Задачи, алгоритмы, программы (стр. 10 )

Рис. 17.1. Множество Мандельброта.

Задача 17.2. Напишите программу, строящую простейший фрактал в виде дерева.

Программа должна строить горизонтальный отрезок [AB], от его концов A и B рисовать два вертикальных отростка [AC] и [BD]. Затем снова строить два горизонтальных отрезка меньшей длины [EF] и [GH], от концов которых пойдут два вертикальных отрезка и т. д. Длины горизонтальных отрезков на каждом шаге уменьшаются в a раз, где a --- случайное число в интервале от 1,5 до 3. Программа ПР - 17.2 представлена ниже.

uses dos, crt, graph; { ПР - 17.2 } const dt=0.000001; var x, y : array[1..700] of real; Gd, Gm, i, j, n, k,kk, yy : integer; a, l : real; label Metka, metka1; BEGIN Gd:=Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); setbkcolor(8); Randomize; x[1]:=320; yy:=400; l:=150; n:=1; kk:=9; Repeat i:=1; For k:=1 to n do begin y[i]:=x[k]+l; y[i+1]:=x[k]-l; i:=i+2; end; n:=n*2; a:=1.5+random(150)/100; l:=l/a; kk:=kk+1; If kk>13 then kk:=9; setcolor(kk); For i:=1 to n do x[i]:=y[i]; yy:=yy-20; For i:=1 to n do line(round(x[i]),yy, round(x[i]),yy-20); For i:=1 to round(n/2) do line(round(x[2*i]),yy, round(x[2*i-1]),yy); until n>300; Repeat until keypressed; CloseGraph; END.

Рис. 17.2. Простейший фрактал.

Задача 17.3. Напишите программу, строящую фрактал следующим образом: строится горизонтальный отрезок [AB], затем пририсовываются два вертикальных отрезка меньшей длины так, чтобы их середины совпадали с концами A и B. После этого строятся четыре горизонтальных отрезка меньшей длины и т. д.

Используемая ПР - 17.3 представлена ниже. С каждым следующим шагом длины отрезков уменьшаются в a раз, где a --- случайное число из интервала [1,5; 1,9]. Поэтому получающийся фрактал называется стохастическим. Процедура Draw рисует отрезки, а на концах строит окружности.

uses dos, crt, graph; { ПР - 17.3 } var x, y,xx, yy : array[1..7000] of integer; Gd, Gm, i,n, k,kk, l,l1,l0 :integer; a: real; Procedure Draw; begin For i:=1 to k do begin delay(20); kk:=kk+1; If kk>14 then kk:=2; setcolor(kk); line(xx[2*i],yy[2*i],xx[2*i-1],yy[2*i-1]); circle(xx[2*i],yy[2*i],3); circle(xx[2*i],yy[2*i],2); circle(xx[2*i-1],yy[2*i-1],3); circle(xx[2*i-1],yy[2*i-1],2); end; end; BEGIN Gd:=Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); setbkcolor(15); Randomize; x[1]:=320; y[1]:=240; l0:=230; k:=1; Repeat l1:=l0; For i:=1 to k do begin {gorizont} a:=1.5+random(400)/1000; l:=round(l1/a); xx[2*i]:=x[i]-l; xx[2*i-1]:=x[i]+l; yy[2*i]:=y[i]; yy[2*i-1]:=y[i]; end; Draw; k:=2*k; For i:=1 to k do begin x[i]:=xx[i]; y[i]:=yy[i]; end; l1:=l0; For i:=1 to k do begin {vertikal} a:=1.5+random(400)/1000; l:=round(l1/a); yy[2*i]:=y[i]-l; yy[2*i-1]:=y[i]+l; xx[2*i]:=x[i]; xx[2*i-1]:=x[i]; end; Draw; k:=2*k; For i:=1 to k do begin x[i]:=xx[i]; y[i]:=yy[i]; end; l0:=round(l0/2); until (k>1000)or(keypressed); Repeat until keypressed; CloseGraph; END.

Рис. 17.3. Стохастический фрактал.

Задача 17.4. Постройте конторово множество: исходный отрезок разбейте на три части и удалите середину. Затем повторите эту процедуру с получившимися двумя отрезками, создав четыре отрезка. Выполнив эту операцию много раз, получите фрактал.

Предлагаемая программа содержит рекурсивную процедуру, которая делит отрезок на 3 части, отбрасывает среднюю часть и вызывает саму себя для повторения этой операции с получившимися двумя отрезками. Результат работы программы представлен на рис. 17.4.

uses dos, crt, graph; { ПР - 17.4 } var Gd, Gm, a,b, n,l, i,j : integer; Procedure rec(a, b,l, n:integer); var x1,x2 :integer; begin If n<9 then begin l:=round(l/2.1); x1:=a; x2:=b; For j:=1 to 19 do begin line(x1,20*n+j, x1+l-2,20*n+j); line(x2-l+2,20*n+j, x2,20*n+j); end; n:=n+1; rec(x1,x1+l, l,n); rec(x2-l, x2,l, n); end; end; BEGIN Gd:=Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); l:=620; a:=10; b:=l; line(a,10,b,10); rec(a, b,l,1); Repeat until keypressed; CloseGraph; END.

Рис. 17.4. Канторово множество.

Задача 17.5. Постройте фрактал по следующему алгоритму: программа выбирает в центре экрана точку O и строит квадрат ABCD с длиной стороны L. После этого она строит квадраты вокруг вершин A, B, C, D с длинами сторон L/a и т. д., где a --- случайная величина в интервале [2; 2,5].

Программа ПР - 17.5 содержит рекурсивную процедуру, которая вызывает сама себя. При каждом вызове счетчик n увеличивается на 1, пересчитывается длина стороны L (уменьшается в a раз, где a --- случайная величина из интервала [2, 2.5]), изменяется цвет рисуемых квадратов.

uses dos, crt, graph; { ПР - 17.5 } var Gd, Gm, x,y, n,l : integer; Procedure rec(x, y,l, n:integer); var x0,y0,x1,x2,y1,y2,x3,y3,x4,y4 :integer; begin inc(n); setcolor(n mod 6+6); If n<9 then begin l:=round(l/(random(5)/10+2)); x0:=x; y0:=y; rectangle(x-l, y-l, x+l, y+l); rectangle(x-l+1,y-l-1,x+l+1,y+l+1); rec(x0-l, y0-l, l,n); rec(x0-l, y0+l, l,n); rec(x0+l, y0+l, l,n); rec(x0+l, y0-l, l,n); end; end; BEGIN Gd:=Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); setbkcolor(11); randomize; l:=250; x:=320; y:=240; rec(x, y,l,1); Repeat until keypressed; CloseGraph; END.

Рис. 17.5. Фрактал из квадратов.

Задача 17.6. Постройте фрактал по следующему алгоритму. Плоская поверхность разбита на клетки, находящиеся в состоянии 0. Если клетка перешла в возбужденное состояние 1, то вероятность перехода соседних четырех клеток в состояние 1 на следующем шаге становится большой. Если невозбужденная клетка граничит с двумя, тремя или четырьмя возбужденными клетками, то вероятность ее перехода в состояние 1 уменьшается.

Пусть на плоской поверхности, разбитой на квадратные клетки, находятся бактерии. Клетку, внутри которой они находятся, будем считать возбужденной (a[i, j]=1). Бактерии могут переходить в смежную клетку (например, [i+1,j]), которая при этом тоже станет возбужденной (была a[i+1,j]=0, стала a[i+1,j]=1). Допустим, что бактерии из клетки [i, j] живут за счет питательных веществ, находящихся в соседних четырех клетках [i-1,j], [i+1,j], [i, j-1], [i, j+1]. Тогда вероятность возбуждения клетки в состоянии 0 тем меньше, чем больше возбужденных соседей она имеет. Можно также учесть и время, в течение которого соседние клетки были возбуждены и жили, потребляя питательное вещество из данной клетки. Для моделирования этого процесса используется программа ПР - 17.6. В ней перебираются все клетки и вычисляется число возбужденных соседей, результаты сохраняются в массиве b[i, j].

uses dos, crt, graph; { ПР - 17.6 } const N=110; M=90; var a, b,p: array[1..N,1..M]of integer; Gd, Gm, i,j, S,K, x: integer; BEGIN Gd:=Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); Randomize; setbkcolor(15); a[60,40]:=1; Repeat For i:=2 to N-1 do For j:=2 to M-1 do begin S:=a[i-1,j]+a[i, j-1]+a[i+1,j]+a[i, j+1]; b[i, j]:=b[i, j]+S; If b[i, j]=0 then p[i, j]:=0; If b[i, j]<>0 then p[i, j]:=round(70/b[i, j]/b[i, j]); If b[i, j]>3 then p[i, j]:=0; end; For i:=2 to N-1 do For j:=2 to M-1 do begin If a[i, j]>0 then a[i, j]:=a[i, j]+1; x:=random(100); If (a[i, j]=0)and(x0 then begin If a[i, j]/6>12 then a[i, j]:=1; setcolor(round(a[i, j]/6+1)); circle(5+5*i,5+5*j,2); circle(5+5*i,5+5*j,1); end; delay(2000); until keypressed; CloseGraph; END.

Рис. 17.6. Стохастический фрактал.

18. ДРУГИЕ ЗАДАЧИ ПО ПРОГРАММИРОВАНИЮ

Задача 18.1. Методом трапеций вычислите площадь круга радиусом 1, определите значение числа π.

Площадь единичного круга равна учетверенному значению интеграла Значение интеграла может быть найдено методом трапеций по следующей формуле: Используемая программа ПР - 18.1 приведена ниже. При ее запуске на экране получается следующее значение: 3,.

uses dos, crt; const dx=0.00001; { ПР - 18.1 } var i : longint; x, y1,y2,S : real; BEGIN Repeat y1:=sqrt(1-x*x); inc(i); x:=i*dx; y2:=sqrt(1-x*x); S:=S+(y1+y2)*dx/2; until i=100000; writeln(4*S); Readkey; END.

Задача 18.2. Напишите программу, переводящe. десятичное число в шестнадцатиричную систему счисления.

Программа ПР - 18.2 работает так. Десятичное число, которое необходимо перевести в шестнадцатиричную систему счисления, присваивается переменной a. В начале цикла значение переменной a присваивается переменной b, а переменной a присваивается целая часть от деления a на 16. После этого определяется разность b - 16 * a, соответствующая цифра записывается в младший разряд. После этого все повторяется снова.

uses crt; { ПР - 18.2 } var a, b,c, d:integer; label m; BEGIN clrscr; write('введите десятичное число '); read(a); c:=20; Repeat c:=c-1; b:=a; a:=a div 16; d:=b-16*a; gotoxy(c,5); If d=10 then begin write('A'); goto 10; end; If d=11 then begin write('B'); goto 10; end; If d=12 then begin write('C'); goto 10; end; If d=13 then begin write('D'); goto 10; end; If d=14 then begin write('E'); goto 10; end; If d=15 then begin write('F'); goto 10; end; write(d); m: until a=0; ReadKey; END.

Задача 18.3. Промоделируйте работу исполнителя, перемещающегося по горизонтальной поверхности в соответствии с заданной программой.

Используется программа ПР - 18.3. Последовательность команд исполнителя записана в виде: a:='drd. . . luld'. при этом u - вверх, d - вниз, r - вправо, l - влево. Программа содержит цикл, в котором вырезается по одному символу, в результате чего светящаяся точка на экране монитора смещается с некоторым шагом вверх, вниз, вправо или влево.

Uses graph, crt; { ПР - 18.3 } Var k4,k1,k, k2,k3,i, Gd, Gm, p: integer; a, x: string; BEGIN Gd:=Detect; InitGraph(Gd, Gm, 'c:\BP\BGI'); moveto(320,240); a:='drdrdruuululululululdddddd'; k:=0; For i:=1 to length(a) do begin x:=copy(a, i,1); If x='r' then begin k1:=k+30; linerel(k1,0) end else If x='u' then begin k2:=k+30; linerel(0,k2) end else If x='l' then begin k3:=k-30; linerel(k3,0) end else If x='d' then begin k4:=k-30; linerel(0,k4) end; delay(5000); sound(400); delay(1500); nosound; end; Readkey; CloseGraph; END.

Задача 18.4. Напишите тестирующую программу, проверяющую умение решать примеры по арифметике.

Используемая программа ПР - 18.4 содержит цикл, в котором задаются случайные значения переменных a и b и генерируется пример типа a * b = ?. Тестируемый вводит ответ n, компьютер сравнивает его с правильным ответом c = a * b. Определяется число правильных ответом, ставится оценка.

uses crt; { ПР - 18.4 } var s, i,j, a,b, c,n:integer; BEGIN clrscr; randomize; s:=0; For j:=1 to 5 do begin a:=random(9); b:=random(9); c:=a*b; writeln; writeln('Сколько будет ',a,'*',b ); writeln('ответ'); readln(n); If n=c then begin write('ВЕРНО') ;s:=s+1; If n<>c then begin write('НЕТ'); end; end; write('Число правильных ответов=',s); end; If s=5 then begin write ('ваша оценка 5'); end; If s=4 then begin write ('ваша оценка 4'); end; If s=3 then begin write ('ваша оценка 3'); end; If s=2 then begin write ('ваша оценка 2'); end; If (s=1) or (s=0) then begin write('попробуйте заново'); end; ReadKey; END.

Задача 18.5. Археологи А, Б и В нашли монету. Каждый высказал по 2 предположения: 1) А сказал: монета греческая, 5 век; 2) Б сказал: монета испанская, 3 век; 3) В сказал: монета не греческая, 4 век. Каждый из археологов прав только в одном из двух предположений. Где и когда была выпущена монета?

Обозначим простые высказывания: G=1 - монета греческая, I=1 - монета испанская, P=1 - пятый век, C=1 - четвертый век, T=1 - третий век. Каждый из археологов прав только в одном из двух предположений, поэтому высказывания 1, 2, и 3 приводят к следующим логическим уравнениям: 1) G not(P) + not(G) P = 1, 2) I not(T) + not(I) T = 1, 3) not(G) not(C) + G C = 1. Монета не может быть изготовлена в двух государствах и двух веках: GI=0, PC=0, PT=0, CT=0. Решением этой задачи является программа ПР - 18. В ней автоматически перебираются все возможные варианты и находится такой, при котором истинны все 7 уравнений. Число истинных уравнений обозначено через k. Необходимо запустить программу и найти строчку, для которой k=7.

uses crt; { ПР - 18.3 } var G, P,I, T,C: boolean; gg, pp, tt, cc, ii, k,l, m,n, o: integer; BEGIN clrscr; k:=0; For gg:=0 to 1 do begin If gg=0 then g:=false else g:=true; For pp:=0 to 1 do begin If pp=0 then p:=false else p:=true; For tt:=0 to 1 do begin If tt=0 then t:=false else t:=true; For cc:=0 to 1 do begin If cc=0 then c:=false else c:=true; For ii:=0 to 1 do begin If ii=0 then i:=false else i:=true; If ((g)and(not(p))or(not(g)and(p))=true) then k:=k+1; If ((i)and(not(t)))or(not(i)and(t))=true then k:=k+1; If (not(g)and(not(c)))or((g)and(c))=true then k:=k+1; If (g)and(i)=false then k:=k+1; If (p)and(c)=false then k:=k+1; If (p)and(t)=false then k:=k+1; If (c)and(t)=false then k:=k+1; writeln(g,' ',p,' ',t,' ',c,' ',i,' ',k,' '); k:=0; end; end; end; end; end; writeln(k); ReadKey; end.

Задача 18.6. Имеется совокупность 30 объектов, каждый из которых характеризуется двумя величинами. Напишите программу, которая осуществляла бы кластеризацию (автоматическую классификацию) объектов, разделяя их на классы.

Кластеризация иерархического типа состоит в последовательном объединении групп объектов, начиная с самых близких и похожих друг на друга. Рассмотрим множество из n объектов O1 (x1, y1), O2(x2, y2), ..., On (xn, yn), каждый из которых характеризуется двумя признаками X и Y. В пространстве признаков XOY каждому объекту соответствует точка. В качестве меры близости двух объектов Oi и Oj обычно выбирают геометрическое расстояние между этими точками: На начальном этапе считают, что каждый объект образует кластер с массой 1. Для каждой пары точек определяют меру близости Si, kи, сравнивая их друг с другом, находят наиболее близко расположенные объекты, которые объединяются в один кластер с массой 2. Координаты нового кластера вычисляются как средние взвешенные координат объединенных кластеров. Затем процесс повторяется. При слиянии двух кластеров Oi и Oj (i меньше j) c весовыми коэффициентами pi и pj получается кластер Oi, имеющий следующие координаты и весовой коэффициент соответственно: В результате N-Ch_kl шагов, на каждом из которых два кластера объединяются в один, получается разбиение на Ch_kl кластеров. Результат использования программы ПР - 18.4 для кластеризации 30 двумерных объектов представлен на рис. 18.4. Если отключить графический режим, закоментировать соответствующие операторы и раскоментировать другие, то на экран будет выведен список объектов с указанием класса, к которому он отнесен.

uses crt, dos, graph; { ПР - 18.6 } const Max=30; Ch_kl=3; U=15; Data1: array[1..Max]of real=(4,3,5,6,5,7,8,4,10,13,9,11,-2, -6,-7,-9,-8,-11,-7,-12,4,7,3,5,6,8,5,7,10,13); Data2: array[1..Max]of real=(-2,-8,-3,-9,-7,-5,-12,-11,-6,-10, -8,-7,9,7,4,6,8,10,6,4,8,7,10,11,6,7,4,11,6,5); Var x, y,p : array[1..Max] of real; klass : array[1..Max] of integer; L: array[1..Max,1..Ch_kl] of real; i, j,k, m,N, t,Gd, Gm: integer; a, L1: real; BEGIN Gd:=Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); N:=Max; For i:=1 to N do begin klass[i]:=i; p[i]:=1; x[i]:=Data1[i]; y[i]:=Data2[i]; end; Repeat a:=10000; For i:=1 to N do For j:=i+1 to N do begin L1:=sqr(x[i]-x[j])+sqr(y[i]-y[j]); If L1<a then begin a:=L1; k:=i; m:=j; end; end; dec(N); { writeLn('Объекты ',k,' и ',m,' объединяются в новый кластер ',k);} { line(320+round(x[k]*U),240-round(y[k]*U), 320+round(x[m]*U),240-round(y[m]*U));} y[k]:=(y[k]*p[k]+y[m]*p[m])/(p[k]+p[m]); x[k]:=(x[k]*p[k]+x[m]*p[m])/(p[k]+p[m]); p[k]:=p[k]+p[m]; { writeLn('Его координаты ', x[k]:4:2, y[k]:8:2,' вес ',p[k]:2:0);} For i:=1 to N do If i>=m then begin x[i]:=x[i+1]; y[i]:=y[i+1]; p[i]:=p[i+1]; klass[i]:=klass[i+1]; end; until N=Ch_kl; For i:=1 to Max do begin a:=1000; For j:=1 to Ch_kl do begin L[i, j]:=sqr(Data1[i]-x[j])+sqr(Data2[i]-y[j]); If L[i, j]<a then begin a:=L[i, j]; klass[i]:=j; end; end; end; For i:=1 to Max do write(' | ob[',i,']=',klass[i]);{} line(0,240,640,240); line(320,0,320,480); For i:=1 to Max do circle(320+round(Data1[i]*U), 240-round(Data2[i]*U),2); For i:=1 to N do circle(320+round(x[i]*U), 240-round(y[i]*U),3); For i:=1 to Max do For j:=1 to Ch_kl do If klass[i]=j then line(320+round(x[j]*U),240-round(y[j]*U), 320+round(Data1[i]*U),240-round(Data2[i]*U)); Repeat until keypressed; CloseGraph; END.

Рис. 18.4. Результат классификации объектов на 3 группы.

Задача 18.7. Напряжение изменяется по периодическому закону U=U(t). Напишите программу, осуществляющую разложение функции U=U(t) в ряд Фурье. Восстановите функцию и постройте график.

Формулы для разложения периодической функции в ряд Фурье имеют вид: В предлагаемой программе методом прямоугольников вычисляются постоянная составляющая U0, косинусоидальные и синусоидальные члены ряда a[n] и b[n] для двадцати первых гармоник. По результатам строят график восстановленного сигнала (рис. 18.5).

uses dos, crt, graph; const Ch_garm=20; pi=3.1415926; var t, dt, w,aa, bb, U0,UV, Period: real; i, n,Gd, Gm: integer; a, b: array[1..50]of real; Function U(t:real):real; begin w:=2*pi/Period; U:=abs(10*sin(w*t)); {If t>Period/2 then U:=0 else U:=10*sin(w*t);} {If t>Period/2 then U:=0 else U:=10;} {U:=2*t;} end; BEGIN clrscr; dt:=2*pi/1000; Period:=2*pi; For i:=1 to 1000 do begin t:=i*dt; U0:=U0+U(t)*dt; end; U0:=U0/Period; writeln(U0); For n:=1 to Ch_garm do begin aa:=0; bb:=0; For i:=1 to 1000 do begin t:=i*dt; aa:=aa+U(t)*cos(n*w*t)*dt; end; a[n]:=2*aa/Period; For i:=1 to 1000 do begin t:=i*dt; bb:=bb+U(t)*sin(n*w*t)*dt; end; b[n]:=2*bb/Period; writeln(a[n],' ',b[n]); end; readkey; Gd:=Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); line(0,300,640,300); For i:=1 to 5000 do begin t:=i*dt; UV:=U0; For n:=1 to Ch_garm do begin UV:=UV+a[n]*cos(n*w*t)+b[n]*sin(n*w*t); end; circle(10+round(t*20),300-round(10*UV),1); end; Repeat until keypressed; CloseGraph; END.

Рис. 18.5. Разложение в ряд Фурье.

Задача 18.8. Напишите программу, которая работает так: компьютер случайно загадывает число от 1 до 256. Вы пытаетесь угадать. Компьютер отвечает "больше" или "меньше".