تمارين برمجة باسكال
. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . .
نبذة
هذه الصفحة هي بالاصل مأخوذة من كتاب تمارين برمجة محلولة خطوة على طريق البرمجة (نسخة باسكال ) إعداد وسيم أبوزينة في حال كنت تملك حلولاً اخرى يمكنك وضع الحل الذي تراه مناسباً بعد اضافة سطر يحوي طريقة اخرى .
| وسيم أبو زينة ساهم بشكل رئيسي في تحرير هذا المقال
|
الفصل الاول تمارين ابتدائية
1-اكتب برنامج بلغة T.Pascal لقراءة عددين صحيحين وطباعة نواتج عملية الضرب والقسمة والجمع والطرح لهذين العددين
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.
2-اكتب برنامج بلغة T.pascal يقوم بقراءة عدد صحيح X وعدد صحيح موجب n ثم يقوم بحساب Xn
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.
3-اكتب برنامج لقلب عدد صحيح مدخل مثال العدد المدخل 1234 يصبح 4321
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.
4-اكتب برنامج يقوم بحساب قيمة تقريبية ل ex بحيث
مع العلم انه يتوقف الحساب عندما تكون قيمة الحد الأخير الذي نصل إليه اصغر آو تساوي
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.
5-أكتب خوارزمية تقوم بقراءة عددين A,B و طباعة الأعداد المحصورة بينهما بطريقة تنازلية دون معرفة أي العددين A,B هو الأكبر .
2-أكتب خوارزمية تقوم بقراءة عدد N و طباعة مجموع الأعداد الزوجية المحصورة بين n و الصفر .
3-أكتب خوارزمية تقوم بقراءة رقمm ما و طباعة عدد خاناته .
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.
6-وضع أحد العملاء مبلغ sum في البنك لعدد year من السنوات ..
ما هي قيمة هذا المبلغ بعد هذه السنوات علماً أن العميل يتقاضى على المبلغ فائدة (مركبة) سنوية p%
2-وضع أحد العملاء مبلغ sum في البنك فإذا علمت أن العميل يتقاضى على المبلغ فائدة (مركبة )سنوية p% بعد كم سنة يتضاعف المبلغ ..؟؟؟
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;
7-لدينا فاتورة مشتريات تحوي البيانات التالية :
عدد المواد N
عدد الوحدات من كل مادة q
سعر الوحدة unit 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 ;
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.
8-اكتب برنامج لقراءة نص محرف محرف ينتهي بنقطة (.) والمطلوب :
1-حساب عدد المحارف الكلي
2-حساب عدد الأحرف وعدد الأرقام وعدد علامات التنقيط
3-طباعة النص مع استبدال كل حرف صغير في اول الكلمة بحرف كبير
4-تحويل كل عدد إلى عدد عشري حيث ان العدد العشري =n-9 أي المتمم إلى10
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
9-اكتب برنامج يعطي نتيجة منطقية True آو False عن تناظر مصفوفة أحادية بعدها n بالنسبة لمنتصفها مثال نقول عن مصفوفة احادية انها متناظرة
في حال بعد المصفوفة
N=9 فردي
2 7 5 6 4 6 5 7 2
N=8 زوجي
2 7 5 6 6 5 7 2
نقول عن مصفوفة احادية انها غير متناظرة
7 6 5 2 1 1
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.
10-يتم حساب رواتب الموظفين في دائرة حكومية بالشكل التالي : لكل موظف راتب اساسي يضاف إليه قيمة تعويضات يستحقها حسب نشاطه وعمله وتخصم منه قيمة حسميات حسب إجازاته وعطله اكتب برنامج بلغة باسكال ينظم جداول رواتب الموظفين يطلب فيه
1-قراءة الأرقام التسلسلية للموظفين وتخزينها في جدول ارقام الموظفين
ارقام الموظفين
2-قراءة تفصيل راتبه حيث يتم التخزين في 3 جداول كالتالي:
الراتب الأساسي – التعويضات –الحسميات الراتب الأساسي
التعويضات
الحسميات
3-حساب إجمالي الراتب للموظفين وتخزينه في جدول حيث اجمالي الراتب = الراتب الأساسي + التعويضات – الحسميات إجمالي الراتب
4-اظهار اكبر قيمة للراتب الأساسي
إظهار رقم الموظيف الذي يتقاضى اعلى قيمة تعويضات
إظهار رقم الوظف الذي يخصم من راتبه اقل قيمة حسميات
حساب وسطي الراتب الإجمالي وتخزين هذه القيم في جدول النتائج التالي:
النتائج
اكبر قيمة للراتب الأساسي – رقم الموظف الذي له اعلى تعويضات –رقم الموظف الذي له اقل حسميات –وسطي الراتب الإجمالي
اكبر قيمة للراتب الأساسي رقم الموظف الذي له اعلى تعويضات رقم الموظف الذي له اقل حسميات وسطي الراتب الإجمالي
5-إظهار النتائج السابقة بالشكل
رقم الموظف – الراتب الأساسي – التعويضات – الحسميات –إجمالي الراتب
النتائج
رقم الموظف – الراتب الأساسي التعويضات – الحسميات إجمالي الراتب
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]<min then
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.ندخل عدد الثواني ثم يقوم الحاسب بإظهار عدد الساعات ،الدقائق،الثواني على الشكل التالي h:m:s
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<a[j] ) then
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[;’