Программы с циклами
Пример.
Вычислить
program primer;
const n=3;
var i:integer;
s:real;
begin
s:=0;
for i:=n downto 0 do
s:=i+sqrt(s);
writeln('s=',s)
end.
Пример.
Вычислить 
N
и M
ввести с клавиатуры.
program primer;
var i,j,m,n:integer;
p,s:real;
begin
write(‘n,m’);readln(n,m);
s:=0;
for i:=1 to n do
begin p:=1;
for j:=1 to m do
p:=p*2/(i+j);
s:=s+p;
end;
writeln(‘s=’,s);
end.
Пример.
Cоставить
программу вычисления
program primer;
var p,f,k:integer;
s,z,x,e:real;
Begin
write('Введите x');readln(x);
write('Введите e :');readln(e);
k:=2;p:=1;z:=-sqr(sqr(sqr(x)))/125;s:=0;
while abs(z)>e do
begin
s:=s+z;
z:=-z*x*x*x/(k+3);
k:=k+1;
end;
write('S=',s)
End.
Пример. Протабулировать функцию y(x) и функцию g(x) на отрезке [a;b] с шагом h=(b-a)/n. Функцию y(x) взять из задания 2.1. Результат получить в виде таблицы.
g(x)=sin(x-1)
program primer;
var i,n:integer;x,a,b,g,y:real;
begin
writeln('Введите a,b,n');
readln(a,b,n);
writeln('| x | y(x) | g(x) |');
writeln('|______|_________|______|');
x:=a;
for i:=1 to n+1 do
begin
if x<1 then
if x<-1 then y:=arctan(2*x)
else y:=int(x+2)
else
if x<=3 then y:=(2*x*x+14*x)
else y:=ln(2*x);
g:=sin(x+1);
writeln('| ',x:5:2,'|',y:10:3,'|',g:10:3,'|');
x:=x+(b-a)/n;
writeln('|______________________|');
end;
readln;
End.
Процедуры и функции
Пример.
Вычислить число
(вычисление p!).
program primer;
var n,m:integer;
function s(a:integer):longint;
var i:integer; p:longint;
begin p:=1; for i:=1 to a do p:=p*i;s:=p; end;
begin
write('Введите n,m');readln(n,m);
writeln('c=',s(n)/(s(m)*s(n-m)));
end.
Пример. Летела стая гусей. На каждом озере садилось половина стаи гусей и еще полгуся, а остальные летели дальше. Все гуси разместились на семи озерах. Сколько гусей было в стае.
program primer;
var k:integer;
procedure goose(x,k:integer);
begin
if k=1 then write (x) else goose(2*x+1,k-1)
end;
begin
write('Введите число озер');readln(k);
write('В стае было'); goose(1,k); write('гусей')
end.
Массивы
Пример. Найти сумму положительных элементов массива.
program primer;
const n=8;
type mas=array[1..n]of real;
var a:mas; i:integer; s:real;
begin
for i:=1 to n do
begin
write('a[',i,']=');readln(a[i])
end;
s:=0;
for i:=1 to n do
if a[i]>0 then s:=s+a[i];
writeln('s=',s:8:3);
for i:=1 to n do write(a[i]:5:2);
readln
end.
Пример. Дана матрица NxM, заполненная случайными числами. Образовать новую матрицу Nx(M-1) удалением столбца с номером P данной матрицы.
program primer;
const n=3;m=4;
type masb=array[1..n,1..m] of integer;
masm=array[1..n,1..n] of integer;
var a:masb; b:masm; i,j,p:integer;
begin
randomize;
for i:=1 to n do
for j:=1 to m do
a[i,j]:=random(10);
for i:=1 to n do
for j:=1 to m-1 do
b[i,j]:=0;
for i:=1 to n do
begin
for j:=1 to m do
write( a[i,j]:4);
writeln
end;
write('Введите номер столбца');
readln(p);
for i:=1 to n do
for j:=1 to p-1 do
b[i,j]:=a[i,j];
for i:=1 to n do
for j:=p to m-1 do
b[i,j]:=a[i,j+1];
for i:=1 to n do
begin
for j:=1 to m do
write( b[i,j]:4);
writeln
end;
end.
Пример. Составить программу обработки матрицы размерности NxM. Выполнить программу для N=3, M=4. Заполнение массива произвести с помощью датчика случайных чисел. В программе предусмотреть вывод исходной матрицы и полученной. Упорядочить (переставить) строки массива по не убыванию значений первых элементов столбцов.
program primer;
const n=3; m=4;
type mas=array[1..n,1..m] of integer;
var a:mas; k,i,j,p:integer;
procedure wiwod(x:mas);
begin writeln;
for i:=1 to n do
begin
for j:=1 to m do
write(x[i,j]:3,' ');
writeln;
end;
end;
procedure wwod(var x:mas);
begin
for i:=1 to n do
for j:=1 to m do
x[i,j]:=random(100);
end;
BEGIN
randomize;
wwod(a);
write('Исходный массив имеет вид:');
wiwod(a);
for i:=1 to n-1 do
for j:=1 to m-1 do
if a[1,j+1]<a[1,j] then
for k:=1 to n do
begin
p:=a[k,j];
a[k,j]:=a[k,j+1];
a[k,j+1]:=p;
end;
write('Массив после сортировки имеет вид:');
wiwod(a);
readln;
END.
Строковые переменные
Пример. Дана строка символов. Найти наиболее часто встречающийся символ.
Program primer;
var c:array[0..255] of integer;
mx, i:integer;s:string;
begin
write('введите строку: ');
readln(s);
for i:=1 to 255 do
c[i]:=0;
for i:=1 to length(s) do
c[ord(s[i])]:=c[ord(s[i])]+1;
mx:=c[0];
for i:=0 to 255 do
if c[i]>=mx then mx:=c[i];
for i:=0 to 255 do
if c[i]=mx then writeln(chr(i),' ',c[i])
end.
Пример. Составить и отладить программу, заменяющую во введенном строковом выражении указанную подстроку нужным числовым значением в строковом представлении.
PROGRAM primer;
const s:string='frgabs(5q2)abs(5)abs(-7.2)abs(8)lllabc(6)';
s1='abs('; sl1=')';
var at,d,s2,dt:string; t,i,k:integer; n:real;
begin
writeln('------------------------');
at:='abs('; d:='';i:=1;
while i<=length(s) do
begin
if copy(s,i,length(s1))=s1 then
begin k:=i+length(at);
while (s[k]<>')') and (k<=length(s)) do
begin
s2:=s2+s[k];k:=k+1;
end;
val(s2,n,t);
if t=0 then
begin
n:=abs(N); STR(N,dT);
d:=d+dt;i:=k;
end;
S2:='';
end
else d:=d+s[i];
i:=i+1
end;
writeln('старая строка:',s);
writeln('------------------------');
writeln('новая строка :',d);end.
Пример. В предложении подсчитать процент слов, содержащих букву "н".
program primer;
type slovo=string;
vars,sd:slovo;,n:integer;lag:boolean;
functionkolslov(sf:slovo):iteger;
var k,i:integer; s:slovo;
begin
s:=sf;k:=0;
for i:=1 to length(s) do
if s[i]=' ' then k:=k+1;
if s[length(s)]<>' ' then k:=k+1;
kolslov:=k
end;
begin
write('введите строку'); readln(s);}
n:=0; flag:=false;
for i:=1 to length(s) do
begin
if copy(sd,i,1)='н' then flag:=true;
if copy(sd,i,1)=' ' then
if flag then
begin n:=n+1;
flag:=false
end;
end;
if flag then n:=n+1;
writeln(s);
writeln(n/kolslov(s)*100:5:3)
end.
Записи
Пример. Дана простая дробь. Сократить числитель и знаменатель. Полученную дробь вывести на экран.
program primer;
type fraction=record
num:integer;
denom:1..maxint
end;
var a:fraction;
function nod(m,n:integer):integer;
begin
while m<>n do
if m>n then m:=m-n
else n:=n-m;
nod:=m
end;
procedure simple(var v:fraction);
var d:integer;
begin
d:=nod(abs(v.num),v.denom);
v.num:=v.num div d;
v.denom:=v.denom div d;
end;
begin
write('числитель');readln(a.num);
write('знаменатель');readln(a.denom);
simple(a);
writeln(a.num:3);
writeln(' --');
writeln(a.denom:3);
writeln
end.
Пример. Имеется зачетка. Посчитать, сколько сессий сдано без троек.
program primer;
const kolsemestr=5;
maxexam=5;
type data=record
day:1..31;
mes:1..12;
year:integer
end;
stroka=record
predmet:string[10];
sdano:data;
otmetka:2..5
end;
semestr=record
kolexam:1..maxexam;
zapisi:array[1..maxexam] of stroka;
end;
var
i,j,number:integer;
flag:boolean;
zachetka:array[1..kolsemestr] of semestr;
begin
for i:=1 to kolsemestr do
begin
write('kolexam v',i:2,'semestre');
readln(zachetka[i].kolexam);
for j:=1 to zachetka[i].kolexam do
begin
write('vv',j:2,'predmet:');
readln(zachetka[i].zapisi[j].predmet);
write('vv datu sdachi(dd mm gggg):');
readln(zachetka[i].zapisi[j].sdano.day,
zachetka[i].zapisi[j].sdano.mes,
zachetka[i].zapisi[j].sdano.year);
write('vv otmetky');
readln(zachetka[i].zapisi[j].otmetka)
end
end;
number:=0;
for i:=1 to kolsemestr do
begin
flag:=true;
for j:=1 to zachetka[i].kolexam do
if zachetka[i].zapisi[j].otmetka<=3 then flag:=false;
if flag then number:=number+1
end;
writeln('number=',number:3)
end.