Примеры программ на Pascal

Задание:

Ввести с клавиатуры n чисел. Определить количество четных.

Скачать файл .pas

Код программы:

var n,i,k,a:integer;
begin
writeln('введите количество чисел');
readln(n);
a:=0;
for i:=1 to n do begin
                 writeln('введите ',i:1,'-е число');
                 readln(a);
                 if a mod 2=0 then k:=k+1;
                 end;
writeln('кол-во четных чисел ',k);
readln;
end.

Задание:

Дано четырехзначное число. Верно ли, что сумма первой и последней цифр равна сумме средних цифр?

Пример теста:

1234 — да: 1+4=2+3
7459 — нет: 7+9 ≠ 4+5

Скачать файл .pas

Код программы:

var n,p1,p2,p3,p4:integer;
begin
writeln('введите четырехзначное число');
readln(n);
p1:=n div 1000;
p4:=n mod 10;
p2:=(n div 100) mod 10;
p3:=(n div 10) mod 10;
if p1+p4=p2+p3 then writeln('right') else writeln('false');
readln;
end.

Задание:

Решение квадратного уравнения ax2+bx+c=0

Пример теста:

a
b
c
x
0
0
0
любое
0
0
5
нет решений
0
2
5
-2,5
1
1
-6
x1=2; x2=-3
16
-24
9
0.75
2
1
3
нет решений

Скачать файл .pas

Код программы:

var a,b,c,D,x1,x2:real;
begin
writeln('введите a,b,c');
readln(a,b,c);
if a=0 then if b=0 then if c=0 then writeln('x любое')
                               else writeln('нет решений')
                   else begin
                        x1:=c/b;
                        writeln('x=',x1:12:6);
                        end
        else begin
             D:=b*b-4*a*c;
             if D>0 then begin
                         x1:=(-b-sqrt(D))/(2*a);
                         x2:=(-b+sqrt(D))/(2*a);
                         writeln('x1=',x1:12:6);
                         writeln('x2=',x2:12:6);
                         end
                    else if D=0 then begin
                                     x1:=-b/(2*a);
                                     writeln('x=',x1:12:6);
                                     end
                                 else writeln('нет решений');
end;
readln;
end.

Задание:

При попадании в маленький круг (радиус = 1), игроку начисляется 2 балла, при попадании в большой круг (радиус 2) — 1 балл, мимо мишеней — 0 баллов.

Пример теста:

0.5; 0.6 — 2
-1.2; -1.3 — 1
2.6; 3 — 0

Скачать файл .pas

Код программы:

var x,y:real;
z:byte;
begin
writeln('введите координаты');
readln(x,y);
if x*x+y*y<=1 then z:=2
             else if x*x+y*y<=4 then z:=1
                                else z:=0;
writeln('ваш результат ',z);
readln;
end.

Задание:

Вычислить значение функции y:=(arctan(x)-exp(x))/sqrt(abs(x))

Пример теста:

при x = 2, y = -4.441979

Скачать файл .pas

Код программы:

var x,y:real;
begin
writeln('введите x');
readln(x);
y:=(arctan(x)-exp(x))/sqrt(abs(x));
writeln('y=',y:12:6);
readln;
end.

Задание:

Найти сумму элементов столбца, содержащего максимальный элемент. Если максимальный элемент встречается несколько раз, то вычислить сумму столбца, в котором максимальный элемент встречается в последний раз. То есть в тесте взять такую матрицу, чтобы максимальный элемент встречался в несколькх столбцах.

Пример теста:

1 2 3 4
7 1 3 0
2 7 4 3
1 3 2 1

Ответ: 13 (второй столбец: 2+1+7+3=13)

Скачать файл .pas

Код программы:

type meow=array[1..10,1..10] of integer;
var a:meow;
i,j,m,n:byte;
max,s,k:integer;
begin
writeln('введите число строк и столбцов ');
readln(n,m);
for i:=1 to n do begin
                 writeln('введите строку ', i);
                 for j:=1 to m do readln (a[i,j]);
                 end;
writeln ('матрица А');
for i:=1 to n do begin
                 for j:=1 to m do write (a[i,j]:4, ' ');
                 writeln;
                 end;
max:=a[1,1];
for i:=1 to n do
  for j:=1 to m do if a[i,j]>=max then begin max:=a[i,j];
                                             k:=j;
                                             end;
  for i:=1 to n do begin
                    for j:=k to k do s:=s+a[i,k];
                    end;
writeln('s=',s);
readln;
end.

Добавить комментарий

Ваш e-mail не будет опубликован. Обязательные поля помечены *