Written by xinyiman Dicembre 19, 2011, 03:05:00 pm16411 ViewsRating: 0 (0 Rates)Print
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
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.
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
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;
xinyiman registered at Italian community of Lazarus and Free Pascal on Ottobre 14, 2011, 10:56:28 pm and has posted 3249 posts in the boards since then. Last visit was Aprile 24, 2024, 01:06:22 pm.
Questo blog non rappresenta una testata giornalistica poiché viene
aggiornato senza alcuna periodicità. Non può pertanto considerarsi un
prodotto editoriale ai sensi della legge n. 62/2001.
Questo sito utilizza cookie, anche di terze parti, per offriti servizi in linea con le tue preferenze. Chiudendo questo banner, scorrendo questa pagina, cliccando su un link o proseguendo la navigazione in altra maniera, acconsenti all’uso dei cookie.