Fórum Algoritmo de Combinacoes #380592

Caramba...Essa da um pouquinho de trabalho... kkkMais acho que consigo fazer...

Você vai passar uma String com um texto aleatório e tem que devolver todas as combinações possiveis...?

Tem muito tempo que tenho a Rotina abaixo . Ela merece ser Melhorada   Não em termos de lógica , ( pq a lógica é boa ) mas em termos de Languagem Delphi.... Depois eu modificarei   Foi tirada deste tópico http://forum.devmedia.com.br/viewtopic.php?t=53942&highlight=combina%E7%F5es e o Autor mereceu as honras. Porém com eu disse ( em Termos de Linguagem ela pode e deve ser Melhirada ... )   procedure TForm3.Button3Click(Sender: TObject);
var
  i: Integer;
begin
for i := 1 to Length('ABC')  do
   Memo1.Lines.AddStrings(GeraCombinacoes('ABC',I)); end;
[/ode]

Isso mesmo.



Tipo

vou passar as seguintes strings:

alternador do palio

tem que retornar

alternador
alternador do
alternador palio
alternador do palio
alternador palio do

do
do alternador
do palio
do alternador palio
do palio alternador

palio
palio alternador
palio do
palio alternador do
palio do alternador


isso, porque sao so 3 palavras, o algoritmo tem quer se flexivel, porque terei situacoes em que serao 6 palavras para a tal combinacao.



Abracos,
Cleber.

Marcos Sales, boa noite.


sua rotina é fantástica, deu certo para o meu exemplo do inicio do topico.


vi que ela combina as letras, certinho.


tentei adapta-la numa outra situacao, mas sem sucesso, to  meio sem criatividade hoje.


seguinte:

em vez de "ABC", vamos trocar para "ALTERNADOR DO PALIO"


como adaptar esta sua funcao para esta situacao ?  (tem que retornar as combinacoes das palavras, em vez de letras )



Grato, valeu mesmo.

Obrigado.
Cleber.

..   Não é minha rotina que é fantastico ... É a rotina do Amigo do Link Para adaptar a sua necessidade não é dificil.. Mas tem que fazer Algebismo   Vamos pensar que   ALTERNADOR DO PALIO ALTERNADOR = A DO = B PALIO = C   Então ???  pq não Ponteiros ??????      

Boa noite Marcos Sales,


fiz uma adaptacao, na rotina.

nao utilizei ponteiros, utilizei outra técnica.


fico estranha, mas funcional.


Resolveu meu problema.



Segue todo código, para quem quiser aproveitar.




...

===INICIO======

function GeraCombinacoes(S: string; NumDig: Integer): TStrings;
var I, J: Integer;
       X: Char;
      TS: TStrings;
      S1: string;
begin
  Result := TStringList.Create;
  TS     := TStringList.Create;

  for I := 1 to Length(S) do
    Result.Add(S[I]);

  while Length(Result.Strings[0]) < NumDig do
    begin
      for I := 0 to (Result.Count - 1) do
        begin
          S1 := '';

          for J := 1 to Length(S) do
            begin
              X := S[J];
              if Pos(X, Result.Strings[I]) = 0
                then S1 := S1 + X;
            end;

          for J := 1 to Length(S1) do
            begin
              X := S1[J];
              TS.Add( Result.Strings[I] + X) ;
            end;
        end;
      Result.Text := TS.Text;
      TS.Clear;
    end;
  TS.Free;
end;



procedure TForm2.GeraPalavrasChaves;
var


  PalavrasChaves : String;
  Palavra        : TStrings;
  QdePalavras    : Integer;
  i, j           : Integer;

  Combinacoes    : String;

  Linha          : String;

  Frase          : String;
  Numero         : Integer;

  FraseCompleta  : String;
begin

  PalavrasChaves := Trim( edPalavrasChaves.Text );
  FraseCompleta  := edPalavraMaster.Text;

  Palavra        := TStringList.Create;

  while Pos( ' ', PalavrasChaves ) > 0 do
  Begin
    i := Pos( ' ', PalavrasChaves );
    Palavra.Add( Copy( PalavrasChaves, 1, i-1 ) );
    PalavrasChaves := Trim( Copy( PalavrasChaves, i+1, Length( PalavrasChaves ) ) );
  End;
  Palavra.Add( Trim( Copy( PalavrasChaves, 1, Length( PalavrasChaves ) ) ) );

  QdePalavras := Palavra.Count;

  Combinacoes := Copy( '123456789', 1, QdePalavras );  // ACEITA ATE 9 PALAVRAS NA FRASE, PARA O MEU CASO, ATE SOBROU.



  memoCombinacoes.Lines.Clear;

  if jvLimparMemoPalavrasChaves.Checked then
    memoPalavrasChaves.Lines.Clear;


  if Palavra[0] <> '' then
  Begin

    for i := 1 to QdePalavras  do
      memoCombinacoes.Lines.AddStrings( GeraCombinacoes( Combinacoes ,I ) );

    for i := 0 to memoCombinacoes.Lines.Count-1 do
    begin
      Linha := memoCombinacoes.Lines[i];
      Frase := '';
      for j := 1 to Length( Linha ) do
      begin
        Numero := StrToIntDef( Linha[ j ], 0 );
        if Numero <> 0 then
         Frase := Frase + ' ' + Palavra[ Numero - 1 ];
      end;
      Frase := Trim( Frase );

      if Frase <> '' then
        memoPalavrasChaves.Lines.Add( FraseCompleta + ' ' + Frase );
    end;
  End

 Else
    memoPalavrasChaves.Lines.Add( Trim( edPalavraMaster.Text ) );

end;


===FIM===



Valeu,

Abracos, me ajudou muito.


Agradecido.

Cleber.

Beleza , Cleber   Mas não é recomendável Fazer Deste jeito   No inicio do Post eu comentei que a lógica é boa mas tem que modificar a Languagem . ( Do jeito que esta vc terá muito Memory Leak na Aplicação ) Perceba que a cada Iteração Vc Esta Instanciando Um TStringsList e não Tem como Liberar o Mesmo , pq ocasionará erros de AV  

para evitar o Memory Leak que o MARCO SALLES se refere, você pode passar a lista como parâmetro para uma procedure, assim:


procedure GeraCombinacoes(S: string; Digitos: Integer; Lista: TStrings);
var I, J, NumDig: Integer;
       X: Char;
      TS, RS: TStrings;
      S1: string;
begin
  RS := TStringList.Create; // instancia a classe
  TS := TStringList.Create; // instancia a classe

  for NumDig := 1 to Digitos do
  begin
    RS.Clear;

    for I := 1 to Length(S) do
      RS.Add(S[I]);

    while Length(RS.Strings[0]) < NumDig do
    begin
      for I := 0 to (RS.Count - 1) do
      begin
        S1 := '';

        for J := 1 to Length(S) do
        begin
          X := S[J];
          if Pos(X, RS.Strings[I]) = 0
          then S1 := S1 + X;
        end;

        for J := 1 to Length(S1) do
        begin
          X := S1[J];
          TS.Add( RS.Strings[I] + X) ;
        end;
      end;
      RS.Text := TS.Text;
      TS.Clear;
    end;
    Lista.AddStrings(RS);
  end;
  FreeAndNil(TS); // elimina a instância da classe
  FreeAndNil(RS); // elimina a instância da classe
end;

e usá-la assim:

procedure TFormX.Button1Click(Sender: TObject);
var
  i: Integer;
  lst: TStrings;
begin
  Memo1.Clear;

  lst := TStringList.Create; // instancia a classe
  GeraCombinacoes('ABC',3, lst); // gera combinações de até 3 dígitos
  Memo1.Lines.AddStrings(lst); // adiciona a listagem ao memo..
  FreeAndNil(lst); // elimina a instância da classe
end;

Note que os objetos criados são eliminados assim que não são mais necessários.



Você pode também criar uma classe para isso:

interface
uses SysUtils, Classes;

type
  TGeraCombinacoes = class
  private
    FOrigem: string;
    FItems: TStrings;
    FItemsTemp: TStrings;
  public
    constructor Create;
    destructor Destroy;

    procedure Gerar(nDigitos: integer = 1);

    property Origem: string read Forigem write FOrigem;
    property Items: TStrings read FItems;
  end;

implementation

{ TGeraCombinacoes }

constructor TGeraCombinacoes.Create;
begin
  FItems := TStringList.Create;
  FItemsTemp := TStringList.Create;
end;

destructor TGeraCombinacoes.Destroy;
begin
  FreeAndNil(FItems);
  FreeAndNil(FItemsTemp);
end;

procedure TGeraCombinacoes.Gerar(nDigitos: integer);
var I, J, NumDig: Integer;
       X: Char;
      TS: TStrings;
      S1: string;
begin
  TS := TStringList.Create;
  NumDig := Length(FOrigem);

  for NumDig := 1 to nDigitos do
  begin
    FItemsTemp.Clear;

    for I := 1 to Length(FOrigem) do
      FItemsTemp.Add(FOrigem[I]);

    while Length(FItemsTemp.Strings[0]) < NumDig do
    begin
      for I := 0 to (FItemsTemp.Count - 1) do
      begin
        S1 := '';

        for J := 1 to Length(FOrigem) do
        begin
          X := FOrigem[J];
          if Pos(X, FItemsTemp.Strings[I]) = 0
          then S1 := S1 + X;
        end;

        for J := 1 to Length(S1) do
        begin
          X := S1[J];
          TS.Add(FItemsTemp.Strings[I] + X) ;
        end;
      end;
      FItemsTemp.Text := TS.Text;
      TS.Clear;
    end;
    FItems.AddStrings(FItemsTemp);
  end;
  TS.Free;
end;


e deverá utilizá-la assim:

procedure TFormX.Button1Click(Sender: TObject);
var
  gc: TGeraCombinacoes;
begin
  Memo1.Clear;

  gc := TGeraCombinacoes.Create; // instancia a classe GeraCombinacoes
  gc.Origem := 'ABC';
  gc.Gerar(3); // gera combinações de até 3 dígitos

  Memo1.Lines.AddStrings(gc.Items);

  FreeAndNil(gc); // elimina a instância da
end;

Ok.

Muito obrigado.
Funcionou 100%.

Valeu, vcs sao feras.


Post fechado - Resolvido