const N = ...; type ELEM = 1..N; {elementi} Sottinsieme = array [ELEM] of boolean; {la componente i-esi e' vera sse i appartiene all'insieme} Relazione = array [ELEM,ELEM] of boolean; {la componente i,j-esima e' vera sse i e' in relazione con j} function Check(R: Relazione; Xp: Sottinsieme): boolean; var x: integer; TROVATO: boolean; {vero sse abbiamo trovato x appartenente ad Xp} {soddisfacente condizione ....} Rstar: Relazione; procedure CHIUSURA(R: Relazione; var Rstar: Relazione); {ritorna in Rstar la chiusura riflessiva e transitiva di R} var x,y,z: ELEM; MODIFICATO: boolean; begin {CHIUSURA} Rstar := R; {se x R y, allora x R* y} for x:= 1 to N do Rstar[x,x]:= true; {x R* x} {se x R* z e z R* y, allora x R* y} MODIFICATO:= true; while MODIFICATO do begin MODIFICATO:= false; for x:= 1 to N do for y:= 1 to N do for z := 1 to N do if ((Rstar[x,z] and Rstar[z,y]) and not Rstar[x,y]) then begin Rstar[x,y]:= true; MODIFICATO:= true end; end; end; {CHIUSURA} function EGIUSTO(x:ELEM; Rstar: Relazione): boolean; {controlla se x soddisfa la condizione ...} var GIUS: boolean; y: ELEM; begin GIUS:= true; y:= 1; while (GIUS and (y è= N)) do begin if Xp[y] {y appartiene a Xp} then if not(Rstar[x,y] and Rstar[y,x]) then GIUS:= false; y:= y+1; end; EGIUSTO:= GIUS; end; {EGIUSTO} begin{Check} CHIUSURA(R,Rstar); x:=1; TROVATO:= false; while ((not TROVATO) and (x <= N)) do if not Xp[x] then x:= x+1 else if EGIUSTO(x,Rstar) then TROVATO:= true; Check:= TROVATO; end; {Check}
function Elev(x: real; n: integer): real; {calcola x alla n} begin if n > 0 then Elev:= x*Elev(x,n-1) else Elev:= 1 end;
function ElevI(x: real; n: integer): real; {calcola x alla n} var E: real; begin E:= 1; while n > 0 do begin E:= E * X; n:= n-1; end; ElevI:= E; end;
procedure P (var f: text;N: integer); {si assume che esista un file sulla memoria di massa di nome FIL} var aux: text; LUN, j: integer; c: char; begin reset(f, 'FIL'); rewrite(aux); while not eof(f) do begin LUN := 0; while ((not eoln(f)) and (LUN < N)) do begin read(f, c); write(aux, c); LUN := LUN + 1; end; if LUN < N then for j := LUN + 1 to N do write(aux, ' '); writeln(aux); readln(f); end; reset(aux); close(f); rewrite(f, 'FIL'); while not eof(aux) do begin while not eoln(aux) do begin read(aux, c); write(f, c) end; readln(aux); writeln(f); end; end;
program PROG; var X, Y, N: integer; procedure P (N: integer); begin if N > 0 then begin if N mod 2 = 0 then X := X + 1 else Y := Y + 1; P(N div 2); end; end; {P} begin readln(N); X := 0; Y := 0; P(N); writeln(X); writeln(Y) end.
program PROG; var X, Y, N: integer; begin readln(N); X := 0; Y := 0; while N > 0 do begin if N mod 2 = 0 then X := X + 1 else Y := Y + 1; N := N div 2; end; writeln(X); writeln(Y) end.
procedure CANCELLA (EFFE, ELLE: string); var N_LINEA, {linea corrente di F} PROSSIMA {numero della prossima linea da cancellare} : integer; F, aux: text; L: file of integer; procedure COPIA_LINEA (var F, G: text); {copia la linea corrent da F a G} var C: char; begin{COPIA_LINEA} while not eoln(F) do begin read(F, C); write(G, C); end; readln(F); writeln(G); end;{COPIA_LINEA} begin {CANCELLA} open(F, EFFE); reset(F); open(L, ELLE); reset(L); rewrite(aux); read(L, PROSSIMA); N_LINEA := 1; while (not eof(F)) do begin if N_LINEA <> PROSSIMA then begin COPIA_LINEA(F, aux); N_LINEA := N_LINEA + 1; end else begin readln(F); if not eof(L) then read(L, PROSSIMA); N_LINEA := N_LINEA + 1; end; end; close(F); open(F, EFFE); rewrite(F); reset(aux); while not eof(aux) do COPIA_LINEA(aux, F); close(F); end; {CANCELLA}
function commutativa (Op: OpBin): boolean; var E_COM: boolean; I, J: integer; begin E_COM := true; I := primo; while (E_COM and (I <= ultimo)) do begin J := primo; while (E_COM and (J &= ultimo)) do if Op[I, J] <> Op[J, I] then E_COM := false else J := J + 1; I := I + 1; end; commutativa := E_COM; end; function associativa (Op: OpBin): boolean; var E_ASS: boolean; I, J, K: integer; begin E_ASS := true; I := primo; while (E_ASS and (I <= ultimo)) do begin J := primo; while (E_ASS and (J <= ultimo)) do begin K := primo; while (E_ASS and (k <= ultimo)) do if Op[Op[I, J], k] <> Op[I, Op[J, k]] then E_ASS := false else k := k + 1; j := j + 1; end; I := I + 1; end; end; procedure prodotto (zero: T; sum, prod: OpBin; A, B: Matrice; var C: Matrice); var I, J, K: 1..N; begin for I := 1 to N do for K := 1 to N do begin C[I, K] := zero; for J := 1 to N do C[I, K] := sum[C[I, K], prod[A[I, J], B[J, K]]] end; end;
procedure TUTTO (NOME_F: string; var MINIMO, MASSIMO, MEDIA: real); var F: file of real; SOMMA, X: real; NUM_EL: integer; begin open(F, NOME_F); reset(F); read(F, MINIMO);(*il file e' sicuramente non vuoto*) MASSIMO := MINIMO; SOMMA := MINIMO; NUM_EL := 1; while not eof(F) do begin read(F, X); if X < MINIMO then MINIMO := X; if X > MASSIMO then MASSIMO := X; SOMMA := SOMMA + X; NUM_EL := NUM_EL + 1; end; MEDIA := SOMMA / NUM_EL; close(F); end;
procedure STAMPA (N: BNAT; var F: text); {stampa N sul file F, mettendo al più 20 cifre su ogni riga} var I: integer; begin {STAMPA} for I := 0 to 5000 - N.PRIMA_C do if I mod 20 = 0 then begin writeln(F); write(F, N.NUM[I + N.PRIMA_C] : 1); end else write(F, N.NUM[I + N.PRIMA_C] : 1); end; {STAMPA} procedure LEGGI (var N: BNAT); {legge N dall'input standard leggendo prima il numero di cifre di N} {e poi le sue cifre partendo dalla piu ' significativa} var I, NCIFRE: integer; begin {LEGGI} writeln('Dammi il numero di cifre'); read(NCIFRE); writeln('dammi le cifre a partire dalla piu'' significativa '); N.PRIMA_C := (5000 - NCIFRE) + 1; for I := 1 to NCIFRE do read(N.NUM[(N.PRIMA_C + I) - 1]); end; {LEGGI} procedure SOMMA (N1, N2: BNAT; var RIS: BNAT); {ritorna in RIS la somma di N1 con N2} var POS_COR, RIP, X: integer; begin {SOMMA} RIP := 0; POS_COR := 5000; {cifre comuni ai due numeri} while ((POS_COR >= N1.PRIMA_C) and (POS_COR >= N2.PRIMA_C)) do begin X := N1.NUM[POS_COR] + N2.NUM[POS_COR] + RIP; RIS.NUM[POS_COR] := X mod 10; RIP := X div 10; POS_COR := POS_COR - 1; end; {cifre di un solo numer0} if N1.PRIMA_C < N2.PRIMA_C then{N1 ha piu' cifre} while (POS_COR >= N1.PRIMA_C) do begin X := N1.NUM[POS_COR] + RIP; RIS.NUM[POS_COR] := X mod 10; RIP := X div 10; POS_COR := POS_COR - 1; end else {N2 ha piu' cifre} while (POS_COR >= N2.PRIMA_C) do begin X := N2.NUM[POS_COR] + RIP; RIS.NUM[POS_COR] := X mod 10; RIP := X div 10; POS_COR := POS_COR - 1; end; {se i due numeri avevano lo stesso numero di cifre, questo if non si fa} if RIP <> 0 then begin RIS.NUM[POS_COR] := RIP; RIS.PRIMA_C := POS_COR; end else RIS.PRIMA_C := POS_COR + 1; end; {SOMMA} procedure PER_CIFRA (N: BNAT; C: CIFRE; var RIS: BNAT); {ritorna in RIS il prodotto di N per la cifra C} var POS_COR, RIP, X: integer; begin {PER_CIFRA} RIP := 0; for POS_COR := 5000 downto N.PRIMA_C do begin X := (C * N.NUM[POS_COR]) + RIP; RIS.NUM[POS_COR] := X mod 10; RIP := X div 10; end; if RIP <> 0 then begin RIS.NUM[N.PRIMA_C - 1] := RIP; RIS.PRIMA_C := N.PRIMA_C - 1 end else RIS.PRIMA_C := N.PRIMA_C; end; {PER_CIFRA} procedure PER_DIECI_MULT (N: BNAT; D: integer; var RIS: BNAT); {ritorna in RIS il prodotto di N per 10 elevato a D, } {si assuma che D sia sempre non negativo } var POS_COR, RIP, X: integer; begin {PER_DIECI_MULT} for POS_COR := 5000 downto (5000 - D) + 1 do RIS.NUM[POS_COR] := 0; for POS_COR := N.PRIMA_C to 5000 do RIS.NUM[POS_COR - D] := N.NUM[POS_COR]; RIS.PRIMA_C := N.PRIMA_C - D; end; {PER_DIECI_MULT} procedure PROD (N1, N2: BNAT; var RIS: BNAT); {ritorna in RIS il prodotto di N1 per N2} var I: integer; AUX, AUX1: BNAT; begin {PRODOTTO} RIS.PRIMA_C := 5000; RIS.NUM[5000] := 0; for I := 5000 downto N2.PRIMA_C do begin PER_CIFRA(N1, N2.NUM[I], AUX); PER_DIECI_MULT(AUX, 5000 - I, AUX1); SOMMA(AUX1, RIS, RIS); end; end; {PRODOTTO}
function APPARTIENE (X: ELEM; S: INSIEME): boolean; (* controlla se X appartiene ad S *) var APP: boolean; I: integer; begin(*APPARTIENE*) APP := false; I := 1; while (I <= S.N_ELEMENTI) and (not APP) do if x = S.ELEMENTI[I] then APP := true else I := I + 1; APPARTIENE := APP; end; (*APPARTIENE*) function CONTENUTO (S1, S2: INSIEME): boolean; (* controlla se S1 e' contenuto in S2 *) var CONT: boolean; I: integer; begin (*APPARTIENE*) CONT := true; I := 1; while (I <= S1.N_ELEMENTI) and CONT do if APPARTIENE(S1.ELEMENTI[I], S2) then I := I + 1 else CONT := false; CONTENUTO := CONT end; (*CONTENUTO*) procedure SINGLETON (X: ELEM; var S: INSIEME); (* ritorna in S l'insieme il cui unico elemento e' X *) begin S.N_ELEMENTI := 1; S.ELEMENTI[1] := x; end; (*SINGLETON*)
procedure MODIFICA (var f: text; N: integer); var COR_LINEA: integer; aux: text; procedure COPIA_LINEA (var F, G: text); {copia la linea corrent da F a G} var C: char; begin{COPIA_LINEA} while not eoln(F) do begin read(F, C); write(G, C); end; readln(F); writeln(G); end;{COPIA_LINEA} procedure COPIA_FILE (var F, G: text); {copia il contenuto di F in G} var C: char; begin{COPIA_FILE} reset(F); rewrite(G, 'FIL'); while not eof(F) do COPIA_LINEA(F, G); end;{COPIA_FILE} begin {MODIFICA} reset(f, 'FIL'); rewrite(aux); COR_LINEA := 1; while not eof(f) do if COR_LINEA mod N <> 0 then begin write(aux, COR_LINEA, ': '); COPIA_LINEA(f, aux); COR_LINEA := COR_LINEA + 1; end else begin writeln(aux, COR_LINEA); COR_LINEA := COR_LINEA + 1; end; close(f); COPIA_FILE(aux, f); end; {MODIFICA}
type VETTORE = file of real; ... function PRODOTTO (var V1, V2: VETTORE): real; var X1, X2, PROD: real; begin {PRODOTTO} reset(V1); reset(V2); PROD := 0; while ((not eof(V1)) and not (eof(V2))) do begin read(V1, X1); read(V2, X2); PROD := PROD + X1 * X2; end; if not (eof(V1) and eof(V2)) then PROD := 0; PRODOTTO := PROD; end; {PRODOTTO}
program Traccia; type T = record a,b: integer end; var x: T; procedure P; begin writeln(x.a,x.b) end; { P } procedure Q(var y: T; var z: integer); type T = record b,a: integer end; var x: T; begin x.a:=z; z:=z+1; *6 P; *7 y.b:=x.a+y.a; *8 end; { Q } begin x.a:=0; x.b:=10; *1 Q(x,x.a); *2 P; *3 Q(x,x.b); *4 P *5 end.
x
contiene 0 10
Q
y
corrisponde alla variabile x
z
alla variabile x.a
*6 modifica x
globale che ora contiene 1 10
*7 scriverà 1 10
*8 modifica x
globale che ora contiene 1 1
1 1
Q
y
corrisponde alla variabile x
z
alla variabile x.b
*6 modifica x
globale che ora contiene 1 2
*7 scriverà 1 2
*8 modifica x
globale che ora contiene 1 2
1 2
1 10
1 1
1 2
1 2
a
è la componente del tipo T2
, come il
primo b
; mentre il secondo b
è un
elemento di tipo T3
.
T1
e T3
rispettivamente).
program B; type CIFRE = '0'..'1'; BINARY = record NCIFRE: 1..100; BCIFRE: array[1..100] of CIFRE end; {i valori di questo tipo corrispondono a rappresentazioni binarie di numeri naturali} {di al piu' 100 cifre; si assuma che la cifra piu' significativa e' la prima} function BIN_NUM (NB: BINARY): integer; {data la rappresentazione binaria di un numero NB, ritorna il numero rappresentato} var N, I: integer; function VAL (C: CIFRE): integer; begin if C = '0' then VAL := 0 else VAL := 1; end; function ELEV_2 (N: integer): integer; begin if N <= 0 then ELEV_2 := 1 else ELEV_2 := 2 * ELEV_2(N - 1); end; begin N := 0; for I := 1 to NB.NCIFRE do N := N + (VAL(NB.BCIFRE[I]) * ELEV_2(NB.NCIFRE - I)); BIN_NUM := N; end;{BIN_NUM} procedure NUM_BIN (N: integer; var NB: BINARY); {dato un numero N ritorna in NB la sua rappresentazione binaria} var NCIF, I: integer; CIFR: array[1..100] of CIFRE; begin NCIF := 1; while N >= 2 do begin if Odd(N) then CIFR[NCIF] := '1' else CIFR[NCIF] := '0'; N := N div 2; NCIF := NCIF + 1; end; if Odd(N) then CIFR[NCIF] := '1' else CIFR[NCIF] := '0'; for I := NCIF downto 1 do NB.BCIFRE[I] := CIFR[(NCIF - I) + 1]; NB.NCIFRE := NCIF; end;
N=5 Ric
ritorna 2
Ric(5) = Ric(3)+Ric(2) =
Ric(1)+Ric(0)+Ric(2) = 1+ 0 + 1 = 2
)
Per N=7 Ric
ritorna 4
(Ric(7) = Ric(5)+Ric(4) =
Ric(5)+Ric(2)+Ric(1) = 2+ 1 + 1 = 4
)
function RicI (N: integer): integer; var R, I, MENO1, MENO2, MENO3: integer; begin if N <= 0 then R := 0 else if (N = 1) or (N = 2) then R := 1 else begin I := 3; MENO1 := 1; MENO2 := 1; MENO3 := 0; R := 1; while I < N do begin MENO3 := MENO2; MENO2 := MENO1; MENO1 := R; R := MENO2 + MENO3; I := I + 1; end; end; RicI := R; end;
Presente
non è uno statement, occorre assegnare dei
valori a tale identificatore.
function Presente(var A: array [1..n] of real; i,j: 1..n; x: real): Boolean; var k: 1..n; begin k:=(i+j) mod 2; if Presente(A,i,k,x) then Presente:= true else if Presente(A,k,j,x) then Presente:= true else Presente:=false; end; { Presente }A questo punto è sintatticamente corretta.
In esecuzione darà un errore la prima assegnazione (k non
può assumere il valore 0).
Occorre mettere div
al posto di mod.
Non è stata prevista una "base" per la ricorsione e quindi la funzione va in loop.
La funzione corretta è
function Presente(var A: array [1..n] of real; i,j: 1..n; x: real): Boolean; var k: 1..n; begin if i = j then Presente := A[i] = x else if j = i + 1 then Presente := ((A[i] = x) or (A[j] = x)) else begin k := (i + j) div 2; if Presente(A, i, k, x) then Presente := true else if Presente(A, k, j, x) then Presente := true else Presente := false; end; end; { Presente }
program Stampa; var x: integer; procedure P1; begin writeln(x) end; procedure P2(var y: integer); var x: integer; procedure P3(var z: integer); begin z := y+1 end; begin {*3} x := 0; {*4} P1; {*5} P3(x); {*6} P1; {*7} P3(y); {*8} P1 end; {P2} begin x := 0; {*1} P2(x); {*2} P1 end.
{*1}
x[alias y) = 0
{*3}
x[alias y] = 0 x(interno)=0
{*4}
x[alias y] = 0 x(interno)=0
scriverà 0
{*5}
x[alias y] = 0 x(interno)=1
{*6}
x[alias y] = 0 x(interno)=1
scriverà 0
{*7}
x[alias y] = 1 x(interno)=1
{*8}
x = 0 x(interno)=1 y = 1
scriverà 1
{*2}
x = 1
scriverà 1
0 0 1 1
.
program Stampa; var x: integer; procedure P1(var x:integer); begin x := x + 1 end; procedure P2(x:integer); begin x := x+10; P1(x); writeln(x) end; begin x := 0; {1} P1(x); {2} writeln(x); {3} P2(x); {4} writeln(x) {5} end.
{1} x=0
{2} x=1
{3} x=1
scriverà 1
{4} x=1
scriverà 12
{5} x=1
scriverà 1
k
non è dichiarata e va sostituita
dalla costante n
.
x
appartiene a
V
il test {*}
può essere falso;
inoltre se x
non appartiene a
V
in {**}
V[n+1]
non esiste.
La versione corretta della funzione è:
function Member(var x: real; var V: vettore): boolean; {ritorna false se x non compare in V altrimenti true} var i: integer; PRES: boolean; begin Pres:= false; i := 1; while (not Pres) and (i <= n) do if V[i]=x then Pres:=true else i := i+1; Member := Pres; end; {Member}
function Present (x: Elem; var S: Insieme): Boolean; {true se l'insieme S contiene l'elemento x} var aux: Insieme; Pres: boolean; Y: Elem; begin {Present} COPIA(S, aux); reset(aux); Pres := false; while (not eof(aux)) and (not Pres) do begin read(aux, y); if y = x then Pres := true; end; Present := Pres; end; {Present} procedure Difference (var S1, S2, S: Insieme); {ad S e' assegnato l'insieme S1 a cui sono stati tolti gli elementi in S2} var x: Elem; begin {Difference} rewrite(S); reset(S1); while not (eof(S1)) do begin read(S1, x); if not Present(x, S2) then write(S, x); end; end; {Difference}
program Stampa; const n = 2; type I = 1..n; A = array[I] of I; var a1, a2: A; i1: I; procedure Stampa (var a1: A); var i1: I; begin for i1 := 1 to n do write(a1[i1]); writeln end; procedure Init (var a1: A); var i1: I; begin for i1 := 1 to n do a1[i1] := i1 end; procedure Op1 (var a1, a2: A; i1: I); var i2: I; begin a2[1] := a1[i1]; {5} for i2 := 2 to n do a2[i2] := a1[a2[i2 - 1]] {6} end; procedure Op2 (var a1, a2: A); var i1: I; begin for i1 := 1 to n do a2[i1] := a2[a1[i1]]; {11} end; begin Init(a1); {1} Init(a2); {2} Stampa(a1); {3} Op1(a1,a1,1); {4} Stampa(a1); {7} Op1(a2, a2, 2); {8} Stampa(a2); {9} Op2(a1, a2); {10} Stampa(a2) {12} end.
{1} a1=(1,2)
{2} a1=(1,2) a2=(1,2)
{3} a1=(1,2) a2=(1,2) stamperà 1 2
{4} a1[alias a1][alias a2]=(1,2) a2[non visibile]=(1,2) i1=1 i2=?
{5} a1[alias a1][alias a2]=(1,2) a2[non visibile]=(1,2) i1=1 i2=?
{6} a1[alias a1][alias a2]=(1,1) a2[non visibile]=(1,2) i1=1 i2=?
{7} a1=(1,1) a2=(1,2) stamperà 1 1
{8} a1[non visibile]=(1,1) a2[alias a1][alias a2]=(1,2) i1=2 i2=?
{5} a1[non visibile]=(1,1) a2[alias a1][alias a2]=(2,2) i1=2 i2=?
{6} a1[non visibile]=(1,1) a2[alias a1][alias a2]=(2,2) i1=2 i2=?
{9} a1=(1,1) a2=(2,2) stamperà 2 2
{10} a1[alias a1]=(1,1) a2[alias a2]=(2,2) i1=2 i2=?
{11} a1[alias a1]=(1,1) a2[alias a2]=(2,2) i1=2 i2=?
{12} a1=(1,1) a2=(2,2) stamperà 2 2
program Endofunzioni; const n = ...; {cardinalita' di X} type X = 1..n; Fun = array[X] of X; procedure Moltiplicazione (f, g: Fun; var h: Fun); {h:=la composizione di f e g, cioe' h(x)=g(f(x))} var I: X; begin {Moltiplicazione} for I := 1 to n do h[I] := g[f[I]]; end; {Moltiplicazione} procedure Unita (var f: Fun); {f:=identita' su X} var I: X; begin {Unita} for I := 1 to n do f[I] := I; end; {Unita} function Invertibile (f: Fun): Boolean; {Invertibile(f) sse f è invertibile} var I, J: integer; Inv: boolean; begin {Invertibile} Inv := true; I := 0; while (I < n) and Inv do begin I := I + 1; J := I; while (J < n) and Inv do begin J := J + 1; if f[I] = f[J] then Inv := false; end; end; Invertibile := Inv; end; {Invertibile} procedure Inversa (f: Fun; var g: Fun); {g:=l'inversa di f, se esiste} var I: X; begin {Inversa} for I := 1 to n do g[f[I]] := I; end; {Inversa}
program ESEMPIO1; const N = 10; type VECTOR = array[1..N] of integer; var I: integer; A, B, C: VECTOR; procedure SX (A, B: VECTOR; var C: VECTOR); var J: integer; begin for J := 1 to N do if J mod 2 = 0 then C[J] := A[J] else C[J] := B[J] {3} end; {SX} procedure PR (A: VECTOR); var H: integer; begin for H := 1 to N do begin if (H - 1) mod 2 = 0 then writeln; write(A[H]); write(' '); end; {5} end; {PR} begin for I := 1 to N do A[I] := I; for I := N downto 1 do B[I] := I; {1} SX(A, B, C); {2} PR(C); {4} SX(B, A, C); {6} PR(C) {7} end.{1} A=(1,2,3,4,5,6,7,8,9,10) B=(1,2,3,4,5,6,7,8,9,10) C =?
1 2 3 4 5 6 7 8 9 10{6} A[globale, non visibile]=(1,2,3,4,5,6,7,8,9,10) B[globale, non visibile]=(1,2,3,4,5,6,7,8,9,10) C[globale][alias C]=(1,2,3,4,5,6,7,8,9,10)
1 2 3 4 5 6 7 8 9 10
program GREP; const SL = 5; var L_LUNG: 0..180; {lunghezza della linea corrente} LINEA: array[1..180] of char; STRINGA: array[1..Sl] of char; F: text; APPARE: boolean; I: integer; procedure LEGGI_LINEA; var I: integer; begin L_LUNG := 0; while not eoln(F) do begin L_LUNG := L_LUNG + 1; read(F, LINEA[L_LUNG]); end; readln(F); end; procedure SCRIVI_LINEA; var I: integer; begin for I := 1 to L_LUNG do write(LINEA[I]); writeln; end; function APPARE_IN (I: integer): boolean; var J: integer; CE: boolean; begin CE := true; for J := 1 to SL do if LINEA[(J + I) - 1] <> STRINGA[J] then CE := false; APPARE_IN := CE; end; begin {LEGGO LA STRINGA} for I := 1 to SL do read(STRINGA[I]); open(F, 'SCHEDARIO'); reset(F); while not eof(F) do begin LEGGI_LINEA; APPARE := false; I := 1; while not (APPARE) and (I <= L_LUNG - 5) do if APPARE_IN(I) then APPARE := true else I := I + 1; if APPARE then SCRIVI_LINEA; end; close(F); writeln('FINITO'); end.
procedure RIDOTTO (VM: V_MATRICI; I, J: INDICI; var RID: V_MATRICI); {ritorna in RID il ridotto di VM rispetto alla riga I ed alla colonna J,} {se I e J sono una riga ed una colonna di VM, altrimenti stampa un messaggio} {di errore sull'output standard} var I1, J1: integer; begin if (I <= VM.N) and (J <= VM.M) then begin {1 QUARTO} for I1 := 1 to I - 1 do for J1 := 1 to J - 1 do RID.MAT[I1, J1] := VM.MAT[I1, J1]; {2 QUARTO} for I1 := 1 to I - 1 do for J1 := J + 1 to VM.M do RID.MAT[I1, J1 - 1] := VM.MAT[I1, J1]; {3 QUARTO} for I1 := I + 1 to VM.N do for J1 := 1 to J - 1 do RID.MAT[I1 - 1, J1] := VM.MAT[I1, J1]; {4 QUARTO} for I1 := I + 1 to VM.N do for J1 := J + 1 to VM.M do RID.MAT[I1 - 1, J1 - 1] := VM.MAT[I1, J1]; RID.N := VM.N - 1; RID.M := VM.M - 1; end else writeln('Indici errati'); end; function DET (VM: V_MATRICI): integer; {calcola il determinante di VM} var I, J, K: integer; D: integer; VM1: V_MATRICI; begin D := 0; if VM.M = 1 then D := VM.MAT[1, 1] else for I := 1 to VM.N do begin for J := 1 to I - 1 do for K := 1 to VM.M - 1 do VM1.MAT[J, K] := VM.MAT[J, K + 1]; for J := I + 1 to VM.N do for K := 1 to VM.M - 1 do VM1.MAT[J - 1, K] := VM.MAT[J, K + 1]; VM1.N := VM.N - 1; VM1.M := VM.M - 1; D := D + VM.MAT[i, 1] * DET(VM1); end; DET := D; end; procedure PRODOTTO (VM1, VM2: V_MATRICI; var VM: V_MATRICI); {ritorna in VM il prodotto di VM1 con VM2, se le dimensioni} {sono corrette, altrimenti stampa un messaggio di errore sull'output standard} var I, J, K: INDICI; begin if VM1.M <> VM2.N then writeln('Le matrici non possono essere moltiplicate') else for I := 1 to DIM do for J := 1 to DIM do begin VM.MAT[I, J] := 0; for K := 1 to VM1.M do VM.MAT[I, J] := VM.MAT[I, J] + (VM1.MAT[I, K] * VM2.MAT[K, J]); end; end;
program ES3; type PAROLA = array[1..10] of integer; var F, G: file of PAROLA; X: integer; A, B: PAROLA; function SUM (A: PAROLA): integer; var I, X: integer; begin X:=0; for I := 1 to 10 do X := X + A[I]; SUM:=X; end; begin X := 0; open(F, 'FF'); open(G, 'GG'); while not eof(F) do begin read(F, A); if not eof(F) then read(F, A); if SUM(A) >= 0 then write(G, A) end; close(F); close(G); open(F, 'FF '); open(G, 'GG'); while not eof(G) do begin read(G, B); if SUM(B) >= 0 then write(F, B) end; close(F); close(G); end.Quello senza funzioni/procedure è:
program ES3; type PAROLA = array[1..10] of integer; var F, G: file of PAROLA; X: integer; A, B: PAROLA; begin X := 0; open(F, 'FF'); open(G, 'GG'); while not eof(F) do begin read(F, A); if not eof(F) then read(F, A); X:=0; for I := 1 to 10 do X := X + A[I]; if X >= 0 then write(G, A) end; close(F); close(G); open(F, 'FF '); open(G, 'GG'); while not eof(G) do begin read(G, B); X:=0; for I := 1 to 10 do X := X + B[I]; if X >= 0 then write(F, B) end; close(F); close(G); end.
program ES3; type PAROLA = array[1..10] of integer; var F, G: file of PAROLA; X: integer; A, B: PAROLA; procedure SUM (A: PAROLA;var X:integer); var I: integer; begin X:=0; for I := 1 to 10 do X := X + A[I]; end; begin X := 0; open(F, 'FF'); open(G, 'GG'); while not eof(F) do begin read(F, A); if not eof(F) then read(F, A); SUM(A,X); if X >= 0 then write(G, A) end; close(F); close(G); open(F, 'FF '); open(G, 'GG'); while not eof(G) do begin read(G, B); SUM(B,X); if X >= 0 then write(F, B) end; close(F); close(G); end.