Файл: Методическое пособие 2013 Корректор Осипова Е. А.pdf

66
writeln('Введите элемент, который Вы хотите вставить в список'); readln(e1); insert(l,e,e1); writeln('Полученный список'); out_spisok(l);
{освобождаем динамическую память} while l<> nil do begin s:=l^.next; dispose(l); l:=s; end; end.
10>0>

Задача 4.3. Описать процедуру, которая удаляет из непустого спи-
ска l последний элемент.
type list=^node; node= record info : integer; next : list end; var s,l : list; x : integer; n,i : integer; procedure del(var l : list); var p,q : list; begin if l=nil then {удалять нечего} else if l^.next=nil {в списке один элемент} then begin dispose(l);l:=nil end else begin
{поиск предпослед.(p) и послед.(q) звеньев: } p:=l; q:=p^.next; while q^.next<>nil do begin p:=q; q:=q^.next end;
{удаление последнего звена:} dispose(q); p^.next:=nil end; end;

67
procedure out_spisok(l : list); begin while l<> nil do begin s:=l^.next; write(l^.info,' '); l:=s; end; writeln; end; begin
{формируем список} s:=nil; writeln('Введите количесто элементов списка'); readln(n); for i:=1 to n do begin new(l); l^.next:=s; readln(x); l^.info:=x; s:=l; end;
{выводим список на экран} writeln('Введенный список'); out_spisok(l); del(l); writeln('Полученный список'); out_spisok(l);
{освобождаем динамическую память} while l<> nil do begin s:=l^.next; dispose(l); l:=s; end; end.
Задача 4.4. Описать рекурсивную функцию или процедуру, которая:
а) определяет, входит ли элемент E в список L;
б) удаляет из списка L первое вхождение элемента Е, если такое есть;

68
а) type list=^node; node= record info : integer; next : list end; var s,l : list; x,e : integer; n,i : integer; function memb(l : list; e : integer) : boolean; var l1 : list; begin if l=nil then memb:=false else if l1^.info=e then memb:=true else memb:=memb(l1^.next,e) end; procedure out_spisok(l : list); begin while l<> nil do begin s:=l^.next; write(l^.info,' '); l:=s; end; writeln; end; begin
{формируем список} s:=nil; writeln('Введите количесто элементов списка'); readln(n); for i:=1 to n do begin new(l); l^.next:=s; readln(x); l^.info:=x; s:=l; end;
{выводим список на экран}

69
writeln('Введенный список'); out_spisok(l); writeln('Введите интересующий Вас элемент'); readln(e); if not(memb(l,e)) then writeln('Элемент ', e, ' входит в список') else writeln('Элемент ', e, ' не входит в список');
{освобождаем динамическую память} while l<> nil do begin s:=l^.next; dispose(l); l:=s; end; end. б) type list=^node; node= record info : integer; next : list end; var s,l : list; x,e : integer; n,i : integer; procedure delete(var l : list; e :integer); var p : list; begin if l<>nil then begin if l^.info=e then {удалить первое звено} begin p:=l; l:=L^.next; dispose(p) end else {удалить Е из "хвоста" списка и записать в 1-е звено ссылку на измененный хвост":} delete(l^.next,e) end; end; procedure out_spisok(l : list); begin while l<> nil do begin

70
s:=l^.next; write(l^.info,' '); l:=s; end; writeln; end; begin
{формируем список} s:=nil; writeln('Введите количесто элементов списка'); readln(n); for i:=1 to n do begin new(l); l^.next:=s; readln(x); l^.info:=x; s:=l; end;
{выводим список на экран} writeln('Введенный список'); out_spisok(l); writeln('Введите интересующий Вас элемент'); readln(e); delete(l,e); writeln('Полученный список'); out_spisok(l);
{освобождаем динамическую память} while l<> nil do begin s:=l^.next; dispose(l); l:=s; end; end.
Программы, работающие в графическом режиме
Для решения задач, приведенных ниже, используется модуль
GRAPH, этот модуль не может быть использован для написания программ в системе PascalABС, так как для данной системы разработан модуль
GRAPHABC, процедуры и функции которого не всегда совпадают с про-

71
цедурами и функциями модуля GRAPH. В примерах 8 и 9 данного раздела приводятся программы, использующие модуль GRAPHABC, также приме- ры использования данного модуля можно посмотреть в разделе Помощь системы программирования PascalABC.
Задача 4.5. Построить семейство одинаковых окружностей, цен-
тры которых лежат на вертикально вращающемся отрезке, верхний ко-
нец которого закреплен.
Переменные: x, y — координаты центра очередного маленького круга; y0 — смещение кругов по вертикале; i — переменная цикла; t — угол поворота; drive — тип графического драйвера; mode — режим работы графического адаптера.
Для решения задачи:
1)
инициируем модуль graph;
2)
устанавливаем начальные значения радиуса, координаты центра;
3)
организуем цикл, в котором закрашиваем круги со все большим радиусом до тех пор, пока не будет нажата любая клавиша. uses crt, graph; var drive,mode,x,y,i,t,y0:integer; begin drive:=detect; initgraph(drive,mode,'c:\tp\bgi'); setfillstyle(1,1); floodfill(1,4,1); t:=–4; y0:=10; setcolor(16); for i:=1 to 150 do begin t:=t+2; y0:=y0+3; x:=getmaxx div 2 + trunc(cos(t/10)*i); y:=y0 – trunc(sin(t/10)*i); setfillstyle(1,14); fillellipse(x,y,20,20); delay(100); end;

72
repeat until keypressed; closegraph; end.
Задача 4.6. Построить движущиеся изображения НЛО на фоне
звездного неба.
I.
Переменные: x, y — случайные координаты; r — радиус; i — переменная цикла; drive — тип графического драйвера; mode — режим работы графического адаптера.
Алгоритм решения задачи:
1)
инициируем модуль graph;
2)
организуем безусловный цикл по переменной i и рисуем звездное небо;
3)
организуем цикл до тех пор, пока не будет нажата любая клавиша;
4)
в этом цикле рисуем НЛО с помощью двух эллипсов, двух линий и двух маленьких кружочков, держим на экране, затем стираем изображение процедурой CLEARDEVICE;
5)
опять рисуем звездное небо;
6)
определяем случайным образом координаты следующего изобра- жения НЛО;
7)
после нажатия любой клавиши закрываем графический режим. uses crt,graph; var drive,mode,x,y,i,r:integer; begin r:=40; x:=r*5; y:=r*2; drive:=detect; initgraph(drive,mode,'c:\tp\bgi'); setcolor(3); for i:=1 to 600 do putpixel(random(i),random(i),i); repeat ellipse(x,y,0,360,r,(r div 3)+2); ellipse(x,y–4,190,357,r,r div 3); line(x–17,y–16,x–25,y–22); line(x+17,y–16,x+25,y–22);

73
circle(x+25, y–25,2); circle(x–25, y–25,2); setfillstyle(1,3); floodfill(x+1,y+4,3); delay(150); cleardevice; for i:=1 to 600 do putpixel(random(i),random(i),i); x:=x+random(10); y:=y+random(10); until (keypressed); closegraph; end.
II. Эта же программа может быть написана с использованием пары процедур GETIMAGE(lx,ly,rx,ry,saucer^) и PUTIMAGE(x,y,saucer^,xorput).
Процедура GETIMAGE(lx,ly,rx,ry,saucer^) помещает изображение в буфер, а PUTIMAGE(x,y,saucer^,xorput) выводит в заданное место изобра- жение.
Параметр xorput определяет способ вывода на экран — исключаю- щее ИЛИ.
Например, операторами
GETIMAGE(lx,ly,rx,ry,saucer^);
READLN;
PUTIMAGE(x,y,saucer^,xorput); мы выводим изображение на экран и после нажатия любой клавиши стира- ем его.
Можно использовать другие способы вывода изображения на экран, например:
NORMALPUT — стирает часть экрана и на это место выводит изо- бражение;
NOTPUT — делает то же самое, но изображение инвертируется;
ORPUY — дописывает новое изображение.
Переменные: x, y — случайные координаты; r — радиус; i — переменная цикла; saucer — указатель буфера хранения изображения; drive — тип графического драйвера; mode — режим работы графического адаптера.
Алгоритм решения задачи:
1)
инициируем модуль graph;

74 2)
рисуем НЛО с помощью двух эллипсов, двух линий и двух ма- леньких кружочков, держим на экране, затем стираем изображение проце- дурой CLEARDEVICE;
3)
определяем размер буфера и помещаем в него изображение;
4)
организуем безусловный цикл по переменной i и рисуем звездное небо;
5)
организуем цикл до тех пор, пока не будет нажата любая клавиша;
6)
опять рисуем звездное небо;
7)
в этом цикле помещаем изображение из буфера на экран, держим его на экране, затем стираем изображение;
8)
определяем случайным образом координаты следующего изобра- жения НЛО;
9)
после нажатия любой клавиши закрываем графический режим. uses crt,graph; var drive,mode,x,y,i,r,rx,ry,lx,ly,size:integer; saucer:pointer; begin r:=20; x:=r*5; y:=r*2; drive:=detect; initgraph(drive,mode,'c:\tp\bgi'); setcolor(3); ellipse(x,y,0,360,r,(r div 3)+2); ellipse(x,y–4,190,357,r,r div 3); line(x–17,y–16,x–25,y–22); line(x+17,y–16,x+25,y–22); circle(x+25, y–25,2); circle(x–25, y–25,2); setfillstyle(1,3); floodfill(x+1,y+4,3); lx:=x–r–30; ly:=y–30; rx:=x+r+30; ry:=y+r div 3+30; size:=imagesize(lx,ly,rx,ry); getmem(saucer,size); getimage(lx,ly,rx,ry,saucer^); readln; putimage(lx,ly,saucer^,xorput); for i:=1 to 600 do putpixel(random(i),random(i),i);

75
repeat putimage(x,y,saucer^,xorput); delay(150); putimage(x,y,saucer^,xorput); x:=x+random(10); y:=y+random(10); until (keypressed); readln; closegraph; end.
Задача 4.7. Построить астроиду-кривую, заданную параметриче-
ским уравнением x = b cos
3
(t), y = b sin
3
(t), t принадлежит интервалу [0,
2
π
] (рис. 1).
uses crt,graph; const B=200; var drive,mode,i:integer; x,y,t:real; begin drive:=detect; initgraph(drive,mode,'c:\tp\bgi'); {инициализация графического режима} setcolor(3); line(10,240,630,240); {ось X} line(320,10,320,470); {ось Y} line(630,240,610,235); {стрелки на оси X} line(630,240,610,245); line(320,10,315,30); {стрелки на оси Y} line(320,10,325,30); t:=0; while t<=2*pi do begin x:=b*sqr(cos(t))*cos(t); {рассчитываем по формуле координаты точек} y:=b*sqr(sin(t))*sin(t); x:=320+x; y:=240+y; {рисуем в центре экрана}
{рисуем точку с координатами x, y} putpixel(round(x),round(y),random(15)); t:=t+0.001; end; repeat until keypressed;
-2
-1 1
2
-2
-1 1
2
Рис. 1 — Астроида

76
closegraph; end.
Задача 4.8. Программа выводит окно с линиями.
Обратите внимание, что не нужно использовать специальные процедуры для подключения графического модуля,
// Графика. Линии. Размеры окна. Заголовок окна uses GraphABC; begin
Window.Title := 'Первая графическая программа';
Line(0,0,Window.Width-1,Window.Height-1);
Line(0,Window.Height-1,Window.Width-1,0); end.
Задача 4.9. Программа иллюстрирует обработку событий мыши.
// Иллюстрация обработки событий мыши uses GraphABC; procedure MouseDown(x,y,mb: integer); begin
MoveTo(x,y); end; procedure MouseMove(x,y,mb: integer); begin if mb=1 then LineTo(x,y); end; begin
// Привязка обработчиков к событиям
OnMouseDown := MouseDown;
OnMouseMove := MouseMove end.

77
-2
-1 1
2
-2
-1 1
2
Варианты
заданий
лабораторной
работы
№
4
Вариант 1
Задача 1
Используйте линейные списки для хранения последователь- ности чисел. Опишите процедуру или функцию, которая: а) переносит в начало непустого списка его последний эле- мент; б) добавляет в конец списка L1 все элементы списка L2.
Задача 2
Напишите программу для графической иллюстрации сорти- ровки массива алгоритмом простого выбора. Массив изобра- зите в виде диаграммы — каждый элемент массива представ- ляется в виде столбика, высота которого пропорциональна значению элемента. Визуализация сортировки сводится к по- казу массива после каждого перемещения элементов.
Вариант 2
Задача 1
Используйте линейные списки для хранения последователь- ности чисел. Опишите процедуру или функцию, которая: а) вставляет в список L за первым вхождением элемента E все элементы списка L1, если E входит в L. б) удаляет из списка L все элементы, которые есть в списке
L1.
Задача 2
Построить эпициклоиду — кривую, заданную параметриче- ским уравнениемx = (a+b) cos(t) – a cos((a+b) t/a), y = (a+b) sin(t) – a sin((a+b) t/a), a>0, b>0, b/a — целое положительное число, t принадлежит интервалу
[0,2
π].
Вариант 3
Задача 1
Используйте линейные списки для хранения последователь- ности чисел. Опишите процедуру, которая удаляет: а) из списка второй элемент, если такой есть; б) из непустого списка последний элемент.

78
Задача 2
Построить лемнискату — кривую, уравнение которой в по- лярных координатах
ρ = a
2 cos(2 )
ϕ
. a>0.
Вариант 4
Задача 1
Используйте линейные списки для хранения последователь- ности чисел. Опишите процедуру, которая удаляет: а) из списка первый отрицательный элемент, если такой есть; б) из списка все отрицательные элементы.
Задача 2
Построить строфоиду — кривую, заданную параметриче- ским уравнением x = a(t
2
– 1)/(t
2
+ 1), y = at (t
2
– 1)/(t
2
+1), a>0,t принадлежит интервалу [–
∞, + ∞].
Вариант 5
Задача 1
Используйте линейные списки для хранения последователь- ности строк. Опишите функцию, подсчитывающую количе- ство строк — элементов списка, которые: а) начинаются и оканчиваются одним и тем же символом; б) начинаются с того же символа, что и следующая строка.
-1
-0.5 0.5 1
-0.4
-0.2 0.2 0.4
-0.4
-0.2 0.2 0.4
-1.5
-1
-0.5 0.5 1
1.5

79
Задача 2
Построить кривую «улитку Паскаля» по заданному парамет- рическому уравнению x = a cos
2
(t) + b cos(t), y = a cos(t) sin(t) + b sin(t), a>0, b>0, t принадлежит интервалу [0, 2
π].
Рассмотреть три случая:
1) b >= 2a (см. рис.); 2) a < b< 2a; 3) a > b.
Вариант 6
Задача 1
Используйте линейные списки для хранения последователь- ности чисел. Опишите процедуру или функцию, которая для данного списка L создает список L1, содержащий те же эле- менты, но в обратном порядке
Задача 2
Соединить конечное множество точек на плоскости замкну- той ломаной линией без самопересечений с вершинами в этих точках. (Полный перебор не делать; ответом будет по- рядок обхода точек плоскости.)
Указание: перейти к полярным координатам и упорядочить точки по значениям угла, а для точек с одинаковым значени- ем угла — по расстоянию до полюса.
Вариант 7
Задача 1
Используйте линейные списки для хранения последователь- ности вещественных чисел. Опишите процедуру или функ- цию, которая: а) находит среднее арифметическое элементов непустого списка; б) заменяет в списке все вхождения элемента E1 на элемент E2.
Задача 2
Даны целые числа t1, t2, ... t31, — задающие график темпера- тур за март месяц. Построить график температур. Отрезки
1 2
3 4
5 6
7
-4
-2 2
4