Posted to tcl by kbk at Mon Dec 02 00:11:33 GMT 2013view raw

  1. test bdd-21.1 {eight queens} {*}{
  2. -setup {
  3. bdd::system create sys
  4. for {set i 0} {$i < 64} {incr i} {
  5. sys nthvar v$i $i; sys notnthvar !v$i $i
  6. }
  7. }
  8. -body {
  9. sys := solution 1
  10.  
  11. # iterate through the cells
  12.  
  13. for {set row 0} {$row < 8} {incr row} {
  14. sys := thisRowC 1
  15. for {set col 7} {$col >= 0} {incr col -1} {
  16. sys := cellC 1
  17. set q1 v[expr {8* $row + $col}]
  18.  
  19. # queen here <= no other queen in the same column
  20.  
  21. sys := columnC 1
  22. for {set col2 7} {$col2 >= 0} {incr col2 -1} {
  23. if {$col2 != $col} {
  24. set q2 v[expr {8 * $row + $col2}]
  25. sys & columnC columnC !$q2
  26. }
  27. }
  28. sys <= columnC $q1 columnC
  29. sys & cellC cellC columnC
  30.  
  31. # queen here <= no other queen in the same row
  32.  
  33. sys := rowC 1
  34. for {set row2 7} {$row2 >= 0} {incr row2 -1} {
  35. if {$row2 != $row} {
  36. set q2 v[expr {8 * $row2 + $col}]
  37. sys & rowC rowC !$q2
  38. }
  39. }
  40. sys <= rowC $q1 rowC
  41. sys & cellC cellC rowC
  42.  
  43. # queen here <= no other queen in the same diagonal
  44.  
  45. sys := diag1C 1
  46. sys := diag2C 1
  47. for {set row2 7} {$row2 >= 0} {incr row2 -1} {
  48. if {$row2 != $row} {
  49. set col2 [expr {$col + $row2 - $row}]
  50. if {$col2 >= 0 && $col2 < 8} {
  51. set q2 v[expr {8 * $row2 + $col2}]
  52. sys & diag1C diag1C !$q2
  53. }
  54. set col2 [expr {$col + $row - $row2}]
  55. if {$col2 >= 0 && $col2 < 8} {
  56. set q2 v[expr {8 * $row2 + $col2}]
  57. sys & diag2C diag2C !$q2
  58. }
  59. }
  60. }
  61. sys <= diag1C $q1 diag1C
  62. sys & cellC cellC diag1C
  63.  
  64. sys <= diag2C $q1 diag2C
  65. sys & cellC cellC diag2C
  66.  
  67. # accumulate into the constraint set for the row
  68.  
  69. sys & thisRowC thisRowC cellC
  70. }
  71.  
  72. # accumulate all constraints for a row into the solution
  73.  
  74. sys & solution solution thisRowC
  75. }
  76.  
  77. # at least one queen in each column
  78. for {set col 0} {$col < 8} {incr col} {
  79. sys := columnC 0
  80. for {set row 0} {$row < 8} {incr row} {
  81. set q v[expr {8*$row + $col}]
  82. sys | columnC columnC $q
  83. }
  84. sys & solution solution columnC
  85. }
  86. sys foreach_sat A solution {
  87. set sol [lrepeat 8 {}]
  88. foreach {var value} $A {
  89. if {$value} {
  90. lset sol [expr {$var/8}] [expr {$var%8}]
  91. }
  92. }
  93. lappend sols [join $sol {}]
  94. }
  95. lreverse $sols
  96.  
  97. }
  98. -cleanup {rename sys {}}
  99. -result {04752613 05726314 06357142 06471352 13572064 14602753 14630752 15063724 15720364 16257403 16470352 17502463 20647135 24170635 24175360 24603175 24730615 25147063 25160374 25164073 25307461 25317460 25703641 25704613 25713064 26174035 26175304 27360514 30471625 30475261 31475026 31625704 31625740 31640752 31746025 31750246 35041726 35716024 35720641 36074152 36271405 36415027 36420571 37025164 37046152 37420615 40357162 40731625 40752613 41357206 41362750 41506372 41703625 42057136 42061753 42736051 46027531 46031752 46137025 46152037 46152073 46302751 47302516 47306152 50417263 51602473 51603742 52064713 52073164 52074136 52460317 52470316 52613704 52617403 52630714 53047162 53174602 53602417 53607142 57130642 60275314 61307425 61520374 62057413 62714053 63147025 63175024 64205713 71306425 71420635 72051463 73025164}
  100. }