МАЙЕР Р.В.

ТЕОРЕТИЧЕСКИЕ ОСНОВЫ ИНФОРМАТИКИ: ЗАДАЧИ

    Формула Шеннона

  1. Сообщение состоит из 1 символа, алфавит -- 3 буквы с заданными вероятностями. Напишите программу, вычисляющую информацию в сообщении по формуле Шеннона.
  2. Проводится опыт с двумя исходами, вероятности которых p1 и p2. Постройте график зависимости энтропии опыта от вероятности одного из исходов p1. Когда H максимально?
  3. Задано сообщение из 50 символов на алфавите из 5 букв. Напишите программу, которая определяет вероятности каждого символа и по формуле Шеннона определяет среднюю информацию, приходящуюся на 1 символ и общую информацию в сообщении. 
    uses crt;
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:=30;
for i:=1 to length(r) 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:=-30*(((pa*(ln(pa+0.001)/ln(2)))+
                         (pq*(ln(pq+0.0000001)/ln(2)))));
h:=h1-30*((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.
  4. С помощью предыдущей программы убедитесь в том, что информативность сообщения максимальна тогда, когда все символы используются с равными вероятностями. Если в сообщении повторяется один символ, то информативность сообщения равна 0.

    Кодирование и декодирование сообщения

  5. Сгенерируйте случайное сообщение, содержащее букву A -- 30 %, B --- 35 %, С --- 23 % и D --- 12 %.
  6. Напишите программу, кодирующую двоичным кодом сообщение из 20 букв на алфавите из 8 букв. На каждую букву --- по 3 двоичных разряда: 000, 001, 010, ... , 111. 
    uses crt;
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;  randomize;  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.
  7. Создайте программу, декодирующую сообщение, закодированное предыдущим способом.
  8. Имеется сообщение из 30 букв на алфавите из 8 букв. Напишите программу, которая кодирует каждую букву тремя битами, случайно с вероятностью p=0,1 вносит ошибки (инвертирует биты), и декодирует сообщение. Результат каждого действия должен выводиться на экран.
  9. Имеется сообщение 01101 ... 01. Напишите программу, кодирующую его помехоустойчивым кодом, в котором каждый бит утраивается, затем вносит ошибки с заданной вероятностью p и декодирует сообщение. 
    uses Crt;
var aa1,aa,y,z,zz,x1,x : string;
  i : byte;  s,k,p : real;
Begin  clrscr;
  writeln('Исходное сообщение: ');
  aa1:='101010101010101010101010
               101010101010101010101010101010';
  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.
  10. Используя предыдущую программу, исследуйте зависимость относительного числа ошибок k декодирования от вероятности p, с которой инвертируются биты при передаче сообщения по линии связи. Величину k определите, сравнивая исходное и конечное сообщения.
  11. Имеется сообщение 01101 ... 01. Напишите программу, которая разбивает его на кадры по 7 бит и добавляет восьмой бит четности. 
    {Вставляет бит четности, вносит ошибки, и находит ошибку}
uses crt; 
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:='001010010111011000101010101001010110010010';
 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) and (s1[i]='1') then s1[i]:='0';
  if (w<0.1) and (s1[i]='0') then s1[i]:='1'; end;
writeln('Сообщение с ошибкой'); writeln(s1); readln;
end.
  12. Дополните предыдущую программу так, чтобы она вносила бы ошибки в сообщение, получающееся после добавления битов четности, а затем выявляла бы их.
  13. Создайте программу, шифрующующую сообщение из 32 букв русского языка путем их перемешивания и добавления новых символов.
  14. Напишите программу, которая дешифрует зашифрованное в предыдущей задаче сообщение.
  15. Создайте архиватор, который архивирует строку 11110110001 ... 1 по принципу "значение бита --- число повторов": 14011203 ... и затем восстанавливает ее.

    Машина Поста

    Машина Поста состоит из ленты, разбитой на ячейки, и каретки, которая может считывать содержимое обозреваемой ячейки, стирать метки и ставить метки. 

    uses crt, dos; const N=35; zadergka=100;  {Машина Поста}
var aaa,z,lenta: string; komand : array [1..N] of string;
aa,a : array [1..N] of string; 
xxx, yyy : array [1..N] of integer;
error,s,NN,Koordinata,zapis,smeshen,P,x,y,i,ii:integer;
FF, f : text; Label K1, K2, Stop;
Procedure Prog;
begin Koordinata:=3;  {Увеличение числа на 2}
lenta:='VVVVVVV-----------------
                 -----------------------------------';
komand[1]:='right'; xxx[1]:=2; yyy[1]:=0;
komand[2]:='if';    xxx[2]:=3; yyy[2]:=1;
komand[3]:='metka'; xxx[3]:=4; yyy[3]:=0;
komand[4]:='right'; xxx[4]:=5; yyy[4]:=0;
komand[5]:='metka'; xxx[5]:=6; yyy[5]:=0;
komand[6]:='stop';  xxx[6]:=0; yyy[6]:=0;
end;
Procedure Pechat;
begin  P:=P+1; writeln; writeln('НАЧАЛЬНОЕ СОСТОЯНИЕ: ');
  For i:=1 to N do write(aa[i],' '); writeln;
  write('==',P,'=='); For i:=1 to N-2 do write('==');  
  writeln;
  For i:=1 to N do write(a[i],' ');  
  writeln; delay(200*zadergka);
  For i:=1 to Koordinata-1 do write('--');  write('M  ');
  end;
Procedure Smestit(x:integer);
var i: integer;
begin for i:=1 to abs(x) do begin 
    if x>0 then Koordinata:=Koordinata+1;
    if x<0 then Koordinata:=Koordinata-1; clrscr; Pechat;
    sound(500); Delay(200*zadergka); Nosound; end; end;
Procedure Schitat;
Begin clrscr; Pechat; z:=a[Koordinata];
sound(50); Delay(200*zadergka); Nosound; end;
Procedure Postavit_Metku;
begin clrscr;
if a[Koordinata]='V' then begin Pechat;
writeln('ОШИБКА! МЕТКА УЖЕ СТОИТ. КОМАНДА ',ii);
error:=1;  end else begin  a[Koordinata]:='V'; Pechat; end;
sound(30); Delay(200*zadergka); Nosound; end;
Procedure Steret;
Begin clrscr;
if a[Koordinata]='-' then begin Pechat;
writeln('ОШИБКА! МЕТКИ УЖЕ НЕТ. КОМАНДА ',ii);
error:=1; end else begin a[Koordinata]:='-'; Pechat; end;
sound(120); Delay(200*zadergka); Nosound; end;
Procedure Ustanovit(x:integer);
Begin clrscr; Koordinata:=x; Pechat;
sound(150); Delay(200*zadergka); Nosound;
end;
BEGIN clrscr; Prog; For i:=1 to N do aa[i]:='-'; ii:=1;
  for i:=1 to N do begin 
          a[i]:=copy(lenta,i,1); aa[i]:=a[i]; end;
  Pechat; sound(600); Delay(400*zadergka);
  Nosound; writeln; i:=0;
   k2: if Keypressed then goto k1; 
       if komand[ii]='stop' then goto K1;
   if komand[ii]='left' then begin 
           Smestit(-1);ii:=xxx[ii]; goto k2; end;
   if komand[ii]='right' then begin 
           Smestit(1); ii:=xxx[ii]; goto k2; end;
   if komand[ii]='erase' then begin Steret;
   If error=1 then goto k1; ii:=xxx[ii]; goto k2; end;
   if komand[ii]='metka' then begin Postavit_Metku;
   If error=1 then goto k1; ii:=xxx[ii]; goto k2; end;
   if komand[ii]='if' then begin Schitat;
   if z='-' then ii:=xxx[ii] else ii:=yyy[ii]; goto k2; end;
   Writeln('ОШИБКА В СТРОКЕ ', ii);
K1: Writeln; Writeln('КОНЕЦ ИСПОЛНЕНИЯ ПРОГРАММЫ. ');
Repeat until KeyPressed;
END.
    Ниже приведены примеры нескольких задач с решениями. Перед запуском пояснения следует удалить.
  16. Напишите программу для МП, увеличивающую данное число на 2. Содержимое файла progr.txt представлено ниже. 

    3                            -- координата каретки 
VVVVVVV-----------------------------  лента 
1  сместить вправо, команда 2
2  если пусто - команда 3, если метка - команда 1 
3  поставить метку, команда 4
4  сместить вправо, команда 5
5  поставить метку, команда 6
6  остановить МП.
  17. Напишите программу для МП, складывающую два целых числа. 

    5                             -- координата каретки 
VVVV-VVV------------------------------ лента
1 поставить метку, команда 2                                     
2 сместить вправо, команда 3
3 если пусто -- команда 4, если метка -- команда 2 
4 сместить влево, команда 5
5 удалить метку, команда 6
6 остановить МП.
  18. Напишите программу для МП, вычитающую целые числа.

    7                                -- координата каретки             
VVVVVV-VVVV----------------------------   лента
1    сместить влево,  команда 2
2    если пусто  -- команда 1, если метка -- команда 3 
3    удалить метку, команда 4
4    сместить вправо, команда 5
5    если пусто  -- команда 4, если метка -- команда 6 
6    удалить метку,  команда 7                                 
7    сместить вправо,  команда 8                                   
8    если пусто  -- команда 9, если метка -- команда 1 
9    остановить МП.
    Машина Тьюринга

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

    uses crt, graph;  { Увеличение числа на 1 }
type c=array[1..8] of string;
const a: c=('_','1','1','1','1','1','1','_');
const N=25;
var i,k,m,s,fl : integer; x1,x2,x4,x5,x6,q :string;
z: array[1..N] of string;
Label metka;
BEGIN clrscr;
m:=2;   {положение головки}
q:='1'; {состояние МТ}
z[1]:='11=11R';
z[2]:='1_=2_L';
z[3]:='21=2_S';
Repeat fl:=0; s:=s+1;
For i:=1 to N do begin
x1:=copy(z[i],1,1); x2:=copy(z[i],2,1); x4:=copy(z[i],4,1);
x5:=copy(z[i],5,1); x6:=copy(z[i],6,1);
if (fl=0)and(x1=q)and(x2=a[m]) then begin q:=x4; a[m]:=x5;
if x6='R' then m:=m+1; if x6='L' then m:=m-1;
if x6='S' then goto metka;
fl:=1; end; end; metka: k:=k+1;
For i:=1 to 20 do write(a[i],' '); writeln('   ',q,'   k=',k);
delay(500);
For i:=1 to m-1 do write('=='); write('|'); writeln;
until x6='S';
Readkey;
END.
  19. Целое число задано набором единиц: _11111___. Написать программу, увеличивающую это число на 1. Головка находится напротив левой 1.

    q "1" "_"
    1 11R 2_L
    2 2_S

  20. Целое число задано набором единиц _11111___. Написать программу, уменьшающую это число на 2. Головка находится напротив левой 1.

    q "1" "_"
    1 11R 21R
    2 21!

  21. Сложить два целых положительных числа, заданных набором единиц. Начальное состояние ленты машины Тьюринга: _11111_1111__

    q "1" "_"
    1 2_R
    2 21R 31R
    3 31R 4_L
    4 1_S

  22. На ленте --- конечный набор единиц: _11111__. Написать программу, которая ставит звездочки вместо первой и последней единицы.

    q "_" "1" "*"
    1 1_R 21R
    2 2_L 2*R 3*L
    3 3_! 3*L 3_L

  23. На ленте --- конечный набор единиц: _11111__. Написать программу, которая заменяет единицы звездочками. Головка --- левее первой единицы.

    q "_" "1" "*"
    1 1_R 3*R
    2 2_L 2*R 3*L
    3 3_! 2*R 3*L

  24. На ленте --- последовательность _ABBAABAB____. Написать программу, которая группирует символы "A" в правой части строки, а вместо них ставит звездочки. Головка --- напротив левого символа.

    q "_" "A" "B" "*" " | "
    1 1_R 2*R 1BR 1*R 1|!
    2 3|R 2AR 2BR 2*R 3|R
    3 4AL 3AR
    4 1_R 4AL 4BL 4*L 4|L

  25. На ленте --- число в десятичной системе счисления, например, 1429. Написать программу, увеличивающую его на 1.

    q "_" "1" "2" "3" "4" "5" "6" "7" "8" "9"
    1 2_L 11R 12R 13R 14R 15R 16R 17R 18R 19R
    2 2_! 22! 23! 24! 25! 26! 27! 28R 29! 20L

    Нормальный алгоритм Маркова

    Имеется входное слово и система подстановок. Сначала выполняется первая подстановка, слово переписывается. Затем --- снова первая подстановка; если невозможно --- вторая; если вторая не проходит, --- третья. Слово переписывается. Снова первая подстановка, если невозможно --- вторая; если невозможно --- третья. Слово переписывается. Программа, моделирующая нормальный алгоритм Маркова, представлена ниже.

    uses crt, graph;  { Цепи Маркова }
const N=10;
var i,j,k,m,s,flag : integer; x1,x2,x4,x5,x6,q :string;
x,y: array[1..N] of string; slovo, slovo1 : string;
Label m1;
Procedure Podstanovka(j:integer);
Label m;
begin flag:=0; i:=0; Repeat i:=i+1;
if copy(slovo,i,length(x[j]))=x[j] then begin flag:=1;
slovo1:=copy(slovo,1,i-1)+y[j]+
copy(slovo,i+length(x[j]),length(slovo)-i-length(x[j])+1);
slovo:=slovo1; if (x[j]='')and(x[j]='') then flag:=0;
goto m; end;
until i>length(slovo); m:
if flag=1 then writeln(k,'  ',slovo, '   | подстановка ',j);
end;
BEGIN clrscr; slovo:='BAB_BA_AA_BABB_ABA'; writeln(slovo);
{Подстановки}
x[1]:='BA';      y[1]:='AB';
x[2]:='B_';      y[2]:='_B';
x[3]:='_A';      y[3]:='A_';
m1: k:=k+1; delay(5000);
Podstanovka(1); if flag=1 then goto m1;
Podstanovka(2); if flag=1 then goto m1;
Podstanovka(3); if flag=1 then goto m1;
Podstanovka(4); if flag=1 then goto m1;
Podstanovka(5); if flag=1 then goto m1;
Readkey;
END.
  26. Имеется слово 'BAB_BA_AA_BABB_ABA'. Создайте нормальный алгоритм Маркова, который символы 'A' переносит влево, символы 'B' --- вправо, а пробелы оставляет посередине. Промоделируйте на компьютере.

    Ответ: 1) 'BA' => 'AB'; 2) 'B_' => '_B'; 3) '_A' => 'A_'.

  27. Имеется слово 'abcbacbdacdb'. Создайте нормальный алгоритм Маркова, который кодирует это слово. Промоделируйте на компьютере.

    Ответ: 1) 'a' => '00-'; 2) 'b' => '01-'; 3) 'c' => '10-'; 4) 'd' => '11-'; 5) 'e' => '111-'.

    Оцифровка сигнала и его восстановление

  28. Напряжение на входе АЦП изменяется по закону u=A*exp[-bt]. Число уровней напряжения равно 512. Сохраните в массиве u[i] результат оцифровки. Методом покоординатного спуска восстановите значения A и b. Постройте график исходного сигнала, точки после оцифровки, график восстановленного сигнала. Программа -- ниже. 
    uses crt, Graph;
var i: integer; A, b, nev, nevyazka : real;
u:array[1..100]of integer;
begin clrscr;
For i:=1 to 100 do u[i]:=round(512*exp(-0.05*i));
For i:=1 to 100 do write(u[i],' ');
A:=100; b:=0.001;  {начальные значения A и b}
Repeat
nevyazka:=0; {найдем начальную невязку}
for i:=1 to 100 do nevyazka:=nevyazka+abs(u[i]-A*exp(-b*i));
A:=A+0.5;   {приращение A}
nev:=0;      {снова найдем невязку}
for i:=1 to 100 do nev:=nev+abs(u[i]-A*exp(-b*i));
if nev>nevyazka then A:=A-0.5;  {сравним и изменим A}

{---- то же самое для b ---}
nevyazka:=0;
for i:=1 to 100 do nevyazka:=nevyazka+abs(u[i]-A*exp(-b*i));
b:=b+0.00001;
nev:=0;
for i:=1 to 100 do nev:=nev+abs(u[i]-A*exp(-b*i));
if nev>nevyazka then b:=b-0.00001;
{----------------------------}
writeln(A,' ', b,' ',nevyazka); {вывод на экран}
until nevyazka<0.1;
Repeat until KeyPressed;
end. {программа работает 1-2 минуты}
  29. Смоделируйте работу аналого-цифрового преобразователя с n=256 уровнями дисретизации по напряжению, на вход которого поступает гармонический сигнал известной амплитуды и частоты. Результаты оцифровки должны быть сохранены в массиве u(i) или файле.
  30. Восстановите оцифрованный сигнал, построив соответствующие точки на экране и соединив их отрезками. Повторите все это, увеличив число уровней дискретизации n в 2 или 4 раза. В каком случае сигнал восстанавливается точнее?
  31. Напишите программу, которая исходя из результатов оцифровки гармонического сигнала u(i) определяет его амплитуду A и частоту w методом покоординатного спуска. Метод заключается в минимизации невязки Delta u=|u(i)-A*sin(wt)| путем варьирования A и w. Результаты выведите на экран в графическом виде.
  32. Убедитесь в справедливости теоремы Котельникова, для этого оцифруйте входной сигнал при различной частоте отсчетов и восстановите его, соединяя точки отрезками, либо методом покоординатного спуска.

    Модель нейрона. Нейросеть

  33. Создайте однослойную нейросеть с 5 входными нейронами и 3 выходными, которая распознавала бы объекты 11000, 00011, 01110.
  34. Создайте двуслойную нейросеть с 8 входными нейронами, 5 промежуточными и 3 выходными нейронами, которая распознавала бы образы объектов 11110000, 00001111, 00111100. Как распознает нейросеть другие объекты?
  35. Создайте модель двуслойной нейросети, которая способна обучаться. Организуйте обучение нейросети. Осуществите проверку в конце обучения.

    Логические задачи

  36. Археологи А, Б и В нашли монету. Каждый высказал по 2 предположения:

    А: монета греческая, 5 век;

    Б: монета испанская, 3 век;

    В: монета не греческая, 4 век;

    Каждый из археологов прав только в одном из двух предположений. Где и когда была выпущена монета?

    Решение: Обозначим простые высказывания: G - монета греческая, I - монета испанская, P - 5 век, C - четвертый век, T - третий век.

    Высказывания:

    G not(P) + not(G) P = 1,

    I not(T) + not(I) T = 1,

    not(G) not(C) + G C = 1,

    Монета не может быть изготовлена в двух государствах и двух веках:

    GI=0, PC=0, PT=0, CT=0.

    Необходимо написать программу, в которой перебираются все варианты и автоматически находится приемлемый. 

    uses crt;
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.
  37. Напишите программу, которая работает так: компьютер случайно загадывает число от 1 до 256. Вы пытаетесь угадать. Компьютер отвечает "больше" или "меньше".
  38. Компьютер моделирует многократное (100-1000 раз) одновременное наступление двух событий A и B с заданными вероятностями p'A, p'B. При этом подсчитывается эмпирические вероятности этих событий pA, pB, а также вероятность их одновременного наступления. Докажите закон умножения вероятностей: pAB=pA * pB.
  39. Промоделируйте игру Жизнь. Клетка оживает при наличии 3 живых соседей. Если живых соседей 4 и больше, она умирает от перенаселенности. Если живых соседей меньше 2, она умирает от одиночества. 
    uses crt; {ЖИЗНЬ --- 2007}
const     N=26;
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   Begin
    For j:=1 to N do  Begin
    If x[i,j]=1 then Write(' * ');
    If x[i,j]=0 then Write('   ');
    end;    Writeln;   end;
end; {+++++++++++++++++++++++++++++++++++++++++++++++}
procedure Oboznach; {++++++++++++++++++++++++++++++++}
var     i,j:integer;
begin
 For i:=1 to N do Begin
  For j:=1 to N do  x1[i,j]:=x[i,j];  end;
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.
  40. Промоделируйте работу автомата, имеющего 4 внутренних состояния. Нарисуйте диаграмму Мура. 
    uses crt;
var i:integer;x,S,a,b,c,y:string;
q:integer; label 1;
BEGIN clrscr;
S:='abacaaacccbbb';writeln('S=',S);q:=1;
for i:=1 to length(S) do begin
x:=copy(S,i,1);
if (x='a') and (q=1) then begin q:=1; y:='F';goto 1;end;
if (x='c') and (q=1) then begin q:=2; y:='G';goto 1;end;
if (x='b') and (q=1) then begin q:=4; y:='E';goto 1;end;
if (x='b') and (q=2) then begin q:=2; y:='G';goto 1;end;
if (x='a') and (q=2) then begin q:=3; y:='F';goto 1;end;
if (x='c') and (q=2) then begin q:=4; y:='F';goto 1;end;
if (x='a') and (q=3) then begin q:=4; y:='F';goto 1;end;
if (x='c') and (q=3) then begin q:=3; y:='E';goto 1;end;
if (x='b') and (q=3) then begin q:=2; y:='F';goto 1;end;
if (x='a') and (q=4) then begin q:=4; y:='E';goto 1;end;
if (x='b') and (q=4) then begin q:=3; y:='F';goto 1;end;
if (x='c') and (q=4) then begin q:=2; y:='G';goto 1;end;
1: writeln(q,' ',y);
end;readkey;
END.
  41. Программа, переводящая десятичное число в шестнадцатиричную систему счисления. 
     uses crt;
 var a,b,c,d:integer;   label 10;
 BEGIN
  clrscr;  write('введите число в 10 система счисления ');
  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); 10:until a=0;  readkey;
  END.
  42. Промоделируйте работу исполнителя, перемещающегося по горизонтальной поверхности в соответствии с заданной программой. 
    Uses Graph,crt;
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.
  43. Напишите обучающую программу, проверяющую умение решать примеры по арифметике. 
    uses crt;
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.
Перечисленные задачи неоднократно предлагались студентам на занятиях по курсу "Теоретические основы информатики" и успешно ими решались.

ВВЕРХ