Задача "Автомобильный гараж"

      Комментарии к записи Задача "Автомобильный гараж" отключены

В этой теме 7 ответов, 2 участника, последнее обновление  StrKllr 11 мес. назад.

  • Автор
    Сообщения
  • #2630

    StrKllr
    Участник

    Автомобильный гараж

    На нашем чертеже изображен план автомобильного гаража с помещениями для двенадцати автомобилей. Но помещение так неудобно, так мало, что у заведующего гаражом постоянно возникают затруднения. Вот одно из них. Предположим, что восемь автомобилей стоят так, как показано на рис. 3. Автомобили 1,2, 3 и 4 необходимо поменять местами с автомобилями 5, 6, 7 и 8.

    автомобильный_гараж_логическая_задача

    Как это сделать за наименьшее число переездов?

    Надо заметить, что два автомобиля двигаться одновременно не могут и что в каждом отсеке гаража помещается только один автомобиль.

    Решение необходимо предоставить на SWI-Prolog 7.2.3.

    Я пытался решить задачу, основываясь на Вашем решении задачи о ревнивых мужьях.

    /*nodes (боксы гаража)*/ 
    node(0). node(1). node(2). node(3). node(4). 
    node(5). node(6). node(7). node(8). node(9). 
    node(10). node(11). 
    /* edges (проезды между боксами) */ 
    edge(0,1). edge(1,0). edge(1,2). edge(2,1). edge(1,4). 
    edge(4,1). edge(2,3). edge(3,2). edge(4,5). edge(5,4). 
    edge(5,6). edge(6,5). edge(5,7). edge(7,5). edge(7,9). 
    edge(9,7). edge(8,9). edge(9,8). edge(9,10). edge(10,9). 
    edge(10,11). edge(11,10). 
    
    /* поиск в глубину (проверяет, есть ли путь между вершинами) */ 
    
    dfs(A, B, _, [(A, B)], State):- 
      edge(A, B),nth0(B,State,Spot), 
      Spot == 0,!. 
    dfs(A, B, VN, [(A, X)|TR], State):- 
      edge(A, X),nth0(X,State,Spot),
      Spot == 0, not(member(X, VN)), 
      dfs(X, B, [A|VN], TR, State). 
    
    swapCar(As,I,J,Cs):- 
      same_length(As,Cs), 
      append(BeforeI,[AtI|PastI],As), 
      append(BeforeI,[AtJ|PastI],Bs), 
      append(BeforeJ,[AtJ|PastJ],Bs), 
      append(BeforeJ,[AtI|PastJ],Cs), 
      length(BeforeI,I), length(BeforeJ,J). 
    
    checkPath(State,From,To):-
      dfs(From,To,[],Path,State), length(Path,Size),Size>0. 
    
    generateMoves(X,Y):- 
      node(X), node(Y), X \== Y. 
    
    checkStartIsCar(State,Position):- 
      nth0(Position,State,Car),Car \== 0. 
    checkEndIsEmpty(State,Position):- 
      nth0(Position,State,Spot), Spot == 0. 
    
    moveCar(PreviousState,NewState):-  
      generateMoves(From,To),
      checkStartIsCar(PreviousState,From),   
      checkEndIsEmpty(PreviousState,To),
      checkPath(PreviousState,From,To), 
      swapCar(PreviousState,From,To,NewState). 
    
    /* В идеале - здесь должна быть проверка, когда нам стоит закончить рекурсию поиска в глубину (почему-то не работает) должно закончить, когда текущее состояние = конечному. */ 
    solve([Head|Tail],[Head|Tail],_,_):-!. 
    solve(A,End, VN, [A|TR]):- 
      moveCar(A, X), 
      not(member(X, VN)), 
      solve(X,End, [A|VN], TR).

    Работать оно по задумке должно так:
    Вводится начальное и конечное состояние гаража в предикат solve, который на ходу должен строить дерево состояний и обходить его. Новое состояние генерируется предикатом moveCar. Генерируются все перестановки от 0 до 11 длиной 2 — это откуда и куда мы двигаем машину, выполняется проверка возможности такого перехода из текущего состояния.

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

    Не могли бы Вы помочь?

  • #2640

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

    Я вижу, что у вас описан граф, но не понял где у вас описаны машины (текущее состояние). Я бы описал начальное состояние в виде списка, который передается функции solve на каждом шаге. Начальный граф такой:
    Graph = [node(a, 5), node(b, 6), node(c, 7), node(d, 8), node(i, 1), node(j, 2), node(k, 3), node(l, 4)].
    При таком подходе я думаю у вас бы не было проблем с выходом из рекурсии, т.к. условие окончания выглядело бы так примерно так:
    solve([node(a, 1), node(b, 2), node(c, 3), node(d, 4), node(i, 5), node(j, 6), node(k, 7), node(l, 8)]):-!.

    А кроме этого, у вас вроде бы верных поход — нужно запустить поиск в ширину — на каждом шаге брать из очереди первое состояние, генерировать из него новые состояния и добавлять их в конец очереди.

  • #2641

    StrKllr
    Участник

    В качестве состояния (текущего и финального я использую просто массив [1,2,3,4,0,0,0,0,5,6,7,8], где индекс элемента — это бокс (0-А, 11-L), а цифра, стоящая на этой позиции — машина в боксе, либо 0, если бокс пустой.

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

    • #2642

      Вообще, я не понимаю ваш алгоритм. Опишите пожалуйста что делает каждая функция. Я не понимаю зачем вам генерировать перестановки. Я пытался разобрать, например, что если ваша программа передвинет машину 6 с клетки b в клетку f — то будет ли она на следующем шаге пытаться передвинуть ее назад в клетку b. Если ваша программа так делает, то это можно исправить и эффект может появиться. Например, на каком-то шаге она может передвинуть 4 машины, значит в дереве поиска решения на следующем ярусе будет 4 узла, но если она может сдвинуть их еще и назад — то 8 узлов. Если в вашем дереве потом будет например 10 ярусов (задача решается за 10 ходов) — то программа зря обрабатывает 4^10 вариантов, а это много.

      Но я еще раз повторюсь, я не смог понять ваш код. Я уже просил подробно его расписать. Мне кажется, что комментарии в коде у вас лишь запутывают. Так функция dfs у вас не проверяет наличие пути между вершинами (или делает не только это).

      Я не понимаю почему у вас в БД явно записаны все дуги — можно было описать лишь половину, вторая часть могла бы быть получена так:

      check_edge(A, B):-
        edge(A, B), !; edge(B, A).

      Я считаю, что отлаживать программу с вашим массивом-состоянием не удобно. Еще больше мешают номера боксов вместо букв (как на картинке).

      Я не понял почему и зачем swapCar выполняет 4 раза append и что он вообще должен делать. Как по мне, чтобы переставить машину X из бокса A в бокс B надо выполнить что-то такое:

      select(node(A, X), State, StatePart), !,
      NextState = [node(B, X)|StatePart].

      И это однозначно будет работать быстрее чем ваш код.

      Мне вообще не понятно что делает функция generateMoves. Просто не понимаю зачем нужно генерировать все возможные пары вершин (перемещаться мы все равно может только по дугам графа, которых гораздо меньше), хотя ваша функция moveCar пытается перемещать все машины как попало — без учета дуг графа (если я правильно понял).

      Может быть я не прав. Я хочу помочь, но не могу понять код. Я прошу описать то, как с вашей точки зрения он работает (каждая функция).

  • #2643

    StrKllr
    Участник

    Здравствуйте еще раз.

    Сейчас программа выглядит так

    :- dynamic states/2.
    
    /*nodes (боксы гаража)*/
    node(0).
    node(1).
    node(2).
    node(3).
    node(4).
    node(5).
    node(6).
    node(7).
    node(8).
    node(9).
    node(10).
    node(11).
    
    /* edges (проезды между боксами) */
    edge(0,1).
    edge(1,0).
    edge(1,2).
    edge(2,1).
    edge(1,4).
    edge(4,1).
    edge(2,3).
    edge(3,2).
    edge(4,5).
    edge(5,4).
    edge(5,6).
    edge(6,5).
    edge(5,7).
    edge(7,5).
    edge(7,9).
    edge(9,7).
    edge(8,9).
    edge(9,8).
    edge(9,10).
    edge(10,9).
    edge(10,11).
    edge(11,10).
    
    /* поиск в глубину (проверяет, есть ли путь между вершинами) */
    dfs(A, B, _, [(A, B)], State):-
      edge(A, B),nth0(B,State,Spot), Spot == 0,!.
    
    dfs(A, B, VN, [(A, X)|TR], State):-
      edge(A, X),nth0(X,State,Spot),Spot == 0, not(member(X, VN)),
      dfs(X, B, [A|VN], TR, State).
    
    swapCar(As,I,J,Cs) :-
       same_length(As,Cs),
       append(BeforeI,[AtI|PastI],As),
       append(BeforeI,[AtJ|PastI],Bs),
       append(BeforeJ,[AtJ|PastJ],Bs),
       append(BeforeJ,[AtI|PastJ],Cs),
       length(BeforeI,I),
       length(BeforeJ,J),!.
    
    checkPath(State,From,To):-dfs(From,To,[],Path,State),length(Path,Size),Size>0.
    
    generateMoves(X,Y):- node(X), node(Y), X \== Y.
    
    checkStartIsCar(State,Position) :- nth0(Position,State,Car),Car \== 0.
    
    checkEndIsEmpty(State,Position) :- nth0(Position,State,Spot), Spot == 0.
    
    moveCar(PreviousState):- generateMoves(From,To),checkStartIsCar(PreviousState,From), checkEndIsEmpty(PreviousState,To),checkPath(PreviousState,From,To), swapCar(PreviousState,From,To,NewState),
      \+(states(_, NewState)),
      assert(states(PreviousState, NewState)),fail;!.
    
    path(Finish, [[Finish | PathPart] | _], [Finish | PathPart]):-!.
    path(Finish, [[X | PathPart] | ProcList], Path):-
      moveCar(X),
      findall(Y, step(X, PathPart, Y), AdjNodes),
      append(ProcList, AdjNodes, NewProcList), !,
      path(Finish, NewProcList, Path).
    
    step(X,T,[Y,X|T]):-
      states(X,Y),
      not(member(Y,T)).
    
    path(Start, Finish):-
        path(Finish, [[Start]], RPath), !,
        reverse(RPath,Path), write(Path).

    Сейчас для поиска решения используется поиск в ширину.

    Теперь по функциям.
    Функция DFS ищет путь по пустым клеткам от бокса до бокса, проверяя, чтобы по пути мы проходили только по пустым боксам (проверка на 0)
    Функция SwapCar переставляет элементы с заданными индексами в массиве-состоянии, для получения нового состояния.
    GenerateMoves используется для создания всевозможных перестановок, которые потом отсеются проверками CheckStartIsCar, dfs, CheckEndIsEmpty.
    CheckStartIsCar проверяет, что точка, откуда мы собираемся двигать занята машиной.
    CheckEndIsEmpty проверяет, что точка КУДА мы двигаем машину — пуста.

    Таким образом мы движемся только по заданным ранее ребрам.

    Также в moveCar добавлено добавление новых состояний

    not(states(_, NewState)),
      assert(states(PreviousState, NewState)),fail;!

    так как мы используем поиск в ширину.

    Как в моём понимании должно всё работать.

    Мы запускаемся от path(начальное положение, желаемое положение)
    Наш moveCar сгенерирует все ДОПУСТИМЫЕ перемещения (он действительно это делает, проверял) из этого состояния. То есть, на первом ходу мы можем сделать 8 разных допустимых перемещений. Создаются ребра графа states, если еще не было пути в определённые состояния.
    Затем уже стандартный поиск в ширину с достраиванием графа.

    Если Вам не сложно, я бы с удовольствием посмотрел на Ваше решение.

  • #2650

    StrKllr
    Участник

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

    • #2662

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

      edge(a, b).
      edge(b, c).
      edge(c, d).
      %edge(b, e).
      %edge(e, f).
      edge(f, e).
      %edge(f, h).
      %edge(h, j).
      edge(j, i).
      edge(j, k).
      edge(k, l).
      
      edge(b, f).
      edge(j, f).
        
      merge_list([], []):-!.
      merge_list([HeadA|TailA], B):-
        select(HeadA, B, TailB), !,
        merge_list(TailA, TailB).
      
      exist_edge(From, To):-
        edge(From, To); edge(To, From).
        
      proliferate(FromState, [(CarId, CarCellTo)|FromTailState]):-
        select(Car, FromState, FromTailState),
        Car = (CarId, _CarCellFrom),
        move_car(Car, CarCellTo, FromTailState).
        
      move_car((_CarIdFrom, CellFrom), CellTo, OtherCars):-
        exist_edge(CellFrom, CellTo),
        \+ member((_CarIdTo, CellTo), OtherCars).
        
      is_state_processed(State, ProcessedStates):-
        member(ProcessedState, ProcessedStates),
        merge_list(State, ProcessedState), !.
        
      path([[FinishState|PathPart]|_], [FinishState|PathPart]):-
        merge_list(FinishState, [(1, a), (2, b), (3, c), (4, c), (5, i), (6, j), (7, k), (8, l)]).
      path([[FromState|PathPart]|ProcList], Path):-
        findall(Y, step(FromState, PathPart, Y), AdjNodes),
        append(ProcList, AdjNodes, NewProcList), !,
        path(NewProcList, Path).  
        
      step(FromState, ProcessedStates,[ToState, FromState|ProcessedStates]):-
        proliferate(FromState, ToState),
        \+ is_state_processed(ToState, ProcessedStates).
       
      solution(Path):-
        path([[[(5, a), (6, b), (7, c), (8, c), (1, i), (2, j), (3, k), (4, l)]]], RPath),
        reverse(RPath, Path), write(Path).

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

      Если мы на вход подадим менее сложное требование (например ситуацию, когда нам необходимо всего 8 перестановок, чтобы достигнуть результата), то помучавшись 30 сек. она выдает список переходов.

      В таком случае можно применить, так называемый поиск с заглублением — это модификация поиска в глубину, при которой сначала ищется решение за 1 ход, потом за 2, за 3 и т.д. пока не будет подобрано минимальное число ходов для получения ответа.

  • #2663

    StrKllr
    Участник

    Большое спасибо за помощь и за Ваш блог в целом, ведь пост про логические задачи является основой основ =)

Для ответа в этой теме необходимо авторизоваться.