Реализация игры "Балда".

@Vadim00311 · Регистрация: 22.10.2016

Author24 — интернет-сервис помощи студентам

Доброго времени суток уважаемые форумчане!
Уже запарился со своей курсовой работой, зашел в тупик.
Программная реализация игры "Балда". Для поиска слов в словаре использовать дерево поиска.
Не могу реализовать ход компьютера!!! Хоть убейте! В рекурсии я пока не силен (1 курс БГУИР)
Помогите пожалуйста с ходом компьютера.
Вот пока что у меня есть

Pascal

Program balda;
Uses crt,graph;
Type
Arr=Array[1..5,1..5] of char;
Adrzv=^Zveno;
Zveno=Record
Kl:integer;
Lev,Prav:Adrzv;
Inf:string[11];
end;
 
Var
gm,gt:integer;
Pole:Arr;
Derevo,p,gg:adrzv;
S,Put: string;
i,j:integer;
proc:real;
b:Boolean;
 
Function poisk(k:integer;Var D,Rez:adrzv):Boolean;
Var
Q,P:adrzv;
B:Boolean;
begin
B:=False;
P:=D;
Q:=Nil;
If D<>Nil then
Repeat
Q:=P;
If P^.Kl=k then B:=True
Else if K<P^.kl then P:=P^.lev
Else P:=P^.Prav;
Until B or (P=Nil);
Poisk:=B;
Rez:=Q;
end;
 
Function PoiskSlova(Var T:string;Var D,Rez:adrzv):Boolean;
Var
Q,P:adrzv;
B:Boolean;
begin
B:=False;
P:=D;
Q:=Nil;
If D<>Nil then
Repeat
Q:=P;
If P^.inf=T then B:=True
Else if T<P^.inf then P:=P^.lev
Else P:=P^.Prav;
Until B or (P=Nil);
PoiskSlova:=B;
Rez:=Q;
If (B=false) then writeln('Такого слова нет!')
Else Writeln('Слово найдено!');
Readkey;
end;
 
Procedure Vkl(K:Integer;Var D:adrzv;Zap:string);
Var
Q,S:adrzv;
begin
If not poisk(K,D,Q) then
Begin
New(s);
S^.Kl:=K;
S^.inf:=ZAP;
S^.lev:=Nil;
S^.Prav:=Nil;
If D=Nil then
D:=S
Else
If K<Q^.Kl Then Q^.Lev:=s
Else
Q^.prav:=s;
End;
End;
 
Procedure igrakomp(Var Mass:Arr;Var D:adrzv);
Var
M:arr;
k,slovo:string;
i,l,t:byte;
h:integer;
v:char;
q:adrzv;
begin
m:=Mass;
repeat
clrscr;
Writeln;
Writeln;
Writeln;
Writeln;
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    | | 1 | 2 | 3 | 4 | 5 |');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |1| ',m[1,1],' | ',m[1,2],' | ',m[1,3],' | ',m[1,4],' | ',m[1,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |2| ',m[2,1],' | ',m[2,2],' | ',m[2,3],' | ',m[2,4],' | ',m[2,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |3| ',m[3,1],' | ',m[3,2],' | ',m[3,3],' | ',m[3,4],' | ',m[3,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |4| ',m[4,1],' | ',m[4,2],' | ',m[4,3],' | ',m[4,4],' | ',m[4,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |5| ',m[5,1],' | ',m[5,2],' | ',m[5,3],' | ',m[5,4],' | ',m[5,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('Сделайте Ваш ход!');
Writeln('Введите координаты и букву');
Readln(k);
Val(k[1],i,h);
Val(k[2],j,h);
m[i,j]:=k[3];
clrscr;
Writeln;
Writeln;
Writeln;
Writeln;
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    | | 1 | 2 | 3 | 4 | 5 |');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |1| ',m[1,1],' | ',m[1,2],' | ',m[1,3],' | ',m[1,4],' | ',m[1,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |2| ',m[2,1],' | ',m[2,2],' | ',m[2,3],' | ',m[2,4],' | ',m[2,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |3| ',m[3,1],' | ',m[3,2],' | ',m[3,3],' | ',m[3,4],' | ',m[3,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |4| ',m[4,1],' | ',m[4,2],' | ',m[4,3],' | ',m[4,4],' | ',m[4,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('                    |5| ',m[5,1],' | ',m[5,2],' | ',m[5,3],' | ',m[5,4],' | ',m[5,5],' | ');
Writeln('                    +-+---+---+---+---+---+');
Writeln('Введите координаты слова');
k:='';
Slovo:='';
Readln(k);
t:=length(k) div 2;
For l:=1 to t do
begin
Val(k[1],i,h);
Val(k[2],j,h);
Slovo:=Slovo+m[i,j];
delete(k,1,2);
end;
Writeln(Slovo);
PoiskSlova(Slovo,Derevo,Q);
 
Writeln('y-выйти');
v:=readkey;
Until v='y';
end;
 
Procedure zagr(Var d:adrzv;P:string);
Var
kolslov,i,j,c:integer;
F: file of string;
begin
Assign(F,P);
Reset(F);
kolslov:=0;
While not Eof(F) do
begin
Read(F,S);
kolslov:=kolslov+1;
end;
Writeln('Кол-во слов в файле-',kolslov);
Writeln('Подождите...Происходит загрузка словаря в бинарное дерево поиска...');
c:=kolslov div 2;
Seek(F,C-1);
j:=0;
For i:=C to kolslov do
begin
Read(F,S);
Vkl(i,derevo,S);
j:=j+1;
Case j of
2161:writeln('10%');
4322:writeln('20%.');
6483:writeln('30%..');
8644:writeln('40%...');
10805:writeln('50%....');
end;
end;
 
Seek(F,0);
For i:=1 to C-1 do
begin
Read(F,S);
Vkl(i,derevo,S);
j:=j+1;
Case j of
12966:writeln('60%.....');
15127:writeln('70%......');
17228:writeln('80%.......');
19449:writeln('90%........');
21610:writeln('100%........');
end;
end;
Writeln('Словарь успешно загружен,можно играть!');
write('Press Enter...');
Close(F);
ReadKey;
end;
 
{Выбор режима работы}
Function Vibor(Der:adrzv;Put:String;Massiv:arr):Boolean;
Var
i:char;
begin
Vibor:=true;
Writeln;
Writeln;
Writeln;
Writeln;
Writeln('                    +-+-------------------------------+');
Writeln('                    |1|   Загрузить словарь из файла  |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |2|     Играть с компьютером      |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |3|  Играть с др.человеком вдвоем |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |4|            Справка            |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |5|     Поиск слова в словаре     |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |6|             Выход             |');
Writeln('                    +-+-------------------------------+');
i:=readkey;
case i of
'1':zagr(Der,Put);
'2':IgraKomp(Massiv,derevo);
{'3':Novii_tarif(adrpred);
'4':Izmena(adrpred);
'5':PoiskSLova(s,derevo,gg);}
'6':vibor:=false;
end;
end;
 
 
begin;
Clrscr;
Derevo:=nil;
Put:='d:\NewStr.txt';
 
 
Pole[3,1]:='б';
Pole[3,2]:='а';
Pole[3,3]:='л';
Pole[3,4]:='д';
Pole[3,5]:='а';
 
repeat
b:=vibor(Derevo,Put,Pole);
read;
clrscr;
Until not b;
clrscr;
write('Press Enter...');
Readln;
end.

Думаю многим это будет интересно,т.к. данная тема популярна в технических ВУЗах в качестве курсовых работ.
Приму любую критику, но пожалуйста, помогите, я уже не знаю что делать.

Добавлено через 18 часов 50 минут
Помогите хоть кто...

@Cold · 03.05.2017, 11:03

может тут что то найдешь...
Слишком медленный алгоритм искусственного интеллекта игры Балда

есть пример на СИ...
Добавлено через 10 минут
Игра Балда (язык С)

@JuriiMW · 03.05.2017, 11:16

Дерево у вас формируется как-то не по фэн шую…

Во-первых, что такое „file of string“? С обычным текстом работает тип „Text“… Приложите словарь, чтоб глянуть ;–)
Во-вторых, вы как-то странно определяете количество слов:

Pascal

kolslov:=0;
While not Eof(F) do
begin
Read(F,S);
kolslov:=kolslov+1;
end;

Пять минут в инете и готово заполнение словаря в „сбалансированное“ дерево:

Pascal

const
  WordMaxLength = 21;
 
type
  WordString = String[WordMaxLength];
  
type
  tTree = ^rTree;
  rTree = record
    Word  : WordString;
    Level : Integer;
    Left, Right : tTree;
  end;
 
procedure Swap(tree1, tree2 : tTree);
var
  tmp : rTree;
begin
  tmp    := tree1^;
  tree1^ := tree2^;
  tree2^ := tmp;
end;
 
procedure Skew(tree : tTree);
var
  Left : tTree;
begin
  Left := tree^.Left;
  if Left <> nil then
    if tree^.Level = Left^.Level then
      begin
        Swap(tree, Left);
        Left^.Left := tree^.Right;
        tree^.Right := Left;
      end;
end;
 
procedure Split(tree : tTree);
var
  Right : tTree;
begin
  Right := tree^.Right;
  if Right <> nil then
    if Right^.Right <> nil then
      if tree^.Level = Right^.Right^.Level then
        begin
          Swap(tree, Right);
          Right^.Right := tree^.Left;
          tree^.Left := Right;
          inc(tree^.Level);
        end;
end;
 
procedure NodeInsert(var tree : tTree; Word : WordString);
begin
  if tree = nil then
    begin
      New(tree);
      tree^.Word  := Word;
      tree^.Level := 1;
      tree^.Left  := nil;
      tree^.Right := nil;
    end
  else
    begin
      if Word < tree^.Word then
        NodeInsert(tree^.Left, Word)
      else if Word > tree^.Word then
        NodeInsert(tree^.Right, Word)
      else
        Exit;
      Skew(tree);
      Split(tree);
    end;
end;
 
function ReadLib(libName : String) : tTree;
var
  tree : tTree;
  t : Text;
  Word : WordString;
begin
  tree := nil;
  
  Assign(t, libName);
  Reset(t);
  while Not EOF(t) do
    begin
      ReadLn(t, Word);
      if Length(Word) > 0 then
        NodeInsert(tree, Word);
    end;
  Close(t);
  
  WriteLn('Сформировано сбалансированное дерево.');
  ReadLib := tree;
end;
 
procedure inTree(tree : tTree; s : WordString; level : Integer; var find : Integer);
begin
  if s = tree^.Word then find := level
  else if (s > tree^.Word) and (tree^.Right <> nil) then inTree(tree^.Right, s, level+1, find)
  else if (s < tree^.Word) and (tree^.Left <> nil) then inTree(tree^.Left, s, level+1, find);
end;
  
function WordInTree(tree : tTree; s : WordString) : Integer;
var
  L : Integer;
begin
  L := 0;
  inTree(tree, s, 0, L);
  WordInTree := L;
end;
 
var
  tree : tTree;
  s : String;
  l : Integer;
begin
  tree := ReadLib('balda.lib');
  
  Write('введите слово: '); ReadLn(s);
  l := WordInTree(tree, s);
  if l > 0 then
    WriteLn('слово в словаре на уровне ', l)
  else
    WriteLn('слова в словаре нет');
end.

Алгоритм из Хабрахабра

Словарь слил с инета на 1090 слов.

P.S. Там же на Хабре заметил Алгоритм быстрого поиска слов в игре балда

@Vadim00311 · 03.05.2017, 23:27 **[ТС]**

Спасибо. Буду что то думать

@Vadim00311 · 19.05.2017, 21:55 **[ТС]**

Pascal

Program Balda;
Uses crt;
Const
{Максимальная длинна слова}
WordMaxLength=7;
Type
Temp=set of byte;{Множества для опред-ния допустимых коорд-т для вставки}
WordString=String[WordMaxLength];{слова разрешенной длинны}
Pole=array[1..5,1..5] of WordString;{Массив поля}
ISP=Array[1..50] of WordString;{Массив для использованных слов}
{Объявление дерева}
Type
tTree=^rTree;
rTree=Record
      Word:WordString;{Информационное поле}
      Level:integer;{Уровень}
      Left,Right:tTree;{левые правые ветви дерева}
end;
 
{Замена местами вершин}
Procedure Swap(tree1,tree2:tTree);{Замена}
Var
tmp:rTree;
begin
tmp:=tree1^;
tree1^:=tree2^;
tree2^:=tmp;
end;
 
{Процедура по устранению левой связи на одном уровне}
Procedure Skew(tree:tTree);{Скос}
var
Left:tTree;
begin
Left:=tree^.left;
If Left<>nil then
If tree^.Level=Left^.level then
begin
Swap(tree,left);
Left^.Left:=tree^.Right;
tree^.Right:=Left;
end;
end;
 
{Процедура по устранению двух правых связей на одном уровне}
Procedure Split(tree:tTree);{Трещина}
Var
Right:tTree;
begin
Right:=tree^.Right;
If Right<>nil then
If Right^.Right<>nil then
If tree^.Level=Right^.Right^.Level then
begin
Swap(tree,Right);
Right^.Right:=tree^.Left;
tree^.Left:=Right;
inc(tree^.Level);
end;
end;
 
{Добавление нового слово в словарь}
procedure NodeInsert(Var tree:tTree;Word:WordString);
begin
if tree=nil then
begin
New(tree);
tree^.Word:=Word;
tree^.Level:=1;
tree^.Left:=nil;
tree^.Right:=nil;
end
else
begin
If Word<tree^.Word then
NodeInsert(tree^.Left,Word)
else if Word > tree^.Word then
NodeInsert(tree^.Right,Word)
else
Exit;
Skew(tree);
Split(tree);
end;
end;
{Загрузка слов из словаря}
Function ReadLib(LibName:String):tTree;
var
tree:tTree;
t:text;
Word:WordString;
begin
tree:=nil;
Assign(t,LibName);
Reset(t);
While not Eof(t) do
begin
Readln(t,Word);
If Length(Word)>0 then
NodeInsert(tree,Word);
end;
Close(t);
Writeln('Сформировано сбалансированное дерево');
ReadLib:=tree;
end;
 
Procedure InTree(tree:tTree;s:WordString;Level:integer;var find:integer);
begin
If s=tree^.Word then find:=level
else if (s>tree^.Word) and (tree^.Right<>nil) then
inTree(tree^.Right,s,level+1,find)
else if (s<tree^.Word) and (tree^.Left<>nil) then
inTree(tree^.Left,s,level+1,find);
end;
 
Function WordIntree(tree:tTree;s:WordString):integer;
var
L:integer;
begin
L:=0;
inTree(tree,s,0,L);
WordinTree:=L;
end;
 
{Игровое поле}
Procedure PlayingField(BallK,BallP:byte;mass:pole);
Var
i:byte;
p:pole;
begin
clrscr;
P:=mass;
For i:=1 to 3 do
writeln;
Writeln('     ОЧКИ КОМПЬЮТЕРА            ИГРА "БАЛДА"           ОЧКИ ПОЛЬЗОВАТЕЛЯ ');
writeln('                           +--+--+--+--+--+--+');
writeln('                           |  |1 |2 |3 |4 |5 |');
writeln('                           +--+--+--+--+--+--+');
writeln('                           |1 |',p[1,1]:1,' |',p[1,2]:1,' |',p[1,3]:1,' |',p[1,4]:1,' |',p[1,5]:1,' |');
writeln('          ' ,ballK:3, '              +--+--+--+--+--+--+                ',ballP:3);
writeln('                           |2 |',p[2,1]:1,' |',p[2,2]:1,' |',p[2,3]:1,' |',p[2,4]:1,' |',p[2,5]:1,' |');
writeln('                           +--+--+--+--+--+--+');
writeln('                           |3 |',p[3,1]:1,' |',p[3,2]:1,' |',p[3,3]:1,' |',p[3,4]:1,' |',p[3,5]:1,' |');
writeln('                           +--+--+--+--+--+--+');
writeln('                           |4 |',p[4,1]:1,' |',p[4,2]:1,' |',p[4,3]:1,' |',p[4,4]:1,' |',p[4,5]:1,' |');
writeln('                           +--+--+--+--+--+--+');
writeln('                           |5 |',p[5,1]:1,' |',p[5,2]:1,' |',p[5,3]:1,' |',p[5,4]:1,' |',p[5,5]:1,' |');
writeln('                           +--+--+--+--+--+--+');
End;
 
{Узнаем какие допустимые координаты для вставки буквы}
Function AcceptCoord(MassP:pole;Coord:String):boolean;
Var
TempCoord:String[2];
Num,k,AC:Temp;
i,j,q,cod:integer;
Begin
AcceptCoord:=True;
k:=[];AC:=[];
Num:=[1..10,16..20,26..30,36..40,46..50,56..70];
For i:=1 to 5 do begin
For j:=1 to 5 do
If MassP[i,j]<>'' then
begin
Num:=Num+[i*10+j];
k:=k+[i*10+j+1];k:=k+[i*10+j-1];k:=k+[i*10+j+10];k:=k+[i*10+j-10];
end;
end;
For j:=1 to 55 do if (j in k) and not(j in Num) then AC:=AC+[j];{AC - граничащие клетки}
j:=length(Coord) div 2;
For i:=1 to j do
begin
TempCoord:='';
TempCoord:=TempCoord+Coord[1]+Coord[2];
Delete(Coord,1,2);
Val(TempCoord,q,cod);
If not(q in AC) then
begin
AcceptCoord:=False;
exit;
end;
end;
end;
 
{Очистка массива с иппользованными словами}
Procedure ClearMassISP(Var MW:ISP);
Var
i:byte;
begin
For i:=1 to 50 do
MW[i]:='';
end;
 
{Очистка массива слов поля}
Procedure ClearMassP(Var MassP:Pole);
Var
i,j:byte;
begin
For i:=1 to 5 do
begin
For j:=1 to 5 do
MassP[i,j]:='';
end;
end;
 
{Использованные слова}
Function IspWord(Var MW:ISP;Word:WordString):Boolean;
Var
i:byte;
begin
For i:=1 to 50 do
if MW[i]=Word then
begin
IspWord:=True;
exit;
end;
For i:=1 to 50 do
If MW[i]='' then
begin
MW[i]:=Word;
IspWord:=False;
exit;
end;
end;
 
{Ход пользователя}
Procedure ProgressUser(Var Mw:ISP;Var MassP:pole;Var BK,BP:byte;Var tree:Ttree);
Var
k,slovo,k1:WordString;
koord,prov1:string[22];
i,j,l,cod,dl,o,p,u,Err,res1,res2,res3:integer;
C,R:char;
B:boolean;
Prov:set of byte;
begin
Repeat
PlayingField(BK,BP,MassP);{Выводится поле игры}
Writeln('Введите вставляемую букву вида(11а-где "11" координаты клетки, "а" буква): ');
Readln(k); {Ввели координаты и букву}
b:=AcceptCoord(Massp,k);{Проверка допустимости введенных координат}
If (b=False) or (k='') then  {Если координаты не соответ. то повтор ввода}
{ДОДЕЛАТЬ}
begin
Writeln('Запрещённый ход, вам необходимо его повторить! Нажмите любую клавишу...');
Readkey;
Continue;
end;
{Если все нормально то преобразовываем введенную строку в коор-ты и букву}
k1:='';
Val(k[1],j,cod);
Val(k[2],l,cod);
c:=k[3];
k1:=k1+k[1]+k[2];{переменная к1 предназначена для проверки введенных координат}
Val(k1,U,cod);
{Переменные о,р нужны для отмены хода (если данные не соответствуют)}
O:=j;
P:=l;
MassP[j,l]:=c;
PlayingField(BK,BP,MassP);    {Вставляем букву в поле}
{Обнуляем координаты и будущее слово}
Koord:='';
Slovo:='';
k1:='';
Writeln('Укажите координаты вашего слова: ');
{Цикл по проверке включения очередной введенной буквы в полученное слово}
Repeat
b:=true;
Prov:=[];
Readln(koord);  {вводим коорд. слова}
Prov1:=koord;
dl:=length(prov1) div 2;
Err:=length(prov1) mod 2;
res3:=0;
For i:=1 to dl do
begin
k1:=k1+prov1[1]+prov1[2];
delete(prov1,1,2);
Val(k1,j,cod);
Prov:=Prov+[j];
k1:='';
 
res1:=j div 10;
res2:=j-res1*10;
Writeln(res1,' ',res2);
If (res3<>0) or (MassP[res1,res2]='') then
If (MassP[res1,res2]<>'') and (j=res3+10) or (j=res3-10) or (j=res3-1) or (j=res3+1) then
Else
begin
b:=False;
Clrscr;
PlayingField(BK,BP,MassP);
Writeln('Вы играете не по правилам. Повторите ввод координат снова...');
continue;
end;
res3:=j;
end;
 
 
{Если ничего не введено, то цикл повторяется сначала}
If (prov=[]) or (Err<>0) then
begin
b:=False;
Clrscr;
PlayingField(BK,BP,MassP);
Writeln('Ошибка ввода. Повторите ввод снова...');
continue;
end;
{Если введенная буква не включена в итоговое слово, то повтор цикла}
If not(U in Prov) then
begin
b:=False;
Clrscr;
PlayingField(BK,BP,MassP);
Writeln('Введенная Вами буква должнa быть включена в слово! Повторите ввод координат!');
end;
Until b=true;
 
dl:=length(koord) div 2;
For i:=1 to dl do
begin
Val(koord[1],j,cod);
Val(koord[2],l,cod);
slovo:=slovo+MassP[j,l];{Определяем слово}
delete(koord,1,2);
end;
l:=WordInTree(tree,slovo);{Передаем слово на проверку по словарю}
b:=IspWord(MW,slovo);
If (l>0) and (b=false)  then{Если l>0 значит слово имеется в словаре}
begin
BP:=BP+length(slovo);
PlayingField(BK,BP,MassP);
Writeln('Слово ','"',slovo,'"',' найдено! Заработано очков - ',length(slovo));
end
else
If (l>0) and (b=true)  then
begin
MassP[o,p]:='';
PlayingField(BK,BP,MassP);
Writeln('Данное слово уже использовалось, повторите Ваш ход!');
end
else
begin
Writeln('Слово ','"',slovo,'"',' в словаре отсутствует, добавить его в словарь? д/н');
R:=Readkey;
If (R='д') and (Length(Slovo)>0) then
begin
NodeInsert(tree,slovo);{Добавление слова в дерево}
BP:=BP+length(slovo);{Баллы пользователя}
PlayingField(BK,BP,MassP);
Writeln('Слово ','"',slovo,'"',' успешно добавлено в словарь!');
Writeln('Заработано очков - ',length(slovo));
end
Else
begin
MassP[o,p]:='';
PlayingField(BK,BP,MassP);
Writeln('Слово не было добавлено в словарь по причине его отсутствия, любо отказа пользователя!');
end;
end;
Writeln('Продолжить играть?? д/н');
R:=readkey;
until R='н';
Writeln('Ход завершен!');
Readkey;
end;
 
Procedure Recur(m:char;i,j:byte;MassP:pole;tree:Ttree);
Var
TempWord:Array[1..100] of WordString;{Массив с найденными словами}
des,edin,l,k:byte;
h:integer;
bukva:char;
Word:WordString;
TempP:array[1..5,1..5] of boolean;
begin
Word:='';
For l:=1 to 5 do
    For k:=1 to 5 do
        If MassP[l,k]='' then TempP[l,k]:=False
        Else TempP[l,k]:=True;
 
des:=i;
edin:=j;
bukva:=m;
Word:=Word+m;
Write(des,' ',edin,' ',bukva);
MassP[des,edin]:=bukva;
TempP[des,edin]:=True;
 
If (Edin+1<=5) then Writeln(TempP[des,edin+1]);
If (Edin+1<=5) and (TempP[des,edin+1]=true) then
begin
TempP[des,edin+1]:=false;
Word:=Word+MassP[des,edin+1];
Write(' ',Word);
Recur(bukva,des,edin+1,MassP,tree);
end;
 
If (Edin-1>=5) then Writeln(TempP[des,edin-1]);
If (Edin-1>=1) and (TempP[des,edin-1]=true) then
begin
TempP[des,edin-1]:=false;
Word:=Word+MassP[des,edin-1];
Write(' ',Word);
Recur(bukva,des,edin+1,MassP,tree);
end;
 
If (Des+1<=5) then Writeln(TempP[des+1,edin]);
If (Des+1<=5) and (TempP[des+1,edin]=true) then
begin
TempP[des+1,edin]:=false;
Word:=Word+MassP[des+1,edin];
Write(' ',Word);
Recur(bukva,des+1,edin,MassP,tree);
end;
 
If (Des-1>=5) then Writeln(TempP[des-1,edin]);
If (Des-1>=1) and (TempP[des-1,edin]=true) then
begin
TempP[des-1,edin]:=false;
Word:=Word+MassP[des-1,edin];
Write(' ',Word);
Recur(bukva,des-1,edin,MassP,tree);
end;
 
 
 
end;
 
{Реализация хода компьютера}
Procedure ComputerProgress(Var MassP:pole;Var BK,BP:byte;Var tree:Ttree);
Var
j:WordString;
b:boolean;
i,f,g:byte;
m:char;
begin
PlayingField(BK,BP,MassP);{Выводим поле игры}
For i:=10 to 55 do
begin
Str(i,j);{Определяемся с допустимыми клеточками для ввода буквы}
b:=AcceptCoord(MassP,j);
If b=True then {Если клетка допустима то рекурсия}
begin
f:=i div 10;{Строка}
g:=i-f*10;{Столбец}
For m:='а' to 'я' do
Recur(m,f,g,MassP,tree);
end;
end;
Readkey;
end;
 
{Процедура по вставке начального слова в поле игры}
Procedure First_Word(Var MassP:pole);
Var
t:text;
Word:WordString;
Arr:Array[1..100] of String[5];
i:byte;
begin
Randomize;
i:=0;
Assign(t,'d:\balda.lib');
Reset(t);
While not Eof(t) do
begin
Readln(t,Word);
If Length(Word)=5 then
begin
i:=i+1;
Arr[i]:=Word;
If i=100 then Break;
end;
end;
i:=Random(100)+1;
Word:=Arr[i];
MassP[3,1]:=Word[1];
MassP[3,2]:=Word[2];
MassP[3,3]:=Word[3];
MassP[3,4]:=Word[4];
MassP[3,5]:=Word[5];
Close(t);
end;
 
{Выбор режима работы}
Function Vibor(Var MW:ISP;Var MassP:pole;Var BK,BP:byte;Var tree:Ttree):Boolean;
Var
i:char;
begin
Clrscr;
BK:=0;
BP:=0;
ClearMassP(MassP);
ClearMassISP(MW);
First_Word(MassP);
Vibor:=true;
Writeln;
Writeln;
Writeln('                    +-+-------------------------------+');
Writeln('                    |1|        Ход пользователя       |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |2|         Ход компьютера        |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |3|  ???????????????????????????  |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |4| ????????????????????????????? |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |5|    ????????????????????????   |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |6|        ???????????????        |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |7|       ??????????????????      |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |0|             Выход             |');
Writeln('                    +-+-------------------------------+');
Write('>');
i:=readkey;
case i of
'1':ProgressUser(MW,MassP,BK,BP,tree);
'2':ComputerProgress(MassP,BK,BP,tree);
{'3':AddList(Q,Ring);
'4':Setup(Q,Ring);
'5':Delete_TP(Q,Ring);
'6':Save(Q,Ring,f);
'7':Load(f,Q,Ring);}
'0':vibor:=false;
end;
end;
 
 
{Начало программы}
VAR
BallK,BallP,i,j:byte;
b:boolean;
MW:ISP;
MassP:pole;
tree:tTree;
s:WordString;
L:integer;
BEGIN
clrscr;
BallK:=0;
BallP:=0;
tree:=ReadLib('d:\balda.lib');
Repeat
b:=vibor(MW,MassP,BallK,BallP,tree);
Until not b;
clrscr;
{Write('Для выхода из программы нажмите Enter...');
Readln;}
END.

Вроде все сделал, но никак не могу реализовать ход компьютера (Procedure ComputerProgress и Procedure Recur). Может кто-нибудь помочь с этим? Нужно реализовать рекурсивный поиск по полю игры.

@Vadim00311 · 28.05.2017, 23:09 **[ТС]**

В общем-то написал весь код)) Доволен как слон.
До идеала еще далеко, но играть можно))
Привожу весь код, может кому понадобиться)

Pascal

Program Balda;
Uses crt;
Const
{Максимальная длинна слова}
WordMaxLength=7;
Type
Temp=set of byte;{Множества для опред-ния допустимых коорд-т для вставки}
WordString=String[WordMaxLength];{слова разрешенной длинны}
SW=Array[1..15] of WordString;{Массив со словами, которые нашел компьютер}
Pole=Array[1..5,1..5] of WordString;{Массив поля}
ISP=Array[1..50] of WordString;{Массив для использованных слов}
Tem=Array[1..5,1..5] of boolean;{Зеркальная матрица}
TW=Array[1..50] of WordString;{Массив для найденных слов}
{Объявление дерева}
Type
tTree=^rTree;
rTree=Record
      Word:WordString;{Информационное поле}
      Level:integer;{Уровень}
      Left,Right:tTree;{левые правые ветви дерева}
end;
 
{Замена местами вершин}
Procedure Swap(tree1,tree2:tTree);{Замена}
Var
tmp:rTree;
begin
tmp:=tree1^;
tree1^:=tree2^;
tree2^:=tmp;
end;
 
{Процедура по устранению левой связи на одном уровне}
Procedure Skew(tree:tTree);{Скос}
var
Left:tTree;
begin
Left:=tree^.left;
If Left<>nil then
If tree^.Level=Left^.level then
begin
Swap(tree,left);
Left^.Left:=tree^.Right;
tree^.Right:=Left;
end;
end;
 
{Процедура по устранению двух правых связей на одном уровне}
Procedure Split(tree:tTree);{Трещина}
Var
Right:tTree;
begin
Right:=tree^.Right;
If Right<>nil then
If Right^.Right<>nil then
If tree^.Level=Right^.Right^.Level then
begin
Swap(tree,Right);
Right^.Right:=tree^.Left;
tree^.Left:=Right;
inc(tree^.Level);
end;
end;
 
{Добавление нового слово в словарь}
procedure NodeInsert(Var tree:tTree;Word:WordString);
begin
if tree=nil then
begin
New(tree);
tree^.Word:=Word;
tree^.Level:=1;
tree^.Left:=nil;
tree^.Right:=nil;
end
else
begin
If Word<tree^.Word then
NodeInsert(tree^.Left,Word)
else if Word > tree^.Word then
NodeInsert(tree^.Right,Word)
else
Exit;
Skew(tree);
Split(tree);
end;
end;
 
{Загрузка слов из словаря}
Function ReadLib(LibName:String):tTree;
var
tree:tTree;
t:text;
Word:WordString;
begin
tree:=nil;
Assign(t,LibName);
Reset(t);
While not Eof(t) do
begin
Readln(t,Word);
If Length(Word)>0 then
NodeInsert(tree,Word);
end;
Close(t);
Writeln('Сформировано сбалансированное дерево');
ReadLib:=tree;
end;
 
Procedure InTree(tree:tTree;s:WordString;Level:integer;var find:integer);
begin
If s=tree^.Word then find:=level
else if (s>tree^.Word) and (tree^.Right<>nil) then
inTree(tree^.Right,s,level+1,find)
else if (s<tree^.Word) and (tree^.Left<>nil) then
inTree(tree^.Left,s,level+1,find);
end;
 
Function WordIntree(tree:tTree;s:WordString):integer;
var
L:integer;
begin
L:=0;
inTree(tree,s,0,L);
WordinTree:=L;
end;
 
{Игровое поле}
Procedure PlayingField(BallK,BallP:byte;WordUser,WordKomp:SW;mass:pole);
Var
i:byte;
p:pole;
begin
clrscr;
P:=mass;
Writeln('     ОЧКИ КОМПЬЮТЕРА        ИГРА "БАЛДА"    ОЧКИ ПОЛЬЗОВАТЕЛЯ ');
writeln('          ' ,ballK:3, '          +--+--+--+--+--+--+',ballP:10);
writeln('     Найденные слова:  |  |1 |2 |3 |4 |5 |  Найденные слова:');
writeln(' ',WordKomp[1]:7,'               +--+--+--+--+--+--+',WordUser[1]:7);
writeln(' ',WordKomp[2]:7,'               |1 |',p[1,1]:1,' |',p[1,2]:1,' |',p[1,3]:1,' |',p[1,4]:1,' |',p[1,5]:1,' |'
,WordUser[2]:7);
writeln(' ',WordKomp[3]:7,'               +--+--+--+--+--+--+',WordUser[3]:7);
writeln(' ',WordKomp[4]:7,'               |2 |',p[2,1]:1,' |',p[2,2]:1,' |',p[2,3]:1,' |',p[2,4]:1,' |',p[2,5]:1,' |',
WordUser[4]:7);
writeln(' ',WordKomp[5]:7,'               +--+--+--+--+--+--+',WordUser[5]:7);
writeln(' ',WordKomp[6]:7,'               |3 |',p[3,1]:1,' |',p[3,2]:1,' |',p[3,3]:1,' |',p[3,4]:1,' |',p[3,5]:1,' |',
WordUser[6]:7);
writeln(' ',WordKomp[7]:7,'               +--+--+--+--+--+--+',WordUser[7]:7);
writeln(' ',WordKomp[8]:7,'               |4 |',p[4,1]:1,' |',p[4,2]:1,' |',p[4,3]:1,' |',p[4,4]:1,' |',p[4,5]:1,' |',
WordUser[8]:7);
writeln(' ',WordKomp[9]:7,'               +--+--+--+--+--+--+',WordUser[9]:7);
writeln(' ',WordKomp[10]:7,'               |5 |',p[5,1]:1,' |',p[5,2]:1,' |',p[5,3]:1,' |',p[5,4]:1,' |',p[5,5]:1,' |',
WordUser[10]:7);
writeln(' ',WordKomp[11]:7,'               +--+--+--+--+--+--+',WordUser[11]:7);
writeln(' ',WordKomp[12]:7,'                   ',WordUser[12]:7);
writeln(' ',WordKomp[13]:7,'                   ',WordUser[13]:7);
writeln(' ',WordKomp[14]:7,'                   ',WordUser[14]:7);
writeln(' ',WordKomp[15]:7,'                   ',WordUser[15]:7);
End;
 
{Узнаем какие допустимые координаты для вставки буквы}
Function AcceptCoord(MassP:pole;Coord:String):boolean;
Var
TempCoord:String[2];
Num,k,AC:Temp;
i,j,q,cod:integer;
Begin
AcceptCoord:=True;
k:=[];AC:=[];
Num:=[1..10,16..20,26..30,36..40,46..50,56..70];
For i:=1 to 5 do begin
For j:=1 to 5 do
If MassP[i,j]<>'' then
begin
Num:=Num+[i*10+j];
k:=k+[i*10+j+1];k:=k+[i*10+j-1];k:=k+[i*10+j+10];k:=k+[i*10+j-10];
end;
end;
For j:=1 to 55 do if (j in k) and not(j in Num) then AC:=AC+[j];{AC - граничащие клетки}
j:=length(Coord) div 2;
For i:=1 to j do
begin
TempCoord:='';
TempCoord:=TempCoord+Coord[1]+Coord[2];
Delete(Coord,1,2);
Val(TempCoord,q,cod);
If not(q in AC) then
begin
AcceptCoord:=False;
exit;
end;
end;
end;
 
{ПРоверка по словарю}
Procedure Proverka(Tree:Ttree);
Var
s:WordString;
l:integer;
begin
Writeln('Vvvedite Slovo  ');
Readln(s);
l:=WordInTree(tree,s);{Передаем слово на проверку по словарю}
If (l>0) then Writeln('Cлово ',s,' имеется в словаре')
Else Writeln('Слова ',s,' нет в словаре');
ReadKey;
end;
 
{Очистка массива с иппользованными словами}
Procedure ClearMassISP(Var MW:ISP);
Var
i:byte;
begin
For i:=1 to 50 do
MW[i]:='';
end;
 
{Очистка массива слов поля}
Procedure ClearMassP(Var MassP:Pole);
Var
i,j:byte;
begin
For i:=1 to 5 do
begin
For j:=1 to 5 do
MassP[i,j]:='';
end;
end;
 
{Использованные слова}
Function IspWord(Var MW:ISP;Word:WordString;Param:byte):Boolean;
Var
i:byte;
BEGIN
If (Param=0) then
begin
For i:=1 to 50 do
if (MW[i]=Word) then
begin
IspWord:=True;
exit;
end
Else IspWord:=False;
end;
If (Param=1) then
begin
For i:=1 to 50 do
If MW[i]='' then
begin
MW[i]:=Word;
exit;
end;
end;
END;
 
{Ход пользователя}
Procedure ProgressUser(Var WordUser,WordKomp:SW;Var MW:ISP;Var MassP:pole;Var BK,BP:byte;Var tree:Ttree);
Var
k,slovo,k1:WordString;
koord,prov1:string[22];
i,j,l,cod,dl,o,p,u,Err,res1,res2,res3,t:integer;
C,R:char;
B,b1:boolean;
Prov:set of byte;
begin
Repeat
PlayingField(BK,BP,WordUser,WordKomp,MassP);{Выводится поле игры}
Writeln('Введите вставляемую букву вида(11а-где "11" координаты клетки, "а" буква): ');
Readln(k); {Ввели координаты и букву}
b:=AcceptCoord(Massp,k);{Проверка допустимости введенных координат}
If (b=False) or (length(k)<3) or not(k[3] in ['а'..'я']) or (length(k)>3) then  {Если координаты не соответ. то повтор ввода}
begin
Writeln('Запрещённый ход,отсутствует необходимое кол-во символов или введен не положенный тип данных.');
Write('Нажмите любую клавишу...Вам необходимо его повторить!');
Readkey;
Continue;
end;
{Если все нормально то преобразовываем введенную строку в коор-ты и букву}
k1:='';
Val(k[1],j,cod);
Val(k[2],l,cod);
c:=k[3];
k1:=k1+k[1]+k[2];{переменная к1 предназначена для проверки введенных координат}
Val(k1,U,cod);
{Переменные о,р нужны для отмены хода (если данные не соответствуют)}
O:=j;
P:=l;
MassP[j,l]:=c;
PlayingField(BK,BP,WordUser,WordKomp,MassP);    {Вставляем букву в поле}
{Обнуляем координаты и будущее слово}
Koord:='';
Slovo:='';
k1:='';
Writeln('Укажите координаты вашего слова: ');
{Цикл по проверке включения очередной введенной буквы в полученное слово}
Repeat
b:=true;
Prov:=[];
Readln(koord);  {вводим коорд. слова}
Prov1:=koord;
dl:=length(prov1) div 2;
Err:=length(prov1) mod 2;
res3:=0;
For i:=1 to dl do
begin
k1:=k1+prov1[1]+prov1[2];
delete(prov1,1,2);
Val(k1,j,cod);
Prov:=Prov+[j];
k1:='';
res1:=j div 10;
res2:=j-res1*10;
If (res3<>0) or (MassP[res1,res2]='') then
If (MassP[res1,res2]<>'') and (j=res3+10) or (j=res3-10) or (j=res3-1) or (j=res3+1) then
Else
begin
b:=False;
Clrscr;
PlayingField(BK,BP,WordUser,WordKomp,MassP);
Writeln('Вы играете не по правилам. Повторите ввод координат снова...');
continue;
end;
res3:=j;
end;
{Если ничего не введено, то цикл повторяется сначала}
If (prov=[]) or (Err<>0) then
begin
b:=False;
Clrscr;
PlayingField(BK,BP,WordUser,WordKomp,MassP);
Writeln('Ошибка ввода. Повторите ввод снова...');
continue;
end;
{Если введенная буква не включена в итоговое слово, то повтор цикла}
If not(U in Prov) then
begin
b:=False;
Clrscr;
PlayingField(BK,BP,WordUser,WordKomp,MassP);
Writeln('Введенная Вами буква должнa быть включена в слово! Повторите ввод координат!');
end;
Until b=true;
dl:=length(koord) div 2;
For i:=1 to dl do
begin
Val(koord[1],j,cod);
Val(koord[2],l,cod);
slovo:=slovo+MassP[j,l];{Определяем слово}
delete(koord,1,2);
end;
l:=WordInTree(tree,slovo);{Передаем слово на проверку по словарю}
b:=IspWord(MW,slovo,0);{Передаем слово на проверку по массиву использованых слов}
If (l>0) and (b=false) then{Если l>0 значит слово имеется
в словаре, b=False слово не использовалось ранее}
begin
BP:=BP+length(slovo);
PlayingField(BK,BP,WordUser,WordKomp,MassP);
Writeln('Слово ','"',slovo,'"',' найдено! Заработано очков - ',length(slovo));
IspWord(MW,slovo,1);{Слово вносится в массив использованных слов}
{Слово вноситься в массив найденных слов пользователя}
t:=0;
Repeat
b1:=False;
inc(t);
If WordUser[t]='' then
begin
WordUser[t]:=slovo;
b1:=True;
end;
Until (b1=true) or (t=15);
end
{Если слово имеестся в словаре, но использовалось ранее}
else
If (l>0) and (b=true)  then
begin
MassP[o,p]:='';
PlayingField(BK,BP,WordUser,WordKomp,MassP);
Writeln('Данное слово уже использовалось, повторите Ваш ход!');
Readln;
end
{Если слово в словаре отсутствует}
else
begin
Writeln('Слово ','"',slovo,'"',' в словаре отсутствует, добавить его в словарь? д/н');
R:=Readkey;
If (R='д') and (Length(Slovo)>0) then
begin
NodeInsert(tree,slovo);{Добавление слова в дерево}
BP:=BP+length(slovo);{Баллы пользователя}
PlayingField(BK,BP,WordUser,WordKomp,MassP);
Writeln('Слово ','"',slovo,'"',' успешно добавлено в словарь!');
Writeln('Заработано очков - ',length(slovo));
t:=0;
{Добавление слова к пользовательским словам}
Repeat
b1:=False;
inc(t);
If WordUser[t]='' then
begin
WordUser[t]:=slovo;
b1:=True;
end;
Until (b1=true) or (t=15);
end;
end;
If(l=0) and (R<>'д') then
begin
MassP[o,p]:='';
PlayingField(BK,BP,WordUser,WordKomp,MassP);
Writeln('Слово не было добавлено в словарь по причине его отсутствия, либо отказа пользователя!');
Writeln('Повторите Ваш ход!');
Readln;
end;
{Writeln('Продолжить играть?? д/н');}
until (l>0) and (b=false);
Writeln('Ход завершен!');
Readkey;
end;
 
{Завершение хода компьютера - вставка буквы, вывод результатов...}
Procedure ComputerWalking(Var WordUser,WordKomp:SW;Var MassP:pole;Var MW:ISP;Var BK,BP:byte;Word:WordString;Koord:String);
Var
j,l,dl,cod,i:integer;
k:String;
b:Boolean;
Begin
ClrScr;
i:=0;
Repeat
b:=False;
inc(i);
If WordKomp[i]='' then
begin
WordKomp[i]:=Word;
b:=True;
end;
Until (b=true) or (i=15);
k:='';
i:=1;
dl:=length(Word);
IspWord(MW,Word,1);{Слово вносится в массив использованных слов}
Val(koord[1],j,cod);
Val(koord[2],l,cod);
MassP[j,l]:=Word[1];
BK:=BK+dl;
PlayingField(BK,BP,WordUser,WordKomp,MassP);{Выводим поле игры}
While (i<=dl) do
begin
Val(koord[1],j,cod);
Val(koord[2],l,cod);
If MassP[j,l]=Word[i] then
begin
k:=k+Koord[1]+koord[2]+'('+Word[i]+')'+' ';
Inc(i);
end;
delete(Koord,1,2);
end;
For i:=1 to dl do
Word[i]:=UpCase(Word[i]);
Writeln('Компьютер нашел слово - "',Word,'" и заработал очков - ',dl);
Writeln('Расположение найденного слова: ',K);
Writeln('Теперь Ваш ход...');
End;
 
{Процедура рекурсивного поиска слова на поле игры}
{MassP - поле игры, TempP - копия массива, tree - дерево
Slovo - очищенное слово, i,j - координаты буквы}
Procedure Recur(Var Max:WordString;Var MW:ISP;des,edin:byte;MassP:pole;
TempP:Tem;tree:Ttree;Slovo:WordString;Var Koord:String;Var KoordWord:String);
Var
b:boolean;
l,i,j:byte;
Word,x,y:WordString;
begin
Word:=Slovo;{Очищенное слово}
TempP[des,edin]:=False;{Копия массива, чтобы не использовалась два раза буква}
Word:=Word+MassP[des,edin];{Формируемое слово}
{Формирование координат найденного слова}
Str(des,x);
Str(edin,y);
Koord:=Koord+x+y;
l:=WordInTree(tree,Word);{Передаем слово на проверку по словарю}
b:=IspWord(MW,Word,0);{Проверка на использованные ранее слова}
If (l>0) and (b=False) then {Если слово есть в словаре и
не использовалось ранее}
begin
If Length(Max)<Length(Word) then {Определяем самое длинное из найденных слов}
begin
Max:=Word;{Самое длинное слово}
KoordWord:=koord;{Координаты самого длинного слова}
end;
end;
{Рекурсивный поиск}
If (Edin+1<=5) and (TempP[des,edin+1]=true) then
Recur(Max,MW,des,edin+1,MassP,TempP,tree,Word,Koord,KoordWord);
 
If (Edin-1>=1) and (TempP[des,edin-1]=true) then
Recur(Max,MW,des,edin-1,MassP,TempP,tree,Word,Koord,KoordWord);
 
If (Des+1<=5) and (TempP[des+1,edin]=true) then
Recur(Max,MW,des+1,edin,MassP,TempP,tree,Word,Koord,KoordWord);
 
If (Des-1>=1) and (TempP[des-1,edin]=true) then
Recur(Max,MW,des-1,edin,MassP,TempP,tree,Word,Koord,KoordWord);
 
end;
 
{Реализация хода компьютера}
Procedure ComputerProgress(Var WordUser,WordKomp:SW;Var MW:ISP;Var MassP:pole;Var BK,BP:byte;Var tree:Ttree);
Var
KoordWord,Koord:String;
{Массив в котором хранятся допустимые для хода клетки}
DopKl:Array[1..25] of byte;
TempP:Tem;
j,Slovo,Max:WordString;
b:boolean;
i,f,g,k,l,n:byte;
m:char;
begin
For i:=1 to 25 do
DopKl[i]:=0;
Max:='';
KoordWord:='';
n:=0;
PlayingField(BK,BP,WordUser,WordKomp,MassP);{Выводим поле игры}
For i:=10 to 55 do
begin
Str(i,j);{Определяемся с допустимыми клеточками для ввода буквы
и заносим их координаты в массив DopKl}
b:=AcceptCoord(MassP,j);
If b=True then
begin
inc(n);
DopKl[n]:=i;
end;
end;
For i:=1 to 25 do {Посылка координат из массива допустимых координат}
If (DopKl[i]<>0) then
begin
f:=DopKl[i] div 10;{Строка DopKl}
g:=DopKl[i]-f*10;{Столбец DopKl}
For m:='а' to 'я' do {Цикл по подстановке букв}
begin
Koord:='';
Slovo:='';{Очистить слово}
MassP[f,g]:=m;{Вставка очередной буквы}
For l:=1 to 5 do {Обновление копии массива False-буквы в клетке нет
True-буква в клетке есть}
    For k:=1 to 5 do
    If MassP[l,k]='' then TempP[l,k]:=False{Если клетка на поле пустая,
    то в копию массива записать False}
    Else TempP[l,k]:=True;{Иначе True}
{Передаем массив со вставленной буквой в процедуру рекурсивного поиска слов}
Recur(Max,MW,f,g,MassP,TempP,tree,Slovo,Koord,KoordWord);
MassP[f,g]:='';{Обнуляем проверяемую клетку}
end;
end;
ComputerWalking(WordUser,WordKomp,MassP,MW,BK,BP,Max,KoordWord);
Readkey;
end;

@Vadim00311 · 28.05.2017, 23:09 **[ТС]**

Продолжение ....

Pascal

{Процедура по вставке начального слова в поле игры}
Procedure First_Word(Var MW:ISP;Var MassP:pole);
Var
t:text;
Word:WordString;
Arr:Array[1..100] of String[5];
i:byte;
begin
Randomize;
i:=0;
Assign(t,'d:\balda.lib');
Reset(t);
While not Eof(t) do
begin
Readln(t,Word);
If Length(Word)=5 then
begin
i:=i+1;
Arr[i]:=Word;
If i=100 then Break;
end;
end;
i:=Random(100)+1;
Word:=Arr[i];
IspWord(MW,Word,1);
MassP[3,1]:=Word[1];
MassP[3,2]:=Word[2];
MassP[3,3]:=Word[3];
MassP[3,4]:=Word[4];
MassP[3,5]:=Word[5];
Close(t);
end;
 
{Процедура запуска игры}
Procedure igra(Var WordUser,WordKomp:SW;Var MW:ISP;Var MassP:pole;
Var BK,BP:byte;Var tree:Ttree);
Var
i,k,y:integer;
j:string;
b:boolean;
begin
y:=0;
repeat
inc(y);
k:=0;
b:=False;
For i:=10 to 55 do
begin
Str(i,j);{Определяемся с допустимыми клеточками для ввода буквы}
b:=AcceptCoord(MassP,j);
If (b=True) then k:=1;
end;
If (k=1) and (y mod 2<>0) then
ProgressUser(WordUser,WordKomp,MW,MassP,BK,BP,tree);
If (k=1) and (y mod 2=0) then
ComputerProgress(WordUser,WordKomp,MW,MassP,BK,BP,tree);
until (k=0);
If BK>BP then
Writeln('Победу одержал компьютер! Счет ',BK,'-',BP);
If BK<BP then
Writeln('Поздравляем! Вы одержали победу над компьютером со счетом ',BK,'-',BP);
If BK=BP then
Writeln('Ничья со счетом ',BK,'-',BP,'Победила дружба!');
Readln;
end;
 
{Справка для пользователя}
Procedure Help;
begin
ClrScr;
Writeln('-----------------------------------------------------------------------------');
Writeln('Играют двое (в данном случае Вы и моя программа).|');
Writeln('В середине поля, состоящего из 25 клеток, выбирается слово из пяти букв.|');
Writeln('Ваш ход первый - Вы должны придумать новое слово, состоящее из|');
Writeln('уже находящихся на поле букв и обязательно одной новой буквы, которую|');
Writeln('вы добавляете.|');
Writeln('Чем длиннее слово вы придумаете, тем больше очков Вы получаете.|');
Writeln('Одна буква - одно очко.|');
Writeln('Потом, с добавлением новой буквы, ходит соперник и так далее по очереди.|');
Writeln('Слова в одной игре повторяться не могут.|');
Writeln('Игра завершается при заполнении последней клетки поля. Выигрывает тот, у кого больше очков.|');
Writeln('Слово может образовываться из букв, находящихся последовательно в любом направлении от клетки к клетке');
Writeln('вверх, вниз,|');
Writeln('влево или вправо, но не по диагонали и без пересечений.|');
Writeln('Чтобы сделать ход нужно ввести координаты (в какую клетку хотите вставить букву и саму букву,|');
Writeln('затем необходимо указать компьютеру координаты всего слова на поле.|');
Writeln('Например вводим 21к, затем координаты всего слова 323121 получилось например слово "рак"|');
Writeln('Для выхода нажмите любую кнопку...');
Writeln('-------------------------------------------------------------------------------');
Readln;
end;
 
{Выбор режима работы}
Function Vibor(Var WordUser,WordKomp:SW;Var MW:ISP;Var MassP:pole;
Var BK,BP:byte;Var tree:Ttree):Boolean;
Var
i:char;j:integer;
begin
Clrscr;
BK:=0;
BP:=0;
ClearMassP(MassP);
ClearMassISP(MW);
First_Word(MW,MassP);
Vibor:=true;
For j:=1 to 5 do
Writeln;
Writeln('                    +-+-------------------------------+');
Writeln('                    |1|             ИГРАТЬ            |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |2|    Проверка слова по словарю  |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |3|            Справка            |');
Writeln('                    +-+-------------------------------+');
Writeln('                    |0|             Выход             |');
Writeln('                    +-+-------------------------------+');
Write('>');
i:=readkey;
case i of
'1':igra(WordUser,WordKomp,MW,MassP,BK,BP,tree);
'2':Proverka(tree);
'3':Help;
'4':ProgressUser(WordUser,WordKomp,MW,MassP,BK,BP,tree);
'5':ComputerProgress(WordUser,WordKomp,MW,MassP,BK,BP,tree);
'0':vibor:=false;
end;
end;
 
{Начало программы}
VAR
{Массив со словами, которые нашел компьютер}
WordKomp:SW;
WordUser:SW;
BallK,BallP,i:byte;
b:boolean;
MW:ISP;
MassP:pole;
tree:tTree;
s:WordString;
L:integer;
BEGIN
clrscr;
For i:=1 to 15 do
begin
WordKomp[i]:='';
WordUser[i]:='';
end;
BallK:=0;
BallP:=0;
tree:=ReadLib('d:\balda.lib');
Repeat
b:=vibor(WordUser,WordKomp,MW,MassP,BallK,BallP,tree);
Until not b;
clrscr;
END.

@Vadik1993 · 08.12.2017, 21:16

Паскаль ругается на эту строку, как исправить?
Assign(t,LibName);

Pascal

Reset(t);

@Vadim00311 · 08.12.2017, 22:42 **[ТС]**

Как он ругается?

@Vadik1993 · 09.12.2017, 00:16

Vadim00311,
Path not found

@JuriiMW · 11.12.2017, 06:56

Vadik1993, ну а есть у вас в каталоге с данной программой файл с именем balda.lib ?
Эта программа, которая у вас ругается, вовсе не игры.
Это программа заполнения сбалансированного дерева для ТС.
Он хотел что-то для быстрого поиска вариантов. — Я ему это и предоставил.

@Vadik1993 · 12.12.2017, 19:13

JuriiMW, да есть.
заменив строку с

Pascal

1	Assign(t,LibName);

на

Pascal

1	Assign(t,'balda.lib');

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

@Vadik1993 · 17.12.2017, 20:23

после нескольких ходов выдает ошибку
на строке

Pascal

1	475 Koord:=Koord+x+y;

произошло переполнение строки при выполнении операции "+"
как можно исправить?

@Cold 87 / 87 / 65 Регистрация: 22.05.2014 Сообщений: 485
	03.05.2017, 11:03	2
	может тут что то найдешь... Слишком медленный алгоритм искусственного интеллекта игры Балда есть пример на СИ... Добавлено через 10 минут Игра Балда (язык С) 0

@Vadim00311 1 / 1 / 0 Регистрация: 22.10.2016 Сообщений: 105
	03.05.2017, 23:27 [ТС]	4
	Спасибо. Буду что то думать 0

@Vadim00311 1 / 1 / 0 Регистрация: 22.10.2016 Сообщений: 105
	08.12.2017, 22:42 [ТС]	9
	Как он ругается? 0

@Vadik1993 59 / 58 / 39 Регистрация: 16.03.2012 Сообщений: 165
	09.12.2017, 00:16	10
	Vadim00311, Path not found 0

@JuriiMW 5079 / 2651 / 2349 Регистрация: 10.12.2014 Сообщений: 10,028
	11.12.2017, 06:56	11
	Vadik1993, ну а есть у вас в каталоге с данной программой файл с именем balda.lib ? Эта программа, которая у вас ругается, вовсе не игры. Это программа заполнения сбалансированного дерева для ТС. Он хотел что-то для быстрого поиска вариантов. — Я ему это и предоставил. 0