[successivo] [precedente] [inizio] [fine] [indice generale] [indice ridotto] [indice analitico] [home] [volume] [parte]


Capitolo 640.   Pascal: esempi di programmazione

Questo capitolo raccoglie solo alcuni esempi di programmazione, in parte già descritti in altri capitoli. Lo scopo di questi esempi è solo didattico, utilizzando forme non ottimizzate per la velocità di esecuzione.

640.1   Problemi elementari di programmazione

In questa sezione vengono mostrati alcuni algoritmi elementari portati in Pascal. Per la spiegazione degli algoritmi, se non sono già conosciuti, occorre leggere quanto riportato nel capitolo 543.

640.1.1   Somma tra due numeri positivi

Il problema della somma tra due numeri positivi, attraverso l'incremento unitario, è descritto nella sezione 543.2.1.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/Somma.pas>.

(* ================================================================= *)
(* Somma.pas                                                         *)
(* Somma esclusivamente valori positivi.                             *)
(* ================================================================= *)
program Sommare;

var     x       : integer;
        y       : integer;
        z       : integer;

(* ================================================================= *)
(* somma( <x>, <y> )                                                 *)
(* ----------------------------------------------------------------- *)
function somma( x : integer; y : integer ) : integer;

var     z       : integer;
        i       : integer;

begin

    z := x;
    
    for i := 1 to y do begin
        z := z+1;
    end;
    
    somma := z;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln;
    Write( 'Inserisci il primo numero intero positivo: ' );
    Readln( x );
    Write( 'Inserisci il secondo numero intero positivo: ' );
    Readln( y );
    
    z := somma( x, y );

    Write( x, ' + ', y, ' = ', z );

end.

(* ================================================================= *)

In alternativa si può tradurre il ciclo for in un ciclo while:

function somma( x : integer; y : integer ) : integer;

var     z       : integer;
        i       : integer;

begin

    z := x;
    i := 1;
    
    while i <= y do begin
        z := z+1;
        i := i+1;
    end;
    
    somma := z;

end;

640.1.2   Moltiplicazione di due numeri positivi attraverso la somma

Il problema della moltiplicazione tra due numeri positivi, attraverso la somma, è descritto nella sezione 543.2.2.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/Moltiplica.pas>.

(* ================================================================= *)
(* Moltiplica.pas                                                    *)
(* Moltiplica esclusivamente valori positivi.                        *)
(* ================================================================= *)
program Moltiplicare;

var     x       : integer;
        y       : integer;
        z       : integer;

(* ================================================================= *)
(* moltiplica( <x>, <y> )                                            *)
(* ----------------------------------------------------------------- *)
function moltiplica( x : integer; y : integer ) : integer;

var     z       : integer;
        i       : integer;

begin

    z := 0;
    
    for i := 1 to y do begin
        z := z+x;
    end;
    
    moltiplica := z;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln;
    Write( 'Inserisci il primo numero intero positivo: ' );
    Readln( x );
    Write( 'Inserisci il secondo numero intero positivo: ' );
    Readln( y );
    
    z := moltiplica( x, y );

    Write( x, ' * ', y, ' = ', z );

end.

(* ================================================================= *)

In alternativa si può tradurre il ciclo for in un ciclo while:

function moltiplica( x : integer; y : integer ) : integer;

var     z       : integer;
        i       : integer;

begin

    z := 0;
    i := 1;
    
    while i <= y do begin
        z := z+x;
        i := i+1;
    end;
    
    moltiplica := z;

end;

640.1.3   Divisione intera tra due numeri positivi

Il problema della divisione tra due numeri positivi, attraverso la sottrazione, è descritto nella sezione 543.2.3.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/Dividi.pas>.

(* ================================================================= *)
(* Dividi.pas                                                        *)
(* Divide esclusivamente valori positivi.                            *)
(* ================================================================= *)
program Dividere;

var     x       : integer;
        y       : integer;
        z       : integer;

(* ================================================================= *)
(* dividi( <x>, <y> )                                                *)
(* ----------------------------------------------------------------- *)
function dividi( x : integer; y : integer ) : integer;

var     z       : integer;
        i       : integer;

begin

    z := 0;
    i := x;
    
    while i >= y do begin
        i := i - y;
        z := z+1;
    end;
    
    dividi := z;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln;
    Write( 'Inserisci il primo numero intero positivo: ' );
    Readln( x );
    Write( 'Inserisci il secondo numero intero positivo: ' );
    Readln( y );
    
    z := dividi( x, y );

    Write( x, ' / ', y, ' = ', z );

end.
(* ================================================================= *)

640.1.4   Elevamento a potenza

Il problema dell'elevamento a potenza tra due numeri positivi, attraverso la moltiplicazione, è descritto nella sezione 543.2.4.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/Exp.pas>.

(* ================================================================= *)
(* Exp.pas                                                           *)
(* Eleva a potenza.                                                  *)
(* ================================================================= *)
program Potenza;

var     x       : integer;
        y       : integer;
        z       : integer;

(* ================================================================= *)
(* exp( <x>, <y> )                                                   *)
(* ----------------------------------------------------------------- *)
function exp( x : integer; y : integer ) : integer;

var     z       : integer;
        i       : integer;

begin

    z := 1;
    
    for i := 1 to y do begin
        z := z * x;
    end;
    
    exp := z;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln;
    Write( 'Inserisci il primo numero intero positivo: ' );
    Readln( x );
    Write( 'Inserisci il secondo numero intero positivo: ' );
    Readln( y );
    
    z := exp( x, y );

    Write( x, ' ** ', y, ' = ', z );

end.
(* ================================================================= *)

In alternativa si può tradurre il ciclo for in un ciclo while:

(* ================================================================= *)
(* exp( <x>, <y> )                                                   *)
(* ----------------------------------------------------------------- *)
function exp( x : integer; y : integer ) : integer;

var     z       : integer;
        i       : integer;

begin

    z := 1;
    i := 1;
    
    while i <= y do begin
        z := z * x;
        i := i+1;
    end;
    
    exp := z;

end;

È possibile usare anche un algoritmo ricorsivo:

function exp( x : integer; y : integer ) : integer;

begin

    if x = 0 then
        begin
            exp := 0;
        end
    else if y = 0 then
        begin
            exp := 1;
        end
    else
        begin
            exp := ( x * exp(x, y-1) );
        end
    ;
        
end;

640.1.5   Radice quadrata

Il problema della radice quadrata è descritto nella sezione 543.2.5.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/Radice.pas>.

(* ================================================================= *)
(* Radice.pas                                                        *)
(* Radice quadrata.                                                  *)
(* ================================================================= *)
program RadiceQuadrata;

var     x       : integer;
        z       : integer;

(* ================================================================= *)
(* radice( <x> )                                                     *)
(* ----------------------------------------------------------------- *)
function radice( x : integer; ) : integer;

var     z       : integer;
        t       : integer;
        ciclo   : boolean;

begin

    z := 0;
    t := 0;
    ciclo := TRUE;

    while ciclo do begin
    
        t := z * z;

        if t > x then
            begin
                z := z-1;
                radice := z;
                ciclo := FALSE;
            end
        ;
        
        z := z+1;

    end;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln;
    Write( 'Inserisci il numero intero positivo: ' );
    Readln( x );
    
    z := radice( x );

    Writeln( 'La radice di ', x, ' e'' ', z );

end.
(* ================================================================= *)

640.1.6   Fattoriale

Il problema del fattoriale è descritto nella sezione 543.2.6.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/Fact.pas>.

(* ================================================================= *)
(* Fact.pas                                                          *)
(* Fattoriale.                                                       *)
(* ================================================================= *)
program Fattoriale;

var     x       : integer;
        z       : integer;

(* ================================================================= *)
(* fact( <x> )                                                       *)
(* ----------------------------------------------------------------- *)
function fact( x : integer ) : integer;

var     i       : integer;

begin

    i := x - 1;

    while i > 0 do begin
    
        x := x * i;
        i := i-1;
        
    end;
    
    fact := x;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln;
    Write( 'Inserisci il numero intero positivo: ' );
    Readln( x );
    
    z := fact( x );

    Writeln( 'Il fattoriale di ', x, ' e'' ', z );

end.

(* ================================================================= *)

In alternativa, l'algoritmo si può tradurre in modo ricorsivo:

function fact( x : integer ) : integer;

begin

    if x > 1 then
        begin
            fact := ( x * fact( x - 1 ) )
        end
    else
        begin
            fact := 1
        end
    ;

end;

640.1.7   Massimo comune divisore

Il problema del massimo comune divisore, tra due numeri positivi, è descritto nella sezione 543.2.7.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/MCD.pas>.

(* ================================================================= *)
(* MCD.pas                                                           *)
(* Massimo Comune Divisore.                                          *)
(* ================================================================= *)
program MassimoComuneDivisore;

var     x       : integer;
        y       : integer;
        z       : integer;

(* ================================================================= *)
(* mcd( <x>, <y> )                                                   *)
(* ----------------------------------------------------------------- *)
function mcd( x : integer; y : integer ) : integer;

begin

    while x <> y do begin
        
        if x > y then
            begin
                x := x - y;
            end
        else
            begin
                y := y - x;
            end
        ;

    end;

    mcd := x;
    
end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln;
    Write( 'Inserisci il primo numero intero positivo: ' );
    Readln( x );
    Write( 'Inserisci il secondo numero intero positivo: ' );
    Readln( y );
    
    z := mcd( x, y );

    Write( 'Il massimo comune divisore tra ', x, ' e ', y, ' e'' ', z );

end.

(* ================================================================= *)

640.1.8   Numero primo

Il problema della determinazione se un numero sia primo o meno, è descritto nella sezione 543.2.8.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/Primo.pas>.

(* ================================================================= *)
(* Primo.pas                                                         *)
(* ================================================================= *)
program NumeroPrimo;

var     x       : integer;

(* ================================================================= *)
(* primo( <x> )                                                      *)
(* ----------------------------------------------------------------- *)
function primo( x : integer ) : boolean;

var     np      : boolean;
        i       : integer;
        j       : integer;

begin

    np := TRUE;
    i := 2;
    
    while (i < x) AND np do begin
    
        j := x / i;
        j := x - (j * i);
        
        if j = 0  then
            begin
                np := FALSE;
            end
        else
            begin
                i := i+1;
            end
        ;

    end;

    primo := np;
    
end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln;
    Write( 'Inserisci un numero intero positivo: ' );
    Readln( x );
    
    if primo( x ) then
        begin
            Writeln( 'E'' un numero primo' );
        end
    else
        begin
            Writeln( 'Non e'' un numero primo' );
        end
    ;

end.
(* ================================================================= *)

640.2   Scansione di array

In questa sezione vengono mostrati alcuni algoritmi, legati alla scansione degli array, portati in Pascal. Per la spiegazione degli algoritmi, se non sono già conosciuti, occorre leggere quanto descritto nel capitolo 543.

Per semplicità, gli esempi mostrati fanno uso di array dichiarati globalmente, che come tali sono accessibili alle procedure e alle funzioni senza necessità di farne riferimento all'interno delle chiamate.

640.2.1   Ricerca sequenziale

Il problema della ricerca sequenziale all'interno di un array, è descritto nella sezione 543.3.1.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/RicercaSeq.pas>.

(* ================================================================= *)
(* RicercaSeq.pas                                                    *)
(* Ricerca sequenziale.                                              *)
(* ================================================================= *)
program RicercaSequenziale;

const   DIM     = 100;

var     lista   : array[1..DIM] of integer;
        x       : integer;
        i       : integer;
        z       : integer;

(* ================================================================= *)
(* ricercaseq( <x>, <ele-inf>, <ele-sup> )                           *)
(* ----------------------------------------------------------------- *)
function ricercaseq( x : integer; a : integer; z : integer ) : integer;

var     i       : integer;

begin

    (* ------------------------------------------------------------- *)
    (* Se l'elemento non viene trovato, il valore -1 segnala         *)
    (* l'errore.                                                     *)
    (* ------------------------------------------------------------- *)
    ricercaseq := -1;

    (* ------------------------------------------------------------- *)
    (* Scandisce l'array alla ricerca dell'elemento.                 *)
    (* ------------------------------------------------------------- *)
    for i := a to z do begin
    
        if x = lista[i] then
            begin
                ricercaseq := i;
            end
        ;
        
    end;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln( 'Inserire il numero di elementi.' );
    Writeln( DIM, ' al massimo.' );
    Readln( z );

    if z > DIM then
        begin
            z := DIM;
        end
    ;

    Writeln( 'Inserire i valori dell''array' );

    for i := 1 to z do begin
        Write( 'elemento ', i:2, ': ' );
        Readln( lista[i] );
    end;

    Writeln( 'Inserire il valore da cercare' );
    Readln( x );
    
    i := ricercaseq( x, 1, z );
    
    Writeln( 'Il valore cercato si trova nell''elemento', i );

end.
(* ================================================================= *)

Esiste anche una soluzione ricorsiva che viene mostrata nella subroutine seguente:

function ricercaseq( x : integer; a : integer; z : integer ) : integer;

begin

    if a > z then
        begin
    
            (* ----------------------------------------------------- *)
            (* La corrispondenza non è stata trovata.                *)
            (* ----------------------------------------------------- *)
            ricercaseq := -1;
        end
    else if x = lista[a] then
        begin
            ricercaseq := a;
        end
    else
        begin
            ricercaseq := ricercaseq( x, a+1, z);
        end
    ;

end;

640.2.2   Ricerca binaria

Il problema della ricerca binaria all'interno di un array, è descritto nella sezione 543.3.2.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/RicercaBin.pas>.

(* ================================================================= *)
(* RicercaBin.pas                                                    *)
(* Ricerca binaria.                                                  *)
(* ================================================================= *)
program RicercaBinaria;

const   DIM     = 100;

var     lista   : array[1..DIM] of integer;
        x       : integer;
        i       : integer;
        z       : integer;

(* ================================================================= *)
(* ricercabin( <x>, <ele-inf>, <ele-sup> )                           *)
(* ----------------------------------------------------------------- *)
function ricercabin( x : integer; a : integer; z : integer ) : integer;

var     m       : integer;

begin

    (* ------------------------------------------------------------- *)
    (* Determina l'elemento centrale.                                *)
    (* ------------------------------------------------------------- *)
    m := ( a + z ) / 2;
    
    if m < a then
        begin

            (* ----------------------------------------------------- *)
            (* Non restano elementi da controllare.                  *)
            (* ----------------------------------------------------- *)
            ricercabin := -1;
        end
    else if x < lista[m] then
        begin

            (* ----------------------------------------------------- *)
            (* Si ripete la ricerca nella parte inferiore.           *)
            (* ----------------------------------------------------- *)
            ricercabin := ricercabin( x, a, m-1 );
        end
    else if x > lista[m] then
        begin

            (* ----------------------------------------------------- *)
            (* Si ripete la ricerca nella parte superiore.           *)
            (* ----------------------------------------------------- *)
            ricercabin := ricercabin( x, m+1, z );
        end
    else
        begin

            (* ----------------------------------------------------- *)
            (* m rappresenta l'indice dell'elemento cercato.         *)
            (* ----------------------------------------------------- *)
            ricercabin := m;
        end
    ;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln( 'Inserire il numero di elementi.' );
    Writeln( DIM, ' al massimo.' );
    Readln( z );

    if z > DIM then
        begin
            z := DIM;
        end
    ;

    Writeln( 'Inserire i valori dell''array' );

    for i := 1 to z do begin
        Write( 'elemento ', i:2, ': ' );
        Readln( lista[i] );
    end;

    Writeln( 'Inserire il valore da cercare' );
    Readln( x );
    
    i := ricercabin( x, 1, z );
    
    Writeln( 'Il valore cercato si trova nell''elemento', i );

end.
(* ================================================================= *)

640.3   Algoritmi tradizionali

In questa sezione vengono mostrati alcuni algoritmi tradizionali portati in Pascal. Per la spiegazione degli algoritmi, se non sono già conosciuti, occorre leggere quanto riportato nel capitolo 543.

640.3.1   Bubblesort

Il problema del Bubblesort è stato descritto nella sezione 543.4.1. Viene mostrata prima una soluzione iterativa e successivamente la funzione bsort in versione ricorsiva.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/BSort.pas>.

(* ================================================================= *)
(* BSort.pas                                                         *)
(* ================================================================= *)
program BubbleSort;

const   DIM     = 100;

var     lista   : array[1..DIM] of integer;
        i       : integer;
        z       : integer;

(* ================================================================= *)
(* bsort( <ele-inf>, <ele-sup> )                                     *)
(* ----------------------------------------------------------------- *)
procedure bsort( a : integer; z : integer );

var     scambio : integer;
        j       : integer;
        k       : integer;

begin

    (* ------------------------------------------------------------- *)
    (* Inizia il ciclo di scansione dell'array.                      *)
    (* ------------------------------------------------------------- *)
    for j := a to ( z-1 ) do begin
    
        (* --------------------------------------------------------- *)
        (* Scansione interna dell'array per collocare nella          *)
        (* posizione j l'elemento giusto.                            *)
        (* --------------------------------------------------------- *)
        for k := ( j+1 ) to z do begin
        
            if lista[k] < lista[j] then
                begin

                    (* --------------------------------------------- *)
                    (* Scambia i valori.                             *)
                    (* --------------------------------------------- *)
                    scambio := lista[k];
                    lista[k] := lista[j];
                    lista[j] := scambio;
                end
            ;

        end;
    end;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln( 'Inserire il numero di elementi.' );
    Writeln( DIM, ' al massimo.' );
    Readln( z );

    if z > DIM then
        begin
            z := DIM;
        end
    ;

    Writeln( 'Inserire i valori dell''array' );

    for i := 1 to z do begin
        Write( 'elemento ', i:2, ': ' );
        Readln( lista[i] );
    end;

    bsort( 1, z );

    Writeln( 'Array ordinato:' );

    for i := 1 to z do begin
        Write( lista[i] );
    end;

end.
(* ================================================================= *)

Segue la procedura bsort in versione ricorsiva:

procedure bsort( a : integer; z : integer );

var     scambio : integer;
        k       : integer;

begin

    if a < z then
        begin
            
            (* ----------------------------------------------------- *)
            (* Scansione interna dell'array per collocare nella      *)
            (* posizione j l'elemento giusto.                        *)
            (* ----------------------------------------------------- *)
            for k := ( a+1 ) to z do begin
        
                if lista[k] < lista[a] then
                    begin
    
                        (* ----------------------------------------- *)
                        (* Scambia i valori.                         *)
                        (* ----------------------------------------- *)
                        scambio := lista[k];
                        lista[k] := lista[a];
                        lista[a] := scambio;
                    end
                ;

            end;
            
            bsort( a+1, z );

        end
    ;

end;

640.3.2   Torre di Hanoi

Il problema della torre di Hanoi è descritto nella sezione 543.4.3.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/Hanoi.pas>.

(* ================================================================= *)
(* Hanoi.pas                                                         *)
(* Torre di Hanoi.                                                   *)
(* ================================================================= *)
program TorreHanoi;

var     n       : integer;
        p1      : integer;
        p2      : integer;

(* ================================================================= *)
(* hanoi( <n>, <p1>, <p2> )                                          *)
(* ----------------------------------------------------------------- *)
procedure hanoi( n : integer; p1 : integer; p2 : integer );

begin

    if n > 0 then
        begin
            hanoi( n-1, p1, 6-p1-p2 );
            
            Writeln(
                'Muovi l''anello ', n:1,
                ' dal piolo ', p1:1,
                ' al piolo ', p2:1
            );
            
            hanoi( n-1, 6-p1-p2, p2 );
        end
    ;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln;
    Write( 'Inserisci il numero di anelli: ' );
    Readln( n );
    Write( 'Inserisci il piolo iniziale: ' );
    Readln( p1 );
    Write( 'Inserisci il piolo finale: ' );
    Readln( p2 );
    
    hanoi( n, p1, p2 );

end.
(* ================================================================= *)

640.3.3   Quicksort

L'algoritmo del Quicksort è stato descritto nella sezione 543.4.4.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/QSort.pas>.

(* ================================================================= *)
(* QSort.pas                                                         *)
(* ================================================================= *)
program QuickSort;

const   DIM     = 100;

var     lista   : array[1..DIM] of integer;
        i       : integer;
        z       : integer;

(* ================================================================= *)
(* part( <ele-inf>, <ele-sup> )                                      *)
(* ----------------------------------------------------------------- *)
function part( a : integer; z : integer ) : integer;

var     scambio : integer;
        i       : integer;
        cf      : integer;
        loop1   : boolean;
        loop2   : boolean;
        loop3   : boolean;

begin

    (* ------------------------------------------------------------- *)
    (* Si assume che a sia inferiore a z.                            *)
    (* ------------------------------------------------------------- *)
    i := a+1;
    cf := z;
    
    (* ------------------------------------------------------------- *)
    (* Inizia il ciclo di scansione dell'array.                      *)
    (* ------------------------------------------------------------- *)
    loop1 := TRUE;
    while loop1 do begin

        loop2 := TRUE;
        while loop2 do begin
        
            (* ----------------------------------------------------- *)
            (* Sposta i a destra.                                    *)
            (* ----------------------------------------------------- *)
            if ( lista[i] > lista[a] ) OR ( i >= cf ) then
                begin
                    loop2 := FALSE;
                end
            else
                begin
                    i := i+1;
                end
            ;
            
        end;
        
        loop3 := TRUE;
        while loop3 do begin
        
            (* ----------------------------------------------------- *)
            (* Sposta cf a sinistra.                                 *)
            (* ----------------------------------------------------- *)
            if lista[cf] <= lista[a] then
                begin
                    loop3 := FALSE;
                end
            else
                begin
                    cf := cf-1;
                end
            ;
            
        end;
        
        if cf <= i then
            begin
                
                (* ------------------------------------------------- *)
                (* è avvenuto l'incontro tra i e cf.                 *)
                (* ------------------------------------------------- *)
                loop1 := FALSE;
            end
        else
            begin
            
                (* ------------------------------------------------- *)
                (* Vengono scambiati i valori.                       *)
                (* ------------------------------------------------- *)
                scambio := lista[cf];
                lista[cf] := lista[i];
                lista[i] := scambio;

                i := i+1;
                cf := cf-1;
            end
        ;
    end;

    (* ------------------------------------------------------------- *)
    (* A questo punto, lista[a..z] è stata ripartita e cf è la       *)
    (* collocazione finale.                                          *)
    (* ------------------------------------------------------------- *)
    scambio := lista[cf];
    lista[cf] := lista[a];
    lista[a] := scambio;
    
    (* ------------------------------------------------------------- *)
    (* In questo momento, lista[cf] è un elemento (un valore) nella  *)
    (* posizione giusta.                                             *)
    (* ------------------------------------------------------------- *)
    part := cf

end;

(* ================================================================= *)
(* quicksort( <ele-inf>, <ele-sup> )                                 *)
(* ----------------------------------------------------------------- *)
procedure quicksort( a : integer; z : integer );

var     cf      : integer;

begin

    if z > a then
        begin
            cf := part( a, z );
            quicksort( a, cf-1 );
            quicksort( cf+1, z );
        end
    ;

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln( 'Inserire il numero di elementi.' );
    Writeln( DIM, ' al massimo.' );
    Readln( z );

    if z > DIM then
        begin
            z := DIM;
        end
    ;

    Writeln( 'Inserire i valori dell''array' );

    for i := 1 to z do begin
        Write( 'elemento ', i:2, ': ' );
        Readln( lista[i] );
    end;

    quicksort( 1, z );

    Writeln( 'Array ordinato:' );

    for i := 1 to z do begin
        Write( lista[i] );
    end;

end.
(* ================================================================= *)

640.3.4   Permutazioni

L'algoritmo ricorsivo delle permutazioni è descritto nella sezione 543.4.5.

Una copia di questo file dovrebbe essere disponibile presso <allegati/a2/Permuta.pas>.

(* ================================================================= *)
(* Permuta.pas                                                       *)
(* ================================================================= *)
program Permutazioni;

const   DIM     = 100;

var     lista   : array[1..DIM] of integer;
        i       : integer;
        z       : integer;

(* ================================================================= *)
(* permuta( <ele-inf>, <ele-sup>, <elementi-totali> )                *)
(* ----------------------------------------------------------------- *)
function permuta( a : integer; z : integer; elementi : integer ) : integer;

var     scambio : integer;
        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( 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
                Write( lista[i]:4 );
            end;
            Writeln;
                
        end
    ;   

end;

(* ================================================================= *)
(* Inizio del programma.                                             *)
(* ----------------------------------------------------------------- *)
begin

    Writeln( 'Inserire il numero di elementi.' );
    Writeln( DIM, ' al massimo.' );
    Readln( z );

    if z > DIM then
        begin
            z := DIM;
        end
    ;

    Writeln( 'Inserire i valori dell''array' );

    for i := 1 to z do begin
        Write( 'elemento ', i:2, ': ' );
        Readln( lista[i] );
    end;

    permuta( 1, z, z );

end.

(* ================================================================= *)

Appunti di informatica libera 2008 --- Copyright © 2000-2008 Daniele Giacomini -- <appunti2 (ad) gmail·com>


Dovrebbe essere possibile fare riferimento a questa pagina anche con il nome pascal_esempi_di_programmazione.htm

[successivo] [precedente] [inizio] [fine] [indice generale] [indice ridotto] [indice analitico] [home]

Valid ISO-HTML!

CSS validator!

Gjlg Metamotore e Web Directory