Игра Калах, самообучающийся алгоритм ИИ Опции

[Lapp]

Всем привет,
сыграем в Калах?
Эта игра меня давно занимает, причем с определенной точки зрения. Но сначала о том, что это за игра (не все, может, знакомы). Она очень древняя, пришла (как чуть ли не все игры) с Востока. Известна также под названием Ман-Кала, а также иногда пишут два "л": Каллах. Играют двое на специальной доске камнями. Доска имеет два ряда лунок (по шесть), а по бокам две большие лунки (именно они и называются "калах"). Доска ставится между двумя игроками. Ближайший ко мне ряд лунок - мой, другой - противника. Правый калах - мой, левый - противника.

В начале игры во всех лунках (кроме калахов) лежит по шесть камней. Ход заключается в том, что игрок берет все камни из любой своей лунки (не из калаха) и раскладывает их по одному в направлении против часовой стрелки, начиная с ближайшей правой, и тут уже включая свой калах - но не калах противника, который пропускается.

Если при раскладывании последний камень попал в калах, то игрок ходит еще раз. Если последний камень попал в свою пустую лунку, а в противоположной лунке противника есть камни, то этот последний камень перекладывается в калах и все камни из противоположной лунки тоже перекладываются в калах игрока (если противоположная лунка была пуста, ничего не происходит).

Игра заканчивается либо когда в одном из калахов скопилось более половины всех камней (то есть больше 36), и тогда этот игрок выиграл, либо когда в лунках игрока кончились камни, и тогда он проиграл. Вот, кажется, и все правила. На рисунке изображено состояние после моего хода лункой №1. Сейчас снова мой ход.

Игра продавалась у нас, наверняка продается и сейчас. Играть интересно, ситуация на доске меняется иногда молниеносно, предсказать игру на пару ходов очень нелегко. Разумеется, есть и программные реализации (поройтесь в сети). В свое время все сотрудники нашего головного предприятия по производству ЭВМ были страстно увлечены ее электронной версией, проводились соревнования.. Понятно, что предсказание хода в данном случае трудно для человека, но не для машины - сбивает с толку необходимость постоянно вести подсчеты, но граф этой игры ветвится не так сильно, так как всякий раз есть не более шести возможных ходов.

Вот именно эта особенность (малое количество ходов) и привлекла меня. Теперь расскажу о другом..
Когда-то давно я прочитал в книжке моего кумира Мартина Гарднера, как сделать машину для игры крестики-нолики. Ничего удивительного, если не сказать, что это было написано где-то в 60-е годы.. Машину предлагалось делать из.. спичечных коробков! Меня заинтересовал принцип. А принцип состоял в следующем..

По сути, это был метод кнута и пряника. Нужно было записывать все комбинации, возникающие в игре, зарисовывать их каждую на отдельном коробке. При игре 3х3 это возможно . Но не только каждой комбинации соответствовал отдельный коробок, но и каждому возможному в ней ходу тоже. Перед процессом обучения "машины" в каждый коробок нужно было положить по три горошины. Потом нужно было несколько раз сыграть самому (с кем-нить) в эту игру, при каждом ходе фиксируя возникшие комбинации. В конце партии, когда результат (кто выиграл) уже ясен, нужно во все коробки, на которых обозначены ходы выигравшего игрока, должить по горошине. Из всех же тех, которые соответствуют ходам проигравшего игрока - наоборот, вынуть горошину. Я сейчас не ручаюсь за точность повторения алгоритма, но принцип тот.

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

Не правда ли, все просто? Если мое объяснение вам таковым не показалось, найдите книжку Гарднера .

Итак, я решил применить тот же принцип к Калаху. Это было давно, жутко давно - когда я впервые дорвался до персоналки. Тогда я это сделал на Бейсике. И ведь работало! Конечно, полный вариант мне был тогда не по зубам - не хватало ни памяти, ни производительности - но я извернулся. Придумал калах-3. Как вы, может, уже догадались, это вариант игры с тремя лунками, в каждой из которых в начале лежит 3 камня.

Да, не очень интересно.. Именно поэтому я помнил это и ждал момента, когда машины подрастут. Тогда я делал все на машине с памятью 512 КБ (аналог DEC Pro 350, кажется). Нынешние машины имеют памяти примерно на три порядка больше (а моя и вообще в 4000 раз). Так что я решил, что момент настал. И сделал все заново. Теперь на Паскале (с прицелом, чтоб выложить сюда ).

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

Собсно, а что там говорить? Разберетесь.. Это Калах-4 (легко превращающийся в Калах-5,6 и т.д. заменой одной констаныт). Интерфейс крайне уродский, но не хочу доводить его до ума в текстовой версии. Во время игры можно только вводить номер лунки. Между играми можно кое-что еще (хелп по нажатии h). Советую переходить в режим картинки (буква p). Код непричесанный, невычищенный - короче, рабочий, не судите строго. Извиняюсь за отсутствие комментариев. Если будет интерес - снабжу.

Enjoy, как грится! И - жду ваших коментариев.. улучшений.. и т.п.

Да, забыл сказать.. Программа сама по себе страшно тупая - она ходит случайным образом. Чтоб ей поумнеть, нужен файл с накопленными данными. Файл у меня есть (для Калах-4), он весит почти 30 МБ - но вы можете сделать его и сами.

Самый интересный вопрос - оценка памяти, необходимой для обучения Калах-5 и 6. Я пока не соображу, как правильно оценить. Если верно, что каждый новый уровень требует примерно на 2.5-3 порядка большей памяти (как при переходе от 3 к 4), то для Калаха-5 потребуется больше 10 ГБ.. И такого количества операционки у меня пока нету.. Но мне кажется, что множитель не постоянен, он растет, но не спец по этим вопросам..
Итак - ваши соображения, господа?..

Старый вариант программы удален! Новый в посте №16

[Archon]

Знаю эту игру! На нокиа 3310 она была среди стандартных игр (правда под другим кажется именем) На высоких уровнях сложности телефон думал аж секунд ~30, но это его не спасало... переиграть всё равно было просто.
Мартина Гарднера читал... И крестики нолики такие делал... И тоже на Васике . Вот только не думаю, что этот способ подходит для данной игры. Хранить базу данных на 10 гб... это имхо.. слишком. Проще обычный перебор с отсеиванием заведомо проигрышных ветвей на ранней стадии.

[Творец]

Хотелось бы посмотреть на комментарии кода проги что бы получше её понять, ведь что-то может я не так понял, а что-то и во все не понимаю к чему это!?

[Lapp]

посмотреть на комментарии кода проги

Творец, обязательно сделаю. На вскидку - в ближайшие несколько дней найду для этого время. Заглядывай еще.
Спасибо за интерес! Сам бы я еще долго не занялся бы этим..

[Творец]

Творец, обязательно сделаю. На вскидку - в ближайшие несколько дней найду для этого время. Заглядывай еще.
Спасибо за интерес! Сам бы я еще долго не занялся бы этим..

Хорошо Буду заглядывать

[Творец]

Lapp пока хотя бы примерно что к чему поясни пожалуйста

[Lapp]

Lapp пока хотя бы примерно что к чему поясни пожалуйста

Я посмотрел прогу , и решил, что писать комменты займет слишком много времени.. Ты скажи - тебя интересует общий принцип работы? Это я могу рассказать, плюс назначение процедур. Устроит?

[Творец]

Я посмотрел прогу , и решил, что писать комменты займет слишком много времени.. Ты скажи - тебя интересует общий принцип работы? Это я могу рассказать, плюс назначение процедур. Устроит?

да, хватит, надеюсь мои все вопросы это решит

[RathaR]

Популярная это всётаки игрушка Описали и алгоритм для программы
Разложили игру по полочкам

З.Ы. Просто предполагаю: Lapp а не после этой ли статьи появилась идея програмной реализации?

Сообщение отредактировано: RathaR - 11.10.2009 20:42

[Lapp]

Популярная это всётаки игрушка Описали и алгоритм для программы
Разложили игру по полочкам
З.Ы. Просто предполагаю: Lapp а не после этой ли статьи появилась идея програмной реализации?

Да, хорошая заметка)). Нет, я ее не видел (да и подход же совсем другой). В некий момент у нас на работе появились персоналки, Электроника НЦ-80 (копия DEC Pro 350). 8-битный проц, 512К памяти, Бейсик. Встал вопрос, на каком примере ее осваивать, и выбор пал на Калах (по соображениям, о которых я уже говорил не раз). Забавно, что это все происходило как раз примерно в момент выхода статьи. Надо еще сказать, что тогда в эту игру резались все программеры, поскольку существовала ее неплохая реализация (типа для БЭСМ). А еще, она тогда продавалась (не программная, а настольная). И была, кстати, значительно удобнее классического варианта (который описан в этой статье и широко продается сейчас тут, например). Там лунки были каждая отдельно, и не круглые, а камни одинаковые. Первое способствует легкости доставания шариков, а второе с третьим - легкости подсчета. Все это немаловажно, как выясняется в игре.

Такие были времена.. Машина в миллионы (не преувеличиваю) раз слабее, и доступ к ним был сложнее. Но, вот, делали же и такие штуки)).

[cameron]

Lapp, огромное спасибо Вам за написание сей программы!

Я посмотрел прогу , и решил, что писать комменты займет слишком много времени.. Ты скажи - тебя интересует общий принцип работы? Это я могу рассказать, плюс назначение процедур. Устроит?

да, очень интересует общий принцип работы и назначение процедур!
но, если Вас не затруднит написать подробнее, очень прошу!

[Lapp]

очень интересует общий принцип работы и назначение процедур!
но, если Вас не затруднит написать подробнее, очень прошу!

Хорошо, я попробую. Загляни типа завтра-послезавтра.

[Lapp]

Выполняя обещание, я пересмотрел программу, и.. не обрадовался..
Я, помню, что выкладывал довольно сырой код, но все же не думал, что настолько сырой. Функциональность, вроде, без ошибок, но интерфейс жутко неудобный. И совсем непросто разобраться, как накапливать БД.. Короче, я начал с интерфейса и существенно его переделал (хотя оставил текстовым, терминальным). Играть стало поприятнее, но я все-таки еще не закончил. Поэтому код я пока не выкладываю, но надеюсь это сделать довольно скоро, через день-два. Так что, следите за новостями)).

cameron, а можно узнать - тебе это для какой цели? Это курсовая или еще что-то? Просто интересно узнать .

[RathaR]

Lapp, не так давно, я втечении примерно двух недель пытался, исключительно самостоятельно розобраться с этой поистине "адской" БД. Но так и не добился успеха, перешел к другому... однако интерес не угас Так что я тоже буду безумно рад увидеть хоть какое либо пояснение/коментарии, или доработаную версию игры

andriano, я почти ничего не понял, но это действительно хороший пример игры для конкурса, хотя реализация программы для рядового учасника может быть сложноватой... это ж не Крестики-Нолики хотя я и не говорю что игра должна быть очень простой

[cameron]

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

Это Калах-4 (легко превращающийся в Калах-5,6 и т.д. заменой одной констант)

в графическом режиме при Калах-6 одна лунка выезжает на другую..

[Lapp]

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

Вторая часть фразы мне нравится больше, но и первая нормально, если серьезный подход .

в графическом режиме при Калах-6 одна лунка выезжает на другую..

Что ты имеешь в виду под графическим режимом? Этот режим называется у меня в программе "картинка", а графики тут и в помине нет..

Я кое-что сделал, что хотел, но далеко не все. Решил, что хватит тебя (Cameron) мучить, и хоть что-то надо выложить. Я сильно переделал интерфейс - как вывод, так и ввод. При этом больше внимания уделил все же выводу, а ввод остался довольно запутанным, там легко прогу сбить с толку. Картинка получила настраиваемые параметры (см. код). Команды тоже стали немного разумнее, но все же не совсем )).

При запуске выдается "меню". Можно нажимать буковки..

p - play - играть. Если есть база и ход найден в ней - то программа играет "разумно"; нет - случайно.
t - train - тренироваться. Программа играет со случайным процессом, при этом накапливается БД.
r - read - читать БД (если она есть на диске).
w - write - записать накопленную БД. Осторожно: БД затирается без предупреждения.
q - quit - выйти из игры.

В процессе игры теперь не нужно жать энтер - ход делается по сразу по нажатии клавиши. Можно выйти по нажатии Q.

Теперь про обучение.. Для него достаточно в главном меню нажать T. Если хочется посмотреть, как продвигается процесс, нажми N - она будет выводить количество сыгранных партий. Чтобы убрать это - снова N (эта опция не отмесена в меню).

Советую сначала поиграть в рангом 3. Этот случай обучается очень быстро. Запиши накопленную базу и потом считывай.

При ранге 4 обучение тоже довольно быстрое, а игра уже начинает приобретать интерес. Примерный размер базы данных - десятки мегабайт (типа 30-40МБ), что терпимо.

При ранге 5 обучение занимает порядка суток и не заканчивается, поскольку вылетает по памяти (примерно после 3 миллионов сыгранных игр). Размер БД на диске - под 1 ГБ. Полагаю, полный размер потребует нескольких ГБ (может, 4-6), а обучение будет продолжаться не меньше недели.

Ранг 6 я толком не пробовал. Думаю, что размер БД будет где-то сотни ГБ, что вполне разумно. Если вычистить код и ввести многопроцессность, то время накопления такой БД тоже будет, хотя и большим, но еще не безумным (месяцы).

Вообще, обучение можно ускорить, если обучать не случайно, а целенаправленно (игрой с человеком). Но тогда прогу будет возможно сбить с толку глупым ходом.

Уфф... Разберешься? (Показать/Скрыть)

// Game  Kalah
// By Lapp
// Version t04

uses
  CRT,Dos;

const
// --- adjustable parameters (настраиваемые параметры): -------------------------------------
  r=4;          // rank (ранг, количество лунок)
  CeWiSt= 4;    // cell width in stones, ~4 (ширина лунки в камнях)
  CeHiSt= 4;    // cell hight in stones, ~5 (высота лунки в камнях)
  SpStSt= 0;    // space stone-stone, 0..1, (расстояние между камнями)
  SpWaSt= 1;    // space wall-stone,  0..1, (расстояние от стенки до камня)
  SpCeHo= 1;    // space cell-cell, horizontal, 0..1 (расстояние между лунками по горизонтали)
  SpCeVe= 0;    // space cell-cell, vertical, 0..1 (расстояние между лунками по вертикали)
// -------------------------------------------------------------------------------------------

  r1=r+1;
  LBlock=8000; LB2=LBlock div 2; {Block Length. Even!}
  LStore=8000;
  LProtocol=100;
  RateLim=320 div r;
  Col: array[1..2]of byte=(Yellow,White);
  MesCol= LightGreen;

type
  tBoard=array[1..2,1..r]of byte;
  tKalah=array[1..2]of byte;
  tRecord=record
    Brd:tBoard;
    Mv:integer
  end;
  tStore=record
    Len:integer;
    Block:array[1..LBlock]of record
      Brd:tBoard;
      Rate:array[1..r]of integer;
    end
  end;

var
  Board:tBoard;
  Kalah:tKalah;
  n:integer;
  p:integer;
  Mov:integer;
  Score:array[1..2]of integer;
  Protocol:array[1..2]of array[1..LProtocol]of tRecord;
  Rec:array[1..2]of integer;
  Store:array[1..LStore]of ^tStore;
  NStore:integer;   {number of Blocks in Store}
  f:file;
  Rank:string;
  Auto,Stop,Vis,Num,Pic:boolean;
  Gs:LongInt;


function Timer:LongInt;
var
	m,d,h,mi,s,s1:word;
	l:LongInt;
begin
	GetDate(h,m,d,mi);GetTime(h,mi,s,s1);l:=d;
	Timer:=(((l*24+h)*60+mi)*60+s)*100+s1
end;


function HexDig(i:integer):char;
begin
  if i<10 then HexDig:=Chr(i+48)
  else HexDig:=Chr(i+65)
end;


function NewBlock:boolean;
begin
  if NStore<LStore then begin
    Inc(NStore);
    New(Store[NStore]);
    Store[NStore]^.Len:=0;
    NewBlock:=true
  end
  else NewBlock:=false
end;


function Compare(var B1:tBoard; var B2:tBoard):integer;
var
  i,j:integer;
begin
  j:=1;
  repeat
    i:=1;
    repeat
      if B1[j,i]<>B2[j,i] then begin
        if B1[j,i]<B2[j,i] then Compare:=-1 else Compare:=1;
        i:=r; j:=r+1
      end;
      Inc(i)
    until i>r;
    Inc(j)
  until j>2;
  if j=3 then Compare:=0
end;


function SplitBlock(var Blk:integer):boolean;
var
  p:pointer;
  i:integer;
begin
  if NewBlock then begin
    p:=Store[Nstore];
    for i:=NStore-1 downto Blk+1 do Store[i+1]:=Store[i];
    Store[Blk+1]:=p;
    for i:=1 to LB2 do Store[Blk+1]^.Block[i]:=Store[Blk]^.Block[i+LB2];
    Store[Blk]^.Len:=LB2;
    Store[Blk+1]^.Len:=LB2;
    SplitBlock:=true
  end
  else begin
    Dec(Blk);
    SplitBlock:=false
  end
end;


function AddRec(var B:tBoard; var k,l:integer):boolean;
var
  i:integer;
  Go:boolean;
begin
  Go:=(Store[k]^.Len<LBlock)or SplitBlock(k);
  if Go then begin
    if l>Store[k]^.Len+1 then begin
      Inc(k);
      l:=l-LB2
    end;
    with Store[k]^ do begin
      for i:=Len downto l do Block[i+1]:=Block[i];
      Inc(Len);
      with Block[l] do begin
        Brd:=B;
        for i:=1 to r do Rate[i]:=0
      end
    end
  end;
  AddRec:=Go
end;


function FindRec(var B:tBoard; var k,l:integer):boolean;
var
  i,j:integer;
begin
  j:=NStore;
  i:=1;
  repeat
    with Store[j]^ do case Compare(B,Block[i].Brd) of
      -1: if i=1 then Dec(j) else begin
        FindRec:=false;
        break
      end;
      0 : begin
        FindRec:=true;
        break
      end;
      1 : begin
        Inc(i); if i>Len then begin
          FindRec:=false;
          break
        end
      end
    end
  until false;
  k:=j;
  l:=i
end;


procedure Teach;
var
  i,j,k,l,ii:integer;
begin
  for j:=1 to 2 do for i:=1 to Rec[j] do with Protocol[j,i] do begin
    if FindRec(Brd,k,l) or AddRec(Brd,k,l) then with Store[k]^.Block[l] do begin
      if Abs(Rate[Mv])>RateLim then for ii:=1 to r do Rate[ii]:=Rate[ii] div 2;
      Inc(Rate[Mv],Score[j])
    end
    else WriteLn('Memory full')
  end
end;


procedure Mark;
begin
  Inc(Rec[p]);
  with Protocol[p,Rec[p]] do begin
    Brd[1]:=Board[p];
    Brd[2]:=Board[3-p];
    Mv:=Mov
  end
end;


const
  Shift:array[1..2]of string[15]=('','              ');


procedure AIMove(Addition:integer);
var
  i,k,l,m,Min,Sum:integer;
  w:array[1..r]of integer;
  B:tBoard;

  procedure Rand;
  begin
    repeat Mov:=Random®+1 until B[1,Mov]>0;
    if Vis then Write(' (random) ');
  end;

begin
  if Vis then Write(' AI move: ');
  if p=1 then B:=Board else begin
    B[1]:=Board[2];
    B[2]:=Board[1]
  end;
  if FindRec(B,k,l) then with Store[k]^.Block[l] do begin
    Min:=Rate[1];
    for i:=2 to r do if Rate[i]<min then Min:=Rate[i];
    Sum:=0;
    for i:=1 to r do Inc(Sum,Rate[i]-min);
    if Sum=0 then Rand else begin
      for i:=1 to r do if B[1,i]>0 then
        w[i]:=Addition+LongInt(Rate[i]-min)*100 div Sum else w[i]:=0;
      Sum:=0;
      for i:=1 to r do Inc(Sum,w[i]);
      m:=Random(Sum);
      Mov:=0;
      Sum:=0;
      while (m>=Sum)or(B[1,Mov]=0) do begin
        Inc(Mov);
        Inc(Sum,w[Mov])
      end;
      if Vis then begin
        Write(' (');
        for i:=1 to r do Write(Rate[i]:4);
        Write(' ) ')
      end
    end
  end
  else Rand;
  if Vis then WriteLn(Mov)
end;


procedure RandomMove;
begin
  repeat Mov:=Random®+1 until Board[p,Mov]>0;
  if Vis then WriteLn('Random move: ',Mov)
end;


function Move:boolean;
  procedure Drop(s,i:integer);
  begin
    if n>0 then if i<=r then Inc(Board[s,i]) else Inc(Kalah[s]);
    Dec(n)
  end;
var
  i:integer;
begin
  Mark;
  n:=Board[p,Mov];
  Move:=false;
  repeat
    if n>0 then begin
      if Mov>0 then Board[p,Mov]:=0;
      for i:=Mov+1 to r1 do Drop(p,i);
    end;
    if n=0 then Move:=true
    else if n>0 then for i:=1 to r do Drop(3-p,i)
    else if Board[p,r1+n]=1 then if Board[3-p,-n]>0 then begin
      Inc(Kalah[p],Board[3-p,-n]+1);
      Board[p,r1+n]:=0;
      Board[3-p,-n]:=0
    end;
    Mov:=0
  until n<=0
end;


procedure Picture(Brd:tBoard;Klh:tKalah);
const
  KaWiSt= CeWiSt;            {kalah width in stones}
  KaHiSt= 2*CeHiSt+SpCeVe-2;   {kalah hight in stones}
  cw= CeWiSt+SpStSt*(CeWiSt-1)+2*(SpWaSt+1);
  kw= KaWiSt+SpStSt*(KaWiSt-1)+2*(SpWaSt+1);
type
  tBox=record
    x,y,w,h:integer
  end;
  tBoardPic=array[1..2,1..r]of tBox;
  tKalahPic=array[1..2]of tBox;
var
  BPic:tBoardPic;
  KPic:tKalahPic;
  b,i,j,k,l:integer;
  s:string;
  c:char;

  function OutLine:boolean;
  begin
    while s[Length(s)]=' ' do Delete(s,Length(s),1);
    if Length(s)>0 then begin
      WriteLn(s);
      OutLine:=true
    end
    else OutLine:=false
  end;

begin
  TextColor(Col[p]);
  for j:=1 to 2 do begin
    for i:=1 to r do with BPic[j,i] do begin
      if j=1 then x:=kw+2+SpCeHo*2+(i-1)*(cw+SpCeHo) else x:=kw+2+SpCeHo*2+(r-i)*(cw+SpCeHo);
      y:=1+(2-j)*(CeHiSt+2+SpCeVe);
      w:=cw-1;
      h:=CeHiSt+1
    end;
    with KPic[j] do begin
      x:=2+SpCeHo+(2-j)*(r*(cw+SpCeHo)+kw+SpCeHo);
      y:=CeHiSt-KaHiSt div 2+2;
      w:=kw-1;
      h:=KaHiSt+1
    end
  end;
  j:=0;
  repeat
    s:='';
    for i:=1 to 100 do begin
      c:=' ';
      for k:=1 to 2 do begin
        for l:=1 to r do with BPic[k,l] do begin
          b:=Brd[k,l];
          if ((i+1)mod(SpStSt+1)=0)and(y<j)and(j<y+h)and(x+SpWaSt<i)and(i<x+w-SpWaSt) then
            if CeWiSt*CeHiSt>b then Inc(Brd[k,l]) else c:='0';
          if ((i=x)or(i=x+w))and((y<j)and(j<y+h)) then c:='|';
          if ((j=y)or(j=y+h))and((x<i)and(i<x+w)) then c:='-';
          if (b>9)and(j=y)and(i=x+w-1) then c:=Chr(b div 10+48);
          if (j=y)and(i=x+w) then c:=Chr(b mod 10+48);
          if k=1 then begin if (j=y+h+1)and(i=x+w div 2) then c:=Chr(l+48) end
          else if (j=0)and(i=x+w div 2) then c:=Chr(l+48)
        end;
        with KPic[k] do begin
          b:=Klh[k];
          if ((i+1)mod(SpStSt+1)=0)and(y<j)and(j<y+h)and(x+SpWaSt<i)and(i+SpWaSt<x+w) then
            if KaWiSt*KaHiSt-b>0 then Inc(Klh[k]) else c:='0';
          if ((i=x)or(i=x+w))and((y<j)and(j<y+h)) then c:='|';
          if ((j=y)or(j=y+h))and((x<i)and(i<x+w)) then c:='-';
          if (b>9)and(j=y)and(i=x+w-1) then c:=Chr(b div 10+48);
          if (j=y)and(i=x+w) then c:=Chr(b mod 10+48)
        end
      end;
      s:=s+c
    end;
    Inc(j)
  until not OutLine;
  WriteLn;WriteLn;
end;



procedure Show;
var
  i:integer;
begin
  if Vis then if Pic then Picture(Board,Kalah) else begin
    Write('  ');
    for i:=r downto 1 do Write(Board[2,i]:3);
    WriteLn;
    Write(Kalah[2]:2);
    for i:=1 to r do Write('   ');
    WriteLn(' ',Kalah[1]);
    Write('  ');
    for i:=1 to r do Write(Board[1,i]:3);
    WriteLn;
    WriteLn('-----------------------------------')
  end
end;


function Finish:boolean;
var
  i,j:integer;
  s:array[1..2]of integer;
begin
  Finish:=false;
  if Kalah[p]>r*r then begin
    Score[p]:=1; Score[3-p]:=-1;
    Finish:=true
  end
  else begin
    for j:=1 to 2 do begin
      s[j]:=0;
      for i:=1 to r do s[j]:=s[j]+Board[j,i];
      if s[j]=0 then begin
        Score[j]:=-1; Score[3-j]:=1;
        Finish:=true
      end
    end
  end
end;


procedure Game;
var
  i: integer;
  t: LongInt;
  Wait: boolean;
  c: char;
  b: byte;
  Quit: boolean;
begin
  p:=2;
  repeat
    p:=3-p;
    TextColor(Col[p]);
    Wait:=false;
    repeat
      Show;
      Quit:=false;
      TextColor(MesCol);
      if Vis then Write(Shift[p],'Player ',p,', ');
      case p of
      {  1: if Odd(Gs) then RandomMove else AIMove(4);
        2: if Odd(Gs) then AIMove(4) else RandomMove;}
        1: if Auto then RandomMove else repeat
          Write(Shift[p],'move (');
          for i:=1 to r do Write(i,' ');
          Write('(Q)uit): ');
          c:=ReadKey;
          b:=Ord©-48;
          Mov:=0;
          case UpCase© of
            #0 : ;
            'Q': begin
              Quit:=true;
              WriteLn©
            end;
            'R': begin
              Quit:=true;
              WriteLn©
            end;
            #49..Chr(r+48): if b<=r then begin
              if Board[p,b]=0 then WriteLn(c,' - empty cell, try again')
              else begin
                Mov:=b;
                WriteLn©
              end
            end;
            else WriteLn('Not an option. Try again')
          end;
        until Quit or(Mov>0);

        2: begin
          if not Auto and Wait then begin
            t:=Timer;
            repeat until Timer-t>80
          end;
          AIMove(1);
          Wait:=true
        end
      end
    until Quit or not Move or Finish
  until Quit or Finish;
  if not Quit then begin
    Show;
    if Score[3-p]=1 then p:=3-p;
    TextColor(MesCol);
    if Vis then WriteLn('============================================= player ',p,' wins!')
  end;
  Stop:=not Auto
end;


procedure ReadDB;
var
  i:integer;
begin
  for i:=Nstore downto 1 do Dispose(Store[i]);
  Nstore:=0;
  Str(r,Rank);
  Write('Reading file kalah'+Rank+'.dat ...  ');
  Assign(f,'kalah'+Rank+'.dat');
  ReSet(f,1);
  while not EoF(f) do begin
    Inc(Nstore);
    New(Store[Nstore]);
    Store[NStore]^.Len:=0;
    with Store[NStore]^ do repeat
      Inc(Len);
      BlockRead(f,Block[Len],SizeOf(Block[1]))
    until EoF(f) or(Len>LBlock*90 div 100)
  end;
  Close(f);
  WriteLn('Done.')
end;



procedure WriteDB;
var
  i,j:integer;
begin
  Str(r,Rank);
  Write('Writing file kalah'+Rank+'.dat ...  ');
  Assign(f,'kalah'+Rank+'.dat');
  ReWrite(f,1);
  for j:=1 to NStore do with Store[j]^ do for i:=1 to Len do
    BlockWrite(f,Block[i],SizeOf(Block[1]));
  Close(f);
  WriteLn('Done.')
end;

var
  i,j,k,l,m:integer;
  Key:char;
  ll:LongInt;

begin
  WriteLn('Starting Kalah of rank ',r);
  NStore:=0;
  NewBlock;
  with Store[1]^ do begin
    for i:=1 to r do with Block[1] do begin
      Brd[1,i]:=0;Brd[2,i]:=0;Rate[i]:=0
    end;
    Len:=1
  end;
  {ReadDB;     }


  Randomize;
  Gs:=0;
  Stop:=true;
  Vis:=true;
  Num:=false;
  Pic:=true;
  Auto:=false;
  repeat
    if Gs mod 10= 0 then Randomize;
    if Stop or KeyPressed then begin
      WriteLn(' (P)lay  (T)rain  ®ead  (W)rite  (Q)uit');
      repeat
        Key:=ReadKey;
        case UpCase(Key) of
          'T': begin
            Auto:=true;
            Stop:=false;
            Vis:=false;
            Num:=false;
            WriteLn('training, hit (E)nough to stop')
          end;
          'E': begin
            Auto:=false;
            Stop:=true;
            Vis:=true;
            WriteLn(Gs,' games plaied')
          end;
          'A': Auto:=true;
          'M': Auto:=false;
          'P': Stop:=not Stop;
          'N': Num:=not Num;
          'V': Vis:=true;
          'B': Vis:=false;
          'L': Pic:=true;
          'S': Pic:=false;
          'W': WriteDB;
          'R': ReadDB;
          'I':begin
            ll:=0;
            for i:=1 to Nstore do ll:=ll+Store[i]^.Len;
            WriteLn('Games:',Gs,' Blocks:',NStore,' Lines:',ll,' L/B:',ll div NStore,' Auto:',Auto);
            {for j:=1 to NStore do with Store[j]^ do begin
              WriteLn('Block ',j,'  Len=',Len);
              for l:=1 to Len do begin
                Write(l:4,':  ');
                for k:=1 to 2 do begin
                  for i:=1 to r do Write(Block[l].Brd[k,i]:3);
                  Write(' -')
                end;
                Write('   ');
                for i:=1 to r do Write(Block[l].Rate[i]:3);
                WriteLn
              end
            end}
          end;
          'Q': Exit;
        end
     { until (not (Key in['i','w']))or((not Num)and(not Vis));}
      until (Key=' ')or not Stop
    end;
    if Vis then begin
      TextColor(MesCol);
      WriteLn('New Game =================================================');
    end;
    for j:=1 to 2 do begin
      for i:=1 to r do Board[j,i]:=r;
      Rec[j]:=0;
      Kalah[j]:=0
    end;
    Game;
    Inc(Gs);
    if Num then WriteLn(Gs);
    Teach;
  until false;
end.

Любители попридираться могут feel free мордовать меня. Только я вряд ли смогу ответить на большинство вопросов )).

[cameron]

Lapp, спасибо, что ответил скоро!
сейчас буду разбираться в программе! пока, понятно, воопросов нет. Одни только благодарности

[Lapp]

Lapp, спасибо, что ответил скоро!
сейчас буду разбираться в программе! пока, понятно, воопросов нет. Одни только благодарности

Да какие там благодарности, я же так и не сделал пояснений к процедурам.. В принципе, там названия говорящие, но в основном я надеюсь, что ты будешь спрашивать поконкретнее - я отвечу.

Еще про ранг 6 (и частично 5).. То, что я написал выше, требует дополнения.
БД уже достигает таких размеров, что она не может поместиться в оперативную память и, ссответственно, не должна записываться одним файлом. Раз так, нужно для каждого хода считывать соответствующий кусок с диска. И значит, эти куски должны быть достаточно маленькими, чтоб чтение происходило быстро (не больше 1 МБ). Далее, при обучении надо устроить так, чтобы добавление записи в один файл не влекло за собой переписывания остатка БД (то есть формат должен быть достаточно свободным). И все равно обучение замедлится dramatically, в сотни раз, думаю [вставлено позже: и тогда месяцы превратятся в десятки лет. Наверное, это однозначно указывает на необходимость использования БД, а не просто файлов]. Проблема в том, что существено невозможно придумать организацию БД, где более употребительные ходы хранились бы "ближе", а менее - "подальше". Большинство из этих проблем решаются, если использовать реальную БД (типа MySQL), но мне не хотелось бы - можно обойтись и без нее. Короче гря, ЭТА реализация совершенно не годится для ранга 6 (да и для ранга 5 тоже уже не совсем).

Я лелею надежду все переписать совсем, полностью переделав БД. Я еще не вполне определился со средствами.. Сама по себе игра будет иметь web-интерфейс (скорее всего без излишеств на JS). Идея простая: выкладывается необученная прога, обучение проходит а)при игре пользователей; б)случайным фоновым процессом. И вот там выбор будет такой:

1. писать проги для доступа к файлам на Паскале или Си, вызываемые из PHP (либо прямо cgi);
2. писать доступ к файлам непосредственно на PHP;
3. использовать стандартную БД.

Пока не могу выбрать. Приглашаю всех к дискуссии на эту тему. Также, если кто поможет (Cameron?))..

[cameron]

плохо поняла назначение функций HexDig, AddRec, FindRec (что-то добавить, найти... )

[andriano]

Большинство из этих проблем решаются, если использовать реальную БД (типа MySQL), но мне не хотелось бы - можно обойтись и без нее.
...
Пока не могу выбрать. Приглашаю всех к дискуссии на эту тему. Также, если кто поможет (Cameron?))..

Стандартная БД - это ОЧЕНЬ медленно. Впрочем, если для составления базы будут использованы переборные алгоритмы с большой глубиной, то это несущественно. А если живые игроки - тем более.
Кстати, нет ли возможности реализовать базу в виде дерева?