مسائل محلولة في البرمجة 1

نبذة





الفصل الاول تمارين ابتدائية






Program Calc (output) ;
Var x,y:integer;
Begin
Writeln(‘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(‘The Result of ‘,x,’ / ’,y, ‘ = ‘,x/y);
End.




Program Power_To_ppl ;
Var x,n,i,Res:integer;
Begin
Res :=1;
Writeln(‘Enter Two numbers X, and n ‘);
Readln(x,n)
For i=1 to n do
Res= Res *X;

Writeln(‘The Result is ‘,Res);
End.




Program Flip_Flop ;
Var n,m,num:integer;
Begin
Writeln(‘Enter The Number ‘);
Readln(n);
while (n div 10 <>0 )do
begin
m:= n mod 10;
num:= m+num*10;
n:= n div 10;
end;
Writeln(‘The Number After Flipping ‘,n);
end.






Program Damn_The_e ;
Var x,n,i,counter :integer;
Power,fact ,res:real
Begin
fact :=1; counter=2; res =0;
Writeln(‘Enter Two numbers X ‘);
Readln(x);
Power=x;
While (power div fact < 10 ^(-5)) do
begin
For i=2 to counter do
begin
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.



.
program Numberz;
var
Digit_counter,m, i,a,b,min,max,sum,first,last:integer;
begin
Readln(a,b);
If (a>b)then
Max =a; min =b
Else
max=b; min =a
first=min ; last =max
while (first <=max ) do
begin
last = last -1
fisrt = first +1
writeln(last)
end;
end.
2:
Readln(n)
Sum=0;
For i=0 to n do
If i mod 2 =0 then
Sum= sum+i;
3:
Readln(m)
Digit_counter=0;
While (m <>0) do
begin
Digit_counter = Digit_counter+1;
M = m div 10;
End;
writeln(m);
End.




program Banks;
var i,num,year,value:integer;
p :float ;
begin
1:
Readln(year,num,p)
For i=1 to year do
Num = num + Num *p;

2:
Y=0; Value =2*num;
While (num<= value )do
begin
num= num +num *p;
Y=Y+1;
End;
Writeln(y);
end;




program Bills ;
var
N,q,Unit_price,Total,net_price :integer;
q=0; Unit_price=0 ; Total =0; net_price=0 ;
begin
Readln(n);
For i =1 to n do
begin
Writeln(‘Enter the price for the product num ‘,i);
Readln(Unit_price);
Writeln(‘Enter the Quantity for the product num ‘,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.




program Reading with the stars ;
var ch,ch1 : char;
countchr: integer; // Char counter
countnum: integer; // Numbers Counter
counter3: integer; // Other Char Counter
begin
writeln('Enter the text');
countchr:=0; countnum:=0; counter3:=0;
while (ch <> '.') do
begin
ch1:=ch;
read (ch);
case ch of
'0'..'9' :
begin
ch:=chr(ord('9')-ord(ch) + ord('0') ) ; //Converting Number
countnum:=countnum+1;
end;
'a'..'z':
begin
countchr:= countchr+1;
ch:=chr(ord('A')+ord(ch)-ord('a')); // Converting to Capital
end;
if (ch1 = ' ') or (ch1= ',') or (ch1= ' " ') then
counter3:=counter3+1;
end; // While
write(ch);
end;
writeln('The number of the letters =',countchr);
writeln('The number of numbers are = ',countnum);
writeln('Number of the symbols = ',counter3+countnum+countchr);
end. // End of program






program Semitic _Arrays;

const maxn=100;

var A:array [1..maxn]of integer;
b:boolean;
n:integer;
i:integer;
begin
writeln('Please enter the Array Length ');
readln(n);
writeln('Please enter the elements so The Array can be initialized ‘);

For i:=1 to n do
readln(A[i]);
b:=true;
For i:=1 to n do
if (A[i]<>A[n-i+1]) then
b:=false;

if (b=true) then
writeln('The matrix is Semitic ‘);
else if (b=false) then
writeln('The matrix is not Semitic ‘);
readln;
end.






Program employee ;
Const m=100;
Type Matrix =array[1..m] of integer;
Var
Num,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 of employees‘);
Readln(z);
Writeln(‘Please Enter the number of the employee’);
For j =1 to z do
begin
Readln(Num[j]);
End;

Writeln(‘Please Enter the basic Salary for each employee’);
For j=1 to z do
begin
Readln(Basic[j]);
End;

Writeln(‘Plz Enter the compensations for each employee’);
For j=1 to z do
begin
Readln(Comp[j])
End;

Writeln(‘Please Enter the Discounts for each employee’);
For j=1 to z do
begin
Readln(Dis[j]);
End;

For j=1 to z do
Total[j]=Basic[j]+Comp[j]-Dis[j]

Writeln(‘employee No Basic Salary Bounces Discounts Total ‘);
Writeln;
For j=1 to z do
Begin
Write(Num[j]:5,’ ‘,Basic[j]:5,’ ‘,Comp[j]:5,’ ‘,Dis[j]:5,’ ‘,Total[j]:5);
Writeln;
End;

Max1=Basic[1];

Mx2=Comp[1];

X=num[1];

Y =num[1];

Min=dis[1];

Sum=0;

For j=1 to z do
Begin
If Basic[j]>max1 then
Max1=Basic[j];

If comp[j]>max2 then
begin
Max2= comp[j];
X=num[j];
End;

If dis[j] Begin
Min= dis[j];
Y=num[j];
End;
Sum= sum + total[j];
End;
Avg= sum/z;
Write(max1,x,y,avg);

End.

11.لدينا مصفوفة مربعة بعدها n.n يتم إدخال البعد n من قبل المستثمر والمطلوب
1-حساب مجموع عناصر محيط هذه المصفوفة

2- حساب مجموع عناصر الأسطر m الأخيرة من هذه المصفوفة

3-حساب مجموع عناصر المثلث العلوي في المصفوفة المربعة ما عدا القطر الرئيسي

4-فرز عناصر القطر الثانوي لمصفوفة مربعة تصاعدياً

program Matrix ;
const z= 100;
var A: array [1..z,1..z]of integer;
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;
begin
writeln('Enter the length of the array');
readln(n);
{reading the Array}
for i:=1 to n do
for j:=1 to n do
readln(A[i,j]);
// جمع عناصر السطر الأخير والسطر الأول والعمود الأول والأخير
sum1:=0;
for i:=1 to n do
sum1:=(sum1+A[i,1]);
sum11:=0;
for i:=1 to n do
sum11:=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('the sum of the circumfence is',sum);
// طباعة المصفوفة بشكل ثنائي
for i:=1 to n do
begin
write(' ');
for j:=1 to n do
write(A[i,j],' ');
writeln(' ');
end;
writeln('Enter m number of lines to show u the sum');
readln(m);
if (m>n) or (m<0) then
begin
writeln('please try again');
g:=false;
readln(m);
while (m>n) do
readln(m)
end
else v:=n-m;
for j:=v+1 to n do
for 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
begin
for 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 do
begin
j:= n;
for i := 1 to n-f do
begin
if a[i,j] < a[i+1,j-1] then
begin
t := a[i,j];
a[i,j] := a[i+1,j-1];
a[i+1,j-1] := t;
end;
j:= j-1
end;
end;
for i := 1 to n do
begin
writeln(' ');
for j := 1 to n do
write(a[i,j] , ' ');
writeln(' ');
end;
readln;
end.
End.

12.اكتب تابع يقوم بفحص مصفوفة مربعة بعدها n فيما اذا كانت متناظرة ام لا

2-اكتب اجرائية تقوم بإيجاد القيمة العظمى لعناصر مصفوفة متناظرة

3-اكتب تابع يقوم بإيجاد القيمة العظمى لعناصر مصفوفة غير متناظرة

4-اكتب برنامجاً يستدعي التوابع والإجرائيات السابقة لإيجاد القيمة العظمى لعناصر مصفوفة ما

program Matrix_part2;
type mat=array[1..10,1..10]of integer;
var a:mat;
n,i,j,max:integer;
ok:boolean;

{1}
function simitric(n:integer):boolean;
var i,j:integer;
error:boolean;
begin
i:=1;
error:=false;
while (i<=n ) and (not error) do
begin
j:=1;
while (j<=n) and (not error) do
begin
if a[i,j]<>a[j,i] then
error:=true
else
j:=j+1;
end;
i:=i+1;
end;
simitric:=not error;
end;
{end fo function simitric}
{2}
procedure max1(n:integer;var max:integer);
var i,j:integer;
begin
max:=a[1,1];
for i:=1 to n do
for j:=1 to n do
if a[i,j]>max then
max:=a[i,j];
end;
{end for procedure max1 }



{3}
function max2(n:integer):integer;
var i,j,max:integer;
begin
max:=a[1,1];
for i:= 1 to n do
for j:=1 to n do
if a[i,j]>max then
max:=a[i,j];
max2:=max;
end;
{ end fo function max2}

{4}
begin {main program}
writeln('please inter long the matrix');
readln(n);
for i:=1 to n do
for j:=1 to n do
readln(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 by procedure =',max);
writeln('the max value in the simitric by function =', max2(n));
writeln;
for i:=1 to n do
begin
for j:=1 to n do
write(a[i,j],' ');
writeln;
end;
readln;
End.

13.اكتب اجرائية تاخذ كوسيط سلسلة محارف تمثل تعبير رياضي وتعيد نتيجة منطقية تدل على صحة هذا التعبير آو عدمه
علماً ان سلسلة المحارف تقبل فقط محارف رقمية 0-9 وتقبل العمليات *و-و+

2-اكتب تابع ياخذ كوسيط سلسلة محارف تمثل تعبير رياضي ويعيد قيمة هذا التعبير
علماً ان سلسلة المحارف تقبل فقط محارف رقمية 0-9 وتقبل العمليات *و+و-

3-اكتب برنامج يقرا سلسلة محارف ويستدعي الإجرائية الأولى للتأكد
اذا كانت سلسلة المحارف هذه تمثل تعبير رياضي آو لا وفي حال كانت تعبير عن
تعبير رياضي فيطلب استدعاء التابع الثاني لإيجاد قيمة هذا التعبير

program MatExp;

type
PStack=^Element;
Element=record
val:string;
prev:PStack;
end;

var
a:string;
x,c:char;
elem:Element;
n,n1,n2,b:integer;
top,auxtop,ptop,Rtop:PStack;


procedure Push(var ptop:PStack; elem:Element);
var
temp:PStack;
begin
new(temp);
temp^:=elem;
temp^.prev:=ptop;
ptop:=temp;
end;



procedure Clear(var ptop:PStack);
var
temp:PStack;
begin
while (ptop<>nil) do
begin
temp:=ptop;
ptop:=ptop^.prev;
dispose(temp);
end;
end;

function StrToIntConvert(a:string; n:integer):integer;
var
conc,i,j,s:integer;
begin
conc:=0;
j:=1;
while (j<=n) do
begin
s:=(ord(a[j])-ord('0'));
for i:=j+1 to n do
s:=s*10;
conc:=conc+s;
j:=j+1;
end;
StrToIntConvert:=conc;
end;

function Calc(n1,n2:integer; c:char):integer;
var
sum:integer;
begin
case c of
'+': sum:=n1+n2;
'*': sum:=n1*n2;
end;
Calc:=sum;
end;





function IntToStrConvert(b:integer):string;
var
t,c,i,n,d:integer;
s:string;
begin
t:=b;
n:=0;
while (t<>0) do
begin
t:=t div 10;
n:=n+1;
end;
c:=1;
for i:=2 to n do
c:=c*10;
i:=1;
s:=' ';
while (i<=n) do
begin
d:=b div c;
s:=s+chr(ord('0')+d);
b:=b-(d*c);
c:=c div 10;
i:=i+1;
end;
delete(s,1,1);
IntToStrConvert:=s;
end;

function Combine(var ptemp:PStack):string;
var
bo:boolean;
s:string;
begin
s:=ptemp^.val;
bo:=true;
while (bo) do
begin
if ((ptemp^.prev^.val='1') or (ptemp^.prev^.val='2') or (ptemp^.prev^.val='3') or (ptemp^.prev^.val='4')
or (ptemp^.prev^.val='5') or (ptemp^.prev^.val='6') or (ptemp^.prev^.val='7') or (ptemp^.prev^.val='8') or (ptemp^.prev^.val='9')) then
begin
s:=s+ptemp^.prev^.val;
ptemp:=ptemp^.prev;
end
else
bo:=false;
end;
Combine:=s;
end;

procedure Transfer(var top,auxtop:PStack);
var
d,Ssum:string;
temp,temp1:PStack;
check1,check2:boolean;
num1,num2,sum:integer;
begin
temp:=top;
while (temp<>nil) do
begin
if (temp^.val='(') then
begin
temp1:=temp^.prev;
check1:=true;
check2:=false;
while (temp1^.val<>')') and (check1) do
begin
if (temp1^.val='(') then
check1:=false;
if ((temp1^.val ='+') or (temp1^.val='*')) then
check2:=true;
temp1:=temp1^.prev;
end;

if (check1) and (check2) then
begin
temp:=temp^.prev;
sum:=0;
while (temp^.val<>')') do
begin
if ((temp^.val<>'+') and (temp^.val<>'*')) then
begin
d:=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;
end
else
begin
num1:=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);
end
else
push(auxtop,temp^);
end
else
push(auxtop,temp^);
temp:=temp^.prev;
end;
clear(top);
end;

procedure AuxTransfer(var top,auxtop:PStack);
var
temp:PStack;
begin
temp:=auxtop;
while (temp<>nil) do
begin
push(top,temp^);
temp:=temp^.prev;
end;
clear(auxtop);
end;









Begin
top:=nil;
Rtop:=nil;
auxtop:=nil;

writeln(‘plz insert a mathematical expression between parentheses and ending with "." ');
read(x);

while (x<>'.') do
begin
elem.val:=x;
push(Rtop,elem);
read(x);
end;

AuxTransfer(top,Rtop);

while (top^.prev<>nil) do
begin
Transfer(top,auxtop);
AuxTransfer(top,auxtop);
end;

writeln;
writeln('after calculating ... the conclusion = ', top^.val);

readln;
readln;

End.





الفصل الثاني مسائل ابتدائية 2

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 = Max2
Writeln( Max1)

ملاحظة برمجية عند وجود شرطين if متتالين كما في مثالنا فإن الحاسب
سيقوم بفحص الشرطين معاً وفي حال عدم تحقق احدهما سينتقل إلى else
الموافقة لل if للشرط المختل الحل بطريقة اخرى :

If (a>b ) And (a>c ) And (a>d) then
Max =a
Else if (b>c) And (b>d) then
Max =b
Else if (c>d)
Max=c
Else max=d
Writeln(max)

2.اكتب برنامج يقرأ مجموعة من الأعداد ويطبعا وإذا ادخل 10 يتوقف البرنامج عن العمل

Readln(n)
While (n <> 10 ) do
Writeln(n);
Readln(n);
آو عن طريق التعليمة التالية break التي تؤمن خروج من الحلقة غير المنتهية
While (true)
Readln(n)
If (n = 10)
Break
Writeln(n)

3.اكتب برنامج يبدل بين قيميتن مثال إذا كانت a=3 و b=2 يصبح a=2 و b=3

الطريقة الأولى :عن طريق 3 متحولات
Temp = a;
a=b;
b=Temp;

الطريقة الثانية : عن طريق متحولين فقط
a =a-b
b =a+b
a =b-a

4.السنة الكبيسة هي سنة يكون فيها عدد أيام شهر شباط 29 يوماً بدلا من
28 يوم ,تكون السنة كبيسة إذا كانت تقبل القسمة على 4 بدون باقي ,باستثناء
السنوات التي تأتي في نهاية كل قرن حيث يجب ان تقبل القسمة على 400 بدون
باقي لتكون كبيسة وهكذا فإن السنوات 1996و 1940 و 200 مثلا هي سنوات كبيسة
في حين السنوات مثل 1995 و 1969 و1900 و 1800 ليست كبيسة . اكتب برنامج
بلغة شبه الرماز لقراءة السنة وطباعة إن كانت كبيسة ام لا

Readln( year )
Isleap= false;
If (year mod 4 = 0 )then
If (year mod 400 =0 )then
Isleap= true
Else
If (year mod 100 =0 )then
Isleap=false;
Else isleap=true;
Else
Isleap = false
السنة تقبل القسمة على 4 و 400 = كبيسة
السنة تقبل القسمة على 4 ولا تقبل القسمة على 400 وتقبل على 100 = ليست كبيسة
السنة تقبل القسمة على 4 ولا تقبل على 400 ولا 100 = كبيسة

5.لدى عميل في بنك مبلغ قيمته A يتقاضى فائدة سنوية قيمتها p لعدد من السنوات y احسن واطبع قيمة المبلغ بعد انقضاء عدد السنوات y

Read A,p,y
C=1
While (c<= y )do
A = A+A*p
C= C+1
Writeln(A)

6.اكتب برنامج يقرأ مبلغ قدره A والفائدة التي يعطيها البنك لهذا المبلغ p والمطلوب طباعة بعد كم سنة يتضاعف المبلغ

Readln(a,p)
Y=0
Value =2*a;
While (a<= value )do
A= A +A *p;
Y=Y+1
Writeln(y)

7.اكتب برنامج لقراءة عددين a,b وطباعة الأعداد المحصورة بينها تنازلياً

If (a>b)then
Max =a; min =b
Else
max=b; min =a
first=min ; last =max
while (first <=max ) do
last = last -1
fisrt = first +1
writeln(last)

8.اكتب برنامج لقراءة عدد صحيح n وطباعة n! بحيث تعرف
n!= n*(n-1)*(n-2)*(n-3)*…….1

fact: =1;
readln(n)
for i:=1 to n do
fact:=fact*n;
writeln)‘The Factor of the number ‘,n,’is ‘,fact(;

9.اكتب برنامج لحساب X مرفوع للقوة n بحيث يكون x,n دخل من المستثمر بطريقة تكرارية

Res :=1;
Readln(x,n)
For i=1 to n do
Res= Res *X;
Writeln(Res);

10.اكتب برنامج لحساب مجموع الأعداد الفردية من 1 إلى 100

Sum=0
For i =1 to 100 do
Sum = sum +i

Writeln(sum)

11.اكتب برنامج لجدول ضرب العدد n بجميع الأعداد من 1 إلى 10

Readln(n)
For i=0 to 10 do
Prod =n *i
Writeln( prod)

12.اكتب برنامج يوجد جدول الضرب لجميع الأعداد من 1 إلى 10 وذلك بان
نوجد جدول خاص لضرب الأعداد مثلا بين 1 وبين باقي الأعداد وبين 2 وباقي
الأعداد وهكذا

نحتاج إلى حلقتين كوننا نسير على مجموعتين من الأعداد

For i =1 to 10 do
For j = 1 to 10 do
begin
Prod= i*j
Writeln(prod)
end;

13.اكتب برنامج يقوم بعملية الضرب باستخدام الجمع

Readln(m,n)
mult:=0;
For i:=1 to n do
Mult:=Mult+m;
Writeln(mult)

14.اكتب برنامج لقراءة وطباعة التاريخ ويقوم بما يلي

قراءة متحول يمثل السنة 1989 إلى 2007

قراءة متحول يمثل الشهر من 1 إلى 12

قراءة متحول يمثل رقم اليوم 1 إلى b

بحيث يمكن ان نناقش اذا كانت السنة كبيسة ام لا وتعود b إلى الشهر المناسب فهناك اشهر فيها 31 يوم واخرى 30 و29
المطلوب إدخال المستخدم رقم التاريخ وإذا ادخل رقم خاطىء نطلب منه إعادة الإدخال حتى يتم الادخال الصحيح
وعند الادخال الصحيح يتم أظهار التاريخ بشكل كامل

Cyear =false هل هي سنة كبيسة ام لا
Between = false
Read a,b // years
While not (between ) do
Read (year )
If (year >=a ) and (year <=b )
Between =true
If (year mod 4 =0 )
Cyear =true لن ندخل بكثير من التفاصيل سنقبل بالقسمة على 4 فقط ولن نتطرق إلى كافة الشروط
Between =false
While not (between )do
Read(month)
If (mnth >=1 ) and (month <=12 )
Between =true
A=1 , b=31
If (m=2)
If cyear =true then
B=29
Else b=28
Else if (m=4) or (m=6) or (m=9) or (m=11)
B=30
Between =false
While not (between)do
Read (day)
If day>=1 and day<=b
Between =true
Writeln(day, month, year )

15.اكتب برنامج يقوم بعملية القسمة باستخدام عملية الطرح

Read m,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 <=n( do
begin
readln)m(; {الأرقام المدخلة من المستخدم }
isdone_ check:=false; i:=2;
While )i <=m-1( and )not isdone_ check) do {true }
if i mod m=0 then { أي انه ليس أولي }
isdone_ check:=true;
else
i:=i+1;
isdone_ check:=false;
end; {while 2}
if isdone_ check =true then
write)m(;
j = j+1;
end; { while 1}

شرح الطريقة

مثال لنفرض انه n =3 أي هناك 3 أعداد للإدخال نقرأ العدد m ثم نسند
ل i متحول من نمط عدد صحيح العدد 2 لان الواحد يقبل القسمة already وهذه
العملية ستبين التالي : نفرض ان تم إدخال 6 ثم 7 بالنسبة لل 6 سيدخل
i وياخد القيم من 2 –5 وبيشوف إذا في عدد متل 2 هلق هو يقبل القسمة
على 2 إذا هيك بيطلع وما بيطبع العدد بينما إذا فتنا على 7 لح نلاقي انو
مافي أعداد من 2-6 بتقبل القسمة على 7 فلا نطبعه
17.اكتب برنامج يجمع آخر عددين مدخلين

Readln n ; عدد الأرقام المدخلة sum:=0;
for i:=1 to n do
begin
Readln m ;
if i+1=n then
sum:=sum+m;
end;
writeln(sum)
آو طريقة أخرى نحن لا نعلم عدد الأرقام المدخلة
Sum=0,m=0;
C :srting
While ( c <>‘no ‚) do
begin
Writeln(‘Do u want to read a number ‘)
Readln(c)
Sum2=m; // The old value of m
If c=’yes’ then
Readln(m)
Sum2=m;
Else
Sum =sum1 +sum2;
End;

18.اكتب برنامج يطبع الشكل حيث يدخل المستخدم عدد n ليحدد عدد الأسطر

1

212

32123

4321234

Readln n ;
Writeln)1(;
for i:=2 to n do
for j:=i downto 2 do
write)j:4(;
for j:=1 to i do
write)j):4((;

19.اكتب برنامج يدخل 10 أعداد تكون محصورة بين 10-100 ويطبع التي لم تتكرر
ملاحظة للحل :بما ان لدينا 10 أعداد فنشكل مصفوفة لا ن بعدها ثابت ونضع الأرقام ثم نطبع الأعداد غير المتكررة

var A: array]1..10[ of integer;
i:=1;
while i<=10 do
begin
read m
if m in 10..100 then {m >=10 & m<=100}
begin
A]i[n=n m;
i:=i+1;
end;
else
writeln )‘Enter a number which have the domain 10..100’(
j:=1;
{// طباعة غير المكرر}
while j< 10 do
for k:=j+1 to 10 do
begin
if A]j[ n=n A]k[ then
found:=true
else found:=false;
end;
if found=false then writeln A]j[;
end;

20.اكتب برنامج يقوم بتبديل بين أول مرتبة وآخر مرتبة بالعدد
مثال : العدد 1217 يصبح 7211 سؤال وظيفة عملي

num,mid=0,n2,digits,last,first,n1=0,res : integer;
readln num;
first =num mod 10;
n2 =num; digits =1;
while )n2 div 10 <> 0( do
begin
Digits = digits +1;
n2 =n2 div 10;
last =n2;
end

n2 =num div 10;
int digit_counter =1;
for ) i=1 to digits-2 ( do
begin
mid = n2 mod 10 * powf)10,digit_counter(;
n1 =n1+mid;
n2 =n2 div 10;
digit_counter=digit_counter+1 ;
end


for ) m=1 to digits-1 ( do
first =first*10;

res =last+first+n1;
Writeln ) res (

شرح الطريقة ناخذ الرقم الاول بعملية واحدة هي العدد mod ال10 بينما
الرقم الأخير نقوم بحساب عدد خاناته ولنفترض لديناالرقم 1234 فينتج لدينا
4 خانات فيكون آخر عدد 1234 مقسوم على 1000 فينتج 1 فيكون العدد الناتج هو
4000+ 1 + رقم نشكله وهو يمثل القسم الأوسط من العدد نقوم بعملية بسيطة
لنشكل العدد 230 وهذه العملية بعد تعريف digit_counter بالقسم الأوسط من
الكود



21.اكتب برنامج يقوم بإدخال عدد من المستثمر ويحسب عدد خاناته

Function Number_digit )n:integer(integer;
Var digit:integer;
Begin
Digit:=0;
While n div 1o <> 0 do
begin
digit:= digit+1;
n:=n div 10
end;
end;

22.اكتب برنامج يقيوم بمعرفة هل الرقم المدخل بدايتو تساوي نهايتو

Readln n
first:=n mod 10;
while n <>0 do
begin
last:=n div 10
n:=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 m
For k:=1 to n do
If k mod 2 = 0 then
Sum:=sum-k;
Else
sum:=sum+k;

24.ندخل عدد الثواني ثم يقوم الحاسب بإظهار عدد الساعات ،الدقائق،الثواني على الشكل التالي hs

program time;
var
hour,min,sec,temp,temp2,day,t:longint;

begin
writeln)'enter your time in the form of seconds'(;
Readln)t(;
sec:=t mod 60;
temp:=t div 60;
min:=temp mod 60;
temp2:=temp div 60;
hour:=temp2 mod 24;
day:=temp2 div 24;
writeln)'day=',day,' hour=',hour,' min=',min,' sec',sec(;
readln;
end.
آو يمكن الحل بهذه الطريقة
Function getTime)seconds: LongInt(: String;
Var
H, M, S: Integer;
Begin
H := seconds div 3600;
seconds := seconds mod 3600;
M := seconds div 60;
S := seconds mod 60;
getTime := IntToStr)H( + ':' + IntToStr)M( + ':' + IntToStr)S(;
End;

25.اكتب برنامج ينشى السلسة التالية :
1-1-2-3-5-8-13-21-34…..

هذه السلسة هي سلسة فيبوناتشي حيث ينتج كل حد نتيجة جمع حدين سابقين له
الحل وفق متحولين وسيطين دون العودية وفق طريقة تكرارية وهي اسرع بكثير من العودية

x=0;
y=1
for i=2 to n-1 do
begin
temp=y
y=y+x
x=temp
end

26.أوجد جذر عدد مدخل موجب

الحل يترك كوظيفة للقارىء

احدى الطرق تتمثل بان نجمع عدد الأعداد الفردية المكونة للرقم
مثال
جذر ال16 هو 4 لان عدد الأعداد الفردية والتي مجموعها يساوي 16 هي 4 أعداد فردية
1+3+5+7

الفصل الثالث مسائل على المحارف 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-9

Ch:=chr)ord)0( + ord)9) - ord)ch) + x(

الأحرف
التحويل من حرف صغير إلى كبير a..z
ch:=chr)ord)‘A’ + (ord)‘a’ - (ord)ch((;
آو يمكن بطريقة أخرى

ch:=chr)ord)‘Z’ ( n-n ord)‘z’ (n+n ord)ch((;

التحويل من حرف كبير إلى حرف صغير A..Z

Ch=chr(-ord(‘a’) +ord(‘A’) +ord(ch));


1.اكتب برنامج لتحويل سلسلة من الكلمات من كبتل إلى اسمول وحساب أحرف العلة

تذكرة : أحرف العلة بالإنجليزية تذكرة a,u,e,o,i

S:string
for i=1 to length)s( do
if ord)s]i[ >’A’( and ord)s]i[<’Z’(
s]i[ n=n chr)ord)c(n-n ord)‘A’) n+n ord)‘a’((

if s]i]n=n ’a’ or s]i] n=n ’u’ or ……. then
Vowel=vowel +1

2.اكتب برنامج يعكس كل كلمة داخل سلسلة

first,last:integer
s:string]100[
first=1
while i<= length)s( do
if s]i] n=n ’ ‘ then
begin
first=i+1 ; last=i-1
for j=last downto first do
write s]i[ ;
writeln;
end;{if}
else
i=i+1

3.اكتب برنامج يأخذ أول حرف من كل كلمة ويطبعه

Write s]1] n:n 4
for j=2 to length)s(do
if s]j] n=n’ ‘ then
write)s]i+1] n:n 4(

4.اكتب برنامج يعرف ان هل الكلمة تقرأ من الجانبين ام لا )بكلمة أخرى هل هي متناظرة ام لا بالنسبة للمنتصف

For i =1 to length (s) div2 do
begin
If S[i] = S[length (s) –i+1] then
Is_semtirc =true;
Else
Begin
Is_semtirc =false ;
Break;
End;
End;

5.اكتب برنامج تدخل سلسلة من الكلمات ويعكس جميع الكلمات ما عدا اول وآخر كلمة

إيجاد خانة البداية لثاني كلمة وآخر كلمة
For i =1 to length (s) do
If S[i] =‘ ‚ then {space }
First =i
If S[length (s) –i+1 ] = ‚ ‚ then {space }
Last = length (s) –i+1
العمل ضمن مجال الكلمة لعكس الأحرف
First _temp_word = first;
For i = first to last do
If S[i] = ‘ ‘ then {space }
begin
Last_temp_word = i;
For j= First _temp_word to Last_temp_word div 2 do
S[j]= S [Last_temp_word –j +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;

7.اكتب برنامج يطبع كلمة Capital وكلمة Small

i=1
for j=1 to length)s(
if i mod 2=o then زوجي
begin
if ord)s]i[(>’a’( and ord)s]i[ <’z’( then الحرف صغير
write s]i] n:n 4
else
write )chr)ord)s]i[(-ord)‘A’(+ord)‘a’((
end {if}
else فردي
if ord)s]i[(>’A’( and ord)s][i[<’Z’( then
write)s]i[:4(;
else
write )chr)ord)s]i[ n)+n ord)‘A’) n-n ord)‘a’((

8.المطلوب إدخال نص (محرف محرف ) ينتهي بنقطة ومن ثم اظهار النص المدخل و ذلك بعد عكس المحارف
مثال: النص المدخل .dido
و النص بعد المعالجة odid.

A:array ]1..100[ of char
C:char
Repeat
Read c
A]i] = c
I:=i+1;
Until c=’.’
For j:=I downto 1 do
Write)A]i[:4(

program paragraph )input,output( ;
const
n = 10;
var
a : array]1..n[ of char;
i:integer;
m:char;
begin
read m ;
writeln) ' Please enter the text in order to reverse it' ( ;
i:=1 ;
while )m<> ' . ' (and )i<>n(do
begin
a]i[ := m;
read m ;
i:= i+1;
end;
for i:=n downto 1 do
begin
write)a]i[( ;
end;
readln; readln;
end.

9.اكتب برنامج بلغة باسكال يقوم بقراءة سلسلة من المحارف(string)تنتهي
بالمحرف(.)ثم يقوم البرنامج بأيجاد المحرف ذي التواتر الاكبر(المحرف الذي
يرد في سلسلة المحارف لاكبر عدد من المرات) وأظهاره

program test;
type
vect=array]'a'..'z'[of integer;
var j:char; max,i:integer; s:string; a:vect; found:boolean;

begin
writeln)'write the text'(
read)s(;
i:=1;
j:='a';
while)s]i[<>'.'do
begin
found:=false;
j:='a';
while)j<>'z' ( and)not found(do
begin
if)s[i] =j )then
begin
a[j]= a[j+1]
found:=true;
end;
j:=succ(j)
end;
i:=i+1;
end;





(*this section is to count the freq for each letter *)
max:=a]'a'[; (*comparing the max *)
for j:='a' to 'z' do
begin
if(max max:=a[j] ;
end;

for j:='a' to 'z' do (*showing off that max*)
begin
if(max=a[j] )then
begin
case j of
'a':writeln('a');
'b':writeln('b');
'c':wrietln('c');
.........
'z':writeln('z');

end; (*case*)
end; (*if*)
end; (*for*)
readln;

end.

10.أكتب برنامج لفصل سلسلة حرفية الى ثلاث مجاميع واحدة للحروف الكبيرة
و الثانية للأرقام و الثالثة للحروف المتبقية من السلسلة الحرفية طبعا
باستخدام ال string

Capital :array ]‘A’..’Z’[ of char
Number:array ]1..9[ of integer;
ordinary:array]‘a’..’z’[of char

Writeln)‘Enter the text’(;

Read)s(; )*s is verify as string *(;
For i:=1 to length)s( do
Case s]i[ of
‘A’..’Z’ : capital]i[ =s]i[;
‘1’..’2’ : number ]i[ =s]i[;
‘a’..’z’ : ordinary]i[ =s]i[;’





الفصل الرابع العمليات على المصفوفات

المسألة 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
begin
Read(A[i]);
If A[i] Min =A[i]
If A[i]>max then
Max =A[i]
Avg= Avg+A[i]
End;
Avg= avg / n;
Readln(m)
For i=1 to n do
If A[i] =m then
Freq =Freq +1;

Writeln(freq)

end.

المسألة 2:
أكتب برنامج بلغة الباسكال يقوم بقراءة مصفوفة أحادية بعدها n ثم إيجاد :
1-مجموع الأعداد الزوجية في المصفوفة .
2-مجموع الأعداد ذات الترتيب الفردي في المصفوفة (هذا الطلب دون استخدام mod ).

program Vertex ;
var n,i,sum :integer;
A: Array [1..100] of integer ;
begin

Readln(n)
Sum=0;
For i =1 to n do
Readln(A[i]);

For i=1 to n do
If A[i] mod 2 = 0 then
Sum = sum+1;
2:
I =1
While i <= n do
Sum= sum+1
I=i+2;

end.

المسألة 3:
أكتب برنامج بلغة الباسكال يقوم بقراءة مصفوفة A و إعادة مصفوفة أخرى B
بحيث تكون B تحتوي عنصر من A ثم ضعفه ثم العنصر التالي من A ثم ضعفه و
هكذا .... مثال :
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;

Begin
Readln(n);
For i =1 to n do
Read(A[i])
I=1; j=1;
While i<=n do
begin
B[j]=A[i];
B[j+1]=A[i]*2;
J= j+2;
I =i+1;
end;

For i =1 to n do
write(B[i]),’ ‘);
end.

المسألة 4:
أكتب برنامجاً يأخذ مصفوفتين A,B بعد كل منهما n و دمجهما في مصفوفة ثالثة C بطريقتين :
1- ملء C بعناصر A كلها ثم عناصر B كلها .
2- ملء C بالعناصر بالتناوب واحدة من A و الأخرى من B (و ذلك بطريقتين الأولى باستخدام عدادين و الثانية باستخدام عداد واحد ).
مثال :

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,b

For i=1 to n do
C[i]=A[i];
C[n+i]=B[i];
1:
i=1
j=1;
while i<= n do
begin
C[j]=A[i]
C[j+1]=B[i];
i=i+1
j=j+2
end;
الطريقة الثانية :
k=1 ;
while (k <= 2*n) do
begin
C[ k ]=A[k/2+1];
C[k+1]=B[k/2+1];
k=k+2;
end

المسألة 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 ....
ثم لاحظ ماالذي يربط بين كل قيمة لi و المجال الذي تتراوح بينه الj من أجل هذه القيمة؟؟؟؟

A[10,10] :Matrix
n :integer;
writeln(‘Input The Length of A’);
readln( n) ;
writeln( ‘Input The element of A ...’;
for i= 1 to n do
begin
for j= 1 to n do
begin
readln A[i,j];
end;
end;
sum =0;
{calculation The Sum of the elements of matrix That Upper Main diameter}

writeln(‘calculation The Sum of the elements of matrix That Upper Main diameter .. ‘) ;
writeln(‘The Index of The element.. ‘) ;
for i=1 to n do
begin
for j=i to n do
begin
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 Main diameter }
writeln(‘calculation The Sum of the elements of matrix That under Main diameter ‘);
sum =0;
writeln(‘The Index of The element...’) ;
for i=1 to n do
begin
for j= 1 to i do
begin
sum= sum + A[i,j];
writeln(‘i= "’, i,’ j=" ‘, j );
end;
writeln;
end;

writeln(‘The Sum : " ‘, sum );

المسألة 6:
اكتب برنامج يعكس عناصر القطر الرئيسي أو الثانوي بمصفوفة ثنائية
1 2 223 22
35 2 26 24
45 5 3 27
54 54 54 4

تصبح على الشكل
4 2 223 22
35 3 26 24
45 5 2 27
54 54 54 1

ملاحظة قبل الحل
المصفوفات المربعة هي فقط التي يوجد لها قطر رئيسي او ثانوي حيث المصفوفة من البعد n
شرط القطر الرئيسي هو ان A[i]=A[j] آو A[i,i] و الثانوية i+j=n

For 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 do
temp= 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 [

المسألة 8:
لدينا مصفوفة ثنائية البعد تدخل الرقم المراد البحث عنهnum وكم مرة إذا
تكرر ويطبعه إذا تحققت الشروط ان كان عدد التكرار freq أكبر من قيمة max
يدخلها المستخدم

Read)num,max(;
freq:=0;
for i:=1 to n do
for j:=1 to n do
begin
if A ] i , j [ n=num then
freq:=freq+1;
end;
if )freq>max( then
write)freq(

المسألة 9: اكتب برنامج يقوم بتبديل أصغر عنصر في مصفوفة بأكبر واحد وإعطاء إحداثيات العنصر الأكبر والأصغر قبل النقل

Max=n ]a , b[; min=n]c, d [
max:=A]1,1[; min:=A]1,1[;
for i:=1 to n do
for j:=1 to n do
begin
if A]i,j[> max then
begin
max:=A]i,j[; a:=i; b:=j;
end;
if A]i,j[ < min then
begin
min:=A]i,j[; c:=i; d:=j;
end;
end;
swap) A]a,b[ , A]c,d[ (
Writeln ‘Max is’,max’min is’,min
Writeln )‘The position for max is’,a,b,’And for the min ‘,c,d(

المسألة 10:
اكتب برنامج يزيح مصفوفة ثائية إلى اليمين بمقدار k
1 2 3
4 5 6
7 8 9
تصبح وعندما تساوي 3 نرجع للمصفوفة الاولى k=1
3 1 2
6 4 5
9 7 8

نقوم بنقل الأرقام من كل عمود ومن ثم نصفر آخر الأمر

if k>n then writeln ‘Error’ ;
shift_counter =0;
else
begin
for raw =1 to n do
B ]raw[m n=n A ] raw , n [
while )shift_counter < k ( do
for j:= n downto 2 do
for i:=1 to n do
A]i,j [n n=n A]i,j-1[;
shift_counter = shift_counter +1
for i:=1 to n do
A] i , 1 [n=nn B ] i [
end;

مفتاح الحل :



نقوم بعدد K من العمليات بحيث تتضمن كل عملية نقل عناصر المصفوفة إلى العمود الذي يسبقها بحيث ننقل في آخر الأمر عناصر العمود الأخير إلى العمود الأول

وبتكرار العملية عدد k من المرات فينتج لدينا المصفوفة المزاحة

المسألة 11:
- اكتب برنامج يدخل مصفوفة أعداد أحادية شرط ألا تتكرر القيم )سؤال دورة(
الحل :

i=0
while i<=n
begin
Read A]i[
for j=1 to i-1 do
if A]i[ n=n A]j[then
i=i
else
i:=i+1
end;

المسألة 12:
اكتب برنامج يبدل عناصر المصفوفة الأحادية المواقع الزوجية مع المواقع الزوجية
مثال
19 1 632 86 57 33 8 2
تصبح
1 19 86 632 33 57 2 8

i=1
while i<=n
if A]i[mod 2=0 then
swap)A]i[ , A]i+1[ )
مع مناقشة حالة إذا كانت آخر خانة حيث نطرح 1 بدل من الجمع
i:=i+2

المسألة 13:
مصفوفة ذات بعدين اطبع الأرقام وكم مرة تكررت بدون تكرار الأرقام
910 8 6 5 1 0 1
2 54 8 787 9 82 23
1 1 5 6 8 910 0
1 5 2 2 8 9 82
الحل : نعتبر هناك تابع مساعد يدعى freq ندخل لها عدد ومصفوفة وترد لنا عدد تكرار هذا العدد ضمن المصفوفة

function freq )A:Array; num :integer(integer
frq:=0;
for i:=1 to n do
for j:=1 to n do
if A[i,j] n=n num
frq:=frq+1
freq = frq
end; { func}

for i=1 to n do
for 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 do
begin
for k=1 to n*n
if Aux[k]= A[i,j] then
begin
found =true
break
else {do nothing}
if not found then
writeln( A[i,j]:4,’ ‘ ,freq(A[i,j]))
end;

المسألة 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 do
for i:=1 to n-1 do
if A]i+1[ > A]i[ then
begin
temp:=A]i+1[;
A]i+1]:=A]i[;
A]i]:=temp;
end

المسألة 15:
مصفوفة أحادية حولها إلى مصفوفة ثنائية البعد وفق الشكل التالي

1234567
1230567
1200067
1000007

Print A
if n فردي
mid1=mid2 =( n div2) + 1
else
mid1=n div 2 ;
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=n 0;
A]mid2-1]n=n 0;
Print (A)
التابع print يقوم بطباعة المصفوفة

المسألة 16:
- اكتب برنامج بلغة باسكال يقوم بقراءة n عدد وتخزينها ضمن مصفوفة(a) ,والمطلوب:

1-كتابة برنامج يقوم بالتالي:في حال كان عدد الرقام المتتالية
والمتماثلة(في المصفوفة a) اكبر او تساوي(2) يتم نقل هذه العناصر من
المصفوفة(a) الى المصفوفة(b),
a: 122557776955332
b:25753

2-كتابة برنامج يقوم بالتالي:نقل العناصر المكررة لاكتر من مرة
والغير مكررة في المصفوفةa الى المصفوفة c ,لمرة واحدة فقط,اي كالتالي:
a:1225577776955332
c:125769532

readln(n)
for i =1 to digit(n) do {digit is a fun calculate the num of n digit}
begin num=n mod 10 ; A[i]=num; n=n div 10;
end;
j=1; i=1; index =1;
1:While i If a]i]=a]i+1[then
begin
for k= i+2 to n do
if A[k] =A[i] then
Index =k;
else break;
if index >i+1 then begin
B]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 بمقدار واحد