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

Рис. 12.2.2. Обучение с поощрением.

Рис. 12.2.3. Обучение с наказанием.

Рис. 12.2.4. Обучение с поощрением и наказанием.

Рассмотрим другой вариант решения задачи (программа ПР - 12.2.2). В процедуре Uchenik случайным образом, исходя из матрицы вероятностей, производится переход в следующее состояние. В процедуре Obuchenie осуществляется пересчет вероятностей переходов из одного состояния в другое, в процедуре Zabyvan различие между вероятностями правильных и неправильных переходов уменьшается. На экране получаются графики зависимости уровня знаний от времени при различных коэффициентах научения и забывания (рис. 12.2.5).

uses crt, graph; { ПР - 12.2.2 } const N=2; NN=4000; var x : array[1..NN] of integer; p : array[1..2,1..2] of real; EC, DV, MV, k,i, j : integer; alpha, beta, s,rnd : real; Procedure Uchenik; begin rnd:=random(1000)/1000; inc(i); If rnd500 then goto met; If (x[i-1]=1)and(x[i]=2) then begin p[1,2]:=p[1,2]+alpha*(1-p[1,2]); p[1,1]:=(1-alpha)*p[1,1]; end; If (x[i-1]=2)and(x[i]=1) then begin p[2,1]:=p[2,1]+alpha*(1-p[2,1]); p[2,2]:=(1-alpha)*p[2,2]; end; met: end; Procedure Zabyvan; begin p[1,2]:=p[1,2]-beta*(p[1,2]-p[1,1]); p[1,1]:=p[1,1]+beta*(p[1,2]-p[1,1]); p[2,1]:=p[2,1]-beta*(p[2,1]-p[2,2]); p[2,2]:=p[2,2]+beta*(p[2,1]-p[2,2]); end; Procedure Raschet; begin For i:=1 to 2 do For j:=1 to 2 do p[i, j]:=0.5; For k:=1 to NN do begin Uchenik; Obuchenie; Zabyvan; j:=x[i]; circle(10+round(0.3*i),450-round(800*((p[1,2]-0.5))),1); end; end; BEGIN DV:=Detect; InitGraph(DV, MV,'c:\bp\bgi'); Randomize; Line(0,450,640,450); beta:=0.001; alpha:=0.01; Raschet; beta:=0.002; alpha:=0.01; Raschet; beta:=0.001; alpha:=0.02; Raschet; Repeat until Keypressed; CloseGraph; END.

Рис. 12.2.5. Кривые обучения.

Задача 12.3. Промоделируйте работу гомеостата Эшби --- адаптирующегося устройства с тремя степенями свободы x1, x2, x3, которое при выводе из положения равновесия (0,0,0) самостоятельно в него возвращается.

Гомеостат описывается тремя дифференциальными уравнениями: Программа ПР - 12.3.1 для нахождения коэффициентов ai, j, определяющих работы гомеостата, работает так. Значения ai, j и xjзадаются случайным образом. Вычисляются скорости v1, v2, v3 и координаты x1, x2, x3 в последовательные моменты времени. Если модуль хотя бы одной из координат превысил 1, то коэффициенты ai, j изменяются случайным образом. Так продолжается до тех пор, пока система не вернется в положение равновесия (0,0,0). Найденные значения коэффициентов ai, j печатаются в файл.

uses dos, crt, graph; { ПР - 12.3.1 } const n=3; dt=0.01; var x1,x2,x3,v1,v2,v3 : real; Gd, Gm, i,j, k : integer; a: array[1..n,1..n]of real; F: text; BEGIN Assign(F,'111.bak');Append(F); Gd:=Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); Randomize; x1:=0.1; For i:=1 to n do For j:=1 to n do a[i, j]:=0.1-random(200)/1000; line(10,100,640,100);line(100,10,100,480);line(400,10,400,480); Repeat v1:=a[1,1]*x1+a[1,2]*x2+a[1,3]*x3; v2:=a[2,1]*x1+a[2,2]*x2+a[2,3]*x3; v3:=a[3,1]*x1+a[3,2]*x2+a[3,3]*x3; x1:=x1+v1*dt; x2:=x2+v2*dt; x3:=x3+v3*dt; If abs(x1)>1 then For j:=1 to n do a[1,j]:=0.1-random(200)/1000; If abs(x2)>1 then For j:=1 to n do a[2,j]:=0.1-random(200)/1000; If abs(x3)>1 then For j:=1 to n do a[3,j]:=0.1-random(200)/1000; If x1>1 then x1:=0.99; if x1<-1 then x1:=-0.99; If x2>1 then x2:=0.99; if x2<-1 then x2:=-0.99; If x3>1 then x3:=0.99; if x3<-1 then x3:=-0.99; circle(100+round(x1*100),100-round(x2*100),1); circle(400+round(x2*100),100-round(x3*100),1); k:=k+1; until (k>40000)or(keypressed); For i:=1 to 3 do Writeln(F, a[i,1],' ',a[i,2],' ',a[i,3],' '); Readkey; Close(F); END.

Рис. 12.3.1. Подбор параметров гомеостата.

В результате работы программы ПР-1 рассчитываются коэффициенты ai, j, при которых гомеостат находится в положении равновесия (0,0,0). Эта задача имеет несколько решений. Допустим, получились следующие значения: После того, как найдены оптимальные параметры гомеостата, можно исследовать, как ведет себя гомеостат при выводе его из положения равновесия. В программе ПР - 12.3.2 случайным образом задаются начальные координаты x1, x2, x3 из интервала [-0,9; 0,9] и рассчитывается "поведение" гомеостата в последующие моменты времени. Во всех случаях гомеостат возвращается в положение равновесия.

uses dos, crt, graph; { ПР - 12.3.2 } const n=3; dt=0.01; var x1,x2,x3,v1,v2,v3,k : real; Gd, Gm, i,j : integer; a: array[1..n,1..n]of real; F: text; begin Gd:=Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); Randomize; x1:=0.1; a[1,1]:=-0.089; a[1,2]:=-0.001; a[1,3]:=0.07; a[2,1]:=0.082; a[2,2]:=-0.043; a[2,3]:=-0.028; a[3,1]:=-0.072; a[3,2]:=-0.045; a[3,3]:=0.027; Repeat k:=k+0.1; v1:=a[1,1]*x1+a[1,2]*x2+a[1,3]*x3; v2:=a[2,1]*x1+a[2,2]*x2+a[2,3]*x3; v3:=a[3,1]*x1+a[3,2]*x2+a[3,3]*x3; x1:=x1+v1*dt; x2:=x2+v2*dt; x3:=x3+v3*dt; if k>5000 then begin x1:=0.9-random(1800)/1000; x2:=0.9-random(1800)/1000; x3:=0.9-random(1800)/1000; k:=0; delay(10000); cleardevice; line(0,240,640,240); line(150,10,150,480); line(450,10,450,480); end; circle(150+round(x1*150),240-round(x2*150),1); circle(450+round(x2*150),240-round(x3*150),1); until keypressed; Repeat until keypressed; CloseGraph; end.

Рис. 12.3.2. Функционирование гомеостата.

Задача 12.4. Промоделируйте игру Жизнь. Плоская поверхность разбита на клетки, ведущие себя как автоматы, способные находиться в двух состояниях: "живой" и "метртвый". Клетка оживает при наличии 3 живых соседей. Если живых соседей 4 и больше, она умирает от перенаселенности. Если живых соседей меньше 2, она умирает от одиночества.

Представим двумерную сетку, в каждом узле --- автомат, реализующий заданное правило. Используется программа ПР - 12.4. Состояния клеток закодированы так: клетка "жива" - 1, "мертва" - 0. Вычисление числа "живых" соседей и установление "жива" данная клетка или нет на следующем временном шаге осуществляется в процедуре Raschet и записывается в массив x[i, j]. В массив x1[i, j] записывается состояние клеток на предыдущем временном шаге. В начале программы следует задать исходное распределение "живых" клеток.

uses crt; const N=26; { ПР - 12.4 } type z1=record x, y,xy, x1,y1:real end; massiv = array[-1..N+1,-1..N+1] of integer; var z, y,x, x1: massiv; s, i,j, k,l, m:integer; procedure Print; var i, j:integer; begin clrscr; For i:=1 to N do For j:=1 to N do begin If x[i, j]=1 then Write(' * '); If x[i, j]=0 then Write(' '); end; Writeln; end; procedure Oboznach; var i, j:integer; begin For i:=1 to N do For j:=1 to N do x1[i, j]:=x[i, j]; end; procedure Raschet; var i, j:integer; begin For i:=1 to N do For j:=1 to N do begin S:=x1[i-1,j-1]+x1[i-1,j]+x1[i-1,j+1]+x1[i, j-1]+ x1[i, j+1]+x1[i+1,j-1]+x1[i+1,j]+x1[i+1,j+1]; If s=3 then x[i, j]:=1; If (s<2)or(s>3) then x[i, j]:=0; end; end; BEGIN For i:=-1 to N+1 do For j:=-1 to N+1 do x[i, j]:=0; {x[14,18]:=1; x[14,17]:=1; x[14,16]:=1; x[14,15]:=1;} {x[14,17]:=1; x[14,16]:=1; x[14,15]:=1;} {x[14,17]:=1; x[14,16]:=1; x[14,15]:=1; x[13,15]:=1; x[12,16]:=1;} {x[15,13]:=1; x[15,14]:=1; x[15,15]:=1; x[16,14]:=1;} {x[14,17]:=1; x[14,16]:=1; x[14,15]:=1; x[15,16]:=1; x[15,15]:=1; x[15,14]:=1;} x[14,17]:=1; x[14,16]:=1; x[14,15]:=1; x[15,16]:=1; x[15,15]:=1; x[15,14]:=1; x[14,10]:=1; x[14,11]:=1; x[14,12]:=1; x[15,11]:=1; x[15,15]:=1; x[15,13]:=1; Print; Repeat delay(6000); Oboznach; Raschet; Print; until keypressed; END.

Задача 12.5. Промоделируйте распространение автоволн в двумерной активной среде. Изучите однорукавную и двурукавную автоволны, подавление высокочастотного источника низкочастотным, дифракцию автоволн.

Каждый элемент активной среды может находиться в трех различных состояниях: покое, возбуждении и рефрактерности. При отсутствии внешнего воздействия, элемент находится в состоянии покоя. В результате воздействия элемент переходит в возбужденное состояние, приобретая способность возбуждать соседние элементы. Через некоторое время после возбуждения элемент переключается в состояние рефрактерности, находясь в котором он не может быть возбужден. Затем элемент сам возвращается в исходное состояние покоя, то есть снова приобретает способность переходить в возбужденное состояние. Рассмотрим обобщенную модель Винера--Розенблюта. Пусть состояние каждого элемента в момент t описывается фазой yi, jt, и концентрацией активатора ui, jt. Если элемент находится в покое, то будем считать, что yi, jt=0. Если вследствие близости возбужденных элементов концентрация активатора ui, jt достигает порогового значения h, то элемент возбуждается и переходит в состояние 1. Затем на следующем шаге он переключается в состояние 2, затем --- в состояние 3 и т. д., оставаясь при этом возбужденным. Достигнув состояния r элемент переходит в состояние рефрактерности. Через s (s>r) шагов после возбуждения элемент возвращается в состояние покоя: Будем считать, что при переходе из состояния s в состояние покоя 0 концентрация активатора становится равной 0. При наличии соседнего элемента, находящегося в возбужденном состоянии, она увеличивается на 1. Можно ограничиться учетом ближайших восьми соседних элементов. Используется программа ПР - 12.5, получающиеся результаты представлены на рис. 12.5.1 и 2.

uses dos, crt, graph; { ПР - 12.5 } Const N=110; M=90; s=18; r=10; h=10; Var y, yy, u : array [1..N,1..M] of integer; ii, jj, j, k, Gd, Gm: integer; i: Longint; Label met; BEGIN Gd:= Detect; InitGraph(Gd, Gm, 'c:\bp\bgi'); If GraphResult <> grOk then Halt(1); setcolor(8); setbkcolor(15); (* y[50,50]:=1; { Одиночная волна } *) (* For j:=1 to 40 do { Однорукавная волна } For i:=1 to s do y[50+i, j]:=i; *) (* For j:=1 to M do { Двурукавная волна } For i:=1 to s do begin y[50+i, j]:=i; If j>40 then y[50+i, j]:=14-i; end; *) Repeat k:=k+1; {If k=round(k/20)*20 then y[60,40]:=1; {Осциллятор 1} If k=round(k/30)*30 then y[20,30]:=1; {Осциллятор 2} For i:=2 to N-1 do For j:=2 to M-1 do begin If (y[i, j]>0) and (y[i, j]<=""> 0 then goto met; For ii:=i-1 to i+1 do For jj:=j-1 to j+1 do begin If (y[ii, jj]>0) and (y[ii, jj]<=r) then u[i, j]:=u[i, j]+1; If u[i, j]>=h then yy[i, j]:=1; end; met: end; Delay(1000); cleardevice; (* For i:=21 to 70 do begin yy[i,60]:=0; yy[i,61]:=0; end; rectangle(6*21-10,500-6*60,6*70-10,500-6*61); *) For i:=1 to N do For j:=1 to M do begin y[i, j]:=yy[i, j]; setcolor(12); If (y[i, j]>=1) and (y[i, j]<=r) then begin circle(6*i-10,500-6*j,3); circle(6*i-10,500-6*j,2); circle(6*i-10,500-6*j,1); end; setcolor(8); If (y[i, j]>r) and (y[i, j]<=s) then begin circle(6*i-10,500-6*j,3); circle(6*i-10,500-6*j,2); circle(6*i-10,500-6*j,1); end; end; until KeyPressed; CloseGraph; END.

Рис. 12.5.1. Однорукавная и двурукавная автоволны.

Рис. 12.5.2. Подавление низкочастотного источника высокочастотным. Дифракция автоволн.

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

Рис. 12.6.1. Струя жидкости, наполняющая сосуд.

Рассмотрим струю вязкой жидкости, падающую в сосуд (рис. 12.6). Будем различать три области: 1) собственно струя, то есть область, включающая падающие вниз частицы жидкости; 2) область, включающая часть жидкости, которая растекается в горизонтальном направлении; 3) область, включающая неподвижные частицы жидкости, полностью заполняющие горизонтальные строки матрицы ai, j. Промоделируем это явление с помощью двумерных клеточных автоматов. Разобъем плоскость на клетки с координатами i и j (ось i направим вправо, ось j вверх) и введем двумерный массив ai, j. Будем считать, что если клетка пустая, то ai, j=0, если в клетке имеется жидкость, то ai, j=1. Препятствия, дно и стенки сосуда состоят из клеток, для которых xi, j=-2 (можно было бы присвоить значение -1, но в этом случае произведение двух элементов массива ai, j равно 1, когда эти элементы равны 1 или -1, что неудобно). Если произведение a13,24и a13,25 равно 1, то в обоих клетках находится жидкость. <="" p=""> Рис. 12.6.2. Опускание частиц жидкости. Чтобы промоделировать опускание частиц жидкости под действием силы тяжести (рис. 12.6.2) должны выполняться следующие правила: Если a[i, j]=1 (жидкость), то 1. Если a[i, j-1]=0, то a[i, j-1]:=1, a[i, j]:=0; 2. Если a[i, j]=1 и a[i-1,j-1]=0 и a[i+1,j-1]=0, то a[i, j]:=0 и с вероятностью 0,5 a[i-1,j-1]:=1 или a[i+1,j-1]:=1; 3. Если a[i-1,j-1]=0 и a[i+1,j-1]=1, то a[i-1,j-1]:=1, a[i, j]:=0; 4. Если a[i+1,j-1]=0 и a[i-1,j-1]=1, то a[i+1,j-1]:=1, a[i, j]:=0; Рис. 12.6.4. Растекание струи. Когда вертикальная струя жидкости падает на горизонтальную поверхность, то направление движения частиц жидкости изменяется на 90 градусов. При этом жидкость растекается по поверхности так, что частицы жидкости из средней части струи перемещаются в горизонтальном направлении вправо или влево. Это можно промоделировать следующим образом (рис. 12.6.4): Если a[i, j]=1 и (a[i, j-1]=-2 или a[i, j-2]=-2 или a[i, j-3]=-2 или a[i, j-4]=-2), то с вероятностью 0,1 смещать элемент по горизонтали влево или вправо до первой пустой клетки; Аналогичное правило должно выполняться при наполнении сосуда. Компьютер подсчитывает толщину области 3, частицы которой полностью заполняют горизонтальные строки двумерной матрица ai, j между стенками сосуда. Растекание жидкости в области 2, которая содержит пустые клетки с ai, j=0 моделируется так: случайно выбирается наполненная жидкостью клетка (ai, j=1) и смещается по горизонтали влево или вправо (случайный выбор) до ближайшей пустой клетки, после чего эти клетки меняются местами (рис. 12.6.4). Предложенный алгоритм реализован в программе ПР - 12.6, представленной ниже. Результаты моделирования заполнения жидкостью сосуда с препятствиями представлены на рис. 1.

Uses crt, graph; { ПР - 12.6 } Const n=180; m=120; Var b, s,f, i,ii, i1,j, k,DV, MV: integer; x: real; a: array[1..N,1..M] of integer; Procedure Obmen(ii, jj: integer); begin a[i, j]:=0; a[ii, jj]:=1; end; Procedure Smeshenie; {смещение частиц по горизонтали} label m5, m2, m6; begin begin x:=random(100)/100; If (a[i, j]=1)and(x<0.5) then begin i1:=i-1; m5: If a[i1,j]=-2 then goto m2; If a[i1,j]=0 then begin Obmen(i1,j); goto m2; end else i1:=i1-1; goto m5; end; If (a[i, j]=1)and(x>0.5) then begin i1:=i+1; m6: If a[i1,j]=-2 then goto m2; If a[i1,j]=0 then begin a[i, j]:=0; a[i1,j]:=1; goto m2; end else i1:=i1+1; goto m6; end; end; m2: end; Procedure Raschet1; var i1 :integer; label m1; {расчет струи} begin If (k<250)and(abs(100-i)<8) then a[i, M]:=1; If (a[i, j]=0)or(a[i, j]=-2) then goto m1; If (a[i, j-1]=0) then begin Obmen(i, j-1); goto m1; end; If (a[i, j]=1)and(a[i-1,j-1]=0)and(a[i+1,j-1]=0) then begin x:=Random(100)/100; If x<0.5 then Obmen(i-1,j-1) else Obmen(i+1,j-1); goto m1; end; If (a[i, j-1]<>0)and(a[i-1,j-1]=0)and(a[i+1,j-1]=1) then begin Obmen(i-1,j-1); goto m1; end; If (a[i, j-1]<>0)and(a[i+1,j-1]=0)and(a[i-1,j-1]=1) then begin Obmen(i+1,j-1); goto m1; end; x:=random(100)/100; If (x<0.1)and(j>30)and(a[i, j]=1)and((a[i, j-1]=-2)or(a[i, j-2]=-2) or(a[i, j-3]=-2)or(a[i, j-4]=-2)) then Smeshenie; m1: end; Procedure Raschet2; label m1; {поверхностное натяжение} begin If (a[i, j]*a[i+1,j]*a[i+2,j-1]=1)and(a[i+1,j-1]=0)then begin Obmen(i+1,j-1); goto m1; end; If (a[i, j]*a[i-1,j]*a[i-2,j-1]=1)and(a[i-1,j-1]=0)then begin Obmen(i-1,j-1); goto m1; end; If (a[i, j]*a[i+1,j]*a[i+2,j+1]=1)and(a[i+1,j+1]=0)then begin Obmen(i+1,j+1); goto m1; end; If (a[i, j]*a[i-1,j]*a[i-2,j+1]=1)and(a[i-1,j+1]=0)then begin Obmen(i-1,j+1); goto m1; end; m1: end; Procedure Raschet3; begin b:=2; {жидкость в сосуде} For j:=2 to 40 do begin s:=0; For i:=2 to N-1 do If a[i, j]=1 then s:=s+1; If s>22 then begin b:=j+1; end; end; Randomize; For j:=2 to b+2 do For ii:=1 to 25 do begin i:=round(random(n)); Smeshenie; end; end; BEGIN DV:=Detect; InitGraph(DV, MV,'c:\bp\bgi'); Randomize; Setbkcolor(15); For i:=1 to N do For j:=1 to M do begin If (abs(60-i)<2)and(j<8) then a[i, j]:=-2; If (j<20-0.5*i)or(i=1)or(i=N)or(j=1) then a[i, j]:=-2; If (95-i)*(95-i)+(j-85)*(j-85)<70 then a[i, j]:=-2; If (i>50)and((150-i)*(150-i)+j*j<150) then a[i, j]:=-2; If (abs(j-60)<2)and(abs(110-i)<8) then a[i, j]:=-2; end; Repeat inc(k); For i:=1 to N do For j:=1 to M do begin If a[i, j]=0 then setcolor(15); If a[i, j]=1 then setcolor(8); If a[i, j]=-2 then setcolor(9); rectangle(15+3*i,450-3*j,15+3*i+2,450-3*j+2); end; For j:=1 to M do For i:=1 to N do Raschet1; For j:=1 to M do For i:=N downto 1 do Raschet1; For i:=1 to N do For j:=50 to M do Raschet2; f:=0; For i:=1 to N do If a[i,2]=1 then f:=1; If f=1 then Raschet3; Delay(1); ClearDevice; until KeyPressed or(k>300); Repeat until KeyPressed; CloseGraph; END.

Рис. 12.6.5. Наполнение сосуда жидкостью.

Рис. 12.6.6. Наполнение сосуда жидкостью (увеличено).

Рис. 12.6.7. Наполнение сосуда жидкостью (t=40, 80, 160 и 240).

13. ИНФОРМАЦИЯ И ЕЕ КОДИРОВАНИЕ

Задача 13.1. Задано сообщение из 50 символов на алфавите из 5 букв. Напишите программу, которая вычисляет вероятности каждого символа и по формуле Шеннона определяет среднюю информацию, приходящуюся на 1 символ и общую информацию в сообщении. Убедитесь в том, что: 1) если все символы одинаковы, информативность сообщения минимальна; 2) если символы алфавита встречаются с равными вероятностями, то сообщение несет максимальное количество информации.

В программе ПР - 13.1 из сообщения r="aqws...ea" вырезается первый, второй, третий и последующие символы и определяется, частота (эмпирическая вероятность) каждой буквы алфавита, результат выводится на экран. Для нахождения средней информации приходящейся на 1 символ используется формула Шеннона: Чтобы определить информативность всего сообщения необходимо получившуюся величину умножить на число символов N. Если какая-либо буква ни разу не встречается в тексте, то ее эмпирическая вероятность равна 0 и логарифм неопределен. Чтобы избежать этого вместо ln(pa) в программе вычисляется ln(pa+0.001). С помощью программы можно убедиться в том, что информативность сообщения максимальна тогда, когда все символы используются с равными вероятностями. Если в сообщении повторяется один и тот же символ, то информативность сообщения равна 0.

uses crt; { ПР - 13.1 } var N, i,a, q,w, s,e: integer; r, s1: string; h1,pi, pa, pq, pw, ps, pe, h: real; BEGIN clrscr; r:='aqwseaeswaqeawseqweasesaeseeewawwqwwesassea'; a:=0; q:=0; w:=0; s:=0; e:=0; N:=length(r); For i:=1 to N do begin If r[i]='a' then a:=a+1; If r[i]='q' then q:=q+1; If r[i]='w' then w:=w+1; If r[i]='s' then s:=s+1; If r[i]='e' then e:=e+1; end; Writeln ('буква а встречается ',a,' раз'); Writeln ('буква q встречается ',q,' раз'); Writeln ('буква w встречается ',w,' раз'); Writeln ('буква s встречается ',s,' раз'); Writeln ('буква e встречается ',e,' раз'); pa:=a/N; pq:=q/N; pw:=w/n; ps:=s/n; pe:=e/n; Writeln ('Pa=',pa); Writeln ('Pq=',pq); Writeln ('Pw=',pw); Writeln ('Ps=',ps); Writeln ('Pe=',pe); h1:=-N*(((pa*(ln(pa+0.001)/ln(2)))+(pq*(ln(pq+0.0000001)/ln(2))))); h:=h1-N*((pw*(ln(pw+0.001)/ln(2)))+(ps*(ln(ps+0.001)/ln(2))) +(pe*(ln(pe+0.001)/ln(2)))); writeln('H=',h); readkey; END.

Задача 13.2. Напишите программу, кодирующую двоичным кодом сообщение из 20 букв на алфавите из 8 букв. На каждую букву приходится три двоичных разряда: a - 000, b - 001, c - 010, ... , h - 111. На экран выводится закодированное сообщение, затем осуществляется декодирование.

Используется программа ПР - 13.2. Из заданного сообщения s="abc..defa" она вырезает по одному символу, он кодируется тремя битами и изаписывается в стринговую переменную b. Аналогичным образом осуществляется декодирование.

uses crt; { ПР - 13.2 } var f, s,a, b:string; i, k:integer; x:real; BEGIN clrscr; s:='aaabbcbddeeebbcadeaabbddeeffgh'; writeln(s); b:=''; {======= КОДИРОВАНИЕ ==========} For i:=1 to length(s) do begin a:=s[i]; If a='a' then b:=b+'000'; If a='b' then b:=b+'001'; If a='c' then b:=b+'010'; If a='d' then b:=b+'011'; If a='e' then b:=b+'100'; If a='f' then b:=b+'101'; If a='g' then b:=b+'110'; If a='h' then b:=b+'111'; end; write(b); writeln; {====== ДЕКОДИРОВАНИЕ =========} s:=''; For i:=1 to length(b) do begin f:=copy(b,3*i-2,3); If f='000' then s:=s+'a'; If f='001' then s:=s+'b'; If f='010' then s:=s+'c'; If f='011' then s:=s+'d'; If f='100' then s:=s+'e'; If f='101' then s:=s+'f'; If f='110' then s:=s+'g'; If f='111' then s:=s+'h'; end; write(s); readln; END.

Задача 13.3. Имеется сообщение 01Напишите программу, кодирующую его помехоустойчивым кодом, в котором каждый бит утраивается, затем вносит ошибки с заданной вероятностью p и декодирует сообщение.

Используется программа ПР - 13.3. Из заданного сообщения aa1="01" вырезается по одному символу 0 или 1, он утраивается, то есть получается 000 или 111. Результат выводится на экран. После этого в получившееся закодированное сообщение с заданной вероятностью вносятся ошибки, сообщение выводится на экран. Затем оно декодируется в соответствии с правилом: кодовые последовательности 111, 011, 101, 110 воспринимаются как 1, а кодовые последовательности 000, 100, 010, 001 воспринимаются как 0. Данный код исправляет часть ошибок. Программа вычисляет относительное число ошибок при заданной вероятности p и позволяет изучить k от p и построить график.

uses crt; { ПР - 13.3 } var aa1,aa, y,z, zz, x1,x : string; i : byte; s, k,p : real; BEGIN clrscr; writeln('Исходное сообщение: '); aa1:=''; writeln(aa1); writeln('Задайте вероятность ошибки: '); readln(p); {======== КОДИРОВАНИЕ ===========} For i:=1 to length(aa1) do begin x:=copy(aa1,i,1); If x='0' then y:='000'; If x='1' then y:='111'; z:=z+y; end; writeln('Закодированное сообщение: '); writeln(z); {======== ВНЕСЕНИЕ ОШИБОК ===========} randomize; zz:=''; For i:=1 to length(z) do begin s:=random(1000)/1000; If (s=p then zz:=zz+z[i]; end; writeln('Сообщение с ошибкой: '); writeln(zz); {=== ДЕКОДИРОВАНИЕ, ИСПРАВЛЕНИЕ ОШИБОК ===} aa:=''; i:=1; while i < length(zz) do begin x:=copy(zz, i,3); If x='000' then y:='0'; If x='001' then y:='0'; If x='010' then y:='0'; If x='011' then y:='1'; If x='100' then y:='0'; If x='101' then y:='1'; If x='110' then y:='1'; If x='111' then y:='1'; aa:=aa+y; i:=i+3; end; writeln('Декодированное сообщение: '); writeln(aa); {=== ПОДСЧЕТ ЧИСЛА ОШИБОК ===} For i:=1 to length(aa) do begin x1:=copy(aa1,i,1); x:=copy(aa, i,1); If x1<>x then k:=k+1; end; k:=k/length(aa); writeln('Относительное количество ошибок: ',k); readln; END.

Задача 13.4. Имеется сообщение 01Напишите программу, которая разбивает его на кадры по 7 бит и добавляет восьмой бит четности.

Программа ПР - 13.4 содержит цикл, в котором вырезаются по 7 бит и определяется количество в них единиц. Если число единиц нечетно, то добавляется восьмой бит четности 1, а если четно, -- то 1. Результат выводится на экран, затем в сообщение добавляются ошибки, -- случайным образом инвертируются некоторые биты.

	uses crt; { ПР - 13.4 } var s, s1,a, a1,b, b1,p, f: string; i, i1,j, j1,k, k1,q, q1,n, x,x1: integer; w: real; BEGIN clrscr; n:=49; s1:=''; s:=''; writeln('Исходное сообщение'); writeln(s); k:=round(length(s)/7); writeln('Сообщение с битом четности'); For i:=1 to k do begin a:=copy(s,7*i-6,7); q:=round(length(a)/7); For j:=1 to q do begin x:=0; b:=copy(a, j-1,1); If b='1' then x:=x+1; end; If (x mod 2)=0 then a:=a+'0' else a:=a+'1'; write(a); s1:=s1+a; f:=s1; end; writeln; randomize; For i:=1 to length(f) do begin w:=random(100)/100; If (w<0.1) then If s1[i]='1' then s1[i]:='0' else s1[i]:='1'; end; writeln('Сообщение с ошибкой'); writeln(s1); readln; END.
14. МАШИНА ПОСТА И ТЬЮРИНГА

Задача 14.1. Машина Поста состоит из ленты, разбитой на ячейки, и каретки, которая может считывать содержимое обозреваемой ячейки, стирать метки и ставить метки. Создайте компьютерную модель машины Поста, вычитающей два числа.

Алгоритм вычитания целых чисел для машины Поста приведен ниже. В первых двух строчках указывается положение каретки и состояние ленты, на которой в унарной системе счисления записаны два числа (в данном случае 6 и 4). В результате исполнения программы на ленте останется число 2 в унарной системе счисления. 7 -- координата каретки VVVVVV-VVVV--- лента 1 сместить влево, команда 2 2 если пусто -- команда 1, если метка -- команда 3 3 удалить метку, команда 4 4 сместить вправо, команда 5 5 если пусто -- команда 4, если метка -- команда 6 6 удалить метку, команда 7 7 сместить вправо, команда 8 8 если пусто -- команда 9, если метка -- команда 1 9 остановить МП. Используется программа ПР - 14.1, результат -- на рис. 14.1.

Uses crt, dos; const N=35; t=100; Var z, lenta: string; a, kom : array [1..N] of string; k, kk : array [1..N] of integer; x, p, i, ii : integer; Label m1, m2; Procedure Programma; Begin x:=7; {Программа МП: вычитание двух чисел} lenta:='VVVVVV-VV------ '; kom[1]:='left'; k[1]:=2; kom[2]:='if'; k[2]:=1; kk[2]:=3; kom[3]:='erase'; k[3]:=4; kom[4]:='right'; k[4]:=5; kom[5]:='if'; k[5]:=4; kk[5]:=6; kom[6]:='erase'; k[6]:=7; kom[7]:='right'; k[7]:=8; kom[8]:='if'; k[8]:=9; kk[8]:=1; kom[9]:='stop'; k[9]:=0; end; Procedure Pechat; begin writeln; p:=p+1; For i:=1 to N do write(a[i],' '); writeln('| ',p,' |'); For i:=1 to x-1 do write('--'); write('M'); delay(200*t); Sound(1000); delay(200*t); Nosound; end; BEGIN clrscr; Programma; For i:=1 to N do begin a[i]:=copy(lenta, i,1); end; Pechat; ii:=1; m2: If Keypressed then goto m1; If kom[ii]='stop' then goto m1; If kom[ii]='left' then begin x:=x-1; Pechat; ii:=k[ii]; goto m2; end; If kom[ii]='right' then begin x:=x+1; Pechat; ii:=k[ii]; goto m2; end; If kom[ii]='erase' then begin a[x]:='-'; Pechat; ii:=k[ii]; goto m2; end; If kom[ii]='metka' then begin a[x]:='V'; Pechat; ii:=k[ii]; goto m2; end; If kom[ii]='if' then begin z:=a[x]; If z='-' then ii:=k[ii] else ii:=kk[ii]; goto m2; end; writeln; writeln('ОШИБКА В СТРОКЕ ', ii); m1: writeln; writeln('КОНЕЦ РАБОТЫ'); Repeat until KeyPressed; END.

Вычитание 6 - 2 = 4