quek / paiprolog

forked Christophe Rhodes's PAIProlog that an update of Peter Norvig's "Prolog in Common Lisp".
Other
18 stars 6 forks source link

paiprolog can't solve this sudoku but gprolog can #14

Open muyinliu opened 8 years ago

muyinliu commented 8 years ago

Here is the lisp code I wrote:

;;;; sudoku.lisp

(in-package :paiprolog)

(<-  (member ?item (?item . ?rest))) ;; Fact
(<-  (member ?item (?x . ?rest))     ;; Rule
     (member ?item ?rest))

(<-  (sudoku-match ?list) ;; Rule
     (member 1 ?list)
     (member 2 ?list)
     (member 3 ?list)
     (member 4 ?list)
     (member 5 ?list)
     (member 6 ?list)
     (member 7 ?list)
     (member 8 ?list)
     (member 9 ?list))

;; sudoku
(<-- (sudoku ?puzzle ?solution)
     (= ?solution
        ?puzzle)
     (= ?puzzle
        (?_11 ?_12 ?_13 ?_14 ?_15 ?_16 ?_17 ?_18 ?_19
         ?_21 ?_22 ?_23 ?_24 ?_25 ?_26 ?_27 ?_28 ?_29
         ?_31 ?_32 ?_33 ?_34 ?_35 ?_36 ?_37 ?_38 ?_39
         ?_41 ?_42 ?_43 ?_44 ?_45 ?_46 ?_47 ?_48 ?_49
         ?_51 ?_52 ?_53 ?_54 ?_55 ?_56 ?_57 ?_58 ?_59
         ?_61 ?_62 ?_63 ?_64 ?_65 ?_66 ?_67 ?_68 ?_69
         ?_71 ?_72 ?_73 ?_74 ?_75 ?_76 ?_77 ?_78 ?_79
         ?_81 ?_82 ?_83 ?_84 ?_85 ?_86 ?_87 ?_88 ?_89
         ?_91 ?_92 ?_93 ?_94 ?_95 ?_96 ?_97 ?_98 ?_99))

     ;; row
     (sudoku-match (?_11 ?_12 ?_13 ?_14 ?_15 ?_16 ?_17 ?_18 ?_19))
     (sudoku-match (?_21 ?_22 ?_23 ?_24 ?_25 ?_26 ?_27 ?_28 ?_29))
     (sudoku-match (?_31 ?_32 ?_33 ?_34 ?_35 ?_36 ?_37 ?_38 ?_39))
     (sudoku-match (?_41 ?_42 ?_43 ?_44 ?_45 ?_46 ?_47 ?_48 ?_49))
     (sudoku-match (?_51 ?_52 ?_53 ?_54 ?_55 ?_56 ?_57 ?_58 ?_59))
     (sudoku-match (?_61 ?_62 ?_63 ?_64 ?_65 ?_66 ?_67 ?_68 ?_69))
     (sudoku-match (?_71 ?_72 ?_73 ?_74 ?_75 ?_76 ?_77 ?_78 ?_79))
     (sudoku-match (?_81 ?_82 ?_83 ?_84 ?_85 ?_86 ?_87 ?_88 ?_89))
     (sudoku-match (?_91 ?_92 ?_93 ?_94 ?_95 ?_96 ?_97 ?_98 ?_99))
     ;; col
     (sudoku-match (?_11 ?_21 ?_31 ?_41 ?_51 ?_61 ?_71 ?_81 ?_91))
     (sudoku-match (?_12 ?_22 ?_32 ?_42 ?_52 ?_62 ?_72 ?_82 ?_92))
     (sudoku-match (?_13 ?_23 ?_33 ?_43 ?_53 ?_63 ?_73 ?_83 ?_93))
     (sudoku-match (?_14 ?_24 ?_34 ?_44 ?_54 ?_64 ?_74 ?_84 ?_94))
     (sudoku-match (?_15 ?_25 ?_35 ?_45 ?_55 ?_65 ?_75 ?_85 ?_95))
     (sudoku-match (?_16 ?_26 ?_36 ?_46 ?_56 ?_66 ?_76 ?_86 ?_96))
     (sudoku-match (?_17 ?_27 ?_37 ?_47 ?_57 ?_67 ?_77 ?_87 ?_97))
     (sudoku-match (?_18 ?_28 ?_38 ?_48 ?_58 ?_68 ?_78 ?_88 ?_98))
     (sudoku-match (?_19 ?_29 ?_39 ?_49 ?_59 ?_69 ?_79 ?_89 ?_99))
     ;; square
     (sudoku-match (?_11 ?_12 ?_13 ?_21 ?_22 ?_23 ?_31 ?_32 ?_33))
     (sudoku-match (?_14 ?_15 ?_16 ?_24 ?_25 ?_26 ?_34 ?_35 ?_36))
     (sudoku-match (?_17 ?_18 ?_19 ?_27 ?_28 ?_29 ?_37 ?_38 ?_39))
     (sudoku-match (?_41 ?_42 ?_43 ?_51 ?_52 ?_53 ?_61 ?_62 ?_63))
     (sudoku-match (?_44 ?_45 ?_46 ?_54 ?_55 ?_56 ?_64 ?_65 ?_66))
     (sudoku-match (?_47 ?_48 ?_49 ?_57 ?_58 ?_59 ?_67 ?_68 ?_69))
     (sudoku-match (?_71 ?_72 ?_73 ?_81 ?_82 ?_83 ?_91 ?_92 ?_93))
     (sudoku-match (?_74 ?_75 ?_76 ?_84 ?_85 ?_86 ?_94 ?_95 ?_96))
     (sudoku-match (?_77 ?_78 ?_79 ?_87 ?_88 ?_89 ?_97 ?_98 ?_99)))

(<-  (solve ?Solution)
     (sudoku (? ? 5 3 ? ? ? ? ?
              8 ? ? ? ? ? ? 2 ?
              ? 7 ? ? 1 ? 5 ? ?
              4 ? ? ? ? 5 3 ? ?
              ? 1 ? ? 7 ? ? ? 6
              ? ? 3 2 ? ? ? 8 ?
              ? 6 ? 5 ? ? ? ? 9
              ? ? 4 ? ? ? ? 3 ?
              ? ? ? ? ? 9 7 ? ?)
             ?Solution))

(?- (solve ?Solution))

It takes few minutes and never reach the solution!!(CPU 100% for 10min and still running...) Is there something wrong about my code, or the unify of paiprolog is not that efficient? Note: paiprolog can solve Zebra Puzzle, only taks 6-8ms.

Here is the code written in Prolog(gprolog), it only taks 1ms to solve:

sudoku(Puzzle, Solution):-
  Solution = Puzzle,
  Puzzle = [
      S11,S12,S13,S14,S15,S16,S17,S18,S19,
      S21,S22,S23,S24,S25,S26,S27,S28,S29,
      S31,S32,S33,S34,S35,S36,S37,S38,S39,
      S41,S42,S43,S44,S45,S46,S47,S48,S49,
      S51,S52,S53,S54,S55,S56,S57,S58,S59,
      S61,S62,S63,S64,S65,S66,S67,S68,S69,
      S71,S72,S73,S74,S75,S76,S77,S78,S79,
      S81,S82,S83,S84,S85,S86,S87,S88,S89,
      S91,S92,S93,S94,S95,S96,S97,S98,S99
  ],
  /* limit 1-9*/
  fd_domain(Solution, 1, 9),
  /* row */
  fd_all_different([S11,S12,S13,S14,S15,S16,S17,S18,S19]),
  fd_all_different([S21,S22,S23,S24,S25,S26,S27,S28,S29]),
  fd_all_different([S31,S32,S33,S34,S35,S36,S37,S38,S39]),
  fd_all_different([S41,S42,S43,S44,S45,S46,S47,S48,S49]),
  fd_all_different([S51,S52,S53,S54,S55,S56,S57,S58,S59]),
  fd_all_different([S61,S62,S63,S64,S65,S66,S67,S68,S69]),
  fd_all_different([S71,S72,S73,S74,S75,S76,S77,S78,S79]),
  fd_all_different([S81,S82,S83,S84,S85,S86,S87,S88,S89]),
  fd_all_different([S91,S92,S93,S94,S95,S96,S97,S98,S99]),
  /* col */
  fd_all_different([S11,S21,S31,S41,S51,S61,S71,S81,S91]),
  fd_all_different([S12,S22,S32,S42,S52,S62,S72,S82,S92]),
  fd_all_different([S13,S23,S33,S43,S53,S63,S73,S83,S93]),
  fd_all_different([S14,S24,S34,S44,S54,S64,S74,S84,S94]),
  fd_all_different([S15,S25,S35,S45,S55,S65,S75,S85,S95]),
  fd_all_different([S16,S26,S36,S46,S56,S66,S76,S86,S96]),
  fd_all_different([S17,S27,S37,S47,S57,S67,S77,S87,S97]),
  fd_all_different([S18,S28,S38,S48,S58,S68,S78,S88,S98]),
  fd_all_different([S19,S29,S39,S49,S59,S69,S79,S89,S99]),
  /* square */
  fd_all_different([S11,S12,S13,S21,S22,S23,S31,S32,S33]),
  fd_all_different([S14,S15,S16,S24,S25,S26,S34,S35,S36]),
  fd_all_different([S17,S18,S19,S27,S28,S29,S37,S38,S39]),
  fd_all_different([S41,S42,S43,S51,S52,S53,S61,S62,S63]),
  fd_all_different([S44,S45,S46,S54,S55,S56,S64,S65,S66]),
  fd_all_different([S47,S48,S49,S57,S58,S59,S67,S68,S69]),
  fd_all_different([S71,S72,S73,S81,S82,S83,S91,S92,S93]),
  fd_all_different([S74,S75,S76,S84,S85,S86,S94,S95,S96]),
  fd_all_different([S77,S78,S79,S87,S88,S89,S97,S98,S99]),
  fd_labeling(Solution).

/* solve the most difficult sudoku in the world */
solve(Solution) :-
  sudoku([
    _,_,5,3,_,_,_,_,_,
    8,_,_,_,_,_,_,2,_,
    _,7,_,_,1,_,5,_,_,
    4,_,_,_,_,5,3,_,_,
    _,1,_,_,7,_,_,_,6,
    _,_,3,2,_,_,_,8,_,
    _,6,_,5,_,_,_,_,9,
    _,_,4,_,_,_,_,3,_,
    _,_,_,_,_,9,7,_,_
  ],Solution).

%test: ?- solve(Solution).
/*
Solution = [1,4,5,3,2,7,6,9,8,8,3,9,6,5,4,1,2,7,6,7,2,9,1,8,5,4,3,4,9,6,1,8,5,3,7,2,2,1,8,4,7,3,9,5,6,7,5,3,2,9,6,4,8,1,3,6,7,5,4,2,8,1,9,9,8,4,7,6,1,2,3,5,5,2,1,8,3,9,7,6,4] ? .
(1 ms) yes
*/