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.