From 0f817a2e9a9cf7815e4511c86238d582f415dbd8 Mon Sep 17 00:00:00 2001
From: John Benediktsson <mrjbq7@gmail.com>
Date: Fri, 1 Sep 2023 17:11:01 -0700
Subject: [PATCH] sudokus: fix hint after solved

---
 extra/sudokus/sudokus.factor | 46 +++++++++++++++++++++++-------------
 1 file changed, 30 insertions(+), 16 deletions(-)

diff --git a/extra/sudokus/sudokus.factor b/extra/sudokus/sudokus.factor
index ca8f0ce5d6..d4110d4f80 100644
--- a/extra/sudokus/sudokus.factor
+++ b/extra/sudokus/sudokus.factor
@@ -18,23 +18,37 @@ IN: sudokus
       [ 1array puzzle pos cut-slice rest surround ] map >list [ random? solutions ] bind
     ] [ puzzle list-monad return ] if* ;
 
-: solution ( puzzle random? -- solution ) dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
-: hint ( puzzle -- puzzle' ) [ [ f swap indices random dup ] [ f solution ] bi nth ] keep swapd >vector [ set-nth ] keep ;
-: create ( difficulty -- puzzle ) 81 [ f ] replicate
-    40 random solution [ [ f swap [ length random ] keep set-nth ] curry times ] keep ;
+: solution ( puzzle random? -- solution )
+    dupd solutions dup +nil+ = [ drop "Unsolvable" alert* ] [ nip car ] if ;
 
-: do-sudoku ( -- ) [ [
+: hint ( puzzle -- puzzle' )
+    f over indices random [
+        [ >vector dup f solution ]
+        [ [ swap nth ] keep pick set-nth ] bi*
+    ] when* ;
+
+: create ( difficulty -- puzzle )
+    81 f <array>
+    40 random solution [
+        [ f swap [ length random ] keep set-nth ] curry times
+    ] keep ;
+
+: do-sudoku ( -- )
+    [
         [
-            81 [ "" ] replicate <basic> switch-models [ [ <basic> ] map 9 group [ 3 group ] map 3 group
-               [ [ [ <spacer> [ [ <model-field> ->% 2 [ string>number ] fmap ]
-                    map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product>
-               [ "Difficulty:" <label> , "1" <basic> <model-field> -> [ string>number 1 or 1 + 10 * ] fmap
-               "Generate" <model-border-btn> -> updates [ create ] fmap <spacer>
-               "Hint" <model-border-btn> -> "Solve" <model-border-btn> -> ] <hbox> ,
-               roll [ swap updates ] curry bi@
-               [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array merge [ [ [ number>string ] [ "" ] if* ] map ] fmap
-           ] bind
-        ] with-self , ] <vbox> { 280 220 } >>pref-dim
-    "Sudoku Sleuth" open-window ] with-ui ;
+            [
+                81 [ "" ] replicate <basic> switch-models [ [ <basic> ] map 9 group [ 3 group ] map 3 group
+                   [ [ [ <spacer> [ [ <model-field> ->% 2 [ string>number ] fmap ]
+                        map <spacer> ] map concat ] <hbox> , ] map concat <spacer> ] map concat <product>
+                   [ "Difficulty:" <label> , "1" <basic> <model-field> -> [ string>number 1 or 1 + 10 * ] fmap
+                   "Generate" <model-border-btn> -> updates [ create ] fmap <spacer>
+                   "Hint" <model-border-btn> -> "Solve" <model-border-btn> -> ] <hbox> ,
+                   roll [ swap updates ] curry bi@
+                   [ [ hint ] fmap ] [ [ f solution ] fmap ] bi* 3array merge [ [ [ number>string ] [ "" ] if* ] map ] fmap
+               ] bind
+            ] with-self ,
+        ] <vbox> { 280 220 } >>pref-dim
+        "Sudoku Sleuth" open-window
+    ] with-ui ;
 
 MAIN: do-sudoku
-- 
2.34.1