Версия для печати темы Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Центр помощи > "Пятнашки" (в общем случае игра «N^2-1».).

Автор: mayaer 27.1.2007, 06:18

-> Задачу желательно решить как можно быстрее на turbo prolog 2.0, лучше в виде dll на visual prolog 5.2. Это обобщение знаменитой игры «15». Имеется поле размером NxN клеток, на котором расположено N^2-1 пронумерованных фишек. Требуется выстроить фишки в определенном порядке. Как понятно полный перебор не идет! Для классических пятнашек у нас просто не хватит памяти. Важный метод сокращения перебора - использование оценочных "эвристических" функций, позволяющих грубо оценить, насколько "хорошим" (или "плохим") является текущее состояние. Пример, шахмты, Го. При наличии "идеальной" оценочной функции необходимость в переборе отпадает - мы просто выбираем из всех соседних вершин оптимальную. Далеее приводятся примерный ход решения на swi-prolog. 1) С использованием "эвристической" функции: Код solve(State, Answer) :-    starting(S),    h(S,Val),    search([d(Val,S,[])], [S], d(_,State,Path)),    reverse(Path,Answer). search([d(Val,State,Path)|_], _, d(Val,State,Path)) :-     solution(State). search([d(_,State,Path)|FR], Seen, Answer) :-     findall(d(_,NewState,[Op|Path]),             (arc(State,Op,NewState), \+ member(NewState, Seen)),             NBs),     checklist(hvalue, NBs),     mark(NBs, Seen, NewSeen),     join(NBs, FR, NewFR),     search(NewFR, NewSeen, Answer). mark([], Seen, Seen). mark([d(_,State,_)|Sts], Seen, NewSeen) :-     mark(Sts,[State|Seen],NewSeen). Встроенный предикат checklist(Pred,List) применяет предикат ко всем элементам списка. Обычное его назначение - проверить, что все элементы удовлетворяют некоторому условию. Но в нашем случае мы не проверяем, а устанавливаем этот факт, присваивая значения оценки с помощью предиката hvalue. Код hvalue(d(Val,State,_)) :- h(State,Val). Предикат join определяет последовательность обработки вершин. Определив его соответствующим образом, получим эвристический поиск в глубину,  Код join(Ns,FR,FR1):- sort(Ns,Ns1), append(Ns1,FR,FR1). или в ширину Код join(Ns,FR,FR1):- sort(Ns,Ns1), merge(Ns1,FR,FR1). Встроенная процедура merge выполняет слияние упорядоченных списков и является составной частью сортировки слиянием. Таким образом, это просто более эффективный способ выполнить Код join(Ns,FR,FR1):- append(Ns,FR,NF), sort(NF,FR1). Эти два метода известны под названиями "восхождение на гору" (hill climbing), и "сначала-лучший" (best-first search). Данное решение достаточно быстрое, но решение получается далекое от оптимального. 2) Алгоритм A*  Чтобы получить наилучшее решение, мы должны не просто выбирать самое многообещающее продолжение, но учитывать и уже пройденный путь. Удобнее это делать, если есть некоторая простая связь между оценочной функцией и длиной пути. Но наша функция как раз имеет такую связь. Она дает оценку длины пути от данного состояния к целевому. Причем эта оценка всегда занижена. А это означает, что мы можем изменить критерий упорядочивания вершин и выбирать ту из них, для которой сумма длины уже пройденного пути и оценки пути, который предстоит пройти, минимальна. Все, что нам осталось сделать - изменить процедуру оценки. Код hvalue(d(Val,State,Path)) :-     h(State,Vs),     length(Path,Vp),     Val is Vs + Vp. Новая версия программы находит действительно оптимальное решение за приемлемое время (за несколько минут). В литературе по искусственному интеллекту этот метод носит имя "Алгоритм A*". Иногда используют "взвешенный A*", когда какой либо составляющей придают больший вес. Код hvalue(d(Val,State,Path)) :-     h(State,Vs),     length(Path,Vp),     weight(Wh,Wp),     Val is Wh*Vs + Wp*Vp. В крайнем случае, когда Wh = 0 мы получим более громоздкую реализацию поиска в ширину. В другом крайнем случае, когда Wp = 0, получаем поиск "сначала лучший". Идея состоит в том, чтобы пожертвовать оптимальностью решения ради скорости. 3) Наличие оценочной функции позволяет организовать более интеллектуальное отсечение при поиске с ограничением на глубину. Мы можем отсекать ветви несколько раньше, как только оценка длины пути вместе с длиной уже пройденного пути превзойдет заданное ограничение. Поскольку эвристическая функция не переоценивает длину предстоящего пути, мы можем быть уверены, что отсекаемые ветви будут заведомо длиннее. Комбинируя эту идею с методом итерационного углубления, получим популярный "алгоритм IDA*" (Iterative Deepening A*). В отличие от DFID, ограничение на глубину при переходе к следующей итерации можно увеличивать большими шагами. Новое ограничение можно смело установить равным минимальной оценке всех отброшенных на предыдущей итерации вершин. Эту оценку мы будем передавать вместо флага.  Вот примерноый ход решение на swi-prolog с использованием Алгоритм IDA* и оценочной "эвристической" функции: Код solve(State, Answer) :-     starting(Start),     h(Start,Val),     search([d(Val,Start,[])],Val,0,[Start],d(_,State,Path)),     reverse(Path,Answer). search([d(Val,State,Path)|_], _, _,  _, d(Val,State,Path)) :-     solution(State). search([d(Val,_,_)|FR], Lim,B, Seen, Answer) :-     Val > Lim,!,     adjust_bound(Val,B,B1),     search(FR, Lim,B1, Seen, Answer). search([d(_,State,Path)|FR], Lim,B, Seen, Answer) :-     findall(d(_,NewState,[Op|Path]),            (arc(State, Op, NewState), \+ member(NewState, Seen)),             NBs),     checklist(hvalue, NBs),     mark(NBs, Seen, NewSeen),     append(NBs, FR, NewFR),!,     search(NewFR, Lim,B, NewSeen, Answer). search([], _, B, _, Answer) :-    B>0,    starting(Start),    h(Start,Val),    search([d(Val,Start,[])],B,0,[Start],Answer). adjust_bound(V,B,B) :- B>0,B =< V,!. adjust_bound(V,B,V). где h, например, "эвристическая" функция - "манхэттенское" расстояние (|XX0|+|YY0|) от каждой фишки до ее законного места: Код h(B, HV) :-  sumdist(9,B, 0, HV). sumdist(0, _, S, S) :- !. sumdist(N, B, A, S) :-     arg(N, B, P),     mdist(N, P, D),     A1 is A + D,     M is N-1,     sumdist(M, B, A1, S). mdist(A, B, D) :-   Ax is (A-1) mod 3, Ay is (A-1) // 3,   Bx is (B-1) mod 3, By is (B-1) // 3,   D is abs(Ax-Bx) +  abs(Ay-By) . ***3) Третье решение самое предпочтительное.*** M Guedda Не забываем выделять код!

Автор: mayaer 30.1.2007, 06:56

Кстати последня эвристическая функция дана для случая n=3. Мда, видно придется решать самому, как обычно, за пару дней. Только вот бы еще их выделить

Автор: mayaer 9.2.2007, 08:18

Я, конечно, все понимаю - все заняты. Но может хоть кто-то знает ссылки, у кого-то есть исходники (можно игры в 8, лучше конечно 15). Просто очень критичная ситуация. Я представляю логику, но нет не времени, не сил разбираться в Prolog, особенно VP (а в других средах и языках написать техническое задание не позволяет, я бы конечно с радостью лучше написал в c++ или на java). Буду всем плагодарен, кто хоть чем-то поделится. Хорошие поступки остаются в истории ) В книге братко есть описание процедур для головоломки "игра в восемь", предназначенные для использования программой поиска с предпочтением (которая приведена ниже) (Вот это бы все это переделать для пятнашек и на VP 5.2 или 6.3 в виде DLL): Код /*  Процедуры, отражающие специфику головоломки "игра в восемь". Текущая ситуация представлена списком положений фишек; первый элемент списка соответствует пустой клетке. Пример:    1  1   2   3   2  8        4 3  7   6   5      1   2   3          Эта позиция представляется так: [2/2, 1/3, 2/3, 3/3, 3/2, 3/1, 2/1, 1/1, 1/2]   "Пусто" можно перемещать в любую соседнюю клетку, т.е. "Пусто" меняется местами со своим соседом. */         после( [Пусто | Спис], [Фшк | Спис1], 1) :-                                     % Стоимости всех дуг равны 1                 перест( Пусто, Фшк, Спис, Спис1).                                     % Переставив Пусто и Фшк, получаем СПИС1         перест( П, Ф, [Ф | С], [П | С] ) :-                 расст( П, Ф, 1).         перест( П, Ф, [Ф1 | С], [Ф1 | С1] ) :-                 перест( П, Ф, С, С1).         расст( X/Y, X1/Y1, Р) :-                         % Манхеттеновское расстояние между клетками                 расст1( X, X1, Рх),                 расст1( Y, Y1, Ру),                 Р is Рх + Py.         расст1( А, В, Р) :-                 Р is А-В,    Р >= 0,  ! ;                 Р is B-A. % Эвристическая оценка  h  равна сумме расстояний фишек % от их "целевых" клеток плюс "степень упорядоченности", % умноженная на 3         h( [ Пусто | Спис], H) :-                 цель( [Пусто1 | Цспис] ),                 сумрасст( Спис, ЦСпис, Р),                 упоряд( Спис, Уп),                 Н is Р + 3*Уп.         сумрасст( [ ], [ ], 0).         сумрасст( [Ф | С], [Ф1 | С1], Р) :-                 расст( Ф, Ф1, Р1),                 сумрасст( С, Cl, P2),                 Р is P1 + Р2.         упоряд( [Первый | С], Уп) :-                 упоряд( [Первый | С], Первый, Уп).         упоряд( [Ф1, Ф2 | С], Первый, Уп) :-                 очки( Ф1, Ф2, Уп1),                 упоряд( [Ф2 | С], Первый, Уп2),                 Уп is Уп1 + Уп2.         упоряд( [Последний], Первый, Уп) :-                 очки( Последний, Первый, Уп).         очки( 2/2, _, 1) :-  !.                         % Фишка в центре - 1 очко         очки( 1/3, 2/3, 0) :-  !.                                 % Правильная последовательность - 0 очков         очки( 2/3, 3/3, 0) :-  !.         очки( 3/3, 3/2, 0) :-  !.         очки( 3/2, 3/1, 0) :-  !.         очки( 3/1, 2/1, 0) :-  !.         очки( 2/1, 1/1, 0) :-  !.         очки( 1/1, 1/2, 0) :-  !.         очки( 1/2, 1/3, 0) :-  !.         очки( _, _, 2).                 % Неправильная последовательность         цель( [2/2, 1/3, 2/3, 3/3, 3/2, 3/1, 2/1, 1/1, 1/2] ). % Стартовые позиции для трех головоломок         старт1( [2/2, 1/3, 3/2, 2/3, 3/3, 3/1, 2/1, 1/1, 1/2] ).                                     % Требуется для решения 4 шага         старт2( [2/1, 1/2, 1/3, 3/3, 3/2, 3/1, 2/2, 1/1, 2/3] ).                                     % 5 шагов         старт3( [2/2, 2/3, 1/3, 3/1, 1/2, 2/1, 3/3, 1/1, 3/2] ).                                     % 18 шагов % Отображение решающего пути в виде списка позиций на доске         показреш( [ ]).         показреш( [ Поз | Спис] :-                 показреш( Спис),                 nl, write( '---'),                 показпоз( Поз). % Отображение позиции на доске         показпоз( [S0, S1, S2, S3, S4, S5, S6, S7, S8] ) :-                 принадлежит Y, [3, 2, 1] ),                       % Порядок Y-координат                 nl, принадлежит X, [1, 2, 3] ),                 % Порядок Х-координат                 принадлежит( Фшк-X/Y,                 [' '-S0, 1-S1, 2-S2, 3-S3, 4-S4, 5-S5, 6-S6, 7-S7, 8-S8]),                 write( Фшк),                 fail.                     %Возврат с переходом к следующей клетке                 показпоз( _ ). Программа поиска с предпочтением: Код % Поиск с предпочтением         эврпоиск( Старт, Решение):-                 макс_f( Fмакс).                     % Fмакс  >  любой  f-оценки                 расширить( [ ], л( Старт, 0/0), Fмакс, _, да, Решение).         расширить( П, л( В, _ ), _, _, да, [В | П] ) :-                 цель( В).         расширить( П, л( В, F/G), Предел, Дер1, ЕстьРеш, Реш) :-             F <= Предел,             ( bagof( B1/C, ( после( В, В1, С), not принадлежит( В1, П)),                             Преемники),   !,                 преемспис( G, Преемники, ДД),                 опт_f( ДД, F1),                 расширить( П, д( В, F1/G, ДД), Предел, Дер1,                                                                     ЕстьРеш, Реш);             ЕстьРеш = никогда).                 % Нет преемников - тупик         расширить( П, д( В, F/G, [Д | ДД]), Предел, Дер1,                                                                   ЕстьРеш, Реш):-                 F <= Предел,                 опт_f( ДД, OF), мин( Предел, OF, Предел1),                 расширить( [В | П], Д, Предел1, Д1, ЕстьРеш1, Реш),                 продолжить( П, д( В, F/G, [Д1, ДД]), Предел, Дер1,                                                             ЕстьРеш1, ЕстьРеш, Реш).         расширить( _, д( _, _, [ ]), _, _, никогда, _ ) :-  !.                                    % Тупиковое дерево - нет решений         расширить( _, Дер, Предел, Дер, нет, _ ) :-                 f( Дер, F), F > Предел.           % Рост остановлен         продолжить( _, _, _, _, да, да, Реш).         продолжить( П, д( В, F/G, [Д1, ДД]), Предел, Дер1,                                                            ЕстьРеш1, ЕстьРеш, Реш):-                 ( ЕстьРеш1 = нет, встав( Д1, ДД, НДД);                   ЕстьРеш1 = никогда, НДД = ДД),                 опт_f( НДД, F1),                 расширить( П, д( В, F1/G, НДД), Предел, Дер1,                                                                                 ЕстьРеш, Реш).         преемспис( _, [ ], [ ]).         преемспис( G0, [В/С | ВВ], ДД) :-                 G is G0 + С,                 h( В, Н),                                   % Эвристика h(B)                 F is G + Н,                 преемспис( G0, ВВ, ДД1),                 встав( л( В, F/G), ДД1, ДД). % Вставление дерева Д в список деревьев ДД с сохранением % упорядоченности по f-оценкам         встав( Д, ДД, [Д | ДД] ) :-                 f( Д, F), опт_f( ДД, F1),                 F =< F1,  !.         встав( Д, [Д1 | ДД], [Д1 | ДД1] ) ) :-                 встав( Д, ДД, ДД1). % Получение f-оценки         f( л( _, F/_ ), F).                                             % f-оценка листа         f( д( _, F/_, _ ) F).                                          % f-оценка дерева         опт_f( [Д | _ ], F) :-                                       % Наилучшая f-оценка для              f( Д, F).                                                     % списка деревьев         опт_f( [ ], Fмакс) :-                                      % Нет деревьев:               мaкс_f( Fмакс).                                      % плохая f-оценка         мин( X, Y, X) :-              Х =< Y,   !.         мин( X, Y, Y). Кто хоть чем-то поделится, буду очень благодарен.

Автор: mayaer 9.2.2007, 08:41

Если у кого что-есть можете скидывать на: mayaerst@mail.ru Добавлено @ 08:46  Взаранее всем спасибо!

Автор: Винитарх 10.2.2007, 12:57

Пятнашки были решены на Проложьем форуме года три назад. Зайдите на progz и поищите.

Автор: mayaer 11.2.2007, 14:59

На да, там что-то есть. Но что-то не очень понятно на чем писалось, да и реализация далека от совершенства  Мда...

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)