Редактирование и отладка программ с помощью Pascal (стр. 8 из 12)

var a:array[1..5] of integer;

i,s,p:integer;

begin clrscr;

for i:=1 to 5 do a[i]:=random(88);

for i:=1 to 5 do begin

writeln;

for i:=1 to 5 do write(a[i]:5);

end;

writeln;

for i:=1 to 5 do if a[i]>5 then p:=p+a[i];

writeln(p);

readln;

end.

Задание 5.Подщитать кол-во элементов равных 7

program as;

uses crt;

var a:array[1..7] of integer;

i,s,p:integer;

begin clrscr;

for i:=1 to 7 do a[i]:=random(88);

for i:=1 to 7 do begin

writeln;

for i:=1 to 7 do write(a[i]:5);

end;

writeln;

for i:=1 to 7 do if a[i]=7 then p:=p+1;

writeln(p);

readln;

end.

Задание 6. Дан массив умножить все элементы на 20

program as;

uses crt;

var a:array[1..7] of integer;

i,s,p:integer;

begin clrscr;

for i:=1 to 7 do a[i]:=random(88);

for i:=1 to 7 do begin

writeln;

for i:=1 to 7 do write(a[i]:5);

end;

writeln;

for i:=1 to 7 do

write(a[i]*20:3);

readln;

end.

Задание 7. Дан массив все четные элементы заменить на 2, а не четные удвоить

program as;

uses crt;

var a:array[1..7] of integer;

i,s,p:integer;

begin clrscr;

for i:=1 to 7 do a[i]:=random(88);

for i:=1 to 7 do begin

writeln;

for i:=1 to 7 do write(a[i]:5);

end;

writeln;

for i:=1 to 7 do if a[i] mod 2=0 then writeln(sqr(a[i]));

for i:=1 to 7 do if a[i] mod 2<>0 then writeln(2*a[i]);

readln;

end.

Задание 8. Дан одномерный массив найти максимальный элемент

program as;

uses crt;

var a:array[1..15] of integer;

i,max:integer;

begin clrscr;

for i:=1 to 15 do a[i]:=random(88);

for i:=1 to 15 do begin

writeln;

for i:=1 to 15 do write(a[i]:5);

end;

writeln;

max:=1;

for i:=1 to 15 do if a[i] >a[max] then max:=i;

writeln(a[max]);

readln;

end.

Задание 9. Дан одномерный массив найти min элемент

program as;

uses crt;

var a:array[1..15] of integer;

i,min:integer;

begin clrscr;

for i:=1 to 15 do a[i]:=random(88);

for i:=1 to 15 do begin

writeln;

for i:=1 to 15 do write(a[i]:5);

end;

writeln;

min:=1;

for i:=1 to 15 do if a[i]<a[min] then min:=i;

writeln(a[min]);

readln;

end.

Задание10. Дан массив скопировать все его элементы в другой массив такого же элемента

program as;

uses crt;

var a:array[1..15] of integer;

I,b:integer;

begin clrscr;

for i:=1 to 15 do a[i]:=random(88);

for i:=1 to 15 do begin

writeln;

for i:=1 to 15 do write(a[i]:5);

end;

writeln;

for i:=1 to 15 do a[i]:=b[i];

for i:=1 to 15 do write(a[i]);

writeln(‘скопир’);

for i:=1 to 15 do write(b[i]:4);

readln;

end.

Задание11. Составить программу обмена первого и третьего элем. строки матрицы

program as;

uses crt;

var a:array[1..15] of integer;

I,b,c:integer;

begin clrscr;

for i:=1 to 15 do a[i]:=random(88);

for i:=1 to 15 do begin

writeln;

for i:=1 to 15 do write(a[i]:5);

end;

writeln;

c:=a[1];

a[1]:=a[3];

a[3]:=c;

for i:=1 to 15 do write(a[i]:5);

end.

Задание12. Дан 2 мерный массив. Вывести на экран все элементы второй строки

program as;

uses crt;

var a:array[1..4,1..4] of integer;

i,j:integer;

begin clrscr;

for i:=1 to 4 do

for j:=1 to 4 do a[i,j]:=random(99);

for i:=1 to 4 do begin

writeln;

for j:=1 to 4 do write(a[i,j]:5);

end;

writeln;

writeln;

for j:=1 to 4 do write(a[2,j]:3);

end.

Задание13. Дан одномерный массив. Поменять содержимое двух произвольных ячеек

program as;

uses crt;

var a:array [1..10] of integer;

i,k,m:integer;

begin clrscr;

writeln;

for i:=1 to 10 do a[i]:=random(99);

for i:=1 to 10 do write(a[i]:5);

writeln;

writeln;

k:=a[2];

a[2]:=a[4];

a[4]:=k;

for i:=1 to 10 do write(a[i]:5);

end.

Задание14. Дан 2 мерный массив. Заменить все элементы кратные 5, нулями

program as;

uses crt;

var a:array[1..5,1..5] of integer;

i,j,s:integer;

begin clrscr;

for i:=1 to 5 do

for j:=1 to 5 do a[i,j]:=random(6);

for i:=1 to 5 do begin

writeln;

for j:=1 to 5 do write(a[i,j]:5);

end;

writeln;

for i:=1 to 5 do

for j:=1 to 5 do begin

if a[i,j] mod 5=0 then a[i,j]:=0;

end;

for i:=1 to 5 do begin writeln;

for j:=1 to 5 do write(a[i,j]:5);

end;

end.

Задание15. Дан массив вычислить сумму всех элементов больше 20

program as; end;

uses crt; writeln;

var a:array[1..10] of integer; for i:=1 to 10 do if a[i]>20 then p:=p+a[i];

i,s,p:integer; writeln(p);

begin clrscr; readln;

for i:=1 to 10 do a[i]:=random(88); end.

for i:=1 to 10 do begin

writeln;

for i:=1 to 10 do write(a[i]:5);

Процедуры и функции

Задание 1. Составить программу вычисления числа сочетания C= n!(n-m)!

program as;

uses crt;

var m,n,p1,p2,p3:integer;

c:real;

procedure factor(x:integer; var p:integer);

var i:integer;

begin p:=1;

for i:=1 to x do p:=p*i;

end;

begin clrscr;

writeln('Vvedi m,n');

readln(m,n);

factor(m,p1);

factor(n,p2);

factor(n-m,p3);

c:=p1/(p2*p3);

writeln(c:5:2);

end.

Задание 2. Составить программу нахождения меньшего из 5 заданных чисел, используя процедуру нахождения меньшего из 2 заданных чисел

Program as;

Uses crt;

Var a,b,c,d,e,z1,z2,z3,z4,z5:integer;

Procedure min(x,y:integer; var z:integer);

Begin;

If x<y then z:=x else z:=y;

Writeln(z);

End;

Begin clrscr;

Readln(a,b,c,d,e);

Min(a,b,z1);

Min(z1,c,z3);

Min(z3,d,z4);

Min(z4,e,z5);

End.

Задание 3. Написать программу нахождения суммы большего и меньшего из 3 заданных чисел

Program as;

Uses crt;

Var a,b,c,d,v,v1,max,max1,min,min1:integer;

Procedure ma(x,y,z:integer; var v:integer);

Begin clrscr;

If x<y then max:=x else max:=y;

If max<z then max1:=max else max1:=z;

If x>y then min:=x else min:=y;

If min>z then min1:=min else min1:=z;

V:=min1+max1;

End;

Begin clrscr;

Readln(a,b,c);

Ma(a,b,c,v1);

Writeln(v1);

End.

Задание 4. Составить программу вычисления суммой фактор. всех четных чисел от m до n

program as;

uses crt;

var a,b,c,n,m,s,k,p1,p:integer;

procedure factor(x:integer; var p:integer);

var i:integer;

begin p:=1;

for i:=1 to x do begin p:=p*I; end;

writeln(p);

end;

begin clrscr;

writeln(‘ Vvedi n,m’);

readln(n,m);

for k:=n to m do if k mod 2=0 then begin

factor(k,p1);

s:=s+p1;

end;

writeln(s);

end.

Задание 5. Даны 5 чисел, найти их наибольший общий делитель, используя процедуру. Для алгоритма их вида

program as;

uses crt;

var a,b,c,d,e,z1,z2,z3,z:integer;

procedure E(x,y:integer; var z:integer);

begin

while x<>y do if x>y then x:=x-y

else y:=y-1;

z:=x;

end;

begin clrscr;

writeln(‘ Vvedi a,b,c,d,e’);

readln(a,b,c,d,e);

E(a,b,z);

E(c,d,z1);

E(z,z1,z2);

E(z2,e,z3);

writeln(z3);

end.

M!

Задание 6. Составить программу вычисления числа сочетания C= n!(n-m)! с помощью функции

program as;

uses crt;

var f1,f2,f3,m,m1,n:integer;

c:real;

Function factor(n:integer):integer;

var p,i:integer;

begin p:=1;

for i:=1 to n do p:=p*i;

factor:=p;

end;

begin

read(m, n);

f1:=factor(m);

f2:=factor(n);

m1:=n-m;

f3:=factor(m1);

c:=f1/(f2*m1);

writeln(c:5:2);

end.

Задание 7. Найти НОК двух чисел по формуле НОК(a,b)=НОД

Program as;

Uses crt;

Var m, n,z,nod,a,nok:integer;

Procedure F (a,b:integer; var nod:integer);

Begin

While a<>b do if a>b then a:=a-b else b:=b-a;

Nod:=a;

End;

Begin clrscr;

Readln(m,n);

F (m,n,z);

Nok:= trunk (z/(m*n));

Writeln(nok);

End.

Задание 8. Трехугольник задан с координ. своих вершин. Составить программу вычисления его периметра

Program as;

Uses crt;

Var a1,a2,c1,c2,b1,b2:integer;

d1,d2,d3,d:real;

c,p:real;

procedure F(x1,x2,y1,y2:integer; var d:read);

begin

d:=sqrt(sqr(x2-x1)+sqr(y2-y1));

writeln(d:5:2);

end;

begin clrscr;

readln(a1,a2,b1,b2,d1,d2);

F(a1,a2,c1,c2,d1);

F(c1,c2,b1,b2,d2);

F(d1,d2,a1,a2,d3);

P:=d1+d2+d3;

Writeln(p:8:5);

End.

Задание 9. Увеличить вдвое все элементы массива

program as;

const n=10; m=20;

type T1 = array[1..n] of integer;

T2 = array[-m..m] of integer;

var A: T1; B: T2; k: integer;

Procedure Double(var X: array of integer);

var i: byte;

begin

for i:=0 to High(X)-1 do X[i]:=X[i]*2;

end;

begin

for k:=1 to n do read(A[k]);

for k:=-m to m do read(B[k]);

Double(A);

Double(B);

Double(k);

writeln('k=',k);

for k:=1 to n do write(A[k],' ');

writeln;

for k:=-m to m do write(B[k],' ');

end.

Задание 10. Использование типизированных констант

program typed_const;

var N:integer;

procedure Test;

const k:integer=1;

begin

if k<N then

begin

writeln(k,'-й вызов процедуры');

k:=k+1;

Test;

end

else writeln('последний вызов процедуры');

end;

begin

read(N);

if N>0 then Test;

end.

Задание 11. Вычислить N-е число Фиббоначчи

program Fib;

var n:byte;

function F(k:byte):word;

begin

if k<2 then F:=1 else F:=F(k-1)+F(k-2);

end;

begin

write('введите номер числа Фиббоначчи ');

readln(N);

writeln(N,'-е число Фиббоначчи =',F(N));

readln

end.

Задание12. Даны 5 чисел, найти их наибольший общий делитель, используя процедуру. Для алгоритма их вида

program as;

uses crt;

var a,b,c,d,e,z1,z2,z3,z:integer;

procedure E(x,y:integer; var z:integer);

begin

while x<>y do if x>y then x:=x-y

else y:=y-1;

z:=x;

end;

begin clrscr;

writeln(‘ Vvedi a,b,c,d,e’);

readln(a,b,c,d,e);

E(a,b,z);

E(c,d,z1);

E(z,z1,z2);

E(z2,e,z3);

writeln(z3);

end.

Задание13. Трехугольник задан с координ. своих вершин. Составить программу вычисления его периметра

Program as;

Uses crt;

Var a1,a2,c1,c2,b1,b2:integer;

d1,d2,d3,d:real;

c,p:real;

procedure F(x1,x2,y1,y2:integer; var d:read);

begin

d:=sqrt(sqr(x2-x1)+sqr(y2-y1));

writeln(d:5:2);

end;

begin clrscr;

readln(a1,a2,b1,b2,d1,d2);

F(a1,a2,c1,c2,d1);

F(c1,c2,b1,b2,d2);

F(d1,d2,a1,a2,d3);

P:=d1+d2+d3;

Writeln(p:8:5);

End.

Задание14. Составить программу для вычисления определенного интеграла

tk

2t

I= S--------------- dt

sqrt(1-sin2t)

tn

вычисляется по формуле:

ISimps=2*h/3*(0.5*F(A)+2*F(A+h)+F(A+2*h)+2*F(A+3*h)+...

+2*F(B-h)+0.5*F(B))

Program INTEGRAL;

type

Func= function(x: Real): Real;

var

I,TN,TK:Real;

N:Integer;

{$F+}

Function Q(t: Real): Real;

begin

Q:=2*t/Sqrt(1-Sin(2*t));

end;

{$F-}

Procedure Simps(F:Func; a,b:Real; N:Integer; var INT:Real);

var

sum, h: Real;

j:Integer;

begin

if Odd(N) then N:=N+1;

h:=(b-a)/N;

sum:=0.5*(F(a)+F(b));

for j:=1 to N-1 do

sum:=sum+(j mod 2+1)*F(a+j*h);

INT:=2*h*sum/3

end; begin WriteLn(' ВВЕДИ TN,TK,N');

Read(TN,TK,N);

Simps(Q,TN,TK,N,I);

WriteLn('I=',I:8:3)

end.

Задание15. Записать отрезок -X(-1,-10), с помощью функции

program as;

function A(x:integer):integer;

begin

a:=-x;

end;

var i:integer;

begin

for i:=1 to 10 do writeln(a(i));

end.

Файловые данные в Паскале

Задание 1. Дан текстовый файл, посчитать кол-во строк в нем

Program as;

Uses crt;

Var F:text; a:string; s:integer;

Begin clrscr;

Assign (f,’a1.txt’);

Reset (f);

While not (eof(f)) do begin

Readln(f,a);

S:=s+1; end;

Close(f);

Writeln(s);

End.

Задание 2. Создать текстовый файл и записать в него фразу: «Здравствуй Мир!»

Program as;

Uses crt;

Var F:text; a:string;

Begin clrscr;

Assign (f,’a.txt’);

Rewrite (f);

Readln(a);

Writeln(f,a);

Close(f);

End.

Задание 3. Создать текстовый файл и записать в него слово «Привет»

Program as;

Uses crt;

Var F:text; a:string;

Begin clrscr;

Assign (f,’A.txt’);

Rewrite (f);

Readln(a);

Writeln(f,a);

Close(f);

End.

Задание 4. Создать текстовый файл и записать в него 5 одинаковых чисел

Program as;

Uses crt;

Var F:text; a:string; i:integer;

Begin clrscr;

Assign (f,’text.txt’);

Rewrite (f);

For i:=1 to 5 do

Writeln(f,5);

Close(f);

End.

Задание 5. Создать текстовый файл и записать в него все числа от 10 до 16

Program as;

Uses crt;

Var F:text; a:string; i:integer;

Begin clrscr;

Assign (f,’text.txt’);

Rewrite (f);

For i:=10 to 16 do

Writeln(f,i);

Close(f);

End.

Задание 6. Создать текстовый файл и записать в него 5 одинаковых слов

Program as;

Uses crt;

Var F:text; a:string;

Begin clrscr;

Assign (f,’A.txt’);

Rewrite (f);

Readln(a);

Writeln(f,a);

Close(f);

End.

Задание 7. Дан текстовый файл перенести его строки в другой файл

Program as;

Uses crt;

Var f,t:text; a:string;

Begin clrscr;

Assign(f,’202as.txt’); assign(t,’201as.txt’);

Reset(f); rewrite(t);

While not(eof(f)) do begin

Readln(f,a);

Writeln(t,a);

End;

Close(f);

Close(t);

Readln;

End.

Задание 8. Имеется текстовый файл, напечатать все его строки начиная с буквы Т

Program as;

Uses crt;

Var f:text; a:string;

Begin clrscr;

Assign(f,’202as.txt’);

Reset(f);

While not(eof(f)) do begin

Readln(f,a);