Italian community of Lazarus and Free Pascal

Una permutazione è un modo di ordinare in successione n oggetti distinti, come nell'anagrammare una parola.
Per capire come affrontare questa problematica informatica con Lazarus e il Free Pascal l'obbiettivo del programma d'esempio sarà proprio anagrammare una parola passata come input.
Per prima cosa bisogna sapere che per stabilire a priori tutte le possibili combinazioni bisogna calcolare il fattoriale della lunghezza della parola da anagrammare.
Ad esempio se vogliamo anagrammare la parola "abcd" le permutazioni totali saranno 24. Vediamo allora il codice per generare il fattoriale di un numero:


function TForm1.Fattoriale(x:integer):longint;
begin
     if x=1 then
        Fattoriale:=1
     else
         Fattoriale:=x*Fattoriale(x-1);
end;


Come si può notare è una funzione ricorsiva, che moltiplicare se stesso per se stesso decrementato di uno fino ad arrivare ad 1.
Bene stabilito questo analizziamo la funzione di permutazione vera e propria (anche lei ricorsiva):



function TForm1.Permuta(Lista: string; a : integer; z : integer; elementi : integer ) : integer;
var scambio : char;
k : integer;
i : integer;
begin
    {Se il segmento di array contiene almeno due elementi, si procede.}
    if ( z-a ) >= 1 then
begin
   { Inizia il ciclo di scambi tra l'ultimo elemento e
    uno degli altri contenuti nel segmento di array.}
   k := z;
   while k >= a do begin

{Scambia i valori.}
scambio := lista[k];
lista[k] := lista[z];
lista[z] := scambio;

{ Esegue una chiamata ricorsiva per permutare un segmento più piccolo dell'array. }
permuta(Lista, a, z-1, elementi);

{ Scambia i valori.}
scambio := lista[k];
lista[k] := lista[z];
lista[z] := scambio;

k := k-1;

   end;
end
    else
begin

   {Visualizza la situazione attuale dell'array.}

   for i := 1 to elementi do begin
                Grid_Risultato.Cells[Colonna, Riga]:=lista[i];
                Inc(Colonna);
   end;
            Colonna:=0;
            Inc(Riga);
            MyProgressBar.Position:=MyProgressBar.Position+1;
end;
end;


Se avete osservato attentamente noterete che il codice è ben commentato e spiega dove serve cosa fa.
Segue il codice completo dell'esempio.


unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ComCtrls, Grids;

type

  { TForm1 }

  TForm1 = class(TForm)
    SaveDialog1: TSaveDialog;
    Txt_Esporta: TButton;
    Label1: TLabel;
    Lbl_Num: TLabel;
    MyProgressBar: TProgressBar;
    Grid_Risultato: TStringGrid;
    Txt_Elabora: TButton;
    Txt_StringaIn: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure Txt_ElaboraClick(Sender: TObject);
    function Fattoriale(x:integer):longint;
    function Permuta(Lista: string; a : integer; z : integer; elementi : integer ) : integer;
    procedure Txt_EsportaClick(Sender: TObject);
  private
    { private declarations }
    Riga: integer;
    Colonna: integer;
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

function TForm1.Fattoriale(x:integer):longint;
begin
     if x=1 then
        Fattoriale:=1
     else
         Fattoriale:=x*Fattoriale(x-1);
end;

procedure TForm1.Txt_ElaboraClick(Sender: TObject);
begin
     if Length(Txt_StringaIn.Text)>1 then
     begin
          Grid_Risultato.Clear;
          Riga:=0;
          Colonna:=0;
          Lbl_Num.Caption:=IntToStr(Fattoriale(Length(Txt_StringaIn.Text)));
          Form1.Repaint;
          MyProgressBar.Min:=1;
          MyProgressBar.Max:=Fattoriale(Length(Txt_StringaIn.Text));
          Grid_Risultato.ColCount:=Length(Txt_StringaIn.Text);
          Grid_Risultato.RowCount:=Fattoriale(Length(Txt_StringaIn.Text));;
          Permuta(Txt_StringaIn.Text,1,Length(Txt_StringaIn.Text),Length(Txt_StringaIn.Text));
          ShowMessage('ELABORAZIONE TERMINATA');
     end
     else
     begin
          ShowMessage('Devi inserire una parola maggiore di 1 carattere!');
     end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
     Grid_Risultato.Clear;
     Lbl_Num.Caption:='0';
end;

function TForm1.Permuta(Lista: string; a : integer; z : integer; elementi : integer ) : integer;
var scambio : char;
k : integer;
i : integer;
begin
    {Se il segmento di array contiene almeno due elementi, si procede.}
    if ( z-a ) >= 1 then
begin
   { Inizia il ciclo di scambi tra l'ultimo elemento e
    uno degli altri contenuti nel segmento di array.}
   k := z;
   while k >= a do begin

{Scambia i valori.}
scambio := lista[k];
lista[k] := lista[z];
lista[z] := scambio;

{ Esegue una chiamata ricorsiva per permutare un segmento più piccolo dell'array. }
permuta(Lista, a, z-1, elementi);

{ Scambia i valori.}
scambio := lista[k];
lista[k] := lista[z];
lista[z] := scambio;

k := k-1;

   end;
end
    else
begin

   {Visualizza la situazione attuale dell'array.}

   for i := 1 to elementi do begin
                Grid_Risultato.Cells[Colonna, Riga]:=lista[i];
                Inc(Colonna);
   end;
            Colonna:=0;
            Inc(Riga);
            MyProgressBar.Position:=MyProgressBar.Position+1;
end
    ;
end;

procedure TForm1.Txt_EsportaClick(Sender: TObject);
var
   app:TStringList;
   nome: string;
   parola: string;
   i, j: integer;
begin
    if SaveDialog1.Execute then
       nome:=SaveDialog1.Filename;
    if length(trim(nome))>0 then
    begin
         app:=TStringList.Create;
         for i:=0 to Grid_Risultato.RowCount-1 do
         begin
             parola:='';
             for j:=0 to Grid_Risultato.ColCount-1 do
             begin
                  parola:=parola + Grid_Risultato.Cells[j,i];
             end;
             app.Add(parola);
         end;
         app.SaveToFile(nome);
         app.Free;
         ShowMessage('Esportazione avvenuta con successo: ' + nome);
    end
    else
    begin
         ShowMessage('Devi stabilire dove salvare il file');
    end;
end;

end.


E' possibile scaricare l'esempio appena visto all'indirizzo: http://www.lazaruspascal.it/esempi/permutazioni.zip