19 respuestas en este tema

[eduarcol]

Tengo una lista separada por coma, necesito saber si todos los elementos estan en un TStringList pienso en esto:

delphi

function ExisteLista (ListaOriginal : TStringList; ListaBuscar : string) : boolean;
  var
   posicion, nIdx : integer;
   lBuscar: TStringList;
   Resulta: Boolean;
  begin
    //Ordena la lista
    lBuscar := TStringList.Create;
    try
       lBuscar.Delimiter := ',';
       lBuscar.DelimitedText := ListaBuscar;
       lBuscar.Sort;
       ListaOriginal.Sort;
       for nIdx := 0 to lBuscar.Count - 1 do
       begin
         Resulta := ListaOriginal.Find(lBuscar.Strings[nIdx], posicion);
         if not Resulta then
         begin
            Result := False;
            Exit;
         end;
       end; //Recorre la lista a buscar
       Result := Resulta;
    finally
       FreeandNil(lBuscar);
    end; //Captura excepciones
  end;

Hay alguna otra forma mas eficiente???


Gracias de antemano 

[Sergio]

Si los textos han de estar en el mismo orden (sin textos adicionales intermedios) en ambas listas, podrías usar Pos(list.text, listacompleta.text)>0, en cualquier caso, para tu algoritmo, no es necesario que ordenes las listas, por lo que eso te lo puedes ahorar, no es mucho pero... si le quitas otra linea que sobra:

delphi

function ExisteLista (ListaOriginal : TStringList; ListaBuscar : string) : boolean;
  var
   posicion, nIdx : integer;
   lBuscar: TStringList;
   Resulta: Boolean;
  begin
    //Ordena la lista
    lBuscar := TStringList.Create;
    try
       lBuscar.Delimiter := ',';
       lBuscar.DelimitedText := ListaBuscar;
       result:= true;
       for nIdx := 0 to lBuscar.Count - 1 do begin
         result:= ListaOriginal.Find(lBuscar.Strings[nIdx], posicion);
         if not result then Exit;
       end; //Recorre la lista a buscar
    finally
       FreeandNil(lBuscar);
    end; //Captura excepciones
  end;

Si pudieras indicar un indice donde comenzar la busqueda en el comando ListaOriginal.Find (no tengo delphi a mano para ver la ayuda) en ese caso podrías serte de gran utilidad ordenar antes las dos listas y empezar las busquedas por la posicion donde se encontro la ultima busqueda +1, eso te ahorraría mucha CPU.

Si find no tiene esa opción, otra es eliminar las primeras "posicion" líneas de ListaOriginal tras cada busqueda existosa, eso si, la lista la destrozas en el proceso, quizás usar una copia sería más "orientado a objetos". Tampoco sé de memoria si se pueden eliminar las primeras n líneas de un TStringList, eso sería perfecto.

Si ListaOriginal es muy grande, necesitaras una de estas dos cosas para optimizar, no tienes otra que yo le vea.

delphi

function ExisteLista (ListaOriginal : TStringList; ListaBuscar : string) : boolean;
  var
   posicion, nIdx, i: integer;
   lBuscar: TStringList;
   Resulta: Boolean;
  begin
    //Ordena la lista
    lBuscar := TStringList.Create;
    try
       lBuscar.Delimiter := ',';
       lBuscar.DelimitedText := ListaBuscar;
       lBuscar.Sort;
       ListaOriginal.Sort;
       result:= true;
       for nIdx := 0 to lBuscar.Count - 1 do begin
         result:= ListaOriginal.Find(lBuscar.Strings[nIdx], posicion);
         if not result then Exit;
         //Eliminamos las lineas donde ya no puede esperar encontrar mas lineas
         for i:= 1 to posicion-1 do ListaOriginal.Delete(0);
       end; //Recorre la lista a buscar
    finally
       FreeandNil(lBuscar);
    end; //Captura excepciones
  end;

He puesto posicion-1 por si pudieses tener un texto repetido, pero si es imposible, puedes quitar el -1 en el for i.

[eduarcol]

Hola Sergio, gracias por el comentario, lo de eliminar los elementos no es tan factible ya que la lista se reconstruye cada vez que se llama el procedimiento, lo bueno es que no es tan grande.

Voy a aplicar los cambios que sugieres de las lineas extras, gracias

[luisgutierrezb]

Bueno, según veo en el código, con que un elemento este duplicado te sales del procedimiento, no se que tan eficiente sea, pero podrían ser menos lineas de código si usas:

[Delphi]
//Al no permitir duplicados y agregar los elementos de otra lista, si existe algún duplicado lanzara una excepción...
Try
  ListaOriginal.Duplicates := dupError;
  ListaOriginal.AddStrings(lBuscar);
Except
  Exit;
End;
[/Delphi]

Una disculpa si algo tiene error, lo estoy haciendo de memoria...

[eduarcol]

es que necesariamente deben estar todos, se sale es cuando no encuentra el primero ya no sigue buscando

[Delphius]

No recuerdo bien... tengo un vago recuerdo de que en algún lado leí de que en Delphi ya existe una función o un método que permite saber si dos listas son iguales y que está optimizado a más no poder ya trabaja a muy bajo nivel.

Si me lo permites, mañana si logro darme un tiempito lo busco.

Saludos,

[Delphius]

Bueno... a ver... haciendo mejor memoria, la clase base de TStringList, TStrings ya ofrece un método: Equals(). La ayuda dice:

Compares the list of strings to the list from another TStrings object and returns True if the two lists match.

function Equals(Strings: TStrings): Boolean;

Description

Call Equals to compare the lists in two TStrings objects. Equals compares only the strings, not any references to associated objects. Equals returns True if the lists for both TStrings objects have the same number of strings and the strings in each list match when compared using the protected CompareStrings method. Equals returns False if the lists are different in length, if they contain different strings, or if the order of the strings in the two lists differ.

Del texto se entiende que se requiere de un Sort.

Con este método entonces basta con hacer un:

delphi

Lista1.Sort;
Lista2.Sort;
SonIguales := Lista1.Equals(Lista2);

Aunque esto no es lo que yo creo recordar... en mi vaga memoria tengo la imagen de que la implementación era algo de más bajo nivel, y se veía en el código de un CompareMem() para hacer su tarea más rápido.

La implementación de Equals() es la siguiente:

delphi

function TStrings.Equals(Strings: TStrings): Boolean;
var
  I, Count: Integer;
begin
  Result := False;
  Count := GetCount;
  if Count <> Strings.GetCount then Exit;
  for I := 0 to Count - 1 do if Get(I) <> Strings.Get(I) then Exit;
  Result := True;
end;

Y si bien se aprecia que funciona y cumple con el propósito no es lo que yo recuerdo haber visto.

EDITO:
Tras una búsqueda rápida encontré un artículo de Marco Cantú que trata sobre la optimización de listas de strings. Si bien no trata de forma directa al problema quizá ofrece una perspectiva a considerar sobre ciertos usos y la forma en como estamos acostumbrados a tratar con TStrings y sus descendientes.

Saludos,

[eduarcol]

Gracias por la informacion Delphius, pero no es lo que estoy buscando, en mi caso Lista1 puede tener mas elementos que lista2, lo que me interesa saber es si lista2 esta en lista1

[Delphius]

Hola Eduardo, ¿Cuál es el objetivo de evaluar si una lista está dentro de otra? ¿Necesariamente ha de ser TStringList?

La clase TList tiene un método con un comportamiento muy interesante que al menos yo le desconozco algo parecido a la clase base TStrings: Assing.

El método para TList tiene un parámetro que le permite indicar que operación posible se ha de llevar entre la lista A y la lista B que se quiere asignar. La ayuda dice:

Copies elements of one list to another.

procedure Assign(ListA: TList; AOperator: TListAssignOp = laCopy; ListB: TList = nil);

Description

Call Assign to assign the elements of another list to this one. Assign combines the source list with this one using the logical operator specified by the AOperator parameter.

If the ListB parameter is specified, then Assign first replaces all the elements of this list with those in ListA, and then merges ListB into this list using the operator specified by AOperator.

If the ListB parameter is not specified, then Assign merges ListA into this list using the operator specified by AOperator.

Y los operandos posibles son:

Indicates how two lists should be merged.

Unit

Classes

type TListAssignOp = (laCopy, laAnd, laOr, laXor, laSrcUnique, laDestUnique);

Description

TListAssignOps describes how the Assign method combines a source and destination list:

Value Meaning

laAnd Removes all elements from the destination list that do not appear in the source list. The destination list ends up containing the intersection of the two lists.
laCopy Overwrites the destination list with the source list.
laDestUnique Removes all elements from the destination list that appear in the source list. The destination list ends up containing the elements unique to the original destination list. (same as laOr followed by laXor)
laOr Adds any elements from the source list that do not already appear in the destination list. The destination list ends up containing the union of the two lists.

laSrcUnique Replaces the destination list with those elements of the source list that do not appear in the destination list. (same as laAnd followed by laXor)
laXor Removes all elements from the destination list that appear in the source list and adds any elements from the source list that do not appear in the original destination list. The destination list ends up with the elements unique to both the source and destination lists.

Si es entre las operaciones que tu buscas entre ambas listas encuentras lo que necesitas y si no necesariamente se ha de llevar a cabo con la clase TStringList podrías considerar el uso de List y una clase que encapsule los datos a la lista, un TMiItem por darle un nombre.
Sino no tendrás otra que implementar tu propio algoritmo que recorra al TStringList como lo estás encarando.

Por otro lado, mientras estuve investigando dentro de la VCL me doy con que la unidad Classes tiene entre sus funciones una que se llama NameInStrings. Básicamente lo que hace es recorrer al TStrings buscando un Name dentro de éste. Como tu necesitarías buscar los elementos de una lista en otra necesitarías algo como:

delphi

Hay := true; i := 0;
repeat
  Hay := NameInStrings(ListaB, ListaA[i]);
  i := i + 1;
until (NOT Hay) or (i = ListaA.Count);
if Hay
  then ShowMessage('Efectivamente A está en B')
  else ShowMessage('Lamentablemente al menos un elemento de A no está en B');

No estaría mal un método Assing() con el poder que tiene TList para la clase TStrings y sus descendientes. Al menos es lo que yo puedo hablar sobre D6... quizá para versiones más nuevas tenga más cosas (no sería de extrañar).

Saludos,

[Sergio]

No se si será mejor este enfoque que el "clasico", pero si no permitimos duplicados en la lista original y le vamos añadiendo lineas, todas deberían darnos error, si una no da error, devolvemos false:

delphi

function ExisteLista (ListaOriginal : TStringList; ListaBuscar : string) : boolean;
var
  nIdx: integer;
  lBuscar: TStringList;
begin
    lBuscar := TStringList.Create;
    try
       lBuscar.Delimiter := ',';
       lBuscar.DelimitedText := ListaBuscar;
       ListaOriginal.Duplicates := dupError;
       result:= true;
       for nIdx := 0 to lBuscar.Count - 1 do begin
         try 
           ListaOriginal.Add(lBuscar.Strings[nIdx]);
           //Si estoy aqui hay una linea que falta.
           ListaOriginal.Delete(ListaOriginal.Count-1);
           result:= false;
           break;
         finally end;
       end; //Recorre la lista a buscar
    finally
       FreeandNil(lBuscar);
    end; //Captura excepciones
end;

[eduarcol]

Hola, gracias por responder le explico un poco mas

En un sistema de facturacion se debe implantar un sistema para dar descuento basados en promociones especificas, por ejemplo, si en la factura (Lista A) se encuentra un refresco un pan y una mantequilla (lista B) le damos el descuento en el queso y el jamon (Lista C)

Es decir aqui hay varias premisas pero las mas importantes, por las dudas presentadas aqui, son:

- En la lista A los items pueden estar duplicados
- En la lista A pueden estar los items de la lista B y otros mas
- La lista A es modificable
- La lista B sera constante, al menos que se modifique la promocion
- Para aplicar el descuento a la Lista C hay que verificar que Lista B este dentro de Lista A

Espero haberme explicado un poco mejor

Gracias

[egostar]

Hola, gracias por responder le explico un poco mas

En un sistema de facturacion se debe implantar un sistema para dar descuento basados en promociones especificas, por ejemplo, si en la factura (Lista A) se encuentra un refresco un pan y una mantequilla (lista B) le damos el descuento en el queso y el jamon (Lista C)

Es decir aqui hay varias premisas pero las mas importantes, por las dudas presentadas aqui, son:

- En la lista A los items pueden estar duplicados
- En la lista A pueden estar los items de la lista B y otros mas
- La lista A es modificable
- La lista B sera constante, al menos que se modifique la promocion
- Para aplicar el descuento a la Lista C hay que verificar que Lista B este dentro de Lista A

Espero haberme explicado un poco mejor

Gracias

Caray amigo y no sería mas facil meter un campo en la tabla de productos donde tenga el número de lista que correspondiera a un porcentaje 'X'.

O de plano una tabla adicional con toda esa lógica de negocios ¿?

Saludos

[eduarcol]

La tabla adicional la tengo, pero el problema se reduce a validar si en la factura que se esta generando se aplica el descuento, y un producto puede pertenecer a varias listas

[Wilson]

A ver si esto te sirve, he escrito dos funciones,  una para comprobar que un item esté en una lista, y otra (basada en la anterior) para comprobar si todos los elementos de una lista están en otra, te adjunto un ejemplo de prueba, solo debes llenar las líneas de los memos para probar.

Espero te sirva.

delphi

unit UMain;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
 
type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Memo2: TMemo;
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    function ItemEnLista(AItem: string; Lista: TStringList): Boolean;
    function ListaFijaEnListaVariable(ListaFija, ListaVariable
      : TStringList): Boolean;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
{ TForm1 }
 
 
 
function TForm1.ItemEnLista(AItem: string; Lista: TStringList): Boolean;
var
  k: integer;
begin
  for k := 0 to Lista.Count - 1 do
  begin
    result := AItem = Lista[k];
    if result then
      break;
  end;
end;
 
function TForm1.ListaFijaEnListaVariable(ListaFija, ListaVariable
  : TStringList): Boolean;
var
  k: integer;
begin
  for k := 0 to ListaFija.Count - 1 do
  begin
    result := ItemEnLista(ListaFija[k], ListaVariable);
    if not result then
      break
  end;
end;
 
procedure TForm1.Button1Click(Sender: TObject);
var
  ListaFija, ListaVariable: TStringList;
begin
  ListaFija := TStringList.Create;
  ListaVariable := TStringList.Create;
  try
    ListaFija.assign(Memo1.Lines);
    ListaVariable.assign(Memo2.Lines);
    if ListaFijaEnListaVariable(ListaFija, ListaVariable) then
      showMessage('Si están todas')
    else
      showMessage('No están todas')
  finally
    ListaFija.Free;
    ListaVariable.Free;
  end;
end;
 
end.

[eduarcol]

Muy bien Wilson, es parecido al que tenemos arriba pero con unas mejoras lo voy a adaptar

[Delphius]

Hola,

Si parte de la idea es que se busque de una en otra creo que como dije unos posts antes, se puede aprovechar algo que ya existe: NameInStrings. Basta con pasar cada item de una lista a ser comparado con la otra lista.
En mi código de ejemplo se es mucho más efectivo que emplear un for tan directo y tener que interrumpirlo a las fuerzas (en el mejor caso) con un Break. Existe otros ciclos, y que hasta se me hacen que son más naturales para el caso y no hay que estar interrumpierlos de forma brusca. Aprendamos a usar más el repeat... no se queden con el while y el for.

Saludos,

[eduarcol]

Gracias Delphius,

Hasta el momento llevo esto:

delphi

function ExisteLista (ListaOriginal : TStringList; ListaBuscar : string) : boolean;
  var
   posicion, i : integer;
   lBuscar: TStringList;
   Hay: Boolean;
  begin
    lBuscar := TStringList.Create;
    try
      lBuscar.Delimiter := ',';
      lBuscar.DelimitedText := ListaBuscar;
      lBuscar.Sort;
      ListaOriginal.Sort;
      Hay := true; i := 0;
      repeat
        Hay := listaOriginal.Find(lBuscar.Strings[i], posicion)
        i := i + 1;
      until (NOT Hay) or (i = lBuscar.Count);
      Result := Hay;
    finally
       FreeandNil(lBuscar);
    end;
  end;

[Delphius]

De lo que aprecio y entiendo no es necesario ordenar las listas, por lo que te podrías ahorrar esas dos líneas de código, y de paso unos cuantos ciclos de procesador. 

Por otro lado recién me doy con que la función NameInStrings() que había descubierto es sólo de uso interno en la unit Classes. Pero nada impide que le veamos su código y la aprovechemos 

delphi

function NameInStrings(Strings: TStrings; const Name: string): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to Strings.Count - 1 do
    if SameText(Name, Strings[I]) then Exit;
  Result := False;
end;

Con esta función a modo de inspiración creo que el código se te hace más sencillo amigo. Básicamente la idea es que pases a buscar cada item de una lista sobre la otra lista. En vez de estar haciéndolo por medio de Find.

Aunque... No sabría decir que diferencias podría haber entre basar el código en un Find()/IndexOf() (Find sólo aplica cuando la lista está ordenada) o hacerlo por SameText() como el de esta muestra.
Ya que Find()/IndexOf() pueden hacer diferencias entre emplear o no CaseSensitive... mientras que SameText no es sensible a mayúsculas y no se ve afectado por el "locale".

Saludos,

[Sergio]

Hum, se me ocurre una forma de aprovechar esos dos inútiles "sort" de tu código para acellerar las busquedas creo que bastante:

delphi

function ExisteLista (ListaOriginal : TStringList; ListaBuscar : string) : boolean;
  var
   posicion, i : integer;
   lBuscar: TStringList;
   Copia: String;
   Hay: Boolean;
  begin
    lBuscar := TStringList.Create;
    try
      lBuscar.Delimiter := ',';
      lBuscar.DelimitedText := ListaBuscar;
      lBuscar.Sort;
      ListaOriginal.Sort;
      Copia:= ListaOriginal.Text;
      Hay := true; i := 0;
      repeat
        Posicion:= Pos(lBuscar.Strings[i], Copia);
        if Posicion=0 then 
          Hay:= false
        else
          Copia:= Copy(Copia, Posicion+Length(lBuscar.Strings[i]), Length(Copia));
        inc(i);
      until (NOT Hay) or (Copia='') or (i = lBuscar.Count);
      Result := Hay;
    finally
       FreeandNil(lBuscar);
    end;
  end;

Esto te evita buscar por las ya usadas y todas las anteirores: Si la primera cadena está en la posicion 1000, esas 1000 lineas se descartan para el resto de busquedas.

Por cierto, creo recordar de memoria que TStringList tiene una opción de "indexar texos" o similar que si la activas busca mucho más rápido, pero si modificas la lista va mucho más lento, era algo de indexar, tokenizar o algo así, no tengo la ayuda disponible pero la idea es que como ListaOriginal es estática y se busca mucho en ella, lo activas y los find van 10 o 20 veces más rápidos -si, soy algo exagerado, je je- en casos de listas grandes.

[eduarcol]

Gracias a los dos por el interes, voy a aplicarlo a ver que queda

Saludos