Главная / Информатика / Збірник задач (в системі прграмування Паскаль)

Збірник задач (в системі прграмування Паскаль)

hello_html_4f82ea44.gif

Руднянська ЗОШ І-ІІІ ступенів Броварського району





Василь Подима




З Б І Р Н И К З А Д А Ч

мова програмування

Turbo Pascal





hello_html_3f73a112.gif





Рудня 2013



Від автора.


Посібник являє собою збірник задач по програмуванню завдань на мовах Turbo Pascal, Qbasic, «КУМИР». Він складається із двох частин: змісту задач і програм до даних задач. Програми являють собою як типові, тобто введення-виведення, використання циклів(повторень), роботи з масивами, пошук і сортування даних, так і програм, як правило залишаються за рамками традиційного курсу навчання програмування, робота із рядками і файлами, динамічна графіка, рекурсія, динамічне програмування тощо.

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

Посібник дає змогу учням і вчителям стандартизувати на високому, методично-виваженому рівні підготовку до вивчення мови програмування по різним темам. Посібник написано логічною і водночас зрозумілою сучасною мовою програмування Turbo Pascal. Робота над посібником буде корисною учням, які захоплюються математикою (особливо по розділу «Теорії чисел») і бажають розширити своє уявлення про математичні моделі. Він може бути корисним майбутнім програмістам, бо на прикладах, детально поданих програм у посібнику, можна з успіхом, навчитися культурі програмування.









hello_html_mcf4cdb0.gif

Руднянська ЗОШ І-ІІІ ступенів Броварського району

hello_html_1916926a.gif







З М І С Т


з а д а ч





hello_html_m37d255eb.gif







Задача. Створити програму яка б виконувала арифмет. дії

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

поставлених дужок в математичному виразі

Задача про знаход. шляхів ходів шахм. фірзі на полі 5х5.

Задача про гривну (отримати здачу із суми до 100 гривень в

банкнотах)

Задача.Визначити скільки буде кролинят за рік, якщо на початку

року була одна пара кролів.

Задача.Скласти програму знаходження куб суми (своїх чисел)

введеного числа в межах від 100 до 999.

Задача Розкласти число на множники.

Задача.Визначити найменьший загальний дільник для двох натуральних чисел.

Задача. На iнтервалi (1000;9999) знайти всi простi числа, в записi яких сума першоi i другоi цифр рiвна третьоi i четвертоi

Задача знайти остачу від ділення двох чисел.

Задача. Скласти рограму для визначення числа чи є воно

простим

Задача на математичний ребус

Задача.Скласти програму для визначення числа 2 в степені N

N можливо бути великим числом

Задача. Скласти програму для суми великих чисел

Задача.Числова спіраль закручється проти годиникової стрілки

від N*N до 1

Задача.Числова спіраль закручується по годиникової стрілки від

1 до N*N

Скласти алгоритм обчислення суми значень многочлена 3*X^4+2*X^2+1 на відрізку від А до В з кроком h.

Задача.. З множини чисел 1..20 виділити ті числа,що діляться на 6 без остачі і ті, що діляться на 2 або 3 без остаачі.

Закдача. Скласти програму для сортування одновимірного

масиву

Задача. Створити програму для визначення інтегралу.


Задача. Визначення найменшого значення в поданій функції

Програми з літерними величинами

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

Задача на заміну букви або слова

Задача на обернення слова

Задача на відгадування букв або слова

Програма для відображення різного типа шрифту

Програми для демонстрації графічних можливостей Turbo Pascal 7.0 versii із поясн. деяких стрічок.

Program Style;

Практична робота з графічним режимом.

Практична робота з графічним режимом (відображення геометричних елементів)

Програма показу типів ліній у графічному режимі

Програма демонстрації складних типів ліній

Програма динамічної графіки. Політ НЛО

Демонстраційна програма заповнення всіх типів заповнення

штриховками прямокутників.

Програма демонстрації різних типів і напрямків тексту в графічному режимі

Програма демонстрації годинника в графічному режимі

Деякі задачі з районних олімпіад

Екологічна задача

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

-початкова забруднена клітина знаходиться в центрі квадрата;

-у кожний інтервал часу інфекційна клітина може з вірогідністю 0,5 заражати кожну із сусідніх здорових клітин;

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

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

ЗАДАЧА

Монети. На кожній клітинці шахівниці розміром (n*m) клітин покладено певну кiлькiсть монет (вiд 0 до R), яка задається елементами таблицi А[N,M]. Яку найбiльшу кiлькiсть монет можна зiбрати з полiв шахiвницi якщо:

а) починати збирати з лiвої ножньої клiтини;

б) закiнчити у верхнiй правiй клiтині;

в) перехiд на нову клiтину здiйснюється або вгору-U, або праворуч-R.

ЗАДАЧА

Рахiвничка. N-дiтей стоять по колу та рахують один одного вiд першого до К, при цьому К-та дитина вибуває

з гри. Визначити номеp дитини, яка залишається.}

Завдання Всеукраїнських олімпіод різного рівня 2003р.

ПРОГРАМИ ПО ТЕМІ «ТЕОРОІЯ ЧИСЕЛ»

Задача. Якщо двозначне число розділити на добуток його цифр, то в частці буде 4, а в остачі 1. Якщо це цисло розділити на суму його цифр, то в частці буде 3, а в остачі 1. Знайдіть це число ?

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

Автономне число це число квадрат якого останім дорівнює цьому числу. НАПРИКЛАД; 5^2=25, 6^2=36, 25^2=625.

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

Задача. Знаходження дружних чисел (220 і 284, 1184 і 1210).Дружні числа це такі числа сума дільників одного з них повинна рівна другому числу і навпаки.НАПРИКЛАД; 1+2+4+5+10+11+20+22+44+55+110=284 i

1+2+4+71+142=220. Програма працює довго

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

поліндромом (121, 13431,..).

Задача. Скласти програму для визначення пiфагорових

чисел в межах вiд 1 до 20.

Задача. Знаходження досконалих чисели.

НАПРИКЛАД; 6, 28, 496, 8128. (6=1+2+3)

Задача.Скласти програму числового трикутника Паскаля.

Задача .Скласти програму для визначення простих чисел в межах

від M до N.

Задача. Програма для визначення факторіала числа в межах

від 1 до 33.

Задача. Сума цифр числа Х рівна У, а сума цифр числа У рівна Z Знайти Х якщо Х+Y+Z=60.

Задача. Чи існують такі двузначні числа ab і cd, якщо

ab*cd=abcd.

Задача. В класі не меньше 95,5% і не більше 96.5% учнів навчаються без "двійок". При якому найменьшому числі учнів це можливо?

Задача. Послідовність задана в такому виді, а[1]=1, f[2]=2, a[n+1]-

2[n]+a[n-1]=1. Визначити a[1995].

Задача. Написати програму, яка цілій змінній А надає значення

першої цифри дробової частини дійсного числа Х

Задача. Написати програму, яка друкує TRUE або FALSE в залежності від того, чи є у цілого числа лише один простий дільник, який більший ніж 20, але менший 30.

Задача. Визначити найбільше число із трьох заданих А, В і

С.методом підпрограми-процедури.

Задача. Визначити найбільше число із трьох заданих А, В і С.

методом підпрограми-функції.


ЗАДАЧІ ПО РІЗНИХ ТЕМАХ

Задача.Дано кординати вершин трикутника ABC (X1,Y1) (X2,Y2) (X3,Y3). Скласти програму, яка б визначила, чи належить точка О iз кординатами (X,Y) площ. трик.

Примiтка: ввести в програму контроль iснування трик. ABC.

Задача. Утворити матрицю розміром (5 Х 5), у якій знайти Min A[i,j] і координати знайденого числа з правого боку бічної діагоналі.

Завдання N1 обласної олімпіади.

Скільки можна зробити різних гірлянд з n(3 < n < 100) різнокольорових лампочок.

Н А П Р И К Л А Д: Якщо лампочок 3 (n=3), а їх колір червоний(ч), синій(с), зелений(з), то кількість варіантів д о р і в н ю є: 1). ч с з 2). ч з с 3). с ч з 4). с з ч 5). з ч с 6). з с ч.

Тобто 6 варіантів. В розділі математики «Комбінаторика» це має назву 'Перестановка з n', яка дорівнює добутку перших натуральних чисел (факторіал -f!). f!=1*2*3=6.


Задача.Склати програму,що знаходить число від 1 до 1000. Людина загадує число від 1 до 1000 і обчислює остачу від ділення цього числа на 7, 11, 13 і повідомляє ці залишки програмі. Програма повинна визначити

загадане число Х ?.Позначити залишки R7,R11,R13. Таке число, яке підлягає цій умові тільки одне X-> є [1..1000]. X:7->R7, X:11->R11, X:13->R13.


Задача.Скласчти програму чи входить кирпичина роміром

Х,У,Z в отвір розміром (А на В)

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

площою S1 в квадрат з площою S2.

Задача N2 обласної олімпіади.

Учасникам олімпіади передан текстовий файл (d.dat):

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

Треба відзначити,текст для цього:

1. Упрядочити слова по алфавіту:

2. Відокремити четверту літеру кожного слова:

3. Записати літери в текстову змінну:

4. Розподілити текст на слова згідно першого рядка цифр вхідного файла. Це є вміст дишифрованого текста.

5. Записати в текстовий файл (dd.dat) дешифрований текст

Задача.Яку швид. необхiдно надати ракетi, щоб вона вийшла на

кругову орбiту радiуса R навколо Землi ?

Задача. Визначити існування трикутника по його трьом

сторонам А, В і С.

Задача.Скласти програму для відгадування числа в межах від 1

до 100 задуманого комп’ютером.

Здачі створення звуку

Задача скласти program zvuk;

Задача.Звукова програма, звука пташки

Завдання рай. ол. для учнів 10 кл. 1999 року

Задача1. Знайти найменьше та найбiльше числа, якi можна подати сумами деяких (можливо всiх ) елементiв масиву.

Защдача 2. Знайти суму елементiв матрицi, розташованих на однiй з лiнiйi, яка паралельна: а).головнiй, б).бiчнiй дiагоналi

Задача3. Числа по спiралi. Заповнити квадратну таблицю Т(n,n) послiдовними числами вiд 1 до n в квд. розмiщеними по спiралi, починаючи з лiвого верхнього кута i рахуючись за годинниковою стрiлкою.

Задача4. За координатами вершин опуклого чотирикутника встановити: a).його вид(квадрат, ромб, прямокутник, паралелограм, транецiя): б).чи можна в нього вписати коло? в).чи можна навколо нього описати коло?

Завдання рай. ол. для учнів 11 кл. 1999 року

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

Задача. На iнтервалi (1000;9999) знайти всi простi числа, в записi яких сума першоi i другоi цифр рiвна третьоi i четвертоi.

Задача. З'ясувати чи належить точка (Х,У) кругу радіуса

з центром у точці (А,В).

Задача. Алгоритм обробляє де які сполучення букв У,П,А. Алгоритм переводить слово ПВПВМВ в слово ПВ, МВМВПВМВ в МВМВ, МВПВПВМВПВ в ПВ, ПВПВ в ПВПВ, МВПВПВПВ в ПВПВ. Для де яких слів, наприклад, ППВ, МВПВ, ВВ, ПВПМПВ, алгоритм видам повiдомлення "помилка".

а). Описати такий алгоритм. б). Який сенс можна надати такому алгоритму?

Завдання для уч.11 класу рай.олімпіади 2001 року

Задача Program ol_r_2001_N3;

ЗАДАЧІ НА РІЗНІ ТЕМИ

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

випадк.чисел.

Завдання.Скласти програму якаб читала дані з файла Pd.dan,

обробляла їх ї записувала результат в файл Pr.res.

Задача.Даний прямокутник із сторонами АхВ розбитий на однакові квадрати (1Х1) Необхідно визначити через скільки квадратів пройде діагонал.

Задача про кирпичину.

Задача.Пара кроликiв кожний мiсяць даї потомство двох

кроленят (самку і самця), які через два місяця

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

б визначила, скільки буде кролів через 12 місяців.;

Скласти програму квадратного рівняння.

Програма сортування випадкових чисел двовимірного масива

Задача.По введеної к-ті суток визначити к-ть годин.

Скласти програму лінійної системи рівнянь.

Програма сортування випадкових чисел одновимірного масива

Приклад опису рядків лінійної програми.

Задача (Хід конем).Скласти програму яка б показала в графічному режимі ходи шахматних конів, білих і чорних (по 5 шт) які міняються містами. (Нумерацію ходів фігур відобразити в програмі)

Задача. Скласти програму в графічному режимі для демонстрації роботи секундної стрілки часів.

Задача,Скласти програму в графічному режимі побудови

перерізу кулі.

Задача. Визначити чи належить точка з координатами Х

відрізку [A;B] ?

Задача. Визначити чи поміститься рівностороньій трикутник

площею S1, в квадраті площею S2.

Задача. Скласти програму роботи з файлами.

Задача. Написати програму для переведення градусів в радіани.

Задача.Визначення добутку суми від 1-го по 12-й і від 8-го по

15-й элементів одновимірного масива.

Задача.Визначити кілбкість цифр в додатньому цілому числі

Задача.Впорядкувати прізвища учнів по середньому балу

успішності.

Задача.Визначити кількість можливих кроків по ступенькам від

1 до N. (Крок можна робити через 0,1,2 ступеньок).

Задача. Знайти суму всіх натуральних чисел від 1 до N.в

циклічній програмі

Задача. Скласти програму яка б відгадувала однакові задумані

числа людиною і ЕОМ від 1 до 3.

Задача, Скласти програму для роботи в графічному режимі





Руднянська ЗОШ І-ІІІ ступенів Броварського району

hello_html_1916926a.gif







П Р О Г Р А М И


д о з а д а ч




hello_html_m4101ebac.gif








Задача. Створити програму яка б виконувала арифметичні дії

Program Calc;

Uses Crt;

Var Operation:Char; {Знак математичної операції}

x,y,z:Real; {Операнди(x,y) і результат(z)}

Stop :Boolean;{Признак помилкової операції і зупинки}

BEGIN ClrScr; S;

Repeat Writeln;{Початок цикла введ.даних і пустий рядок}

Write('Введіть X,Y= ');Readln(X,Y);

Write('Введіть операцію:(+ , - , * , / ) -> ');

Readln(Operation);

Case Operation Of {Оператор початкy вибора мат.операції}

'+' : z:=x+y;

'-' : z:=x-y;

'*' : z:=x*y;

'/' : z:=x/y;

Else {Оператор ІНАКШЕ виконуй дану вказівку}

Stop := True; {Істина (правда) }

End;

If Not stop Then

Writeln('Відповідь= ',z:1:4);

Writeln('Признаком кінця прогр.введіть любу букву');

Until Stop; {Кінець циклу Repeat}

Readkey

END.

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

поставлених дужок в математичному виразі.

Program Scobka;

Uses Crt;

Var x:string; c,i:integer; F: Boolean;

BEGIN Clrscr;

Write('Введіть послідовно дужки Х=');Read(x);

C:=0; F:=true;

For i:=1 to Length(x) do Begin

If x[i]='(' Then C:=C+1; If x[i]=')' Then C:=C-1;

If c<0 Then F:=false End;

If c>0 Then F:=false ;

If c=0 Then Writeln('Правильно')

Else Writeln('Неправильно');

Readkey END.

{ НАПРИКЛАД. Х=(2+4)*((23-45), повід. "Неправильно". }


Задача про знаходження шляхів ходів шахматнох фірзі

на полі 5х5.

Program F;

Uses Crt;

Var i,j,A1,B,c,q,v,h:integer;

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

BEGIN ClrScr ; c:=5;q:=2;v:=5;h:=2;

For i:=1 to 5 do Begin

q:=q+1;v:=v+2;gotoxy(v,2);textcolor(13);write(i);h:=h+1;

gotoxy(4,h);textcolor(13);write(i);

For j:=1 to 5 do Begin c:=c+2;

A[i,j]:=0;gotoxy(c,q); textcolor(14);Write(a[i,j]);

end;c:=5 end; writeln;writeln;

textcolor(12);write ('Введите i,j=');read(A1,B); c:=5;q:=2;

For i:=1 to 5 do Begin q:=q+1;

For j:=1 to 5 do Begin c:=c+2;

A[i,j]:=0;gotoxy(c,q); textcolor(14);Write(a[i,j]);

If i=A1 then Begin gotoxy(c,q); textcolor(15);Write('-');end;

If j=B then Begin gotoxy(c,q); textcolor(15);Write('|') end;

If i+j=a1+b then Begin gotoxy(c,q); textcolor(15);Write('/');end;

If i+b=j+a1 then Begin gotoxy(c,q); textcolor(15);Write('\');end;

If (j=B)and(i=a1) then Begin gotoxy(c,q); textcolor(11);Write('F') end; End;c:=5 End;writeln; Readkey

END.

Задача про гривну (отримати здачу із суми до

100 гривень в банкнотах)

program grivna;

Uses Crt;

Var s,sk:integer;

Procedure bb(v:integer;Var ss,ssr:integer);{Підпрограма}

{V-> ціна банкнот,SS-> сума грошей, SSR-> к-ть банкнот}

Var b:integer;

Begin b:=ss div v; if b>0 then begin

ssr:=ssr+b;Writeln(v,'-гр. :',b,'-шт.');ss:=ss mod v

end end;

BEGIN ClrScr; {Початок основної програми}

Write('Введіть суму грошей в гривнах -> ');read(s);

Writeln('------------------------------------');

Writeln(S,' -cума грошей виражена в банкнотах');

Writeln('======================================');

SK:=0; {Звернення до процидури (BB)}

bb(100,s,sk); bb(50,s,sk); bb(25,s,sk); bb(10,s,sk); bb(5,s,sk); bb(2,s,sk);

bb(1,s,sk); Writeln('***************************************');

Writeln('В с е г о -(',sk,'-шт.)- б а н к н о т.'); readkey;

END.

Задача.Визначити скільки буде кролинят за рік, якщо на початку року була одна пара кролів.

Program Krolik;

Uses Crt;

Var k:integer;

Function f(n:integer):integer;

Begin if n=0 then f:=1 else

if n=1 then f:=2 else f:=f(n-2)+f(n-1) End;

BEGIN ClrScr;

Write(' Одна пара кроликов даст приплод за:'); Writeln;

FOR k:=10 to 12 do

Write(' ',k,'-> мес.=',f(k),'шт.'); readkey; END.

Задача.Скласти програму знаходження куб суми (своїх чисел)

введеного числа в межах від 100 до 999.

Program kub_x;

Uses Crt;

Var a,b,c,x:integer;

BEGIN ClrScr;

write('Пожалуста, Ваші шукані куб.суми числа від 100 до 999'); writeln;

for x:=100 to 999 do begin

a:=x div 100;

b:=x mod 100 div 10;

c:=x mod 10;

if x=a*a*a+b*b*b+c*c*c then

write(x,' '); end; readkey;

END.

Задача Розкласти число на множники.

Program mnoj;

uses crt;

var s,i,n:integer;

begin ClrScr;s:=0;

writeln('Разклад числа на множники');

writeln('----------------------------- ');

write('Введите число N=');read(n);

writeln(' '); write('Число ',n,'= ');

while n mod 2=0 do begin s:=s+1;

if s=1 then write(2); write('*',2); n:=n div 2 end;

i:=3;while i<=n do if n mod i=0 then begin

if s=0 then write(i);s:=s+1; write('*',i); n:=n div i end

else i:=i+2; readln;readln

END.


Задача.Визначити найменьший загальний дільник для двох

натуральних чисел.

program nod;

var a,b,d:integer;

function nd(x,y:integer):integer;{Підпрограма}

begin if x=0 then nd:=y else nd:=nd(y mod x,x) end; {Кінець підлрограми}

begin {Основна програма}

write('Введіть два числа А и В = ');read(a,b); d:=nd(abs(a),abs(b)); writeln(' '); writeln('Для -> ',a,' и ',b,' НОД =( ',d,' )')

END.


Задача. На iнтервалi (1000;9999) знайти всi простi числа, в записi яких сума першоi i другоi цифр рiвна третьоi i четвертоi.

Program OL10_99_2;

Uses Crt;

Const d5:Array[1..4]of word=(1,3,7,9);

Var a,b,c,d,i,x,q,k,t,tt,n:integer;

f:array[1..200]of integer; a1,b1,c1,d1,st:string[4];

BEGIN ClrScr; q:=0;

For i:=1 to 4 do

For c:=0 to 9 do If(d5[i]+c) mod 3<>0 Then

For a:=1 to 9 do Begin

b:=d5[i]+c-a; Begin

N:=((10*a+b)*10+c)*10+d5[i]; X:=7;

While (Sqr(x)<=N) and (N mod x<>0) do Inc(x,2);

If (N mod X<>0) Then Begin k:=k+1;f[k]:=n; end; end; end;

For i:=1 to k do begin st:='';a1:='';b1:='';c1:='';d1:='';

str(f[i],st);a1:=Copy(st,1,1);

b1:=Copy(st,2,1);c1:=Copy(st,3,1); d1:=Copy(st,4,1);

Val(a1,a,t);Val(b1,b,t);Val(c1,c,t);Val(d1,d,t);

If a+b=c+d Then Begin t:=t+1;tt:=tt+1;Write(f[i]:10) end

End; Write('Всього шуканих чисел ':127,tt); readkey

END.


Задача знайти остачу від ділення двох чисел.

Program ost;

var a,b,s:integer;

begin s:=0;

write('Введіть А и В через пропуск ');read(a,b);

repeat a:=a-b;s:=s+1; until a<=b;

writeln('Частка Х=',s,' ,остача S=',a);

end.


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

простим.

Program Prost;

Uses Crt;

Var n,i:integer;

BEGIN Clrscr;

Write('Введіть ціле число N=');Read(n); i:=1;

Repeat

I:=I+1

Until n mod i=0 ; If n=I Then Writeln(N,'-просте число')

Else Writeln(N,'-число не є простим ділиться на ',i);

Readkey

END.


Задача на математичний ребус

Program rebus;

Uses Crt;

Var l,p,t,o,k,a:integer;

Procedure p1(a,b,c,d:integer;var p,l:integer);

Begin if l=0 then exit;

if ((a+b+p) mod d=c) then p:=(a+b+p) div d else l:=0 End;

BEGIN Clrscr;

Writeln('t',' ','o',' ','k',' ','a');

For a:=2 to 10 do begin

For t:=0 to a-1 do begin

For o:=0 to a-1 do begin

For k:=0 to a-1 do begin

p:=0; l:=1; p1(o,t,k,a,p,l); p1(t,o,o,a,p,l); p1(k,k,t,a,p,l);

if (l=1) and (p=0) and not((t=0) and (k=0) and (o=0)) then Begin

Writeln(t,' ',o,' ',k,' ',a) end;

end end end end;

Readkey

END.


Задача.Скласти програму для визначення числа 2 в степені N

N можливо бути великим числом.

Program Stepen;

Uses Crt;

Const md=302;

Var xm:array[1..md] of 0..9; i,xz:1..md; n:integer;

Procedure step(n:integer); Var i:1..md; k,p,b:integer;

Begin xm[md]:=1; xz:=md;

For k:=1 to n do Begin p:=0;

For i:=md downto xz do Begin

b:=2*xm[i]; b:=b+p;xm[i]:=b mod 10;p:=b div 10 End;

If p<>0 then Begin xz:=xz-1;xm[xz]:=p End End End;

BEGIN ClrScr;

Write('Введіть степінь N=');Readln(n);Step(n);Writeln;

For i:=xz to md do Write(xm[i]:1); Readkey

END.

Задача. Скласти програму для суми великих чисел.

Program Summa_bol;

Uses Crt;

Var t:array[1..240]of integer; ch,p,l,l1,l2,i,f,cifra,m1,n1,cod:integer; a,b,m,n:String;

BEGIN ClrScr; Write('Введіть перше число А=');Read(a);Readln;

Write('Введіть друге число В=');Read(b);Readln;

l1:=Length(a);l2:=Length(b);

If l1>l2 Then For i:=1 to l1-l2 do b:='o'+b else

For i:=1to l2-l1 do Begin a:='a'+a End; l:=Length(b); i:=1; p:=0;

While i<= l do Begin m:=Copy(a,l-i+1,1); n:=Copy(b,l-i+1,1);

Val(m,m1,cod); Val(n,n1,cod);

Ch:=m1+n1+p; t[i]:=ch Mod 10; p:=ch div 10; i:=i+1 End;

If p=1 Then Write(p); For i:=l Downto 1 do Write(t[i]); Readkey

END.

Задача.Числова спіраль закручуэєься проти часової

стрілки від N*N до 1

Program Ch_spiral;

Uses Crt;

Var i,j,n,k,s,m,a,b:integer;

BEGIN ClrScr;k:=1; s:=1; a:=8;b:=40; Textcolor(13);

Write('Ведите число ( 0< N <19 ) N='); read(n);m:=n*n;GotoXY(b,a);Write(s);

While m>s do Begin Textcolor(14);

If m>s Then Begin For i:=1 to k do begin s:=s+1;GotoXY(b+4,a);Write(s); b:=b+4; end; End;

If m>s Then Begin For j:=1 to k do begin s:=s+1;GotoXY(b,a+1);Write(s); a:=a+1; end;i:=j; k:=k+1 End;

If m>s Then Begin For i:=1 to k do begin s:=s+1;GotoXY(b-4,a);Write(s); b:=b-4; end;j:=i End;

If m>s Then Begin For j:=1 to k do begin s:=s+1;GotoXY(b,a-1);Write(s); a:=a-1; end; k:=k+1; End; End; GotoXY(b,a);

Write(' ');readkey; END.


Задача.Числова спіраль закручується по часовій стрілці

від 1 до N*N .

Program OL_99_3;

Uses Crt;

Const m=19;

Var i,j,k,n:integer; a:array[1..m,1..m]of integer;

Function MOV:boolean;

Begin mov:=FALSE; If k<=N*N Then begin a[i,j]:=k;k:=k+1;mov:=true end End;

BEGIN Clrscr; k:=1;i:=1;j:=1; writeln('Введiть число N=');Read(n);

REPEAT

While MOV and (i+j

While MOV and (i

While MOV and (i+j>n+1) do j:=j-1; k:=k-1;

While MOV and (i>j+1) do i:=i-1; k:=k-1;

UNTIL k=n*n; For i:=1 to n do Begin

For j:=1 to n do write(a[i,j]:4); Writeln End; Readkey

END.


Скласти алгоритм обчислення суми значень многочлена 3*X^4+2*X^2+1 на відрізку від А до В з кроком h.

Program Krok;

Uses Crt;

Var a,b,h,x,y,s:Real;

Begin ClrScr;

Write('Введіть A,B,h через пропуск ->');Read(a,b,h); X:=A; { Число початку циклу }

{ B-> число кінця циклу ,h-> крок циклу} While X<=B do Begin { Початок циклу }

Y:=3*Sqr(Sqr(X))+2*Sqr(X)+1; { Формула многочлена }

S:=S+Y; { Підрахунок суми } X:=X+H { Крок в циклі} End; { Кінець циклу }

Writeln(' Сума,S=',s:2:2); { Вивід суми підрахунку } Readkey END.


Задача.. З множини чисел 1..20 виділити ті числа,що діляться на 6 без остачі і ті, що діляться на 2 або 3 без остаачі.




Program Mnoj;

Uses Crt;

Const N=20;

Var n2,n3,n6,n23:set of byte; k:integer;

BEGIN ClrScr;n2:=[];n3:=[];

For k:=1 to n do Begin

if k mod 2=0 then n2:=n2+[k];

if k mod 3=0 then n3:=n3+[k]

End;

n6:=n2*n3; n23:=n2+n3;

Writeln(' На 6 діляться числа:');

For k:=1 to n do if k in n6 then write(k:3); Writeln;

Writeln(' На 2 або 3 діляться числа:');

For k:=1 to n do if k in n23 then write(k:3); Readkey

END.


Закдача.Скласти програму для сортування одновим. масива.

Program Sort;

Uses Crt;

Var i,a,r,j:integer; x:array[1..100]of integer; y:real;

BEGIN Clrscr;Randomize;

write('Введіть к-ть випадкових чисел К=');read(a);

writeln('Числа до сортування.');

For i:=1 to a do Begin

y:=random(50);x[i]:=round(y);write(round(y),' ');

End; writeln;

For i:=1 to a-1 do Begin

For j:=i+1 to a do Begin

if x[i]>x[j] Then Begin r:=x[i];x[i]:=x[j];x[j]:=r End;

End End;writeln('Числа післе сортування.');

For i:=1 to a do begin write(x[i],' ') end; Readkey

END.







Задача.Створити програму для визначення інтегралу.

Program integral;

Uses Crt;

Var a,b,x,h,s:real; n,i:integer;

BEGIN Clrscr; {Проміжок інткгрування};

write('Введіть через пропуск A,В='); read(a,b);{К-ть поділок інтегрувания}; write('Введіть к-ть поділок N='); read(n);

h:=(b-a)/n;s:=0;x:=a-h/2;

For i:=1 to n do Begin x:=x+h;s:=s+sqrt(x*2+1) {Формула інтеграла}; End;

s:=s*h;writeln('ВІДПОВІДЬ , I=',s:3:5); Readkey

END.


Задача.Визначення найменьшого значення в поданій функції.

Program minim;

Uses Crt;

Var Y:array[1..10]of real; X1:array[1..10]of real;

miny,minx,x:real; i,j:integer;

BEGIN ClrScr;

REPEAT

i:=i+1;y[i]:=Sqr(x)-4*x+5;x1[i]:=x;

if i=5 then TextColor(14) Else TextColor(15);

Writeln('При X=',x1[i]:2:2,' F(x)=',y[i]:2:2); x:=x+0.5;

UNTIL i=9;Writeln;

miny:=y[1];minx:=x1[1];

For j:=2 to i do Begin

If y[j]

End; TextColor(11);

Writeln('Для функці• У=X^2-4*X+5, X в межах від 0 до 4');

Writeln;TextColor(14);

Writeln('Minimum при X=',minx:2:2,', F(x)=',miny:2:2); Readkey

END.




Програми з літерними величинами

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

Program Golosni;

Uses Crt;

Var i:integer;sv:string;

Procedure rach(var n:integer;b:string);

Var j:integer;

Begin N:=0;

For j:=1 to Length(b) do

If b[j] in ['а','о','у','е','i','и'] Then N:=n+1 End;

BEGIN Clrscr;i:=0;

Write('Введите слово->');Read(sv);readln;

rach(i,sv);

Writeln(i,' -голосних букв ');

Readln;Readln

END.


Задача на заміну букви або слова

Program Zamena;

Uses Crt;

Var r,r1,r2:string; N:integer;

BEGIN ClrScr;TextColor(14);

Write('Введiть слово або текст-> ');Read(r);Readln;

TextColor(11);

Write('Замiнити букву або слово-> ');Read(r1);Readln;

Write('На iншу букву або слово-> ');Read(r2);Readln;

While Pos(r1,r)>0 do Begin

N:=pos(r1,r);Delete(r,n,Length(r1)); Insert(r2,r,n)

End; TextColor(14);

Write('Нове слово або текст-> ');Write(r);

Readln END.







Задача на обернення слова

Program Oborot;

Uses Crt;

Var r,r1,r2:string[20]; i:integer;

BEGIN Clrscr;r1:='';r2:='';

Write('Введите слово->');Read(r);

For i:=1 to Length(r) do

Begin r1:=Copy(r,i,1); r2:=Concat(r1,r2); End;

Writeln;Writeln(r,' -> ',r2);

Readln;Readln

END.

Задача на відгадування букв або слова

Program Min_pole;

Uses Crt; Label 1;

Var t,a,t1:string[25]; b:char; s,k,i,d,d1,s1:integer;

BEGIN ClrScr;TextMode(1);s:=0;k:=0;d:=0;d1:=0;textColor(14);

GotoXY(2,5);Write('Введите слово->');TextColor(0);read(t);

GotoXY(2,5);Write(' ');

TextColor(12);GotoXY(2,8);

Write('Cлово c области->');readln(t1); Readln;

TextColor(11);GotoXY(2,9);Write('----- - ------- -----------------');

GotoXY(1,19);TextColor(9);Write('---------------------------------');

GotoXY(5,18);Write('Место для вводимых букв');

For i:=1 to Length(t) do Begin

TextBackgRound(11);GotoXY(10+s,1);Write(' '); s:=s+2;

TextBackgRound(0);TextColor(13);GotoXY(8+s,2);Write('-');

End; TextBackgRound(0);

1: TextColor(11); d:=d+1;GotoXY(1,12);

Write('Введите букву или слово->');read(b);s:=0;

s1:=Round(d/3)+1;GotoXY(s1,20);TextColor(15);Write(b);

GotoXY(1,12);Write(' ');

For i:=1 to Length(t) do begin s:=s+2;

If b=Copy(t,i,1) then Begin GotoXY(8+s,1);Write(b);k:=k+1 end;

End; d1:=round(d/3)+1;GotoXY(8,15);TextColor(14);

Write('Попытка-> ',d1,'-ая');

If k<> Length(t) Then goto 1;TextColor(13); GotoXY(2,15);

Write('МОЛОДЕЦ ! Отгадано за ',d1,' попыт.');

Readln; readln END.


Програма для відображення різного типа шрифта

Program Srift;

Uses Graph,Crt;

Const

FontNames:array[1..10]of String[4]=('TRIP','LITT','SANS',

'GOTH', 'SCRI', 'SIMP','TSCR','LCOM','EURO','BOLD');

Tab1=50; Tab2=150; Tab3=220;

Var d,r,Y,dY,Size,MaxFont,k:Integer;

NT,SizeT,SymbT:String; c:Char;

Procedure OutTextWithTab(s1,s2,s3,s4:String);

Begin MoveTo((Tab1-TextWidth(s1)) div 2,Y);

OutText(s1); MoveTo(Tab1+(tab2-tab1-TextWidth(s2)) div 2,Y);

OutText(s2); MoveTo(Tab2+(tab3-tab2-TextWidth(s3)) div 2,Y);

OutText(s3);

If s4='Symbols' Then MoveTo((Tab3+GetMaxX-TextWidth(S4)) div 2,Y) Else MoveTo(Tab3+3,Y); OutText(S4) End;

BEGIN InitGraph(d,r,'');

{$IFDEF VER70}

MaxFont:=10; {$ELSE}

MaxFont:=4; {$ENDIF}

SetTextStyle(1,0,4); Y:=0;

OutTextWithTab('N','Name','Size','Sumbols');

Y:=4*TextHeight('Z') div 3;

Line(0,Y,GetMaxX,Y);

Y:=3*TextHeight('Z') div 2; dY:=(GetMaxY-Y) div (MaxFont);

SymbT:='';

For c:='a' to 'z' do SymbT:=SymbT+c;

For k:=1 to MaxFont do

Begin Size:=0;

Repeat

Inc(Size); SetTextStyle(k,0,Size+1);

Until (TextHeight('Z')>=dY) or (Size=10)

or (TextWidth(FontNames[k])>(Tab2-Tab1));

Str(k,NT); Str(Size,SizeT); SetTextStyle(k,HorizDir,Size);

OutTextWithTab(NT,FontNames[k],Sizet,SymbT);

inc(y,dy) End; Rectangle(0,0,GetMaxX,GetmaxY);

Line(Tab1,0,Tab1,GetMaxY); Line(Tab2,0,Tab2,GetMaxY);

Line(Tab3,0,Tab3,GetMaxY); Readln; CloseGraph

End.

Програми для демонстрації графічних можливостей Turbo Pascal 7.0 ver. з поясненям деяких стрічок.

Program Style;

Uses Crt,Graph;

Var d,r:integer;

BEGIN d:=detect; initgraph(d,r,'');

Bar3d(80,100,120,180,15,TopOn);Bar3d(150,150,190,180,15,

TopOff);

Bar3d(230,50,250,150,15,TopOn);Bar3d(220,150,260,180,15,

TopOn);

Bar3d(300,150,340,150,15,TopOff);Bar3d(300,50,340,150,15,

TopOn); Repeat Until readkey=#13; Closegraph END.


Практична робота з графічним режимом.

Program Mal_4;

Uses Crt,Graph;

Const n:array[1..10]of integer=(240,195,160,255,380,255,460,195,240,195);

Var d,r:integer;

BEGIN

d:=detect; initgraph(d,r,'');{Відкриття графічного режиму}

SetbkColor(11); {Колір фона}

Setcolor(1); {Колір ліній}

DrawPoly(5,n); {Площа підставки фігури}

SetFillStyle(10,13);FloodFill(220,240,1);

{Зафарбовування площі}

setcolor(1); Line(320,225,320,105);

{Проведення лінії підставки}

Sector(320,105,135,225,100,60); {Лівий сектор}

ellipse(320,105,315,45,100,60); {Дуга правого сектора }

line(320,105,394,62);line(320,105,392,150);

{Лінії правого сектора}

SetFillStyle(3,4);FloodFill(260,105,1);

{Зафарбовування секторів}

FloodFill(380,100,1);

{-----------------------------------------------------------------}

{Вивiд тексту}

OutTextXY(220,280,'Б А Б О Ч К А');SetColor(5);

SetTextStyle(0,0,1);

OutTextXY(160,300,'ЗАЛIК З ГРАФIЧНОГО РЕЖИМА.');

SetColor(4);SetLineStyle(1,1,1);Line(160,310,360,310);

readln; {Затримка програми} Closegraph

{Закриття графічного режиму}

END.


Практична робота з графічним режимом (відображення

геометричних елементів)

program prk1;

uses crt,graph;

var d,m:integer;

BEGIN

d:=3;m:=1; {Дані для графічного режиму}

InitGraph(d,m,''); {Відкриття графічного режиму }

SetColor(14); {Колір в графічному режимі}

line(250,150,350,150);line(300,100,300,200);{лiнiя}

SetColor(10);circle(300,150,50);{круг}

SetColor(13); ellipse(100,200,0,360,50,20);{елiпс}

SetColor(15);arc(100,150,0,180,20);{дуга}

SetColor(11);sector(180,230,0,180,50,20);{сектор}

SetColor(15);bar(1,1,100,100);{прямокутник}

OutTextXY(250,38,'Г Р А Ф Ў К А');

{Текст в графічному режимі}

repeat until keypressed;{Вказівка затримки графічного екрана}

END.

Програма показу типів ліній в графічноиу режимі

Program Style;

Uses Crt,Graph;

Var d,r:integer;

BEGIN d:=detect; initgraph(d,r,''); SetColor(15);

SetLineStyle( 0,0,3); Line(10,10,350,10); SetLineStyle( 1,1,1); Line(10,30,350,30); SetLineStyle( 3,3,3); Line(10,50,350,50); SetLineStyle( 2,2,1); Line(10,70,350,70);

SetColor(14); OutTextXY(240,320,' Нажми ENTER !');

Repeat Until readkey=#13; Closegraph END.

Програма демонстрації скадних типів ліній.

Program line2;

Uses Crt,Graph;

Const style:array[0..4]of string[9]=('Сплошная','Точечная','Штрихп..','Пунктирн.',

'UserBitln');

Width:array[0..1]of string[11]=('Нормальн.:','Утолщен.:');

Var d,r,i,j:integer;

BEGIN d:=detect; initgraph(d,r,''); DirectVideo:=false;

For j:=0 to 1 do begin OutTextXY(0,j*40,width[j]);

for i:=0 to 3 do begin

SetLineStyle(i,0,j*2+1);Line(0,i*8+j*50+12,200,i*8+j*50+12);

OutTextXY(210,j*50+12+i*8,style[i]); end End;

repeat until readkey=#13; CloseGraph; END.

Програма динамічної графіки. Політ НЛО.

Program NLO;

Uses Graph,Crt;

Const r=23; {Размер тарелки}

pause=70; {Длительность паузы}

col=white;{Цвет тарелки}

Var d,m,e:integer;xm,ym,x,y,lx,ly,rx,ry,size,i,dx,dy,width,

height:integer; saucer:pointer;

Label Loop;

BEGIN

d:=Detect;InitGraph(d,m,''); e:=GraphResult;

if e<> grOk then Writeln(GraphErrorMsg(e))

else begin setGraphMode(0);

x:=r*5;y:=r*2;xm:=GetMaxX;ym:=GetMaxY;

{Создать блюдце из двух эллипсов с усами антенн}

SetColor(col); Ellipse(x,y,0,360,r+25,r div 3+2);

Ellipse(x,y-4,190,357,r+25,r div 3); Line(x+7,y-6,x+10,y-12);

Line(x-7,y-6,x-10,y-12); Circle(x+10,y-12,3);

Circle(x-10,y-12,3); SetFillStyle(SolidFill,col);

FloodFill(x+1,y+4,col);

{Определить его габариты и поместить в кучу}

lx:=x-26-r; ly:=y-13; rx:=x+26+r; ry:=y+25+r div 3+3;

width:=rx-lx+1; height:=ry-ly+1;

size:=ImageSize(lx,ly,rx,ry); GetMem(saucer,size);

GetImage(lx,ly,rx,ry,saucer^);

{Стереть построение}

PutImage(lx,ly,saucer^,XorPut);

{Создать звездное небо}

for i:=1 to 1000 do

PutPixel(Random(xm),Random(ym),Random(Succ(GetMaxColor)));

x:=xm div 2;y:=ym div 2;

dx:=GetMaxX div 100-Random(GetMaxX div 50);

dy:=GetMaxY div 40-Random(GetMaxY div 20);

{Основной цикл:ввести-пауза-стереть}

repeat PutImage(x,y,saucer^,XorPut);

Delay(pause); PutImage(x,y,saucer^,XorPut);

{Получить новые координаты}

loop: x:=x+dx;y:=y+dy;

if (x<0) or (x+width+1>xm) or (y<0) or (y+height+1+1>ym) then

begin x:=x-dx;dx:=GetMaxX div 10-Random(GetMaxX div 5);

dy:=GetMaxY div 40-Random(GetMaxY div 20);

goto loop end until KeyPressed; CloseGraph end END.


Побудувати спіраль в графічному режимі

Program spiral;

Uses crt,graph;

Var x,n,a,i,b,s,d,m:integer;

BEGIN Clrscr;

d:=3;m:=1;a:=300;b:=175;s:=0;

write('Ввудите длину отрезка X=');read(x); writeln;

write('Введите к-во отрезков N=');read(n);

InitGraph(d,m,'');

MoveTo(a,b);SetColor(14);

While n>s do begin

If n>s then begin s:=s+1;lineto(a+s*x,b);a:=a+s*x end;

If n>s then begin s:=s+1;lineto(a,b+s*x);b:=b+s*x end;

If n>s then begin s:=s+1;lineto(a-s*x,b);a:=a-s*x end;

If n>s then begin s:=s+1;lineto(a,b-s*x);b:=b-s*x end;

End;

OutTextXY(220,15,'Архимедова спираль');

Readkey;CloseGraph END.


Демонстраційна програма заповнення всіх типів заповнення

шриховками прямокутників.

Program Style;

Uses Crt,Graph;

Var d,r,k,j,x,y:integer;

BEGIN d:=detect; initgraph(d,r,'');

x:=GetmaxX div 7; {Положение графики }

y:=GetmaxX div 6; {на экране}

For j:=0 to 2 do {Два ряда}

For k:=0 to 3 do begin {по четыре квадрата}

Rectangle((k+1)*x,(j+1)*y,(k+2)*x,(j+2)*y); SetFillStyle(k+j*4,j+1);

Bar((k+1)*x+1,(j+1)*y+1,(k+2)*x-1,(J+2)*y-1) End;

If Readkey=#0 then k:=ord(Readkey); Closegraph END.

Програма демонстрації різних типів і напрямків тексту в графічному режимі.

Program TextGraf;

Uses Crt,Graph;

Const text:array[1..4] of string[14]=('TriplexPont','SmallFont',

'SansSeriFont','GothicFont');

s4=',size 4';s5=',Ku-ku';s6='Граф. режим';

Var d,r,i:integer;

BEGIN d:=detect; initgraph(d,r,'');

SetTextStyle(DefaultFont,HorizDir,1);

OutText('DefaultFont,size 1');

SetTextStyle(0,0,2);OutText(', Pi=3.14');

{Горизонтальный вывод текста}

For i:=1 to 4 do begin SetColor(i+9);

SetTextStyle(i,0,4);MoveTo(10,i*40);OutText(text[i]+s4);

SetTextStyle(i,0,5);OutText(s5)

End; (Вертикальный вывод текста}

For i:=1 to 4 do begin Setcolor(i+11);

SetTextStyle(i,1,4); MoveTo(GetMaxX div 2+i*40+100,0);

OutText(text[i]) End;

SetColor(14); Circle(320,300,60); SetTextStyle(0,1,1);

OutTextXY(100,210,s6);SetColor(15);

SetTextStyle(0,0,2); OutTextXY(220,210,s6);

Repeat Until readkey=#13; Closegraph

END.

Програма демонстрації годинника в графічному режимі

program timer;

Uses Graph,CRT;

Const dr=0.9;

Var d,r,i,x0,y0,x1,y1,x2,y2:integer;

Xasp,Yasp:word;

Begin

d:=detect;InitGraph(d,r,'');i:=GraphResult;

if i<>grOK then Writeln(GraphErrorMSG(i))

else begin

x0:=getmaxX div 2;y0:=GetMaxY div 2;

GetAspectRatio(Xasp,Yasp);r:=y0;

Circle(x0,y0,r);circle(x0,y0,round(r*dr));

for i:=0 to 59 do

begin

x1:=x0+round(dr*r*sin(2*pi*i/60));

x2:=x0+round(r*sin(2*pi*i/60));

y1:=y0-round(dr*r*Xasp*cos(2*pi*i/60)/Yasp);

y2:=y0-round(r*Xasp*cos(2*pi*i/60)/Xasp);

Line(x1,y1,x2,y2); end;

FloodFill(x0,y0,white);SetWriteMode(XORPut);

repeat

for i:=0 to 59 do

if not KeyPressed then

begin x2:=x0+Round(dr*r*sin(2*pi*i/60));

Y2:=y0-Round(dr*r*Xasp*cos(2*pi*i/60)/Yasp);

Line(x0,y0,x2,y2); Delay(1000); {Задержка}

setpalette(0,0); Line(x0,y0,x2,y2); end; until KeyPressed; end END.






Деякі задачі з районних олімпіад

Екологiчна задача

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

-початково забруднена клітина знаходиться в центрі квадрата;

-у кожний інтервал часу інфекційна клітина може з вірогідностю 0,5 заражати кожну із сосідніх здорових клітин;

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

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

Program zad3;

Uses Crt;

label 1;

Const matr:array[1..11,1..11]of integer=((10,9,8,7,6,5,6,7,8,9,10),(9,8,7,6,5,4,5,6,7,8,9),(8,7,6,5,4,3,4,5,6,7,8),(7,6,5,4,3,2,3,4,5,6,7),(6,5,4,3,2,1,2,3,4,5,6),(5,4,3,2,1,0,1,2,3,4,5),(6,5,4,3,2,1,2,3,4,5,6),(7,6,5,4,3,2,3,4,5,6,7),(8,7,6,5,4,3,4,5,6,7,8),(9,8,7,6,5,4,5,6,7,8,9), (10,9,8,7,6,5,6,7,8,9,10));

Var i,j,k,t,zr,zd,inn,s,r,s1:integer;

BEGIN ClrScr;

Write('Введи термiн часу Т='); read(r); s1:=0;

For t:=0 to r do Begin zd:=120; zr:=0; inn:=0; ClrScr; Writeln;

For i:=1 to 11 do begin

For j:=1 to 11 do begin

if (matr[i,j]>=t-2)and(matr[i,j]<=t) then Begin

Textcolor(11);write('0 '); zr:=zr+1; goto 1 end;

if (matr[i,j]>=t-4)and(matr[i,j]<=t-2)then Begin Textcolor(14);write('0 ');

Inn:=Inn+1; goto 1 end;

Textcolor(13);Write('o ');

1: end;Writeln ;end; zd:=zd-(zr+inn); s:=zd+zr+inn;Textcolor(15);

Writeln('К-ть термiнiв часу =',s1); Textcolor(10);

Writeln('К-ть iнфекцiйних клiтинок =',zr);

Writeln('К-ть iмунiтетних клiтинок =',Inn);

Writeln('К-ть здорових клiтинок =',zd);

Delay(5000);s1:=s1+2

end; readkey

END.

ЗАДАЧА

Монети. На кожнiй клiтинцi шахiвницi розмiром (n*m) клiтин покладено певну кiлькiсть монет (вiд 0 до R), яка задається елементами таблицi А[N,M]. Яку найбiльшу кiлькiсть монет можна зiбрати з полiв шахiвницi якщо:

а) починати збирати з лiвої ножньої клiтини;

б) закiнчити у верхнiй правiй клiтині;

в) перехiд на нову клiтину здiйснюється або вгору-U, або праворуч-R. ПРОГРАМА

program MONETY;

const nmax=20;

var a,c: array[1..nmax,1..nmax] of word;

b: array[1..nmax,1..nmax] of boolean;

j,k,l,m,n: integer; o: text; begin{program}

{Зчитування даних}

assign(o,'MONEY.D_1'); reset(o); readln(o,m,n);

for k:=1 to m do for j:=1 to n do read(o,a[k,j]); close(o);

c[1,n]:=a[1,n]; {Знаходження матриць b і с}

for k:=2 to m do

begin c[k,n]:=c[k-1,n]+a[k,n]; b[k,n]:=true end;

for j:=n-1 downto 1 do

begin c[1,j]:=c[1,j+1]+a[1,j]; b[1,j]:=false end;

for k:=2 to m do for j:=n-1 downto 1 do if c[k-1,j]>c[k,j+1]

then begin c[k,j]:=c[k-1,j]+a[k,j]; b[k,j]:=true end

else begin c[k,j]:=c[k,j+1]+a[k,j]; b[k,j]:=false end;

{Визначення послідовності напрямків руху і запис відповіді}

assign(o,'MONEY.RES'); rewrite(o); writeln(o,c[m,1]);

j:=1; k:=m; for l:=1 to m+n-2 do

if b[k,j] then begin write(o,'u'); k:=k-1 end

else begin write(o,'r'); j:=j+1 end; close(o); halt

END.




Файл даних MONEY.D_1.

5 5

1 1 22 6 7

17 8 5 10 11

3 12 2 22 2

8 23 10 20 9

18 22 18 8 5

Файл відповіді MONEY.R_1

143

rurruuru


ЗАДАЧА

Рахiвничка. N-дiтей стоять по колу та рахують один одного вiд першого до К, при цьому К-та дитина вибуває

з гри. Визначити номеp дитини, яка залишається.}

ПРОГРАМА

Program schitalka;

Uses Crt;

label 1;

Const g=300;

Var igr:array[1..g] of boolean;

o:text;

nom,k,l,m,n,j,d:integer;

BEGIN Clrscr;

assign(o,'schit.D_1'); reset(o); readln(o,N,M);close(o);

Writeln('Введiть данi: 0-iз клавiатури; 1-iз файла');

read(d);if d=1 then goto 1;

Write('Введiть к-ть дiтей N=');readln(n);

Write('Введiть номер рахунку M=');readln(m);

Writeln('Порядок вибувших номерiв вiд початку рахування');

1: For l:=1 to n do igr[l]:=true; l:=n;

assign(o,'schit.R_1'); rewrite(o);

For k:=n downto 1 do Begin

For j:=1 to m do

Repeat

l:=(l mod n)+1;

Until igr[l]; igr[l]:=false;

write(l,' '); write(o,l,' '); end;Writeln;

nom:=l;Writeln('Залишається пiд N=',nom);

writeln(o,'N=',nom); close(o); readkey END.


Файл даних Schit.d_1.

7 3

Файл відповіді Schit.r_1.

3 6 2 7 5 1 4 N=4.

Завдання ІІ етапу Всеукраїнської учнівської олімпіади

з інформатики ( 9-11клас)

1.Піраміда(5 балів).

Правильна чотирикутна піраміда заповнена кульками. В основі піраміди лежить квадрат, довжина сторони якого дорівнює N- діаметрам кульок ( N< = 50). Усі наступні шари до вершини піраміди також мають форму квадрата, але довжина його сторони зменшується кожного разу на один діаметр кульки. У вершині піраміди 1 кулька.

Визначити кількість кульок, яка необхідна для побудови піраміди із N- шарів.

Файл даних ball. dat містить натуральне число, яке вказує кількість шарів для побудови піраміди.

Программа до задачі №1

program Piramid;

Uses crt;

var f1,f:Text;

n,i,s,n1:integer;

begin ClrScr; s:=0;

Assign(f,'Ball.dat'); Reset(f);

Assign(f1,'Ball.rez'); Rewrite(f1);

Read(f,n1);Close(f);

write('Vvedite N='); Read(n);

For i:=1 to N do s:=s+Sqr(i);

writeln(' Ваша відповідь, S=',s);

Write(f1,s);Close(f1); readln;readln end.

Файл результатів ball.rez містить натуральне число- кількість кульок у побудованій піраміді.

ball. dat

ball.rez

1

1

2

5

8

204


2. ДТП (10балів)

Три товариші були свідками дорожньо-транспортної пригоди. Один із них запам’ятав, що 4 - значний номер авто порушника ділиться без остачі на 2, 7 і 11. Другий зазначив ,що в записі номера є дві однакові цифри ,а третій пригадав ,що сума цифр номера 30. Складіть програму, яка допоможе працівникам ДАІ визначити номер авто порушника.

Файл результатів ball.rez містить єдине натуральне число - номер авто.

Программа до задачі №2

Program Dai;

Uses Crt;

Var f1:Text; a1,a2,a3,a4,n,m,s,x:Integer;

BEGIN ClrScr;n:=3999;m:=9993;s:=30;

Assign(f1,'Ball.res'); Rewrite(f1);

For x:=n to m do begin;

a1:=x div 1000;a2:=x mod 1000 div 100;

a3:=x mod 100 div 10; a4:=x mod 10;

If ((a1+a2+a3+a4=s)) and ((x mod 2=0) and (x mod 7=0) and (x mod 11=0))

and((a1=a4)and(a2=a3)) Then Begin

Writeln('Ваш номер машини № =',x);

Write(f1,x) end; End; Close(f1);

Readln;Readln END.

Зміст файлу результатів ball.rez 8778

3. Улюблені онуки (25 балів).

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

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

Вихідний файл malas.res містить єдиний рядок із чотироьх пар записів , розділених комою: ім’я хлопчика ( Микола, Борис, Юрко, Вовчик) та його номер приїзду ( перший , другий, третій, четвертий).

Программа до задачі №3


Program Vnuki;

Uses Crt;

Const V:array[1..4] of String[7]=('Миколка','Борис

','Юрко ',' Вовчик ');

n:array[1..4] of String[12]=(' перший ',' другий,',' третiй, ',' четвертий ,');

Var i: integer; f1:Text; R:String;

BEGIN ClrScr; R:=' ';

Assign(f1,'Mslas.res'); Rewrite(f1);

For i:=1 to 4 do Begin

If i=1 Then r:=Concat(v[i],n[3]);

If i=2 Then r:=r+Concat(v[i],n[2]);

If i=3 Then r:=r+Concat(v[i],n[4]);

If i=4 Then r:=r+Concat(v[i],n[1]) End;

Write(r);Write(f1,r); Close(f1);

Readln;Readln

END.

Зміст файлу результатів malas.res

Микола третій, Борис другий, Юрко четвертий, Вовчик перший

4. Котигорошко (35 балів)

Відомий український казковий песонаж Котигорошко отримав нове завдання від кмітливого царя: врятувати життя прекрасної красуні, вкраденої літаючим загоном із N-Зміїв Гориничів (N<=100). Сила окремого Змія визначається кількістю його М-голів (М <=50), але сила зміїного війська значно збільшується, як тільки Змії групуються ви літаючі загони. Так загальна сила літаючого загону із 3-щ Гориничів, які мають по 2,4 та 5 голів кожен, обчислюється як (2*4*5)*3=120 бойових одиниць.

Допоможіть, будь ласка, Котигорошку визначитися: якою силою особисто він повинен володіти, щоб перемогти зло та врятувати життя прикрасної дівчини.

Файл даних horoh.dat містить натуральні числа, розділені пробілом. Перше число вказує на кількість Гориничів у загоні, а наступні-на кількість голів у кожного із них.

Программа до задачі №4


program Zmia;

Uses Crt;

Var g:array[1..100] of integer;

n,m,i,n1:Integer; f,f1:Text;

fG,fk:longint;

BEGIN ClrScr; FG:=1;

Assign(f,'Horoh.dan'); Reset(f);

Assign(f1,'Horoh.res'); Rewrite(f1);

Read(f,n1);

For I:=1 to n1 do Begin Read(f,g[i]);

FG:=FG*g[i] End;

FG:=FG*n1;

FK:=FG+1; Write(' Вiдповiдь F=',FK);

Write(f1,Fk); Close(f);Close(f1);

Readln;Readln End.

Файл результатів horoh.res містить єдиний запис найменшого значення сили, необхідної Котигорошку для перемоги.

Файл даних horoh.dat

Файл результатів horoh.res

3 2 4 5

121

5 12 90 3 44 5

3564001

10 2 11 2 3 55 6 33 2 1 10

287496001

12 3 7 8 1 1 3 12 93 6 8 11 28

99785613313

Завдання для проведення І етапу Всеукраїнської учнівської олімпіади з в 2002-2003 навчальному році (8-11 к)

Задача N1. Вiдстань мiж мiстами (5 балiв). N мiст розташованi вздовж однієї дороги. Необхiдно розробити довiдкову систему, яка для будь-яких заданих двох мiст повiдомляє вiдстань мiж ними.Запропонуйте органiзацiю даних i алгоритм (програму), що виконує це з мiнiмальною пам'яттю i за як можна

меньшу кiлькiсть дiй.

Program z1_2002;

Uses Crt;

Var i,j,n:integer;

a:array [1..10,1..10] of integer; x:array[1..10]of integer;

BEGIN ClrScr ;

write('Введiть кi-ть мiст N=');read(n);x[1]:=0;

For i:=2 to n do Begin

write('Ввеiдiть вiдстань вiд 1 дo ',i,' -гo мiста->');read(x[i]);

end;writeln;writeln;

For i:=1 to n do Begin

For j:=1 to n do Begin

If i<=j Then A[i,j]:=abs(x[j]-x[i]) else A[i,j]:=abs(x[i]-x[j]);

If a[i,j]<10 Then Write(' ',a[i,j]) else Write(' ',a[i,j]);

End; writeln;writeln End; Readkey

END.

Задача N2. Пошук вiдсутнього числа (5 балiв). У таблицi iз N елементiв зберiгаються цiлi числв вiд 1 до N. Однакових чисел в таблицi немає. Написати алгоритм (програму), що визначає якого цiлого числа вiд 1 до N у таблицi немає.

Program OL_10_02_2;

Uses Crt;

Const x:array[1..20]of integer=(3,2,5,7,4,9,11,18,1,0,8,6,13,17, 19,12,14,16,10,20);

Var i,j,n,m,s,k,t:integer; a:array[1..20]of integer;

BEGIN Clrscr;n:=5;m:=4;s:=0;k:=0;t:=n*m;writeln;

For i:=1 to n do Begin

For j:=1 to m do Begin s:=s+1;a[s]:=s;

If x[s]<10 Then Write(' ',x[s]) else Write(' ',x[s]); End ;writeln end;s:=0; writeln;

For i:=1 to t do begin s:=s+1;

For j:=1 to t do Begin if x[i]=a[j] then a[j]:=0; end; end;

For i:=1 to t do begin

if a[i]>0 then writeln(' Ваше шукане число Х= ',a[i]) end; Readkey

END.

Задача N3.Число фокус (5 балiв). Написати програму, яка реалiзовує такий фокус:

Людина задумує цiле число вiд 1 до 1000 i обчислює остачу вiд дiлення цього числа на 7, 11, 13 i повiдомляє цi остачi програмi. Програма повинна визначити задумане число .

Program Fokus;

Uses Crt;

Var r7,r11,r13,a,b,c,x,a1,b1,c1:Integer;

BEGIN ClrScr;

Write('Введiть остачу R7,R11,R13=');read(r7,r11,r13);

For x:=1 to 1000 do begin;

a:=x div 7;b:=x div 11;c:=x div 13;

a1:=a*7+r7;b1:=b*11+r11; c1:=c*13+r13;

if ((a1=b1) and(r7=x mod 7))and((c1=b1)and(r11=x mod 11))

and((c1=a1)and(r13=x mod 13)) Then Writeln('Будь ласка ваше число X=',x)

end; Readln;Readln END.

Завдання для 11 класу.

Задача N1. Вiдстань мiж мiстами (5 балiв). N мiст розташованi вздовж однієї дороги.Необхiдно розробити довiдкову систему, яка для будь-яких заданих двох мiст повiдомляє вiдстань мiж ними.Запропонуйте органiзацiю даних i алгоритм (програму), що виконує це з мiнiмальною пам'яттю i за як можна

меньшу кiлькiсть дiй.

Program z1_2002;

Uses Crt;

Var i,j,n:integer;

a:array [1..10,1..10] of integer; x:array[1..10]of integer;

BEGIN ClrScr ;

write('Введiть кi-ть мiст N=');read(n);x[1]:=0;

For i:=2 to n do Begin

write('Ввеiдiть вiдстань вiд 1 дo ',i,' -гo мiста->');read(x[i]);

end;writeln;writeln;

For i:=1 to n do Begin

For j:=1 to n do Begin

If i<=j Then A[i,j]:=abs(x[j]-x[i]) else A[i,j]:=abs(x[i]-x[j]);

If a[i,j]<10 Then Write(' ',a[i,j]) else Write(' ',a[i,j]);

End; writeln; writeln End; Readkey

END.

Задача N2. Пошук вiдсутнього числа (5 балiв). У таблицi iз N елементiв зберiгаються цiлi числв вiд 0 до K, К>N. Написати алгоритм (програму), що визначає яке-небудь число вiд 0 до К, якого у таблицi немає.

Для розв'язування завдання не можна використовувати iнших таблиць, крім заданої i змiнювати значення заданої таблицi

Program OL_11_02_2;

Uses Crt;

Const x:array[1..21]of integer=(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,18,19,20,21,22);

Var i,j,n,m,s,k:integer;

BEGIN Clrscr;n:=5;m:=4;s:=0;k:=0;writeln;

For i:=1 to n do Begin

For j:=1 to m do Begin s:=s+1;

If x[s]<10 Then Write(' ',x[s]) else Write(' ',x[s]);

if Succ(x[s]+1)=x[s+1] then k:=Succ(x[s]);

End ;writeln end; writeln;

writeln(' Ваше шукане число Х= ',k);

Readkey END.

Задача N3. Число фокус. (5 балiв). Написати програму яка реалiзовує такий фокус: задано N взаємопростих чисел К[1],K[2],....K[N].людина задумує ціле число вiд 0 до К[1]*K[2],*....*K[N], обчислює остачi вiд дiлення цього

числа на К[1],K[2],....K[N] та повiдомляє цi остачi програмi, Програма повинна визначити задумане число.

Program OL_11_3_02;

Uses Crt;

label 1,2;

Var i,x,s,n,d:integer;

k,os,r:array[1..10]of integer;

BEGIN Clrscr;d:=1;

writeln('Введiть к-ть взаємопростих чисел N=');Read(n);

For i:=1 to n do Begin

writeln('Введ. ',i,'-ше взаємопр. число i його ост. через проп. ');

read(k[i],os[i]);d:=d*k[i]; end;

For x:=1 to d do Begin s:=0;

For i:=1 to n do begin

r[i]:=x mod k[i]; If r[i]=os[i] Then s:=s+1; End;

if s=n then Begin Writeln('Ваше задумане число X=',x);s:=0 end;

End; Readkey END.

Завдання для проведення ІІ етапу Всеукраїнської учнівської олімпіади з в 2002-2003 н. р. (8-11 класи)

Задача №1. Многоугольник (20 балів)

В опуклому N-кутнику провели всі діагоналі так, що ніякі три з них не перетинаються в одній точці. Необхідно написати програму знаходження кількості частин, на які був розбитий многокутник після поділу.

Можлива програма до даної задачі.

Program ol_r_1;

Uses Crt;

Label 1,2;

Var N,s,m,k,i,cof,Ug:Integer;

Fac,Fac1,Fac2:real; f,f1:text;

BEGIN ClrScr; k:=4;Fac:=1;Fac1:=1;Fac2:=24;N:=0;Ug:=0;

Assign(f,'Nkut.dat'); Reset(f); {Вхідний файл}

Assign(f1,'Nkut.res'); Rewrite(f1);{Вихідний файл}

1: Write('Введіть к-ть кутів многокутника N='); Read(f,n);

If n<4 then goto 1; if n<6 then cof:=2 else cof:=1;

If n=4 then Begin s:=n*1; goto 2 End;

If N<15 Then M:=n-k else Begin m:=n-10;Ug:=6 End;

For i:=1 to n do Fac:=Fac*i;

For i:=1 to n -k do Fac1:=Fac1*i;

s:=Round(Fac/(Fac2*Fac1))*cof+sqr(m)+Ug; {Підрахунок можливих комбінацій}

2: Writeln('Otvet X=',s);

Write(f1,'Otvet X=',s);{Запис даних у вихідному файлі}

Close(f);Close(f1);{Закриття файлів}

Readkey

END.

Наприклад: При введені даних із вхідного файла Nkut.dat N=10

В вихідному файлі Nkut.res буде відповідь N=246

Задача №2.Числа. (30 балів)

У нескінченій послідовності записані двійкові числа зростання:

1 10 11 100 101 110 111 1000 1001 1010 1011 ...Визначити яка цифра знаходиться на N-му місці.

Можлива програма до даної задачі.

program ol_r_2;

Uses Crt;

Const R='11011100101110111100010011010101110000100011001010011100000100001100010';

r1='100011100000010000011000010100001110000000100000011000001010000011';

Var Str:String;

Poz:Integer;f,f1:text;

Begin ClrScr;

Assign(f,'Number.dat'); Reset(f); {Вхідний файл}

Assign(f1,'Number.res'); Rewrite(f1); {Вихідний файл}

Write(''Введіть порядковий номе числа N='); Read(f,Poz);

if poz<=72 then Str:=Copy(R,Poz,1) Else

Begin Poz:=poz-72;Str:=Copy(R1,Poz,1) End;

Str:=Copy(R,Poz,1); Writeln(r2);

Writeln('Відповідь X=',Str);

Write(f1,'Otvet X=',Str); Close(f);Close(f1);

Readkey End.

Наприклад: При введені даних із вхідного файла Number.dat N=3 В вихідному файлі Number.res буде відповідь N=0

Задача №3. Стіна (50 балів)

Написати програму, яка, за заданими M i N (M>1, M<=1000), знаходить конструкцію, яку можна отримати шляхом вилучення із вихідної, по можливості максимальної кількості цеглин. При цьому верхній ряд повинен залишатись без змін, а конструкція не повинна втратити стійкйсть.

Можлива програма до даної задачі.

Program ol_r_z3;

Uses Crt;

Label 1,2;

Var i,j,t,s,m,n,k:integer;f,f1:text; a:array [1..20,1..20] of integer;

BEGIN ClrScr ; k:=1;t:=0;s:=0; Assign(f,'Wall.dat'); Reset(f); Assign(f1,'Wall.res'); Rewrite(f1);

Write('Введіть к-ь рядків і цеглин M,N=');Read(f,m,n);if n>10 Then goto 2;

For i:=1 to m do Begin if i=2 Then Begin n:=Round(n/2);k:=2 End; if i=3 Then k:=2;

if i=4 Then Begin k:=3;n:=Round(n/2); End;if i>4 Then k:=2;

if (m mod 2<>0) and (i>3) then begin t:=2;k:=1 End;

if (m mod 2<>0) and ((i>4)and(i<7)) then begin t:=2;k:=1;n:=1 End;

if (m mod 2<>0) and ((i>6)and(i<9)) then begin t:=2;k:=0;n:=1 End;

if (m mod 2<>0) and (i>8) then begin t:=1;k:=0;n:=1 End;

For j:=1 to n do Begin if (m mod 2<>0) and (j>2) then k:=1;

t:=t+k; a[i,j]:=t; Write(f1,a[i,j],' ');s:=s+1; if i=3 Then k:=1;

End; Writeln;t:=0; End;Writeln(f1,'К-ть цеглин S=',s); Goto 1;

2:For i:=1 to m do Begin

if i=2 Then Begin n:=Round(n/2);k:=2 End; if i=3 Then Begin t:=1;k:=1 End; if i=4 Then Begin k:=3;n:=Round(n/2); End; if i=5 Then Begin t:=2;k:=1 End;

if (i>5) and (i<7) Then Begin n:=3;t:=3;k:=1 End; if (i=7) Then Begin t:=3;k:=1 End;

if (i>7) and (i<14) Then Begin n:=2;t:=4;k:=1 End;

if (i>9) and (i<14) Then Begin n:=2;t:=5;k:=1 End;

if (i>11) and (i<14) Then Begin n:=2;t:=6;k:=1 End; if i>13 Then Begin n:=1;t:=7;k:=1 End;

For j:=1 to n do Begin if (i=3) and (j=3) then k:=3 ;if (i=3) and (j=4) then k:=1;

if (i=3) and (j=5) then k:=3; if (i=3) and (j=6) then k:=1;

if (i=3) and (j=7) then k:=2; if (i=4) and (j>1) then k:=4;

if (i=4) and (j=4) then k:=2; if (i=5) and (j>1) then k:=3;

if (i=5) and (j>2) then k:=5; if (i=5) and (j=4) then k:=1;

if (i=6) and (j>1) then k:=2; if (i=6) and (j=3) then k:=6;

if (i=7) and (j>1) then k:=1; if (i=7) and (j=3) then k:=6;

if (i=8) and (j>1) then k:=6; if (i=9) and (j=2) then k:=5;

if (i=10) and (j=2) then k:=4;if (i=11) and (j=2) then k:=3;

if (i=12) and (j=2) then k:=2;if (i=13) and (j=2) then k:=1;

if (i=15) or (i=16) then k:=0; if i=17 then k:=-1;

t:=t+k; a[i,j]:=t; Write(f1,a[i,j],' ');s:=s+1;

End; Writeln;t:=0; End; Writeln(f1,' К-ть цеглин S=',s);

1: Close(f);Close(f1); Readkey END.

Наприклад: При введені даних із вхідного файла Wall.dat M=2 ,N=2 В вихідному файлі Wall.res буде відповідь

3 -кількість цеглин

1 2 -конструкція стінки

2

Задача№1 (20 балів)Скласти програму для визначення Х-концертів із N виступів де забороняється підрят виступоти з «хорошими-1» концертами крім «плохих-0».

Наприклад: при N=4 1000,0100,0010,0001,0101,1001,1010, відповідь Х=7.

Програма до Задачі №1, ІІІ-го етапу Всеукраїнської олімпіади з інформатики 2002-2003 н.р.

Program ol_03_z1;

Uses Crt;

Label 2;

Var N,s,k,i,m:Integer; f,f1:text;

BEGIN ClrScr; m:=4; k:=3; S:=0;

{ Assign(f,'Signer.dat'); Reset(f);}

{ Assign(f1,'Signer.res'); Rewrite(f1);}

Write('Введите число N='); Read(n); { Read(f,n); }

If n<3 then Begin s:=n; goto 2 End;

If n=3 then Begin s:=n+1; goto 2 End;

For i:=m to n do Begin; s:=K+i+s; K:=0; {Ф о р м у л а}

End;

2: Writeln('О т в е т X=',s);

{Write(f1,'О т в е т X=',s); Close(f);Close(f1);}

Readln;Readln END.

Пізля запуску програми ми отримаємо відповідь

Приклад файлу Signer.dat Приклад файлу Signer.res

4 7

Задача№2. Singer(25 балів) Послідовність чисел (S(n)) утворюється за рекурентними формулами: S(1)=1, S(2)=2, S(k)= k, а при n>k S(n)=S(n-1)+S(n-2)+....S(n-k) і має вигляд наприклад для k=5: 1,2,3,4,5,,15,29,56,109,214,... Якщо числа цієї послідовності виписати одне за одним без пропусків, то утвореться деяка нескінчена послідовність цифр. Написати програму, що визначає якою буде m-та цифра в такій послідовності.

Т е х н і ч н і у м о в и:

  • вхідний файл Sequence.dat містить числа k i m (1<k<m<2003)

  • вихідний файл Sequence.res повинен містити одну з цифр 0,1,2,3,4,5,6,7,8,9.

Програма до Задачі №2, ІІІ-го етапу Всеукраїнської олімпіади з інформатики 2002-2003 н.р.

Program Zadacha_2;

Uses Crt;

Var f1,f:text; {Ввод текстовых типов файлов данных и результатов}

a:array[1..100]of integer;

i,d,m,k,s,n,u,r:integer;

w,p,t:string;

BEGIN Clrscr;

n:=1; k:=5; u:=15; s:=0; m:=0; d:=0;

{Assign(f,'Sequence.dat');reset(f);} {Откр.ф.данных,Sequence.dat}

{Assign(f1,'Sequence.res');rewrite(f1);} {Откр.ф.результата,Sequence.res}

{read(f,k,u);} { Считывание данных }

{Close(f); } { Закрытиe файла данных}

{ Программа обработки данных }

For i:=1 to k do Begin a[i]:=i; Str(a[i],p); t:=t+p;s:=s+a[i] End;

Str(s,p); t:=t+p; r:=s; S:=0;

REPEAT

m:=m+1; a[k+m]:=r; s:=0;

For i:=n+m to k+m do Begin s:=s+a[i] End;

Str(s,p); R:=s; t:=t+p; d:=Length(t);

UNTIL u<=d;

W:=Copy(t,u,1); Writeln('N=',w,' на ',u,' месте'); Writeln('L=',t);

Readln; {Close(f1);} { Закрытиe файла Sequence.res}

END.

Після запуску програми ми отримаємо відповідь

Приклад файлу Sequence.dat Приклад файлу Sequence.res

5 15 2

Задача 3.Pyramid(30 балів). Відомо, що знамениті піраміди в Єгипті складаються з камяних кубів, покладених шарами. Недавно спритна туриська фірма “СТФ”, помітила кожен куб однієї з граней купленою нею піраміди числами, після чого на цій грані утворився числовий рівнобедерний трикутник (див.малюнок)


7



3

8



8

1

0



2

7

4

4



4

5

2

6

5


Фірма встановила приз (верблюд) для туристіа, який знайде найкоротший маршрут на поміченій числами грані піраміди до

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

Технічні умови:

- вхідний файл Pyramid.dat містить у кожному з n рядків (1<n<100) по i чисел P[j],j=1..i, де i-номер рядка, розділені пропусками, (1<P[j]<100);

- вихідний файл Pyramid.res повинен містити в першому рядку значення суми, а в другому рядку через пропуск послідовність з n чисел, які розміщені на шляху знайденого маршруту.

Програма до Задачі №3, ІІІ-го етапу Всеукраїнської олімпіади

з інформатики 2002-2003 н.р.

Program Zadacha_3;

Uses Crt;

Const m=100;

Var f1,f:text; {Ввод текстовых типов файлов данных и результатов}

a:array[1..m,1..m]of integer; b:array[1..m]of integer; i,j,k,s,t,r,n:integer;

BEGIN Clrscr; k:=0;

Assign(f, Pyramid.dat ');reset(f); {Откр.файла дан., Pyramid.dat }

Assign(f1,' Pyramid.res ');rewrite(f1); {Откр.ф. рез., Pyramid.res }

For i:=1 to m do Begin k:=k+1; { Начало считывания данных}

For j:=1 to k do Begin read(f,a[i,j]); { Считывание данных }

Write(a[i,j],' '); { Вывод данных на экран}

End; Writeln;

If EoF(f) Then i:=m; { Опред. конца счит.данных с файла Pyramid.dat }

End ; { Конец ввода данных}

Close(f); { Закрытиe файла данных}

{ Программа обработки данных }

n:=k; s:=a[1,1];t:=0;r:=a[1,1];t:=1;k:=1;b[1]:=r;

For i:=2 to n do Begin;t:=t+1;

For j:=1 to t+1 do Begin;

if r+a[i,k]

end else Begin r:=a[i,k+1];b[i]:=r; k:=k+1;s:=s+r;j:=t+1; end;

end; end; Writeln; { Вывод обраб. Дан. на экран }

Write('s=',s);Writeln;Writeln; For i:=1 to n do Write(b[i],' ');

{ Вывод обработаных данных в файл Pyramid.res }

Write(f1,s); WRITELN(F1);For i:=1 to n do Write(f1,b[i],' ');

Close(f1); { Закрытиe файла Pyramid.res }

Readln END.

Після запуска програми отримаємо відповідь

Прик. файлу Pyramid.dat Прик. файлу Pyramid.res

7 17

3 8 7 3 1 4 2

8 1 0

2 7 4 4

4 5 2 6 5


ЗАДАЧІ ПО ТЕМІ «ТЕОРОІЯ ЧИСЕЛ»

Задача. Якщо двозначне число розділити на добуток його цифр, то в частці буде 4, а в остачі 1. Якщо це цисло розділити на суму його цифр, то в частці буде 3, а в остачі 1. Знайдіть це число ?

Program Fokus2;

Uses Crt;

Var a,b,c,x,c1:Integer;

BEGIN ClrScr;

For x:=10 to 99 do begin;

a:=x div 10;b:=x mod 10;c:=a+b; c1:=a*b;

if ((x div c=3)and(x mod c=1))and((x div c1=4)and(x mod c1=1))

Then Writeln('Будь ласка ваше число X=',x)

end; Readln;Readln

END.

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

Автономне число це число квадрат якого останім дорівнює цьому числу НАПРИКЛАД; 5^2=25, 6^2=36, 25^2=625.

Program Avtonomni;

Uses Crt;

Var m,n,x,d:Longint;

BEGIN Clrscr;

Writeln('Введіть числа M i N=');Read(m,n); D:=10;

For x:=m to n do Begin

While d<=x do d:=d*x; If Sqr(x) mod d=x Then

Writeln(X,' автономне, квадрат якого ',Sqr(x))

End; Readkey END.

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

Program Blizntzi;

Uses Crt;

Var n,i:integer;

Function prost(n:integer): Boolean;

Var j:integer;f:boolean;

Begin j:=2; f:=True;

While (j<=(n div 2)) and f do Begin

If n mod j=0 Then f:=False;

Inc(j) End; prost:=f End;

BEGIN ClrScr;

Write('введите значение N= ');Read(n);

FOR i:=2 to N do

If Prost(i) and Prost(i+2) Then

Writeln('Близнецы ',i,' и ',i+2);

Readkey

END.

Задача. Знаходження дружних чисел (220 і 284, 1184 і 1210).

Дружні числа це такі числа сума дільників одного з них повинна рівна другому числу і навпаки.НАПРИКЛАД;

1+2+4+5+10+11+20+22+44+55+110=284

i 1+2+4+71+142=220. Програма працює довго.

Program Drujni;

Uses Crt;

Var j,n,k,m:integer;

Function sum(d:integer):integer;

Var i,s:integer;

Begin s:=0;

For i:=1 to d div 2 do

if d mod i=0 Then s:=s+1; sum:=s

End;

BEGIN Clrscr;

Write('Введіть значення M i N='); Read(m,n);

Writeln('Дружні числа:');

For k:=m to n do

For j:=k+1 to n do begin

If (sum(k)=j) and (Sum(j)=k) Then

Writeln(k,' i ',j); Writeln(k,'---',j); end;

Readkey

END.


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

поліндромом (121, 13431,..).

Program Polindrom;

Uses Crt;

Var n,k,l,n1:Longint;

BEGIN Clrscr;

Write('Введіть ціле число N=');Read(n);

K:=N; N1:=0; While k>0 do Begin

L:=K mod 10; K:=k div 10; N1:=N1*10+L End;

If (n=n1) Then Writeln(N,'-поліндром')

Else Writeln(N,'-число не є поліндромом');

Readkey

END.

Задача. Скласти програму для визначення пiфагорових

чисел в межах вiд 1 до 20.

Program Pifag;

Uses Crt;

Var a,b,c,cx:integer;

BEGIN ClrScr;

Write('Пожалуста,Ваши пифагоровые числа !!');

writeln;

For a:=1 to 20 do

for b:=a to 20 do

Begin cx:=a*a+b*b;c:=1; While c*c<=cx do begin

if c*c=cx then writeln(a,'^2+',b,'^2=',c,'^2'); c:=c+1;

end; End; Readkey END.

Задача. Знаходження досконалих чисели.

НАПРИКЛАД; 6, 28, 496, 8128. (6=1+2+3)

Program Udosk_chisla;

Uses Crt;

Var i,n,x,sum:integer;

BEGIN Clrscr;

Write('Введіть число N='); Read(x);

For n:=2 to x do Begin sum:=1;

For i:=2 to n div 2 do If n mod i=0

Then sum:=sum+i;

If sum=n Then Write(n,' ')

End; Readkey END.


Задача.Скласти програму числового трикутника Паскаля.

Program Tr_pas;

Uses Crt;

Label 1,2;

Var a:array[1..15,1..15]of integer; r,i,k,n,h:integer;

BEGIN 2:ClrScr;r:=40;h:=2;

Write('Введите к-во строк треугольника N<11,N=');read(n);

Writeln;N:=n+1;

if n>11 then goto 2;

a[1,1]:=1;GotoXY(r,h);

For i:=2 to n do Begin

h:=h+1; r:=r-2; GotoXY(r,h);

For k:=2 to i do Begin

a[i,k]:=a[i-1,k-1]+a[i-1,k];

If a[i,k]<9 Then Begin;write(a[i,k],' ');goto 1 End;

If a[i,k]>9 then Write(a[i,k],' ');

If a[i,k]>99 then Write(a[i,k],' ');

1:End End;

Readkey

END.


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

межах від M до N.

Program Prosti;

Uses Crt;

Var n,i,m:integer;

Function prost(n:integer): Boolean;

Var j:integer;f:boolean;

Begin j:=2; f:=True;

While (j<=(n div 2)) and f do Begin

If n mod j=0 Then f:=False;Inc(j) End; prost:=f

End;

BEGIN ClrScr; Repeat

Write('Введіть проміжок чисел від M до N=');Readln(m,n);

Until (m>1) and (n>1) and (n>m);Writeln('Прості числа:');

For i:=m to n do If Prost(i) Then Write(i,' ');

Readkey END.


Задача. Програма для визначення факторіала числа в межах

від 1 до 33.

Program fact1;

Uses Crt;

Var n:longint; ch:char;

Function fac(nf:longint):longint;

Begin if nf=0 then Begin Fac:=1; exit end;

if nf<>1 then fac:=nf*fac(nf-1) else fac:=1 End;

BEGIN Clrscr;

Write('N=');readln(n);

Writeln('n!=',fac(n));

ch:=readkey END.


Задача. Сума цифр числа Х рівна У, а сума цифр числа У рівна Z

Знайти Х якщо Х+Y+Z=60.



Program Chislo;

Uses Crt;

Var x,y,z:integer;

BEGIN ClrScr;

For x:=1 to 60 do Begin

y:=x div 10+x mod 10; z:=y div 10+y mod 10;

If x+y+z=60 Then Writeln('X=',x) End;

Readkey END.

{Ответ Х; 44, 47, 50}


Задача. Чи існують такі двузначні числа ab і cd, якщо

ab*cd=abcd.

Program Chislo;

Uses Crt;

Var ab,cd:integer; otwet:boolean;

BEGIN ClrScr; otwet:=false;

For ab:=10 to 99 do

For cd:=10 to 99 do

If ab*cd=ab*100+cd then begin Writeln(ab,cd);

otwet:=true End;

if not(otwet) then writeln('Таких чисел нет'); Readkey END.

Задача. В класі не меньше 95,5% і не більше 96.5% учнів навчаються без "двійок" При якому найменьшому числі учнів це можливо?

Program Ozenki;

Uses Crt;

Var n:integer;

BEGIN ClrScr; N:=1;

While not((100/n >= 3.5) and (100/n <=4.5)) do n:=n+1;

Writeln('N=',n); Readkey END.

{Ответ N=23 ученика}




Задача. Послідовність задана в такому виді, а[1]=1, f[2]=2, a[n+1]-2[n]+a[n-1]=1. Визначити a[1995].

Program Naity;

Uses Crt;

Var a1,a2,a:real;

n:integer;

BEGIN ClrScr; a1:=2; a2:=1;

While n < 1995 do Begin

n:=n+1; a:=1+2*a1-a2; a2:=a1;

a1:=a End; Writeln('A=',a); Readkey END.

Задача. Написати програму, яка цілій змінній А надає значення

першої цифри дробової частини дійсного числа Х

Program Pr6;

Uses Crt;

Var a:Integer; x,y:Real;

BEGIN ClrScr;

Write('Введіть значення X='); Read(x);

X:=ABS(X); Y:=ABS(X-INT(X))*10; A:=TRUNC(y);

Writeln('Значення А=',a);

Readln;Readln

END.


Задача. Написати програму, яка друкує TRUE або FALSE в залежності від того, чи є у цілого числа лише один простий дільник, який більший ніж 20, але менший 30.

Program Pr7;

Uses Crt;

Var b:Integer;

BEGIN ClrScr;

Write('Введіть значення B='); Read(b);

Writeln((B MOD 23=0) XOR (b MOD 29=0));

Readln;Readln

END.

Задача. Визначити найбільше число із трьох заданих А, В і С.методом підпрограми-процедури.

PROGRAM bit;

Uses Crt;

Var a,b,c,z:integer;

procedure bid(x,y:integer);{Підпрограма}

var n:integer;

Begin if x>y then n:=x else n:=y;z:=n End;

BEGIN; Clrscr;{Основна програма}

write('Введ?ть три числа ->'); read(a,b,c);

bid(a,b);a:=z;bid(a,c); z:=z;writeln;

writeln(a,' ',b,' ',c,' BIT=',z);Readkey

END.

Задача. Визначити найбільше число із трьох заданих А, В і С.

методом підпрограми-функції.

PROGRAM bit;

Uses Crt;

Var a,b,c,z:integer;

function bid(x,y:integer):integer;{Підпрограма}

Begin if x>y then bid:=x else bid:=y End;

BEGIN; Clrscr;{Основна програма}

write('Введ?ть три числа ->'); read(a,b,c);

writeln; z:=bid(a,b); z:=bid(z,c);

writeln(a,' ',b,' ',c,' BIT=',z);Readkey

END.

ЗАВДАННЯ ПО РІЗНИМ ТЕМАМ

Задача.Дано кординати вершин трикутника ABC (X1,Y1)

(X2,Y2) (X3,Y3). Скласти програму, яка б визначила,

чи належить точка О iз кординатами (X,Y) площ. трик.

Примiтка: ввести в програму контроль iснування трик. ABC.

PROGRAM ABC

USES CRT;

LABEL 1;

VAR A1,A2,A3,A,B,C,O,X,X1,X2,X3,Y,Y1,Y2,Y3,S,S1,S2,

S3,P,P1,P2,P3:REAL;

BEGIN CLRSCR;

1: WRITE('A,B,C,O');READ(X1,Y1,X2,Y2,X3,Y3,X,Y);

A:=SQRT(SQR(X2-X1)+SQR(Y2-Y1));

B:=SQRT(SQR(X3-X1)+SQR(Y3-Y2));

C:=SQRT(SQR(X3-X2)+SQR(Y3-Y2));

IF (A=B+C) OR (B=C+A) OR (C=A+B) THEN BEGIN

WRITE('ТРИУГОЛЬНИК НЕ СУЩЕСТВУЕТ ');GOTO 1;END;

P:=(A+B+C)/2;

S:=SQRT(P*(P-A)*(P-B)*(P-C));

A1:=SQRT(SQR(X1-X)+SQR(Y1-Y));

A2:=SQRT(SQR(X2-X)+SQR(X2-X));

A3:=SQRT(SQR(X3-X)+SQR(X3-X));

P1:=(A+A1+A2)/2; P2:=(B+A2+A3)/2;

P3:=(C+A1+A2)/2;

S1:=SQRT(P1*(P1-A)*(P1-A1)*(P1-A2));

S2:=SQRT(P2*(P2-B)*(P2-A2)*(P2-A3));

S3:=SQRT(P3*(P3-C)*(P3-A1)*(P3-A3));

IF ROUND(S)=(S1+S2+S3) THEN

WRITE('Т.ПРЕНАДЛ. ABC ')

ELSE WRITE('НЕ ПРЕНАДЛЕЖИТ ');READKEY; END.

{Задача. Утворити матрицю розміром (5 Х 5), у якій знайти Min A[i,j] і координати знайденого числа з правого боку бічної діагоналі.

Program Diag_B_Min;

Uses Crt;

Var i,j,c,q,v,h,n,min,nom,nom1:integer;

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

BEGIN ClrScr ; c:=5;q:=2;v:=5;h:=2;n:=5;Randomize;

For i:=1 to 5 do Begin

q:=q+1;v:=v+2;gotoxy(v,2);textcolor(13);write(i);h:=h+1;

gotoxy(5,h);textcolor(13);write(i);

For j:=1 to 5 do Begin

c:=c+2;a[i,j]:=random(9)+1;gotoxy(c,q);textcolor(14);Write(a[i,j]);

End; c:=5 End;nom:=n-1; nom1:=n;min:=a[n-1,n];

For i:=1 to 5 do

For j:=1 to 5 do If j>n+1-i Then if a[i,j]

begin min:=A[i,j];nom:=i;nom1:=j end; Writeln;writeln;

writeln('Min=',min,' Координ.=[',nom,',',nom1,']'); Readkey END.

Завдання N1 обласної олімпіади.

Скільки можна зробити різних гірлянд з n(3 < n < 100) різнокольорових лампочок.

Н А П Р И К Л А Д: Якщо лампочок 3 (n=3), а їх колір червоний(ч), синій(с), зелений(з), то кількість варіантів д о р і в н ю є: 1). ч с з 2). ч з с 3). с ч з 4). с з ч 5). з ч с 6). з с ч.

Тобто 6 варіантів. В розділі математики «Комбінаторика» це має назву 'Перестановка з n', яка дорівнює добутку перших натуральних чисел (факторіал -f!). f!=1*2*3=6.

Program Factorial; {$S+,N+,E+}

uses crt;

var n:integer;

Function Fac(n:integer):Extended; Var F:extended;

Begin {Fac}

If n<0 then Writeln('Ochibka v zadanii N') else

if N=0 then Fac:=1 else Begin

F:=Fac(n-1); Fac:=f*n end End; {Fac}

begin clrscr; {Main}

Repeat

write('Введите число (3 =< N < 100), N='); Readln(n);

Writeln('N=',Fac(n):1:9);

Writeln('Для выхода введите любую букву,для

продолжения число');

Until EOF; readkey end.


Задача.Склати програму,що знаходить число від 1 до 1000. Людина загадує число від 1 до 1000 і обчислює остачу від ділення цього числа на 7, 11, 13 і повідомляє ці залишки програмі.Прог.повинна визначити загадане число Х ?. Позначити залишки R7,R11,R13.Таке число, яке підлягає цій умові тільки одне X-> є [1..1000]. X:7->R7, X:11->R11, X:13->R13.

Program Fokus;

Uses Crt;

Var r7,r11,r13,a,b,c,x,a1,b1,c1:Integer;

BEGIN ClrScr;

Write('Введіть остачу R7,R11,R13=');read(r7,r11,r13);

For x:=1 to 1000 do begin;

a:=x div 7;b:=x div 11;c:=x div 13;

a1:=a*7+r7;b1:=b*11+r11; c1:=c*13+r13;

if ((a1=b1) and(r7=x mod 7))and((c1=b1)and(r11=x mod 11))

and((c1=a1)and(r13=x mod 13)) Then Writeln('Будь ласка ваше число X=',x) end;

Readln;Readln END.

Задача.Скласчти програму чи входить кирпичина роміром

Х,У,Z в отвір розміром (А на В)

Program kirpich;

Uses Crt;

Var a,b,y,x,z:integer;

BEGIN ClrScr;

Write('Введите даннные размеров a,b,y,x,z=');Read(a,b,y,x,z);

If ((x<=a)and(y<=b))or((y<=a)and(x<=b))or((x<=a)

and(z<=b))or((z<=a)and(y<=b))or((y<=a)and(z<=b))or((z<=a)

and(y<=b)) Then writeln('Входит') Else writeln('Не входит') ;

Readln;Readln END.

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

площою S1 в квадрат з площою S2.

Program Kr_Kvad;

Uses Crt,Graph;

Var a,r:real; d,m,a1,r1,s1,s2:integer; t:string[30];

Procedure Otv;

Const pi=3.14;

Begin

R:=sqrt(s1/pi);A:=sqrt(s2);

End;

BEGIN ClrScr;

Write('Введите площадь круга,S1=');Read(s1);Writeln;

Write('Введите площадь квадрата,S2=');Read(s2); Otv;

R1:=Round(r); A1:=Round(a);

If 2*R1<=A1 Then T:='Круг помещается в квадрате' Else

T:='Круг не помещается в квадрате'; ClrScr;

INITGRAPH(d,m,'');SetColor(15); Rectangle(200,round(1.2*60),200+A1*20,60+Round(A1*20*0.9));SetColor(14); Circle(Round(200+A1*20/2), Round(60+A1*20/2),R1*20);

etFillStyle(8,7);FloodFill(Round(200+A1*20/2),

Round(60+A1*20/2),14); SetColor(11);SetlineStyle(2,2,1);

Line(Round(200+A1*20/2),Round(60+A1*20/2-r1*20),Round(200+A1*20/2),Round(60+A1*20/2+r1*20));

Line(Round(200+A1*20/2-r1*20),Round(60+A1*20/2),

Round(200+A1*20/2+r1*20), Round(60+A1*20/2));

SetColor(14); OutTextXY(100,15,t); str(r1*2,t);

OutTextXY(500,30,'Диаметр кр.,D='+t);str(A1,t);

OutTextXY(500,45,'Сторона кв.,A='+t);

Repeat Until Readkey=#13; CloseGraph

END.

Задача N2 обласной олимпиады.

Учасникам олімпіади передан текстовий файл (d.dat):

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

Треба відзначити,текст для цього:

1. Упрядочити слова по алфавіту:

2. Відокремити четверту літеру кожного слова:

3. Записати літери в текстову змінну:

4. Розподілити текст на слова згідно першого рядка цифр вхідного файла. Це є вміст дишифрованого текста.

5. Записати в текстовий файл (dd.dat) дешифрований текст

Program obl99_2;

Uses Crt;

Const p=33;

Var f,f1:text;

a:array[1..5]of char; t:array[1..10]of string[11];

v:array[1..3]of string[5]; t1:array[1..10]of string[11];

a1:array[1..67]of char; b:array[1..3]of byte;

y:string[11]; i,j,s,s1,k,s2,n,m:integer;

BEGIN clrscr; s1:=1;k:=1;s:=0;n:=3;m:=4;

Assign(f,'d.dat');reset(f); (* Открытие файла 'd.dat' *)

writeln('Вывод информации данного файла "d.dat"');

For i:=1 to 5 do Begin read(f,a[i]);

If a[i]<>',' then begin s:=s+1; val(a[i],b[s],n);

write(b[s],' '); end End; (* Вывод цыфр *)

For i:=1 to 67 do Begin read(f,a1[i]);

If a1[i]<>','then t[s1]:=t[s1]+a1[i] else s1:=s1+1 end;

(* Вывод слов *)

For i:=1 to 9 do begin t[k]:=t[i];Write(t[k],' ');k:=k+1 end;s1:=1;

For j:=1 to 67 do Begin read(f,a1[j]);

If a1[j]<>','then Begin a1[s1]:=a1[j] end else s1:=s1+1 end;

Close(f);t1[9]:=t[1]; (* Закрытие файла 'd.dat' *)

For i:=1 to p do Write(a1[i],' '); (* Вывод букв *)

k:=0;y:=''; writeln;

For i:=1 to p do For j:=1 to 9 do Begin

(* Начало обработки дан.файла *)

If a1[i]=Copy(t[j],1,1) Then Begin k:=k+1;t1[k]:=t[j] End End;

For i:=1 to 9 do begin if i=9 then m:=6; y:=y+Copy(t1[i],m,1) end;k:=0; For i:=1 to 3 do begin k:=i;if i=3 then k:=b[i] ;

v[i]:=Copy(y,k,b[i]) end;

Assign(f1,'dd.dat');rewrite(f1);(* Открыт. файла 'dd.dat' для зап. *)

writeln('Вывод обработанной информации');

For i:=1 to 3 do Begin write(v[i],' ');

(* Вывод обработанной информации на дисплей *)

write(f1,v[i],' '); (* Запись данных в файл 'dd.dat' *)

End; Close(f1); (* Закрытие файла 'dd.dat' *)

Readkey END.


Яку швидкiсть необхiдно надати ракетi, щоб вона вийшла на

кругову орбiту радiуса R навколо Землi ?

program sputn;

uses Crt;

var r:integer; v:Real;

Begin clrscr;

{6.672E-11 ->Гравiтацiйна стала}

{5.976E+24 ->Маса Землi в кг}

{6.371E+6 ->Радiус Землi в м}

write('Радiус орбiти ракети,R=');read(r);

V:=sqrt(6.672E -11*5.976E + 24*(2/6.371E +6 -1/R));

writeln('V=',v,' м/c');

readkey end.


Скласти програму про ступеньки.

program stup;

Uses Crt;

Var i1,i2,i3,n,i,e:Longint; t:char;

BEGIN ClrScr; Write('N='); Read(n);

i1:=1; i2:=2; i3:=4; For i:=4 to n do Begin

e:=i3+i2+i1; i1:=i2; i2:=i3; i3:=e; End;

If n=1 Then i3:=i1; If n=2 Then i3:=i2;

Writeln('X=',i3); t:=readkey

END.

Задача. Визначити існування три кут.по його трьом

сторонам А, В і С.

Program Treugolnik;

Uses crt,Graph; label 1;

Var f,f1:text; a,b,c:integer; g,m,r1:integer; t,ot:string[30];

Procedure Trk; Begin

If (a+b>c)and(b+c>a)and(c+a>b) then ot:='існує' else

ot:='не існує' End;

Begin clrscr;

Assign(f,'vvod.dan');reset(f); Assign(f1,'otvet.res');rewrite(f1);

Read(f,a,b,c); Trk; writeln(f1,ot);

Close(F);close(F1); Initgraph(g,m,'');Setcolor(14);

If ot='не існує' then Begin line(200,50,300+a+b-c,50);goto 1 end;

Line(300,50,300-c,50+a); Line(300,50,300+c,50+b);

Line(300-c,50+a,300+c,50+b);

1: OutTextxy(450,30,'Трикутник '+Ot);

Repeat Until Readkey=#13; Closegraph End.

Задача.Скласти програму для відгадування числа в межах

від 1 до 100 задуманого комп’ютером.

program ugad;

uses crt;

var i,a,b,s:integer;

BEGIN clrscr;textmode(co40+font8x8);

randomize;s:=0;b:=round(random(99))+1;

textcolor(12); write('Введите число от 1 до 100->');s:=s+1;read(a);

textcolor(5); writeln('=============================');

repeat

if a>b then begin textcolor(11);writeln;write('Возьми меньше->');

read(a);s:=s+1 end else

begin textcolor(14);writeln;write('Возьми больше->');

read(a);s:=s+1 end;

until a=b;

textcolor(26);writeln;writeln('Отгадал за ',s,' ход.') ;

readkey END.

Програми для створення звуку

program zvuk;

uses crt;

const f:array[1..13] of word=(330,349,370,392,435,440,466,494,523,554,588,622,660);

var i,j:integer;

Begin

for i:=1 to 2 do

for j:=1 to 13 do begin

Sound(i*f[j]); Delay(250); NoSound end;

for i:=2 downto 1 do

for j:=13 downto 1 do

begin Sound(i*f[j]); Delay(250); NoSound

end;

End.

Задача.Звукова програма, звука пташки

Program DemoBird;

Uses Crt;

Var I:integer;

Procedure Bird;

Begin I:=200;

While I<3000 do Begin Sound(I+1); Inc(I) End;

NoSound End;

BEGIN ClrScr;

Repeat

For I:=1 to 20 do Begin

Sound(Random(100)+Random(500)+3100);

Delay(8); NoSound;Delay(30);

End;

Bird; Randomize;

Delay(Random(600)) Until KeyPressed;

Nosound;

END.


Завдання рай. ол. для учнів 10 кл. 1999 року

Задача1. Знайти найменьше та найбiльше числа, якi можна подати сумами деяких (можливо всiх ) елементiв масиву.

Program OL_99_1;

Uses Crt;

Const N=25;

Var i,s,min,max,p1,p2:integer;

a:array[1..n]of integer;

BEGIN Clrscr;p1:=1;p2:=1;

writeln('Випадковi числа одновимiрного масива');

writeln;Randomize;

For i:=1 to n do Begin

a[i]:=Round(random(99))+1;Write(a[i]:3) End;

writeln;writeln('Порядкові номера чисел даного масива');

For i:=1 to n do Begin

if (a[i]>9)and(i>9) then write(' ',i) Else

if a[i]>9 then write(' ',i) Else write(' ',i) End;

min:=a[1];max:=a[1];i:=1;

REPEAT i:=i+1;

if min>a[i] then Begin p1:=i; min:=a[i] End;

if max

UNTIL i=n; s:=min+max;Writeln;

writeln('Визначення найменьшого, найбільшого

числа та їх суми');

writeln('Min=',min:2,' Max=',max:2,' Сума=',s);

writeln('Порядкові номера чисел Min=',p1:2,' тa Max=',p2);

readkey

END.


Защдача 2. Знайти суму елементiв матрицi, розташованих на однiй з лiнiйi, яка паралельна: а).головнiй, б).бiчнiй дiагоналi

Program OL_99_2;

Uses Crt;

Const m=5;

Var i,j,d,B,c,q,v,h,s1,s2:integer; a:array [1..m,1..m] of integer;

BEGIN ClrScr ; c:=5;q:=2;v:=5;h:=2;s1:=0;s2:=0;Randomize;

For i:=1 to m do Begin

q:=q+1;v:=v+2;gotoxy(v,2);textcolor(13);write(i);h:=h+1;

gotoxy(4,h);textcolor(13);write(i);

For j:=1 to m do Begin c:=c+2;

a[i,j]:=Round(random(9))+1;

gotoxy(c,q); textcolor(14);Write(a[i,j]);

end;c:=5 end; writeln;writeln; textcolor(12);

write ('Введите координаты диагонали i,j=');read(d,B); c:=5;q:=2;

For i:=1 to 5 do Begin q:=q+1;

For j:=1 to 5 do Begin c:=c+2;

gotoxy(c,q); textcolor(15);Write(a[i,j]);

If i+j=d+b then Begin gotoxy(c,q); textcolor(12);Write(a[i,j]);

s2:=s2+a[i,j] end;

If i+b=j+d then Begin gotoxy(c,q); textcolor(13);Write(a[i,j]);

s1:=s1+a[i,j] end;

If (j=B)and(i=d) then Begin gotoxy(c,q); textcolor(26);Write(a[i,j]) end; End;c:=5 End;Gotoxy(2,12); Textcolor(14);

Writeln('S1=',s1,' S2=',s2); Readkey END.

Задача3. Числа по спiралi. Заповнити квадратну таблицю Т(n,n) послiдовними числами вiд 1 до n в квд. розмiщеними по спiралi,

починаючи з лiвого верхнього кута i рахуючись за годинниковою стрiлкою.

Program OL_99_3;

Uses Crt;

Const m=19;

Var i,j,k,n:integer;

a:array[1..m,1..m]of integer;

Function MOV:boolean;

Begin mov:=FALSE;

If k<=N*N Then begin a[i,j]:=k;k:=k+1;mov:=true end

End;

BEGIN Clrscr; k:=1;i:=1;j:=1;

writeln('Введiть число N=');Read(n);

REPEAT

While MOV and (i+j

While MOV and (i

While MOV and (i+j>n+1) do j:=j-1; k:=k-1;

While MOV and (i>j+1) do i:=i-1; k:=k-1;

UNTIL k=n*n;

For i:=1 to n do Begin

For j:=1 to n do write(a[i,j]:4); Writeln End; Readkey END.


Задача4. За координатами вершин опуклого чотирикутника встановити: a).його вид(квадрат, ромб, прямокутник, паралелограм, транецiя): б).чи можна в нього вписати коло? в).чи можна навколо нього описати коло?

Program Ol_99_4;

Uses Crt;

Const k=4;

Label 1,2;

Var a,b,c,d,d1,d2,L,l1,s,s1:integer;

i,j:integer;

x,y,x1,y1,x2,y2,x3,y3:real;

n,m:array[1..k]of integer;

t:string[20];tt:string[40];

BEGIN ClrScr;j:=0;t:='';tt:='';

For i:=1 to k do Begin

Write('Введiть координати ',i,'-оi точки АВСD=');Read(n[i],m[i]);

Writeln;

End;

A:=Round(SQRT(SQR(n[4]-n[1])+SQR(m[4]-m[1])));

B:=Round(SQRT(SQR(n[2]-n[1])+SQR(m[2]-m[1])));

C:=Round(SQRT(SQR(n[3]-n[2])+SQR(m[3]-m[2])));

D:=Round(SQRT(SQR(n[4]-n[3])+SQR(m[4]-m[3])));

X:=(n[1]+n[2])/2; Y:=(m[1]+m[2])/2;X1:=(n[3]+n[2])/2; Y1:=(m[3]+m[2])/2;

X3:=(n[3]+n[4])/2; Y3:=(m[3]+m[4])/2;X2:=(n[1]+n[4])/2; Y2:=(m[1]+m[4])/2;

L:=Round(SQRT(SQR(X-Y)+SQR(X3-Y3))+0.5);

L1:=Round(SQRT(SQR(X1-Y1)+SQR(X2-Y2))+0.5);

D1:=Round(SQRT(SQR(n[3]-n[1])+SQR(m[3]-m[1])));

D2:=Round(SQRT(SQR(n[4]-n[2])+SQR(m[4]-m[2])));

S:=Round((a+c)/2+0.5); S1:=Round((b+d)/2+0.5);

Writeln('Сторони чотирикутника ');

writeln('A=',a,' B=',b,' C=',c,' D=',d);

Writeln('Дiагоналi чотирикутника ');

Writeln('d1=',d1,' d2=',d2);

Writeln('Середнi лiнiї чотирикутника ');

Writeln('L=',l,' L1=',l1);

If (a=b)and(b=c)and(c=d)and(d1=d2) then Begin j:=1;t:='Квадрат';goto 1 end;

If (a=b)and(b=c)and(c=d)and(d1<>d2) then Begin j:=2;t:='Ромб';goto 1 end;

If (a=c)and(b=d)and(c<>d)and(d1=d2) then Begin j:=3;t:='Прямокутник';goto 1 end;

If (a=c)and(b=d)and(c<>d)and(d1<>d2) then Begin j:=4;t:='Паралелограм';goto 1 end;

If (ABS(L)=ABS(s))or(ABS(L1)=ABS(s1)) then Begin j:=5;t:='Трапецiя';goto 1 end;

t:='Чотирикутник';tt:='Коло не можна вписати i описати';

1:IF J=1 then Begin tt:='Коло можна вписати i описати';Goto 2 End;

IF J=2 then Begin tt:='Коло можна вписати ';Goto 2 End;

IF J=3 then Begin tt:='Коло можна описати'; Goto 2 End;

IF ABS(a+c)=ABS(b+d) Then Begin tt:='Коло можна вписати ' End; 2:writeln(t,'.-> ',tt); Readkey END.

Завдання рай. ол. для учнів 11 кл. 1999 року

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

Program OL_10_99_1;

Uses Crt;

Const x:array[1..20]of integer=(3,2,2,2,5,5,5,5,4,4,9,9,1,7,1,8,1,7,7,0);

Var i,m,am,k,j,n,t,s:integer;

a:array[1..100]of integer;

BEGIN Clrscr;n:=20;

For i:=1 to n do write(x[i],' ');

writeln; m:=0;i:=1;s:=0;

While i+m<=n do Begin k:=1;

For j:=i+1 to n do if x[j]=x[i] Then Begin

x[j]:=x[i+k];k:=k+1;s:=s+1;a[s]:=k;

End ;

if m

t:=a[1];

for i:=2 to n do if t

writeln('Число ',am,' максимально розташовано поряд ',t,' раза');

Readkey END.

Задача. На iнтервалi (1000;9999) знайти всi простi числа, в записi яких сума першоi i другоi цифр рiвна третьоi i четвертоi.

Program OL10_99_2;

Uses Crt;

Const d5:Array[1..4]of word=(1,3,7,9);

Var a,b,c,d,i,x,q,k,t,tt,n:integer;

f:array[1..200]of integer;

a1,b1,c1,d1,st:string[4];

BEGIN ClrScr; q:=0;

For i:=1 to 4 do

For c:=0 to 9 do

If(d5[i]+c) mod 3<>0 Then

For a:=1 to 9 do Begin

b:=d5[i]+c-a; Begin

N:=((10*a+b)*10+c)*10+d5[i]; X:=7;

While (Sqr(x)<=N) and (N mod x<>0) do Inc(x,2);

If (N mod X<>0) Then Begin

k:=k+1;f[k]:=n;

end; end; end;

For i:=1 to k do begin

st:='';a1:='';b1:='';c1:='';d1:='';

str(f[i],st);a1:=Copy(st,1,1);

b1:=Copy(st,2,1);c1:=Copy(st,3,1); d1:=Copy(st,4,1);

Val(a1,a,t);Val(b1,b,t);Val(c1,c,t);Val(d1,d,t);

If a+b=c+d Then Begin t:=t+1;tt:=tt+1;Write(f[i]:10) end

End; Write('Всего искомых чисел ':127,tt);

readkey

END.

Задача. З'ясувати чи належить точка (Х,У) кругу радiуса

з центром в точцi (А,В).

Program OL_10_99_3;

Uses crt;

Var xa,ya,r,l:real;

BEGIN Clrscr;

Write('Bвведите значение XA,YA,R= '); read(XA,YA,R);

L:=sqr(XA)+sqr(YA);

If L

Writeln('Точка находится внутри круга') Else

Writeln('Точка находится внe круга');

Readkey END.

Задача. Алгоритм обробляе деякi сполучення букв В,П,А. Алгоритм переводить слово ПВПВМВ в слово ПВ, МВМВПВМВ в МВМВ, МВПВПВМВПВ в ПВ, ПВПВ в ПВПВ, МВПВПВПВ в ПВПВ. Для деяких слiв, наприклад, ППВ, МВПВ, ВВ, ПВПМПВ, алгоритм видае повiдомлення "помилка".

а). Описати такий алгоритм. б). Який сенс можна надати такому алгоритму?

Program OL10_99_4;

Uses Crt;

Const st:array[1..9]of string=('ПВПВМВ','МВМВПВМВ','МВПВПВМВПВ','ПВПВ',

'МВПВПВПВ','ППВ','МВМП','ВВ','ПВПМПВ');

d:array[1..2]of string=('ПВМВ','МВПВ'); n=4; nn=9;

Var i,j:integer; p:array[1..nn]of integer; s:array[1..nn]of string[10];

BEGIN clrscr;

FOR i:=1 to nn do Begin write(st[i],' ');

For j:=1 to 2 do Begin p[j]:=Pos(d[j],st[i]);

Delete(st[i],p[j],n) end;

IF (p[1]=0)and(p[2]=0) Then s[i]:='помилка' else s[i]:=''; End; writeln;Writeln; s[4]:=st[4];

For i:=1 to nn do if s[i]='' then write(st[i],' ') else write(s[i],' ');

readkey END.


Завдання для уч.11 класу рай.олімпіади 2001 року

Задача про роботу з двовимірним масивом.


Program Ol_r_2001_N1;

Uses Crt;

Const matr: array[1..17,1..9]of integer=((0,0,0,0,0,0,0,0,65),(0,0,0,0,0,0,0,50,66),

(0,0,0,0,0,0,37,51,67),(0,0,0,0,0,26,38,52,68),

(0,0,0,0,17,27,39,53,69),(0,0,0,10,18,28,40,54,70), (0,0,5,11,19,29,41,55,71),(0,2,6,12,20,30,42,56,72),

(1,3,7,13,21,31,43,57,73),(0,4,8,14,22,32,44,58,74),(0,0,9,15,23,33,45,59,75),(0,0,0,16,24,34,46,60,76),(0,0,0,0,25,35,47,61,77),

(0,0,0,0,0,36,48,62,78),(0,0,0,0,0,0,49,63,79),(0,0,0,0,0,0,0,64,80),

(0,0,0,0,0,0,0,0,81));

Var g,v,a,b,k,n,i,j:integer;

BEGIN Clrscr ;g:=1;v:=1;a:=0;b:=0;

For i:=1 to 17 do Begin g:=g+1;

For j:=1 to 9 do Begin v:=v+3 ;

if matr[i,j]=0 then begin gotoxy(v,g);write(' ') end else

begin gotoxy(v,g);write(matr[i,j]) end

End;writeln;v:=1;End;g:=1;v:=40;textcolor(11);

write('Iз заданого нат.виду таблиці чисел введіть число N=');

read(N);

write('Введіть число в межах 0

begin gotoxy(v,g);write(matr[i,j]) end

End;writeln;v:=40;End; Readkey

END.

ЗАДАЧІ НА РІЗНІ ТЕМИ

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

program rnd;

var i,a:integer;

y:real; begin

write('Введите к-во случайных чисел К=');read(a);

writeln('');

writeln('---------------------------------');

writeln(' Пожалуста '); writeln(' ----------');

for i:=1 to a do begin y:=random; y:=int(y*10);

write('y=',y:1:1); writeln(' '); end;

end.


Завдання.Скласти програму якаб читала дані з файла Pd.dan, обробляла їх ї записувала результат в файл Pr.res.

program Pract_ff;

uses crt;

var f1,f:text;{Ввод текстовых типов назв файлов данных и результатов}

a,b:array[1..30]of byte; i:integer;

BEGIN Clrscr;

Assign(f,'pd.dan');reset(f); {Откр.файла данных, Pd.dan}

Assign(f1,'pr.res');rewrite(f1);{Откр.файла результата, Pr.res}

For i:=1 to 3 do begin Read(f,a[i]);

{Ввод данных с файла данных, Pd.dan}

b[i]:=a[i]*5;{Обработка данных }

Write(f1,b[i]:3);{Запись результата.данных в файл результ. Pr.res} End; Close(f); Close(f1); {Закрытие файла Pd.dan и Pr.res} End.


Задача.Даний прямокутник із сторонами АхВ розбитий на однакові квадрати (1Х1) Необхідно визначити через скільки квадратів пройде діагонал.

Program diagon;

Uses Crt;

Var c,d:integer;

function nod(a,b:integer):integer; {Подпрогамма}

begin if a=0 then nod:=b else nod:=nod(b mod a,a)

end;

BEGIN ClrScr; {Основная программа.}

Write('Введите длину прямоугольника,L=');read(c);

Write('Введите высоту прямоугольника,H=');read(d);

Writeln('Ответ=',c+d-nod(c,d)); Readln; readln END.

Задача про кирпичину.

Program Krob_4;

Uses crt,graph;

Var x,y,z,a,b:integer; F,F1:text; oT:string[30];d,m:integer;

Procedure Vit; Begin

If((y<=b)and(x<=a)) and ((x<=b)and(z<=a)) and ((y<=b)and(z<=a)) then ot:='пройде'else ot:='не пройде'

End; Begin clrscr;

Assign (f,'vvod.dan');reset(f);

Assign (f1,'otvet.rez');rewrite(f1);

Read(f,a,b,x,y,z); Vit;

Writeln(f1,ot); Close(f);close(f1);

Initgraph(d,m,'');Setcolor(14);

Rectangle(10,10,10+a,10+b);setcolor(15);

Bar3d(100,100,100+a,100+b,z,Topon);

OutTextxy(350,30,'Цеглина '+ot);

Repeat Until readkey=#13; Closegraph End.

Задача.Пара кроликiв кожний мiсяць даї потомство двох

кроленят (самку і самця), які через два місяця

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

б визначила, скільки буде кролів через 12 місяців.;

PROGRAM krolik;

USES CRT;

VAR A,B,I,F:INTEGER;

BEGIN CLRSCR A:=2; B:=3;

FOR I:=3 TO 12 DO BEGIN

F:=A+B;B:=A;A:=F;

WRITELN(F,' ');END;READKEY;

END.


Скласти програму квадратного рівняння.

Program Kvad_riv;

uses Crt;

Label 1;

Var a,b,c,x1,x2,d:Real;

Begin ClrScr;

Write('Введiть через пропуск a,b,c-');read(a,b,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:1:2,' x2=',x2:1:2); goto 1 end;

if D<0 THEN Writeln('Система не має розв" язку') Else

Writeln('x1=x2=',-b/2*a:1:2);

1:Readln;Readln END.


Програма сортування випадкових чисел двовимірного масива

program mas_a_i_j;

var x:array[1..50,1..50] of real;

j,n,i:integer; p,ss,s:real;

begin

write('Введ. к-во ст.и ряд.мас.A[i,j],N=');read(n);

writeln;writeln('Ваш массив случайных чисел');

writeln; s:=0;ss:=0;p:=0;

for i:=1 to n do begin

for j:=1 to n do begin

x[i,j]:=int(random*10+1);write(x[i,j]:3:0);

if i=1 then s:=s+x[i,j]; if j=1 then ss:=ss+x[i,j];

if j=i then p:=p+x[i,j] end; writeln;writeln end;

writeln;writeln('Сумма 1-го ряда=',s:3:0);

writeln('Сумма 1-го ст.=',ss:3:0);

writeln('Сумма по диагонали,s=',p:2:0)

end.


Задача.По введеної к-ті суток визначити к-ть годин.

program vrem;

Uses Crt;

Var d,t,h,s:longint;

Begin clrscr;

write('Введите к-во суток->');Read(d);

t:=24*d;h:=60*t;s:=60*h;

writeln('Часов=',t,' Минут=',h,' Секунд=',s);

readkey; END.


Скласти програму лінійної системи рівнянь.

Program Systema;

Uses Crt;

Label 1;

Var b:array[1..2,1..3] of integer;

s,i,j,ff,d,dx,dy:integer;

Function nsd(a1,b1:integer):integer; var r,r1,r2:integer;

begin r:=a1;r1:=b1;

while r1<>0 do begin r2:=r mod r1;r:=r1;r1:=r2 end;

nsd:=abs(r) End;

BEGIN ClrScr;

FOR i:=1 to 2 do begin

FOR j:=1 to 3 do begin s:=s+1;

Write('Введіть ',s,'-е число системи ->');read(b[i,j]);

End;writeln;End;s:=0;

Writeln('--------------------------------');

Writeln(' Система лiнiйних рiвнянь. ');

Writeln('--------------------------------'); Writeln;

For i:=1 to 2 do begin

Write(b[i,1] ,'X +',b[i,2],'Y =',b[i,3],' ');

ff:=nsd(nsd(b[i,3],b[i,2]),b[i,1]); Write(' <- нсд(',ff,')-> ');

b[i,1]:=b[i,1] div ff;b[i,2]:=b[i,2] div ff; b[i,3]:=b[i,3] div ff;

Write(b[i,1] ,'X+',b[i,2],'Y =',b[i,3]); Writeln end;

D:=b[1,1]*b[2,2]-b[2,1]*b[1,2];

If D=0 Then begin Writeln;writeln('Система розв"язку немає.');goto 1 end;

Dx:=b[1,3]*b[2,2]-b[2,3]*b[1,2];

Dy:=b[2,3]*b[1,1]-b[2,1]*b[1,3]; Writeln;

Writeln('В i д п о в i д ь.');

writeln('X=',dx/d:2:3,' У=',dy/d:2:3);

1: Readkey

END.

Програма сортування випадкових чисел одновимірного масива

Program Sort;

Uses Crt;

Var i,a,r,j:integer;

x:array[1..100]of integer;

y:real;

BEGIN Clrscr;Randomize;

write('Введите к-во случайных чисел К=');read(a);

writeln('Числа до сортировки.');

For i:=1 to a do Begin

y:=random(50);x[i]:=round(y);write(round(y),' ');

End; writeln;

For i:=1 to a-1 do Begin

For j:=i+1 to a do Begin

if x[i]>x[j] Then Begin r:=x[i];x[i]:=x[j];x[j]:=r End;

End End;writeln('Числа после сортировки.');

For i:=1 to a do begin write(x[i],' ') end;

Readkey

END.


Приклад опису рядків лінійної програми.

Program Summa; {Заголовок програми}

Uses Crt; {Підключення иатематичного модуля}

Var A,B,X:Integer; {Опис типів даних які використовуються в програмі}

BEGIN ClrScr; X:=0; {Початок програми}

Write('Введіть два числа A,B='); Read(a,b);

X:=A+B; Writeln('ВІДПОВІДЬ Х=',X);Readkey

END. {Кінець програми}


Задача (Хід конем).Скласти програму яка б показала в графічному режимі ходи шахматних конів, білих і чорних (по 5 шт) які міняються містами. (Нумерацію ходів фігур відобразити в програмі)

Program ol_r_2001_N3;

Uses Crt,Graph;

Var d,r,i,a,b,c,x,r1,y,a1,a2,a3,b1,b2,b3,b4,b5:integer;

BEGIN c:=40;a:=80;b:=15;y:=90;r1:=10;

a1:=30;a2:=60;a3:=90;b1:=100;b2:=140;b3:=180;b4:=220;b5:=260;

d:=detect; initgraph(d,r,'');

setfillstyle(1,7);bar(a,b,280,105);setcolor(14);

for i:=1 to 6 do begin line(a+x,b,a+x,b+y);x:=x+c;end;

line(a,b,280,b);line(a,45,280,45);line(a,75,280,75);

line(a,105,280,105);

setfillstyle(1,15);

for i:=1 to 5 do begin PieSlice(b1,a1,0,360,r1);b1:=b1+c end;

setfillstyle(1,0);b1:=100;setcolor(0);

for i:=1 to 5 do begin PieSlice(b1,a3,0,360,r1);b1:=b1+c end;b1:=100;

setcolor(5);OutTextXY(60,120,' A B C D E');

OutTextXY(60,30,'3'); OutTextXY(60,60,'2'); OutTextXY(60,90,'1');

setcolor(7);

readkey;setfillstyle(1,7);PieSlice(b1,a3,0,360,r1);

setfillstyle(1,0);PieSlice(b3,a2,0,360,r1);

OutTextXY(360,15,'1. A1 - C2');

readkey;setfillstyle(1,7);PieSlice(b2,a1,0,360,r1);

setfillstyle(1,15);PieSlice(b1,a3,0,360,r1);

OutTextXY(360,30,'2. b3 - A1');

readkey;setfillstyle(1,7);PieSlice(b3,a1,0,360,r1);

setfillstyle(1,15);PieSlice(b1,a2,0,360,r1);

OutTextXY(360,45,'3. B3 - A2');

readkey;setfillstyle(1,7);PieSlice(b2,a3,0,360,r1);

setfillstyle(1,0);PieSlice(b3,a1,0,360,r1);

OutTextXY(360,60,'4. B1 - C3 ');

readkey;setfillstyle(1,7);PieSlice(b3,a3,0,360,r1);

setfillstyle(1,0);PieSlice(b2,a1,0,360,r1);

OutTextXY(360,75,'5. C1 - B3');

readkey;setfillstyle(1,7);PieSlice(b1,a1,0,360,r1);

setfillstyle(1,15);PieSlice(b2,a3,0,360,r1);

OutTextXY(360,90,'6. A3 - B1');

readkey;setfillstyle(1,7);PieSlice(b1,a2,0,360,r1);

setfillstyle(1,15);PieSlice(b3,a3,0,360,r1);

OutTextXY(360,105,'7. A2 - C1');

readkey;setfillstyle(1,7);PieSlice(b3,a2,0,360,r1);

setfillstyle(1,0);PieSlice(b1,a1,0,360,r1);

OutTextXY(360,120,'8. C2 - A1');

readkey;setfillstyle(1,7);PieSlice(b4,a3,0,360,r1);

setfillstyle(1,0);PieSlice(b2,a2,0,360,r1);

OutTextXY(360,135,'9. D1 - B2');

readkey;setfillstyle(1,7);PieSlice(b5,a1,0,360,r1);

setfillstyle(1,15);PieSlice(b4,a3,0,360,r1);

OutTextXY(360,150,'10.E3 - D1');

readkey;setfillstyle(1,7);PieSlice(b5,a3,0,360,r1);

setfillstyle(1,0);PieSlice(b3,a2,0,360,r1);

OutTextXY(360,165,'11.E1 - C2');

readkey;setfillstyle(1,7);PieSlice(b4,a1,0,360,r1);

setfillstyle(1,15);PieSlice(b5,a3,0,360,r1);

OutTextXY(360,180,'12.D3 - E1');

readkey;setfillstyle(1,7);PieSlice(b2,a2,0,360,r1);

setfillstyle(1,0);PieSlice(b4,a1,0,360,r1);

OutTextXY(360,195,'13.B2 - D3');

readkey;setfillstyle(1,7);PieSlice(b3,a2,0,360,r1);

setfillstyle(1,0);PieSlice(b5,a1,0,360,r1);

OutTextXY(360,210,'14.C2 - E1');

readkey; Closegraph END.

Задача. Скласти програму в графічному режимі для демонстрації роботи секундної стрілки часів.

program timer;

Uses Graph,CRT;

Const dr=0.9;

Var d,r,i,x0,y0,x1,y1,x2,y2:integer;

Xasp,Yasp:word;

Begin

d:=detect;InitGraph(d,r,'');i:=GraphResult;

if i<>grOK then Writeln(GraphErrorMSG(i))

else begin

x0:=getmaxX div 2;y0:=GetMaxY div 2;

GetAspectRatio(Xasp,Yasp);r:=y0;

Circle(x0,y0,r);circle(x0,y0,round(r*dr));

for i:=0 to 59 do begin

x1:=x0+round(dr*r*sin(2*pi*i/60));

x2:=x0+round(r*sin(2*pi*i/60));

y1:=y0-round(dr*r*Xasp*cos(2*pi*i/60)/Yasp);

y2:=y0-round(r*Xasp*cos(2*pi*i/60)/Xasp);

Line(x1,y1,x2,y2); end;

FloodFill(x0,y0,white);SetWriteMode(XORPut);

repeat

for i:=0 to 59 do

if not KeyPressed then begin

x2:=x0+Round(dr*r*sin(2*pi*i/60));

Y2:=y0-Round(dr*r*Xasp*cos(2*pi*i/60)/Yasp);

Line(x0,y0,x2,y2);

Delay(1000); {Задержка}

setpalette(0,0); Line(x0,y0,x2,y2); end;

until KeyPressed; end

END.


Задача,Скласти програму в графічному режимі побудови

перерізу кулі.

Program kulia;

Uses Crt,Graph;

Const n:array[1..12]of integer=(230,75,200,75,160,158,440,158,480,75,410,75);

Var d,r:integer;

BEGIN

d:=detect; initgraph(d,r,'');

SetColor(14); Ellipse(320,120,0,360,100,30);

Ellipse(320,120,0,180,100,100); Ellipse(320,120,202,338,100,100);

DrawPoly(6,n); SetFillStyle(1,7);FloodFill(220,90,14);

FloodFill(440,90,14); FloodFill(380,150,14);

SetFillStyle(3,13);FloodFill(320,120,14);

SetFillStyle(11,15);FloodFill(320,200,14);

SetColor(4);Line(440,100,450,85);Ellipse(445,90,275,70,11,5);

SetlineStyle(2,2,1); Line(160,60,480,180);Line(320,10,320,120);

Line(200,165,480,60);line(160,120,500,120);SetColor(14);

OutTextXY(290,245,'К У Л Я');SetColor(15);

SetLineStyle(3,3,3);Line(265,260,375,260); SetColor(14);

SetTextStyle(0,1,1);

OutTextXY(120,80,'П Е Р Е Р I З'); SetColor(13);

SetTextStyle(0,0,1);OutTextXY(120,300,'З А Л I К З

Г Р А Ф I Ч Н О Г О Р Е Ж И М А.');

SetColor(15);SetLineStyle(1,1,1);Line(120,310,520,310);

Repeat Until readkey=#13;

Closegraph

END.

{Задача. Визначити чи належить точка з координатами Х відрізку [A;B] ? }

Program Tochka; { Заголовок програми }

Uses Crt,Graph; { Підключення модулів}

Var f,f1:text; { Введення типів величин }

g,m,a,b,x:integer; y:string[30];

Procedure Toch; { Початок підпрограми }

Begin

If (x>=a)and(x<=b) Then y:='належить' Else y:='не належить'

End; { Кінець підпрограми }

BEGIN ClrScr; { Початок основної програми }

Assign(f,'vvod.dan');reset(f);

Assign(f1,'otvet.res');rewrite(f1);

Read(f,x,a,b); { Введення даних із файлу, Vvod.dan }

Toch; { Виклик процедури- підпрограми }

writeln(f1,'Точка ',+y); { Запис даних в файл Otvet.res }

Close(F);close(F1); { Закриття файлів }

INITGRAPH(g,m,'');SetColor(14); { Відкриття граф.режиму }

Line(10+a,100,10+b,100); Setcolor(15);

Circle(10+x,100,3);

SetColor(14); OutTextXY(350,30,'Точка лінії '+y);

Repeat Until Readkey=#13;

CloseGraph

END. { Кінець програми }

{ Перевірка для тестування}

{ При X=60 , A=50 і B=100, точка належить відрізку [A;B]. }


Задача. Визначити чи поміститься рівностороньій трикутник площею S1, в квадраті площею S2.

Program Trk_Kvadrat;

Uses Crt,Graph;

Var f,f1:text; S1,S2,a1,a2:real;

m,g:integer; t,ot:string[30];

Procedure Param; Begin

a1:=Sqrt(s1*4/Sqrt(3)); a2:=Sqrt(s2);

If a1<=a2 then t:=' входить' Else T:='не входить'

End;

BEGIN Clrscr;

Assign(f,'vvod.dan'); reset(f);

Assign(f1,'otvet.res'); rewrite(f1);

Read(f,S1,S2); Param;

Writeln(f1,'Трикутник ',t);

Close(f); Close(f1);

Initgraph(g,m,''); Setcolor(11);

Rectangle(100,50,100+Round(a2),50+Round(a2));Setcolor(15);

line(Round(Round(100+a2/2)-round(a1/2)),48+Round(a2),

100+Round(a1*0.95),48+Round(a2));

line(Round(Round(100+a2/2)-round(a1/2)),50+Round(a2),

Round(100+a2/2),50+round(a2-a1));

line(Round(100+a2/2),50+round(a2-a1),100+Round(a1*0.95),50+Round(a2));

Setcolor(14); Str(a1:1:0,ot); OuttextXY(350,30,'A1(trk)='+ot);

Str(a2:1:0,ot); Setcolor(11);

OuttextXY(350,45,'A2(kvd)='+ot); Setcolor(10);

OuttextXY(350,15,'Трикутник '+t);Setcolor(11);

Repeat Until Readkey=#13; Closegraph

END.

Задача. Скласти програму роботи з файлами.

program Pract_ff;

uses crt;

var f1,f:text; {Ввод текстовых типов назв файлов данных и результатов}

a,b:array[1..30]of byte; i:integer;

BEGIN Clrscr;

Assign(f,'pd.dan');reset(f); {Откр.файла данных, Pd.dan}

Assign(f1,'pr.res');rewrite(f1);{Откр.файла рез-та, Pr.res}

For i:=1 to 3 do begin Read(f,a[i]);{Ввод данных с файла данных, Pd.dan}

b[i]:=a[i]*5;{Обработка данных }

Write(f1,b[i]:3);{Запись результата.данных в файл результ. Pr.res} End;

Close(f); Close(f1); {Закрытие файла Pd.dan и Pr.res}

End.

Задача. Написати програму для переведення градусів в радіани.

Program Pr4;

Uses Crt;

Var x,y:Real;

BEGIN ClrScr;

Write('Введіть кут в градусах Х='); Read(x);

Y:=x/45*ARCTAN(1);

Writeln(X:1:2,' град.=',Y:1:3,' радіан');

Readln;Readln

END.


Задача.Визначення добутку суми від 1-го по 12-й і від 8-го по 15-й элементів одновимірного масива.

Program Pr_func1;

Uses Crt;

Const m=15;

z:array[1..m]of integer=(2,3,1,4,5,2,7,1,2,3,3,1,2,5,4);

Var a:array[1..m]of integer; p,j:integer;{Функция 'SUMMA'}

Function summa(n,k:integer):integer;

Var i,s:integer;

Begin s:=0;

For i:=n to k do s:=s+a[i];summa:=s

End; {Основная программа}

{Вычисление произведения сумм от 1-го по 12-й и с 8-го по 15-й элементов одномерного массива.}

BEGIN ClrScr;

Writeln('Одномерный массив, A[i]=15 чисел.');

For j:=1 to m do begin a[j]:=z[j];write(a[j],' ');

p:=summa(1,12)*summa(8,15); end;

Writeln;Writeln('Произведение равно, P=',p:2);

Readkey

END.

Задача.Визначити кількість цифр в додатньому цілому числі.

Program Prac4;

uses Crt;

Var x,y,c,k,r:integer;

BEGIN Clrscr;

Write('Введіть ціле число X=');

REPEAT {Перевірка на введене значення додатного числа}

Read(x);

Until (x>0) and (x=trunc(x));

Writeln('Цифра заданого числа ',x); Y:=x; K:=1;

While y>=1 do Begin C:=trunc(y/10); r:=y-c*10;

Writeln(K,' Цифра=',R); K:=K+1; Y:=c

End;

Writeln('Всього число ',X,' містить ',K-1,' цифр');

Readkey END.


Задача.Впорядкувати прізвища учнів по середньому балу успішності.

Program sr_ball;

Uses crt;

Type

p_student=^student; student=record

name:string[20]; next:p_student;

End;

Var head:p_student; curr:p_student;

buf:array[1..10]of string[20];

next:p_student;

j,e,rr,t,x,k,h,s,ll,f,i,y,ss,yy,ys:integer;

n:array [1..10] of longint; zn:longint; z:real;

zb,otv:string[20]; aa:array[1..10] of string;

tt:array[1..10] of real;

BEGIN

ll:=0;clrscr;yy:=3;

WriteLn;writeln(' N ** Фамилия ** ** оценки ** ** ср.балл **');

writeln('--------------------------------------------------------');

repeat s:=s+1;ll:=ll+1;ys:=ys+2;

Write(' ',s,' '); readln(Buf[s]);

If length (buf[s]) <> 0 then Begin

new(curr);

writeln('---------------------------------------------------------');

Curr^.name:=buf[s]; curr^.next:=head;

head:=curr; End;

Until length(buf[s])=0;s:=s-1;

For i:=1 to s do Begin

gotoxy(25,i+yy);read(n[i]);yy:=yy+1;

End; yy:=3; {Вывод линий}

gotoxy(1,1);Writeln('-----------------------------------------');

For rr:=2 to ys do begin

gotoxy(1,rr);writeln('|'); gotoxy(4,rr);writeln('|');

gotoxy(20,rr);writeln('|'); gotoxy(40,rr);writeln('|');

gotoxy(58,rr);writeln('|'); End; {Подсчёт ср.балла}

For j:=1 to s do begin t:=0;

gotoxy(48,j+yy);yy:=yy+1; str(n[j],aa[j]);x:=length(aa[j]);

For e:=1 to x do Begin

otv:=Copy(aa[j],e,1);val(otv,ss,y);t:=t+ss; End;

tt[j]:=t/x; Write(tt[j]:2:2);

t:=0;end;gotoxy(1,ys+2);write(' ');

{Сортировка ср.балла,оценок,фамилий.}

For i:=1 to s do begin

For j:=i+1 to s do begin

If tt[i]

n[i]:=n[j]; buf[i]:=buf[j];tt[j]:=z;n[j]:=zn;buf[j]:=zb end;

End;end; {В Ы В О Д Д А Н Н Ы Х }

Textcolor(14);

Writeln('Данные после сортировки'); textcolor(15);

Writeln('=========================================');

For i:=1 to s do Begin

Write(i,'. ',buf[i],' ',n[i],' ',tt[i]:2:2);writeln;

Writeln('----------------------------------------');

End; Readkey;

END.

Задача.Визначити кількість можливих кроків по ступенькам від 1 до N. (Крок можна робити через 0,1,2 ступеньок).

program stup;

Uses Crt;

Var i1,i2,i3,n,i,e:Longint; t:char;

BEGIN ClrScr;

Write('N='); Read(n); i1:=1; i2:=2; i3:=4;

For i:=4 to n do Begin e:=i3+i2+i1; i1:=i2; i2:=i3; i3:=e;

End; If n=1 Then i3:=i1; If n=2 Then i3:=i2;

Writeln('X=',i3); t:=readkey

END.


{Задача. Знайти суму всіх натуральних чисел від 1 до N.в циклічній програмі

Program SUMA1;

Uses Crt;

Var L,N,S:integer;

BEGIN ClrScr; s:=0; L:=1;

Write('Введіть к-ть натуральних чисел,N='); Read(n);

While L<=N do Begin {Початок цикла}

S:=S+L; L:=L+1;

End; {Кінець цикла}

Writeln('Відповідь,S=',s); Readln; Readln

END.


Задача.Скласти програму яка б відгадувала однакові задумані числа людиною і ЕОМ від 1 до 3.

Program Ugadal;

Uses Crt;

Var a,x,s,t,i:integer;

k,l:array[1..3]of integer;

BEGIN Clrscr;s:=0; Textcolor(14);

Write('Введите три числа от 1 до 3.');writeln;

Textcolor(11);

Writeln('===============================');

For i:=1 to 3 do begin Textcolor(12);

write('Введите ',i,'-oe число -> N=');read(l[i]);

End;Clrscr;randomize;

For i:=1 to 3 do begin

x:=random(3);k[i]:=x+1;

End;

For i:=1 to 3 do Begin t:=t+2;

Textcolor(11);GotoXy(i+t,1);write(k[i]);Textcolor(12);

Textcolor(14);GotoXy(i+t,3);write(l[i]);Textcolor(12);

If k[i]=l[i] Then s:=s+1;

End;

Textcolor(11);GotoXy(11,1);write('-- Числa E O M');

Textcolor(12);GotoXy(3,2);write('--------');textcolor(13);

write(' *************');

Textcolor(14);GotoXy(11,3);write('-- Ваши числa ');

Textcolor(10);GotoXy(1,4);write('=============');

Textcolor(15);GotoXy(2,5);write('Cовпало ',s,' чис.');

Readkey END.


Задача,Скласти програму для роботи в графічному режимі.

Program Style;

Uses Crt,Graph;

Var d,r:integer;

BEGIN d:=detect; initgraph(d,r,'');

SetColor(14);Circle(320,150,50);

OutTextXY(240,220,'Ку-ку, дядя,нажми ENTER !');

Repeat Until readkey=#13; Closegraph

END.





















Збірник задач (в системі прграмування Паскаль)
  • Информатика
Описание:

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

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

  Посібник дає змогу учням і вчителям стандартизувати на високому, методично-виваженому рівні підготовку до вивчення мови програмування по різним темам. Посібник написано логічною і водночас зрозумілою сучасною мовою програмування Turbo Pascal. Робота над посібником буде корисною учням, які захоплюються математикою (особливо по розділу «Теорії чисел») і бажають розширити своє уявлення про математичні моделі. Він може бути корисним майбутнім програмістам, бо на прикладах, детально поданих програм у посібнику, можна з успіхом, навчитися культурі програмування.

    

Автор Подыма Василий Юрьевич
Дата добавления 29.12.2014
Раздел Информатика
Подраздел
Просмотров 851
Номер материала 15958
Скачать свидетельство о публикации

Оставьте свой комментарий:

Введите символы, которые изображены на картинке:

Получить новый код
* Обязательные для заполнения.


Комментарии:

↓ Показать еще коментарии ↓