МІНІСТЕРСТВО ОСВІТИ І НАУКИ УКРАЇНИ
МАРІУПОЛЬСЬКИЙ ТЕХНІКУМ
ДОНЕЦЬКОГО НАЦІОНАЛЬНОГО УНІВЕРСИТЕТУ
ЕКОНОМІКИ І ТОРГІВЛІ
ІМЕНІ МИХАЙЛА ТУГАН – БАРАНОВСЬКОГО

ЗІНАЇДА КОСТЯНТИНІВНА ЛІГАЧОВА

МЕТОДИЧНА РОЗРОБКА
З ТЕМИ
«РОЗВ’ЯЗОК ЗАДАЧ МОВОЮ ПРОГРАМУВАННЯ PASCAL»
ДИСЦИПЛІНА «ІНФОРМАТИКА»
Маріуполь

Методична розробка з теми: «Розв’язок задач мовою програмування PASCAL» підготувала Лігачова Зінаїда Костянтинівна викладач МТДонНУЄТ кваліфікаційної категорії «Спеціаліст вищої категорії» –

Викладено методику проведення практичного заняття, спрямованого на вимір досягнутого рівня знань і умінь студентів з теми «Розв’язок задач мовою програмування PASCAL» з дисципліни «Інформатика»

Для студентів денної форми навчання навчальних закладів 1 – 2 рівні акредитації

Розглянуто та схвалено на засіданні циклової комісії обліково-фінансових дисциплін протокол

1. Лінійні алгоритми

Загальна структура програми на мові Паскаль наступна:
Рrogram ИМЯ..; {заголовок програми}
Uses ...; {розділ опису модулів}
Var ..; {розділ оголошення змінних}
...
Begin {початок виконавчої частини програми}
... {послідовність
... операторів}
End. {кінець програми}

Оператор присвоювання - основний оператор будь-якої мови програмування. Загальна форма запису оператора:
Ім'я величини : = вираз
Наприклад, В : = ; або V : = +1;
За допомогою оператора присвоювання змінній можуть присвоюватися константи та вирази, значення змінних будь-якого типу. Як тільки в програмі зустрічається змінна, для неї в пам'яті відводиться місце. Оператор присвоювання розміщує значення змінної або значення виразу у відведене місце.
Алгоритм - чітка послідовність дій, необхідна для виконання завдання.
Програма - алгоритм, записаний на мові програмування.
Алфавіт мови - набір елементарних символів, які використовуються для складання програм.
Алфавіт містить:
• 52 букви латинського алфавіту (малі і великі);
• арабські цифри (0-9);
• спеціальні символи;
• знаки математичних дій (+ - * /);
• знаки пунктуації (:.,; "`);
• дужки ([] () {});
• знак пробілу;
• знаки відношення (< > <> =).
Ідентифікатор (ім'я) - ім'я якого-небудь елементу програми, яке повинно задовольняти таким вимогам:
• довжина імені не повинна перевищувати 63 символи,
• першим символом не може бути цифра,
• змінна не може містити пробіл;
• ім'я не повинно збігатися з зарезервованим (службовим) словом,
• великі та малі літери сприймаються однаково.
Зарезервовані (службові) слова - це слова, що використовуються тільки за своїм прямим призначенням. Їх не можна використовувати в якості змінних, так як вони виконують певне смислове навантаження.
Приклади зарезервованих слів: AND, GOTO, PROGRAM, ELSE, IF, RECORD, NOT, ARRAY, REPEAT, UNTIL, BEGIN, IN, SET, END, CASE, CONST, USES, INTERFACE, STRING, LABEL, THEN, OF, DIV, TO, VAR, DO, TYPE, WHILE, DOWNTO, FILE, FUNCTION, PROCEDURE та інші.
Змінні (Var) - вид даних, що може змінювати своє значення в ході програми, описують змінні після зарезервованого слова Var.
Константи (Const) - вид даних, який є постійним на протязі виконання програми, описують константи після зарезервованого слова Const.
Коментарі - деяка запис, що служить для пояснення програми, який записується у фігурних дужках.
Для тимчасового зберігання інформації в оперативній пам'яті комп’ютера в мові Паскаль використовуються константи і змінні.
Вони можуть бути різних типів:
 • цілі числа (integer);
 • дійсні числа (real);
 • символьний тип (Char);
 • строковий тип (string);
 • логічний тип (boolean);
Процедури Write WriteLn використовуються для виведення результату і для виведення різних повідомлень або запитів. Це дозволяє вести діалог з користувачем, повідомляти його, коли йому потрібно ввести значення, коли він отримує результат, коли він помилився та ін.
Процедури Read и ReadLn використовуються для введення інформації з клавіатури. Часто процедуру ReadLn без параметрів застосовують в кінці програми для затримки: до натискання на клавішу результат виконання програми залишається на екрані. Це дуже корисно робити для аналізу результатів.
Для розв’язування задач необхідні стандартні функції і процедури.
Функція - це така організація перетворення переданого їй значення, при якій це змінене значення повертається назад.
Процедура - це така організація перетворення переданого їй значення параметра, при якій змінюється значення цього параметра, і, на відміну від функції, не повертається ніяке значення.
Арифметичні функції:
1. Abs(x), де аргумент і результат є змінними цілого або дійсного типу - обчислює модуль (абсолютну величину) числа х;
2. Cos(х), де аргумент і результат є змінними дійсного типу - обчислює косинус х;
3. Sin(х), де аргумент і результат є змінними дійсного типу - обчислює синус х;
4. Frac(х), де аргумент і результат є змінними дійсного типу - виділяє дробову частину числа х;
5. Int(х), де аргумент і результат є змінними дійсного типу - виділяє цілу частину числа х;
6. Pi, де результат є змінною дійсного типу - обчислює значення π;
7. Random(х), де аргумент і результат є змінними цілого типу - генерує випадкове число в межах від 0 до х включно. Якщо параметр х не заданий, то формується дійсне число від 0 до 1. Перед використанням даної функції потрібно ініціалізувати генератор випадкових чисел за допомогою процедури Randomize;
8. Sqr(х), де аргумент і результат є змінними цілого або дійсного типу - обчислює x2;
9. Sqrt(х), де аргумент і результат є змінними цілого або дійсного типу - обчислює √ х

Задача 1. Знайти середнє значение трьох чисел.
Program Srednee;
Uses Crt;
Var
First, Second, Third ,Sum: integer;
Ser¬_ar : real;
Begin
ClrScr;
Write (‘Введіть перше число=> ‘);
ReadLn(First);
Write (‘Введіть друге і третє числа через пробіл =>‘);
ReadLn(Second, Third);
Sum := First + Second + Third;
Ser_ar:= Sum/3;
Write (‘Среднєє значення ‘, First, ‘, ‘,Second, ‘ и ‘, Third, ‘ дорівнює ‘,Ser_ar:5:2);
ReadLn;
End.

Задача 2. Створити за допомогою програми свою візитну картку.
********************************
* Іванов Сергій *
* Пролетарска 74 кв. 55 *
* Телефон 445-72-88 *
********************************
Program Vizutka;
Uses Crt;
Begin
ClrScr;
Writeln (‘******************************‘);
Writeln (‘* Іванов Сергій *‘);
Writeln (‘* Пролетарська 74 кв. 55 *‘);
Writeln (‘* Телефон 445-72-88 *‘);
Writeln (‘******************************‘);
ReadLn;
End.

Задача 3. Запросити у користувача два числа і вивести на екран результат суми, різниці, добутку, частки та цілочисельного ділення і залишок від цілочисельного ділення у вигляді таблиці. Наприклад, при введенні чисел 5 і 3 на екрані повинна бути така таблиця:
***************************************************************
* X * Y * syma * riznuzya * dobytok * chastka * div * mod *
***************************************************************
* 5 * 3 * 8 * 2 * 15 * 1.67 * 1 * 2 *
***************************************************************
Program Arufmet_dii;
Uses Crt;
Var
x, y, syma, riznuzya dobytok, z_div, z_mod : integer;
chastka : real;
Begin
ClrScr;
Write (‘Введіть перше число=>‘);
ReadLn(x);
Write (‘Введіть друге числo=>‘);
ReadLn(y);
syma := x + y;
riznuzya := x - y;
dobytok := x * y;
chastka := x / y;
z_div := x div y;
z_mod := x mod y;
Writeln (‘***********************************************************‘);
Writeln (‘* X * Y * syma * riznuzya * dobytok * chastka * div * mod *‘);
Writeln (‘***********************************************************‘);
Writeln (‘* ’,x,’ * ,‘y,’ * ‘,syma,’ * ‘,riznuzya,’ * ‘,dobytok,’ * ‘,
chastka’, * ‘,z_div,’ * ‘,z_mod,’ *‘);
Writeln (‘***********************************************************‘);
ReadLn;
End.

Задача 4. З клавіатури задається число К. Викинути із запису числа цифру, що позначає сотні. Вивести отримане число на екран.
Program chuslo;
Uses Crt;
Var
x, y, z, k : integer;
Begin
ClrScr;
Write (‘Введіть число=>‘);
ReadLn(x);
y := x div 1000;
y := y * 100;
z := x mod 100;
k := y + z;
Writeln (k);
ReadLn;
End.
Задача 5. Задано площу кільця й радіус зовнішнього кола. Визначити радіус внутрішнього колa.
Program kilze;
Uses crt;
Var
s1,s2,sk,r1,r2:real;
Begin
clrscr;
write('sk=>');
readln(sk);
write('r1=>');
readln(r1);
s1:=pi*sqr(r1);
s2:=s1-sk;
r2:=sqrt(s2/pi);
writeln('r2=',r2:4:1);
End.
Задача 6. Трикутник заданий координатами своїх вершин. Знайти периметр трикутника.
Program perumetr_trukytnuka;
Uses crt;
Var
x1,x2,x3,y1,y2,y3,a,b,c,p:real;
Begin
clrscr;
write('x1=>');
readln(x1);
write('y1=>');
readln(y1);
write('x2=>');
readln(x2);
write('y2=>');
readln(y2);
write('x3=>');
readln(x3);
write('y3=>');
readln(y3);
a:=sqrt(sqr(x2-x1)+sqr(y2-y1));
b:=sqrt(sqr(x3-x2)+sqr(y3-y2));
c:=sqrt(sqr(x1-x3)+sqr(y1-y3));
p:=a+b+c;
writeln('p=',p:4:2);
End.
Задача 7. Визначено чотиризначне число. Знайти добуток цифр цього числа.
Program Dobutok;
Var
a,b,c,d,n:integer;
Begin
Write('n=>');
Readln(n);
a:=n div 1000;
b:=(n mod 1000) div 100;
c:=(n mod 100) div 10;
d:=n mod 10;
writeln(a*b*c*d);
End.

Задача 8. Елементи кола пронумеровані таким чином:
1-радіус (R),
2-діаметр (D),
3-довжина (L),
4-площа круга (S).
Дан радіус кола. Скласти програму і вивести значення інших елементів даного кола (в тому ж порядку).
Program kolo;
Uses crt;
Var
r,d,l,s:real;
Begin
clrscr;
write('r=>');
readln(r);
write('1 – radiyc=>',r:4:2);
write('2 - diametr=>',2*r:4:2);
write('3 - dovghuna=>',2*pi*r:4:2);
write('4 - plocha=>',pi*sqr(r):4:2);
readln;
End.
Задача 9. Дано катети прямокутного трикутника. Знайти його гіпотенузу і площа.
Program pr_trukytnuk;
Uses crt;
Var
a,b,c,s:real;
Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
c:=sqrt(sqr(a)+sqr(b));
s:=a*b/2;
write('c=>',c:4:2);
write('s =>',s:4:2);
readln;
End.
Задача 10. Обчислити площу прямокутного трикутника за формулою Герона, якщо задані його сторони.
Program trukytnuk;
Uses CRT
Var
a,b,c,p,s:real;
Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
c:=sqrt(sqr(a)+sqr(b));
p:=(a+b+c)/2;
s:=sqrt(p*(p-a)*(p-b)*(p-c));
writeln('s =>',s:4:2)
readln;
End.
Задача 11. Визначити площу трапеції висотою h, з основами а і b.
Program trapeziya;
Uses CRT
Var
a,b,h,s:real;
Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
write('h=>');
readln(h);
s:=(a+b)/2
writeln('s =>',s:4:2)
readln;
End.

Задача 12. Визначити кількість теплоти необхідне для нагрівання рідини масою m, що володіє теплоємністю с від температури t1 до температури t2.
Program teplota;
Uses CRT
Var
m,c,t1,t2,Q:real;
Begin
clrscr;
write('m=>');
readln(m);
write('c=>');
readln(c);
write('t1=>');
readln(t1);
write('t2=>');
readln(t2);
Q:=m*c*(t2-t1)
writeln('Q =>',Q:4:2)
readln;
End.
Задача 13. Обчислити об'єм паралелепіпеда зі сторонами a, b, c.
Program paralelepiped;
Uses CRT
Var
a,b,c,v:real;
Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
write('c=>');
readln(c);
v:=a*b*c
writeln('v =>',v:4:2)
readln;
End.

Задача 14. Поміняйте між собою значення двох змінних А і В, скориставшись третьої змінної R для зберігання тимчасового значення.
Program perestanovka;
Uses CRT
Var
a,b,r:integer;
Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
r:=a;
a:=b;
b:=r;
writeln('a =>',a)
writeln('b =>',b)
readln;
End.
Задача 15. Поміняти між собою значення двох змінних, не використовуючи третьої.
Program perestanovka;
Uses CRT
Var
a,b:integer;
Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
a:=a+b;
b:=b+a;
a:=b-a;
b:=b-2*a;
writeln('a=',a);
writeln('b=',b);
readln;
End.

Задача 16. Змінна Х містить тризначне число. Помістити в змінну S суму цифр цього числа.

Program syma;
Var
x,a,b,c,s:integer;
Begin
Write('n=>');
Readln(n);
a:=x div 100;
b:=(x mod 100) div 10;
c:=x mod 10;
s:=a+b+c;
writeln(‘s=’,s);
End.

Завдання для самостійної роботи
1. За даними сторонам прямокутника обчислити його периметр (P), площа (S) і довжину діагоналей

2. Дано дійсне число, знайдіть цілу частину цього числа і округлите його до найближчого цілого.

3. Знайти площу круга (S) і довжину кола (L) заданого радіуса.

4. Скласти програму обчислення площі довільного трикутника, користуючись будь-якими з відомих формул (задавши необхідні вихідні дані):
a, h, де а - основа трикутника, H - висота, проведена до цієї основии;
a,b,c, де а,b і c - сторони трикутника;
a,b,С, де a,b - сторони трикутника, ∟ С - кут між ними.

5. Обчислити раціональним способом, тобто за мінімальну кількість операцій:
а) у = x5, (тобто за три операції в = (x2) 2x);
б) у = x6, (тобто за три операції в = (x2x) 2);
в) у = x8, (тобто за три операції у = ((x2) 2) 2).

6. Обчислити об'єм (V) і площа (S) повної поверхні прямокутного паралелепіпеда по довжинах його ребер а, в, с.

7. По даній висоті Н і діаметру основи D прямого кругового циліндри обчислити його площу повної поверхні (S) і об'єм (V).

8. За відомим радіусу обчисліть об'єм і площу поверхні кулі.

9. Складіть програму обчислення довжини висоти трикутника, у якого довжина сторін дорівнює a,b,c.

10. Скласти програму обчислення тиску стовпа рідини, густина якої ρ, висотою Н на дно посудини, користуючись формулою P = gρH.

11. Складіть програму обчислення виштовхувальної сили, що діє на тіло об'ємом V, наполовину занурене в рідину густиною ρ, користуючись формулою F = gρV.

12. Складіть програму обчислення потенційної енергії тіла масою m на висоті h відносно Землі, користуючись формулою Eρ = gmh.

13. Складіть програму обчислення механічної роботи, коли тіло рівномірно рухається під дією прикладеної до нього сили, користуючись формулою A= FS, де F - прикладена сила, а S - пройдений шлях.

14. Введіть 4-значне число. Перетворити його в 2-значне, відкинувши першу і останню цифру.

15. З клавіатури задається число К. Викинути із запису До цифру, що позначає сотні. Вивести отримане число на екран.

16. Складіть програму обчислення довжини медіан треугольника, у якого довжина сторін дорівнює a, b, c.

2. Алгоритми з розгалуженням

Лінійні алгоритми, це алгоритми, в яких всі етапи рішення задачі виконуються строго послідовно.
Розгалуженим називають такий алгоритм, в якому вибирається один з декількох можливих варіантів обчислювального процесу.
Кожен подібний шлях називається гілкою алгоритму.
Ознакою розгалуження алгоритму є наявність операцій перевірки умови.
Розрізняють два види умов - прості і складені.
Простою умовою називається вираз, що складається з двох арифметичних виразів або двох текстових величин, пов'язаних одним із знаків:
< - Менше, ніж ...
> - Більше, ніж ...
<= - Менше, ніж ... або дорівнює
>= - Більше, ніж ... або дорівнює
<> - Не дорівнює
= - Дорівнює.
Вираз, про який, при підстановці в нього деяких значень змінних, можна сказати правдивий (вірний) чи помилковий (невірний) називаються булевим (логічним) виразом.
Змінна, яка може приймати одне з двох значень: True (правда) або False (брехня), називається булевой (логічного) змінної.
Складеною умовою називається вираз, в якому використовуються логічні операції and, or, not.
Логічна операція and дає результат true тоді і тільки тоді, коли обидва операнди мають значення true.
Логічна операція or дає результат true тоді, коли хоча б один операнд має значення true.
Логічна операція not завжди дає результат, протилежний значенню її операнда.
Логічну операцію and ще називають логічним множенням, а логічну операцію or - логічним додаванням.
Кожна програма повинна здійснювати контроль за допустимостью величин, що беруть участь в обчисленнях. Тут ми стикаємося з розгалуженням нашого алгоритму в залежності від умови. Для реалізації таких умовних переходів у мові Паскаль використовують оператори If і Else, а також оператор безумовного переходу Goto.
У загальному виглядіу повна форма умовного оператора має вигляд:
if <логичний вираз>
then
<оператор 1>
else
<оператор 2>
Умовний оператор працює за наступним алгоритмом:
Спочатку обчислюється значення логічного виразу, розташованого за службовим словом IF. Якщо його результат істина, виконується <оператор 1>, розташований після слова THEN, а дії після ELSE пропускаються; якщо результат невірний, то, навпаки, дії після слова THEN пропускаються, а після ELSE виконується <оператор 2>. Якщо в якості оператора повинна виконатися серія операторів, то вони беруться в операторні дужки begin-End. Конструкція Begin ... End називається складеним оператором.

if <логічний вираз>
then
begin
оператор 1;
оператор 2;
...
end
else
begin
оператор 1;
оператор 2;
...
end;
Більшість операторів в програмах на мові Паскаль закінчуються крапкою з комою, але після деяких операторів крапка з комою не ставиться.
Загальні правила вживання крапки з комою:
1. Кожний опис змінної і визначення константи закінчуються крапкою з комою.
2. Кожен оператор у тілі програми завершується крапкою з комою, якщо відразу за ним не йдуть зарезервовані слова End, Else, Until.
3. Після певних зарезервованих слів, таких, як Then, Else, Var, Const, Begin, ніколи не ставиться крапка з комою.

Неповна форма умовного оператора має наступний вигляд:

if <логічний вираз>
then
<оператор>

Якщо вираз, розташований за службовим словом IF. в результаті дає істину, виконуються дії після слова THEN, в іншому випадку ці дії пропускаються.

Часто доводиться розглядати не два, а більшу кількість варіантів. Це можна реалізувати, використовуючи декілька умовних операторів. Коли оператор if з'являється всередині іншого оператора if, вони вважаються вкладеними.
Не рекомендується використовувати більше одного-двох рівнів вкладення if. За другим рівнем вкладення стає важко відновити послідовність перевірки умов кожним умовним оператором.
Мова Паскаль надає для цих цілей іншу керуючу структуру (оператор вибору case), яка дозволяє побудувати розгалуження по ряду умов у формі, більш зручній для читання програм.
Оператор вибору дозволяє вибрати одне з декількох можливих продовжень програми. Параметром, за яким здійснюється вибір, служить так званий ключ вибору (або селектор) - вираз будь-якого типу (крім типів REAL і STRING).

Загальна форма запису наступна:

case селектор of
значення1 : оператор (группа операторів);
значення2 : оператор (группа операторів);
. . . . . . . . . . . . . . . . . . . . . .
значенняN : оператор (группа операторів)
else оператор (группа операторів);
end;

Оператор вибору працює таким чином.
Спочатку обчислюється значення виразу, що стоїть після зарезервованого слова case, а потім виконується оператор (або складений оператор), відповідний результату обчислення виразу. Може статися, що в списку вибору не виявиться константи рівній обчисленого значення ключа. У цьому випадку управління передається оператору, що стоїть за словом ELSE.
Якщо один оператор виконується при декількох значеннях, то їх можна перерахувати через кому.
Константи повинні належати до того ж типу, що і селектор.

В програмуванні виникає необхідність безумовного переходу для виконання потрібної послідовності операторів. Для цього призначений оператор безумовного переходу, який має таку форму запису:
goto мітка;
Після опису мітки її можна використовувати в програмі. Мітка записується перед оператором і відокремлюється від нього двокрапкою. А оператор goto повинен бути розміщений в тому місці програми, звідки виконується перехід. Оператор goto передає управління на оператор із заданою міткою. Оператор goto можна вставляти в будь-яке місце програми.
В простих програмах цей оператор не викликає труднощів. При написанні складних і об'ємних програм можуть бути труднощі, тому програмісти намагаються не використовувати цей оператор. Застосування оператора безумовного переходу – це поганий стиль програмування.

Задача 1. Розв’язати квадратне рівняння.

Program kv_rivnyannya;
Uses CRT
Var
a,b,c:real;
x1,x2:real;
D:real;
Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
write('c=>');
readln(c);
D:=sqr(b)-4*a*c;
if D>=0 then
Begin
X1:=(-b+sqrt(D))/(2*a);
X2:=(-b-sqrt(D))/(2*a);
writeln('x1=>',x1:4:2);
writeln('x2=>',x2:4:2);
end
else
writeln(‘Nema koreniv y rivnyannya’
readln;
End.

Задача 2. Визначити номер квадранта, в якому розміщено точка М(х,у).

Program koordunatu;
Var
x,y:real;
Begin
Write( 'x=>' );
readln(x);
Write( 'y=>' );
readln(y);
if (x=0) and (y=0) then
writeln('M(0,0)')
else
if x=0 then
writeln('OY')
else
if y=0 then
writeln('OX');
if (x>0) and (y>0) then writeln('І');
if (x<0) and (y>0) then writeln('II');
if (x<0) and (y<0) then writeln('III');
if (x>0) and (y<0) then writeln('IV')
End.

Задача 3. Дано два дійсних числа Х і У. Менше з них замінити їх напівсумою, а більше – їх подвоєним добутком. Результат вивести на екран монітора.

Program porivnyannya;
Uses CRT
Var
x,y:real;
Begin
clrscr;
write('x=>');
readln(x);
write('y=>');
readln(y);
if x>y then
Begin
x:=2*x*y;
y:=(x+y)/2;
end
else
Begin
y:=2*x*y;
x:=(x+y)/2;
end;
writeln(‘x=’,x:4:2);
writeln(‘y=’,y:4:2);
readln;
End.

Задача 4. Дано три дійсних числа. Піднести до квадрату лише додатні числа. Результат вивести на екран монітора.

Program dodat_chusla;
Uses crt;
Var
a,b,c:real;
Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
write('c=>');
readln(c);
if a>0 then a:=sqr(a);
if b>0 then b:=sqr(b);
if c>0 then c:=sqr(c);
writeln('a=',a:4:2);
writeln('b=',b:4:2);
writeln('c=',c:4:2);
readln;
End.

Задача 5. Залежно від розміру суми, розмір податку з неї розраховується за такою схемою: якщо сума не перевищує деяку величину а , то податок не вираховується, якщо сума більша за а , але не перевищує b ,то податок становить 10%, якщо сума більша за b , але не перевищує с , то податок становить 25% і якщо сума більша за с , то податок становить 50%. Визначити, який податок буде нарахований із суми розміром S.

Program podatok;
Var
a, b, c s,p: real;
Begin
writeln(‘Введить числа a, b, c’);
readln(a,b,c);
writeln(‘Введите числа суму’);
readln(s);
if (s<=a) then p:=0
if (s>a) and (s<=b) then p:=s*0.1;
if (s>b) and (s<=c) then p:=s*0.25;
if (s>c) then p:=s*0.5;
writeln(‘p=’,p:5:2);
readln;
End.

Задача 6. Дано цілі числа a, b, c. Якщо a ≤ b ≤ c, то всі числа замінити їх квадратами, якщо a> b> c, то кожне число замінити найбільшим з них, в іншому разі змінити знак кожного числа.

Program porivnyannya;
Var
a, b, c : integer;
Begin
writeln(‘Введить числа a, b, c’);
readln(a,b,c);
if (a<=b) and (b<=c) then
begin
a:=sqr(a);
b:=sqr(b);
c:=sqr(c);
end
else
if (a>b) and (b>c) then
begin
b:=a;
c:=a;
end
else
begin
a:=-a;
b:=-b;
c:=-c;
end
writeln(a,b,c);
readln;
End.

Задача 7. Дано три різні числа, найти среднє з них. Среднім називається число, яке більше найменшого з даних чисел, але меньше найбільшого.
Program seredne;
Var
a, b, c, ser: integer;
Begin
writeln(‘Введить числа a, b, c');
readln(a,b,c);
if ((a>b) and (b>c))or((aa) and (a>c))or((bc) and (c>b))or((c>a)and(csqrt(sqr(x)+sqr(y)) then
writeln(‘Tochka A popadae v sereduny kola’)
Else
if r=sqrt(sqr(x)+sqr(y)) then
writeln(‘Tochka A znachodutsya na koli’)
Else
if r0 і a2<>0. Визначити:
1. Чи мають ці рівняння одинакові пари коренів;
2. Чи збігаються відношення між меншими і більшими коренями обох рівнянь;
3. Чи можуть бути корені обох рівнянь сторонами деякого прямокутника.

Program kv_rivnyannya1;
Uses Crt;
Var
a1,b1,c1,a2,b2,c2:real;
x11,x12,x21,x22:real;
D1,D2:real;
Begin
clrscr;
write('a1=>');
readln(a1);
write('b1=>');
readln(b1);
write('c1=>');
readln(c1);
write('a2=>');
readln(a2);
write('b2=>');
readln(b2);
write('c2=>');
readln(c2);
D1:=sqr(b1)-4*a1*c1;
if D1>=0 then
Begin
X11:=(-b1+sqrt(D1))/(2*a1);
X12:=(-b1-sqrt(D1))/(2*a1);
end
else
writeln('Nema koreniv y pershogo rivnyannya');
D2:=sqr(b1)-4*a1*c1;
if D2>=0 then
Begin
X21:=(-b2+sqrt(D2))/(2*a2);
X22:=(-b1-sqrt(D2))/(2*a2);
end
else
writeln('Nema koreniv y drygogo rivnyannya');
if ((x11=x21)and(x12=x22))or((x11=x22)and(x12=x21)) then
writeln('Rivnyannya majt odunakovi paru koreniv');
if x11/x21=x12/x22 then
writeln('Vidnoshennya migh menshumu І bilshumu korenyamu obox rivnyann
zbigajtsya');
if ((x11>0)and(x12>0)and(x21>0)and(x22>0)) and((x11=x21)and(x12=x22)) or((x11=x22)and(x12=x21)) then
writeln('Koreni rivnyann moghyt bytu storonamu pryamokytnuka');
readln;
End.

Задача 10. Дано дійсні додатні числа a, b, c, х, у. З'ясувати, чи пройде цеглина з ребрами a, b, c в прямокутний отвір зі сторонами х, у. Просовувати цеглу в отвір дозволяється тільки так, щоб кожна з його ребер було паралельно або перпендикулярно кожної зі сторін отвору.

Program kv_rivnyannya1;
Uses Crt;
Var
a,b,c,x,y:real;
Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
write('c=>');
readln(c);
write('x=>');
readln(x);
write('y=>');
readln(y);
if ((a<=x)and(b<=y))or((a<=y)and(b<=x))or
((a<=x)and(c<=y))or((a<=y)and(c<=x))or((c<=x)and(b<=y))or((c<=y)and(b<=x)) then
writeln('Proshtovchnytu zegluny moghna')
else
writeln('Proshtovchnytu zegluny ne moghna');
readln;
End.

Задача 11. Послуги стаціонарного телефонного зв’язку сплачують за такими правилом. Кожного місяця, сплачуючи абонентну плату в розмірі с1 грн., користувач отримує х безоплатних хвилин. Якщо час розмов більший за безоплатний (х хв.), але не перевищує у хвилин, то його оплачують з розрахунку с2 грн. за 1 хв розмови. Якщо ж абонент протягом місяця користувався телефонним зв’язком понад у хв, він сплачуватиме свої розмови з розрахунку с3 грн. за кожну хвилину розмови. Необхідно розрахувати, яку суму має сплатити абонент за користування стаціонарним телефоном.

Program telefon;
Uses Crt;
Var
c1,c2,c3,x,y,s,t:real;
Begin
clrscr;
write('c1=>');
readln(c1);
write('c2=>');
readln(c2);
write('c3=>');
readln(c3);
write('x=>');
readln(x);
write('y=>');
readln(y);
write('t=>');
readln(t);
if tx)and(ty then s:=c1+t*c3;
writeln('S=',s:4:2);
readln;
End.

Задача 12. Дано двозначне число n. Необхідно створити інтерфейс та визначити:
1. Чи є сума його цифр двозначним числом;
2. Чи кількість одиниць цього числа більша за кількість його десятків.

Program dv_chuslo;
Uses Crt;
Var
n,a,b,s:integer;
Begin
TextBackGround(7);
Clrscr;
window(2,2,78,8);
TextBackGround(1);
Clrscr;
TextColor(14);
GoToXY(27,2);
Writeln('Yvedit dvoznachne chuslo');
GoToXY(37,5);
Write('n=');
readln(n);
window(3,9,79,9);
TextBackGround(0);
Clrscr;
window(79,3,79,8);
TextBackGround(0);
Clrscr;
window(2,11,78,15);
TextBackGround(4);
Clrscr;
a:=n div 10;
b:=n mod 10;
s:=a+b;
TextColor(15);
GoToXY(23,3);
Write('Syma zufr chusla dorivnje: ',s);
TextColor(15);
GoToXY(23,5);
if (s div 10)<>0 then Writeln('Syma zufr - dvoznachne chuslo')
else Writeln('Syma zufr - ne dvoznachne chuslo');
window(3,16,79,16);
TextBackGround(0);
Clrscr;
window(79,12,79,15);
TextBackGround(0);
Clrscr;
window(2,18,78,23);
TextBackGround(4);
Clrscr;
TextColor(15);
GoToXY(18,4);
if b>a then Writeln('Kilkist odunuz chusla bilsha za kilkist desyatkiv')
else Writeln('Kilkist odunuz chusla mensha za kilkist desyatkiv');
window(3,24,79,24);
TextBackGround(0);
Clrscr;
window(79,18,79,24);
TextBackGround(0);
Clrscr;
readln;
End.

Задача 13. Необхідно створити інтерфейс та визначити, чи є введене користувачем тризначне число паліндромом.

Program chuslo_palidr;
Uses Crt;
Var
x,y,a,b,c: integer;
Begin
TextBackGround(7);
Clrscr;
window(2,2,78,13);
TextBackGround(1);
Clrscr;
TextColor(14);
GoToXY(27,5);
Write ('Yvedit chuslo=>');
ReadLn(x);
a:=x div 100;
b:=(x mod 100) div 10;
c:=(x mod 10);
y:=c*100+b*10+a;
window(3,14,79,14);
TextBackGround(0);
Clrscr;
window(79,3,79,14);
TextBackGround(0);
Clrscr;
window(2,16,78,23);
TextBackGround(4);
Clrscr;
TextColor(15);
GoToXY(26,4);
if x=y then Writeln ('yes - chuslo palidrom' )
Else Writeln ('No - chuslo ne palidromu');
window(3,24,79,24);
TextBackGround(0);
Clrscr;
window(79,17,79,24);
TextBackGround(0);
Clrscr;
ReadLn;
End.

Задача 14. Розмір наданної знижки залежить від вартості придбаних у магазині товарів. Якщо загальна вартість покупки менша 201 грн., знижка не надають. Якщо покупець придбав товари на суму від 201 грн. до 501 грн., то він отримає знижку х % . Якщо ж загальна вартість покупки перевищує 501 грн., його знижка дорівнюватиме у %.

Program znughka;
Uses Crt;
Var
x,y: integer;
s,s1,s2: real;
Begin
TextBackGround(7);
Clrscr;
window(2,2,39,23);
TextBackGround(3);
Clrscr;
TextColor(14);
GoToXY(2,4);
Writeln ('Vidsotok znughku, yaksco pokypka vid');
writeln;
Write(' 201 do 501 grn. ==>');
read(x);
writeln;
writeln;
Writeln (' Vidsotok znughku, yaksco pokypka vid');
writeln;
Write(' 501 grn. ==>');
read(y);
writeln;
writeln;
writeln;
Writeln;
Write(' Zagalna vartist pokypku ==> ');
readln(s);
window(3,24,40,24);
TextBackGround(0);
Clrscr;
window(40,3,40,24);
TextBackGround(0);
Clrscr;
window(42,2,78,23);
TextBackGround(4);
Clrscr;
TextColor(15);
GoToXY(2,4);
Write('Vam nadano znughky');
if s<201 then
begin
Writeln(' ',0,'%');
s1:=s*0;
end
else
if s<501 then
begin
Writeln(' ',x,'%');
s1:=s*x/100;
end
else
begin
Writeln(' ',y,'%');
s1:=s*y/100;
end;
writeln;
writeln;
writeln;
Writeln (' Syma znughku');
writeln;
Writeln(' stanovut ',s1:4:2,' grn. ');
writeln;
writeln;
writeln;
writeln;
Writeln;
s2:=s-s1;
Writeln (' Splatutu do kasu ', s2:4:2,'grn.');
window(43,24,79,24);
TextBackGround(0);
Clrscr;
window(79,3,79,24);
TextBackGround(0);
Clrscr;
ReadLn;
End.

Задача 15. Необхідно визначити вартість міжміської телефонної розмови за її тривалістю у хвилинах та кодом міста абонента. Вартість хвилини розмови залежить від відстані між містами, її визначають за введеним кодом. Розробити зручний інтерфейс програми.

Program vart_telefon;
Uses Crt;
Var
k,tr: integer;
vart: real;
Begin
TextBackGround(7);
Clrscr;
window(2,2,40,24);
TextBackGround(3);
Clrscr;
TextColor(14);
GoToXY(2,4);
Writeln (' Misto Kod');
writeln;
Writeln('--------------------------------------');
writeln;
writeln(' Brovaru 4494 0.4');
Writeln;
writeln(' Binnuzya 432 0.8');
Writeln;
writeln(' Dnipropetrovsk 56 1.2');
Writeln;
writeln(' Lviv 322 1.0');
Writeln;
writeln(' Ternopil 352 1.0');
Writeln;
writeln(' Chernivzi 372 1.2');
Writeln;
writeln(' Charkiv 57 1.0');
Writeln;
Writeln('--------------------------------------');
writeln;
writeln(' Vartist chvulunu, grn.');
window(42,2,78,12);
TextBackGround(2);
Clrscr;
TextColor(14);
GoToXY(4,3);
Write(' Yvedit kod mista => ');
Readln(k);
writeln;
Writeln;
Writeln;
Writeln(' Yvedit truvalist');
Writeln;
Write(' rozmovu y chvulunax => ');
Readln(tr);
window(42,14,78,24);
TextBackGround(4);
Clrscr;
TextColor(15);
GoToXY(4,4);
Case k of
4494: vart:=0.4*tr;
432: vart:=0.8*tr;
57,322,352: vart:=tr;
56,372: vart:=1.2*tr;
Else
begin
writeln('Informaziya pro vartist rozmovu ');
writeln;
writeln(' z zum mistom nevidoma');
writeln;
end;
end;
if vart<>0 then
begin
Writeln(' Vartist rozmovu ');
writeln;
writeln(' stanovut ',vart:4:2,' grn.');
end;
ReadLn;
End.

Задача 16. За введеним номером дня тижня виводити його назву. Якщо цей день робочий, то на екран необхідно виводити розклад уроків на цей день.

Program rozklad_yrokiv;
Uses Crt;
Label a,b,c,d,e,f,g,h;
Var
k: integer;
Begin
Clrscr;
TextBackGround(7);
Clrscr;
window(2,2,79,25);
TextBackGround(2);
Clrscr;
TextColor(14);
GoToXY(7,4);
write('Yvedit nomer dnya tughdnya => ');
readln(k);
writeln;
Writeln (' Rozklad yrokiv');
writeln;
Writeln('--------------------------------------');
writeln;
Case k of
1: goto a;
2: goto b;
3: goto c;
4: goto d;
5: goto e;
6: goto f;
7: goto g;
Else
writeln('Ze ne den tughdnya');
end;
a: writeln(' Ponedilok');
Writeln;
Writeln(' 1. Chimiya');
Writeln;
Writeln(' 2. Chimiya');
Writeln;
Writeln(' 3. Algebraa');
Writeln;
Writeln(' 4. Algebra');
Writeln;
Writeln(' 5. Fizkyltyra');
Writeln;
Writeln(' 6. Informatuka');
Writeln;
Writeln(' 7. Informatuka');
Writeln;
goto h;
b: writeln(' Vivtorok');
Writeln;
Writeln(' 1. Chimiya');
Writeln;
Writeln(' 2. Chimiya');
Writeln;
Writeln(' 3. Algebraa');
Writeln;
Writeln(' 4. Algebra');
Writeln;
Writeln(' 5. Fizkyltyra');
Writeln;
Writeln(' 6. Informatuka');
Writeln;
Writeln(' 7. Informatuka');
Writeln;
goto h;
c: writeln(' Sereda');
Writeln;
Writeln(' 1. Chimiya');
Writeln;
Writeln(' 2. Chimiya');
Writeln;
Writeln(' 3. Algebraa');
Writeln;
Writeln(' 4. Algebra');
Writeln;
Writeln(' 5. Fizkyltyra');
Writeln;
Writeln(' 6. Informatuka');
Writeln;
Writeln(' 7. Informatuka');
Writeln;
goto h;
d: writeln(' Chetver');
Writeln;
Writeln(' 1. Chimiya');
Writeln;
Writeln(' 2. Chimiya');
Writeln;
Writeln(' 3. Algebraa');
Writeln;
Writeln(' 4. Algebra');
Writeln;
Writeln(' 5. Fizkyltyra');
Writeln;
Writeln(' 6. Informatuka');
Writeln;
Writeln(' 7. Informatuka');
Writeln;
goto h;
e: writeln(' Pyatnuzya');
Writeln;
Writeln(' 1. Chimiya');
Writeln;
Writeln(' 2. Chimiya');
Writeln;
Writeln(' 3. Algebraa');
Writeln;
Writeln(' 4. Algebra');
Writeln;
Writeln(' 5. Fizkyltyra');
Writeln;
Writeln(' 6. Informatuka');
Writeln;
Writeln(' 7. Informatuka');
Writeln;
goto h;
f: writeln(' Sybota');
Writeln;
Writeln(' Vuxidnuj den');
goto h;
g: writeln(' Nedilya');
Writeln;
Writeln(' Vuxidnuj den');
h: ReadLn;
End.

Задача 17. Вартість квитка на «Льодову арену» залежить від часу початку сеансу. Вартість дитячого квитка становить половину вартості квитка для дорослого. Якщо у відвідувача ковзанки є дисконтна картка, купуючи квиток, він отримує знижку, яка становить х%. Необхідно визначити суму коштів, які повинен сплатити відвідувач ковзанки в касу.

Program vart_kvutka;
Uses Crt;
label 1;
Var
K1,k2,t,x,d: integer;
vart,s: real;
Begin
TextBackGround(7);
Clrscr;
window(2,2,40,24);
TextBackGround(3);
Clrscr;
TextColor(14);
GoToXY(1,2);
Writeln (' Chas pochatky - Chas zakinch seansy');
writeln;
Writeln('-------------------------------------');
writeln(' 8:00 - 9:30 ');
writeln(' 10:00 - 11:00 25 grn.');
writeln(' 12:00 - 13:00 ');
writeln;
writeln(' 14:00 - 15:00 30 grn.');
writeln(' 16:00 - 17:00 ');
writeln;
writeln(' 18:00 - 19:00 ');
writeln(' 19:00 - 20:00 35 grn.');
writeln(' 20:00 - 21:00 ');
Writeln;
writeln(' 22:00 - 23:30 25 grn.');
Writeln('-------------------------------------');
writeln(' Vartist kvutka, grn.');
writeln;
writeln(' Vidsotok znughku, yaksco j ');
writeln;
write(' duskontna kartka => ');
readln(x);
window(42,2,78,12);
TextBackGround(2);
Clrscr;
TextColor(14);
GoToXY(2,3);
Write('Yvedit chas pochatky seansy =>');
Readln(t);
Writeln;
Write(' Kilkist dutyachux kvutkiv => ');
Readln(k1);
Writeln;
Write(' Kilkist doroslux kvutkiv => ');
Readln(k2);
Writeln;
Write(' Y vas j duskontna kartka => ');
Readln(d);
Writeln;
window(42,14,78,24);
TextBackGround(4);
Clrscr;
TextColor(15);
GoToXY(1,3);
Case t of
8,10,12,22: vart:=25*k2+(25*k1)/2;
14,16: vart:=30*k2+(30*k1)/2;
18,19,20: vart:=35*k2+(35*k1)/2;
Else
begin
TextColor(15);
GoToXY(1,5);
writeln(' Informaziya pro takuj chas ');
writeln;
writeln(' pochatky seansy nevidoma');
writeln;
goto 1;
end;
end;
If d=1 then
begin
s:=vart*x/100;
writeln;
Write(' Vu majte znughky y rozmiri=>',s:4:2,'grn.' );
end
Else
Write(' Y vas nema znughku');
vart:=vart-s;
if vart<>0 then
begin
writeln;
writeln;
writeln;
Writeln(' Vartist kvutka stanovut ',vart:4:2,'grn.');
end;
1: ReadLn;
End.

Задача 18. Необхідно перевести час наданий у секундах в ті одиниці часу, що обере користувач.

Program odunuzi_chasy;
Uses Crt;
Var
N,s: longint;
r,m,d,g,ch:real;
Begin
TextBackGround(7);
Clrscr;
window(2,2,39,23);
TextBackGround(3);
Clrscr;
TextColor(14);
GoToXY(4,5);
Writeln (' Odunuwi vumirjvannya chasy: ');
writeln;
Writeln('--------------------------------------');
writeln;
writeln(' 1 - chvulunu');
Writeln;
writeln(' 2 - godunu');
Writeln;
writeln(' 3 - doba');
Writeln;
writeln(' 4 - misyaz');
Writeln;
writeln(' 5 - roku');
writeln;
Writeln('--------------------------------------');
window(3,24,40,24);
TextBackGround(0);
Clrscr;
window(40,3,40,24);
TextBackGround(0);
Clrscr;
window(42,2,78,12);
TextBackGround(2);
Clrscr;
TextColor(14);
GoToXY(4,3);
Writeln(' Yvedit nomer odunuz');
Write(' vumirjvannya chasy => ');
Readln(n);
writeln;
Writeln;
Writeln;
Writeln(' Yvedit znachennya chasy');
Write(' y sekyndach => ');
Readln(s);
window(43,13,79,13);
TextBackGround(0);
Clrscr;
window(79,3,79,13);
TextBackGround(0);
Clrscr;
window(42,15,78,23);
TextBackGround(4);
Clrscr;
TextColor(15);
GoToXY(10,4);
Case n of
1: writeln(s,' c = ',s/60:4:2,' ch');
2: writeln(s,' c = ',s/3600:4:2,' godun');
3: writeln(s,' c = ',s/(24*3600):4:2,' dobu');
4: writeln(s,' c = ',s/(30*24*3600):4:2,' misyziv');
5: writeln(s,' c = ',s/(365*3600):4:2,' rokiv');
Else
writeln('Inshuch odunuz vumirjvannya chasy nema');
end;
window(43,24,79,24);
TextBackGround(0);
Clrscr;
window(79,16,79,23);
TextBackGround(0);
Clrscr;
ReadLn;
End.

Завдання для самостійної роботи
1. Дано довільні числа a, b та с. Якщо не можна побудувати трикутник з такими довжинами сторін, то надрукувати 0, інакше надрукувати відповідне повідомлення в залежності від того, рівносторонній це трикутник, рівнобедрений або який-небудь інший.

2. Дано число х. Надрукувати в порядку зростання числа x, 1 + | x | і (1 + х2).

3. Дано числа a1, b1, c1, a2, b2, c2. Надрукувати координати точки перетину прямих, описуваних рівняннями a1х + b1у = c1 і a2х + b2у = c2, або повідомити, що прямі співпадають, не перетинаються або зовсім не існують.

4. Написати алгоритм знаходження числа днів у місяці, якщо дано: Номер місяця n - ціле число а, рівне 1 для високосного року і дорівнює 0 у противному випадку.

5. За номером дня тижня вивести його назву.

6. Залежно від того введена відкрита дужка чи закрита, надрукувати "відкрита кругла дужка" або "закрита фігурна дужка". (Враховувати круглі, квадратні, фігурні дужки).

7. Напишіть програму, яка по введеному числу з проміжку 0 .. 24, визначає час доби.

8. Напишіть програму, яка по введеному номеру місяця високосного або невисокосного року, виводить кількість днів у місяці.

9. Складіть програму знаходження добутку двох найбільших з трьох введених з клавіатури чисел.

10. Запитати сторони трикутника і визначити, чи є він різнобічним, рівнобедреним або рівностороннім. Врахувати умова: третя сторона не повинна перевищувати суму двох інших, інакше трикутник не існує.

11. Складіть програму для обчислення виразу
а) max (x + y + z, xyz) +3;
b) min (x2 + y2, y2 + z2) -4;
Значення змінних x, y, z вводяться з клавіатури.

12. Запропонуйте користувачеві ввести число з клавіатури. Якщо число дорівнює нулю, виведіть слово "нуль", якщо число додатнє, виведіть слово "додатнє", якщо число від’ємне, виведіть слово " від’ємне ".

13. Надрукувати програму виведення днів тижня за номером.

14. Потрібно написати програму, яка обчислює значення функції (у = f (x)):
у = x - 2, якщо x> 0,
y = 0, якщо x = 0,
y = | x |, якщо x <0.

15. Знайти мінімальне з трьох чисел.

16. Дано цілі числа a, b, c. Якщо a ≤ b ≤ c, то всі числа замінити їх квадратами, якщо a> b> c, то кожне число замінити найбільшим з них, інакше змінити знак кожного числа.

3. Циклічні алгоритми
Цикл - це послідовність операторів, яка може виконуватися більше одного разу.
Циклічний алгоритм - це алгоритм, що містить один або кілька циклів.
В мові Паскаль існують зручні конструкції для організації циклів:
• цикл з передумовою;
• цикл з післяумовою;
• цикл з лічильником.
Цикли з передумовою використовуються тоді, коли виконання циклу пов'язано з деякою логічною умовою. Оператор циклу з передумовою має дві частини: умова виконання циклу і тіло циклу.
При виконанні оператора while певна група операторів виконується до тих пір, поки визначена в операторі while булева умова істинна. Якщо умова відразу хибна, то оператор не виконається жодного разу.
Загальна форма запису наступна:

while <булево выражение> do
begin
група операторів
end;

Операторні дужки ставлять, щоб відокремити від решти програми ту групу операторів, яку потрібно повторити в циклі. Якщо в циклі потрібно виконати тільки один оператор, то операторні дужки не ставлять.

При використанні циклу з передумовою треба пам'ятати наступне:

1. значення умови виконання циклу має бути визначено до початку циклу;

2. якщо значення умови істинно, то виконується тіло циклу, після чого повторюється перевірка умови. Якщо умова помилкова, то відбувається вихід з циклу;

3. хоча б один з операторів, що входять в тіло циклу, має впливати на значення умови виконання циклу, інакше цикл буде повторюватися нескінченне число разів.

При вирішенні завдань виникає необхідність виконати тіло циклу хоча б один раз, а потім дослідити умову повторювати його ще раз чи ні. Це завдання виконує інший вид циклу - цикл з післяумовою Repeat.
Загальна форма запису наступна:

repeat
оператори оператори
until <умова>;
Є невелика відмінність в організації циклу repeat в порівнянні з while: для виконання в циклі repeat декількох операторів не слід поміщати ці оператори в операторні дужки begin ... End. Зарезервовані слова repeat і until діють як операторні дужки.
Конструкція repeat ... until працює аналогічно циклу while. Різниця полягає в тому, що цикл while перевіряє умову до виконання дій, у той час як repeat перевіряє умову після виконання дії. Це гарантує хоча б одне виконання дії до завершення циклу.

Цикли з лічильником складають такий клас, в яких виконання виконавчої частини повинно повторюватися заздалегідь визначене число разів.
Загальна форма запису циклу з лічильником
for і := A to B do
begin
. . .
end;

for і := A downto B do
begin
. . .
end;

Змінна і - керуюча змінна або змінна циклу,
А - початкове значення змінної циклу,
В - кінцеве значення змінної циклу.
При переході до обробки оператора циклу for керуючій змінні присвоюється задане початкове значення. Потім у циклі виконується оператор (або складений оператор), кожного разу після виконання оператора керуюча змінна збільшується на 1 (для for ... to) або зменшується на 1 (для for ... downto). Цикл завершується при досягненні керуючої змінної свого кінцевого значення.
Тип керуючої змінної не повинен бути real.
Виконавча частина одного з циклів For є новим оператором циклу For. Структури такого роду називаються вкладеними циклами. При завершенні внутрішнього циклу керуюча змінна зовнішнього циклу збільшується. Повторення цих дій буде тривати до завершенія зовнішнього циклу.

Задача 1. Сума кредиту становить S грошових одиниць, які позичив банк на n років під х% річних. Кредит необхідно повертати однаковими частинами раз на рік, сплачуючи банку крім цього відсоток за користування ще не повернутими коштами.

Program bank;
Uses Crt;
Var
N,r,v_s: integer;
K,tsp,v_sp:real;
Begin
TextBackGround(7);
Clrscr;
window(2,2,29,23);
TextBackGround(3);
Clrscr;
TextColor(14);
GoToXY(2,5);
write('Syma kreduty => ');
Readln(k);
writeln;
writeln;
write(' Bankivskuj vidsotok => ');
readln(v_s);
Writeln;
writeln;
Writeln;
Write (' Termin kredutyvannya => ');
readln(n);
Writeln;
window(3,24,30,24);
TextBackGround(0);
Clrscr;
window(30,3,30,24);
TextBackGround(0);
Clrscr;
window(32,2,78,23);
TextBackGround(2);
Clrscr;
TextColor(14);
GoToXY(1,1);
Tsp:=k/n;
For r:=1 to n do
begin
Writeln(r,' rik');
Writeln('Chastuna tila kreduta dlya povernennya:', tsp:4:2);
V_sp:=k*v_s/100;
Writeln('Oplata za korustyvannya kredutom: ', v_sp:4:2);
Writeln('Zagalna vuplata za ',r,' rik: ',tsp+v_sp:4:2);
K:=k-tsp;
Writeln;
End;
window(33,24,79,24);
TextBackGround(0);
Clrscr;
window(79,3,79,23);
TextBackGround(0);
Clrscr;
ReadLn;
End.

Задача 2. Необхідно визначити кількість цифр натурального числа n.

Program kil_zufr;
Uses Crt;
Var
N,k,і: longint;
Begin
Clrscr;
Write(‘Yvedit chuslo =>’);
Readln(n);
і:=0;
While n<>0 do
Begin
N:=n div 10;
і:=і+1;
End;
Writeln(‘Chuslo iz ‘,І,’ zufr’);
ReadLn;
End.

Задача 3. Для заданого цілого числа x обчислити значення функції:

.

Program fynkziya;
Uses Crt;
Var
y:real;
x,і: integer;
Begin
Clrscr;
Write(‘Yvedit chuslo =>’);
Readln(x);
y:=0;
For і:=1 to 9 do
y:=y+(x-і)/(і+1);
Writeln(‘y=’,y:3:2);
ReadLn;
End.

Задача 4. Необхідно вивести на екран значення квадратів натуральних чисел від 1 до n, де n>1 - натуральне число, значення якого задає користувач.

Program kvadrat;
Uses crt;
Var
n,і,kv:integer;
Begin
TextBackGround(7);
clrscr;
window(7,2,73,9);
TextBackGround(5);
clrscr;
TextColor(14);
GotoXY(20,4);
write('Yvedit natyralne chuslo n => ');
readln(n);
window(8,10,74,10);
TextBackGround(0);
clrscr;
window(74,3,74,9);
TextBackGround(0);
clrscr;
window(11,12,69,23);
TextBackGround(4);
clrscr;
TextColor(14);
GotoXY(2,4);
write(' Chuslo Kvadrat chusla ');
writeln(' ------------------------------------');
і:=1;
while і<=n do
begin
writeln(' ',і,' ',sqr(і));
і:=і+1;
end;
window(12,24,70,24);
TextBackGround(0);
clrscr;
window(70,13,70,23);
TextBackGround(0);
clrscr;
readln
End.

Задача 5. Необхідно визначити суму, добуток та середнє арифметичне послідовності цілих чисел, значення яких уводить користувач з клавіатури. Кількість чисел у послідовності невідома. Ознакою закінчення введення числових значень є введення 0.

Program kvadrat;
Uses crt;
Var
n,s,d,k:integer;
sr:real;
Begin
TextBackGround(7);
clrscr;
window(7,2,73,8);
TextBackGround(5);
clrscr;
TextColor(14);
GotoXY(20,2);
writeln('Vuznachennya symu, dobytky ');
writeln;
writeln(' ta serednjgo arufmetuchnogo ');
writeln;
writeln(' chuslovoj poslidovnosti ');
window(8,9,74,9);
TextBackGround(0);
clrscr;
window(74,3,74,8);
TextBackGround(0);
clrscr;
window(2,11,39,23);
TextBackGround(2);
clrscr;
TextColor(15);
GotoXY(2,2);
write('Yvedit znachennya ');
writeln('nastypnogo ');
writeln(' elementa poslidovnosti' );
writeln(' (0 - zakinchennya vvedennya) ');
s:=0;
d:=1;
k:=1;
write(' => ');
readln(n);
repeat
s:=s+n;
d:=d*n;
k:=k+1;
write(' => ');
readln(n);
until n=0;
sr:=s/k;
window(3,24,40,24);
TextBackGround(0);
clrscr;
window(40,12,40,23);
TextBackGround(0);
clrscr;
window(42,11,78,23);
TextBackGround(4);
clrscr;
TextColor(15);
GotoXY(2,4);
writeln(' Syma: ',s);
writeln;
writeln;
writeln(' Dobytok: ',d);
writeln;
writeln;
writeln(' Serednj arufmetuchne: ',sr:3:1);
window(43,24,79,24);
TextBackGround(0);
clrscr;
window(79,12,79,23);
TextBackGround(0);
clrscr;
readln
End.

Задача 6. Деяка область нашої країни поділена на n районів. Восени кожен район передає до області такі відомості:
• Площу (у гектарах), засіяну пшеницею;
• Середню урожайність пшениці (у центнерах з гектара).
Визначити загальний урожай пшениці (у центнерах), зібраний областю за рік, та середню урожайність по області.

Program yroghaj;
Uses crt;
Var
n,p,y,s,d,і:integer;
sr:real;
Begin
TextBackGround(7);
clrscr;
window(7,2,73,4);
TextBackGround(5);
clrscr;
TextColor(14);
GotoXY(20,2);
write('Kilkist rajoniv v oblasti ');
read(n);
window(8,5,74,5);
TextBackGround(0);
clrscr;
window(74,3,74,4);
TextBackGround(0);
clrscr;
window(2,7,39,23);
TextBackGround(2);
clrscr;
TextColor(15);
GotoXY(1,2);
s:=0;
d:=0;
for і:=1 to n do
begin
writeln(' ',і,' rajon');
write(' Plosha zasiyana pshenuzej => ');
readln(p);
write(' Serednya yroghajnist pshenuzi => ');
readln(y);
writeln;
s:=s+p;
d:=d+y*p;
end;
sr:=d/s;
window(3,24,40,24);
TextBackGround(0);
clrscr;
window(40,8,40,23);
TextBackGround(0);
clrscr;
window(42,7,78,23);
TextBackGround(4);
clrscr;
TextColor(15);
GotoXY(2,4);
writeln('Zagalna plosha oblasti, ');
writeln;
writeln(' zasiyana pshenuzej: ',s);
writeln;
writeln;
writeln(' Zagalnuj yroghaj pshenuzi : ',d);
writeln;
writeln;
writeln(' Serednj yroghajnist ' );
writeln;
writeln(' pshenuzi po oblasti: ',sr:3:2);
window(43,24,79,24);
TextBackGround(0);
clrscr;
window(79,8,79,23);
TextBackGround(0);
clrscr;
readln
End.

Задача 7. Визначити суму кубів натуральних чисел від n до m (n1 задає користувач).

Program sym_kvad;
Uses crt;
Var
і,x,s:integer;
Begin
clrscr;
Writeln('Yvedit chuslо x');
readln(x);
s:=0;
for і:=1 to x do
s:=s+sqr(і);
writeln('Syma kvadrativ = ',s);
readln;
End.

Задача 9. Визначити добуток цілих чисел від а до с (значення цілих чисел а та с задає користувач).

Program sym_kyb;
Uses crt;
Var
a,c,d:integer;
Begin
clrscr;
Writeln('Yvedit chusla a і c');
readln(a,c);
d:=1;
while a<=c do
begin
d:=d*a;
a:=a+1;
end;
writeln('Dobytok = ',d);
readln;
End.

Задача 10. Визначити суму квадратів усіх парних чисел від а до с (значення парних чисел а та с задає користувач, a10 задає користувач).

Program serednj;
Uses crt;
Var
y,k,s,і:integer;
sr:real;
Begin
clrscr;
Writeln('Yvedit chuslo y');
readln(y);
s:=0;
k:=0;
for і:=10 to y do
begin
s:=s+і;
k:=k+1;
end;
sr:=s/k;
writeln('Serednj arufmetuchne = ',sr:3:2);
readln;
End.

Задача 12. Визначити середнє арифметичне квадратів непарних чисел від а до с (значення непарних чисел а та с задає користувач, a0 then
begin
while a<=c do
begin
s:=s+sqr(a);
a:=a+2;
і:=і+1;
end;
end
else a:=a+1;
while a<=c do
begin
s:=s+sqr(a);
a:=a+2;
і:=і+1;
end;
sr:=s/І;
writeln('serednj arufmetuchne kvadrativ = ',sr:3:2);
readln;
End.

Задача 13. Необхідно визначити значення n-го елемента числової послідовності.

Program Z_13_1;
Uses crt;
Var
a,b,n,і:integer;
Begin
clrscr;
Writeln('n => ‘);
readln(n);
a:=3;
b:=1;
for і:=2 to n do
begin
a:=a+b;
b:=b+1;
end;
writeln('an = ',a);
readln;
End.

Program Z_13_2;
Uses crt;
Var
a,b,n,і:integer;
Begin
clrscr;
Write('n => ‘);
readln(n);
a:=3;
b:=1;
for і:=2 to n do
begin
a:=a+b;
b:=b+2;
end;
writeln('an = ',a);
readln;
End.

Program Z_13_3;
Uses crt;
Var
a,b,n,і:integer;
Begin
clrscr;
Write('n => ‘);
readln(n);
a:=15;
b:=1;
c:=-2;
for і:=1 to (n div 2)do
begin
a:=a+b;
a:=a+c;
b:=b+2;
c:=c-2;
end;
writeln('an = ',a);
readln;
End.

Program Z_13_4;
Uses crt;
Var
a,b,c,d,n,і:integer;
Begin
clrscr;
Write('n => ‘);
readln(n);
a:=21;
b:=3;
c:=2;
d:=1;
for і:=1 to (n div 3)do
begin
a:=a-b;
a:=a-c;
a:=a-d;
end;
writeln('an = ',a);
readln;
End.

Program Z_13_5;
Uses crt;
Var
a,n,і:integer;
Begin
clrscr;
Write('n => ‘);
readln(n);
a:=4;
for і:=1 to (n div 2)do
begin
a:=a*2;
a:=a+2;
end;
writeln('an = ',a);
readln;
End.

Задача 14. Визначити чи є у записі чотирицифрового натурального числа хоча б одна з цифр 1, 3, 8.

Program zuf_chusli_1;
Uses crt;
Var
a,n:integer;
f:Boolean;
Begin
clrscr;
Writeln('Yvedit chuslo n =>');
readln(n);
f:=false;
repeat
a:=n mod 10;
n:=n div 10;
writeln(a);
if (a=1)or(a=3)or(a=8) then f:=true;
until n=0;
if f then writeln('Chuslo maj chocha b odny z zufr')
else writeln('Chuslo ne maj zuch zufr');
readln;
End.

1. Визначити чи є у записі натурального числа цифра x.

Program zuf_chusli_2;
Uses crt;
Var
a,x,n:integer;
f:Boolean;
Begin
clrscr;
Writeln('Yvedit chuslo n =>');
readln(n);
Writeln('Yvedit zufry x =>');
readln(x);
f:=false;
repeat
a:=n mod 10;
n:=n div 10;
writeln(a);
if (a=x) then f:=true;
until n=0;
if f then writeln('Chuslo maj chocha b odny z zufr')
else writeln('Chuslo ne maj zuch zufr');
readln;
End.

2. Визначити скільки разів трапляється у числі його максимальна цифра.

Program zuf_chusli_3;
Uses crt;
Var
a,max,k,n,n1:integer;
Begin
clrscr;
Writeln('Yvedit chuslo n =>');
readln(n);
n1:=n;
a:=n mod b;
max:=a;
repeat
a:=n mod 10;
n:=n div 10;
if a > max then max:=a;
until n=0;
k:=0;
repeat
a:=n1 mod 10;
n1:=n1 div 10;
if a = max then k:=k+1;
until n1=0;
writeln('Maksumalna zufra y chusli - ', max);
writeln('Y chusli vona traplyaetsya ',k,' raz');
readln;
End.

3. Визначити чи є парною різниця максимальної та мінімальної цифр натурального числа.

Program zuf_chusli_4;
Uses crt;
Var
a,max,min,n,n1,r:integer;
Begin
clrscr;
Writeln('Yvedit chuslo n =>');
readln(n);
n1:=n;
a:=n mod 10;
max:=a;
repeat
a:=n mod 10;
n:=n div 10;
if a > max then max:=a;
until n=0;
a:=n1 mod 10;
min:=a;
repeat
a:=n1 mod 10;
n1:=n1 div 10;
if a < min then min:=a;
until n1=0;
r:=max-min;
if (r mod 2) =0 then
writeln('Riznuzya max ta min zufr chusla - parna І dorivnje =>', r)
else
writeln('Riznuzya max ta min zufr chusla - neparna І dorivnje =>', r);
readln;
End.

4. Визначити усі натуральні чотирицифрові числа, записані різними цифрами та різниця максимальної та мінімальної цифр яких є непарною. Визначити кількість таких цифр.

Program zuf_chusli_5;
Uses crt;
Var
a,b,c,d,max,min,k,r :integer;
Begin
k:=0;
For a:=1 to 9 do
For b:=0 to 9 do
If a<>b then
For c:=0 to 9 do
If (a<>c)and(b<>c) then
For d:=0 to 9 do
begin
If (a<>d)and(b<>d)and(c<>d) then
begin
if (a>b)and(a>c)and(a>d) then max:=a;
if (b>a)and(b>c)and(b>d) then max:=b;
if (c>a)and(c>b)and(c>d) then max:=c;
if (d>a)and(d>b)and(d>c) then max:=d;
if (a0 then
begin
WriteLn( a,b,c,d );
k:=k+1;
end;
end;
end;
WriteLn( 'k=',k );
End.

Задача 15. Необхідно визначити чи є введене натуральне число х числом Армстронга.

Program chuslo_Amstronga;
Uses crt;
Var
a,s,x,n:integer;
Begin
clrscr;
Write('Yvedit chuslo x =>');
readln(x);
s:=0;
n:=x;
repeat
a:=n mod 10;
n:=n div 10;
s:=s+a*sqr(a);
until n=0;
if s = x then writeln('Yvedene chuslo – chuslo Armstronga')
else writeln('No, yvedene chuslo – ne chuslo Armstronga');
readln;
End.

Задача 16. Необхідно визначити та вивести на екран усі трицифрові та чотирицифрові числа, які являються числами Армстронга.

Program chuslo_Amstronga;
Uses crt;
Var
a,s,n,І,k:integer;
Begin
clrscr;
k:=0;
for і:=100 to 9999 do
begin
s:=0;
n:=І;
repeat
a:=n mod 10;
n:=n div 10;
s:=s+a*sqr(a);
until n=0;
if s = і then
begin
writeln(і);
k:=k+1;
end;
end;
writeln('k=',k);
readln;
End.

Задача 17. Сума цифр чотирицифрового числа дорівнює 30, у запису числа використовано лише дві різні цифри, це число ділиться на 2, на 7 і на 11. Визначити це число.

Program nomer_avto;
Uses crt;
Var
a,s,n,і,k:integer;
Begin
clrscr;
for і:=1000 to 9999 do
begin
s:=0;
n:=і;
repeat
a:=n mod 10;
n:=n div 10;
s:=s+a;
until n=0;
if (s = 30)and ((І mod 2)=0) and ((І mod 7)=0) and ((І mod 11)=0) then
writeln(і);
end;
readln;
End.

Завдання для самостійної роботи
1. Вивести всі парні числа починаючи від числа N і до числа M. Числа N та M задає користувач.

2. Скласти програму, яка перевіряє, чи є послідовність із 10 цілих чисел, що вводяться з клавіатури, зростаючою.

3. Спортсмен в перший день пробіг 10 км. Кожен наступний день він збільшував норму на 10% від норми попереднього дня.
а) Визначити через скільки днів спортсмен пробіжить сумарний шлях понад 100 км.
б) Визначити через скільки днів спортсмен буде пробігати більше 20 км.
в) Який шлях пробіжить спортсмен на 7-й день.

4. Вводяться 14 чисел. Визначити, скільки серед них додатних (включаючи 0) і скільки від’ємних. (Числа вводяться в одну змінну в циклі).

5. Запросіть у користувача 16 чисел і виведіть на екран для кожного, чи ділиться воно без остачі на 11. Запросіть у користувача, скільки потрібно проаналізувати чисел, а потім запросіть ці числа і зробіть для кожного висновок, чи є воно парним або від’ємним.

6. Вивести всі квадрати натуральних чисел, не більших даного числа N.

7. Знайти суму і кількість елементів послідовності, які по модулю більше 0.001. послідовність:
S = 1 / 2 - 2 / 4 + 3 / 8 - 4 / 16 + ... - ...

8. Обчислити суму ряду чисел 1 / 12 + 1 / 22 + 1 / 32 + ... + 1/n2, де n визначається користувачем.

9. Складіть програму для визначення N!-M! N! = 1 * 2 * 3 * 4 *.........* n.

10. Запитати ім'я користувача та надрукувати "Привіт, Вася!" 10 разів. (якщо Вася - ім'я користувача).

11. Програма повинна обчислювати добуток двох чисел і питати завершувати програму чи ні, якщо ні то продовжувати запитувати дані обчислювати добуток і друкувати його.

12. Вивести на друк всі тризначні натуральні числа, сума цифр яких дорівнює заданому числу N. (Операції div і mod не використовувати.)

13. Знайдіть всі натуральні числа від 1 до 1000, кратні 3.

14. Скласти програму планування закупівлі товару в магазині на суму, що не перевищує задану величину.

15. Скласти програму запиту пароля поки не буде введений пароль вірно. У програмі передбачити лічильник неправильних введень пароля.

16. Добуток N перше непарних чисел дорівнює р. Скільки співмножників взято?

17. Знайдіть кількість точок з цілочисельними координатами, які потрапляють в коло радіуса R.

18. Скласти програму, яка роздруковує на екрані таблицю множення.

19. Знайдіть всі тризначні числа, які дорівнюють сумі кубів своїх цифр. Врахуйте, що abc = 100a +10 b + c.

20. Скласти програму виведення всіх тризначних чисел, сума цифр яких дорівнює даним цілого числа. Програма повинна друкувати саме числа, а не набір цифр.

21. Імітувати на екрані роботу електронних годинників.

22. Задано n трійок чисел a, b, c. Визначити, скільки із запропонованих трійок можна використовувати для побудови трикутника, якщо a, b, c - довжини його сторін.
(Відомо, що a ≤ b ≤ c)

23. Вкажіть всі цілі числа, які збільшаться на 20%, якщо їхні цифри записати у зворотньому порядку.

24. Скласти програму, в якій серед двозначних чисел друкуються ті числа, які дорівнюють сумі своїх цифр.

4. Процедури і функції
Підпрограма - це окрема функціонально незалежна частина програми. Будь-яка підпрограма має ту ж структурою, яку має і вся програма.

Підпрограми вирішують три важливі завдання:
• позбавляють від необхідності багаторазово повторювати в тексті програми аналогічні фрагменти;
• покращують структуру програми, полегшуючи її розуміння;
• підвищують стійкість до помилок у програмуванні і непередбачених наслідків при модифікаціях програми.
Підпрограми можуть бути стандартними, тобто визначеними системою, і власними, тобто визначеними програмістом.
Стандартна підпрограма (процедура або функція) - підпрограма, включена до бібліотеки програм ЕОМ, доступ до якої забезпечується засобами мови програмування. Викликається вона на ім'я із заданням фактичних параметрів з типом описаним при описі даної процедури в бібліотеці процедур і функцій.
Структура тексту підпрограми відповідає структурі тексту основної програми за двома винятками:
• підпрограма починається з заголовка, що містить ім'я підпрограми, що передаються до неї і які повертаються від неї пераметри, запис заголовка підпрограми відрізняється від заголовка програми;
• підпрограма закінчується не крапкою, а крапкою з комою.

Виклик підпрограми відбувається при кожному вживанні її імені в основній програмі. При виклику підпрограми виконання основної програми припиняється, і управління передається в підпрограму, де виконуються команди, задані в ній. Підпрограма завершується, якщо виконані всі її процедури до завершального слова End або за спеціальною команді виходу з підпрограми Exit. Після закінчення роботи підпрограми управління повертається основній програмі, інакше кажучи, до першої команди, наступної за зверненням до цієї підпрограми.
У мові Pascal визначаються два типи підпрограм - процедури та функції. Основна відмінність між процедурою і функцією полягає в тому, що процедура тільки виконує якусь закінчену послідовність дій, не повертаючи результату роботи в основну програму, а функція і виконує дії, і повертає результат.
Будь-яка підпрограма повинна бути описана до того, як вона буде викликана в програмі або в іншій підпрограмі. Всі змінні, які використовує підпрограма, можуть бути або глобальні або локальні.
Глобальними називаються змінні, оголошені в основній програмі і доступні як програмі, так і всім її підпрограмам.
Локальними називаються змінні, оголошені усередині підпрограми і доступні тільки їй самій.
Обмін інформацією між основною програмою і підпрограмою може здійснюватися тільки за допомогою глобальних змінних.
Якщо змінна описана в основній програмі і не перевизначена в підпрограмі, вона може використовуватися в підпрограмі. Пам'ять для локальних (тобто описаних в підпрограмі) змінних виділяється на час виконання даної підпрограми в спеціальній області, яка називається стеком. При завершенні роботи підпрограми пам'ять звільняється, тому всі внутрішні результати роботи підпрограми не зберігаються від одного звернення до іншого.
Процедури і функції оголошуються в розділі опису програми слідом за розділом змінних.
Загальна структура програми виглядає так:
Рrogram hh;
Label; {описание меток}
Const; {описание констант}
Type; {описание типов}
Var; {описание переменных}
Procedure; {описание процедур}
Function; {описание функций}
Begin
. . .
. . .
End.

Формальні параметри підпрограми вказують, з якими параметрами слід звертатися до цієї програми. Вони задаються в заголовку підпрограми у вигляді списку параметрів.
Усі формальні параметри можна розбити на чотири категорії:
• параметри значення (ці параметри в основній програмі підпрограмою не змінюються);
• параметри - змінні (ці параметри підпрограма може змінити в основній програмі);
• параметри-константи;
• параметри-процедури і параметри-функції.
Для кожного формального параметра слід вказати ім'я і тип, а в разі параметра-змінної або параметра-константи - його категорію.
Тип формального параметра може бути будь-яким, проте в заголовку підпрограми не можна вводити новий тип.
Наприклад, не можна писати

function Max (A: array [1 .. 100] of real): real;

Щоб правильно записати цей заголовок, слід в основній програмі ввести тип-масив, а потім використовувати його в заголовку підпрограми:

type tArr = array [1 .. 100] of real;
function Max (A: tArr): real;

При зверненні до підпрограми формальні параметри замінюють на відповідні фактичні, які викликає програма або підпрограма.
Список параметрів, що задається в заголовку процедури і функції, забезпечує зв'язок підпрограми із основною програмою. Через нього в підпрограму передаються вихідні дані і повертається результат. При цьому передбачено два принципово різні механізми передачі параметрів - за значенням і за посиланням. Синтаксично ці два способи відрізняються вживанням слова Var перед відповідною змінної в заголовку підпрограми. Якщо це слово є, то змінна передається по посиланню, а якщо ні - за значенням.
При виклику за значенням у підпрограмі створюються змінні відповідно з оголошеними в заголовку підпрограми. Ці змінні існують тільки на час виконання підпрограми. У зосновній програмі в якості аргументу підпрограми може використовуватися не тільки змінна, а й вираз. На початку виконання підпрограми значення цієї змінної або виразу присвоюються внутрішній тимчасовій змінні підпрограми. Коли підпрограма завершується, використовувані підпрограмою змінні не зберігають свого значення, тому передачу даних за значенням можна використовувати тільки для передачі даних в підпрограму, але не для отримання від неї результатів.
При виклику за посиланням у підпрограмі пам'ять під змінні не відводиться. Основна програма передає в підпрограму не значення змінної, а посилання на місце в пам'яті основної програми, де розташована деяка змінна. Підпрограма, виконуючи деякі дії з цієї змінної виконує дії зі змінною основної програми, тому після виконання процедури зміни, вчинені зі змінними основної програми, зберігаються. Цей механізм використовується для отримання від підпрограми результатів її виконання.
Параметр-значення вказуються в заголовку підпрограми своїм ім'ям і через двокрапку - типом. Тип параметра-значення може бути будь-яким за винятком файлового.
Якщо параметрів - значення одного типу декілька, їх можна об'єднати в одну групу, перерахувавши їх імена через кому, а потім вже вказати загальний тип. Окремі групи параметрів відокремлюються один від одного крапкою з комою
В якості фактичного параметра на місці параметра-значення при виклику підпрограми може бути будь-який вираз сумісний для даного типу, що не містить файлову компоненту.
Локальні змінні можуть бути описані як в заголовку програми, так і в розділі опису змінних. При збігу імен глобальних і локальних змінних, локальні в межах своєї дії відміняють дії глобальних, і ці змінні ніяк не пов'язані між собою.
Процедура повинна бути, по можливості, незалежна від основної програми, тому всі змінні, потрібні тільки в межах процедури, повинні описуватися як локальні.
Структура процедури має наступний вигляд:
Procedure <ім’я процедури>(формальні параметри : їх тип);
Var (локальні змінні)
Begin
. . .
end;

Кожен формальний параметр вказується разом зі своїм типом. Відповідний йому фактичний параметр вказується без типу. Між формальними і фактичними параметрами повинна бути відповідність по кількості параметрів, за їх типу і порядку слідування.
Підпрограма-функція - оформляється аналогічно процедурі. Відмінні особливості функції:
вона має тільки один результат виконання;
результат позначається іменем функції і передається в основну програму.

Функція оформляється в наступному вигляді:

Function <ім’я функції>(формальні параметри: тип): тип значення функції;
Var
. . .
Begin
. . .
End ;

Викликається функція по її імені із зазначенням фактичних параметрів.
Виклик функції можна робити безпосередньо всередині виразу. При виклику функції тип не вказується.
У тілі функції обов'язково повинен бути хоча б один оператор присвоювання, де в лівій частині стоїть ім'я функції, а в правій - її значення. Інакше, значення не буде визначено.
Якщо ім'я процедури використовується тільки для її виклику, то з ім'ям функції зв'язується її значення.

Практична робота №5

Program Trukytnuk;
Uses CRT;
Var
pt,s,t,d:integer;
S_max,S_tr:real;
n_Var,і:integer;

Function ploscha(x,y,z:integer):real;
Var
p,S:real;
begin
if(x+y>z)and(y+z>x)and(x+z>y) then
begin
p:=(x+y+z)/2;
S:=sqrt(p*(p-x)*(p-y)*(p-z));
end
else S:=0;
ploscha:=s;
end;

Procedure max;
begin
if S_tr>S_max then
begin
S_max:=S_tr;
n_Var:=і;
end;
end;

Begin
clrscr;
write('pt=');
readln(pt);
write('s=');
readln(s);
write('t=');
readln(t);
write('d=');
readln(d);
s_max:=0;
і:=1;
S_tr:=ploscha(pt,s,t);
max;
і:=2;
S_tr:=ploscha(pt,s,d);
max;
і:=3;
S_tr:=ploscha(pt,t,d);
max;
і:=4;
S_tr:=ploscha(s,t,d);
max;
Writeln('Max_S_tr=',S_max:4:2);
writeln('Variant nomer ',n_Var);
readln;
End.

Задача 1. Знайти площу п’ятикутника, у якого сторони дорівнють:
AB = 2м, BC =a м, CD = b м, DE = c м, AE = d м, AC =4 м, AD = 5 м.

Program Pyatukytnuk;
Uses Crt;
Label vvod;
Var
a,b,c,d,f,g,h: integer;
S,S1,S2,S3 : real;

Function ploscha(x,y,z:integer):real;
Var
p,S:real;
begin
If (x+y>z) and (x+z>y) and (y+z>x) Then
begin
P:=(x+y+z)/2;
S:=sqrt(p*(p-x)*(p-y)*(p-z));
end
Else
begin
Writeln(‘Такий трикутник не існує’);
S:=0
end;
ploscha:=S
End;

Begin;
ClrScr;
vvod: Write (‘Введіть сторону=BC> ‘);
ReadLn(a);
Write (‘Введіть сторону=CD> ‘);
ReadLn(b);
Write (‘Введіть сторону=DE> ‘);
ReadLn(c);
Write (‘Введіть сторону=AE> ‘);
ReadLn(d);
f:=2;
g:=4;
h:=5;
S1:=ploscha(f,a,g);
S2:=ploscha(g,b,h);
S3:=ploscha(h,c,d);
if (S1<>0) and (S2<>0) and (S3<>0) then
begin
S:=S1+S2+S3;
Writeln(‘S=’,s:5:2)
end
else
begin
Writeln(‘Пятикутника не існує’);
Writeln(‘уведіть іншу величину сторін)’;
Goto vvod;
end;
ReadLn;
End.

Задача 2. Знайти площу та довжину лінії «вісімки», утвореної двома дотичними колами радіусів R1 і R2.

Program Visimka;
Uses Crt;
Var
R1,R2: integer;
S,S1,S2,L,L1,L2: real;

Procedure ploscha(r:integer; Var s,l:real);
begin
S:=pi*sqr®;
L:=2*pi*r;
end;

Begin;
ClrScr;
Write (‘Введіть радіус R1=> ‘);
ReadLn(R1);
Write (‘Введіть радіус R2>= ‘);
ReadLn(R2);
ploscha(R1,S1,L1);
ploscha(R2,S2,L2);
S:=S1+S2;
L:=L1+L2;
Writeln(‘S=’,s:4:2);
Writeln(‘L=’,l:4:2);
ReadLn;
End.

Задача 3. Написати процедури, що перевіряють ознаки подільності цілого числа n на 2, 3, 4, 5, 8, 9, 11. Використовуючи ці процедури розробити програму, що перевіряє, на які з цих чисел ділиться число n.

Program Dilumist;
Uses Crt;
Var
n:longint;

Procedure dil_2(n:longint);
begin
If (n mod 2)=0 then
Writeln(n,’ ділиться на 2’)
end;

Procedure dil_3(n:longint);
Var
a,b,c,d,e,f,g,h,k,s:integer;
begin
a:=n div 100000000;
b:=(n mod 100000000) div 10000000;
c:=(n mod 10000000) div 1000000;
d:=(n mod 1000000) div 100000;
e:=(n mod 100000) div 10000;
f:=(n mod 10000) div 1000;
g:=(n mod 1000) div 100;
h:=(n mod 100) div 10;
k:= n mod 10;
s:=a+b+c+d+e+f+g+h+k;
if (s mod 3)=0 then Writeln(n,’ ділиться на 3’);
end;

Procedure dil_4(n:longint);
Var
a:longint;
begin
a:=n mod 100;
If (a mod 4)=0 then
Writeln(n,’ ділиться на 4’)
end;

Procedure dil_5(n:longint);
Var
a:longint;
begin
a:=n mod 10;
If (a = 0)or (a = 5) then
Writeln(n,’ ділиться на 5’)
end;

Procedure dil_8(n:longint);
Var
a:longint;
begin
a:= n mod 1000
If (a mod 8)=0 then
Writeln(n,’ ділиться на 8’)
end;

Procedure dil_9(n:longint);
Var
a,b,c,d,e,f,g,h,k,;s:integer;
begin
a:=n div 100000000;
b:=(n mod 100000000) div 10000000;
c:=(n mod 10000000) div 1000000;
d:=(n mod 1000000) div 100000;
e:=(n mod 100000) div 10000;
f:=(n mod 10000) div 1000;
g:=(n mod 1000) div 100;
h:=(n mod 100) div 10;
k:= n mod 10;
s:=a+b+c+d+e+f+g+h+k;
if (s mod 9)=0 then Writeln(n,’ ділиться на 9’)
end;

Procedure dil_11(n:longint);
Var
a,b,c,d,e,s1,s2,r:integer;
begin
a:=n div 100000000;
b:=(n mod 100000000) div 10000000;
c:=(n mod 10000000) div 1000000;
d:=(n mod 1000000) div 100000;
e:=(n mod 100000) div 10000;
f:=(n mod 10000) div 1000;
g:=(n mod 1000) div 100;
h:=(n mod 100) div 10;
k:= n mod 10;
s1:=a+c+e+g+k;
s2:=b+d+f+h;
r:=s2-s1;
If (r mod 11)=0 then Writeln(n,’ ділиться на 11’)
end;

Begin;
ClrScr;
Write (‘Введіть радіус n=> ‘);
ReadLn(n);
dil_2(n);
dil_3(n);
dil_4(n);
dil_5(n);
dil_8(n);
dil_9(n);
dil_11(n);
ReadLn;
End.

Задача 4. Знайти всі прості числа з проміжку від 1 до n.
Program prosti_chusla;
Uses Crt;
Var
x,n,І,j : integer;
F: Boolean;

Procedure proste(x,і,j:integer;Var f:boolean);
begin
while(і<=x) and (not f) do
begin
if (j mod і)=0 then f:=true;
і:=і+1
end;
end;

Begin
ClrScr;
Write (‘Введіть n=>‘);
ReadLn(n);
For j:=2 to n do
Begin
x:=trunc(sqrt(j));
f:=false;
і:=2;
proste(x,І,j,f);
if not f then writeln(j)
end;
ReadLn;
End.

Задача 5. З’ясувати, чи трицифрові числа є паліндромами.
Program chuslo;
Uses Crt;
Var
x, y, а1,b1,c1,a2,b2,c2 : integer;

Procedure zufru_chucla(n:integer;Var a,b,c: integer);
begin
a:=n div 100;
b:=(n mod 100) div 10;
c:=(n mod 10);
end;

Begin
ClrScr;
Write (‘Введіть перше число=>‘);
ReadLn(x);
Write (‘Введіть друге число=>‘);
ReadLn(y);
zufru_chucla(x,a1,b1,c1);
zufru_chucla(y,a2,b2,c2);
if (a1=c2) and (b1=b2) and (c1=a2) then Writeln (‘yes – Числа є палідромами’ )
Else Writeln (‘No – Числа не є палідромами’);
ReadLn;
End.

Задача 6. Визначте значення z=(sign(x)+sign(y)*sign(x+y), де
-1, якщо a<0;
Sign(a)= o, якщо a=0;
1, якщо a>0.

Program signum;
Uses crt;
Var
x,y,k:real;
a,b,c,z:integer;

Procedure sign(a:real;Var z: integer);
begin
If a<0 then z:=-1;
If a=0 then z:=0;
If a>0 then z:=1
end;

Begin
clrscr;
write('x=>');
readln(x);
write('y=>');
readln(y);
sign(x,a);
sign(y,b);
k:=x+y;
sign(k,c);
z:=(a+b)*c;
writeln('z=',z);
readln;
End.

Задача 7. За допомогою функції, що визначає, яке з двох чисел більше, визначити яке з чотирьох чисел більше.

Program max_4chucla;
Uses crt;
Var
a,b,c,d,max:real;

Function maximym(a,b,max:real):real;
begin
Max:=a;
If max');
readln(a);
write('b=>');
readln(b);
write('c=>');
readln(c);
write('d=>');
readln(d);
max:=maximym(maximym(maximym(a,b,max),c,max),d,max);
writeln('max=',max:4:2);
readln;
End.

Задача 8. Двоцифрове число у сумі з числом, записаним тими самими цифрами, але в оберненому порядку, дорівнює квадрату натурального числа. Програма повинна визначати всі такі двоцифрові числа.

Program polindrom;
Uses crt;
Var
s,n1,і:integer;
N,a:real;

Procedure polindrom(n:integer; Var n1:integer);
Var
a,b:integer;
begin
a:=n div 10;
b:=n mod 10;
n1:=b*10+a;
end;

Begin
Clrscr;
For і:=11 to 99 do
begin
Polindrom(і,n1);
S:=і+n1;
N:=sqrt(s);
A:=frac(n);
If a=0 then
writeln(і);
end;
readln;
End.

Задача 9. Знайти всі досконалі числа в заданому проміжку.

Program doskonali;
Uses crt;
Var
n,n1,і:integer;

Procedure dos(n,n1:integer);
Var
і,j,s:integer;
begin
for і:=n to n1 do
begin
s:=0;
for j:=1 to і-1 do
begin
if (і mod j)=0 then s:=s+j;
end;
if s=j then writeln(і);
end;
end;

Begin
clrscr;
write('n=>');
readln(n);
write('n1=>');
readln(n1);
dos(n,n1,і);
readln;
End.

Задача 10. Дано парне число n>2. Представити його у вигляді суми двох простих чисел, використовуючи процедуру, що перевіряє, чи є деяке натуральне число простим.

Program gip_Goldbacha;
Uses crt;
label 1;
Var
x,n,n1,n2,і : integer;
F: Boolean;

Procedure proste(x,і,n:integer;Var f:boolean);
begin
while(і<=x) and (not f) do
begin
if (n mod і)=0 then f:=true;
і:=і+1
end;
end;

Begin
ClrScr;
Write (‘Введіть n=>‘);
ReadLn(n);
1: Write (‘Введіть n1‘);
ReadLn(n1);
x:=trunc(sqrt(n1));
f:=false;
і:=2;
proste(x,І,n1,f);
if f then goto 1;
n2:=n-n1;
x:=trunc(sqrt(n2));
f:=false;
i:=2;
proste(x,І,n2,f);
if not f then writeln(‘Gipoteza Goldbacha virna’);
ReadLn;
End.

Задача 11. Визначити найбільший спільний дільник n натуральних чисел.

Program nsd;
Uses CRT;
Var
a,b,c,d,e,f,sd:integer;

Function dil(a,b:integer):integer;;
begin
while a <> b do
begin
if a>b then a:=a-b
else b:=b-a
end;
dil:=a;
end;

Begin
clrscr;
write('a=>');
readln(a);
write('b=>');
readln(b);
write('c=>');
readln(c);
write('d=>');
readln(d);
write('e=>');
readln(e);
write('f=>');
readln(f);
sd:=dil(dil(dil(dil(dil(a,b),c),d),e),f);
writeln('nsd =>',sd)
readln;
End.

Задача 12. Визначте суму та добуток двох дробів a/b та c/d , чисельник та знаменник яких є натуральними числами. Результат подати у вигляді нескоротного дробу.

Program Sum_Dob;
Uses CRT;
Var
a1,b1,a2,b2,ch_sum, zn_sum, ch_dob, zn_dob:integer;

Procedure vvod;
begin
write('a1=>');
readln(a1);
write('b1=>');
readln(b1);
write('a2=>');
readln(a2);
write('b2=>');
readln(b2);
end;

Procedure Sum;
begin
ch_sum:=a1*b2+a2*b1;
zn_sum:=b1*b2;
end;

Procedure Dob;
begin
ch_dob:=a1*a2;
zn_dob:=b1*b2;
end;

Function nsd(a,b:integer):integer;
begin
while abs(a) <> abs(b) do
begin
if abs(a)>abs(b) then abs(a):=abs(a)-abs(b)
else abs(b):=abs(b)-abs(a)
end;
nsd:=a;
end;

Procedure Skor(Var a,b:integer);
Var
z:integer;
begin
z:=nsd(a,b);
a:=a div z;
b:=b div z;
end;

Procedure vuvod(Var a,b:integer);
begin
writeln('ch=>',a);
writeln('zn=>',b);
end;

Begin
clrscr;
vvod;
sum;
if ch_sum<>0 then
skor(ch_sum,zn_sum);
vuvod(ch_sum,zn_sum);
dob;
skor(ch_sum,zn_sum);
vuvod(ch_sum,zn_sum);
readln;
End.

Задача 13. Дано натуральне число n . Визначити, чи є серед чисел n, n+1, …,2n числа-близнюки, тобто прості числа, різниця між якими дорівнює 2.

Program chusla_bluznuku;
Uses Crt;
Var
x,n,n1,n2,n3,n4,і,j : integer;
F: Boolean;

Procedure proste(x,і,j:integer;Var f:boolean);
begin
while(і<=x) and (not f) do
begin
if (j mod і)=0 then f:=true;
і:=і+1
end;
end;

Begin
ClrScr;
Write (‘Введіть n=>‘);
ReadLn(n);
N1:=2*n;
j:=n;
while j<=n1 do
begin
x:=trunc(sqrt(j));
f:=false;
і:=2;
proste(x,і,j,f);
if not f then
begin
n2:=j;
j:=j+2;
if j<=n1 then
begin
x:=trunc(sqrt(j));
f:=false;
і:=2;
proste(x,І,j,f);
if not f then
begin
n3:=j;
writeln(‘Chucla-blusnuku: ‘,n2,’ ‘,n3);
end;
end;
end;
j:=j+1;
end;
ReadLn;
End.

Задача 14. Визначити та вивести на екран усі прості числа в проміжку від 1000 до 9999, в яких сума першої та другої цифри дорівнює сумі третьої та четвертої.

Program prosti_chusla;
Uses Crt;
Var
x,n,n1,І,j,a,b,c,d : integer;
F: Boolean;

Procedure proste(x,і,j:integer;Var f:boolean);
begin
while(і<=x) and (not f) do
begin
if (j mod і)=0 then f:=true;
і:=і+1
end;
end;

Begin
ClrScr;
Write (‘Введіть n=>‘);
ReadLn(n);
Write (‘Введіть n1=>‘);
ReadLn(n1);
For j:=n to n1 do
begin
x:=trunc(sqrt(j));
f:=false;
і:=2;
proste(x,І,j,f);
if not f then
begin
a:=j div 1000;
b:=(j mod 1000) div 100;
c:=(j mod 100) div 10;
d:=j mod 10;
if (a+b)=(c+d) then writeln(j)
end;
end;
ReadLn;
End.

Задача 15. Координати клітин на шаховій дошці визначає пара натуральних чисел, кожне з яких не більше 8; перше число – номер вертикалі, друге номер горизонталі. Розробити процедури або функції, які б визначали:
1) Чи є клітини шахового поля з координатами (х,у) та (а,с) полями одного кольору?
2) Н клітинці (х,у) перебуває ферзь. Чи загрожує він фігурі, яка перебуває на клітинці з координатами (а,с)?
3) На клітинці шахового поля з координатами (х,у) розташований кінь. Чи загрожує він фігурі, яка перебуває на клітинці з координатами (а,с)?
4) Чи можна з клітинки шагового поля з координатами (х,у) одним ходом потрапити на клітинку (а,с)? Розгляньте варіанти, коли хід робить: тура, ферзь, кінь. Виведіть повідомлення про те, до якої клітинки потрапляє фігура за один хід. Якщо за один хід такий перехід неможливий, то чи можна досягти цього за два ходи кожної фігури?

Program shaxmatu;
Uses CRT;
Var
x,y,a,c: integer;
f1,f2,f3,f4,f5: Boolean;

Procedure Colir;
begin
If (((x mod 2 =0)and(y mod 2=0)or(x mod 2 <>0)and(y mod 2<>0))and
((a mod 2 =0)and(c mod 2=0)or(a mod 2 <>0)and(c mod 2<>0)))or
(((x mod 2 =0)and(y mod 2<>0)or(x mod 2 <>0)and(y mod 2=0))and
((a mod 2 =0)and(c mod 2<>0)or(a mod 2 <>0)and(c mod 2=0))) Then
Writeln('(',x,',',y,') і (',a,',',c,') - zi polya odnogo kolory')
Else
Writeln('(',x,',',y,') і (',a,',',c,') - zi polya riznogo kolory')
end;

Procedure ferz;
begin
If (a=x)or(c=y)or((a=x+1)and(c=y-1))or((a=x+2)and(c=y-2))or
((a=x+3)and(c=y-3))or((a=x+4)and(c=y-4))or((a=x+5)and
(c=y-5))or((a=x+6)and(c=y-6))or((a=x+7)and(c=y-7))or
((a=x-1)and(c=y+1))or((a=x-2)and(c=y+2))or((a=x-3)and(c=y+3))or
((a=x-4)and(c=y+4))or((a=x-5)and(c=y+5))or((a=x-6)and(c=y+6))or
((a=x-7)and(c=y+7))or((a=x-1)and(c=y-1))or((a=x-2)and(c=y-2))or
((a=x-3)and(c=y-3))or((a=x-4)and(c=y-4))or((a=x-5)and(c=y-5))or
((a=x-6)and(c=y-6))or((a=x-7)and(c=y-7))or((a=x+1)and(c=y+1))or
((a=x+2)and(c=y+2))or((a=x+3)and(c=y+3))or((a=x+4)and(c=y+4))or
((a=x+5)and(c=y+5))or((a=x+6)and(c=y+6))or((a=x+7)and(c=y+7)) Then
begin
Writeln('Ferz na klitunzi (',x,',',y,') zagroghye figyri na
klitunzi (',a,',',c,')');
f3:=true;
end
else
begin
Writeln('Ferz na klitunzi (',x,',',y,') ne zagroghye figyri na
klitunzi (',a,',',c,')');
f3:=false
end;
end;

Procedure tyra;
begin
f2:=false;
If (a=x)or(c=y) Then
begin
Writeln('Tyra na klitunzi (',x,',',y,') zagroghye figyri na
klitunzi (',a,',',c,')');
f2:=true;
end
else
begin
Writeln('Tyra na klitunzi (',x,',',y,') ne zagroghye figyri na
klitunzi (',a,',',c,')');
f2:=false
end;
end;

Procedure kin;
begin
f1 := false;
If ((a=x+2)and(c=y-1))or((a=x-2)and(c=y-1))or
((a=x-1)and(c=y-2))or((a=x+1)and(c=y-2))or
((a=x+2)and(c=y+1))or((a=x-2)and(c=y+1))or
((a=x+1)and(c=y+2))or((a=x-1)and(c=y+2)) Then
begin
Writeln('Kin na klitunzi (',x,',',y,') zagroghye figyri na
klitunzi (',a,',',c,')');
f1:=true;
end
else
begin
Writeln('Kin na klitunzi (',x,',',y,') ne zagroghye figyri na
klitunzi (',a,',',c,')');
f1:=false;
end;
end;

Begin
ClrScr;
Write ('vvedit x=>');
ReadLn(x);
Write ('vvedit y=>');
ReadLn(y);
Write ('vvedit a=>');
ReadLn(a);
Write ('vvedit c=>');
ReadLn(c);
Colir;
Ferz;
Kin;
Tyra;
if f1=true then
writeln('Iz klitunu (',x,',',y,') na klituny (',a,',',c,') moghe
potraputu za odun xid kin')
else
writeln('Iz klitunu (',x,',',y,') na klituny (',a,',',c,') ne moghe
potraputu za odun xid kin');
if f2=true then
writeln('Iz klitunu (',x,',',y,') na klituny (',a,',',c,') moghe
potraputu za odun xid tyra')
else
writeln('Iz klitunu (',x,',',y,') na klituny (',a,',',c,') tyra
potraput za dva xoda');
if f3=true then
writeln('Iz klitunu (',x,',',y,') na klituny (',a,',',c,') moghe
potraputu za odun xid ferz')
else writeln('Iz klitunu (',x,',',y,') na klituny (',a,',',c,') ferz
potraput za dva xoda');
ReadLn;
End.

Задача 16. Визначити суму цифр довільного натурального числа, тоді суму цифр отриманого числа і так продовжувати, поки не одержимо одноцифрове число. Отримане таким чином число називається числовим коренем.

Program chuslovu_korin;
Uses CRT;
Var
a,b,r:integer;

Procedure suma(n:integer; Var s:integer);
Var
k,l,і,n1,n2:integer;
begin
k:=1;
n1:=n;
l:=0;
While n>10 do
begin
N:=n div 10;
K:=k*10;
l:=l+1;
end;
s:=0;
For і:=1 to l+1 do
begin
n2:=n1 div k;
n1:=n1 mod k;
s:=S+n2;
k:=k div 10;
end;
end;

Begin
clrscr;
write('n=>');
readln(n);
suma(n,s);
Repeat
writeln('s=>',s);
suma(s,s1);
until s1<10;
writeln('s1=>',s1);
readln;
End.

Завдання для самостійної роботи
1. Знайти числа з проміжку від А до В, у яких найбільше дільників.

2. Знайти суму всіх дільників числа.

3. Знайти суму площ трикутників ABC і МНР, заданих координатами вершин.
Дані для вводу: А (0; 1), В (3; 1), С (4, 2), М (6, 7), Н (4, 3), Р (3; 8).

4. Знайти суму периметрів трикутників ABC і МНР, заданих координатами вершин. Дані для вводу: А (0; 1), В (3; 1), С (4, 2), М (6, 7), Н (4, 3), Р (3; 8).

5. Обчислити 1! +2! +3 !+......+ N! . Обчислення факторіала організувати як функцію fact (Var r: integer): longint.

6. Визначити довжину кола С і площа круга S, відстань L центру кола від початку координат О. Координати центру кола рівні X і Y, радіус R. Обчислення С, S, L оформити у вигляді процедури.

7. Складіть функцію для визначення значень n!, m!, (nm)!

8. Напишіть функцію CUBЕ, яка повертає куб її числового параметра.

9. З клавіатури вводяться числа, до тих пір, поки не буде введено перше від’ємне число. Визначте, скільки чисел із вхідного потоку, дорівнює сумі кубів своїх цифр. При вирішенні задачі використовуйте функцію, яка буде перевіряти, чи дорівнює натуральне число сумі кубів своїх цифр.

10. Напишіть функцію логічного типу, яка перевіряє, чи є всі цифри, що входять в натуральну запис, числа N різними.

11. Складіть програму підрахунку кількості всіх натуральних чисел, менших М і які діляться на кожну зі своїх цифр.

12. Складіть програму знаходження найменшого натурального N-значного числа Х (X> = 10), рівного потроєному добутку своїх цифр.

13. Дано натуральне число. Визначте, скільки парних цифр використовується в запису цього числа.

14. Складіть програму підрахунку кількості всіх натуральних чисел, менших М, квадрат суми цифр яких дорівнює Х.

15. Від користувачу необхідно ввести два числа. Ці значення повинні бути присвоєні двом змінним, причому значення першої повинно бути менше другої. Звичайно, можна попередити про це користувача, але можливо йому зручніше буде і не знати про вимоги програми. У коді програми можна реалізувати процедуру, яка виробляє обмін значень двох змінних, і викликати її після кожного чергового введення користувача.

16. Розташувати в порядку неспадання три цілих числа.

17. Визначте члени послідовність Фібоначчі.

18. Записати власну функцію обчислення модуля числа n modul(n) ф використати її для обчислення середнього арифметичного модулів трьох довільних чисел.

19. Написати процедуру, яка під час натискання клавіші пробіл видає інформацію про розробника програми.

20. Дано дійсні числа a,b,c,d. Визначити значення:

де

21. Дано дві пари дійсних чисел (x1:y1) та (x2;y2), які є координатами відповідно лівого верхнього і правого нижнього кутів прямокутника, сторони якого паралельні осям координат. Створити програму, що визначатиме довжини сторін цього прямокутника.

22. Створити підпрограму, яка б за заданою стороною квадрата а визначала периметр квадрата і його діагональ. У програмі організувати виклик цієї підпрограми.

23. Створити підпрограму, яка б за даними дійсними координатами двох точок (x1:y1) та (x2;y2) визначаладовжину відповідного відрізка та довжину його проекції на вісь Ox. У програмі організувати виклик цієї підпрограми.

24. Створити підпрограму, що одночасно обчислює найменше і найбільше значення серед двох дійсних чисел, та використати її для визначення, у скільки разів найменше значення з трьох заданих дійсних чисел перевищує найменше з них.

5. Одновимірні масиви
Масив - однорідна сукупність елементів.
Найпоширенішою структурою, реалізованої практично у всіх мовах програмування, є масив.
Масиви складаються з обмеженого числа компонентів, причому всі компоненти масиву мають один і той же тип, званий базовим. Структура масиву завжди однорідна. Масив може складатися з елементів типу integer, real або char, або інших однотипних елементів.
Інша особливість масиву полягає в тому, що програма може відразу отримати потрібний їй елемент за його порядковим номером (індексом).
Індекс масиву
Номер елемента масиву називається індексом. Індекс - це значення порядкового типу, визначеного, як тип індексу даного масиву. Дуже часто це цілочисельний тип (integer, word або byte), але може бути і логічний і символьний.
Опис масиву в Паскалі.
У мові Паскаль тип масиву задається з використанням спеціального слова array, і його оголошення в програмі виглядає наступним чином:

Type <ім'я _ типу> = array [І] of T;

де І - тип індексу масиву, T - тип його елементів.
Можна описувати відразу змінні типу масив, тобто в розділі опису змінних:

Var a, b: array [І] of T;

Зазвичай тип індексу характеризується деяким діапазоном значень будь-якого порядкового типу.
Наприклад, оголошення двох типів: vector у вигляді масиву з 10 цілих чисел і stroka у вигляді масиву з 256 символів:

Type
Vector=array [1..10] of integer;
Stroka=array [0..255] of char;

За допомогою індексу масиву можна звертатися до окремих елементів будь-якого масиву, як до звичайної змінної: можна отримувати значення цього елементу, окремо присвоювати йому значення, використовувати його в виразах.
Опишемо змінні типу vector і stroka:

Var a: vector;
c: stroka;

далі в програмі ми можемо звертатися до окремих елементів масиву a або c.
Наприклад, a [5]: = 23; c [1]: = 'w'; a [7]: = a [5] * 2; writeln (c [1], c [3]).

Одновимірні масиви, в яких кожен елемент має один індекс, що характеризує його місце в масиві.
Введення, обробка і виведення масиву здійснюються поелементно, з використанням циклу for.
Самий простий спосіб введення масиву - введення його з клавіатури. Розмірність масиву визначена константою, елементи вводяться по одному в циклі for.
При такому способі введення користувачеві доведеться ввести всі числових значень. При вирішенні навчальних завдань вводити масиви "вручну", особливо якщо їх розмірність велика, не завжди зручно. Існують, як мінімум, два альтернативних рішення:
• за допомогою констант;
• за допомогою генератора випадкових чисел.
Описувати масив у вигляді констант зручно, якщо елементи масиву не повинні змінюватися в процесі виконання програми. Як і інші константи, масиви констант описуються в розділі const.
Наприклад:
const a:array [1..5] of real=(
3.5, 2, -5, 4, 11.7
);
Формування масиву з випадкових значень доречно, якщо при вирішенні задачі масив служить лише для ілюстрації того чи іншого алгоритму, а конкретні значення елементів несуттєві.
Для того щоб отримати чергове випадкове значення, використовується стандартна функція random (N), де параметром N передається значення порядкового типу. Вона поверне випадкове число того ж типу, що тип аргументу і лежить в діапазоні від 0 до N-1 включно.Для того щоб при кожному запуску програми ланцюжок випадкових чисел був новим, перед першим викликом random слід викликати стандартну процедуру randomize, яка запускає генератор випадкових чисел.
Виведення масиву в Паскалі здійснюється також поелементно, в циклі, де параметром виступає індекс масиву, приймаючи послідовно всі значення від першого до останнього.

Задача 1. Відомі дані про щорічну кількість опадів, що випала за останні двадцять років спостережень. Необхідно:
1. Описати масив, за допомогою якого можна зберегти та обробити зібрані дані;
2. Увести в цей масив значення кількості опадів за кожний рік спостережень;
3. Визначити середню кількість опадів, що випала за роки спостережень;
4. Визначити відхилення від середньої кількості опадів для кожного року спостережень;
5. Визначити максимальну та мінімальну кількість опадів за рік (із зазначенням року, коли це було);
6. Розробити зручний інтерфейс користувача програми та вивести на екран отримані результати оброблення масиву опадів.

Program opadu;
Uses CRT;
Var
op:array[1..20] of real;
vid_op:array[1..20] of real;
s_op, sr_op,max_op,min_op:real;
nmax,nmin,і:integer;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘op[‘,І,’]=>’);
Readln(op[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Writeln(op[І]:6:2);
end;

Procedure seredne;
Var
і:integer;
begin
s_op:=0;
For і:=1 to 20 do
s_op:=s_op+op[і];
sr_op:=s_op/20;
Writeln(‘Serednya kilkist opadiv: ‘,sr_op:4:2);
end;

Procedure vidxulennya;
Var
і:integer;
begin
For і:=1 to 20 do
begin
vid_op[і]:=OP[і]-Sr_op;
Writeln(Vid_op[І]:6:2);
end
end;

Procedure vuvod1;
Var
і:integer;
begin
For і:=1 to 20 do
Writeln(Vid_op[І]:6:2);
End;

Procedure Max;
Var
і:integer;
begin
i:=1;
Max_op:=op[1];
Nmax:=1;
While і<20 do
begin
i:=і+1;;
If op[і]>max_op then
begin
Max_op:=op[і];
Nmax:=і
end;
end;
Writeln(‘V ‘,nmax,’ vupala cama bilsha kilkict opadiv: ‘,max_op:4:2);
end;

Procedure Min;
Var
і:integer;
begin
i:=1;
Min_op:=op[1];
Nmin:=1;
While і<20 do
begin
i:=і+1;;
If op[і]');
Readln(sp[і]);
end
end;

Procedure vuvod(Var sp:array of real);
Var
і:integer;
begin
For і:=1 to 6 do
Writeln(sp[І]:6:2);
end;

Procedure seredne(Var sp:array of real);
Var
і:integer;
begin
S_oz:=0;
For і:=1 to 4 do
S_oz:=S_oz+sp[і];
Sr_oz:=s_oz/4;
Writeln('Rezyltat vustypy: ',sr_oz:4:3);
end;

Procedure vuvod1(Var sp:array of real);
Var
і:integer;
begin
For і:=1 to 4 do
Write(sp[І]:6:2);
end;

Procedure Max(Var sp:array of real);
Var
і,nmax:integer;
begin
i:=1;
Max_oz:=sp[1];
Nmax:=1;
While і<6 do
begin
i:=і+1;
If sp[і]>max_oz then
begin
Max_oz:=sp[і];
Nmax:=і
end;
end;
For і:=nmax to 6 do
Sp[і]:=sp[і+1];
end;

Procedure Min(Var sp:array of real);
Var
і,nmin:integer;
begin
i:=1;
Min_oz:=sp[1];
Nmin:=1;
While і<5 do
begin
i:=і+1;;
If sp[і]=4 так, щоб перший елемент дорівнював 1, другий - 2, а кожен наступний:
1. Сумі двох попередніх елементів;
2. Сумі всіх попередніх елементів;
3. Добутку його номера та значення попереднього елемента.

Program zapov1;
Uses CRT;
Const n=15;
Var
A:array[1..n] of integer;
s,d,і:integer;

Procedure zapovnennya1;
Var
і:integer;
begin
A[1]:=1;
A[2]:=2;
For і:=3 to n do
A[і]:=A[і-1]+A[і-2];
end;

Procedure zapovnennya2;
Var
і,s:integer;
begin
A[1]:=1;
A[2]:=2;
S:=A[1]+A[2];
For і:=3 to n do
begin
A[і]:=s;
S:=s+A[і];
end;
end;

Procedure zapovnennya3;
Var
і,d:integer;
begin
A[1]:=1;
A[2]:=2;
For і:=3 to n do
A[і]:=і*A[і-1];
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to n do
Write(A[І]:6);
end;

Begin
clrscr;
zapovnennya1;
writeln;
vuvod;
writeln;
zapovnennya2;
writeln;
vuvod;
writeln;
zapovnennya3;
writeln;
vuvod;
writeln;
readln;
End.

Задача 7. Заповніть одновимірний масив С[1..m] випадковими дійсними числами. Виведіть елементи цього масиву на екран та виконайте такі заміни:
1. Замініть значення кожного елемента з парним номером на 1, а з непарним – на -1;
2. Замініть кожний елемент, значення якого є парним, на обернене до нього число;
3. Замініть значення елементів, номери яких діляться на 3 без остачі, на середнє арифметичне значення всіх елементів початкового масиву.

Program zapovn;
const m=10;
Var
c:array[1..m] of real;
s,as;real;
і:integer;

Procedure zapov1;
Var
і:1..m;
begin
s:=0;
Randomize;
for і:1 to m do
begin
C[І]:=RANDOM(20);
s:=s+c[і];
end;
as:=s/m;
end;

Procedure vuvod;
Var
і:1..m;
begin
for i:=1 to m do
write(c[і]);
end;

Procedure zapov2;
Var
і:1..m;
begin
for і:=1 to m do
begin
if і mod 2 =0 then c[і]:=1
else C[і]:=-1;
end;
end;

Procedure zapov3;
Var
і:1..m;
begin
for і:=1 to m do
begin
if frac(C[і] mod 2)=0 then C[і]:=1/C[і]
else C[і]:=C[і];
end;
end;

Procedure zapov4;
Var
і:1..m;
begin
for і:=1 to m do
begin
if і mod 3=0 then C[і]:=as
else C[і]:=C[і];
end;
end;

Begin
clrscr;
zapov1;
writeln;
vuvod;
writeln;
zapov2;
writeln;
vuvod;
writeln;
zapov1;
zapov3;
writeln;
vuvod;
writeln;
zapov1;
zapov4;
writeln;
vuvod;
writeln;
readln;
End.

Задача 8. Користувач увів з клавіатури цілі значення елементів одновимірних масивів A[1..n] та B[1..n]. Сформуйте масив С, елементами якого є:
1. Спочатку елементи масиву А , а потім елементи масиву В;
2. Суми відповідних елементів масивів А та В;
3. Добуток відповідних значень елементів масиву А та номерів елементів масиву В.

Program sum_dob_masuv;
Uses CRT;
Const
n=5;
n1=10;
Var
A:array[1..n] of integer;
B:array[1..n] of integer;
C:array[1..n] of integer;
і:integer;

Procedure vvod;
Var
і:1..n;
begin
For і:=1 to n do
begin
Write('A[',І,']=>');
Readln(A[і]);
end;
For і:=1 to n do
begin
Write('B[',І,']=>');
Readln(B[і]);
end;
end;

Procedure vuvod;
Var
і:1..n;
begin
For і:=1 to n do
Write(a[і]:4);
writeln;
For і:=1 to n do
Write(b[і]:4);
end;

Procedure dod_elem;
Var
і:integer;
begin
For і:=1 to n do
C[і]:=A[і];
For і:=1 to n do
C[n+і]:=B[і];
end;

Procedure vuvod1;
Var
і:integer;
begin
For і:=1 to n1 do
Write(c[і]:4);
end;

Procedure suma;
Var
і:1..n;
begin
For і:=1 to n do
C[і]:=A[і]+B[і];
end;

Procedure dob;
Var
і:integer;
begin
For і:=1 to n do
C[і]:=A[і]*і;
end;

Procedure vuvod2;
Var
і:integer;
begin
For і:=1 to n do
Write(c[і]:4);
end;

Begin
clrscr;
vvod;
vuvod;
suma;
writeln;
vuvod2;
dob;
writeln;
vuvod2;
dod_elem;
writeln;
vuvod1;
readln;
End.

Задача 9. Елементи масиву А є дійсними числами, значення яких уводять з клавіатури. Визначте:
1. Суму та добуток значень усіх елементів масиву;
2. Кількість додатних, від’ємних та нульових елементів масиву;
3. Середнє арифметичне значення елементів масиву;
4. Максимальний та мінімальний елемент цього масиву із зазначенням їх номерів;
5. Найбільший елемент та його номер серед від’ємних елементів масиву;
6. Суму додатних елементів цього масиву;
7. Суму значень тих елементів масиву, номери яких діляться на 4 без остачі;
8. Суму квадратів елементів масиву, що мають непарні номери;
9. Суму значень тих елементів, що розміщені до максимального елемента цього масиву;
10. Кількість елементів, значення яких перевищує число с;
11. Добуток перших k елементів цього масиву.

Program z_9_1;
Uses CRT;
Var
A:array[1..20] of real;
s,d:real;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:6:2);
end;

Procedure syma;
Var
і:integer;
begin
S:=0;
For і:=1 to 20 do
S:=S+A[і];
Writeln(‘S=‘,s:4:2);
end;

Procedure dob;
Var
і:integer;
begin
D:=1;
For і:=1 to 20 do
D:=A[і]*D;
Writeln(‘D=‘,d:4:2);
End;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
syma;
dob;
readln;
End.

Program z_9_2;
Uses CRT;
Var
A:array[1..20] of real;
d,v,n:integer;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:6:2);
end;

Procedure dodatni;
Var
і:integer;
begin
D:=0;
For і:=1 to 20 do
If A[і]>0 then d:=d+1
Writeln(‘D=‘,d:4:2);
end;

Procedure videmni;
Var
і:integer;
begin
v:=0;
For і:=1 to 20 do
If A[і]<0 then v:=v+1
Writeln(‘V=‘,v:4:2);
end;

Procedure nylovi;
Var
і:integer;
begin
N:=0;
For і:=1 to 20 do
If A[і]=0 then n:=n+1
Writeln(‘N=‘,n:4:2);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
dodatni;
videmni;
nylovi
readln;
End.

Program z_9_3;
Uses CRT;
Var
A:array[1..20] of real;
s,sr:real;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:6:2);
end;

Procedure seredne;
Var
і:integer;
begin
s:=0;
For і:=1 to 20 do
S:=s+A[і]
Sr:=s/20;
Writeln(‘sr=‘,sr:4:2);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
seredne;
readln;
End.

Program z_9_4;
Uses CRT;
Var
A:array[1..20] of real;
max,min:real;
n_max,n_min:integer;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:6:2);
end;

Procedure Max;
Var
і:integer;
begin
i:=1;
Max:=A[1];
N_max:=1;
While і<20 do
begin
i:=і+1;;
If A[і]>max then
begin
Max:=A[і];
N_max:=і
end;
end;
Writeln(n_max,’ element maxumalnuj І dorivnye ‘,max_op:4:2);
end;

Procedure Min;
Var
і:integer;
begin
i:=1;
Min:=A[1];
N_min:=1;
While і<20 do
begin
i:=і+1;;
If A[і]’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:6:2);
end;

Procedure Max_videm;
Var
і:integer;
begin
k:=0;
For і:=1 to 20 do
begin
If A[і]<0 then
begin
If k=0 then
begin
Max_vid:=A[і];
N_max:=І;
k:=1;
end
else
begin
If A[і]>max_vid then
begin
Max_vid:=A[і];
N_max:=і
end;
end;
end;
end;
Writeln(n_max,’ - videmnuj maxumalnuj element І dorivnye ‘,max_vid:4:2);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
max_videm;
readln;
End.

Program z_9_6;
Uses CRT;
Var
A:array[1..20] of real;
S:real;
n_max:integer;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:4:1);
end;

Procedure sum_dod;
Var
і:integer;
begin
s:=0;
For і:=1 to 20 do
begin
If A[і]>0 then
S:=s+A[і]
end;
Writeln(‘Suma_dodat=‘,s:4:2);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
sum_dod;
readln;
End.

Program z_9_7;
Uses CRT;
Var
A:array[1..20] of real;
S:real;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:4:1);
End;

Procedure sum_dil_4;
Var
і:integer;
begin
s:=0;
For і:=1 to 20 do
begin
If (І mod 4)=0 then S:=s+A[і]
end;
Writeln(‘Suma_dil_4=‘,s:4:2);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
sum_dil_4;
readln;
End.

Program z_9_8;
Uses CRT;
Var
A:array[1..20] of real;
S:real;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:4:1);
End;

Procedure sum_kvadr;
Var
і:integer;
begin
s:=0;
For і:=1 to 20 do
begin
If (І mod 2)<>0 then
begin
A[і]:=sqr(A[і]);
S:=s+A[і]
end;
end;
Writeln(‘Suma_kvadrativ_neparnux=‘,s:4:2);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
sum_kvadr;
readln;
End.

Program z_9_9;
Uses CRT;
Var
A:array[1..20] of real;
S, max:real;
N_max:integer;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:4:1);
end;

Procedure sum_Max;
Var
і:integer;
begin
i:=1;
Max:=A[1];
N_max:=1;
While і<20 do
begin
i:=і+1;;
If A[і]>max then
begin
Max:=A[і];
N_max:=і
end;
end;
s:=0;
For і:=1 to n_max-1 do
S:=s+A[і]
Writeln(‘Suma_do_najbilshogo=‘,s:4:2);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
sum_max;
readln;
End.

Program z_9_10;
Uses CRT;
Var
A:array[1..20] of real;
k:integer;
c:real;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:5:1);
end;

Procedure kilkist;
Var
і:integer;
begin
k:=0;
For і:=1 to 20 do
If A[і]<=c then k:=k+1
Writeln(‘k=‘,k);
end;

Begin
clrscr;
Write(‘c=>’);
Readln( c);
vvod;
writeln;
vuvod;
writeln;
kilkist;
readln;
End.

Program z_9_11;
Uses CRT;
Var
A:array[1..20] of real;
k:integer;
d:real;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to 20 do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to 20 do
Write(A[І]:5:1);
end;

Procedure dob_k;
Var
і:integer;
begin
D:=1;
For і:=1 to k do
D:=d*A[і];
Writeln(‘D=‘,d:4:2);
end;

Begin
clrscr;
Write(‘k=>’);
Readln(k);
vvod;
writeln;
vuvod;
writeln;
dob_k;
readln;
End.

10 Задача. Учням першого класу призначають додаткову склянку соку та булочку, якщо першокласник важить менше 30 кг. В перших класах ліцею навчається n учнів. Склянка соку має об’єм 200 мл, а замовлені упаковки соку – 1,5 л. Визначити кількість додаткових пакетів соку та булочок необхідно щодня.

Program pershoklas;
Uses CRT;
Const n=25;
Var
A:array[1..n] of real;
k,m:integer;
c:real;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to n do
begin
Write(‘A[‘,І,’]=>’);
Readln(A[і]);
end
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to n do
Write(A[І]:5:1);
end;

Procedure kilkist;
Var
і:integer;
begin
k:=0;
For і:=1 to n do
begin
If A[і]<=c then k:=k+1
end;
Writeln(‘Bylok neobxidno: ‘,k);
end;

Begin
clrscr;
Write(‘c=>’);
Readln( c);
vvod;
writeln;
vuvod;
writeln;
kilkist;
m:=k*0.2/1.5
writeln(‘Neobxidno ‘,m:3:0,’ paketu soky’);
readln;
End.

Задача 11. Для ведення щоденника погоди є три масиви даних: масив значень температури повітря, масив значень атмосферного тиску і масив значень швидкості вітру. Необхідно визначити :
1. Середнє значення температури, атмосферного тиску та швидкості вітру протягом поточного місяця;
2. Максимальні та мінімальні значення температури,атмосферного тиску та швидкості вітру за місяць із зазначенням днів, коли характеристики стану погоди мала ці значення;
3. Кількість днів протягом місяця, коли температура повітря була від’ємною і коли додатною;
4. Кількість днів протягом місяця, коли швидкість вітру перевищувала задане значення;

Program cshoden_pogodu;
Uses CRT;
Const n=5;
Var
T:array[1..n] of real;
A:array[1..n] of real;
B:array[1..n] of real;
N_maxt,n_maxa,n_maxb,n_mint,n_mina,n_minb,tk_d,tk_v,k:integer;
St,sa, sb,srt,sra,srb,max_t,max_a,max_b,min_t,min_a,min_b,c:real;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to n do
begin
Writeln(І,'-uj den:');
Write('Temperatyra povitrya:');
Readln(T[і]);
Write('Atmosfernuj tusk: ');
Readln(A[і]);
Write('Shvudkist vitry: ');
Readln(b[і]);
end
end;

Procedure seredne;
Var
і:integer;
begin
st:=0;
sa:=0;
sb:=0;
For і:=1 to n do
begin
St:=st+t[і];
Sa:=sa+a[і];
Sb:=sb+b[і];
end;
Srt:=st/n;
Sra:=sa/n;
Srb:=sb/n;
Writeln('Temperatyra: ',srt:5:1);
Writeln('Atmosfernuj tusk: ',sra:3:0);
Writeln('Shvudkist vitry: ',srb:5:2);
end;

Procedure Max;
Var
і:integer;
begin
i:=1;
Max_t:=T[1];
N_maxt:=1;
Max_a:=A[1];
N_maxa:=1;
Max_b:=B[1];
N_maxb:=1;
While іmax_t then
begin
Max_t:=T[і];
N_maxt:=і
end;
If A[і]>max_a then
begin
Max_a:=A[і];
N_maxa:=і
end;
If B[і]>max_b then
begin
Max_b:=B[і];
N_maxb:=і
end;
end;
Writeln('Temperatyra: ',Max_t:5:1,', ',N_maxt,'-j den');
Writeln('Atmosfernuj tusk: ',Max_a:3:0,', ',N_maxa,'-j den');
Writeln('Shvudkist vitry: ',Max_b:5:2,', ',N_maxb,'-j den');
end;

Procedure Min;
Var
і:integer;
begin
i:=1;
Min_t:=T[1];
N_mint:=1;
Min_a:=A[1];
N_mina:=1;
Min_b:=B[1];
N_minb:=1;
While і0 then tk_d:=tk_d+1
Writeln('Kilkist dniv, protyagom yakux');
Writeln('temperatyra byla dodatnoj: ',tk_d);
end;

Procedure videmni;
Var
і:integer;
begin
Tk_v:=0;
For і:=1 to n do
If A[і]<0 then tk_v:=tk_v+1
Writeln('Kilkist dniv, protyagom yakux');
Writeln('temperatyra byla videmnoj: ',tk_d);
end;

Procedure kilkist;
Var
і:integer;
begin
k:=0;
For і:=1 to n do
If B[і]>c then k:=k+1
Writeln('Kilkist dniv, kolu shvudkist');
Writeln('vitry perevuschyvala ',c:2:0,' m/c: ',k);
end;

Begin
clrscr;
vvod;
writeln;
Write('znachennya shvudkosti vitry: ');
Readln(c);
writeln;
writeln('Seredni znachennya');
seredne;
writeln;
writeln('Maxumalni znachennya');
max;
writeln;
writeln('Minimalni znachennya');
min;
writeln;
dodatni;
writeln;
videmni;
writeln;
kilkist;
readln;
End.

Задача 12. Є три види циліндрів. Для циліндрів кожного виду відомий оптимальний діаметр D. Циліндри кожного виду можна використовувати, якщо його дійсний діаметр відрізняється від оптимального не більше ніж на значення х. Якщо кількість браку виявиться більшою за чверть загальної кількості циліндрів даного виду, то таку партію циліндрів потрібно повернути постачальникам. Необхідно вияснити кількість якісних циліндрів у кожній з трьох партій та визначити, чи потрібно вертати партію деталей постачальникам.

Program zulindru;
Uses CRT;
Const
n1=20;
n2=16;
n3=25;
Var
Z1:array[1..n1] of real;
Z2:array[1..n2] of real;
Z3:array[1..n3] of real;
d_op,x:real;
k1,k2,k3:integer;

Procedure vvod;
Var
і:integer;
begin
For і:=1 to n1 do
begin
Write(‘Z1[‘,І,’]=>’);
Readln(z1[і]);
end;
For і:=1 to n2 do
begin
Write(‘Z2[‘,І,’]=>’);
Readln(z2[і]);
end;
For і:=1 to n3 do
begin
Write(‘Z3[‘,І,’]=>’);
Readln(z3[і]);
end;
end;

Procedure brak;
Var
і:integer;
begin
K1:=0;
K2:=0;
K3:=0;
For і:=1 to n1 do
begin
If abs(d_op-z1[і])>x Then k1:=k1+1;
end;
For і:=1 to n2 do
begin
If abs(d_op-z2[і])>x Then k2:=k2+1;
end;
For і:=1 to n3 do
begin
If abs(d_op-z3[і])>x Then k3:=k3+1;
end;
end;

Procedure povernennya;
Var
і:integer;
begin
If k1>n1/4 then Writeln(‘І vud zulindriv neobxidno povernytu‘)
else Writeln(‘І vud zulindriv nepotribno povertatu‘);
If k2>n2/4 then Writeln(‘II vud zulindriv neobxidno povernytu‘)
else Writeln(‘II vud zulindriv nepotribno povertatu‘);
If k3>n3/4 then Writeln(‘III vud zulindriv neobxidno povernytu‘)
else Writeln(‘III vud zulindriv nepotribno povertatu‘);
end;

Procedure vuvod;
Var
і:integer;
begin
For і:=1 to n1 do
Write(z1[І]:5:1);
end;
Writeln;
For і:=1 to n2 do
Write(z2[І]:5:1);
Writeln;
For і:=1 to n3 do
Write(z3[І]:5:1);
end;

Begin
clrscr;
writeln(‘Yvedit optumalnuj diametr zulindriv’);
readln(d_op);
writeln(‘Yvedit vidxulennya vid optumalnogo diametry zulindriv’);
readln(x);
vvod;
vuvod;
writeln;
brak;
povernennya;
readln;
End.

Задача 13. Елементи масиву С є випадковими цілими числами. Виведіть елементи цього масиву на екран та вилучить:
1. Елементи масиву, значення яких кратне 5;
2. Елементи масиву, значення яких менші за ціле число х;
3. Елементи масиву, номери яких дорівнюють квадрату цілого числа;
4. Елементи масиву, номери яких є простими числами.

Program z_13_1;
Uses CRT;
Const n=20;
Var
C:array[1..n] of integer;
k:integer;

Procedure vvod;
Var
i:1..n;
begin
Randomize;
For i:=1 to n do
C[i]:=random(100);
end;

Procedure vuvod(n:integer);
Var
i:1..n;
begin
For i:=1 to n do
Write(C[I]:4);
end;

Procedure zsyv;
Var
j:integer;
begin
For j:=i+1 to n do
C[j-1]:=C[j]
end;

Procedure vudalennya;
Var
i:1..n;
begin
K:=0;
For i:=1 to n do
begin
If (C[i] mod 5)=0 then
begin
While (C[i] mod 5)=0 do
begin
zsyv;
K:=k+1;
end;
end;
end;
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
vudalennya;
m:=n-k;
vuvod;
readln;
End.

Program z_13_2;
Uses CRT;
Const n=20;
Var
C:array[1..n] of integer;
i,k,m,x:integer;

Procedure vvod;
begin
Randomize;
For i:=1 to n do
C[i]:=random(100);
end;

Procedure vuvod(n:integer);
begin
For i:=1 to n do
Write(C[I]:4);
end;

Procedure zsyv;
Var
j:integer;
begin
For j:=i+1 to n do
C[j-1]:=C[j]
end;

Procedure vudalennya;
begin
K:=0;
For i:=1 to n do
begin
If C[i]');
readln(m);
vstavka;
vuvod3;
writeln;
vuvod1;
readln;
End.

Program z_14_3;
Uses CRT;
Const n=16;
Var
A:array[1..n] of integer;
B:array[1..n] of real;
Min_a,n_min,c,z:integer;

Procedure vvod;
Var
і:1..n;
begin
For і:=1 to n-1 do
begin
Write('A[',І,']=');
Readln(A[і]);
end;
end;

Procedure vvod1;
Var
і:1..n;
begin
Randomize;
For і:=1 to n do
B[і]:=random(16);
end;

Procedure vuvod;
Var
і:1..n;
begin
For і:=1 to n-1 do
Write(A[І]:5);
end;

Procedure vuvod4;
Var
і:1..n;
begin
For і:=1 to n-1 do
Write(B[і]:5:0);
end;

Procedure vstavka;
Var
і:1..n;
Procedure zsyv;
Var
j:integer;
begin
For j:=n-1 downto n_min do
A[j+1]:=A[j]
end;

Procedure Min;
Var
і:integer;
begin
i:=1;
Min_a:=A[1];
N_min:=1;
While іm do
begin
if C[j]>C[j-1] then Swap;
j:=j-1;
end;
m:=m+1;
end;
writeln('Yporyadkovanuj masuv:');
vuvod1;
readln;
End.

Задача 16. Значення температур повітря в поточному місяці необхідно розмістити за неспаданням. Після впорядкування деяка кількість елементів залишається на своїх місцях. Визначити кількість елементів масиву, шо залишилась на своїх місцях.

Program sort_bulb1;
Uses CRT;
Const n=30;
Var
T:array[1..n] of integer;
T1:array[1..n] of integer;
і,j,m:integer;

Procedure Swap;
Var
a:integer;
begin
a:=T1[і-1];
T1[і-1]:=T1[і];
T1[і]:=a
end;

Procedure vvod;
Var
і:1..n;
begin
Randomize;
for і:=1 to n do
T[і]:=random(10);
end;

Procedure vuvod;
Var
і:1..n;
begin
for і:=1 to n do
write(T[і]:3)
end;

Procedure vuvod1;
Var
і:1..n;
begin
for і:=1 to n do
write(T1[і]:3)
end;

Begin
clrscr;
vvod;
writeln('Pochatkovuj masuv:');
vuvod;
writeln;
writeln;
for і:=1 to n do
T1[і]:=T[і]
vuvod1;
writeln;
m:=0;
for і:=1 to n-1 do
begin
і:=n;
T1[і]:=T1[n];
while і>m do
begin
if T1[і]>=T1[і-1] then Swap;
і:=і-1;
end;
m:=m+1;
end;
writeln('Yporyadkovanuj masuv:');
vuvod1;
writeln;
j:=0;
for і:=1 to n do
if T1[і]=T[і] then j:=j+1;
writeln(j,' elementu masuvy zalushulus na svojx miszyax');
readln;
End.

Задача 17. Із цілочислових значень елементів масиву A[1..2n] сформуйте масиви B[1..n] та C[1..n] за таким правилом. Оберіть у масиві А два найближчих за значенням елементи. Менший із них розмістіть у масиві В, більший у масиві С. Формуємо масив и В і С, поки не буде розглянуто всі елементи масиву А.

Program dil_mas;
Uses CRT;
Const
n=10;
n1=20;
Var
A:array[1..n1] of integer;
B:array[1..n] of integer;
C:array[1..n1] of integer;
і,j,m:integer;

Procedure vvod;
Var
j:1..n1;
begin
Randomize;
for j:=1 to n1 do
A[j]:=random(100);
end;

Procedure vuvod;
Var
і:1..n1;
begin
for і:=1 to n1 do
write(A[і]:4)
end;

Procedure vuvod1;
Var
j:1..n;
begin
for і:=1 to n do
write(B[і]:4)
end;

Procedure vuvod2;
Var
і:1..n;
begin
for і:=1 to n do
write(C[і]:4)
end;

Procedure formyvannya;
Var
і:1..n;
j:1..n1;
begin
j:=1;
і:=1;
while j<=n1-1 do
begin
if A[j]>=A[j+1] then
begin
B[і]:=A[j+1];
C[і]:=A[j];
end
else
begin
B[і]:=A[j];
C[і]:=A[j+1];
end;
j:=j+2;
і:=і+1;
end;
end;

Begin
clrscr;
vvod;
writeln('Masuv A:');
vuvod;
writeln;
formyvannya;
writeln('Masuv B:');
vuvod1;
writeln;
writeln('Masuv C:');
vuvod2;
readln;
End.

Задача 18. Є масив A[1..n] - середніх балів учні. Необхідно впорядкувати його за незростанням. Визначити, чи одинакові значення має поточний елемент із наступними сусідніми елементами масиву та кількість однакових сусідів.

Метод «Бульбашки»

Program sort_bulb3;
Uses CRT;
Const n=30;
Var
B:array[1..n] of real;
і,j,m:integer;

Procedure Swap;
Var
a:real;
begin
a:=B[і-1];
B[і-1]:=B[і];
B[і]:=a
end;

Procedure vvod;
Var
і:1..n;
begin
Randomize;
for і:=1 to n do
B[і]:=random(12);
end;

Procedure vuvod;
Var
і:1..n;
begin
for і:=1 to n do
write(B[і]:5:1)
end;

Begin
clrscr;
vvod;
writeln('Pochatkovuj masuv:');
vuvod;
writeln;
m:=0;
for і:=1 to n-1 do
begin
і:=n;
B[і]:=B[n];
while і>m do
begin
if B[і]>=B[і-1] then Swap;
і:=і-1;
end;
m:=m+1;
end;
writeln('Yporyadkovanuj masuv:');
vuvod;
writeln;
і:=1;
m:=0;
while і<=n-1 do
begin
if B[і]=B[і+1] then
begin
write('Cerednij bal ',B[і]:5:1);
m:=m+2;
for j:=і+2 to n do
begin
if B[і]=B[j] then
begin
m:=m+1;
і:=і+1;
end;
end;
writeln(' mae ',m,' ychniv');
end;
і:=і+1;
m:=0;
end;
readln;
End.

Метод перестановки

Program sort_per1;
Uses CRT;
Const n=30;
Var
B:array[1..n] of real;
і,j,m:integer;

Function B_max(k:integer):integer;
Var
і,n_max:integer;
max:real;
begin
і:=k;
max:=B[k];
while іmax then
begin
n_max:=і;
max:=B[і]
end
end;
B_max:=n_max;
end;

Procedure Swap(Var x,y:real);
Var
a:real;
begin
a:=x;
x:=y;
y:=a
end;

Procedure vvod;
Var
і:1..n;
begin
Randomize;
for і:=1 to n do
B[і]:=random(12);
end;

Procedure vuvod;
Var
і:1..n;
begin
for і:=1 to n do
write(B[і]:5:1)
end;

Begin
clrscr;
vvod;
writeln('Pochatkovuj masuv:');
vuvod;
writeln;
і:=0;
while іj+1 do
begin
if A[і]>A[і-1] then Swap;
і:=і-1;
end;
j:=j+1;
end;
b:=A[1]*1000+A[2]*100+A[3]*10+A[4];
j:=0;
for і:=1 to n-1 do
begin
і:=n;
A[і]:=A[n];
while і>j+1 do
begin
if A[і]j+1 do
begin
if A[і]>A[і-1] then Swap;
і:=і-1;
end;
j:=j+1;
end;
b:=A[1]*100+A[2]*10+A[3];
j:=0;
for і:=1 to n-1 do
begin
і:=n;
A[і]:=A[n];
while і>j+1 do
begin
if A[і]=і.

Program nul_masuv;
Uses CRT;
Const n=10;
Var
A:array[1..n] of integer;
і,j,m:integer;

Begin
clrscr;
for і:=1 to n do
begin
write('A[',і,']:=');
readln(A[і]);
end;
writeln('Masuv A:');
for і:=1 to n do
write(A[і]:4);
writeln;
m:=0;
for і:=1 to n do
begin
if A[і]>=і then
begin
m:=m+1;
for j:=1 to m do;
A[j]:=A[І];
end;
end;
writeln('Masuv A:');
for j:=1 to m do
write(A[j]:4);
writeln;
readln;
End.

Задача 22. Дано одновимірний масив A[1..n] цілих чиселю Необхідно вивести на екран ті його елементи, у яких:
1. Індекси є степенями двійки;
2. Індекси є простими числами;
3. Індекси є членами послідовності Фібоначчі.

Program Z_22_1;
Uses Crt;
Const n=10;
Var
A:array[1..n] of integer;
і,j,b,m:integer;
Begin
Clrscr;
for і:=1 to n do
begin
write('A[',і,']:=');
readln(A[і]);
end;
writeln('Masuv A:');
for і:=1 to n do
write(A[і]:4);
writeln;
m:=0;
b:=1;
While bn then goto 1;
b:=c;
c:=d;
WriteLn( і,' ',d );
і:=d;
begin
m:=m+1;
for j:=1 to m do;
A[j]:=A[d];
end;
end;
1: writeln('Masuv A:');
for j:=1 to m do
write(A[j]:4);
writeln;
readln;
End.

Задача 23. Дано одновимірний масив A[1..10] цілих чисел. Необхідно заповнити його таким чином, щоб сума елементів, розміщених рядом у трьох сусідніх комірках дорівнювала заздалегіть визначеному числу n.

Program sejf;
Uses crt;
label 1;
Var
A:array[1..10] of integer;
і,j,n,s:integer;

Begin
clrscr;
write('n=');
readln(n);
for і:=1 to 2 do
begin
write('A[',і,']:=');
readln(A[і]);
end;
A[3]:=n-A[1]-A[2];
If A[3]>6 then Writeln('Zapovnutu masuv ne moghna')
Else
begin
i:=4;
While і<=n do
begin
A[і]:=A[1];
if і=10 then goto 1;
A[і+1]:=A[2];
if і=10 then goto 1;
A[і+2]:=A[3];
i:=і+3;
end;
end;
1: writeln('Masuv A:');
for і:=1 to 10 do
write(A[і]:4);
writeln;
readln;
End.

Задача 24. Дано два одновимірний масив A[1..n] та B[1..n], елементами яких є натуральні числа. Необхідно визначити таку перестановку елементів масивів, за якою сума добутків A[1]*B[1]+A[2]*B[2]+…+A[n]*B[n] є максимальною. Виведіть на екран переставлені за знайденим законом елементи масивів та визначене значення цієї максимальної суми.

Program m_symdob;
Uses crt;
Const n=10;
Type MAS=array[1..n] of integer;
Var
A:MAS;
B:MAS;
і,j,sd,m,t:integer;

Procedure sumdob;
begin
Sd:=0;
For і:=1 to n do
Sd:=sd+A[і]*B[і];
writeln('Sd=',sd);
end;

Begin
clrscr;
For і:=1 to n do
begin
write('A[',і,']=');
readln(A[І]);
end;
writeln('Pochatkovuj masuv A:');
For і:=1 to n do
write(A[і]:4);
writeln;
For і:=1 to n do
begin
write('B[',і,']=');
readln(B[і]);
end;
writeln('Pochatkovuj masuv B:');
For і:=1 to n do
write(B[і]:4);
writeln;
sumdob;
writeln;
m:=0;
for і:=1 to n-1 do
begin
і:=n;
A[і]:=A[n];
while і>m do
begin
if A[і]>=A[і-1] then
begin
t:=A[і-1];
A[і-1]:=A[і];
A[і]:=t
end;
і:=і-1;
end;
m:=m+1;
end;
writeln('Yporyadkovanuj masuv A:');
For і:=1 to n do
write(A[і]:4);
writeln;
m:=0;
for і:=1 to n-1 do
begin
і:=n;
B[і]:=B[n];
while і>m do
begin
if B[і]>=B[і-1] then
begin
t:=B[і-1];
B[і-1]:=B[і];
B[і]:=t
end;
і:=і-1;
end;
m:=m+1;
end;
writeln('Yporyadkovanuj masuv B:');
For і:=1 to n do
write(B[і]:4);
writeln;
sumdob;
readln;
End.

Задача 25. Координати кущів є пара цілих чисел xi, yi, де і =1,2,…,n. Необхідно знайти довжину прямокутного паркану, сторони якого паралельні осям координат. Від кутових кущів необхідно відступити на 1 м у кожному напрямку.

Program parkan;
Uses Crt;
Const n=10;
Var
X:array[1..n] of integer;
Y:array[1..n] of integer;
Min_x,min_y,max_x,max_y,L_x,L_y,І,L,Nmin_x,Nmin_y,Nmax_x,Nmax_y:integer;

Procedure vvod;
begin
for і:=1 to n do
begin
write('X[',і,']=');
readln(X[і]);
write('Y[',і,']=');
readln(Y[і]);
end;
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
write(і,'-j ');
writeln(X[і],',',Y[і]);
end;
end;

Procedure shuruna;
begin
Min_x:=X[1];
Nmin_x:=1;
For і:=2 to n do
If X[і]Max_x then
begin
Max_x:=X[і];
Nmax_x:=І;
end;
L_x:=Max_x-Min_x+2;
end;

Procedure dovghuna;
begin
Min_y:=Y[1];
Nmin_y:=1;
For і:=2 to n do
If Y[і]Max_y then
begin
Max_y:=Y[і];
Nmax_y:=І;
end;
L_y:=Max_y-Min_y+2;
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
shuruna;
dovghuna;
writeln(Nmin_x,'-j:',X[Nmin_x],',',Y[Nmin_x]);
writeln(Nmax_x,'-j:',X[Nmax_x],',',Y[Nmax_x]);
writeln(Nmin_y,'-j:',X[Nmin_y],',',Y[Nmin_y]);
writeln(Nmax_y,'-j:',X[Nmax_y],',',Y[Nmax_y]);
L:=2*L_x+2*L_y;
Writeln('L=',l);
readln;
End.

Завдання для самостійної роботи
1. У цілочисельному масиві A [1: n] знайдіть число, яке повторюється максимальну кількість разів. Якщо таких чисел декілька, то одне з них.

2. Змініть знак всіх непарних (парних) елементів масиву, що складається з L чисел.

3. "Стисніть" масив, "викинувши" кожен другий його елемент (додаткові масиви використовувати не дозволяється).

4. У масиві X (N) кожен елемент дорівнює 0, 1 або 2. Переставити елементи масиву так, щоб спочатку розташовувалися всі одиниці, потім все двійки і, нарешті, всі нулі (додаткового масиву не заводити).

5. У заданій послідовності всі елементи, не рівні нулю, розташувати зберігаючи їх порядок слідування, на початку послідовності, а нульові елементи - в кінці послідовності.

6. Дан одновимірний цілочисельний масив A (N). Відомо, що серед його елементів два і лише два рівні між собою. Надрукувати їх індекси.

7. Нехай дано впорядкований за неспаданням масив цілих або дійсних чисел і нехай дано деяке число b (відповідно ціле або дійсне), для якого потрібно знайти таке місце серед чисел, щоб після вставки числа b на це місце впорядкованість не порушилася.

8. З шестизначного числа виділити цифри і з них сформувати одновимірний масив.

9. Мажорірующим елементом у масиві А [1 .. n] будемо називати елемент, що зустрічається в масиві більш n/2 разів. Легко помітити, що в масиві може бути не більше одного мажорірующого елемента. Наприклад, масив 3, 3, 4, 2, 4, 4, 2, 4, 4, 3 має мажорірующий елемент 4. Необходлімо визначити, чи є в масиві мажорірующий елемент, і якщо є, то який.

10. Дан цілочисельний масив А довжиною n, в якому значеннями заповнені тільки перші m елементів (m ;
Matrix = array [1 .. 10] of vector;
Var m: matrix;

Двовимірний масив m, що складається з 10 рядків, у кожному з яких 5 стовпців. При цьому до кожного і-ого рядку можна звертатися m [і], а до кожного j-ого елементу всередині і-ого рядка - m[і,j].
Визначення типів для двовимірних масивів можна задавати і в одному рядку:

Type
Matrix= array [1..5] of array [1..10] of < тип элементів >;

або:

type
matrix = array [1..5, 1..10] of <тип элементів>;

Єдину дію, яку можна здійснити над однотипними масивами в цілому - це присвоювання. Тобто, якщо в програмі у нас описані дві матриці одного типу, наприклад,

Type
matrix = array [1 .. 5, 1 .. 10] of integer;
Var
a, b: matrix;

то в ході виконання програми можна присвоїти матриці a значення матриці b (a: = b). Всі інші дії виконуються поелементно, при цьому над елементами можна виконувати всі допустимі операції, які визначені для типу даних елементів масиву. Це означає, що якщо масив складається з цілих чисел, то над його елементами можна виконувати операції, визначені для цілих чисел, якщо ж масив складається із символів, то до них застосовні операції, визначені для роботи з символами.

Введення двовимірного масиву.
Для послідовного введення елементів одновимірного масиву ми використовували цикл for, в якому змінювали значення індексу з 1-го до останнього. Але положення елемента в двовимірному масиві визначається двома індексами: номером рядка та номером стовпця. Це означає, що потрібно послідовно змінювати номер рядки з 1-ї до останнього і в кожному рядку перебирати елементи стовпців з 1-го до останнього. Значить, нам буде потрібно два цикли for, причому один з них буде вкладений в інший.
Приклад програми введення двовимірного масиву з клавіатури

type
matrix= array [1..5, 1..10] of integer;
Var
a, : matrix;
і, j: integer; { індекси масива }
begin
for і :=1 to 5 do {цикл для перебирання всіх рядків}
for j :=1 to 10 do {перебирання всіх элементів рядка по стовпцям}
readln ( a [ і , j ]); {введення з клавіатуриы елементу, який знаходиться в і -ому рядку і j -ому стовпбці}

Двовимірний масив можна заповнити випадковим чином, тобто використовувати функцію random(N).
Виведення двовимірного масиву на екран.
Виведення елементів двовимірного масиву здійснюється послідовно, необхідно надрукувати елементи кожного рядка і кожного стовпця. При цьому хотілося б, щоб елементи, що стоять в одному рядку, друкувалися поруч, тобто в рядок, а елементи стовпця розташовувалися один під іншим.
Приклад програми виведення двовимірного масиву

for і :=1 to 5 do { цикл для перебирання всіх рядків}
begin
for j :=1 to 10 do {перебирання всіх элементів рядка по стовпцям}
write ( a [ і , j ]:4); {друк елементів, якізнаходяться в і -ому рядку матриці в одному екранному рядку, при цьому для виведення кажного елемента відводиться 4 позиції}
writeln ; {перед тим, як змінити номер рядка в матриці, необхідно перевести курсор на початок нового екранного рядка}
end ;

Задача 1. Створити рейтинг учнів класу, використавши для цього двовимірний масив.
Program Reit_kl;
Uses Crt;
Const n=6;m=5;
Var
Ocinka:array[1..n,1..m] of integer;
reit:array[1..n] of real;
sum_bal,sum_pred,і,j,k:integer;
ser_pred:array[1..m] of real;
t:real;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
for j:=1 to m do
readln(Ocinka[І,j]);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(Ocinka[І,j]:5);
writeln;
end;
end;

Begin
clrscr;
vvod;
vuvod;
for і:=1 to n do
begin
Sum_bal:=0;
for j:=1 to m do
sum_bal:=sum_bal+ocinka[і,j];
reit[і]:=sum_bal/m;
end;
for і:=1 to n do
writeln( і,' ychen: ',reit[і]:3:2);
for j:=1 to m do
begin
Sum_pred:=0;
for і:=1 to n do
sum_pred:=sum_pred+ocinka[і,j];
Ser_pred[j]:=sum_pred/n;
end;
writeln;
for j:=1 to m do
writeln( j,' predmet: ',Ser_pred[j]:3:2);
writeln;
k:=0;
for і:=1 to n-1 do
begin
і:=n;
reit[і]:=reit[n];
while і>k+1 do
begin
if reit[і]>reit[і-1] then
begin
t:=reit[і-1];
reit[і-1]:=reit[і];
reit[і]:=t
end; ;
і:=і-1;
end;
k:=k+1;
end;
for і:=1 to n do
writeln( і,' ychen: ',reit[і]:3:2);
writeln;
k:=0;
for j:=1 to m-1 do
begin
j:=m;
ser_pred[j]:=Ser_pred[m];
while j>k+1 do
begin
if ser_pred[j]>ser_pred[j-1] then
begin
t:=ser_pred[j-1];
ser_pred[j-1]:=ser_pred[j];
ser_pred[j]:=t
end;
j:=j-1;
end;
k:=k+1;
end;
writeln;
for j:=1 to m do
writeln( j,' predmet: ',Ser_pred[j]:3:2);
readln;
End.

Задача 2. Заповніть двовимірний масив T[1..10,1..8] за формулою: T[і,j]=i2+3*j3. Виведіть заповнений массив на екран.
Program zapov;
Uses Crt;
Const
n=10;
m=8;
Var
T:array[1..n,1..m] of integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
for j:=1 to m do
T[І,j]:=sqr(і)+3*j*sqr(j);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(T[І,j]:5);
writeln;
end;
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
readln;
End.

Задача 3. Дано масив А[1..n,1..m], значеннями елементів якого є випадкові дійсні числа. Сформуйте одновимірний масив В, елементами якого є суми елементів кожного стовпця двовимірного масиву. Виведіть елементи массив А та В на екран.
Program zapov;
Uses Crt;
Const
n=10;
m=8;
Var
A:array[1..n,1..m] of real;
B:array[1..m] of real;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[І,j]:=random(20);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[І,j]:5:1);
writeln;
end;
end;

Procedure vuvod1;
Var j:1..m;
begin
for j:=1 to m do
begin
write(B[j]:5:1);
end;
end;

Procedure Syma_stovp;
Var
і:1..n;
j:1..m;
begin
for j:=1 to m do
begin
B[j]:=0;
for і:=1 to n do
B[j]:=B[j]+A[і,j];
end;
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
Syma_stovp;
Vuvod1;
readln;
End.

Задача 4. Дано масив C[1..n,1..m], цілих чисел. Помножте кожний елемент першого рядка, включаючи перший, на С[1,1], кожний елемент другого рядка – на C[2,2] тощою Початковий та змінений масиви виведіть на екран.
Program zapov;
Uses Crt;
Const
n=5;
m=4;
Var
С:array[1..n,1..m] of integer;
B:array[1..n,1..m] jf integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
for j:=1 to m do
begin
Writeln(‘C[‘,і,’,’,j,’]’);
Readln(C[і,j];
end;
end;

Procedure vuvod(A:array of integer);
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5);
writeln;
end;
end;

Procedure Dobytok;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
B[І,j]:=C[і,j]*C[і,1];
end;
end;

Begin
clrscr;
vvod;
writeln;
vuvod(C);
writeln;
dobytok;
vuvod(B);
readln;
End.

Задача 5. Дано масив C[1..n,1..m], цілих чисел. Помножте кожний елемент першого рядка, включаючи перший, на С[1,1], кожний елемент другого рядка – на C[2,2] тощою Початковий та змінений масиви виведіть на екран.
Program zapov;
Uses Crt;
Const
n=5;
m=4;
Var
C:array[1..n,1..m] of integer;
B:array[1..n,1..m] of integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
for j:=1 to m do
begin
Writeln('C[',і,',',j,']');
Readln(C[і,j]);
end;
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(C[і,j]:5);
writeln;
end;
end;

Procedure vuvod1;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(B[і,j]:5);
writeln;
end;
end;

Procedure Dobytok;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
B[І,j]:=C[і,j]*C[і,1];
end;
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
dobytok;
vuvod1;
readln;
End.

Задача 6. Дано двовимірний масив А[1..n,1..m], дійсних чисел. Визначити:
1. Суму елементів k-го стовпця;
2. Добуток елементів С-го рядка;
3. Добуток елементів, розміщених у непарних стовпцях;
4. Суму елементів, розміщених у парних рядках;
5. Найбільший та найменший елементи масиву та значення їх індексів;
6. Номер рядка, сума елементів якого є найменшою;
7. Номер стовпця, у якому розміщено найбільше число від’ємних елементів масиву;
8. Номер рядка, середнє арифметичне значення елементів якого більше заданого числа Х;
9. Номер стовпця, у якому всі елементи діляться без остачі на число У.
Program z_6_1;
Uses Crt;
Const
n=5;
m=4;
Var
A:array[1..n,1..m] of real;
S:real;k:integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(20);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure Syma;
Var
і:1..n;
j:1..m;
begin
s:=0;
for і:=1 to n do
begin
j:=k;
S:=S+A[і,k];
End;
Writeln(‘S=’,s:4:1);
End;

Begin
clrscr;
Write(‘k=’);
Readln(k);
vvod;
writeln;
vuvod;
writeln;
Syma;
readln;
End.

Program z_6_2;
Uses Crt;
Const
n=5;
m=4;
Var
A:array[1..n,1..m] of real;
D:real;c:integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(20);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure Dobytok;
Var
і:1..n;
j:1..m;
begin
D:=1;
for j:=1 to m do
begin
і:=c;
D:=D*A[c,j];
end;
Writeln(‘D=’,d:4:1);
end;

Begin
clrscr;
Write(‘c=’);
Readln(c);
vvod;
writeln;
vuvod;
writeln;
Dobytok;
readln;
End.

Program z_6_3;
Uses Crt;
Const
n=5;
m=4;
Var
A:array[1..n,1..m] of real;
d:real;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(20);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure Dobytok;
Var
і:1..n;
j:1..m;
begin
D:=1;
for і:=1 to n do
begin
for j:=1 to m do
begin
if (j mod 2)<>0 then
D:=D*A[і,j];
end;
end;
Writeln(‘D=’,d:4:1);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
Dobytok;
readln;
End.

Program z_6_4;
Uses Crt;
Const
n=5;
m=4;
Var
A:array[1..n,1..m] of real;
S:real;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(20);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure Syma;
Var
і:1..n;
j:1..m;
begin
S:=0;
for j:=1 to m do
begin
for і:=1 to n do
begin
if (і mod 2)=0 then
S:=S+A[і,j];
end;
end;
Writeln(‘S=’,s:4:1);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
Syma;
readln;
End.

Program z_6_5;
Uses Crt;
Const
n=5;
m=4;
Var
A:array[1..n,1..m] of real;
max,min:real;max_і,max_j,min_і,min_j:integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(20);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure maximym;
Var
і:1..n;
j:1..m;
begin
max:=A[1,1];
max_і:=1;
max_j:=1;
for і:=1 to n do
begin
for j:=1 to m do
begin
if A[І,j]>max then
begin
max:=A[І,j];
max_і:=і;
max_j:=j;
end;
end;
end;
Writeln('Max=',max:4:1);
Writeln('N_max=',max_і,',',max_j);
end;

Procedure minimym;
Var
і:1..n;
j:1..m;
begin
min:=A[1,1];
min_і:=1;
min_j:=1;
for і:=1 to n do
begin
for j:=1 to m do
begin
if A[І,j]',n_min_r);
readln;
End.

Program z_6_7;
Uses Crt;
Const
n=5;
m=4;
Var
A:array[1..n,1..m] of real;
K:array[1..m] of integer;
Kv,Kv_max,n_max_s,і,j:integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
for j:=1 to m do
readln(A[І,j]);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[І,j]:5:1);
writeln;
end;
end;

Begin
clrscr;
vvod;
vuvod;
writeln;
for j:=1 to m do
begin
Kv:=0;
for і:=1 to n do
begin
If A[І,j]<0 then
Kv:=kv+1;
end;
K[j]:=kv;
end;
for j:=1 to m do
write(K[j]:5);
writeln;
Kv_max:=K[1];
N_max_s:=1;
for j:=1 to m do
if K[j]>Kv_max then
begin
Kv_max:=K[j];
N_max_s:=j;
end;
Writeln('Nomer stovpzya z max kil videmnux elementiv=>',n_max_s);
readln;
End.

Program z_6_8;
Uses Crt;
Const
n=5;
m=4;
Var
A:array[1..n,1..m] of real;
K:array[1..n] of real;
S,Sr,Sr_max,x:real; n_max_sr,і,j:integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(20);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Begin
clrscr;
vvod;
vuvod;
writeln(‘Yvedit chuslo x’);
readln(x);
for і:=1 to n do
begin
S:=0;
for j:=1 to m do
s:=s +A[і,j];
sr:=s/m;
K[і]:=sr;
end;
for і:=1 to n do
write(K[і]:5:1);
writeln;
Sr_max:=K[1];
N_max_sr:=1;
for і:=1 to n do
if K[і]>Sr_max then
begin
Sr_max:=K[і];
N_max_sr:=І;
end;
Writeln('Nomer ryadka z max ser elementiv=>',n_max_sr);
readln;
End.

Program z_6_9;
Uses Crt;
Const
n=5;
m=4;
Var
A:array[1..n,1..m] of integer;
K:array[1..m] of integer;
Kd,y,Kv_max,n_max_s,і,j:integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
for j:=1 to m do
readln(A[І,j]);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[І,j]:5);
writeln;
end;
end;

Begin
clrscr;
vvod;
vuvod;
writeln('Yvedit chuslo y');
readln(y);
for j:=1 to m do
begin
Kd:=0;
for і:=1 to n do
begin
If (A[І,j] mod y)=0 then
Kd:=kd+1;
end;
If kd=n then
begin
K[j]:=j;
writeln('Y ',j,' stovpzya vsi elementu dilyatsya na ',y);
end;
end;
readln;
End.

Задача 7. Дано двовимірний масив А[1..n,1..m]. Видалити:
1. k-й рядок;
2. С-й стовпець;
3. Всі стовпці, які містять нульові елементи;
4. Рядки, уяких є хоча б один від’ємний елемент;
5. Усі рядки, у яких перший елемент більший за останній;
6. Стовпець, у якому розміщено найменший елемент масиву.
Program z_7_1;
Uses Crt;
Var
A:array[1..5,1..4] of real;
k,n,m,і,j:integer;

Procedure vvod;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(20);
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure Del_r;
begin
for і:=k to n-1 do
for j:=1 to m do
A[і,j] := A[і+1,j];
for j:=1 to m do
A[n, j]:=0;
Dec(n);
end;

Begin
clrscr;
Write('n=');
Readln(n);
Write('m=');
Readln(m);
Write('k=');
Readln(k);
vvod;
writeln;
vuvod;
writeln;
Del_r;
Vuvod;
readln;
End.

Program z_7_2;
Uses Crt;
Var
A:array[1..5,1..4] of real;
c,n,m,і,j:integer;

Procedure vvod;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(20);
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure Del_s;
begin
for j:=c to m-1 do
for і:=1 to n do
A[і,j] := A[і,j+1];
for і:=1 to m do
A[і, m]:=0;
Dec(m);
end;

Begin
clrscr;
Write('n=');
Readln(n);
Write('m=');
Readln(m);
Write('c=');
Readln(c);
vvod;
writeln;
vuvod;
writeln;
Del_s;
Vuvod;
readln;
End.

Program z_7_3;
Uses Crt;
Var
A:array[1..5,1..4] of real;
c,n,m,і,j:integer;

Procedure vvod;
begin
for і:=1 to n do
for j:=1 to m do
begin
write('A[',і,',',j,']=');
readln(A[і,j]);
end;
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure Del_s;
begin
for j:=c to m-1 do
for і:=1 to n do
A[і,j] := A[і,j+1];
for і:=1 to m do
A[і, m]:=0;
Dec(m);
end;

Begin
clrscr;
Write('n=');
Readln(n);
Write('m=');
Readln(m);
vvod;
writeln;
vuvod;
writeln;
for і:=1 to n do
for j:=1 to m do
begin
if A[І,j]=0 then
begin
c:=j;
del_s;
vuvod;
writeln;
end;
end;
readln;
End.

Program z_7_4;
Uses Crt;
Var
A:array[1..5,1..4] of real;
k,n,m,і,j:integer;

Procedure vvod;
begin
for і:=1 to n do
for j:=1 to m do
begin
write('A[',і,',',j,']=');
readln(A[і,j]);
end;
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure Del_r;
begin
for і:=k to n-1 do
for j:=1 to m do
A[і,j] := A[і+1,j];
for j:=1 to m do
A[n, j]:=0;
Dec(n);
End;

Begin
clrscr;
Write('n=');
Readln(n);
Write('m=');
Readln(m);
vvod;
writeln;
vuvod;
writeln;
for і:=1 to n do
for j:=1 to m do
begin
if A[І,j]<0 then
begin
k:=і;
del_r;
vuvod;
writeln;
end;
end;
readln;
End.

Program z_7_5;
Uses Crt;
Var
A:array[1..5,1..4] of real;
k,n,m,і,j:integer;

Procedure vvod;
begin
for і:=1 to n do
for j:=1 to m do
begin
write('A[',і,',',j,']=');
readln(A[і,j]);
end;
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure Del_r;
begin
for і:=k to n-1 do
for j:=1 to m do
A[і,j] := A[і+1,j];
for j:=1 to m do
A[n, j]:=0;
Dec(n);
end;

Begin
clrscr;
Write('n=');
Readln(n);
Write('m=');
Readln(m);
vvod;
writeln;
vuvod;
writeln;
і:=1;
while іA[І,m] then
begin
k:=і;
del_r;
vuvod;
writeln;
і:=1;
end
else і:=і+1;
end;
readln;
End.

Program z_7_6;
Uses Crt;
Var
A:array[1..5,1..4] of real;
max_і,max_j,min_і,min_j,c,n,m,і,j:integer;
max,min:real;

Procedure vvod;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(20);
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Procedure minimym;
begin
min:=A[1,1];
min_і:=1;
min_j:=1;
for і:=1 to n do
begin
for j:=1 to m do
begin
if A[І,j]0) and ((j mod 2)<>0)) then
begin
A[І,j]:=b;
b:=b+1
end
Else
if (((І mod 2)=0) and ((j mod 2)=0)) then
begin
A[І,j]:=b;
b:=b+1
end
Else A[І,j]:=0;
end;
end;
end;
end;

Procedure vuvod;
begin
For і:=1 to n do
begin
For j:=1 to n do
Write(A[І,j]:4);
Writeln;
end;
end;

Begin
ClrScr;
Zapovn;
Writeln;
Vuvod;
ReadLn;
End.

Program Z_9_4;
Uses Crt;
Const n=7;
Var
A:array[1..n,1..n]of integer;
i,j,b:integer;

Procedure zapovn;
Var
b:integer;
begin
b:=0;
For і=1 to n do
begin
for j:=1 to n do
begin
A[І,j]:=j+b;
If A[І,j]=7 then b:=-6+і-2;
end;
b:=І;
end;
end;

Procedure vuvod;
begin
For і:=1 to n do
begin
For j:=1 to n do
Write(A[І,j]:4);
Writeln;
end;
end;

Begin
ClrScr;
Zapovn;
Writeln;
Vuvod;
ReadLn;
End.

Program Z_9_5;
Uses Crt;
Const n=7;
Var
A:array[1..n,1..n]of integer;
І,j,b:integer;

Procedure zapovn;
Var
b:integer;
begin
b:=0;
j:=1;
while jSb then
Writeln('Matruzya A mae bilshuj slid')
Else
Writeln('Matruzya B mae bilshuj slid');
ReadLn;
End.

Задача 11. Дано цілочислову матрицю порядка n.
1. Необхідно визначити номери рядків, значення всіх елементів яких дорівнюють 0;
2. Необхідно визначити номери рядків, що складаються з однакових елементів;
3. Необхідно визначити номери рядків, значення всіх елементів яких є парними числами;
4. Необхідно визначити номери рядків, значення всіх елементів яких є простими числами.
Program z_11_1;
Uses Crt;
Const n=5;
Var
A:array[1..n,1..n] of integer;
i,j,f,m:integer;

Procedure zapovn;
begin
for і:=1 to n do
for j:=1 to n do
begin
write('A[',І,',',j,']=');
readln(A[І,j]);
end;
end;

Procedure vuvod;
begin
For і:=1 to n do
begin
For j:=1 to n do
Write(A[І,j]:4);
Writeln;
end;
end;

Begin
ClrScr;
Zapovn;
Writeln;
Vuvod;
Writeln;
f:=0;
For і:=1 to n do
begin
m:=0;
For j:=1 to n do
begin
If A[І,j]=0 then m:=m+1;
end;
if m<>n then f:=f+1
else writeln('Ryadok ',І,' mae nylovi znachennya vsix elementiv');
end;
If f=n then
writeln('Matruzya ne mae ryadkiv z nylovumu znachennyamu vsix elementiv');
ReadLn;
End.

Program z_11_2;
Uses Crt;
Const n=5;
Var
A:array[1..n,1..n]of integer;
i,j,f,m:integer;

Procedure zapovn;
begin
for і:=1 to n do
for j:=1 to n do
begin
write('A[',І,',',j,']=');
readln(A[І,j]);
end;
end;

Procedure vuvod;
begin
For і:=1 to n do
begin
For j:=1 to n do
Write(A[І,j]:4);
Writeln;
end;
end;

Begin
ClrScr;
Zapovn;
Writeln;
Vuvod;
Writeln;
f:=0;
For і:=1 to n do
begin
m:=0;
For j:=1 to n-1 do
begin
If A[І,j]=A[І,j+1] then
m:=m+1;
end;
if m=n-1 then
writeln('Ryadok ',І,' mae odunakovi znachennya vsix elementiv')
else f:=f+1;
end;
If f=n then
writeln('Matruzya ne mae ryadkiv z odunakovumu znachennyamu vsix elementiv');
ReadLn;
End.

Program z_11_3;
Uses Crt;
Const n=5;
Var
A:array[1..n,1..n]of integer;
i,j,f,m:integer;

Procedure zapovn;
begin
for і:=1 to n do
for j:=1 to n do
begin
write('A[',І,',',j,']=');
readln(A[І,j]);
end;
end;

Procedure vuvod;
begin
For і:=1 to n do
begin
For j:=1 to n do
Write(A[І,j]:4);
Writeln;
end;
end;

Begin
ClrScr;
Zapovn;
Writeln;
Vuvod;
Writeln;
f:=0;
For і:=1 to n do
begin
m:=0;
For j:=1 to n do
begin
If (A[І,j] mod 2)=0 then
m:=m+1;
end;
if m=n then
writeln('Ryadok ',І,' mae parni znachennya vsix elementiv')
else f:=f+1;
end;
If f=n then
writeln('Matruzya ne mae ryadkiv z parnumu znachennyamu vsix elementiv');
ReadLn;
End.

Program z_11_4;
Uses Crt;
Const n=5;
Var
A:array[1..n,1..n]of integer;
i,j,f,m,x,c:integer;k:boolean;

Procedure zapovn;
begin
for і:=1 to n do
for j:=1 to n do
begin
write('A[',І,',',j,']=');
readln(A[І,j]);
end;
end;

Procedure vuvod;
begin
For і:=1 to n do
begin
For j:=1 to n do
Write(A[І,j]:4);
Writeln;
end;
end;

Begin
ClrScr;
Zapovn;
Writeln;
Vuvod;
Writeln;
f:=0;
For і:=1 to n do
begin
m:=0;
For j:=1 to n do
begin
X:=trunc(sqrt(A[І,j]));
K:=false;
c:=2;
while(c<=x) and (not k) do
begin
if (A[І,j] mod c)=0 then
k:=true;
c:=c+1
end;
If not k then
m:=m+1;
end;
if m=n then
writeln('Ryadok ',І,' mae znachennya vsix elementiv – prosti chusla')
else f:=f+1;
end;
If f=n then
writeln('Matruzya ne mae ryadkiv zi znachennyamu vsix elementiv –
prostumu chuslamu');
ReadLn;
End.

Задача 12. Таблиця футбольного чемпіонату подано у вигляді матриці порядка n. Усі елементи її головної діагоналі дорівнюють нулю, а всі інші елементи дорівнюють:
• 2, якщо команда виграла гру;
• 1, якщо гра закінчилась нічиєю;
• 0, у разі програшу команди;
Необхідно визначити:
1. Кількість виграшів та програшів кожної команди;
2. Номери команд, що зіграли всі ігри чемпіонату без жодної поразки;
3. Кількість команд, що мають у чемпіонаті перемог більше, ніж поразок;
4. Номери команд, що виграли більше половини ігор.
Program futbol;
Uses Crt;
Const n=5;
Var
A:array[1..n,1..n]of integer;
iІ,j,Kp,Kv,Nkv,Nkper,Nkvug:integer;

Procedure zapovn;
begin
Randomize;
for і:=1 to n do
for j:=1 to n do
begin
if і=j then
A[І,j]:=0
Else A[І,j]:=random(3);
end;
end;

Procedure vuvod;
begin
For і:=1 to n do
begin
For j:=1 to n do
Write(A[І,j]);
Writeln;
end;
end;

Procedure progr_vugr;
begin
Kp:=0;
Kv:=0;
for і:=1 to n do
begin
for j:=1 to n do
begin
if A[І,j]=2 then
Kv:=Kv+1;
if (A[І,j]=0)and(і<>j) then
Kp:=Kp+1;
end;
Writeln('Komanda ',І,' vugrala ',Kv,', prograla ',Kp);
writeln;
kv:=0;
kp:=0;
end;
end;

Procedure bez_porazok;
begin
kv:=0;
for і:=1 to n do
begin
for j:=1 to n do
begin
if (A[і,j]<>0)and(І<>j) then
Kv:=Kv+1;
end;
if kv=n-1 then
Writeln('Komanda ',І,' zigrala bez porazok');
writeln;
kv:=0;
end;
end;

Procedure kil_kom;
begin
Kp:=0;
Kv:=0;
Nkv:=0;
for і:=1 to n do
begin
for j:=1 to n do
begin
if A[І,j]=2 then
Kv:=Kv+1;
if (A[І,j]=0)and(і<>j) then
Kp:=Kp+1;
end;
if kv>kp then Nkv:=Nkv+1;
kv:=0;
kp:=0;
end;
Writeln(Nkv,' Komand majt peremog bilshe nigh porazok');
writeln;
end;

Procedure nkom_v_b;
begin
kv:=0;
for і:=1 to n do
begin
for j:=1 to n do
begin
if A[і,j]=2 then
Kv:=Kv+1;
end;
if (kv>(n div 2)) then
Writeln('Komanda ',І,' vugrala bilshe polovunu igor');
writeln;
kv:=0;
end;
end;

Begin
ClrScr;
Zapovn;
Writeln;
Vuvod;
Writeln;
progr_vugr;
bez_porazok;
kil_kom;
nkom_v_b;
ReadLn;
End.

Задача 13. У матриці A[1..n,1..n], елементи якої є цілими числами, у кожному рядку необхідно знайти максимальний елемент і помінть його місцями з елементом головної діагоналі матриці, розміщеним у цьому ж рядку.

Program Matr_perest;
Uses Crt;
Const n=5;
Var
A:array[1..n,1..n]of integer;
Max,N_maxi,N_maxj,і,j,t:integer;

Procedure zapovn;
begin
Randomize;
for і:=1 to n do
for j:=1 to n do
begin
A[І,j]:=random(20);
end;
end;

Procedure vuvod;
begin
For і:=1 to n do
begin
For j:=1 to n do
Write(A[І,j]:3);
Writeln;
end;
end;

Procedure perestanovka;
begin
for і:=1 to n do
begin
Max:=A[І,1];
for j:=1 to n do
begin
if A[І,j]>Max then
begin
Max:=A[І,j];
N_maxi:=І;
N_maxj:=j;
end;
end;
for j:=1 to n do
begin
if j=і then
begin
t:=A[і,j];
A[І,j]:=Max;
end;
end;
for j:=1 to n do
begin
A[N_maxi,N_maxj]:=T;
end
N_maxj:=1;
end;
end;

Begin
ClrScr;
Zapovn;
Writeln;
Vuvod;
Writeln;
Perestanovka;
vuvod;
ReadLn;
End.

Задача 14. Для заданої матриці порядку n, визначте діагональ, паралельну головній діагоналі матриці, сума елементів якої має максимальне значення.

Program Matr_max_diag;
Uses Crt;
Const n=5;
Var
A:array[1..n,1..n]of integer;
Max,Sgl,Sd,і,j,t:integer;

Procedure zapovn;
begin
Randomize;
for і:=1 to n do
for j:=1 to n do
begin
A[І,j]:=random(20);
end;
end;

Procedure vuvod;
begin
For і:=1 to n do
begin
For j:=1 to n do
Write(A[І,j]:3);
Writeln;
end;
end;

Procedure Suma_glav;
begin
Sgl:=0;
for і:=1 to n do
for j:=1 to n do
begin
if і=j then
Sgl:=Sgl+A[І,j];
end;
end;

Procedure Suma_d_vg;
begin
Sd:=0;
j:=1+t;
While j<=n do
begin
і:=j-1;
Sd:=Sd+A[І,j];
j:=j+1;
end;
end;

Procedure Suma_d_ng;
begin
Sd:=0;
і:=1+t;
While і<=n do
begin
j:=і-1;
Sd:=Sd+A[І,j];
і:=і+1;
end;
end;

Begin
ClrScr;
Zapovn;
Writeln;
Vuvod;
Writeln;
Suma_glav;
Max:=Sgl;
For t:=1 to n do
begin
Suma_d_vg;
If Sd>max then
Max:=Sd;
end;
For t:=1 to n do
begin
Suma_d_ng;
If Sd>max then
Max:=Sd;
end;
Writeln('Max syma elementiv diagonali paralelnoj golovnij =',max);
ReadLn;
End.

Задача 15. Дан двовимірний масив, який має n рядків, в яких зберігаються кількість різних видів деталей, і 12 стовпців, відповідно місяцям року. Необхідно визначити:
1. Кількість деталей кожного виду, вироблених за рік;
2. Загальну кількість деталей вироблених за k-тий місяць;
3. Номер місяця, коли було вироблено максимальну кількість деталей m-того виду;
4. Загальна кількість деталей вироблених за рік.

Program vurobn;
Uses Crt;
Const
n=5;
m=12;
Var
A:array[1..n,1..m] of integer;
S1,S2,S3,S4,S5,Sst,c1,c2,c3,c4,c5,k,m1,max,N_max,S:integer;

Procedure vvod;
Var
і:1..n;
j:1..m;
begin
Randomize;
for і:=1 to n do
for j:=1 to m do
A[і,j]:=random(90);
end;

Procedure vuvod;
Var
і:1..n;
j:1..m;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5);
writeln;
end;
end;

Procedure Suma_ryadka(c:integer;Var S:integer);
Var
і:1..n;
j:1..m;
begin
S:=0;
for j:=1 to m do
begin
і:=c;
S:=S+A[c,j];
end;
Writeln('S=',S);
end;

Procedure Syma_stovpzya;
Var
і:1..n;
j:1..m;
begin
Sst:=0;
for і:=1 to n do
begin
j:=k;
Sst:=Sst+A[і,k];
end;
Writeln('Sst=',Sst);
end;

Procedure maximym;
Var
і:1..n;
j:1..m;
begin
max:=A[m1,1];
N_max:=1;
for j:=1 to m do
begin
if A[m1,j]>max then
begin
max:=A[m1,j];
N_max:=j;
end;
end;
Writeln('N_misyazya=',N_max);
end;

Procedure Syma;
Var
і:1..n;
j:1..m;
begin
S:=0;
for і:=1 to n do
for j:=1 to m do
S:=S+A[І,j];
Writeln('Vurobleno za rik ',S);
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
C1:=1;
Suma_ryadka(c1,S1);
C2:=2;
Suma_ryadka(c2,S2);
C3:=3;
Suma_ryadka(c3,S3);
C4:=4;
Suma_ryadka(c4,S4);
C5:=5;
Suma_ryadka(c5,S5);
Write('k=');
Readln(k);
Syma_stovpzya;
Write('m1=');
Readln(m1);
maximym;
Syma;
readln;
End.

Задача 16. Елемент двовимірного масивуA[1..n,1..m] називають сідловою точкою, якщо він є найменшим у своєму рядку та одночасно найбільшим у своєму стовпці. Для заданого масиву дійсних чисел, усі елементи якого мають різні значення, визначити індекси його сідловин точок.

Program sidlo;
Uses Crt
Const n=4;m=5;
Var
A:array[1..n,1..m] of real;
min,max:real;І,j,min_і, min_j,max_і,max_j,k:integer;

Procedure vvod;
begin
for j:=1 to m do
begin
write('A[',і,',',j,']=');
readln(A[і,j]);
end;
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5:1);
writeln;
end;
end;

Begin
clrscr;
vvod;
writeln;
vuvod;
writeln;
j:=1;
for j:=1 to m do
begin
max:=A[1,j];
max_і:=1;
max_j:=j;
for і:=1 to n do
begin
if A[І,j]>max then
begin
max:=A[І,j];
max_і:=І;
max_j:=j;
end;
end;
k:=j;
min:=A[max_і,1];
min_j:=1;
і:=max_і;
for j:=1 to m do
begin
if A[і,j]max then
begin
max:=S_D[і];
max_і:=і;
end;
end;
Writeln('Max vidstan - ',max,' - ',max_і);
readln;
End.

Задача 19. Характиристикою стовпця матриці порядка n є сума модулів його від’ємних елементів. Для заданої матриці A[1..n,1..n] елементами якої є дійсні числа, визначити характеристики кожного стовпця. Перемістити стовпці так, щоб вони розміщувались за зростанням характеристик. Вивести на екран змінену матрицю, указавши під кожним стовпцем його характеристику.

Program character_stovp;
Uses Crt;
Const
n=4;
m=5;
Var
A:array[1..n,1..n] of real;
B:array[1..m,1..n] of real;
Min,T:real;І,j,Nmin,k:integer;

Procedure vvod;
begin
for і:=1 to n do
for j:=1 to n do
begin
write('A[',І,',',j,']=');
readln(A[І,j]);
end;
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
for j:=1 to n do
write(A[і,j]:6:2);
writeln;
end;
end;

Begin
Clrscr;
vvod;
writeln;
vuvod;
writeln;
for j:=1 to n do
begin
B[m,j]:=0;
for і:=1 to n do
begin
B[і,j]:=A[і,j];
if A[І,j]<0 then
B[m,j]:=B[m,j]+abs(A[І,j]);
end;
end;
for і:=1 to m do
begin
for j:=1 to n do
write(B[і,j]:6:2);
writeln;
end;
writeln;
j:=1;
while j0)and(A[x-1,y]=1) then
scolor(x-1,y,c);
If (y>0)and(A[x,y-1]=1) then
scolor(x,y-1,c);
If (x ',c-1 );
for і:=1 to n do
begin
for j:=1 to m do
begin
write (A[і,j]:4);
end;
writeln;
end;
readln;
End.

Задача 22. Латинським квадратом називається матриця порядка n, кожний рядок та кожний стовпець якої містить усі натуральні числа від 1 до n. Необхідно перевірити чи є даний масив A[1..n,1..n] латинським квадратом.

Program lat_kvadrat;
Uses CRT;
Const n=5;
Var
A:array[1..n,1..n]of integer;
і,j:integer;
f,f1:boolean;

Procedure vvod;
begin
for і:=1 to n do
for j:=1 to n do
begin
write('A[',І,',',j,']=');
readln(A[І,j]);
end;
end;

Procedure vuvod;
begin
for і:=1 to n do
begin
for j:=1 to n do
write(A[і,j]:4);
writeln;
end;
end;

Procedure Findstr(x,znach:integer);
Var
k:integer;
begin
For k:=x to n do
If A[і,k]=znach then
begin
f:=true;
end;
end;

Procedure Findcol(y,znach:integer);
Var
k:integer;
begin
For k:=y to n do
If A[k,j]=znach then
begin
f:=true;
end;
end;

Begin
Clrscr;
vvod;
writeln;
vuvod;
writeln;
f:=false;
f1:=false;
For і:=1 to n-1 do
For j:=1 to n-1 do
begin
Findstr(j+1,A[і,j]);
if f=true then f1:=false
else f1:=true;
Findcol(і+1,A[і,j]);
if f=true then f1:=false
else f1:=true;
end;
if f1=true then
writeln('yes, matruzja - latunskuj kvadrat')
else
writeln('No, matruzja - ne latunskuj kvadrat');
readln;
End.

Задача 23.1 Необхідно визначити та вивести на екран перші 10 рядків трикутника Паскаля. У першому рядку трикутника Паскаля записується 1, крайніми елементами кожного наступного рядка також будуть одиниці. Значення будь-якого іншого елемента рядка дорівнює сумі значень сусідніх елементів попереднього рядка. Кількість елементів в рядку визначається його номером.

Program Paskal_Truk;
Uses CRT;
Const
n=10;
m=19;
Var
A:array[1..n,1..m] of integer;
і,j,Summa:integer;

Begin
Clrscr;
For j:=1 to m do
if j=n then a[1,j]:=1
else A[1,j]:=0;
For і:=2 to n do
for j:=1 to m do
begin
Summa := 0;
if (j>1) and (j0 then
a[і,j]:=0
else
begin
s2:=s2+A[і-1,j-1];
a[і,j]:=s2;
end;
end
end;
end;
For і:=1 to n do
begin
for j:=1 to m do
write(A[і,j]:5);
writeln;
writeln;
end;
readln;
End.

Задача 24. На прямокутному ігровому полі розміром n x m , розбитому на клітинки, розміщено «змію» – неперервну ламану, шириною в одну клітинку, яка може згинатися лише на кут 900. «Змія» ніде себе не перетинає і не дотикається різними часинами, крім, можливо, «головою» до кінця»хвоста». «Змія» може утворювати на ігровому полі замкнутий або розімкнутий контур. Інформацію про розміщення «змії» задано цілочисловим масивом Z[1..n,1..m], у якому значення елемента дорівнює:
• 1, якщо клітинка поля належить»змії»;
• 0, якщо клітинка не зайнята «змією».
Необхідно визначити, чи утворює «змія» замкнутий контур.

Program zmija;
Uses CRT;
Const
n =5 ;
m=5;
Var
A:array [ 1..n,1..m ] of integer;
і,j,c,k,z:integer;

Procedure scolor(x,y,c:integer);
begin
A[x,y]:=c;
If (x>0)and(A[x-1,y]=1) then
scolor(x-1,y,c);
If (y>0)and(A[x,y-1]=1) then
scolor(x,y-1,c);
If (x=48)and(kod<=57) then X:=1
Else X:=0;
Cifra:=x;
end;

Function Mala_Lat (c:char):byte;
Var
x:byte;
begin
Kod:=ord(c);
If (kod>=97)and(kod<=122) then X:=1
Else X:=0;
Mala_Lat:=x;
end;

Function Mala_Kur (c:char):byte;
Var
x:byte;
begin
Kod:=ord(c);
If ((kod>=160)and(kod<=175))or
((kod>=224)and(kod<=239))or
((kod>=241)and(kod<=245)) then
X:=1
Else X:=0;
Mala_Kur:=x;
end;

Function Mal_Lat_Kur (c:char):byte;
Var
x:byte;
begin
Kod:=ord(c);
If ((kod>=97)and(kod<=122))or
((kod>=160)and(kod<=175))or
((kod>=224)and(kod<=239))or
(kod>=241)or(kod=243)or(kod<=245) then
X:=1
Else X:=0;
Mal_Lat_Kur:=x;
end;

Function Vel_Lat_Kur (c:char):byte;
Var
x:byte;
begin
Kod:=ord(c);
If ((kod>=65)and(kod<=90))or
((kod>=128)and(kod<=159))or
(kod=240)or(kod=244) then
X:=1
Else X:=0;
Vel_Lat_Kur:=x;
end;

Function Lat_Kur (c:char):byte;
Var
x:byte;
begin
Kod:=ord(c);
If ((kod>=65)and(kod<=90))or
((kod>=97)and(kod<=122))or
((kod>=128)and(kod<=159))or
(kod=240)or(kod=244)or
((kod>=160)and(kod<=175))or
((kod>=224)and(kod<=239))or
(kod=241)or(kod=243)or(kod=245) then
X:=1
else X:=0;
Lat_Kur:=x;
end;

Begin
Clrscr;
Window(1,1,80,25);
Textbackground(0);
Clrscr;
Window(2,2,78,16);
Textbackground(blue);
Clrscr;
GoToXY(28,2);
TextColor(14);
Write(#201);
Write(#205,#205,#200,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205);
Write(#205,#205,#205,#205,#205,#205,#205,#205,#205);
Write(#187);
GoToXY(30,3);
TextColor(14);
Write('Oberit nomer zavdannya:');
GoToXY(28,3);
TextColor(14);
write(#186);
GoToXY(53,3);
TextColor(14);
write(#186);
GoToXY(28,4);
TextColor(14);
write(#200);
Write(#205,#205,#200,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205);
Write(#205,#205,#205,#205,#205,#205,#205,#205,#205);
GoToXY(53,4);
TextColor(14);
write(#188);
GoToXY(25,6);
TextColor(15);
write('1 - desyatkova cifra');
GoToXY(25,7);
write('2 - mala litera latunuzi');
GoToXY(25,8);
write('3 - mala litera kuruluzi');
GoToXY(25,9);
write('4 - mala litera latunuzi chu kuruluzi');
GoToXY(25,10);
write('5 - veluka litera latunuzi chu kuruluzi');
GoToXY(25,11);
write('6 - litera latunuzi chu kuruluzi');
GoToXY(20,14);
write('Vash vubir:',n);
readln(n);
Window(1,18,80,25);
Textbackground(7);
Clrscr;
Window(3,20,20,22);
Textbackground(2);
Clrscr;
GoToXY(4,21);
TextColor(14);
Write(#201,#205,#200,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205);
write(#187);
write(' ');
TextColor(14);
Write(#186,' Sumvol: ',#186,' ');
readln(c);
write(#200,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#188);
Window(60,20,77,22);
Textbackground(4);
clrscr;
write(#201,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#187);
write(' ');
TextColor(14);
Write(#186,' Rezyltat: ',#186,' ');
Case n of
1:writeln(Cifra(c));
2:writeln(Mala_Lat(c));
3:writeln(Mala_Kur(c));
4:writeln(Mal_Lat_Kur(c));
5:writeln(Vel_Lat_Kur(c));
6:writeln(Lat_Kur(c));
end;
write(#200,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#205,#188);
Window(1,26,80,50);
Textbackground(0);
Clrscr;
Readln;
End.

Задача 2. Необхідно розробити функції, до функції UpCase. Функція повинна заміняти велику латинську літеру, що буде її аргументом на малу. Якщо символ не є великою літерою латиниці, функція її не замінює.

Program Obern_UpCase;
Uses Crt;
Var
c,c1:char;

Function Vel_Lat_Mal (c:char):char;
Var
x,x1:byte;
begin
x:=ord(c);
If ((x>=65)and(x<=90)) then
begin
x1:=x+32;
C1:=chr(x1);
end
Else writeln(‘Sumvol ne veluka litera latunuzi’);
Vel_Lat_Mal:=C1;
end;

Begin
Clrscr;
Write(‘yvedit sumvol=>’);
Readln( c) ;
Vel_Lat_Mal(c);
Writeln( c1);
Readln;
End.

Задача 3. Необхідно вивести на екран наступні послідовності символів;
1. ABBCCCDDDD…ZZZZ…ZZ;
2. ABC…ZBBCC…ZZCCCDDD…ZZZ…
3. AZBYCXDW…

Program vuvod_Simv_1;
Uses Crt;
Var
і,n:byte;

Begin
Clrscr;
for і:=65 to 90 do
begin
n:=і-64;
while n>0 do
begin
write(chr(і));
n:=n-1;
end;
end;
Readln;
End.

Program vuvod_Simv_2;
Uses CRT;
Var
і,t,n,m,k:integer;

Begin
clrscr;
n:=1;
while n<=26 do
begin
for і:=64+n to 90 do
begin
k:=1;
m:=n;
while m>0 do
begin
Write( chr(і) );
m:=m-1;
end;
end;
n:=n+1;
end;
Readln;
End.

Program vuvod_Simv_3;
Uses CRT;
Var
і,t:integer;

Begin
Clrscr;
і:=65;
t:=90;
While (і<=77)and(t>=78) do
begin
Write(chr(і));
Write(chr(t));
і:=і+1;
T:=t-1;
end;
readln;
End.

Задача 4. Необхідно визначити кількість цифр в довільній послідовності символів уведених користувачем.

Program Kil_Cifr;
Uses CRT;
Const n=10;
Var
і,k,m : integer;
C:array[1..n] of char;

Begin
Clrscr;
for і:=1 to n do
Read(C[і]);
k:=0;
і:=1;
for і:=1 to n do
begin
m:=ord(C[і]);
If (m>=48)and(m<=57)and(m<>0) then k:=k+1;
end;
WriteLn( k );
readln;
End.

Завдання для самостійної роботи
1. Вивести в один рядок АаБбВвГг.

2. Запитайте у користувача символ і виведіть на екран 5 символів, наступних за ним в таблиці американських стандартних кодів обміну інформацією. Перевірте, чи є серед них розділові знаки.

3. Запитайте у користувача символ і виведіть на екран 5 символів, що передують даному в таблиці американських стандартних кодів обміну інформацією. Перевірте, чи є серед них знаки найпростіших математичних дій.

4. Вивести в один рядок ZYY ... AA ... A.

5. Складіть програму, яка перевіряє, чи є введений символ буквою латинського алфавіту або дужкою (врахувати круглі, фігурні та квадратні дужки).

6. Запитайте у користувача декілька символів і виведіть на екран їх коди. Перевірте, чи є вони літерами.

7. Вивести трикутник:
Аяяяяяяяя ... я
Бюююю ... ю
Вееееее ... е. . .
Еввв
Юбб
Яа.

8. Вивести трикутник:
A B C ... Y Z
B C ... Y Z
C ... Y Z

8. Рядки
Рядок (string) - це послідовність літер.

Тип даних (string) визначає рядки з максимальною довжиною 255 символів. Змінна цього типу може приймати значення змінної довжини.

Рядкова змінна може мати атрибут довжини, що визначає її максимальну довжину.
Поточна довжина строкової змінної може бути визначена за допомогою вбудованої функції Length, для заданого значення типу string ця функція повертає ціле значення, що показує кількість літер у рядку.

Вирази, в яких операндами служать рядки, називаються рядковими виразами.

Над рядками визначені дві операції:
1. Операція об’єднання (+) застосовується для зчеплення декількох рядків в один.

Наприклад,
SumStr: = 'Турбо' + 'Паскаль' + '7 .0 '

2. Операції відносини (=, <>,>, <,> =, <=) проводять порівняння двох рядків зліва направо до першого неспівпадаючого символу, і той рядок вважається більше, в якому перший неспівпадаючий символ має більший номер в стандартній таблиці обміну інформацією. Результат виконання операцій відношення над рядками завжди має булевой тип.

Наприклад,
вираз «MS-DOS '<' MS-Dos 'має значення True

Якщо рядки мають різну довжину, але в загальній частині символи збігаються, вважається, що більш короткий рядок менший, ніж довший.
Рядки вважаються рівними, якщо вони збігаються по довжині і містять одні й ті ж символи на відповідних місцях в рядку.
Для присвоювання рядковій змінні результату рядкового виразу використовується оператор присвоювання. Якщо значення змінної після виконання оператора присвоювання перевищує по довжині максимально допустиму при описі величину, то всі зайві символи справа відкидаються.
Допускається змішування в одному виразі операндів рядкового і символьного типу.
До окремих символів рядка можна звернутися за номером (індексом) даного символу в рядку.

Для обробки рядових даних можна використовувати вбудовані процедури і функції:

1. Delete (Str, Poz, N) - видалення N символів рядка Str, починаючи з позиції Poz.

2. Insert (What, Where, Poz) - вставка рядка What в рядок Where, починаючи з позиції Poz.

3. Copy (Str, Poz, Nstr) - виділяє рядок довжиною Nstr, починаючи з позиції Poz, з рядка Str.

4. Concat (Str1, Str2,..., StrN) - виконує зчеплення рядків у тому порядку, в якому вказані в списку параметрів.

5. Poz (What, Where) - виявляє перша поява підрядка What в рядку Where.

6. UpCase (Ch) - перетворює малу літеру в прописну.

7. Str (Number, Stroka) - перетворює число в рядок.

8. Val (Stroka, Number, Code) - перетворює рядок у число і видає код правильності перетворення.

Задача 1. Дано довільний текстовий фрагмент, довжина якого не перевищує 255 символів. Необхідно визначити та вивести на екран:
1. Окремі слова, з яких складається текстовий фрагмент;
2. Кількість слів у тексті;
3. Найдовше слово в тексті та його довжину;
4. Кількість літер а, шо містить найдовше слово;
5. Кількість слів, у яких перший символ збігається з останнім;
6. Будь-яке слово, що починається з літери, яку вводить користувач.

Program slovo_1;
Uses CRT;
Const n=126;
Var
S:string;
M_sl:array[1..n] of string;
R,dov,І,j:integer;

Begin
Clrscr;
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
j:=1;
While dov<>0 do
begin
While (S[1]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
R:=Pos(' ',S);
If r<>0 then
begin
M_sl[j]:=copy(S,1,r-1);
Delete(S,1,r);
Dov:=length(S);
j:=j+1;
end
Else
begin
M_sl[j]:=S;
Dov:=0;
end;
end;
For j:=1 to j do
If M_sl[j]<>' ' then
Writeln (M_sl[j]);
Readln;
End.

Program slovo_2;
Uses CRT;
Const n=126;
Var
S:string;
M_sl:array[1..n] of string;
R,dov,І,j:integer;

Begin
Clrscr;
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
j:=1;
While dov<>0 do
begin
While (S[1]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
R:=Pos(' ',S);
If r<>0 then
begin
M_sl[j]:=copy(S,1,r-1);
Delete(S,1,r);
Dov:=length(S);
j:=j+1;
end
Else
begin
M_sl[j]:=S;
Dov:=0;
end;
end;
For j:=1 to j do
If M_sl[j]<>' ' then
Writeln (M_sl[j]);
writeln ('Kilkist sliv y teksti: ',j);
Readln;
End.

Program slovo_3;
Uses CRT;
Const n=126;
Var
S:string;
M_sl:array[1..n] of string;
R,dov,І,j:integer;

Begin
Clrscr;
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
j:=1;
While dov<>0 do
begin
While (S[1]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
R:=Pos(' ',S);
If r<>0 then
begin
M_sl[j]:=copy(S,1,r-1);
Delete(S,1,r);
Dov:=length(S);
j:=j+1;
End
Else
begin
M_sl[j]:=S;
Dov:=0;
end;
end;
For j:=1 to j do
If M_sl[j]<>' ' then
Writeln (M_sl[j]);
writeln ('Kilkist sliv y teksti: ',j);
if M_sl[j]<>' ' then
begin
max:=length(M_sl[1]);
N_max:=1;
for j:=2 to j do
if length(M_sl[j])> max then
begin
max:=length(M_sl[j]);
n_max:=j;
end;
end;
writeln ('Maksumalna dovghuna slova: ',max);
writeln ('Nomer slova maksumalnoj dovghunu: ',n_max);
Readln;
End.

Program slovo_4;
Uses CRT;
Const n=126;
Var
S:string;
M_sl:array[1..n] of string;
R,dov,І,j,max,n_max,k,m:integer;

Begin
Clrscr;
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
j:=1;
While dov<>0 do
begin
While (S[1]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
R:=Pos(' ',S);
If r<>0 then
begin
M_sl[j]:=copy(S,1,r-1);
Delete(S,1,r);
Dov:=length(S);
j:=j+1;
end
Else
begin
M_sl[j]:=S;
Dov:=0;
end;
end;
for j:=1 to j do
If M_sl[j]<>' ' then
Writeln (M_sl[j]);
writeln ('Kilkist sliv y teksti: ',j);
if M_sl[j]<>' ' then
begin
max:=length(M_sl[1]);
N_max:=1;
for j:=2 to j do
if length(M_sl[j])> max then
begin
max:=length(M_sl[j]);
n_max:=j;
end;
end;
m:=0;
for k:=1 to max do
begin
if M_sl[n_max][k]='a' then m:=m+1;
end;
writeln ('Maksumalna dovghuna slova: ',max);
writeln ('Nomer slova maksumalnoj dovghunu: ',n_max);
writeln ('V najdovshe slovo litera a vxodut: ',m,' raz');
Readln;
End.

Program slovo_5;
Uses crt;
Const n=126;
Var
S:string;
M_sl:array[1..n] of string;
R,dov,І,j,m:integer;

Begin
clrscr;
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
j:=1;
While dov<>0 do
begin
While (S[1]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
R:=Pos(' ',S);
If r<>0 then
begin
M_sl[j]:=copy(S,1,r-1);
Delete(S,1,r);
Dov:=length(S);
j:=j+1;
end
Else
begin
M_sl[j]:=S;
Dov:=0;
end;
end;
for j:=1 to j do
If M_sl[j]<>' ' then
Writeln (M_sl[j]);
writeln ('Kilkist sliv y teksti: ',j);
if M_sl[j]<>' ' then
begin
m:=0;
for j:=1 to j do
if M_sl[1] =M_sl[j] then
begin
m:=m+1;
end;
end;
writeln ('Sliv, y yakuch persha litera zbigajtsya z ostannjoj: ',m,' raz');
Readln;
End.

Program slovo_6;
Uses crt;
Const n=126;
Var
S,s1:string;
M_sl:array[1..n] of string;
R,dov,І,j,max,n_max,k,m:integer;

Begin
clrscr;
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit sumvol =>');
Readln(s1);
Dov:=length(S);
j:=1;
While dov<>0 do
begin
While (S[1]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
R:=Pos(' ',S);
If r<>0 then
begin
M_sl[j]:=copy(S,1,r-1);
Delete(S,1,r);
Dov:=length(S);
j:=j+1;
end
Else
begin
M_sl[j]:=S;
Dov:=0;
end;
end;
for j:=1 to j do
If M_sl[j]<>' ' then
Writeln (M_sl[j]);
writeln ('Kilkist sliv y teksti: ',j);
if M_sl[j]<>' ' then
begin
m:=0;
for j:=1 to j do
begin
for і:=1 to 1 do
begin
if M_sl[j][1] = s1 then
begin
m:=m+1;
writeln('Znajdene slovo: ',M_sl[j]) ;
end;
end;
if m=0 then writeln('Take slovo v teksti vidsytnj');
end;
end;
Readln;
End.

Задача 2. Дано довільний текстовий рядок, визначити чи є рядок симетричним, а може він і паліндромом.

Program palidrom;
Uses crt;
Const n=126;
Var
S:string;
r,dov,І,k,l,m,p:integer;

Begin
clrscr;
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
r:=0;
for і:=1 to dov do
begin
if s[і] =' ' then
r:=r+1;
end;
l:=r;
і:=1;
while (l<>0)and(dov<>0) do
begin
p:=pos(' ',s);
delete(s,p,1);
l:=l-1;
і:=і+1;
end;
dov:=length(s);
k:=dov div 2;
m:=0;
for і:=1 to k do
begin
if S[І]=S[dov-і+1] then
m:=m+1;
end;
if m=k then
begin
writeln('Ryadok - cumetruchnuj');
if (r mod 2)=0 then
writeln('Ryadok - palidrom')
else writeln('Ryadok - ne palidrom');
end
else writeln('Ryadok - ne cumetruchnuj');
Readln;
End.

Задача 3. Кожна літера тексту замінюється на літеру, яка знаходиться від початкової в абетці на відстані числа шифру. Зашифрувати введений рядок тексту.

Program shufr;
Const n=126;
Var
S:string;
dov,І,k,l,m:integer;
s1:array[1..n] of char;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit chuclo shufry =>');
Readln(m);
Dov:=length(S);
for і:=1 to dov do
begin
s1[і]:=s[і];
l:=ord(s1[і]);
if l<>32 then
begin
k:=l+m;
s1[і]:=chr(k);
s[і]:=s1[і];
end;
end;
writeln(s);
Readln;
End.

Задача 4. Кожна літера тексту замінюється на літеру, яка знаходиться від початкової в абетці на відстані числа шифру. Розшифруйте введений рядок тексту.

Program rozshufr;
Const n=126;
Var
S:string;
dov,І,k,l,m:integer;
s1:array[1..n] of char;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit chuclo shufry =>');
Readln(m);
Dov:=length(S);
for і:=1 to dov do
begin
s1[і]:=s[і];
l:=ord(s1[і]);
if l<>32 then
begin
k:=l-m;
s1[і]:=chr(k);
s[і]:=s1[і];
end;
end;
writeln(s);
Readln;
End.

Задача 5. Необхідно розробити програму, яка отримавши рядок, що містить шлях до файлу, записаний за стандартами ОС Windows, перетворює цей шлях відповідно до стандарту ОС Unix, тобто замінює в рядку всі символи ‘/’ на символи ‘\’.

Program zam_W_U;
Const
n=126;
s1='\';
Var
S:string;
dov,І:integer;

Begin
Write('Yvedit shlyach do faily v Windows=>');
Readln(S);
Dov:=length(S);
for і:=1 to dov do
begin
if s[і]='/' then
begin
Delete(s,і,1);
Insert(s1,s,і);
end
end;
writeln(s);
Readln;
End.

Задача 6. Необхідно розробити програму, яка отримавши рядок, що містить шлях до файлу, записаний за стандартами ОС Windows, перетворює цей шлях відповідно до стандарту, що використовує фірма Borland, тобто замінює в рядку всі символи ‘/’ на символи ‘\\’.

Program zam_W_B;
Const
n=126;
s1='\\';
Var
S:string;
dov,І:integer;

Begin
Write('Yvedit shlyach do faily v Windows=>');
Readln(S);
Dov:=length(S);
for і:=1 to dov+1 do
begin
if s[і]='/' then
begin
Delete(s,і,1);
Insert(s1,s,і);
end
end;
writeln(s);
Readln;
End.

Задача 7. Необхідно вивести на екран слово, уведене користувачем (складається з літер української абетки), замінюючи в ньому кожну літеру її номером в українській абетці та відділяючи ці номери символом пропуску.

Program zam_l_z;
Const
n=126;
s1=' ';
Var
S,s2:string;
dov,dov1,І,l,m:integer;

Begin
Write('Yvedit slovo=>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
l:=ord(s[і]);
m:=l-223;
str(m,s2);
dov1:=length(s2);
delete(s,і,1);
insert(s2,s,і);
insert(s1,s,і+dov1);
і:=і+dov1+1;
WriteLn( і );
dov:=dov-1;
end;
write(s);
Readln;
End.

Задача 8. В текстовому фрагменті є одна дужка (, що відкривається, та одна дужка ), що закривається. Виведіть на екран символи, розміщені в дужках.

Program vstav_v_dyghku;
Const n=126;
Var
S,s1:string;
dov,dov1,І,k,l,m:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit fragment v dyghkax =>');
Readln(s1);
Dov:=length(S);
dov1:=length(s1);
for і:=1 to dov do
begin
if s[і]='(' then
insert(s1,s,і+1);
end;
writeln(s);
Readln;
End.

Задача 9. В текстовому повідомленні є помилки. Якщо виявлена помилка, то в тексті розміщується символ #, який вказує що попередню до нього літеру потрібно видалити. Якщо в тексті трапляється декілька символів #, їх число визначає, скільки символів до цього треба видалити. Необхідно вивести на екран повідомлення без помилок.

Program pomulku_text;
Const n=126;
Var
S,s1:string;
dov,dov1,І,k,l,m:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while і<=dov do
begin
if s[і]='#' then
begin
delete(s,і-1,2);
dov:=dov-2;
і:=і-1;
if s[1 ]='#' then
begin
delete(s,1,1);
dov:=dov-1;
end;
end
else і:=і+1;
end;
writeln(s);
Readln;
End.

Задача 10. Дано рядок, що містить довільний текст, який закінчується крапкою. Виведіть на екран слова цього тексту, що складаються з чотирьох символів.

Program slovo_4sumv;
Const n=126;
Var
S,s1:string;
M_sl:array[1..n] of string;
R,dov,І,j:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
j:=1;
і:=0;
While dov<>0 do
begin
While (S[1]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
R:=Pos(' ',S);
If r=5 then
begin
M_sl[j]:=copy(S,1,r-1);
writeln(M_sl[j]);
Delete(S,1,r);
Dov:=length(S);
end
Else
begin
if r<>0 then
begin
delete(s,1,r);
Dov:=length(s);
end
else dov:=0;
end;
end;
Readln;
End.

Задача 10. Пропуск вважається зайвим, якщо він розміщується на початку рядка, у кінці рядка, за іншим пропуском. Необхідно з рядка видалити лишні пропуски.

Program del_propysk;
Const n=126;
Var
S,s1,s2:string;
R,dov:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
while dov<>0 do
begin
While (S[1]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
R:=Pos(' ',S);
if (r<>0) then
begin
s1:=copy(s,1,r);
write(s1);
delete(s,1,r);
dov:=length(s);
end
else
begin
s1:=copy(s,1,dov);
write(s1);
dov:=length(s);
end;
end;
Readln;
End.

Program Lush_probel;
Var
s: string;
і:integer;

Begin
write('String: ');
readln(s);
і := 1;
repeat
if copy(s,і,2)=' ' then
s := copy(s,1,і) + copy(s,і+2,length(s))
else
і := і + 1
until (і > length(s));
writeln('String: ', s);
readln
End.

Задача 11. Довільний текстовий фрагмент складається зі слів, розділених довільною кількістю пропусків. Необхідно вивести ці слова, але розмістити їх у тексті в оберненому порядку, тобто слово, що було першим, буде виведено останнім, друге слово - передостаннім.

Program fraza_navpaku;
Const n=126;
Var
S,s1,s2:string;
R,dov,і:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
For і:=dov downto 1 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,dov-1,1);
Dov:=length(S);
end;
if (s[і]=' ')then
begin
s1:=copy(s,і+1,dov);
r:=length(s1);
insert(' ',s1,r+1);
write(s1);
delete(s,і,dov-і+1);
dov:=length(s);
end;
if і=1 then
begin
s1:=copy(s,1,dov);
write(s1);
delete(s,1,dov);
end;
end;
readln;
End.

Задача 12. Довільний текстовий фрагмент складається зі слів, розділених довільною кількістю пропусків. Необхідно вивести ці слова, що входять до цього фрагменту, розмістивши їх у порядку зростання кількості символів.

Program sort_rjadku;
Type slov = array [1..10] of string;
Var
p,b : string;
s : slov;
r,і,j,l,dov : integer;
q : boolean;

Procedure maxdl( ii,jj : integer;ss : slov; Var ll : integer );
Var
t:integer;m:string;
begin
m:=ss[ii];
ll:=ii;
for t:=ii+1 to jj do
if length(m)>length(ss[t]) then
begin
m:=ss[t];
ll:=t;
end;
end;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(p);
Dov:=length(p);
і:=1;
j:=1;
while dov<>0 do
begin
while (p[dov]=' ')and(dov<>0) do
begin
Delete(p,1,1);
Dov:=length(p);
end;
r:=pos(' ',p);
if r<>0 then
begin
s[j]:=copy(p,1,r);
delete(p,1,r);
dov:=length(p);
і:=і+1;
end
else
begin
s[j]:=p;
dov:=0;
end;
j:=j+1;
end;
b:='';
for і:=1 to j do
begin
maxdl(і,j,s,l);
b:=s[і];
s[і]:=s[l];
s[l]:=b;
end;
end;

Задача 13. Для даного тексту необхідно визначити та вивести на екран:
1. Слова, що мають уведену користувачем довжину;
2. Слова, що починаються та закінчуються однаковою літерою;
3. Слова, починаються (закінчуються) літерою, визначеною користувачем;
4. Слова, до складу яких входить задана кількість уведеної користувачем літери;
5. Слова, що починаються голосною (приголосною) літерою;
6. Слова, що починаються голосною (приголосною) літерою та закінчуються приголосною (голосною);
7. Слова, що починаються з великої літери;
8. Слова, у яких кількість літер парна (непарна);
9. Найдовше (найкоротше) слово;
10. Середнє арифметичне довжин усіх слів та слово, довжина якого найбільш близька до цієї середньої довжини.

Program z_13_1;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,dov1,dov2:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit dovghuny slova =>');
Readln(dov1);
Dov:=length(S);
For і:=1 to dov do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov2:=length(s1);
delete(s,1,r);
dov:=length(s);
if dov2=dov1 then
write(s1,' ');
end
else
begin
s1:=s;
dov2:=length(s1);
if dov2=dov1 then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_2;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,dov1,dov2:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
For і:=1 to dov do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,dov-1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov2:=length(s1);
delete(s,1,r);
dov:=length(s);
if s1[1]=s1[dov2] then
write(s1,' ');
end
else
begin
s1:=s;
dov2:=length(s1);
if s1[1]=s1[dov2] then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_31;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,dov1,dov2:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit litery =>');
Readln(s2);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov2:=length(s1);
delete(s,1,r);
dov:=length(s);
if s1[1]=s2 then
write(s1,' ');
і:=і+1
end
else
begin
s1:=s;
dov2:=length(s1);
if s1[1]=s2 then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_32;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,dov1,dov2:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit litery =>');
Readln(s2);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov2:=length(s1);
delete(s,1,r);
dov:=length(s);
if s1[dov2]=s2 then
write(s1,' ');
і:=і+1
end
else
begin
s1:=s;
dov2:=length(s1);
if s1[dov2]=s2 then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_4;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,dov1,k,m:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit litery =>');
Readln(s2);
Write('Yvedit kilkist zux liter =>');
Readln(k);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
delete(s,1,r);
dov:=length(s);
m:=0;
for j:=1 to dov1 do
if s1[j]=s2 then
m:=m+1;
if m=k then
write(s1,' ');
і:=і+1
end
else
begin
s1:=s;
dov1:=length(s1);
m:=0;
for j:=1 to dov1 do
if s1[j]=s2 then
m:=m+1;
if m=k then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_51;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,dov1:integer;
golosna:array[1..10] of char;

Begin
golosna[1]:='а';
golosna[2]:='е';
golosna[3]:='є';
golosna[4]:='и';
golosna[5]:='і';
golosna[6]:='ї';
golosna[7]:='о';
golosna[8]:='у';
golosna[9]:='ю';
golosna[10]:='я';
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
delete(s,1,r);
dov:=length(s);
for j:=1 to 10 do
if s1[1]=golosna[j] then
write(s1,' ');
і:=і+1
end
else
begin
s1:=s;
dov1:=length(s1);
for j:=1 to 10 do
if s1[1]=golosna[j] then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_52;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,dov1:integer;
prugolosna:array[1..22] of char;

Begin
prugolosna[1]:='б';
prugolosna[2]:='в';
prugolosna[3]:='г';
prugolosna[4]:='д';
prugolosna[5]:='ж';
prugolosna[6]:='з';
prugolosna[7]:='й';
prugolosna[8]:='к';
prugolosna[9]:='л';
prugolosna[10]:='м';
prugolosna[11]:='н';
prugolosna[12]:='п';
prugolosna[13]:='р';
prugolosna[14]:='с';
prugolosna[15]:='т';
prugolosna[16]:='ф';
prugolosna[17]:='х';
prugolosna[18]:='ц';
prugolosna[19]:='ч';
prugolosna[20]:='ш';
prugolosna[21]:='щ';
prugolosna[22]:='ь';
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
delete(s,1,r);
dov:=length(s);
for j:=1 to 22 do
if s1[1]=prugolosna[j] then
write(s1,' ');
і:=і+1
end
else
begin
s1:=s;
dov1:=length(s1);
for j:=1 to 22 do
if s1[1]=prugolosna[j] then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_61;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,k,dov1:integer;
golosna:array[1..10] of char;
prugolosna:array[1..22] of char;

Begin
golosna[1]:='а';
golosna[2]:='е';
golosna[3]:='є';
golosna[4]:='и';
golosna[5]:='і';
golosna[6]:='ї';
golosna[7]:='о';
golosna[8]:='у';
golosna[9]:='ю';
golosna[10]:='я';
prugolosna[1]:='б';
prugolosna[2]:='в';
prugolosna[3]:='г';
prugolosna[4]:='д';
prugolosna[5]:='ж';
prugolosna[6]:='з';
prugolosna[7]:='й';
prugolosna[8]:='к';
prugolosna[9]:='л';
prugolosna[10]:='м';
prugolosna[11]:='н';
prugolosna[12]:='п';
prugolosna[13]:='р';
prugolosna[14]:='с';
prugolosna[15]:='т';
prugolosna[16]:='ф';
prugolosna[17]:='х';
prugolosna[18]:='ц';
prugolosna[19]:='ч';
prugolosna[20]:='ш';
prugolosna[21]:='щ';
prugolosna[22]:='ь';
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
for j:=1 to 22 do
begin
if s1[dov1]=prugolosna[j] then
begin
for k:=1 to 10 do
if s[1]=golosna[k] then
write(s1,' ');
end;
end;
delete(s,1,r);
dov:=length(s);
і:=і+1
end
else
begin
s1:=s;
dov1:=length(s1);
for j:=1 to 22 do
begin
if s1[dov1]=prugolosna[j] then
begin
for k:=1 to 10 do
if s[1]=golosna[k] then
write(s1,' ');
end;
end;
dov:=0;
end;
end;
readln;
End.

Program z_13_62;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,k,dov1:integer;
golosna:array[1..10] of char;
prugolosna:array[1..22] of char;

Begin
golosna[1]:='а';
golosna[2]:='е';
golosna[3]:='є';
golosna[4]:='и';
golosna[5]:='і';
golosna[6]:='ї';
golosna[7]:='о';
golosna[8]:='у';
golosna[9]:='ю';
golosna[10]:='я';
prugolosna[1]:='б';
prugolosna[2]:='в';
prugolosna[3]:='г';
prugolosna[4]:='д';
prugolosna[5]:='ж';
prugolosna[6]:='з';
prugolosna[7]:='й';
prugolosna[8]:='к';
prugolosna[9]:='л';
prugolosna[10]:='м';
prugolosna[11]:='н';
prugolosna[12]:='п';
prugolosna[13]:='р';
prugolosna[14]:='с';
prugolosna[15]:='т';
prugolosna[16]:='ф';
prugolosna[17]:='х';
prugolosna[18]:='ц';
prugolosna[19]:='ч';
prugolosna[20]:='ш';
prugolosna[21]:='щ';
prugolosna[22]:='ь';
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
End;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
for j:=1 to 22 do
begin
if s1[1]=prugolosna[j] then
begin
for k:=1 to 10 do
if s[dov1]=golosna[k] then
write(s1,' ');
end;
end;
delete(s,1,r);
dov:=length(s);
і:=і+1
end
else
begin
s1:=s;
dov1:=length(s1);
for j:=1 to 22 do
begin
if s1[1]=prugolosna[j] then
begin
for k:=1 to 10 do
if s[dov1]=golosna[k] then
write(s1,' ');
end;
end;
dov:=0;
end;
end;
readln;
End.

Program z_13_7;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,dov1:integer;
litera:array[1..30] of char;

Begin
litera[1]:='А';
litera[2]:='Б';
litera[3]:='В';
litera[4]:='Г';
litera[5]:='Д';
litera[6]:='Е';
litera[7]:='Є';
litera[8]:='Ж';
litera[9]:='З';
litera[10]:='І';
litera[11]:='Ї';
litera[12]:='Й';
litera[13]:='К';
litera[14]:='Л';
litera[15]:='М';
litera[16]:='Н';
litera[17]:='О';
litera[18]:='П';
litera[19]:='Р';
litera[20]:='С';
litera[21]:='Т';
litera[22]:='У';
litera[23]:='Ф';
litera[24]:='Х';
litera[25]:='Ц';
litera[26]:='Ч';
litera[27]:='Ш';
litera[28]:='Щ';
litera[29]:='Ю';
litera[30]:='Я';
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
for j:=1 to 30 do
if s1[1]=litera[j] then
write(s1,' ');
delete(s,1,r);
dov:=length(s);
і:=і+1
end
else
begin
s1:=s;
dov1:=length(s1);
for j:=1 to 30 do
if s1[1]=litera[j] then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_81;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,dov1,k:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
if (dov1 mod 2)=0 then
write(s1,' ');
delete(s,1,r);
dov:=length(s);
і:=і+1
end
else
begin
s1:=s;
dov1:=length(s1);
if (dov1 mod 2)=0 then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_82;
Const n=126;
Var
S,s1,s2:string;
R,dov,і,j,dov1,k:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
if (dov1 mod 2)<>0 then
write(s1,' ');
delete(s,1,r);
dov:=length(s);
і:=і+1
end
else
begin
s1:=s;
dov1:=length(s1);
if (dov1 mod 2)<>0 then
write(s1,' ');
dov:=0;
end;
end;
readln;
End.

Program z_13_9;
Const
n=126;
n1=5;
Var
S,s2:string;
R,dov,і,j,dov1,d,max,n_max ,min,n_min:integer;
d1:array[1..n1] of integer;
s1:array[1..n1] of string;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1[і]:=copy(s,1,r-1);
dov1:=length(s1[і]);
d1[і]:=dov1;
delete(s,1,r);
dov:=length(s);
і:=і+1
end
else
begin
s1[n1]:=s;
dov1:=length(s1[n1]);
d1[n1]:=dov1;
dov:=0;
end;
end;
for j:=1 to n1 do
Write( d1[j]:4 );
WriteLn;
min:=d1[1];
max:=d1[1];
n_max:=1;
n_min:=1;
for j:=2 to n1 do
if d1[j]>max then
begin
max:=d1[j];
n_max:=j;
end;
for j:=2 to n1 do
if d1[і]');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=Pos(' ',s);
if r<>0 then
begin
s1[і]:=copy(s,1,r-1);
dov1:=length(s1[і]);
d1[і]:=dov1;
delete(s,1,r);
dov:=length(s);
і:=і+1
end
else
begin
s1[n1]:=s;
dov1:=length(s1[n1]);
d1[n1]:=dov1;
dov:=0;
end;
end;
syma:=0;
for j:=1 to n1 do
Write( d1[j]:4 );
WriteLn;
for j:=1 to n1 do
syma:=syma+d1[j];
A_ser:=round(syma/n1);
WriteLn( A_ser );
min:=abs(d1[1]-A_ser);
n_min:=1;
for j:=2 to n1 do
if abs(d1[j]-A_ser)');
Readln(S);
Write('Yvedit slovo, jake neobxidno vudalutu =>');
Readln(S2);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
delete(s,1,r);
dov:=length(s);
if s1=s2 then
delete(s1,1,dov1)
else
Write( s1,' ' );
і:=і+1;
end
else
begin
s1:=copy(s,1,dov);
dov1:=length(s1);
if s1=s2 then
delete(s1,1,dov1)
else
write(s1);
delete(s,1,dov);
dov:=0;
end;
end;
readln;
End.

Program Z_14_21;
Const n=126;
Var
S,s1,s2:string;
R,dov,dov1,і:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
delete(s,1,r);
dov:=length(s);
if (і mod 2)=0 then
delete(s1,1,dov1)
else
Write( s1,' ' );
і:=і+1;
end
else
begin
s1:=copy(s,1,dov);
dov1:=length(s1);
if (і mod 2)=0 then
delete(s1,1,dov1)
else
write(s1);
delete(s,1,dov);
dov:=0;
end;
End;

Program Z_14_22;
Const
n=126;
Var
S,s1,s2:string;
R,dov,dov1,і:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
delete(s,1,r);
dov:=length(s);
if (і mod 2)<>0 then
delete(s1,1,dov1)
else
Write( s1,' ' );
і:=і+1;
end
else
begin
s1:=copy(s,1,dov);
dov1:=length(s1);
if (і mod 2)<>0 then
delete(s1,1,dov1)
else
write(s1);
delete(s,1,dov);
dov:=0;
end;
end;
readln;
End.

Program Z_14_31;
Const n=126;
Var
S,s1,s2:string;
R,dov,dov1,і:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
delete(s,1,r);
dov:=length(s);
if і=1 then
delete(s1,1,dov1)
else
Write( s1,' ' );
і:=і+1;
end
else
begin
s1:=copy(s,1,dov);
dov1:=length(s1);
if і=1 then
delete(s1,1,dov1)
else
write(s1);
delete(s,1,dov);
dov:=0;
end;
end;
readln;
End.

Program Z_14_32;
Const n=126;
Var
S,s1,s2:string;
R,dov,dov1,і,m:integer;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit nomer slova =>');
Readln(m);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1:=copy(s,1,r-1);
dov1:=length(s1);
delete(s,1,r);
dov:=length(s);
if і=m then
delete(s1,1,dov1)
else
Write( s1,' ' );
і:=і+1;
end
else
begin
s1:=copy(s,1,dov);
dov1:=length(s1);
if і=m then
delete(s1,1,dov1)
else
write(s1);
delete(s,1,dov);
dov:=0;
end;
end;
readln;
End.

Program Z_14_4;
Const n=126;
Var
S,s2:string;
R,dov,dov1,і,k,m,l:integer;
s1:array[1..n] of string;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
k:=0;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1[і]:=copy(s,1,r-1);
delete(s,1,r);
dov:=length(s);
і:=і+1;
end
else
begin
s1[і]:=s;
dov:=0;
end;
end;
for l:=1 to і-1 do
begin
for m:=l+1 to і do
begin
dov1:=length(s1[m]);
if s1[l]=s1[m] then
delete(s1[m],1,dov1);
end;
end;
for і:=1 to і do
write(s1[і],' ');
readln;
End.

Program Z_14_5;
Const n=126;
Var
S,s2:string;
R,dov,dov1,і,k,m,l:integer;
s1:array[1..n] of string;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
k:=0;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1[і]:=copy(s,1,r-1);
delete(s,1,r);
dov:=length(s);
і:=і+1;
end
else
begin
s1[і]:=s;
dov:=0;
end;
end;
for l:=1 to і-1 do
begin
for m:=l+1 to і do
begin
dov1:=length(s1[m]);
if s1[l]=s1[m] then
delete(s1[m],1,dov1);
end;
end;
for і:=1 to і do
write(s1[і],' ');
readln;
End.

Program Z_14_6;
Const n=126;
Var
S,s2:string;
R,dov,dov1,і,k,p,m,l:integer;
s1:array[1..n] of string;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit nomeru sliv, jaki bydemo minjatu =>');
Readln(k,p);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1[і]:=copy(s,1,r-1);
delete(s,1,r);
dov:=length(s);
і:=і+1;
end
else
begin
s1[і]:=s;
dov:=0;
end;
end;
s2:=s1[k];
s1[k]:=s1[p];
s1[p]:=s2;
for і:=1 to і do
write(s1[і],' ');
readln;
End.

Program Z_14_7;
Const n=126;
Var
S,s2:string;
R,dov,dov1,і,k,m,l:integer;
s1:array[1..n] of string;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Write('Yvedit nomer slova, jake bydemo zminjvatu =>');
Readln(k);
Write('Yvedit slovo =>');
Readln(S2);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1[і]:=copy(s,1,r-1);
delete(s,1,r);
dov:=length(s);
і:=і+1;
end
else
begin
s1[і]:=s;
dov:=0;
end;
end;
for l:=1 to і do
begin
if l=k then
begin
for m:=l+1 to і do
begin
if (s1[l]=s1[m]) then
begin
s1[m]:=s2;
s1[l]:=s2;
end;
end;
end;
end;
s1[k]:=s2;
for і:=1 to і do
write(s1[і],' ');
readln;
End.

Program Z_14_8;
Const n=126;
Var
S,s2:string;
R,dov,dov1,і,k,p,m,l:integer;
s1:array[1..n] of string;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(S);
і:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s1[і]:=copy(s,1,r-1);
delete(s,1,r);
dov:=length(s);
і:=і+1;
end
else
begin
s1[і]:=s;
dov:=0;
end;
end;
k:=1;
for l:=1 to і-1 do
begin
for m:=l+1 to і do
begin
dov1:=length(s1[m]);
if s1[l]=s1[m] then
begin
k:=k+1;
delete(s1[m],1,dov1);
end
end;
WriteLn( s1[l],' ',k );
k:=1;
end;
readln;
End.

Задача 15. Вводяться два числа, розділених символом арифметичної операції. Необхідно визначити:
1. які числа розміщено в тексті;
2. яку арифметичну операцію необхідно виконати;
3. результат виконання цієї дії.

Program text_calc;
Const n=20;
Var
S1:array[1..n] of string;
R,r1,dov,dov1,x,y,і,errcode:integer;
s:string;
z:real;

Begin
Write('Yvedit tekctovuj fragment =>');
Readln(S);
Dov:=length(s);
І:=1;
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
for і:=1 to dov do
begin
r:=pos(' ',s);
if r<>0 then
begin
delete(s,r,1);
dov:=length(s);
end;
end;
for і:=1 to dov do
if (s[і]='+')or(s[і]='-')or(s[і]='*')or(s[і]='/') then
r1:=і;
s1[1]:=copy(s,1,r1-1);
delete(s,1,r1-1);
dov:=length(s);
dov1:=length(s1[1]);
r1:=r1-dov1;
s1[2]:=copy(s,1,r1);
delete(s,r1,1);
dov:=length(s);
s1[3]:=s;
val(s1[1],x,errcode);
if errcode<>0 then
writeln('oshibka vvoda');
val(s1[3],y,errcode);
if errcode<>0 then
writeln('oshibka vvoda');
for і:=1 to 4 do
if s1[2]='+' then z:=x+y;
if s1[2]='-' then z:=x-y;
if s1[2]='*' then z:=x*y;
if s1[2]='/' then z:=x/y;
writeln('z=',z:4:2);
readln;
End.

Задача 16. Виведіть на екран ті слова, що трапляються в кожному з двох уведених користувачем речень.

Program dva_rechennja;
Const n=50;
Var
S1:array[1..n] of string;
s3:array[1..n] of string;
R,r1,dov,dov1,a,b,і,j:integer;
s,s2:string;
z:real;

Begin
Write('Yvedit pershuj tekctovuj fragment =>');
Readln(S);
Write('Yvedit dryguj tekctovuj fragment =>');
Readln(S2);
Dov:=length(s);
dov1:=length(s2);
i:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
a:=dov;
r:=pos(' ',s);
if r<>0 then
begin
s1[і]:=copy(s,1,r-1);
delete(s,1,r);
dov:=length(s);
і:=і+1;
end
else
begin
s1[і]:=s;
dov:=0;
end;
end;
j:=1;
while dov1<>0 do
begin
while (s2[dov1]=' ')and(dov1<>0) do
begin
Delete(S2,dov1-1,1);
Dov1:=length(S2);
end;
b:=dov1;
r1:=pos(' ',s2);
if r1<>0 then
begin
s3[j]:=copy(s2,1,r1-1);
delete(s2,1,r1);
dov1:=length(s2);
j:=j+1;
end
else
begin
s3[j]:=s2;
dov1:=0;
end;
end;
for і:=1 to і do
begin
for j:=1 to j do
if s1[і]=s3[j] then
write(s1[j],' ');
end;
readln;
End.

Задача 17. Задано два довільних текстових фрагменти. Подвойте кожен символ того тексту, у якому сумарна кількість українських голосних більша.

Programm Main;
Var
s,s1,s4,s5:string;
R,r1,dov,dov1,і,j,e,k,k1,l,l1,a,b:integer;
golosna:array[1..10] of char;
s2:array[1..n] of string;
s3:array[1..n] of string;

Begin
golosna[1]:='а';
golosna[2]:='е';
golosna[3]:='є';
golosna[4]:='и';
golosna[5]:='і';
golosna[6]:='ї';
golosna[7]:='о';
golosna[8]:='у';
golosna[9]:='ю';
golosna[10]:='я';
Write('Yvedit pershuj tekctovuj fragment =>');
Readln(S);
Write('Yvedit dryguj tekctovuj fragment =>');
Readln(S1);
Dov:=length(s);
dov1:=length(s1);
s4:=s;
a:=dov;
s5:=s1;
b:=dov1;
k:=0;
k1:=0;
i:=1;
while dov<>0 do
begin
while (s[dov]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos(' ',s);
if r<>0 then
begin
s2[і]:=copy(s,1,r);
for l:=1 to r-1 do
for j:=1 to 10 do
if s2[і][l]=golosna[j] then
k:=k+1;
delete(s,1,r);
dov:=length(s);
і:=і+1;
end
else
begin
s2[і]:=s;
for l:=1 to dov do
for j:=1 to 10 do
if s2[і][l]=golosna[j] then
k:=k+1;
WriteLn( k );
dov:=0;
end;
end;
e:=1;
while dov1<>0 do
begin
while (s1[dov1]=' ')and(dov1<>0) do
begin
Delete(S1,dov1-1,1);
Dov1:=length(S1);
end;
r1:=pos(' ',s1);
if r1<>0 then
begin
s3[e]:=copy(s1,1,r1);
for l1:=1 to r1-1 do
for j:=1 to 10 do
if s3[e][l1]=golosna[j] then
k1:=k1+1;
delete(s1,1,r1);
dov1:=length(s1);
e:=e+1;
end
else
begin
s3[e]:=s1;
for l1:=1 to dov1 do
for j:=1 to 10 do
if s3[e][l1]=golosna[j] then
k1:=k1+1;
WriteLn( k1 );
dov1:=0;
end;
end;
dov:=length(s2[і]);
delete(s2[і],1,dov);
dov1:=length(s3[e]);
delete(s3[e],1,dov1);
if k10 do
begin
while (s4[a]=' ')and(a<>0) do
begin
Delete(S4,a-1,1);
Dov:=length(S);
end;
r:=pos(' ',s4);
if r<>0 then
begin
s2[і]:=copy(s4,1,r-1);
l:=1;
while l<(r+r-2) do
begin
insert(s2[і][l],s2[і],l);
l:=L+2;
end;
write(s2[і],' ');
delete(s4,1,r);
a:=length(s4);
і:=і+1;
end
else
begin
s2[і]:=s4;
l:=1;
while l<(a+a-1) do
begin
insert(s2[і][l],s2[і],l);
l:=L+2;
end;
write(s2[і],' ');
a:=0;
end;
end;
end
else
begin
e:=1;
while b<>0 do
begin
while (s5[b]=' ')and(b<>0) do
begin
Delete(S5,b-1,1);
Dov:=length(S5);
end;
r1:=pos(' ',s5);
if r1<>0 then
begin
s3[e]:=copy(s5,1,r1-1);
l1:=1;
while l1<(r1+r1-2) do
begin
insert(s3[e][l1],s3[e],l1);
l1:=L1+2;
end;
write(s3[e],' ');
delete(s5,1,r1);
b:=length(s5);
e:=e+1;
end
else
begin
s3[e]:=s5;
l1:=1;
while l1<(b+b) do
begin
insert(s3[e][l1],s3[e],l1);
l1:=L1+2;
end;
write(s3[e],' ');
b:=0;
end;
end;
end;
readln;
End.

Задача 18. Текст складається з речень, розділених крапками. Після кожної крапки в кінці речення повинен бути один пропуск. Перше слово в реченні повинно починатися з великої літери.

Program rechennja;
Const n=50;
Var
s,s1:string;
R,dov,і:integer;
litera:char;

Procedure Vellit;
begin
Case litera Of
'a','b','c','d','e','f','g','h','і','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z':
write(Chr(Ord(litera)-32));
'а','б','в','г','д','е','ж','з','и','й','к','л','м','н','о','п','р','с','т','у','ф','х','ц','ч','ш','щ','э','ю','я':
write(Chr(Ord(litera)-32));
'і':
write( Chr(Ord(litera)-1));
'ї','є','ё' :
write(Chr(Ord(litera)-16));
Else
write(Chr(Ord(litera)));
end;
end;

Begin
Write('Yvedit text =>');
Readln(S);
Dov:=length(s);
і:=1;
while dov<>0 do
begin
while (s[1]=' ')and(dov<>0) do
begin
Delete(S,1,1);
Dov:=length(S);
end;
r:=pos('.',s);
if r<>0 then
begin
s1:=copy(s,1,r);
litera:=s[1];
vellit;
for і:=2 to r do
write(s1[і]);
if s[r+1]<>' ' then
insert(' ',s,r+1);
write(' ');
delete(s,1,r+1);
dov:=length(s);
і:=і+1;
end
end;
readln;
End.

Задача 19. Необхідно створити поштову програму, яка самостійно визначає ім’я одержувача листа, виділивши його з електронної адреси, та розміщує це ім’я в тексті листа після вітання. Лист закінчується підписом, який поштова програма формує самостійно, визначивши ім’я відправника листа з його електронної адреси.

Program elektr_poshta;
Const n=50;
Var
s,s1,s2,s3,s4,s5,s6:string;
R,r1,r2,r3,r4,r5,r6,dov,dov1,dov2,dov3,dov4,і,j,k:integer;
a,b:char;

Begin
Write('Yvedit adresy oderghyvacha =>');
Readln(S1);
Dov1:=length(s1);
Write('Yvedit adresy avtora lusta =>');
Readln(S2);
Dov2:=length(s2);
Write('Yvedit texst povidomlennja =>');
Readln(S);
Dov:=length(s);
r1:=pos(':',s1);
delete(s1,1,r1);
r2:=pos('@',s1);
s3:=copy(s1,1,r2-1);
a:=s3[1];
a:=chr(ord(a)-32);
delete(s3,1,1);
insert(a,s3,1);
r3:=pos(':',s2);
delete(s2,1,r3);
r4:=pos('@',s2);
s4:=copy(s2,1,r4-1);
b:=s4[1];
b:=chr(ord(b)-32);
delete(s4,1,1);
insert(b,s4,1);
r:=pos(':',s);
delete(s,1,r);
insert('Електронний лист:',s,1);
r:=pos(':',s);
s5:='Вітаю, шановний ';
dov3:=length(s5);
insert(s3,s5,dov3+1);
dov3:=length(s5);
insert('!',s5,dov3+1);
insert(s5,s,r+1);
dov:=length(s);
s6:='З повагою, ';
dov4:=length(s6);
insert(s4,s6,dov4+1);
dov4:=length(s6);
insert('.',s6,dov4+1);
insert(s6,s,dov+1);
dov:=length(s);
for і:=1 to dov do
write(s[і]);
readln;
End.

Задача 20. Необхідно створити програму, яка формуватиме вітальну листівку. Прізвище та ім’я одержувача зазначені в списку. Побажання вибираються зі списку випадково. До листівки додається електронна адреса одержувача.

Program vital_lustivka;
Const n=50;
Var
s,s1,s2,s3,s4,s5,s6:string;
j,k, R,r1,r2,dov,dov1,dov2,dov4,dov5,dov6,і,m:integer;
a,b:char;

Begin
Write('Yvedit spusok oderghyvachachiv =>');
Readln(S1);
Dov1:=length(s1);
Write('Yvedit elektronni adresu oderghyvachiv =>');
Readln(S2);
Dov2:=length(s2);
Write('Yvedit spusok pobaghan =>');
Readln(S);
Dov:=length(s);
і:=1;
while dov1<>0 do
begin
r1:=pos(',',s1);
if r1<>0 then
begin
s3:=copy(s1,1,r1-1);
insert('Дорогий ',s3,1);
dov4:=length(s3);
Delete(s1,1,r1);
dov1:=length(s1);
for j:=1 to 3 do
begin
randomize;
s5:=s;
m:=random(6);
WriteLn(m);
r:=pos(',',s5);
k:=1;
while kmax then
begin
max:=k;
nt:=і
end;
end;
WriteLn( 'Najpopyljarnisha tema' );
WriteLn( tema[nt] );
WriteLn( 'Kilkist povidomlen ' );
WriteLn( max );
readln;
End.

Задача 22. Перше слово в рядку є словом-донором, а всі інші слова – новими словами, що побудовані з літер початкового слова. Кожна літера в новому слові повинна використовуватись не більше того числа, що визначає кількість входжень літери в слово-донор. Необхідно визначити слова вірно створені із слова-донора.

Program Donor_slovo;
Const n=50;
Var
R, dov, і:integer;
strAll, strG, str2 : string;

Function virno(str1, str2:string):boolean;
Var
k1, k2 : integer;
nFlag : boolean;
begin
nFlag := False;
for k1:=1 to Length(str1) do
for k2:=1 to Length(str2) do
if str1[k1] = str2[k2] then
begin
Delete(str2, k2, 1);
break;
end;
if Length(str2) = 0 then nFlag := True;
virno := nFlag;
end;

Function FindWord():string;
Var
r : integer;
str1 : string;
begin
r:=Pos(',',strAll);
if r=0 then
begin
str1 := strAll;
dov := 0;
end
else
begin
str1 := Copy(strAll,1,r-1);
delete(strAll,1,r+1);
Dov := length(strAll);
end;
FindWord := str1;
end;

Begin
Write('Yvedit slova =>');
Readln(StrAll);
strG := FindWord;
і := 1;
while (dov<>0)or(і<>Length(strAll)) do
begin
if strAll[і] = ',' then
begin
str2 := FindWord;
if Virno(strG, str2) then Writeln(strG,' ',str2);
і:=1;
end;
і:=і+1;
end;
ReadLn;
End.

Задача 23. Необхідно розробити програму, що перетворює натуральне число, записане в римській нумерації, на десяткове число, записане арабськими числами.

Program rumski;
Var
s:string;
n,c,c1,і,a:integer;

Begin
writeln('Yvedit chuslo');
readln(s);
c:=0;n:=0;
for і:=1 to length(s) do
begin
c1:=c;
if s[і]='І' then c:=1;
if s[і]='V' then c:=5;
if s[і]='X' then c:=10;
if s[і]='L' then c:=50;
if s[і]='C' then c:=100;
if s[і]='D' then c:=500;
if s[і]='M' then c:=1000;
if c>c1 then a:=-2*c1
else a:=0;
n:=n+a+c
end;
writeln('Ze chuclo = ',n)
End.

Завдання для самостійної роботи
1. Запитайте у користувача числа, перетворіть їх у рядки, зробіть їх зчеплення в різних поєднаннях і виведіть на екран. Не забудьте поставити між рядками пробіл, в кінці крапку і почати з великої літери.

2. Запитайте у користувача кілька рядків і виведіть на екран їх довжину, результат конкатенації в деякому порядку і зробіть перевірку, чи можна перетворити ці рядки в числа.

3. Запитайте у користувача рядок, що складається з 5 символів, і перевірте чи є він прикладом, додаються два однозначних числа, кожне з яких менше п'яти, якщо є, то обчисліть його.

4. Запитайте у користувача рядок, що складається з декількох слів, розділених пробілом, і виведіть їх на екран так, щоб кожне слово починалося з нового рядка.

5. Запитайте у користувача два рядки і порівняйте їх довжину, перший і останній символ кожного рядка, а також виведіть на екран ці рядки з великої літери.

6. Визначте іменник 1-ої відміни, який закінчується на "а". Перевірте правильність введення. Надрукуйте це слово у всіх відмінках. Застосовуйте підпрограми.

7. Задані прізвище, ім'я та по батькові учня, розділені пропуском. Надрукуйте його прізвище та ініціали. Застосовуйте підпрограми.

8. Підрахуйте кількість цифр у наведеною рядку символів. Застосовуйте підпрограми.

9. Задані прізвище, ім'я та по батькові учня, розділені пропуском. Надрукуйте його прізвище та ініціали. Застосовуйте підпрограми.

10. Порахуйте кількість цифр у наведеною рядку символів. Застосовуйте підпрограми.

11. Складіть програму обчислення суми місць, на яких в слові Х стоять літери "в" і "п".

12. Написати (в порядку появи в тексті) усі слова, довжина яких потрапляє в інтервал [X, Y]. Тут X і Y цілі числа, задаються користувачем.

13. У даному реченні знайти кількість слів, що містять подвоєну приголосну (букви латинські). Слова в реченні розділяються пробілами, в кінці речення - крапка.

14. Складіть програму, викреслюйте кожну третю букву слова Х в заданому реченні.

15. Дана рядок символів до крапки. Групи символів у ній між групами прогалин вважаються словами. Визначити, скільки слів містять рівно 3 букви "е".

16. Дан текст. Підрахувати кількість слів, що закінчуються на задану літеру і перенести їх в інший рядок, написавши через кому. Вивести отриману рядок на екран.

17. Дано 2 текст. Знайти одне із загальних слів, що зустрічаються в текстах.

18. Для кожного заданого слова вказати кількість приголосних. Визначити слово в якому кількість приголосних максимальна.