8/2/2019 exercice Pascale
1/128
1 1
:
wazzz
V3.0
Not compiled
[emailprotected]
8/2/2019 exercice Pascale
2/128
1 2
:
1
.
Chars
Arrays
Recursion
Advanced Numeric
1
1
8/2/2019 exercice Pascale
3/128
1 3
:1 1:
T.Pascal
Program Calc ;Var x,y:integer;
BeginWriteln(Enter Two number );Readln(x,y);
Writeln(The Result of ,x, +,y, =,x+y);Writeln(The Result of ,x,*,y, =,x*y);Writeln(The Result of ,x, -,y, =,x-y);Writeln(TheResult of ,x, /,y, =,x/y);
End.
2:
T.pascal X n
Xn
Program Power_To_ppl ;Var x,n,i,Res:integer;
BeginRes =:1;Writeln(Enter Two numbers X, and n );Readln(x,n)Fori=1 to n do
Res =Res *X;
Writeln(The Result is ,Res);End.
8/2/2019 exercice Pascale
4/128
1 4
3:
12344321
Program Flip_Flop ;Var n,m,num:integer;BeginWriteln(Enter TheNumber );Readln(n);while (n div 10 0 )dobegin
m =:n mod 10;num =:m+num*10;n =:n div 10;
end;
Writeln(The Number After Flipping ,n);end.
4:
ex
Program Damn_The_e ;Var x,n,i,counter :integer;
Power,fact ,res:realBeginfact =:1; counter=2; res=0;Writeln(Enter Two numbers X );Readln(x);Power=x;
While (power div fact < 10 ^(-5)) dobegin
For i=2 to counter dobegin
power =power *X;fact = fact *i;
end;Counter = counter +1;Power =x; fact= 1;
Res= Res + (power div fact);End;Writeln(The Result is,Res);End.
8/2/2019 exercice Pascale
5/128
1 5
:5
1-A,B
A,B.
2-Nn.
3-m
.
program Numberz;var
Digit_counter,m, i,a,b,min,max,sum,first,last:integer;
beginReadln(a,b);If (a>b)then
Max =a; min =bElse
max=b; min =afirst=min ; last =maxwhile (first
8/2/2019 exercice Pascale
6/128
1 6
:6
1-
sumyear..
()
p%2-
sum
()p%
..
program Banks;var i,num,year,value:integer;p :float ;
begin1:Readln(year,num,p)For i=1 to year do
Num = num + Num *p;2:Y=0; Value =2*num;While (num
8/2/2019 exercice Pascale
7/128
1 7
7
:
N
qunit price
:
10%
25000
15%
50000
20%
100000
:
:
total price(.)
net price(.)
program Bills ;
var N,q,Unit_price,Total,net_price :integer;q=0; Unit_price=0 ;Total =0; net_price=0 ;Readln(n);For i =1 to n do
beginWriteln(Enter the price for the product num,i);Readln(Unit_price);Writeln(Enter the Quantity for the productnum ,i);Readln(q);Total = total +q* unit_price;
End;If (tp> 100000)
Netprice = (total * 20)/100;Else If (tp> 50000 )
Netprice = (total * 15)/100;Else If (tp> 25000)
Netprice = (total * 10)/100;
writeln(Netprice, , total );end.
8/2/2019 exercice Pascale
8/128
1 8
8:
(.):
1-
2-
-3
4- =n-9 10
program Reading with the stars ;var ch,ch1 : char;
countchr: integer; // Char countercountnum: integer; // NumbersCountercounter3: integer; // Other Char Counter
beginwriteln('Enter the text');
countchr:=0; countnum:=0; counter3:=0;while (ch '.') do
beginch1:=ch;read (ch);
case ch of'0'..'9' :
beginch:=chr(ord('9')-ord(ch) + ord('0') ) ; //ConvertingNumbercountnum:=countnum+1;
end;'a'..'z':
begincountchr:= countchr+1;ch:=chr(ord('A')+ord(ch)-ord('a'));// Converting to Capital
end;
if (ch1 = ' ') or (ch1= ',') or (ch1= ' " ')thencounter3:=counter3+1;
end; // Whilewrite(ch);
end;
writeln('The number of the letters =',countchr);writeln('Thenumber of numbers are = ',countnum);writeln('Number of the symbols= ',counter3+countnum+countchr);
end. // End of program
8/2/2019 exercice Pascale
9/128
1 9
9:
TrueFalse
n
N=92 7 5 6 4 6 5 7 2
N=827566572
765211
program Semitic _Arrays;
const maxn=100;
var A:array [1..maxn]of integer;b:boolean;
n:integer;i:integer;
beginwriteln('Please enter the Array Length');readln(n);writeln('Please enter the elements so The Array can beinitialized );
For i:=1 to n doreadln(A[i]);
b:=true;For i:=1 to n do
if (A[i]A[n-i+1]) thenb:=false;
if (b=true) thenwriteln('The matrix is Semitic );
else if (b=false) thenwriteln('The matrix is not Semitic );
readln;end.
8/2/2019 exercice Pascale
10/128
1 10
10:
:
1-
2- 3 :
3-
= +
4-
:
5-
8/2/2019 exercice Pascale
11/128
1 11
Program employee ;Const m=100;Type Matrix =array[1..m] ofinteger;
VarNum,basic,comp,dis,total:matrix;I,j,max1,max2,min,sum,x,y,z:integer;Avg:real
Begin {main }Writeln(Please Enter the whole numbers ofemployees);Readln(z);Writeln(Please Enter the number of theemployee);
For j =1 to z dobegin
Readln(Num[j]);End;
Writeln(Please Enter the basic Salary for each employee);For j=1to z dobegin
Readln(Basic[j]);End;
Writeln(Plz Enter the compensations for each employee);For j=1to z dobegin
Readln(Comp[j])End;
Writeln(Please Enter the Discounts for each employee);For j=1 toz do
beginReadln(Dis[j]);
End;
For j=1 to z doTotal[j]=Basic[j]+Comp[j]-Dis[j]
Writeln(employee No Basic Salary Bounces Discounts Total);Writeln;
For j=1 to z doBeginWrite(Num[j]:5, ,Basic[j]:5, ,Comp[j]:5,,Dis[j]:5, ,Total[j]:5);Writeln;
End;
8/2/2019 exercice Pascale
12/128
1 12
Max1=Basic[1];
Mx2=Comp[1];
X=num[1];
Y =num[1];
Min=dis[1];
Sum=0;
For j=1 to z doBeginIf Basic[j]>max1 then
Max1=Basic[j];
If comp[j]>max2 thenbegin
Max2= comp[j];X=num[j];
End;
If dis[j]
8/2/2019 exercice Pascale
13/128
1 13
11:
n.n n
1-
2-
m 3-
4-
program Matrix ;const z= 100;var A: array [1..z,1..z]ofinteger;
B: array [1..z,1..z]of integer;t, v,m,sumv, sum1,sum2,n,i,j:integer;
f,k,l, sumq1, sumq2, summ, sumrec, sum, sum11,sum22:integer;
g:boolean;beginwriteln('Enter the length of thearray');readln(n);
{reading the Array}for i:=1 to n do
for j:=1 to n doreadln(A[i,j]);
//
sum1:=0;for i:=1 to n dosum1:=(sum1+A[i,1]);
sum11:=0;
for i:=1 to n dosum11:=sum11+A[i,n];
sum2:=0;for j:=1 to n do
sum2:=(sum2+A[1,j]);
sum22:=0;for j:=1 to n do
sum22:=sum22+A[n,j];
//sum:=sum1+sum11+sum22+sum2-A[1,1]-A[1,n]-A[n,n]-A[n,1];writeln('thesum of the circumfence is',sum);
//
for i:=1 to n do
beginwrite(' ');
for j:=1 to n dowrite(A[i,j],' ');writeln(' ');
8/2/2019 exercice Pascale
14/128
1 14
end;
writeln('Enter m number of lines to show u thesum');readln(m);if (m>n) or (mn) doreadln(m)
endelse v:=n-m;
for j:=v+1 to n dofor i:=1 to n do
sumv:=sumv+A[j,i];writeln('the sum of the last ',m,' lines is',sumv);
// 3
f:=2; sumrec:=0;for i:=1 to n do
beginfor j:=f to n do
sumrec:=sumrec+A[i,j];f:=f+1;
end;
writeln('the sum for the rectangle is ',sumrec);
for f := 1 to n-1 dobegin
j:= n;for i := 1 to n-f do
beginif a[i,j] < a[i+1,j-1] then
begint := a[i,j];a[i,j] := a[i+1,j-1];
a[i+1,j-1] := t;end;
j:= j-1end;
end;for i := 1 to n do
beginwriteln(' ');for j := 1 to n dowrite(a[i,j] , '');writeln(' ');
end;readln;end.
End.
8/2/2019 exercice Pascale
15/128
1 15
12:
1- n
2-
3-
4-
program Matrix_part2;type mat=array[1..10,1..10]of integer;vara:mat;
n,i,j,max:integer;ok:boolean;
{1}
function simitric(n:integer):boolean;vari,j:integer;error:boolean;
begini:=1;error:=false;while (i
8/2/2019 exercice Pascale
16/128
1 16
{3}
function max2(n:integer):integer;var i,j,max:integer;
beginmax:=a[1,1];for i:= 1 to n do
for j:=1 to n doif a[i,j]>max then
max:=a[i,j];max2:=max;
end;
{ end fo function max2}
{4}begin {main program}writeln('please inter long thematrix');readln(n);for i:=1 to n do
for j:=1 to n doreadln(a[i,j]);
ok:=simitric(n);if ok=true then
writeln('the matrix is simitric')else
writeln('the matrix is not simitric');
max1(n,max);writeln('the max value in the simitric matrix byprocedure =',max);
writeln('the max value in the simitric by function =',max2(n));writeln;for i:=1 to n do
beginfor j:=1 to n do
write(a[i,j],' ');writeln;
end;readln;End.
8/2/2019 exercice Pascale
17/128
1 17
13:
1-
0-9 *-+ -2
0-9 *+-
3-
: 1
2
2
2program MatExp;
typePStack=^Element;Element=recordval:string;prev:PStack;end;
vara:string;x,c:char;
elem:Element;n,n1,n2,b:integer;top,auxtop,ptop,Rtop:PStack;
procedure Push(var ptop:PStack;elem:Element);vartemp:PStack;begin
new(temp);temp^:=elem;temp^.prev:=ptop;ptop:=temp;
end;
8/2/2019 exercice Pascale
18/128
1 18
procedure Clear(var ptop:PStack);
vartemp:PStack;begin
while (ptopnil) dobegin
temp:=ptop;ptop:=ptop^.prev;
dispose(temp);end;
end;
function StrToIntConvert(a:string;n:integer):integer;varconc,i,j,s:integer;begin
conc:=0;j:=1;while (j
8/2/2019 exercice Pascale
19/128
1 19
functionIntToStrConvert(b:integer):string;vart,c,i,n,d:integer;
s:string;begint:=b;n:=0;
while (t0) dobegin
t:=t div 10;n:=n+1;
end;c:=1;
for i:=2 to n doc:=c*10;
i:=1;s:=' ';while (i
8/2/2019 exercice Pascale
20/128
1 20
bo:=false;end;Combine:=s;
end;
procedure Transfer(vartop,auxtop:PStack);vard,Ssum:string;temp,temp1:PStack;check1,check2:boolean;num1,num2,sum:integer;begintemp:=top;while(tempnil) dobeginif (temp^.val='(') thenbegin
temp1:=temp^.prev;check1:=true;check2:=false;while(temp1^.val')') and (check1) dobeginif (temp1^.val='(') then
check1:=false;if ((temp1^.val ='+') or (temp1^.val='*'))thencheck2:=true;
temp1:=temp1^.prev;end;
if (check1) and (check2) thenbegintemp:=temp^.prev;
sum:=0;while (temp^.val')') dobeginif ((temp^.val'+') and(temp^.val'*'))thenbegind:=Combine(temp);num1:=StrToIntConvert(d,length(d));temp:=temp^.prev;c:=temp^.val[1];
temp:=temp^.prev;d:=Combine(temp);num2:=StrToIntConvert(d,length(d));sum:=Calc(num1,num2,c);temp:=temp^.prev;
8/2/2019 exercice Pascale
21/128
1 21
endelsebeginnum1:=sum;
c:=temp^.val[1];temp:=temp^.prev;d:=Combine(temp);num2:=StrToIntConvert(d,length(d));sum:=Calc(num1,num2,c);temp:=temp^.prev;end;
end;Ssum:=IntToStrConvert(sum);elem.val:=Ssum;push(auxtop,elem);endelsepush(auxtop,temp^);
endelsepush(auxtop,temp^);
temp:=temp^.prev;end;
clear(top);end;
procedure AuxTransfer(vartop,auxtop:PStack);vartemp:PStack;begintemp:=auxtop;while (tempnil)do
beginpush(top,temp^);temp:=temp^.prev;
end;clear(auxtop);end;
8/2/2019 exercice Pascale
22/128
1 22
Begintop:=nil;Rtop:=nil;
auxtop:=nil;
writeln(plz insert a mathematical expression between parenthesesand ending with "." ');read(x);
while (x'.') dobeginelem.val:=x;push(Rtop,elem);read(x);end;
AuxTransfer(top,Rtop);
while (top^.prevnil)dobeginTransfer(top,auxtop);AuxTransfer(top,auxtop);end;
writeln;writeln('after calculating ... the conclusion = ',top^.val);
readln;readln;
End.
8/2/2019 exercice Pascale
23/128
1 23
1:
4
Read ( a,b,c,d )If (a >b ) then
Max1 =a;Else
Max1=b;If (c>d)then
Max2=c;Else
Max2= d;If (max2 >max1 )
Max1 = Max2Writeln( Max1)
if
else if
If (a>b ) And (a>c ) And (a>d) then
Max =aElse if (b>c) And (b>d) then
Max =bElse if (c>d)
Max=cElse max=dWriteln(max)
2:
10
Readln(n)While (n 10 ) do
Writeln(n);Readln(n);
break
While (true)Readln(n)If (n = 10)
BreakWriteln(n)
8/2/2019 exercice Pascale
24/128
1 24
3:
a=3b=2a=2b=3
: 3
Temp = a;a=b;b=Temp;
:
a =a-bb =a+ba =b-a
A =:a-b A =3-2=1 Temp=a Temp=3
B =:a+b B =1+2=3 A=b A=2
A =:b-a A =3-1=2 B=temp B = 3
4:
29
28
,
4 ,
400
19961940200 19951969
19001800 .
Readln( year )
Isleap= false;If (year mod 4 = 0 )then
If (year mod 400 =0 )thenIsleap= true
ElseIf (year mod 100 =0 )then
Isleap=false;Else isleap=true;
Else
Isleap = false
4400=
4
400
100=
4
400100=
8/2/2019 exercice Pascale
25/128
1 25
5:
A
p y
y
Read A,p,yC=1While (c
8/2/2019 exercice Pascale
26/128
1 26
9:
X
n x,n
Res =:1;Readln(x,n)For i=1 to n do
Res =Res *X;
Writeln(Res);
10:
1100
Sum=0For i =1 to 100 do
Sum = sum +i
Writeln(sum)
11:
n 110
Readln(n)For i=0 to 10 do
Prod =n *iWriteln( prod)
12:
110
1 2
For i =1 to 10 do
For j = 1 to 10 dobeginProd= i*jWriteln(prod)
end;
13:
Readln(m,n)
mult=:0;For i=:1 to n doMult=:Mult+m;
Writeln(mult)
8/2/2019 exercice Pascale
27/128
1 27
14:
19892007
112
1b
b
31 3029
Cyear =false
Between = falseRead a,b // yearsWhile not (between ) do
Read (year )If (year >=a ) and (year =1 ) and (month =1 andday
8/2/2019 exercice Pascale
28/128
1 28
15:
Readm,n; sub=:1;repeat
sub =sub+1;m =m-n;
until )m-n 0(Writeln)The result is ,sub(;
16:
n :
:
7
1
Readln)num(; j=0;While )j
8/2/2019 exercice Pascale
29/128
1 29
17:
Readln n ; sum=:0;
for i=:1 to n dobeginReadlnm;if i+1=n then
sum=:sum+m;end;
writeln(sum)
Sum=0,m=0;C :srting
While ( c no ) dobegin
Writeln(Do u want to read a number )Readln(c)Sum2=m; // The oldvalue of mIf c=yes then
Readln(m)Sum2=m;
Else
Sum =sum1 +sum2;End;
18:
n
Readln n ;Writeln)1(;for i=:2 to n do
for j=:i downto 2 dowrite)j:4(;
for j=:1 to i do
write)j:)4((;
8/2/2019 exercice Pascale
30/128
1 30
19:
- 10 10-100
:
10
var A :array]1..10 [of integer;i=:1;while i=10 & m
8/2/2019 exercice Pascale
31/128
1 31
20:
:12177211
num,mid=0,n2,digits,last,first,n1=0,res : integer;readlnnum;first =num mod 10;n2 =num; digits =1;
while) n2 div 10 0 (dobegin
Digits = digits +1;
n2 =n2 div 10;last =n2;end
n2 =num div 10;int digit_counter =1;
for) i=1 to digits-2 (dobegin
mid =n2 mod 10 * powf)10,digit_counter(;n1 =n1+mid;n2 =n2 div10;digit_counter=digit_counter+1 ;
end
for) m=1 to digits-1 (dofirst =first*10;
res =last+first+n1;Writeln )res (
mod10
1234
4
1234
1000
1
4000
+1
+
230
digit_counter
8/2/2019 exercice Pascale
32/128
1 32
21:
Function Number_digit )n:integer(integer;Vardigit:integer;BeginDigit=:0;While n div 1o 0 do
begindigit =:digit+1;n=:n div 10
end;end;
22:
Readln nfirst=:n mod 10;while n 0 dobegin
last=:n div 10n=:n div 10
end;if first =last then write first,last ;
23:
m ::m=8
sum=1-2+3-4+5-6+7-8
Read mFor k=:1 to n do
If k mod 2 =0 thenSum=:sum-k;
Elsesum=:sum+k;
8/2/2019 exercice Pascale
33/128
1 33
24:
,,
h:m:s
program time;varhour,min,sec,temp,temp2,day,t:longint;
beginwriteln)'enter your time in the form ofseconds'(;Readln)t(;sec=:t mod 60;temp=:t div 60;min=:temp mod60;temp2=:temp div 60;hour=:temp2 mod 24;day=:temp2 div24;writeln)'day=',day,' hour=',hour,' min=',min,'sec',sec(;readln;end .
Function getTime)seconds :LongInt (: String;Var
H, M, S :Integer;
BeginH =:seconds div 3600;seconds =:seconds mod 3600;M =:secondsdiv 60;S =:seconds mod 60;getTime =:IntToStr)H (+ ':' +IntToStr)M(+ ':' +IntToStr)S(;
End;
8/2/2019 exercice Pascale
34/128
1 34
25:
:
1-1-2-3-5-8-13-21-34..
x=0;y=1for i=2 to n-1 do
begintemp=y
y=y+xx=tempend
26
:
164 164 1+3+5+7
8/2/2019 exercice Pascale
35/128
1 35
Char
:
9
Ch=:chr)ord)0) n+n ord)9) n-n ord)ch));
10
Ch=:chr)ord)0) n+n ord)9) n-n ord)ch) n+n 1(;
n
X=:n-9Ch=:chr)ord)0( + ord)9) - ord)ch) + x(
0 ord 100
Ord0100
....
Ord9109
a..z
ch=:chr)ord)A +( ord)a -( ord)ch((;
ch=:chr)ord)Z (n-n ord)z ( n+n ord)ch((;
A..ZCh=chr(-ord(a) +ord(A) +ord(ch));
8/2/2019 exercice Pascale
36/128
1 36
1:
: a,u,e,o,i
S:stringfor i=1 to length)s (doif ord)s]i [>A ( andord)s]i[
8/2/2019 exercice Pascale
37/128
1 37
3:
Write s]1]n
:n
4for j=2 to length)s(doif s]j]n=n then
write)s]i+1]n:n4(
4:
)
For i =1 to length (s) div2 dobegin
If S[i] = S[length (s)i+1] thenIs_semtirc =true;
ElseBeginIs_semtirc =false ;Break;
End;End;
8/2/2019 exercice Pascale
38/128
1 38
5:
For i =1 to length (s) do If S[i] = then {space }
First =iIf S[length (s)i+1 ] = then {space }
Last = length (s)i+1
First _temp_word = first;For i = first to last doIf S[i] = then{space }
beginLast_temp_word = i;For j= First _temp_word toLast_temp_word div 2 do
S[j]= S [Last_temp_wordj +1]First _temp_word= i+1;
End;
6:
First=1;For i =1 to length (s) do
If S[i] = then {space }Begin
Last =i;Writeln(S[first+last /2] )First =i+1
End;
8/2/2019 exercice Pascale
39/128
1 39
7:
i=1for j=1 to length)s(
if i mod 2=o then
beginif ord)s]i([>a ( and ord)s]i [A (and ord)s[]i[
8/2/2019 exercice Pascale
40/128
1 40
8:
( )
: .dido odid.
A:array ]1..100 [of charC:charRepeatRead c
A]i] =cI=:i+1;
Until c=.For j=:I downto 1 do
Write)A]i:[4(
program paragraph )input,output (;constn =10;
vara :array]1..n [of char;i:integer;m:char;
beginreadm ;writeln )' Please enter the text in order to reverseit' (;i=:1 ;
while )m ' .' (and )in(dobegin
a]i =: [m;
read m ;i =:i+1;
end;for i=:n downto 1 dobeginwrite)a]i ([;
end;readln; readln;
end.
8/2/2019 exercice Pascale
41/128
1 41
9:
(string)
).(
(
)..
program test;typevect=array]'a'..'z'[of integer;var j:char;max,i:integer; s:string; a:vect; found:boolean;
beginwriteln)'write the text'(read)s(;i=:1;j=:'a';
while)s]i['.'dobeginfound=:false;j=:'a';
while)j'z' ( and)not found(dobegin
if)s[i] =j )thenbegin
a[j]= a[j+1]found=:true;
end;j=:succ(j)
end;i=:i+1;
end;
8/2/2019 exercice Pascale
42/128
1 42
(*this section is to count the freq for each letter*)max=:a]'a'[; (*comparing the max *)
for j=:'a' to 'z' dobeginif(max
8/2/2019 exercice Pascale
43/128
1 43
program frexqencychar ;var ch:array[1..30]of char ;i,max,k,n:integer; maxl,L:char;begin
i=:1;read(ch[i]);
max=:0;while ((ch[1] = '.') do
{in case of that the first char was '.'}begin
writeln('please enter the text again';
read,ch[i]);
end;i=:2;
read(ch[i])
while ((ch[i] '.' and (imax)then
beginmax=:k;maxl=:L;
end;
end;
writeln('here is your letter and its frequency :',maxl,' ',maxl:4);readln;readln;end.
8/2/2019 exercice Pascale
44/128
1 44
10:
string
Capital :array ]A..Z [of charNumber:array ]1..9 [ofinteger;ordinary:array]a..z[of char
Writeln)Enter the text(;
Read)s(; )* s is verify as string *( ;For i=:1 to length)s(doCase s]i [ofA..Z :capital]i[=s]i[;1..2 :number ]i[=s]i[;a..z:ordinary]i[=s]i[;
8/2/2019 exercice Pascale
45/128
1 45
1:
n
integer:
.-1
2-.
3-.
4-(.)
program Vertix ;var n,max,min,avg,freq,i :integer;
A: array[1..50] of integer;begin
Writeln(Enter the length of the Array )Readln(n);Min=0 ; max=0;avg=0; freq=0;For i =1 to n do
beginRead(A[i]);If A[i] max thenMax =A[i]
Avg= Avg+A[i]End;Avg= avg / n;Readln(m)For i=1 to n do
If A[i] =m thenFreq =Freq +1;
Writeln(freq)
end.
8/2/2019 exercice Pascale
46/128
1 46
2:
n:
1-.
2-(mod.)
program Vertex ;var n,i,sum :integer;A: Array [1..100] ofinteger ;
begin
Readln(n)Sum=0;
For i =1 to n doReadln(A[i]);
For i=1 to n doIf A[i] mod 2 = 0 then
Sum = sum+1;2:I =1While i
8/2/2019 exercice Pascale
47/128
1 47
3:
ABB
AA....
:A=3,7,2
B=3,6,7,14,2,4
program vertex;Const max_n=100;
Var A = Array[ 1.. max_n] of integer;
B =Array [1..2* max_n] of integer;N:integer;
BeginReadln(n);For i =1 to n do
Read(A[i])I=1; j=1;
While i
8/2/2019 exercice Pascale
48/128
1 48
4:
A,B
n
C
:
1-C
A
B.2-C
AB(
.)
:
A=4,1,9,3
B=2,6,7,5
:
C=4,1,9,3,2,6,7,5
C=4,2,1,6,9,7,3,5
a,bFor i=1 to n doC[i]=A[i];C[n+i]=B[i];
1:
i=1j=1;while i
8/2/2019 exercice Pascale
49/128
1 49
5:
A:
1-
(
. )
2-
(
.)
..
.
n =5
i=1-->j=1,2,3,4,5
i=2-->j=2,3,4,5
i=3-->j=3,4,5
i=4-->j=4,5
i=5-->j=5
n=4
i=1-->j=1,2,3,4
i=2-->j=2,3,4
i=3-->j=3,4
i=4-->j=4
i....
ij
8/2/2019 exercice Pascale
50/128
1 50
A[10,10] :Matrixn :integer;writeln(Input The Length ofA);readln( n) ;writeln( Input The element of A ...;fori= 1 to ndobegin
for j= 1 to n dobegin
readln A[i,j];end;
end;sum =0;
{calculation The Sum of the elements of matrix That Upper Maindiameter}
writeln(calculation The Sum of the elements of matrix ThatUpperMain diameter ..) ;
writeln(The Index of The element ..) ;for i=1 to n dobegin
for j=i to n dobegin
sum =sum +A[i,j];writeln(i =, i,j"=, j );
end;writeln;
end;writeln(The Sum " :, sum );
{calculation The Sum of the elements of matrix That under Maindiameter }
writeln(calculation The Sum of the elements of matrix ThatunderMain diameter );
sum =0;writeln(The Index of The element...) ;fori=1 to ndobegin
for j= 1 to i dobegin
sum =sum + A[i,j];writeln(i" =, i, j"=, j );
end;writeln;
end;
writeln(The Sum " :, sum );
8/2/2019 exercice Pascale
51/128
1 51
6:
n
A[i=]A[j]A[i,i]i+j=nFor i =1 to n do
temp= A[i,i]A[i,i]= A ]n-i+1 ,n-i+1 [
A ]n-i+1 ,n-i+1 [ =temp;
Swap)A ]i,i[, A ]n-i+1 ,n-i+1 ([
7:
for i=:1 to n dotemp= A[i,i]A[i,i]= A ]i,n+1-i [ A ]i,n+1-i [=temp
swap A]i ,i [ , A ]i,n+1-i [
1 2 223 22
35 2 26 2445 5 3 2754 54 54 4
4 2 223 2235 3 26 2445 5 2 27
54 54 54 1
8/2/2019 exercice Pascale
52/128
1 52
8:
num
freq max Read)num,max(;freq=:0;for i=:1 to n dofor j=:1 to ndo
beginif A ] i ,j [ n=num then
freq=:freq+1;end;if )freq>max( thenwrite)freq(
9:
Max=n] a,b[; min=n]c,d[max=:A]1,1[; min=:A]1,1[;for i=:1 to ndofor j=:1 to n dobegin
if A]i,j[> max thenbegin
max=:A]i,j[; a=:i; b=:j;end;
if A]i,j [
8/2/2019 exercice Pascale
53/128
1 53
10:
k
3
k=13 1 26 4 59 7 8
if k>n then writeln Error ;shift_counter =0;else
beginfor raw =1 to n do
B ]raw[m n=nA ]raw , n [while ) shift_counter < k (do
for j =:n downto 2 dofor i=:1 to n doA]i,j[ n n=nA]i,j-1[;
shift_counter =shift_counter +1for i=:1 to n do
A ]i , 1 [n=nn B ]i [end;
:
K
k
1 2 34 5 67 8 9
8/2/2019 exercice Pascale
54/128
1 54
11:
- ) (
:
i=0while i
8/2/2019 exercice Pascale
55/128
1 55
13:
910865101
254878798223115689100
15228982
:
freq
function freq )A:Array; num :integer(integer
frq=:0;for i=:1 to n dofor j=:1 to n do
if A[i,j]n=nnumfrq=:frq+1
freq =frqend; { func}
for i=1 to n dofor j=1 to n do
writeln( A[i,j]:4, ,freq(A[i,j]))
Aux
n*n
for i=1 to n do
for j=1 to n dobegin
for k=1 to n*nif Aux[k]= A[i,j] thenbeginfound =truebreak
else {do nothing}
if not found thenwriteln( A[i,j]:4, ,freq(A[i,j]))
end;
8/2/2019 exercice Pascale
56/128
1 56
14:
:
{i lines und j columns}for i=:1 to n do
for j=:1 to n do
read)A]i,j[;)
for j=:1 to n dofor i=:1 to n-1 do
if A]i+1 [> A]i [thenbegintemp=:A]i+1[;
A]i+1]=:A]i[;A]i]=:temp;end
8/2/2019 exercice Pascale
57/128
1 57
15:
Print Aif n
mid1=mid2 =( n div2) + 1elsemid1=n div2 ;mid2n= n(n div2)+1
writeln;A]mid1]n=n 0;
A]mid2]n=:n0;print(A){ }for j=3 to n
A]mid1+1]n=n0;A]mid2-1]n= n0;
Print (A)
print
8/2/2019 exercice Pascale
58/128
1 58
16:
-
n (a),:
1
- :
( a) (2)
(a) (b),
a:122557776955332
b:25753
-2 :
a
c , , :
a:1225577776955332c:125769532
readln(n)for i =1 to digit(n) do {digit is a fun calculate thenum of n digit}begin num=n mod 10 ; A[i]=num; n=n div 10;end;
j=1; i=1; index =1;1:While ii+1 then beginB]j] =A]i[j=:j+1;
i=index+1; end;else begin
B]j] =A]i[j=:j+1;i= i+2; end;
End;else i=:i+1;
2:
else i=i+1 A[i] B[j] j
8/2/2019 exercice Pascale
59/128
1 59
5
1: :
f(n) = f(n-1) + f(n-2)f(0) = 0f(1) = 1
:
n
, n=3
:
fib(3) = fib(2) + fib(1)
fib(2) = fib(1) + fib(0)
==> fib(3) = fib(1) + fib(1) + fib(0) = 1 + 1 + 0 = 2
==> fib(3) = 2
:
N=5
8/2/2019 exercice Pascale
60/128
1 60
function Fib(n : integer) : integer;begin
if n = 0 thenFib := 0 { return the value Fib(0) = 0 }
elseif n = 1 then
Fib := 1 { return the value Fib(0) = 0 }else
Fib := Fib(n-1) + Fib(n-2);end; { end of function }
2: :
..
(1)(10.)
N..
.
:
constMax := 10; { defining the max size of Vector }
typeVector = array [ 2 .. Max ] of integer; { defining Vector}
vara : Vector; { defining an array variable from Vector }
N=1
fib(1) = 1
N
Vector
:
a[2] = fib(2)
a[3] = fib(3)
a[4] = fib(4)
...
a[10] = fib(10)
8/2/2019 exercice Pascale
61/128
1 61
:
N a
,
N
,
.. .
,
()
, :
for i := 1 to Max do
a[i] := 0; { Zeroing the slots of array }
function VecFib(a : Vector; n : integer) : integer;
begin
if n = 0 then
VecFib := 0
else
if n = 1 then
VecFib := 1
else
begin
if a[n] = 0 then
a[n] := VecFib(n-1) + VecFib(n-2);
VecFib := a[n];
end
end; { end of function }
8/2/2019 exercice Pascale
62/128
1 62
3:
( N )( X )
:
x,n>0
function Power( x , n : integer) : integer;
begin
if n = 0 then
Power := 1
else
if n = 1 then
Power := xelse
Power := Power(x,n mod 2) * Power(x,n div 2) * Power(x,n div2);
end; { end of function }
2= * *
Function Power )x,n:integer(:integer;if n =0 then
Power=:1;else
if n=1 thenPower=:x
elsePower=:x*power)x,n-1(;
8/2/2019 exercice Pascale
63/128
1 63
4:
:
AddByOne (n) = n + (n-1) + (n-2) + ... + 2 + 1
: n
,
n n-1
function AddByOne( n : integer) : integer;
begin
if n = 1 then
AddByOne := 1
else
AddByOne := n + AddByOne(n-1);
end; { end of function }
5:
:
AddByTwo (n) = n + (n-2) + (n-4) + .... + ( one or zero )
n
(2)
,
(1)(0) :
AddByTwo (5) = 5 + 3 + 1 = 9
AddBy (8) = 8 + 6 + 4 + 2 + 0 = 20
:
.. ( n = 1 )
( n < 1 )
(0) .
( n-2 )
function AddByTwo( n : integer) : integer;
begin
if n < 1 then
AddByTwo := 0
else
8/2/2019 exercice Pascale
64/128
1 64
AddByTwo := n + AddByTwo(n-2);
end; { end of function }
6:
..
( +1 )
( -1 )
,
.
:
5 + 3 ==> x = 5 , y = 3
1st recursive call ==> x = 5 + 1 , y = 3 - 1 ==> x = 6 , y= 2
2nd recursive call ==> x = 6 + 1 , y = 2 - 1 ==> x = 7 , y= 1
3rd recursive call ==> x = 7 + 1 , y = 1 - 1 ==> x = 8 , y= 0
x = 5 + 3 = 8
function RecAdd( x , y : integer) : integer;
begin
if y = 0 then
RecAdd := x
else
RecAdd := RecAdd(x+1,y-1);
end; { end of function }
7:
xy ( -1 )
y (y ) , x.
(1: )
5 - 2 ==> x = 5 , y = 2
1st recursive call ==> x = 5 - 1 , y = 2 - 1 ==> x = 4 , y= 1
2nd recursive call ==> x = 4 - 1 , y = 1 - 1 ==> x = 3 , y= 0
x = 3 = 5 2
8/2/2019 exercice Pascale
65/128
1 65
(2: ) :3 - 4 ==> x = 3 , y = 4
1st recursive call ==> x = 3 - 1 , y = 4 - 1 ==> x = 2 , y= 3
2nd recursive call ==> x = 2 - 1 , y = 3 - 1 ==> x = 1 , y= 2
3rd recursive call ==> x = 1 - 1 , y = 2 - 1 ==> x = 0 , y= 1
4th recursive call ==> x = 0 - 1 , y = 1 - 1 ==> x = -1 ,y = 0
x = -1 = 3 - 4
function RecSub( x , y : integer) : integer;
begin
if y = 0 thenRecSub := x
else
RecSub := RecSub(x-1,y-1);
end; { end of function }
8:
x,y
..
x
y
, y=1
,
, .
function RecMult( x , y : integer) : integer;
begin
if ( x = 0 ) or ( y = 0 ) then
RecMult := 0
else
if y = 1 then
RecMult := x
else
RecMult := x + RecMult(x,y-1);
end; { end of function }
8/2/2019 exercice Pascale
66/128
1 66
9: (
div)
x,y, x>y
y x
x
8/2/2019 exercice Pascale
67/128
1 67
11:
-
procedure sort)k,n:integer;var a:vector(
vart:integer;begin
if k=n or n=0 thenbegin
if n0 thensort)n-n+1,n-1,a(
elset=:1;endelse if a]k [>a]k+1 [ then
begint=:a]k[;a]k [n=n a]k+1[a]k+1 [ n=n tsort)k+1,n,a(
endelse
sort)k+1,n,a(end;
12:
1:n!=n*(n-1)*(n-2)*.1
Function Factor )n:integer (: integer;If n
8/2/2019 exercice Pascale
68/128
1 68
13:
Function A )m,n:integer (: integer;BeginIf m=0 and n>0then
A)m,n ( = n+1Else if m>0 and n=0 then
A(m-1,1);If m>0 and n>0 then
A(m-1,A(m,(n-1)))
8/2/2019 exercice Pascale
69/128
1 69
14:
-()
{out side the procedure }Read(n);For j=:1 to ndoRead(A[j]);Min=:a[n]Smallest(n,A[n],min);
6:Functionsmallest(n:integer; A:arrayofnteger,min:integer):integer;If n= 1 thenbegin
If A[1]
8/2/2019 exercice Pascale
70/128
1 70
15:
Function linersearch (A :matrix ; N :integer ; X :integer):BooleanBeginIf (A[N] = X )then
B =trueelse
If (N =0 )and (A[N] X ) thenB =false
else linersearch (A , N-1 , X )
Linersearch =Bend;
16:
:
Function linersearch (A :matrix ; first,last :integer ; X:integer ):Booleanbeginmid = first +last div 2;
if A[mid] =x thenlinersearch = true
else if A[mid] > x thenlinersearch(A,mid+1,last,x)
elselinersearch(A,first ,mid,x)
end;
8/2/2019 exercice Pascale
71/128
1 71
17:
Function Average )A :matrix ; N:integer (: real ;Begin
If )N =1 (thenSum =A[N]
ElseSum =Sum (A , N 1 ) + A[N]L =L +1
Sum =Sum /Lend
18:
Function Sum (A :matrix ; N :integer ):integerBegin
If )N =0 (thenSum =0
ElseSum =Sum )A , N-1 ) + A[N]
8/2/2019 exercice Pascale
72/128
1 72
6
Advanced Numeric
1:
1122123
13 23 3
pow(x,y)
n , m=0 : :long ;num, temp_n :integer;is_no_frq :boolean;i,digit_counter , x :integer;readln n;is_no_frq=true;digit_counter=0;m=0;whilen div 10 0 do
begini=0;num =n mod 10;temp_n =n;
while temp_n 0 dobegin
if num = temp_n mod 10 theni =i+1
elsebegin
x =temp_n mod 10;m =m +x *pow(10.0,digit_counter);digit_counter=digit_counter +1 ;is_no_frq =true;
end
temp_n =temp_n div 10;End {while 2}if temp_n =0 then
writeln(The number of Frequency for ,num,is ,i);ifnot is_no_frqthen
break // elsebegin
is_no_frq=false;digit_counter =0;
n =m;m=0;
end {else }End {while }
8/2/2019 exercice Pascale
73/128
1 73
:
n
n
m
while m=112212 m
111
.
:is_no_frq
.
111
:digit_counterm.
:temp_nn
while
:pow
Function pow )x :integer ; y :integer (Var res :integer ;Res=1;
For i =1 to y doRes =Res *X;
Pow =res ;end;
8/2/2019 exercice Pascale
74/128
1 74
2:
126
2*3*3*7
8
2126363
321
77
function primeFactors )n:integer :( integerbegin
i=:2;while i
8/2/2019 exercice Pascale
75/128
1 75
3:
9804198410
201056215600
8888888855015510
9805201398052130num ,z,res=0,digit-=1,n2,how_many_zeroz=0 :long;
readln )num (;n2 =num;while ) num 0 (dobegin
z =num mod 10 ;
if ) z =0 ( then
beginhow_many_zeroz = how_many_zeroz+ 1 ;num =num div10;continue ;
end;elsebegin
Digit =digit +1;res =res +z *powf)10,digit(;
end;
num =num div 10;
end;
if) how_many_zeroz 0 ( thenfori =0 to how_many_zeroz do
res =res *10;
writeln )res (;
:
12301
13211101001000
1231
10
8/2/2019 exercice Pascale
76/128
1 76
4:
num1 num1,num2,n,fdigit1,fdigit2,res=0 : integern -=1;readln)num1,num2(;
while)num1 0 (do
beginfdigit1 =num1 mod10;fdigit2 =num2 mod 10;
if) num2 0(thenbeginn = n+1;if) fdigit1 > =fdigit2( then
res = res )+fdigit1-fdigit2 *(powf)10,n (;else { {
beginfdigit1 =+10;
res))=fdigit1-fdigit2 *(powf)10,n +)res(;num1 =num1 powf)10,1(;
end{ }
num1=num1 div 10;num2 =num2 div 10;
endelse
beginn =n+1;res =+fdigit1 *powf)10,n (;
break;end
endwriteln )The result is ,res (
8/2/2019 exercice Pascale
77/128
1 77
5:
21
num1,num2,n,fdigit1,fdigit2,res=0,rem1=0,rem2=0 :integer;n-=1;readln(num1,num2);
while (num1 0) dobegin
fdigit1 =num1 mod 10;fdigit2 =num2 mod 10;
if( num2 0) thenbegin
n =n+1;if (fdigit1 +fdigit2> 9) // begin
rem1 =(fdigit1 +fdigit2 )mod 10;rem2 =(fdigit1 +fdigit2 )div10;res =res +(rem1) *powf(10,n );
num1 = num1 +rem2 *10 ;
end;
else // res = res +((fdigit1+fdigit2) *powf(10,n ));
num1=num1 /10;num2 =num2 /10;
endelse
beginn =n+1;res = res +fdigit1 *powf(10,n );break;
end;end;
writeln(res );
end
-n=0while) num2 0 (
fdigit2=num2 mod10res=res)+fdigit2*num1)(*10^n(num2=:num2 div10n =n+1;
8/2/2019 exercice Pascale
78/128
1 78
6:
function div )num1,num2:integer:(integerbeginif num1=num2
return 1else if num1
8/2/2019 exercice Pascale
79/128
1 79
8
- 123456615243
numdigit
getlast 12323
function getlast )var num:integer :(integerbeginn1=0 { }while)num div 10 0(
n1=n1+1last1=num div 10num=num div 10 end;{ end of the whileloop}
num=num mod )10^n(getlast=last1end;
-------------------------------- read numndigit=numdigit)num(n-=2while )num div 10 0(beginfdigit =num mod10ldigit=getlast)num(
Num
res=res*10 ) n+2)n+n ) fdigit*10+ldigit(num=num div 10end;if numdiv10 =0ldigit=fdigit=numres=res*10^)n+2(+)fdigit*10+ldigit(ifndigit mod20 thenres=res div 10writeln res
8/2/2019 exercice Pascale
80/128
1 80
9:
2164326413
Read numndigit=getdigit)num(ndigit1=ndigiti=1; res=0while numdiv 10 0 dodigit =num div 10 ndigit-1
if digit mod2 =0res=res+digit*10 ndigit1
ndigit1=ndigitndigit=ndigit-1num=num mod 10 ndigit
elseA]i [n=ndigit
ndigit=ndigit-1i++num=num mod 10 ndigit
end; {end of while}
for k=1 to i dores=res+A]i[ n*n10i-1
Writeln res
10:
-
1209312903
string
max min
(:
8/2/2019 exercice Pascale
81/128
1 81
11:
1223351235
var num,n,m=0,f_digit,res=0 ,temp,temp2=0 : long ;
readln(num);n=0;while( num 0 ) dobegin
f_digit =num mod 10;
num =num div 10;temp=num;while(temp 0 ) dobegin
if(temp mod 10 f_digit) thenbegin
temp2 =temp2 +(temp mod 10)*powf(10,m);m = m+1;
end;
temp =temp div 10;
end
if(temp =0 ) thenbegin
res =res +f_digit *powf(10,n);
n= n +1;end;num =temp2;temp2=0;m=0;
end;writeln(res);
powf 10 n
8/2/2019 exercice Pascale
82/128
1 82
12:
primary
Readln nwhile n div 10 0 dobeginnum=:n mod 10primary)num(ifprimary=true then
prim=:prim+1;elseif num mod 2 =0 then
odd=:odd+1else
even=:even+1end;
8/2/2019 exercice Pascale
83/128
1 83
7
1
1: :
m,n
m=n
nm.220284
12000 CONST MAXN=3000;TYPE DIVIZER=ARRAY[1..MAXN]OF INTEGER;varm,n,i,j,s1,s2:integer;
C:CHAR;A:DIVIZER ;
procedure menu(var c:char);
beginrepeat
WRITELN( THE MENU ')writeln(' (C)HECK TOW NUMBER');writeln('(F)RIENDS NUMBER BETWEEN )WRITELN( (E)XIT ')READLN(C);
UNTIL C IN['C','c','F','f','E','e']END;
procedure check(n,m:integer);var sn,sm,i:integer;begin
writeln('INPUT THE FIRST NUMBER');READLN(N);writeln('INPUT THESECOND NUMBER');READLN(M);sn=:0;sm=:0;for i=:1 to n-1 do
beginif(n mod i =0)then
sn=:sn+i;end;
for i=:1 to m-1 dobegin
if(m mod i =0)thensm=:sm+i;
end;if(sm=n)and(sn=m)then
BEGINwriteln('AFTER THE CHECKING THE NUMBER ',N,' AND THENUMMBER ',M,' ARE FRIENDS');
END
8/2/2019 exercice Pascale
84/128
1 84
ELSEBEGINwriteln('AFTER THE CHECKING ....THE NUMBER ',N,' ANDTHE NUMMBER ',M,' ARE NOT FRIENDS');
END;
end;
PROCEDURE FRIENDS_BETWEEN(N,M:INTEGER;VAR A:DIVIZER);VARi,j,K:integer;
beginwriteln('INPUT THE FIRST NUMBER ........THE SMALLEST');readln(n);writeln('INPUT THE SECOND NUMBER.........THE LARGEST');readln(m);
FOR I=:1 TO M DOA[I] =0;
for K=:n to m dobeginFOR J=:1 TO K-1 DOBEGIN
IF(K MOD J =0)THENA[K] =A[K]+J;
END;FOR I=:N TO M DO
BEGINIF(A[K] =I)AND (A[I]=K)THEN
WRITELN('THE NUMBER ',K,' AND THE NUMBER ',I,' AREFRIENDS');END;
END;end;
BEGIN {main program }MENU(C);
WHILE(C'E')AND(C'e')DOBEGINCASE COF'C','c':CHECK(N,M);'F','f':FRIENDS_BETWEEN(N,M,A);END;
MENU(C);END;END.
8/2/2019 exercice Pascale
85/128
1 85
2
:
6 6=1+2+3 123 6
200
const maxn =500;var
n,m,i,k:integer;a:array [1..maxn]of integer;
begin
writeln('INPUT THE FIRST NUMBER ........THE SMALLEST');readln(n);writeln('INPUT THE SECOND NUMBER........THELARGEST');READLN(m);for k=:1 to maxn doa[k] =0;for k=:n to mdobegin
for i =:1 to k-1 dobeginif k mod i=0 then
a[k] =a[k]+i;end;
if k=a[k]thenwriteln('the number ',k,' is perfect');
end;
writeln;writeln;WRITELN('PLEASE PRESS ENTER TO END');readln;
end.
8/2/2019 exercice Pascale
86/128
1 86
3
(
,
-1
-2
3-
4-
5-
a1, a2: --:1[[x21,x22[x11,x12]-b1,b2y=ax+b))b-
:-2
:-3.a1=a2-
-) x,y ( x
.
-4:
begin
read )a1( read )a2(if )a1 =a2 (then
print "The two segments are parallel"else
read )b1( read )b2(
read )x11( read )x12(
read )x21( read )x22(
x =) b2 -b1 / )( a1 -a2 )
y =a1 *x +b1
print "Intersection point is "( :, x , ", ", y , " "
if )x > x11 (and )x < x12 (then
print "Intersection point is on the first segment"else
print "Intersection point is on first-segment's porter"
if )x > x21 (and )x < x22 (thenprint "Intersection pointis on the second segment"
else
print "Intersection point is on second-segment's porter"end
8/2/2019 exercice Pascale
87/128
1 87
5- :
1-
.
2- (
)
varc:char;orde,s,old,i:integer;
begins=:0;
c=:'d'; i=:1;
while c'.' do beginread)c(s=:s+1;orde=:ord)c(
if ((i=1)or (old=32))and ((orde>=97)and (orde
8/2/2019 exercice Pascale
88/128
1 88
6:
:
1-
$
2-
var c:char;s,orde,capital,small,digit,dots:integer;
begins=:0;capital=:0;
small=:0;digit=:0;dots=:0;c=:'a';
while c'$' dobegin
read(c)s=:s+1;
orde=:ord(c)case orde of97..122 :small=:small+1;65..90:capital=:capital+1;48..57 :digit=:digit+1
else dots=:dots+1;end; {end case}
end;{end while}writeln('length of the text=', s)writeln('numberof capital letter=',capital)writeln('number of small letter=',small)writeln('number of dots=' ,dots)readln; READLN ;end.
8/2/2019 exercice Pascale
89/128
1 89
9- 1n
n
var n:integer;function sum(n:integer):boolean;var
i,s:integer;s1:real; b:boolean;
begins1=:0; s=:0;for i =:1 to n dobegin
s=:s+i*i;end;
s1=:n*(n+1*)(2*n+1)/6;if s1=s then
sum=:true;end; {end function}
begin {main program}write('enter then=');readln(n)writeln(sum(n))readln;end.
8/2/2019 exercice Pascale
90/128
1 90
:10
:
2
.
Result Country1,country2
country1 country2
1-
2-
( )
3- :
-
--
-
1 2+(
2 1= )2
--
Program football (input,output);
Typeteam=) syria,jordan,egypt,tunisia,algeria,morocco (;matrix=array [syria..morocco,syria..morocco]of integer;matrix1 =array[1..6,1..6]of integer;
Vari,j:team;a :matrix;b :matrix1;t,t1,k,l:integer;
Begin {main }for i =:syria to morocco dobegin
for j =:syria to morocco dobegina[i,j] =0; { butting zeros inthe array }
end;end;
8/2/2019 exercice Pascale
91/128
1 91
writeln(' Welcom to our program')writeln(' Please be aware whileentering the points that:');write(' 1 -When you read team1*team2this means that you should enter');writeln(' the points which theteam1 got when they played with team2');
writeln(' 2 -You will have a chance to change the value case itis wrong ');
writeln(' 3 -If the team won you should enter 2 & if it lostyou should enter 0 & if it drew youshould enter 1');for i=:syria to algeria do
beginfor j=:succ(i)to morocco do
begincase i of
syria :write(' Syria *'); jordan :write(' Jordan *'); morocco:write(' Morocco *');egypt :write(' Egypt *'); tunisia :write('Tunisia *'); algeria :write(' Algeria *');
end; { this case and wherever you see one in this program it isjust a way to write a direction in the screen}case j of
jordan :write(' Jordan '); morocco :write(' Morocco ');
egypt :write(' Egypt '); tunisia :write(' Tunisia '); algeria:write(' Algeria ');end;
readln(a[i,j]);writeln;while (a[i,j]>2)dobeginwriteln('Error');writeln(' Re-enter the result ');a[i,j]=0;readln(a[i,j]);writeln;
end;end;
end;for i =:jordan to morocco dobeginfor j =:syria to algeriado
beginif j
8/2/2019 exercice Pascale
92/128
1 92
end;end;
end;for j =:syria to morocco do { counting the points of eachteam }begin
b[1,1]=:b[1,1]+a[syria,j];b[1,2]=:b[1,2]+a[jordan,j];b[1,3]=:b[1,3]+a[egypt,j];b[1,4]=:b[1,4]+a[tunisia,j];b[1,5]=:b[1,5]+a[algeria,j];b[1,6]=:b[1,6]+a[morocco,j];end;
b[2,1]=:ord(syria);b[2,2]=:ord(jordan);b[2,3]=:ord(egypt);b[2,4]=:ord(tunisia);
b[2,5]=:ord(algeria);b[2,6]=:ord(morocco);for l=:1 to 5dobeginfor k=:l+1 to 6 do { ordering }if (b[1,k]>b[1,l)]thenbegint=:b[1,l];t1=:b[2,l];b[1,l]=:b[1,k];b[2,l]=:b[2,k];b[1,k]=:t;b[2,k]=:t1;
end;end;
writeln;writeln(' The order of the teams is ');writeln;for l=:1to 6 do
beginwrite(l,'_ ' );case b
[2,l
]of
0 :write(' Syria with');1 :write(' Jordan with');2 :write('Egypt with');3 :write(' Tunisia with');4 :write(' Algeria with');5:write(' Morocco with');
end;writeln(' ',b[1,l],' point');writeln;end;
readln;end.
8/2/2019 exercice Pascale
93/128
1 93
11:
1-
$
Tvect2-
Tvectwos
3- Tvectwos
palindrome
typecountries= (syria,leb,jor,egypt,lybia,tunis,maroco);
vara:array[countries]of integer;i,j:countries;max:integer;
function country(i:countries):string;var s:string;begin
case i ofsyria :s=:'SYRIA ';
leb :s=:'LEBANON';jor :s=:'JORDAN ';egypt :s=:'EGYPT ';lybia:s=:'LIPYA ';tunis :s=:'TUNSIA ';maroco:s=:'MAROCO ';
end;country=:s;end;begin
for i =:syria to maroco dobegin
WRITELN;writeln('PLEASE ENTER THE NATIONAL INCOME OF',COUNTRY(I));WRITELN;write(' THE NATIONAL INCOME OF',country(i),'=');readln(a[i])
end;max=:a[syria];
for i =:leb to maroco dobegin
if a[i]>max thenbeginmax=:a[i];
j=:i;end;
8/2/2019 exercice Pascale
94/128
1 94
end;writeln(' THE COUNTRY WITH THE LARGEST NATIONAL INCOME IS ',country(j),'WITH',max);WRITELN('PLEASE PRESS ENTER TOEND');readln;
end.
12-
:
K
k=5
A,B,C,D,E,F,GA FB GY
DZ E
09
09 , 81 , 45
1-
K
2- 3-
Program CryptoWacko(input,output);Const n =5;Type Vector =array[0..n]of char;Var RTVect,ETVect :Vector;
BN,i:Integer;Procedure Encrypt(k:Integer;Vect:Vector;vareVect:vector);Var I :Integer;Begin
For I =:0 to n DoBeginIf (ord(vect[I])> =ord('a' ))AND(ord(vect[I])< =ord('z' ))Then
eVect[I] =: chr(ord(vect[I]) + k)If ord(eVect[I])> ord('z')Then
eVect[I] =: chr(ord('a' ) - 1 +(ord(evect[I]) ord('z' )))
If (ord(vect[I])> =ord('0' ))AND (ord(vect[I])< =ord('9'))TheneVect[I] =: chr(ord('0' ) + 9 (ord(vect[I]) ord('0' )))
If (ord(vect[I])> =ord('A' ))AND (ord(vect[I])< =ord('Z'))Then
eVect[I] =: chr(ord(vect[I]) + k)If (ord(eVect[I]) > ord('Z'))AND (ord(vect[I])> =ord('A' ))AND (ord(vect[I])< =ord('Z')) TheneVect[I] =: chr(ord('A' )- 1 +(ord(evect[I]) ord('Z' )))
End;End;
8/2/2019 exercice Pascale
95/128
1 95
Procedure Decrypt(k:Integer;Vect:Vector;vareVect:vector);Var
I :Integer;BeginFor I =:0 to n DoBeginIf (ord(vect[I])>=ord('a' ))AND (ord(vect[I])< =ord('z' ))Then
eVect[I] =: chr(ord(vect[I]) - k);If ord(eVect[I])< ord('a')Then
eVect[I] =: chr(ord('z' ) + 1 +(ord(evect[I]) - ord('a' )));
If (ord(vect[I])> =ord('0' ))AND (ord(vect[I])< =ord('9'))TheneVect[I] =: chr(ord('0' ) + 9 -(ord(vect[I]) - ord('0')));
If (ord(vect[I])> =ord('A' ))AND (ord(vect[I])< =ord('Z'))TheneVect[I] =: chr(ord(vect[I]) - k);
If (ord(eVect[I])< ord('A' ))AND (ord(ect[I])> =ord('A'))AND (ord(vect[I])< =ord('Z' )) TheneVect[I] =: chr(ord('Z' )+1 +(ord(evect[I]) - ord('A' )));End;End;
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
Begin {main }WriteLn;WriteLn(Please Enter The Text You Want ToEncrypt, The Length Of The Text Is ',n+1,' :' );For I =:0 to nDo
Read(RTVect[I]);WriteLn;WriteLn('Enter The Base Number :');ReadLn(BN);Encrypt(BN,RTVect,ETVect);WriteLn('The Encrypted TextIs :' );For I =:0 to n Do
Write(ETVect[I]);WriteLn;ReadLn;WriteLn('Please Enter The TextYou Want To Decrypt, The Length Of The Text Is ',n+1,' :' );
For I =:0 to n DoRead(ETVect[I]);WriteLn;WriteLn('Enter The BaseNumber :' );ReadLn(BN);Decrypt(BN,ETVect,RTVect);WriteLn('TheDecrypted Text Is :' );For I =:0 to n Do
Write(RTVect[I]);WriteLn;
ReadLn;
End.
8/2/2019 exercice Pascale
96/128
1 96
13-
:
f[n] = f[n-1] + f[n-2] f[0] = 0 f[1] =1
:
1- fn n
2- n=5
fn
fn
3- fn
fn
f[n] = f[n-1[ + f[n-2] f[0] = 0 f[1] =1
1:
Function fib (n:integer)integer;
Readln(n)
If n=0 then
Fib=:0;
Else if n=1 then
Fib=:1Else fib=:fib(n-1)+fib(n-2)
End;
2:
For n=5
8/2/2019 exercice Pascale
97/128
1 97
3:
Function fib (a:vector; n :integer):integer;
Begin
If n =0 then
Fib=:0
Else
If n=1 then
Fib =:1;
Else begin
If A[i]=0 then
A[i]=:fib(n-1)+fib(n-2)
Fib=:a[i];
End;
15
-
A )0,n] = n+1 ;
n
A)m,0] =A)m-1 ,1 (
m
A)m,n] = A)m-1 , A)m,n-1((
m,n
2-
m,n2- m=2n=1
Function Ack(m,n :integer ) : integerBeginIf m =0 then
Ack =n+1;Else if n=0 then
Ack=A)m-1, 1(ElseAck=Ack)m-1,Ack)m,n-1((
End.
8/2/2019 exercice Pascale
98/128
8/2/2019 exercice Pascale
99/128
1 99
begint = false;repeat
w=trunk(h+b)/2
if (b-h =1)thenif ( m[w]=k)thenbegin
q=w;t= true;
end;else if m[w+1]=k then
beginq=w+1;t= true;
end;else q=0;
else if m[w]=k thenbegin
q=w;t=true
end;else if m[w]>k then
b=w;
else h=w;until t or q=0find =q;end;3:
begin {main}write(n)readln(n)
for i =1 to n dobeginwrite(A[,i,] = );read(a[i]);
end;write(enter da numberwich u search for);Readln(v);writeln(find(a,1,n,v);writeln(find(a,1,n,v);
end.
8/2/2019 exercice Pascale
100/128
1 100
17:
1-
2-
3-
12
-Type
1*Country(sy,leb,jor,egpyt,liybia,tun,mor);
Var
income:longint (its just like integer but with longer range);
2 *A:array [sy ..mor]of longint;
3:Begin {main}
For i=:sy to mor do
A :Readln(A[i])
Max=:A[1]
B :For i=:sy to mor do
If A[i]> max then
A[i]=:max;
Else max=:max;
Writeln(The highest income is ,max )
Writeln(The country is ord(i) );( or we can just make case I ofand try this one )
(the ord(i)is very useful tools to know the country )
End;
8/2/2019 exercice Pascale
101/128
1 101
18:
X n+1 =Xn +1/3 *(a/Xn2 -Xn)
Xn+1-Xn /Xn < eps =10^-5
X :array [1..100]of integer;Write(Enter the number to count itscube root);Read(a);X[1]=:1i=:1;X[i+1]=:x[i]+(1/3)(a/(x[i])2)-x[i]))While((X[i+1]x[i]/) x[i])>0.00001 doBegin
i=:i+1;End;Sqroot =:(X[i]);program wasxe;vari,a:integer;ss,sq,sqroot:real;x:array [1..50]of real;
beginWrite('Enter the number to count its cube root');Read(a);
X[1]=:1;i=:1;sq=:x[i]*x[i];ss=:(a/(sq)-(x[i]))/3;X[i+1]=:x[i]+ss;While((X[i+1]- x[i] /) x[i])
8/2/2019 exercice Pascale
102/128
1 102
19:
0241-
2-
3-
12:
.
program train;const nx=6;type city =(dam,hom,ham,ale,rak,dir)var r:array[dam..dir] of integer;k:city;c:char ; t:integer;
proceudre print (o:city);begin
case o ofdam: write(dam);hom: write(homes);ham : write(Hama)ale:write(Aleppo);rak: write(rak);dir: write(dir );
end;
beginfor k= dam to dir do
beginwrite(The time of the train in ): print(k);readln(r[k]);
end;writeln(
)
for k=dam to dir do
begin print(k); write( );end;Readln(c);
8/2/2019 exercice Pascale
103/128
1 103
case c ofd,D:k:=dam ;h,H: k:=hom;a,A:k:=Ham;
l,L: k:= ale;r,R: k:=Rak;i,I: k:=dir;
else c:=q;end;if c q thenbegin
write(The Time now is : );read(t);if r[k]
8/2/2019 exercice Pascale
104/128
1 104
Program Poly;Type mat =array [0..10 ]of real;
Var n,i:integer;
P:mat x,r,x1,x2:real
Function h(n:integer,q:mat,x:real):realVar s:real;BeginS=0;Fori=n downto 0 do
S=s*x+q[i];H:=s;End;
Function pow (x:real,o:integer):real;Var m:real;Begin
M:=1 ;For i=1 to o doM:=m*x;Pow=m;End;
Function d (m:mat;d:real):real;BeginD=sqr(m[1]-4*m[2]*m[0];End;
Begin {main program }Write(n= ); readln(n);
For i= n downto 0 doBegin
Write(a ,i,= ); read(p[i]);End;
Write(x= ) ;read(x);Writeln(F(,x:3:1,(=,h(n,p,x):3:1);
N=p[0];
For i=1 to n doR=r+p[i]*pow(x,i);Writeln(f(,x:3:1,)=,r:3:1); Ifn =2 then
If (p[2]=0 ) and (p[1] =0) then
8/2/2019 exercice Pascale
105/128
1 105
Write(Exacusem);Else if (p[2]=0 )then
Write(x=,-p[0]/p[1]:3:2)Else
begin X=d(p);If x>=0 then
Begin
X1:=(-p[1]-sqrt(x)/(2*p[2]));X2:=(-p[1]+sqrt(x)/(2*p[2]);Writeln(x1=, x1:3:2);Writeln(x2= ,x2:3:2);
End;Else
BeginX1=-p[1]/(2*p[2]);X2:=abs(sqrt(-x)/(2*p[2]);Write(x1=,x1,+,x2);
Write(x2=,x1:3:2,-i,x2:3:2);End;
End;End.
8/2/2019 exercice Pascale
106/128
1 106
21
i
|cii| > |Ci1|+|Ci2|+|Ci3|++|Cin|:
1-
i
Cii
-2
1
:
3-
CONST MAX =5;TYPE Oh =ARRAY [1..MAX,1..MAX]OF INTEGER;VARO:Oh;
I,J:INTEGER;BO:BOOLEAN;
Function Big(O:Oh:)boolean;var i:integer;
Function SumLine_AbsVal(i:integer:)integer;type Qu =array[1..max]of integer;var h,S:integer;
Q:Qu;BeginS=:0;for h=:1 to i-1 doS=:S+abs(Q[h]);
for h=:i+1 to max doS=:S+abs(Q[h]);
End;BeginBo=:true; i=:1;While(i
8/2/2019 exercice Pascale
107/128
1 107
22
.
1-
2-
3-+
0 1
2
4-
1
:
Type Vector =array [1..100]of integer;Var A:Vector;
i,MAX,N:integer;
Function TheGest_Freq(A:Vector;var most:integer):integer;TypeMatrix =array [1..100,1..2]of integer;
Var B:Matrix;
(*B is The Result Freq array 2D (that B[j,1]is for the element/from A/,B[j,2]is for Freq*)
max1( *the max of B*),j:integer;bo:boolean;
Begin
B[1,1]=:A[1]; B[1,2]=:1; max1=:1;i=:2;while (i
8/2/2019 exercice Pascale
108/128
1 108
BEGINI=:1; N-=:1;WHILE (I(:
B
a[i)]
BA[i]
=1
+(1)max1
________
B:B[j,2]
[B[j,1
8/2/2019 exercice Pascale
109/128
1 109
8 1
13-1-2005
:
Knowing that many arab countries have taken steps to formulaterelevant policies andimplementation strategies to built theinformation society ,it becomes necessary to builtupon all suchefforts in promoting an integraded plan of action for a futureinformationsociety in the arab region.
45
246
5.47
Var c:char;Letterc,Wordc,,avr:integer;Read )c);p=:0; {actualletter numbers }
while c. Do
beginletterc=:letterc+1;if c= or c=! or c=# {.etc} then
wordc=:wordc+1;else p=:p+1;
Read )c);End;writeln(The number of words are ,wordc);writeln(Thenumber of letters ,p);avr=:letterc/wordc; (or p/wordc)writeln(TheAverage ,avr);
8/2/2019 exercice Pascale
110/128
1 110
:
1-
Capital
a..z
Capital letters
Capital(a)=A , Capital(f)=F . And so on2- MakeFirstCapital
30
salah al din ben alaziz
Salah Al Din Ben Alaziz
1:Function Capital (c:char):Char;Begin
C=:chr(ord(c)-ord(a)+ord(A));{for example c=:a thenc=:chr(ord(a)-ord(a)+ord(A))=chr(ord(A)=A cos the twofunctions ordand chr are inversed with each otherand in this way we dont need toknowthe ord by ASCII codes )}
Capital=:c;End;
Matrix:array[1..30]of char ;
2:Procedure MakeFirstCapitals (var A:matrix);Begin
A[1]=:capital(A[1]);I=:2;While I< =30 do
If A[i]= then {space}A[i+1]=:Capital(A[i+1]);I=:i+2;
Else{A[i]=:A[i];}
I=:i+1;
End;
8/2/2019 exercice Pascale
111/128
1 111
: n*n n ,
1n2
n=5
17 24 1 8 1523 5 7 14 164 6 13 20 2210 12 19 21 3
11 18 25 2 9
A:
1
E
B:
C:
D:
i,j i+1,j+1
i-1,j
FillMagic Array nn
nextCell i,j
Type Matrix = array[1..100,1..100] of integer;Var I,J,N:integer;Majec:Matrix; c:Char;
Procedure NwxtCell (var i,j:integer);
var i1,j1:integer;Begin
for i1:=1 to n do (*this is for marking the M.A withgaps*)begin
for j1:=1 to n doMajec[i1,j1]:=-1;
end;i1:=1; j1:=(n div 2)+1;Majec[i1,j1]:=0;while ((i1i)or(j1j))do (*//arrive to the wanted cell !//*)begini1:=i1-1; j1:=j1+1;if(i1=0) then
i1:=n;if (j1=n+1) thenj1:=1;
if Majec[i1,j1]=0 thenbegin
8/2/2019 exercice Pascale
112/128
1 112
if (i=n) theni:=0; (*come Back...*) (* 0 becouse we'll add 2 not1*)
i1:=i1+2; (* ???*)j1:=j1-1; (* Becouse we have add 1 *)
if(j1=0) then j:=n; (* !!!!*)end;
Majec[i1,j1]:=0; (*this cell has been done*)end;
i1:=i1-1; j1:=j+1;if (i1=0) theni1:=n;
if (j1=n+1) thenj1:=1;if Majec[i1,j1]=0 then
begin writeln('lll');if (i1=n) theni1:=0; (*come Back...*) (* 0becouse we'll add 2 not 1*)
i1:=i1+2; (* ???*)j1:=j1-1; (* Becouse we have add 1 *)if(j1=0)then j1:=n; (* !!!!*)
end;
i:=i1;j:=j1;End;
Procedure FillMajecArray(var Majec:Matrix);varindex:integer;Begin
i:=1; j:=(n div 2)+1;for index:=1 to n*n do
beginMajec[i,j]:=index;i:=i-1; j:=j+1;if (i=0) then
i:=n;if (j=n+1) thenj:=1;if Majec[i,j] in [1..index] then
begin
if (i=n) theni:=0; (*come Back...*) (* 0 becouse we'll add 2 not1*)i:=i+2; (* ???*)
j:=j-1; (* Becouse we have add 1 *)if(j=0) then
8/2/2019 exercice Pascale
113/128
1 113
j:=n; (* !!!!*)end;
end;End;
BEGINwriteln; writeln; writeln;writeln(' MAJEC ARRAY!!@#!!');writeln('==================');writeln;writeln;readln;repeatwrite(' BeforeBegining .... Enter The Max : ');readln(n);if (n>100)Thenwriteln(' ........ its too much !! Press Enter To Re_Type theMax ');if (n100)or(j
8/2/2019 exercice Pascale
114/128
1 114
beginwriteln;for j:=1 to n dowrite(Majec[i,j]:6);
end;readln;end
elsewriteln(' General Error !! cannot continue...');
End.
3-1-2004
:
6
5113456123682
2-
:2j:=1; freq:=0;
for i:=1 to 6 do{or we can use 2 whiles }while j=< 6 doIfA[i]=B[j] then
j:=7 {or we can put a Boolean }freq:=freq+1
elsej:=j+1
:2 string
checkn
Function checkn(A:string):Boolean;beginFor i:=1 to length a doIfa[i]>0 and a[i]
8/2/2019 exercice Pascale
115/128
1 115
Function read (a,b:string):integer;Freq:=0;Checkn(a);
If check(a)=true then beginCheck( b)If check(b) true then
For i:=1 to length(a) doWhile( j
8/2/2019 exercice Pascale
116/128
1 116
8/2/2019 exercice Pascale
117/128
1 117
program Enc;const
maxn=200;type
ve=array[1..maxn] of char;var
a1,a2,a3:ve; n,i,j,k,s:integer;
procedure tash(a1:ve; k:integer; var a2:ve);var s:integer;begin{ tashfeer procedure}for i:= 1 to n dobegin
s:=ord(a1[i]);
if ((s>=65) and(s=97) and(s90-k)and(s122-k)and(s=48)and(s
8/2/2019 exercice Pascale
118/128
1 118
a2[i]:=chr((57-s)+48)else
a2[i]:=a1[i];end;
end;procedure f_tash(a1:ve; k:integer; var a2:ve);varz:integer;begin { not tashfeer procedure (original text)}
for i:= 1to n dobegin
S:=ord(a1[i]);if((s>=65+k)and(s=97+k)and(s=97)and(s=65)and(s=48)and(s
8/2/2019 exercice Pascale
119/128
1 119
WRITELN;for i:= 1to n do
write (a2[i]);writeln;
f_tash(a2,k,a3);writeln;writeln('----------------------------');write('THETEXT AFTER DELET THE TASHFEER (original text) IS :');for i:= 1 to ndo
write(a3[i]);end.
program math;vari,c,d:integer;a,b:real;
function sum(a:real; b:real):real;beginif (b=0) thensum:=aelseif(b >0)then
sum:=1+sum(a,b-1)elsesum:=-1 +sum(a,b+1);
end;function GCD(var c,d:integer):INTEGER;varmax,min:integer;
f:boolean;beginif(c>d)thenbegin
max:=c;min:=d;
endelsebeginmax:=d;min:=c;
end;if(max mod min = 0)then
gcd:=minelsef:=false;begini:= (min div 2);
8/2/2019 exercice Pascale
120/128
1 120
while(i>0)and(f=false) dobeginif(max mod i =0) and(min mod i=0)then
begin
gcd:=i;f:=true;end;
i:=i-1;end;
end;end;beginwriteln('FIRST INPUT TWO NUMBER TO FIND THE SUM');
WRITE('INPUT THE FIRST NUMBER.....');READLN(A);WRITE('INPUT THESECOND NUMBER... ');READLN(B);
WRITELN('THE SUM =',SUM(A,B):5:2);WRITELN('INPUT TWO NUMBER TOFIND THE GREAT COMMON DIVIDER ');WRITE('INPUT THE FIRSTNUMBER...');READLN(C);WRITE('INPUT THE SECONDNUMBER..');READLN(D);
WRITELN('THE GREAT COMMON DIVIDER = ',GCD(C,D));end.
:PROGRAM BANK_MAN;VAR balance,y,n:integer;
rate:real;begin
writeln('INPUT THE FALUE OFBALANCE');readln(balance);writeln('INPUT THE FALUE OF RATE');readln(rate);n:=balanc*2y:=0;while (balance
8/2/2019 exercice Pascale
121/128
1 121
program exam_2007_4;type vector = array [1..30] of integer;
var a,b:vector;k,c,count,l,z:integer;
function findelem (a:vector;n,x:integer):integer; { to findelement in array }varfound:boolean;i:integer;
beginfound:=false;
i:=0;while (i
8/2/2019 exercice Pascale
122/128
1 122
endelsebeginc:=1;
while (vec[i]=vec[i+1]) and (i
8/2/2019 exercice Pascale
123/128
1 123
2007-2008
vec2d
n2
n :
1-ReadMat
2-PrintMat
3-Sumdiag
4-summat
5-PrintMaxAvg
6-ProdMat
7-TransposeMat
8-SortMat
9-CompressMat
n=6
100101105110110120
100145010
10-DecompressMat
mat1,mat2,mat3
Vec2d : mat1,mat2
mat1
mat1,2
mat3
PrintMaxAvg mat3
mat1mat2
mat3
mat1
mat3
mat1
mat3
mat1
mat1
mat1
mat1
8/2/2019 exercice Pascale
124/128
1 124
program exam;typevec2d=array[1..100] of integer;var
mat1,mat2,mat3:vec2d;m,s:integer;
procedure readmat (var vec:vec2d;n:integer);vari:integer;beginfor i:=1 to n*n do
read(vec[i]);end;
procedure printmat(vec:vec2d; n:integer);vari,j:integer;beginforj:=0 to n-1 do
beginfor i:=(j*n)+1 to n*(j+1) do
write(vec[i],' ');
writeln;end;
end;
procedure sumdiag(vec:vec2d; n:integer; varsum:integer);vari,j:integer;beginsum:=0;for i:=0 to n-1 do
sum:=sum+vec[i*n+1];end;
procedure summat(a,b:vec2d; var c:vec2d;n:integer);vari:integer;beginfor i:=1 to (n*n) do
8/2/2019 exercice Pascale
125/128
1 125
c[i]:=0;for i:=1 to (n*n) doc[i]:=a[i]+b[i];
end;
procedure printmaxavg (vec:vec2d;n:integer);varj,k,sum,i:integer;avg:real;
beginsum:=0;for k:=1 to n*n dosum:=sum+vec[k];
avg:=sum/(n*n);for k:=1 to n*n doif (vec[k]>avg) then
begini:=k div n +1;j:=k mod n ;if (j=0) then
begini:=k div n ;
j:=n;
end;writeln('(',i,',',j,')');end;
end;
procedure prodmat (a,b:vec2d; var c:vec2d ; n:integer);var
i,j,k:integer;beginfor i:=1 to n*n do
c[i]:=0;j:=0;k:=1;while j
8/2/2019 exercice Pascale
126/128
1 126
beginc[k]:=c[k]+a[n*j+(i+1)]*b[n*i+(k-j*n)];i:=i+1;end;
k:=k+1;end;j:=j+1;end;
end;
procedure transposemat (a:vec2d; varb:vec2d;n:integer);vari,j,k:integer;
begink:=1;for j:=1 to n dofor i:=0 to n-1dobeginb[k]:=a[i*n+j];k:=k+1;end;
end;
procedure sortmat (vec:vec2d;var a:vec2d; n:integer);var
i,q,k,t,s,e:integer;begin
for q:=1 to n dofor k:=1 to n-1 dofor i:=(q-1)*n+1 to q*n-k doif(vec[i]>vec[i+1]) then
begin
8/2/2019 exercice Pascale
127/128
1 127
t:=vec[i];vec[i]:=vec[i+1];vec[i+1]:=t;end;
for i:=1 to n*n doa[i]:=vec[i];
end;
procedure compressmat (var vec:vec2d; n:integer);var
i,j:integer;begin
for j:=n downto 1 dofor i:=n*j downto (n*j)-n+2dovec[i]:=vec[i]-vec[i-1];
end;
procedure decompressmat (var vec:vec2d ; n:integer);var
i,j:integer;begin
for j:=0 to n-1 do
for i:=j*n+2 to (j+1)*n dovec[i]:=vec[i]+vec[i-1];
end;
begin{main}writeln('please enter the length ofarray');readln(m);writeln;writeln('please enter the contents of thefirst array');readmat(mat1,m);writeln;writeln('please enter thecontents of the second array');readmat(mat2,m);
writeln;sumdiag(mat1,m,s);writeln('the sum of the maindiagonal"s elements is ');writeln(s);writeln;
8/2/2019 exercice Pascale
128/128
1 128
summat (mat1,mat2,mat3,m);writeln('the result of sum the twoarray ( the third array) ' );printmat(mat3,m);writeln;
writeln('the places of the elements which bigger than the avergein the third array are');printmaxavg(mat3,m);writeln;prodmat(mat1,mat2,mat3,m);writeln('theresult of multiplication the two array ( the third array) ');printmat(mat3,m);writeln;transposemat (mat1,mat3,m);writeln('thetransported of the first array');printmat(mat3,m);writeln;sortmat(mat1,mat3,m);writeln('the first arrayaftersorting');printmat(mat3,m);writeln;compressmat(mat1,m);writeln('the first array after compression');printmat(mat1,m);writeln;
decompressmat(mat1,m);writeln ('the last array afterdecompression');printmat(mat1,m);writeln;
dl
![exercice Pascale - [PDF Document] (2024)](data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAAEAAAABCAQAAAC1HAwCAAAAC0lEQVR42mP8/h8AAvMB+NzmkbcAAAAASUVORK5CYII=)