unit anagramasF;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  StdCtrls;

type

  { TForm1 }

  TForm1 = class(TForm)
    BLento: TButton;
    BRapido: TButton;
    EPalabra: TLabeledEdit;
    LBPalabras: TListBox;
    LTiempoCalculo: TLabel;
    LProgreso: TLabel;
    LContarAnagramas: TLabel;
    procedure BLentoClick(Sender: TObject);
    procedure BRapidoClick(Sender: TObject);
    procedure EPalabraChange(Sender: TObject);
  private
    numPalabras: int64;
    inicio: TDateTime;
    ss: TStringStream;
    function Factorial(unEnt: integer): int64;
    procedure Intercambio(var a, b: Char);
    procedure GenerarAnagramasRapido(unaPalabra: string; posCar: integer);
    procedure GenerarAnagramasLento(unaPalabra: string; posCar: integer);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.EPalabraChange(Sender: TObject);
var long: integer;
f   : int64;
function Plural(x: int64): char;
begin
      Result:= #0;
      if (x > 1) then Result := 's';
end;
begin
 long:= EPalabra.GetTextLen;
 f:= Factorial(long);
 LContarAnagramas.Caption:= Format('%s generará %s anagrama%s', [EPalabra.Text, FormatFloat(',#',f), Plural(f)]);
end;

procedure TForm1.BLentoClick(Sender: TObject);
begin
  LBPalabras.Items.Clear;
  LBPalabras.Items.Add('[Lento]');
  numPalabras:= 0;
  inicio:= Now;
  LBPalabras.Items.BeginUpdate;
  GenerarAnagramasLento(EPalabra.Text,1); LBPalabras.Items.EndUpdate;
LTiempoCalculo.Caption:= 'Tiempo de cálculo: ' + FormatDateTime('n"m" s,z"s"',Now-inicio);
end;

procedure TForm1.BRapidoClick(Sender: TObject);
begin
  LBPalabras.Items.Clear;
  numPalabras:= 0;
  ss := TStringStream.Create('[Rápido]'+LineEnding);
  ss.Seek(0, soFromEnd);
  inicio:= Now;
  LBPalabras.Items.BeginUpdate;
  try
     GenerarAnagramasRapido(EPalabra.Text, 1);
     LProgreso.Caption:= 'Cargando lista...';
     Application.ProcessMessages;
     ss.Seek(0, soFromBeginning);
     LBPalabras.Items.LoadFromStream(ss);
  finally
     ss.Free;
  end;
  LBPalabras.Items.EndUpdate;
  LTiempoCalculo.Caption:='Tiempo de cálculo: '+ FormatDateTime('n"m" s,z"s"',Now-inicio);
end;



function TForm1.Factorial(unEnt: integer): int64;
begin
 result := -1;
 if (unEnt < 0) then Exit;
 case unEnt of
      0, 1: Result:= 1;
      else Result:= unEnt*Factorial(Pred(unEnt));
 end;
end;

procedure TForm1.Intercambio(var a, b: Char);
var tmp: Char;
begin
  tmp := a;
  a := b;
  b := tmp;
end;

procedure TForm1.GenerarAnagramasRapido(unaPalabra: string; posCar: integer);
var long, p: integer;
begin
long := Length(unaPalabra);
if (posCar >= long) then
begin
ss.WriteString(unaPalabra + LineEnding);
inc(numPalabras);
if (numPalabras mod 10) = 0 then
LProgreso.Caption:= Format('%d anagramas generados',[numPalabras]);
Application.ProcessMessages;
end
else for p:= posCar to long do
begin
Intercambio(unaPalabra[p], unaPalabra[posCar]);
GenerarAnagramasRapido(unaPalabra, Succ(posCar));
Intercambio(unaPalabra[p], unaPalabra[posCar]);
end;

end;

procedure TForm1.GenerarAnagramasLento(unaPalabra: string; posCar: integer);
var long, p: integer;
begin
  long := Length(unaPalabra);
  if (posCar >= long) then
    begin
      LBPalabras.Items.Text := Format('%s%s',[LBPalabras.Items.Text,
unaPalabra]); inc(numPalabras);
if (numPalabras mod 10) = 0 then
LProgreso.Caption:= Format('%d anagramas generados',[numPalabras]);
Application.ProcessMessages;
end
else for p:= posCar to long do
begin
Intercambio(unaPalabra[p], unaPalabra[posCar]);
GenerarAnagramasLento(unaPalabra, Succ(posCar));
Intercambio(unaPalabra[p], unaPalabra[posCar]);
end;
end;

end.

