Question

九洞有8个钉子。开始时，左边的四个红色钉子和右边的四个蓝色钉子，以及它们之间的一个空洞。谜题是将所有红色向右移动，将蓝色钉向左移动（在另一个相反方向）。这些是合法的举措：

钉子只能向前移动（红色可能向右移动而蓝色向左移动）。
钉子可以向前移动一步到打开位置。
如果超出它的位置打开，钉子可能会跳过一个相反颜色的钉子。

这是我写的，但它不起作用

% Form of board, b for blue, r for red, o for empty.
% [ [r,r,r,r], [o], [b,b,b,b] ]

% jumps 
linjmp([x, x, o | T], [o, o, x | T]).
linjmp([o, x, x | T], [x, o, o | T]).
linjmp([H|T1], [H|T2]) :- linjmp(T1,T2).


% Series of legal boards.
series(From, To, [From, To]) :- jump(From, To).
series(From, To, [From, By | Rest])
        :- jump(From, By), 
           series(By, To, [By | Rest]).

% Print a series of boards.  This puts one board per line and looks a lot
% nicer than the jumble that appears when the system simply beltches out
% a list of boards.  The write_ln predicate is a built-in which always
% succeeds (is always satisfied), but prints as a side-effect.  Therefore
% print_series(Z) will succeed with any list, and the members of the list
% will be printed, one per line, as a side-effect of that success.
print_series_r([]) :- 
    write_ln('*******************************************************').
print_series_r([X|Y]) :- write_ln(X), print_series_r(Y).
print_series(Z) :- 
    write_ln('\n*******************************************************'),
    print_series_r(Z).

% A solution.
solution(L) :- series([[r,r,r,r], [o], [b,b,b,b]],
                   [[b,b,b,b], [o], [r,r,r,r]], L).

% Find a print the first solution.  
solve :- solution(X), print_series(X).

% Find all the solutions.
solveall :- solve, fail.

% This finds each solution with stepping.
solvestep(Z) :- Z = next, solution(X), print_series(X).

它应该是这样的：

?- consult(linejump).
% linejump compiled 0.00 sec, 3,612 bytes
true.

?- solve.

*******************************************************
[r, r, r, r, o, b, b, b, b]
[r, r, r, o, r, b, b, b, b]
[r, r, r, b, r, o, b, b, b]
[r, r, r, b, r, b, o, b, b]
[r, r, r, b, o, b, r, b, b]
[r, r, o, b, r, b, r, b, b]
[r, o, r, b, r, b, r, b, b]
[r, b, r, o, r, b, r, b, b]
[r, b, r, b, r, o, r, b, b]
[r, b, r, b, r, b, r, o, b]
[r, b, r, b, r, b, r, b, o]
[r, b, r, b, r, b, o, b, r]
[r, b, r, b, o, b, r, b, r]
[r, b, o, b, r, b, r, b, r]
[o, b, r, b, r, b, r, b, r]
[b, o, r, b, r, b, r, b, r]
[b, b, r, o, r, b, r, b, r]
[b, b, r, b, r, o, r, b, r]
[b, b, r, b, r, b, r, o, r]
[b, b, r, b, r, b, o, r, r]
[b, b, r, b, o, b, r, r, r]
[b, b, o, b, r, b, r, r, r]
[b, b, b, o, r, b, r, r, r]
[b, b, b, b, r, o, r, r, r]
[b, b, b, b, o, r, r, r, r]
*******************************************************
true ;

*******************************************************
[r, r, r, r, o, b, b, b, b]
[r, r, r, r, b, o, b, b, b]
[r, r, r, o, b, r, b, b, b]
[r, r, o, r, b, r, b, b, b]
[r, r, b, r, o, r, b, b, b]
[r, r, b, r, b, r, o, b, b]
[r, r, b, r, b, r, b, o, b]
[r, r, b, r, b, o, b, r, b]
[r, r, b, o, b, r, b, r, b]
[r, o, b, r, b, r, b, r, b]
[o, r, b, r, b, r, b, r, b]
[b, r, o, r, b, r, b, r, b]
[b, r, b, r, o, r, b, r, b]
[b, r, b, r, b, r, o, r, b]
[b, r, b, r, b, r, b, r, o]
[b, r, b, r, b, r, b, o, r]
[b, r, b, r, b, o, b, r, r]
[b, r, b, o, b, r, b, r, r]
[b, o, b, r, b, r, b, r, r]
[b, b, o, r, b, r, b, r, r]
[b, b, b, r, o, r, b, r, r]
[b, b, b, r, b, r, o, r, r]
[b, b, b, r, b, o, r, r, r]
[b, b, b, o, b, r, r, r, r]
[b, b, b, b, o, r, r, r, r]
*******************************************************
true .

?-

Answer 1

一个直截了当的Prolog代码，它试图成为最简单和最清晰的代码，并且根本不关心效率：

start([r,r,r,r,e,b,b,b,b]).  % starting position

% can move from a position P1 to position P2
move(P1,P2):- append(A,[r,e|B],P1), append(A,[e,r|B],P2).
move(P1,P2):- append(A,[e,b|B],P1), append(A,[b,e|B],P2).
move(P1,P2):- append(A,[e,r,b|B],P1), append(A,[b,r,e|B],P2).
move(P1,P2):- append(A,[r,b,e|B],P1), append(A,[e,b,r|B],P2).

solved([b,b,b,b,e,r,r,r,r]).   % the target position to be reached

pegs :- start(P), solve(P, [], R), 
        maplist(writeln, R), nl, nl, fail ; true.

% solve( ?InitialPosition, +PreviousPositionsList, ?ResultingPath)
solve(P, Prev, R):- 
    solved(P) -> reverse([P|Prev], R) ; 
    move(P, Q), \+memberchk(Q, Prev), solve(Q, [P|Prev], R).

没什么特别的。整个0.08 seconds on Ideone找到两个解决方案，24个移动。

对于 N -pegs问题，我们只需要相应地修改start和solved谓词。

Kudos去了Cary Swoveland，answer我用了符号（这是解决方案的一半）。一个更高效的代码，遵循mat answer，以Prolog特有的自上而下的方式构建结果列表（类似于difference-lists技术，参见tailrecursion-modulo-cons）：

swap([r,e|B],[e,r|B]).
swap([e,b|B],[b,e|B]).
swap([e,r,b|B],[b,r,e|B]).
swap([r,b,e|B],[e,b,r|B]).

move(A,B):- swap(A,B).
move([A|B],[A|C]):- move(B,C).

moves(S,[S]):- solved(S).
moves(S,[S|B]):- move(S,Q), moves(Q,B).

pegs(PS) :- start(P), moves(P, PS), maplist( writeln, PS), nl.

一般情况下，任何在他们之间有位置和移动的棋盘游戏都可以看作是由有效移动定义的位置搜索空间中的搜索问题，即将我们从开始到结束（最终）位置。可以使用各种搜索策略，深度优先，广度优先，迭代深化，最佳优先启发...这将搜索空间视为节点位置（板配置），边缘移动的图形;否则我们可以说这是move关系的传递闭包。

有时会定义move关系，以便生成新的合法配置（如此处）;有时，更容易定义一般移动关系并检查生成的合法性位置（例如 N - 条纹问题）。在搜索时维护被访问节点列表也是很常见的，并检查任何新发现的节点是否是已访问过的节点之一 - 丢弃该路径，以避免进入循环。

广度优先搜索将显式维护被发现节点的边界，并将其保持为队列，同时一次一个地移动它; 深度优先作为堆栈。 最佳第一次搜索将根据一些启发式重新排序此边界。在这里，moves/2是深度优先隐式，因为它依赖于Prolog搜索，而Prolog搜索本身就是深度优先的。

有时保证搜索空间不具有这些周期（即成为DAG指向的非循环图），因此不需要检查唯一性。至于最终节点，有时候它是由值定义的（就像这里），有时我们对某些条件感兴趣（例如在国际象棋中）。有关如何使用惰性all_dif/1谓词预先强制实施此唯一性，请参阅this answer。随着其中定义的谓词，这个问题变得简单

pegs(Ps):- 
    path( move, Ps, [r,r,r,r,e,b,b,b,b], [b,b,b,b,e,r,r,r,r]).

Answer 2

在描述列表时使用dcg总是很好。

例如：

initial_state([r,r,r,r,o,b,b,b,b]).

final_state([b,b,b,b,o,r,r,r,r]).

move([E|Es])     --> [E], move(Es).
move([r,o|Ls])   --> [o,r], list(Ls).
move([o,b|Ls])   --> [b,o], list(Ls).
move([o,r,b|Ls]) --> [b,r,o], list(Ls).
move([r,b,o|Ls]) --> [o,b,r], list(Ls).

list([])     --> [].
list([L|Ls]) --> [L], list(Ls).

moves(S)  --> [S], { final_state(S) }.
moves(S0) --> [S0], { phrase(move(S0), S) }, moves(S).

我们可以使用迭代深化来找到最短的解决方案：

?- length(Ms, _),
   initial_state(S0),
   phrase(moves(S0), Ms),
   maplist(writeln, Ms).
[r,r,r,r,o,b,b,b,b]
[r,r,r,r,b,o,b,b,b]
[r,r,r,o,b,r,b,b,b]
[r,r,o,r,b,r,b,b,b]
[r,r,b,r,o,r,b,b,b]
[r,r,b,r,b,r,o,b,b]
[r,r,b,r,b,r,b,o,b]
[r,r,b,r,b,o,b,r,b]
[r,r,b,o,b,r,b,r,b]
[r,o,b,r,b,r,b,r,b]
[o,r,b,r,b,r,b,r,b]
[b,r,o,r,b,r,b,r,b]
[b,r,b,r,o,r,b,r,b]
[b,r,b,r,b,r,o,r,b]
[b,r,b,r,b,r,b,r,o]
[b,r,b,r,b,r,b,o,r]
[b,r,b,r,b,o,b,r,r]
[b,r,b,o,b,r,b,r,r]
[b,o,b,r,b,r,b,r,r]
[b,b,o,r,b,r,b,r,r]
[b,b,b,r,o,r,b,r,r]
[b,b,b,r,b,r,o,r,r]
[b,b,b,r,b,o,r,r,r]
[b,b,b,o,b,r,r,r,r]
[b,b,b,b,o,r,r,r,r]

为移动列表Ms和初始状态S0添加其他绑定。

Answer 3

Will Ness answer的纯语法变体：

swap(X,P,Q) :- append([L,X,R],P), reverse(X,Y), append([L,Y,R],Q).

solve(P,Prev,R) :-
       solved(P)
    -> reverse([P|Prev], R)
    ;  % move(P, Q)
       phrase( (swap([r,e])|swap([e,b])|swap([e,r,b])|swap([r,b,e])), P, Q),
       \+memberchk(Q, Prev),
       solve(Q, [P|Prev], R).

Answer 4

我不知道prolog，但这是使用Ruby的递归解决方案。即使你不了解Ruby，你也应该能够弄清楚递归是如何工作的。

Ruby入门：

a[space_pos-1], a[space_pos] = a[space_pos], a[space_pos-1]使用并行分配来交换数组索引space_pos-1和space_pos的值，而无需临时变量。
FINAL，因为它以大写字母开头，是一个常量。
a = arr.dup返回＆＃34;浅＆＃34;数组arr的副本，因此a的交换元素不会影响arr。
如果某个方法不包含return语句，则该方法会返回最后一行计算的值（例如a中的数组red_slide）。

soln=[]

def solve(arr, soln = [])

soln

solve

solve(arr)

soln + [:red_slide]，其中soln是一个数组，[:red_slide]是一个包含单个符号（由冒号表示）的数组，是一个由{{1}元素组成的新数组}和元素soln。
您可以将:red_slide视为＆＃34;和＆＃34;。

&&

nil

solve

solve。

arr

FINAL = [:b, :b, :b, :b, :e, :r, :r, :r, :r]
SIZE = FINAL.size

def red_slide(arr, space_pos)
  a = arr.dup
  a[space_pos-1], a[space_pos] = a[space_pos], a[space_pos-1]
  a
end

def blue_slide(arr, space_pos)
  a = arr.dup
  a[space_pos], a[space_pos+1] = a[space_pos+1], a[space_pos]
  a
end

def red_jump(arr, space_pos)
  a = arr.dup
  a[space_pos-2], a[space_pos] = a[space_pos], a[space_pos-2]   
  a
end

def blue_jump(arr, space_pos)
  a = arr.dup
  a[space_pos+2], a[space_pos] = a[space_pos], a[space_pos+2]   
  a
end

def solve(arr, soln = [])
  return soln if arr == FINAL
  space_pos = arr.index(:e)

  # See if can slide red    
  if space_pos > 0 && arr[space_pos-1] == :r
    ret = solve(red_slide(arr, space_pos), soln + [:red_slide])
    return ret if ret
  end

  # See if can slide blue
  if space_pos < SIZE-1 && arr[space_pos+1] == :b
    ret = solve(blue_slide(arr, space_pos), soln + [:blue_slide])
    return ret if ret
  end

  # See if can jump red over blue
  if space_pos > 1 && arr[space_pos-2] == :r && arr[space_pos-1] == :b 
    ret = solve(red_jump(arr, space_pos), soln + [:red_jump])
    return ret if ret
  end

  # See if can jump blue over red
  if space_pos < SIZE-2 && arr[space_pos+2] == :b && arr[space_pos+1] == :r 
    ret = solve(blue_jump(arr, space_pos), soln + [:blue_jump])
    return ret if ret
  end

  nil
end

我很惊讶计算解决方案只花了不到一秒钟。我想动作组合的数量并不像我想象的那么大。

请注意，此解决方案适用于＆＃34; N peg问题＆＃34;而不仅仅是＆＃34; 8 peg问题＆＃34;。例如，

solve [:r, :r, :r, :r, :e, :b, :b, :b, :b]
  #=> [:red_slide, :blue_jump, :blue_slide, :red_jump, :red_jump, :red_slide,
  #    :blue_jump, :blue_jump, :blue_jump, :blue_slide, :red_jump, :red_jump, 
  #    :red_jump, :red_jump, :blue_slide, :blue_jump, :blue_jump, :blue_jump, 
  #    :red_slide, :red_jump, :red_jump, :blue_slide, :blue_jump, :red_slide]

Answer 5

董事会代表在这里很重要。

df <- read.csv('http://financials.morningstar.com/ajax/exportKR2CSV.html?&t=AAPL', 
           skip=2, stringsAsFactors = FALSE)
df <- df[df[2]!='2006-09',]               # REMOVE REPEAT HEADERS
df <- df[-grep('Key Ratios', df$X),]      # REMOVE KEY RATIO HEADERS

finaldf <- data.frame(t(df), stringsAsFactors = FALSE)
colnames(finaldf) <- finaldf[1,]
finaldf <- finaldf[-1,]

# PERIOD COLUMN
finaldf$Period <- as.character(rownames(finaldf))
finaldf$Period <- gsub("X", "Y", gsub("\\.", "M", finaldf$Period))

rownames(finaldf) <- 1:nrow(finaldf)                      # RESET ROWNAMES
finaldf <- finaldf[,c(ncol(finaldf), 2:ncol(finaldf)-1)]  # RE-ORDER PERIOD TO START

# CONVERT TO NUMERIC
for (i in names(finaldf)) {
        if (i != "Period") {
          finaldf[[i]] <- as.numeric(gsub(",", "", finaldf[[i]]))
        }
     }

finaldf[, c(1:7)]

试图解决Prolog中的跳钉拼图

5 个答案: