Смекни!
smekni.com

Язык программирования Pascal (стр. 2 из 3)

Uses crt;

Var i, n, a, b, c, v, h: integer;

Begin

Clrscr;

For n: =100 to 999 do

for i: =1 to 31 do

begin

a: =n mod 10;

b: =n mod 100;

h: =b div 10;

c: =n div 100;

v: =a*a+h*h+c*c;

if n=i+v then writeln (n,' ', i);

end;

readln;

end.

3.3.5 Результат работы программы

3.4 Решение задачи

3.4.1 Постановка задачи

Нарисовать рисунок.

3.4.2 Таблица идентификаторов

Переменные тип Значения
1 Gd integer Графический драйвер
2 Gm integer Графический режим

3.4.3 Программа

Uses graph,crt;

Var gd,gm: integer;

Begin

gd: =0; gm: =0;

Initgraph (gd, gm,' ');

setcolor (5);

Line (100, 200,250, 200);

Line (250, 200, 209,150);

Arc (157,183, 61, 195, 60);

Setfillstyle (0,3);

Floodfill (256, 200,5);

Ellipse (200, 135, 75, 233, 15, 20);

Ellipse (200, 135, 303, 75, 15, 20);

Ellipse (208, 139, 303, 91, 15, 24);

setfillstyle (1,8);

floodfill (220,145,5);

Arc (120, 200, 180, 0,10);

Setfillstyle (1,1);

Floodfill (125, 202,5);

Arc (120, 200, 180, 0, 15);

Arc (130, 200, 260, 0, 15);

Arc (200, 200, 180, 0,10);

setfillstyle (1,1);

Floodfill (125, 202,5);

Arc (120, 200, 180, 0, 15);

Arc (130, 200, 260, 0, 15);

Arc (200, 200, 180, 0,10);

Setfillstyle (1,1);

Floodfill (200, 202,5);

Arc (200, 200, 180, 0, 15);

Arc (210, 200, 260, 0, 15);

Line (150, 90, 150, 124);

Line (155, 90, 155, 123);

Line (150, 90, 155, 90);

Setfillstyle (1,1);

Floodfill (153, 100,5);

Arc (144, 83, 41, 310,10);

Arc (158, 83, 259, 126,10);

Setfillstyle (1,1);

Floodfill (144, 83,5);

Circle (144, 83,5);

Setfillstyle (1,2);

Floodfill (144, 83,5);

Circle (158, 83,5);

Setfillstyle (1,2);

Floodfill (158, 83,5);

Circle (255, 200,5);

Setfillstyle (1,4);

Floodfill (255, 200,5);

Setfillstyle (1,8);

Floodfill (200, 150,5);

Circle (215, 177,7);

Setfillstyle (1,9);

Floodfill (215, 177,5);

Setfillstyle (1, 14);

floodfill (121, 200,5);

readkey;

closegraph;

end.

3.5 Решение задачи

3.5.1 Постановка задачи

Даны первый член и разность арифметической прогрессии. Написать рекурсивную функцию для нахождения суммы n первых членов прогрессии.

3.5.2 Таблица идентификаторов

Переменные Тип Значение
1 Sn Real Сумма n первых членов арифметической прогрессии
2 n integer Количество членов арифметической прогрессии
3 A1,A2 Real Первый и второй члены арифметической прогрессии
4 d Real Разность прогрессии

3.5.3 Блок-схема


3.5.4 Программа

Program recursiy;

var A1,d,A2,Sn: real; n: integer;

function prog (n: integer): integer;

begin

if n=1 then prog: =A1 else prog: =A1+d* (n-1) +prog (n-1);

end;

begin

Writeln ('введите n');

readln (n);

writeln ('введите первый и 2-ой член арифметической прогрессии');

readln (A1, A2);

d: =A2-A1;

Sn: =prog (n);

writeln (Sn);

readln;

end.

3.5.5 Результат работы программы

3.6 Решение задачи

3.6.1 Постановка задачи

Дан двумерный массив. Удалить среднюю строку (строки).

3.6.2 Таблица идентификаторов

Переменные Тип Значение
1 a array заполнение двумерного массива
2 i,j integer Параметры цикла
3 n, m integer Размерность массива
4 k integer Количество элементов до среднего


3.6.3 Блок-схема

3.6.4 Программа

Var a: array [1. .100,1. .100] of integer;

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

begin

writeln ('Введите разм. мас');

readln (n,m);

randomize;

for i: =1 to n do

begin

for j: =1 to m do

begin

a [i,j]: =random (100);

write (a [i,j]: 3);

end;

writeln;

end;

writeln ('После удаления');

if n mod 2<>0 then begin k: =n div 2+1;

For i: =k to n-1 do

for j: =1 to m do

a [i,j]: =a [i+1,j] ;

for i: =1 to n-1 do

begin

for j: =1 to m do

write (a [i,j]: 3);

writeln;

end;

end

else

if n mod 2=0 then begin k: =n div 2;

For i: =k to n-2 do

for j: =1 to m do

a [i,j]: =a [i+2,j] ;

for i: =1 to n-2 do

begin

for j: =1 to m do

write (a [i,j]: 3);

writeln;

end; end;

readln;

end.

3.6.5 Результат работы программы

3.7 Решение задачи

3.7.1 Постановка задачи

Дан одномерный массив целых чисел произвольной длины. Заполните массив случайными числами до 100. Используя, оператор выбора, создайте меню, в котором при нажатии на клавишу производятся следующие действия:

1 - вычислить среднее геометрическое четных элементов массива;

2 - найти количество делителей максимального числа;

3 - вставить в массив два элемента с данными значениями: первый после минимального элемента, второй - перед минимальным элементом.

3.7.2 Таблица идентификаторов

Переменные Тип Значение
1 a array Заполнение одномерного массива
2 Max integer Максимальный элемент
3 Min integer Минимальный элемент
4 i integer Параметр цикла
5 N integer Размерность массива
6 k integer Количество делителей
7 m integer Выбор действия
8 s Real среднее геометрическое четных элементов массива
9 v, c integer два элемента вставляемые в массив
10 k1 integer Номер позиции перед (после) которой вставляем элемент
11 f integer Количество элементов, которые делятся на 2 без остатка
12 d integer Произведение всех элементов, которые делятся на 2 без остатка

3.7.3 Блок-схема

3.7.4 Программа

uses crt;

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

n, i,m,min,max,k,f,d,k1,c,v: integer;

S: real;

begin

clrscr;

randomize;

writeln ('введите разм. массива');

readln (n);

for i: =1 to n do

begin

a [i]: =random (101);

write (a [i]: 3);

end;

writeln;

writeln ('введите номер операции программы');

writeln ('1-вычислить среднее гео-ое четных эл. мас');

writeln ('2-найти ко-во делителей max числа');

writeln ('3-вставить в массив: 1-ый после min эл,2-ой перед min эл');

readln (m);

case m of

1: begin f: =0;

for i: =1 to n do

begin

if a [i] mod 2=0 then f: =f+1

end; writeln (f);

d: =1; s: =0;

for i: =1 to n do

begin

if a [i] mod 2=0 then d: =d*a [i] ;

end;

writeln (d);

if d=0 then s: =0 else s: =exp (1/f * ln (d));

writeln ('ср. геом=',S: 3: 3);

readln;

end;

2: begin

max: =a [1] ;

for i: =1 to n do

if a [i] >max then begin max: =a [i] ;

end;

for i: =1 to max do

if max mod i=0 then k: =k+1;

writeln ('ко-во делителей max числа',k);

readln;

end;

3: begin

writeln ('введите 2 числа');

readln (v,c);

min: =a [1] ;

k1: =1;

for i: =1 to n do

if a [i] <min then begin min: =a [i] ; k1: =i; end;

writeln;

for i: =n downto k1 do

a [i+1]: =a [i] ;

a [k1]: =v;

for i: =n+1 downto k1+1 do

a [i+1]: =a [i] ;

a [k1+2]: =c;

for i: =1 to n+2 do

write (a [i]: 3);

readln;

end;

end;

end.

3.7.5 Результат работы программы

3.8 Решение задачи

3.8.1 Постановка задачи

Дан массив записей, содержащий сведения о расписании поездов: направление; фамилия, имя, отчество машиниста; время отправления поезда. Необходимо осуществить:

1. заполнение массива данными;

2. поиск поездов по фамилии, имени, отчеству машиниста;

3. редактирование времени отправления поезда;

4. удаление поездов по полю "Направление";

5. сортировку по полю "Направление".

3.8.2 Таблица идентификаторов

Переменные Тип Значение
1 A array Заполнение массива
2 N integer Количество поездов
3 Nap string Поле направления
4 fio String Поле фамилии имя отчества
5 vy String Поле время отправления
6 i, j integer Параметры цикла
7 q integer Выбор действия
8 s1 string Новое время
9 x Rs Дополнительная переменная для сортировки
10 s String Время
11 w String Фамилия, Имя, Отчество машиниста
12 r String Направление поезда, которое удаляем
13 k Integer Номер удаляемой записи
14 f integer флажок

3.8.3 Блок-схема


3.8.4 Программа

type RS=Record

Nap: string [40] ;

fio: string [40] ;

vy: string [10] ;

end;

var a: array [1. .50] of RS;

n, i,j,q,k,f: integer; s,s1,w,r: string; x: RS;

begin

Writeln ('введите kol poezdov');

readln (n);

for i: =1 to n do

begin

writeln ('введите Направление',' ', i,' ','поезда');

readln (a [i]. Nap);

writeln ('введите Ф. И.О. ',' ', i,' ','машиниста');

readln (a [i]. fio);

writeln ('введите время',' ', i,' ','отправления');

readln (a [i]. vy);

end;

writeln ('введите номер операции программы');

writeln ('1-поиск поездов по фамилии, имени, отчеству машиниста');

writeln ('2-редактирование времени отправления поезда');

writeln ('3-удаление поездов по полю <Направление>');

writeln ('4-сортировку по полю <Направление>');

readln (q);

case q of

1: begin

writeln ('ведите Ф. И.О. машиниста ');

readln (w);

f: =0;

for i: =1 to n do

begin

if a [i]. fio=w then begin

writeln ('Направление ',a [i]. Nap,' ','время ',a [i]. vy);

f: =1; end;

if f=0 then writeln ('таких нет');

end; end;

2: begin

writeln ('введите время которое вы хотите поменять');