Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / extra / sudoku / sudoku.factor

diff --git a/extra/sudoku/sudoku.factor b/extra/sudoku/sudoku.factor
old mode 100644 (file)
new mode 100755 (executable)
index b0ba85c..555f1e6
--- a/extra/sudoku/sudoku.factor
+++ b/extra/sudoku/sudoku.factor
@@ -1,41 +1,41 @@
 ! Based on http://www.ffconsultancy.com/ocaml/sudoku/index.html
 USING: sequences namespaces kernel math math.parser io
-io.styles combinators ;
+io.styles combinators columns ;
 IN: sudoku
 
 SYMBOL: solutions
 SYMBOL: board
 
-: pair+ swapd + >r + r> ;
+: pair+ ( a b c d -- a+b c+d ) swapd [ + ] 2bi@ ;
 
-: row board get nth ;
-: board> row nth ;
-: >board row set-nth ;
-: f>board f -rot >board ;
+: row ( n -- row ) board get nth ;
+: board> ( m n -- x ) row nth ;
+: >board ( row m n -- ) row set-nth ;
+: f>board ( m n -- ) f -rot >board ;
 
-: row-contains? ( n y -- ? ) row member? ;
-: col-contains? ( n x -- ? ) board get swap <column> member? ;
-: cell-contains? ( n x y i -- ? ) 3 /mod pair+ board> = ;
+: row-any? ( n y -- ? ) row member? ;
+: col-any? ( n x -- ? ) board get swap <column> member? ;
+: cell-any? ( n x y i -- ? ) 3 /mod pair+ board> = ;
 
-: box-contains? ( n x y -- ? )
+: box-any? ( n x y -- ? )
     [ 3 /i 3 * ] bi@
-    9 [ >r 3dup r> cell-contains? ] contains?
-    >r 3drop r> ;
+    9 [ [ 3dup ] dip cell-any? ] any?
+    [ 3drop ] dip ;
 
 DEFER: search
 
 : assume ( n x y -- )
-    [ >board ] 2keep [ >r 1+ r> search ] 2keep f>board ;
+    [ >board ] 2keep [ [ 1 + ] dip search ] 2keep f>board ;
 
 : attempt ( n x y -- )
     {
-        { [ 3dup nip row-contains? ] [ 3drop ] }
-        { [ 3dup drop col-contains? ] [ 3drop ] }
-        { [ 3dup box-contains? ] [ 3drop ] }
+        { [ 3dup nip row-any? ] [ 3drop ] }
+        { [ 3dup drop col-any? ] [ 3drop ] }
+        { [ 3dup box-any? ] [ 3drop ] }
         [ assume ]
     } cond ;
 
-: solve ( x y -- ) 9 [ 1+ 2over attempt ] each 2drop ;
+: solve ( x y -- ) 9 [ 1 + 2over attempt ] each 2drop ;
 
 : board. ( board -- )
     standard-table-style [
@@ -59,9 +59,9 @@ DEFER: search
 
 : search ( x y -- )
     {
-        { [ over 9 = ] [ >r drop 0 r> 1+ search ] }
+        { [ over 9 = ] [ [ drop 0 ] dip 1 + search ] }
         { [ over 0 = over 9 = and ] [ 2drop solution. ] }
-        { [ 2dup board> ] [ >r 1+ r> search ] }
+        { [ 2dup board> ] [ [ 1 + ] dip search ] }
         [ solve ]
     } cond ;