Типовые задачи на Pascal с решениями

 

Задача:  Написать программу которая по введеному номеру времени года(1-зима,2-весна,3-лето,4-осень)выдавала соответствующие этому времени года, месяцы количество дней в каждом из месяцев.

uses crt;

var w:char;

begin

clrscr;

writeln('Выберите время года:');writeln('1-зима');

writeln('2-весна');

writeln('3-лето');

writeln('4-осень');

readln(w);case w of

'1':begin

    writeln('Зимние месяцы:');

    writeln(' декабрь - 31 день');

    writeln(' январь - 31 день');   

    writeln(' февраль - 28(29) дней');

    end;

'2':begin

    writeln('Весенние месяцы:');

    writeln(' март - 31 день');   

    writeln(' апрель - 30 дней');

    writeln(' май - 31 день');

    end;

'3':begin

    writeln('Летние месяцы:');   

    writeln(' июнь - 30 дней');

    writeln(' июль - 31 день');

    writeln(' август - 31 день');

    end;

'4':begin    writeln('Осенние месяцы:');

    writeln(' сентябрь - 30 дней');

    writeln(' октябрь - 31 день');

    writeln(' ноябрь - 30 дней');

    end;else write('Такого времени года нет!');

end;

readln

end.

 

 

Задача: Определить делителем каких чисел a,b,c является число k.

 

uses crt;
var a,b,c,k,s:integer;
begin
clrscr;
writeln('Введите 3 целых числа:');readln(a,b,c);
write('Введите целое число для проверки делимости k=');
readln(k);
s:=0;
if a mod k=0 then begin
  writeln('Число ',k,' делитель числа ',a);
  s:=s+1;
 end;
if b mod k=0 then begin
  writeln('Число ',k,' делитель числа ',b);
  s:=s+1;
 end;
if c mod k=0 then begin
  write('Число ',k,' делитель числа ',c);
  s:=s+1;
 end;
if s=0 then write('Число ',k,' не является делителем чисел ',a,' ',b,' ',c);readln
end.

 

 

 

Задача: Подсчитать количество отрицательных среди чисел a,b,c

 

uses crt;
var a,b,c:integer;
    k:byte;
begin
clrscr;writeln('Введите 3 целых положительных и отрицательных числа:');
readln(a,b,c);
k:=ord(a<0)+ord(b<0)+ord(c<0);{a<0=true, если отрицательное, ord(true)=1
                                   false, если не отрицательное, ord(false)=0}
write('Количество отрицательных=',k);readln
end.

 

 

Геометрические задачи

Задача 
Дан круг (X0, Y0, R) и точка (X, Y), где X0, Y0, R, X, Y - вещественные числа.
Определить, лежит ли эта точка внутри данного круга.
Пример
(0, 0, 1) и (0.5, 0.5)
Результат: TRUE
Вариант решения

Code (Pascal):

var X0, Y0, R, X, Y: Real;


 

begin

ReadLn (X0, Y0, R, X, Y);

WriteLn (Sqr (X - X0) + Sqr (Y - Y0) <= Sqr (R));

end.



Задача 
Дан треугольник с вершинами (X1, Y1); (X2, Y2); (X3, Y3) и точка (X, Y). Все Xi, Yi - вещественные числа.
Определить, лежит ли эта точка внутри данного треугольника.
Пример
(0, 0); (3, 0); (0, 3) и (1, 1)
Результат: TRUE
Вариант решения

Code (Pascal):

const eps = 1E-5;

var X1, Y1, X2, Y2, X3, Y3, X, Y: Real;

S0, S1, S2, S3: Real;


 

function S (X1, Y1, X2, Y2, X3, Y3: Real): Real;

var a, b, c, p: Real;

begin

a := Sqrt (Sqr (X1 - X2) + Sqr (Y1 - Y2));

b := Sqrt (Sqr (X1 - X3) + Sqr (Y1 - Y3));

c := Sqrt (Sqr (X3 - X2) + Sqr (Y3 - Y2));

p := 0.5 * (a + b + c);

S := Sqrt (p * (p - a) * (p - b) * (p - c));

end; {func S}


 

begin

ReadLn (X1, Y1, X2, Y2, X3, Y3, X, Y);

S0 := S (X1, Y1, X2, Y2, X3, Y3);

S1 := S (X, Y, X2, Y2, X3, Y3);

S2 := S (X1, Y1, X, Y, X3, Y3);

S3 := S (X1, Y1, X2, Y2, X, Y);

WriteLn (S0 + eps >= S1 + S2 + S3);

end.



Задача 
Дан прямоугольник, заданный двумя противоположными вершинами (X1, Y1); (X2, Y2) и точка (X, Y). Все Xi, Yi - вещественные числа.
Определить, лежит ли эта точка внутри данного прямоугольника.
Пример
(1, 1); (7, 4) и (4, 2)
Результат: TRUE
Вариант решения

Code (Pascal):

var X1, Y1, X2, Y2, X, Y: Real;


 

begin

ReadLn (X1, Y1, X2, Y2, X, Y);

WriteLn ((Abs (X1 - X2) = Abs (X1 - X) + Abs (X2 - X)) and

(Abs (Y1 - Y2) = Abs (Y1 - Y) + Abs (Y2 - Y)));

end.


 

Задачи на числа

Задача 
Дано число a (0..999999999).
Найти сумму цифер числа a.

Пример
a = 12345
Результат: 15

Вариант решения

Code (Pascal):

var a: LongInt;

S: Byte;


 

begin

ReadLn (a);

S := 0;

while a > 0 do

begin

Inc (S, a mod 10);

a := a div 10;

end; {while}

WriteLn (S);

end.



Задача 
Дано число a (0..999999999).
Вывести это число в обратном порядке.
Пример
a = 12345
Результат: 54321
Вариант решения

Code (Pascal):

var a: LongInt;


 

begin

ReadLn (a);

repeat

Write (a mod 10);

a := a div 10;

until a = 0;

end.



Задача
Дано число a (0..999999999).
Определить, является ли оно простым.
Замечание: число называется простым, елси оно делится только на 1 и на самого себя.
Пример
a = 12345
Результат: FALSE
Вариант решения

Code (Pascal):

var a, N: LongInt;

Prost: Boolean;


 

begin

ReadLn (a);

Prost := True;

for N := 2 to a div 2 do

if a mod N = 0 then

begin

Prost := False;

Break;

end; {if}

WriteLn (Prost);

end.



Задача
Дано число a (0..999999999).
Разложить это число на простые множители.
Пример
a = 12345
Результат: 3 5 823
Вариант решения

Code (Pascal):

var a, N: LongInt;


 

function Prost (X: LongInt): Boolean;

var N: LongInt;

begin

for N := 2 to X div 2 do

if X mod N = 0 then

begin

Prost := False;

Exit;

end; {if}

Prost := True;

end; {func Prost}


 

begin

ReadLn (a);

while a > 0 do

if Prost (a) then

begin

Write (a);

Break;

end else

begin

N := 2;

while N <= a div 2 do

begin

if (a mod N = 0) and Prost (N) then

begin

Write (N, ' ');

a := a div N;

Break;

end; {if}

Inc (N);

end; {while}

end; {if}

end.



Задача
Дано число S (0..999999999), обозначающее количество секунд.
Вычислить числа Hour, Minute (0..59), Second (0..59), показывающие число часов, минут и секунд соответственно в числе S.
Пример
S = 12345
Результат: 3:25.45
Вариант решения

Code (Pascal):

var S: LongInt;

Hour, Minute, Second: Integer;


 

begin

ReadLn (S);

Second := S mod 60;

Minute := S div 60;

Hour := Minute div 60;

Minute := Minute mod 60;

WriteLn (Hour, ':', Minute, '.', Second);

end.



Задача 
Дано натуральное число a (1..999999999).
Представить его в виде суммы квадратов двух натуральных чисел или сообщить о невозможности такого представления.
Пример
a = 29
Результат: 2, 5
Вариант решения

Code (Pascal):

var a, n: LongInt;

b: Real;


 

begin

ReadLn (a);

for n := 1 to Trunc (Sqrt (a)) do

begin

b := Sqrt (a - Sqr (n));

if (Int (b) = b) and (b > 0) then

begin

WriteLn (n, ', ', Trunc (b));

Exit;

end; {if}

end; {for}

WriteLn ('No');

end.


Задача 
Дано число a (1..999999999).
Определить, является ли оно совершенным.
Замечание: натуральное число называется совершенным, если оно равно сумме всех своих собственных делителей, включая 1.
Пример
a = 496
Результат: TRUE
Вариант решения

Code (Pascal):

var a, i, S: LongInt;


 

begin

ReadLn (a);

S := 1;

for i := 2 to a div 2 do

if a mod i = 0 then Inc (S, i);

WriteLn (S = a);

end.


Задача 
Даны два натуральных числа: m, n (1..999999999), образующие дробь вида m / n.
Сократить дробь, что бы числитель и знаменатель были взаимнопростые.
Пример
m = 256; n = 64
Результат: 4 1
Вариант решения

Code (Pascal):

var m, n, i: LongInt;


 

begin

ReadLn (m, n);

i := 2;

while i <= m do

begin

if (m mod i = 0) and (n mod i = 0) then

begin

m := m div i;

n := n div i;

end; {if}

Inc (i);

end; {while}

WriteLn (m, ' ', n);

end.


 

 

Задачи на строки

Задача 
Дана строка S, состоящая из латинских букв и пунктуационных знаков.
Преобразовать эту строку к верхнему регистру.
Пример
S = 'Hello, World!'
Результат: HELLO, WORLD!
Вариант решения

Code (Pascal):

var S: string;

i: Integer;


 

begin

ReadLn (S);

for i := 1 to Length (S) do

S[i] := UpCase (S[i]);

WriteLn (S);

end.


Задача 
Дана строка S, состоящая из латинских букв и пробелов.
Определить количество слов в данной строке.
Замечание: словом считается любая последовательность максимальной долины, состоящая из латинских букв и не содержащая пробелов.
Пример
S = 'Hello World'
Результат: 2
Вариант решения

Code (Pascal):

var S: string;

i, Count, State: Integer;


 

begin

ReadLn (S);

Count := 0;

State := 1;

for i := 1 to Length (S) do

Case State of

1: if UpCase (S[I]) in ['A'..'Z'] then

begin

Inc (Count);

State := 2;

end; {if}

2: if not (UpCase (S[I]) in ['A'..'Z']) then State := 1;

end; {case}

WriteLn (Count);

end.


Задача
Дано 10 строк, вводимых с клавиатуры.
Вывести их в алфавитном порядке.
Пример
Marina
Aleksej
Sergej
Ivan
Peter
Lubov
Irina
Pavel
Natasha
Kostya

Результат:
Aleksej
Irina
Ivan
Kostya
Lubov
Marina
Natasha
Pavel
Peter
Sergej

Вариант решения

Code (Pascal):

const N = 10;


 

type TStrs = array[1..N] of string;


 

var S: TStrs;

i: Integer;


 

procedure Sort (var S: TStrs);

var i, j: Integer;

tmp: string;

begin

for i := 1 to N - 1 do

for j := i + 1 to N do

if S[i] > s[j] then

begin

tmp := S[i];

S[i] := S[j];

S[j] := tmp;

end; {if}

end; {proc Sort}


 

begin

for i := 1 to N do

ReadLn (S[i]);

Sort (S);

WriteLn;

for i := 1 to N do

WriteLn (S[i]);

end.



Задача 
Дана строка S.
Определить, является ли она полиндромом.
Замечание: полиндромом называются строки, которые одинаково читаются как слева-направо, так и справа-налево.
Пример
S = 'asdfgfdsa'
Результат: TRUE
Вариант решения

Code (Pascal):

var S: string;

i: Integer;

Polindr: Boolean;


 

begin

ReadLn (S);

Polindr := True;

for i := 1 to Length (S) div 2 do

if S[i] <> S[Length(S)-i+1] then

begin

Polindr := False;

Break;

end; {if}

WriteLn (Polindr);

end.



Задача
Дана строка S, состоящая только из символов '0' или '1'.
Подсчитать длинну самой длинной последовательности, состоящей только из '1'.
Пример
S = '111110011110110'
Результат: 5
Вариант решения

Code (Pascal):

var S: string;

i, Len, MaxLen: Integer;


 

begin

ReadLn (S);

MaxLen := 0;

Len := 0;

S := Concat (S, '0'); {ставимбарьер}

for i := 1 to Length (S) do

if S[i] = '0' then

begin

if Len > MaxLen then MaxLen := Len;

Len := 0;

end else Inc (Len);

WriteLn (MaxLen);

end.


 

 

Задачи на массивы

Задача 
Дан массив A, состоящий из 100 натуральных чисел, заполненный случайным образом (каждый элемент находится в промежутка от 1 до 1000).
Отсортировать данный массив по неубыванию и вывести на экран.

Вариант решения

Code (Pascal):

const n = 100;


 

var A: array[1..n] of Word;

i, j, tmp: Integer;


 

begin

Randomize;

for i := 1 to n do

A[i] := Random (1000) + 1;

for i := 1 to n - 1 do

for j := n downto 2 do

if A[j] < A[j-1] then

begin

tmp := A[j];

A[j] := A[j-1];

a[j-1] := tmp;

end; {if}

for i := 1 to n do

Write (A[i]:2);

end.



Задача 
Дан массив A, состоящий из 10 целых чисел.
Вывести все элементы, значение которых превосходит среднего арифметического элементов массива.
Пример
A: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10
Результат: 6, 7, 8, 9, 10
Вариант решения

Code (Pascal):

const n = 10;


 

var A: array[1..n] of Integer;

i, Sum: Integer;


 

begin

Sum := 0;

for i := 1 to n do

begin

Write ('A[', i, '] = ');

ReadLn (A[i]);

Inc (Sum, A[i]);

end; {for}

WriteLn;

for i := 1 to n do

if A[i] > Sum div n then WriteLn (A[i]);

end.



 

Задачи на матрицы

Задача 
Дана матрица A размерностью 3 x 3, состоящая из целых чисел.
Найти разность между максимальным и минимальным элементами данной матрицы.
Пример
A:
12 44 37
8 25 32
19 28 41
Результат: 36
Вариант решения

Code (Pascal):

var A: array[1..3,1..3] of Integer;

i, j, Max, Min: Integer;


 

begin

for i := 1 to 3 do

for j := 1 to 3 do

begin

Write ('A[', i, ',', j, '] = ');

ReadLn (A[i,j]);

end; {for}

Max := A[1,1];

Min := A[1,1];

for i := 1 to 3 do

for j := 1 to 3 do

begin

if Max < A[i,j] then Max := A[i,j];

if Min > A[i,j] then Min := A[i,j];

end; {for}

WriteLn (Max - Min);

end.



Задача 
Дана матрица A размерностью 5 x 5.
Заполнить ее следующим образом:
1 2 3 4 5
2 3 4 5 1
3 4 5 1 2
4 5 1 2 3
5 1 2 3 4
и вывести на экран.

Вариант решения

Code (Pascal):

var A: array[1..5,1..5] of Byte;

i, j: Integer;


 

begin

for i := 1 to 5 do

for j := 1 to 5 do

A[i,j] := 1 + (i + j - 2) mod 5;

for i := 1 to 5 do

begin

for j := 1 to 5 do

Write (A[i,j]:2);

WriteLn;

end; {for}

end.



Задача 
Дана матрица A размерностью 5 x 5.
Заполнить ее следующим образом:
1 1 1 1 1
0 1 1 1 0
0 0 1 0 0
0 1 1 1 0
1 1 1 1 1
и вывести на экран.

Вариант решения

Code (Pascal):

var A: array[1..5,1..5] of Byte;

i, j: Integer;


 

begin

for i := 1 to 5 do

for j := 1 to 5 do

if Abs (j - 3) <= Abs (i - 3) then A[i,j] := 1

else A[i,j] := 0;

for i := 1 to 5 do

begin

for j := 1 to 5 do

Write (A[i,j]:2);

WriteLn;

end; {for}

end.



Задача 
Дана матрица A размерностью 5 x 5.
Заполнить ее следующим образом:
1 2 3 4 5
10 9 8 7 6
11 12 13 14 15
20 19 18 17 16
21 22 23 24 25
и вывести на экран.

Вариант решения

Code (Pascal):

var A: array[1..5,1..5] of Byte;

i, j: Integer;


 

begin

for i := 1 to 5 do

for j := 1 to 5 do

if Odd (i) then A[i,j] := j + (i - 1) * 5

else A[i,j] := 6 - j + (i - 1) * 5;

for i := 1 to 5 do

begin

for j := 1 to 5 do

Write (A[i,j]:3);

WriteLn;

end; {for}

end.



Задача 
Дана матрица A размерностью 5 x 3, состоящая из целых чисел.
Найти номер строки, в которой сумма элементов максимальна.
Пример
A:
1 2 3
0 0 0
5 5 5
2 8 6
2 4 3
Результат: 4
Вариант решения

Code (Pascal):

var A: array[1..5,1..3] of Integer;

i, j, Sum, Max, Imax: Integer;


 

begin

for i := 1 to 5 do

for j := 1 to 3 do

begin

Write ('A[', i, ',', j, '] = ');

ReadLn (A[i,j]);

end; {for}

for i := 1 to 4 do

begin

Sum := 0;

for j := 1 to 3 do

Inc (Sum, A[i,j]);

if (Sum > Max) or (i = 1) then

begin

Imax := i;

Max := Sum;

end; {if}

end; {for}

WriteLn (Imax);

end.