From 574fdf069e41e68d5a1e586a3b08763ceb4b21d6 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 12 Apr 2019 14:50:57 +0200 Subject: [PATCH 01/82] init sudoku projekt --- elm-examples/sudoku/.idea/.name | 1 + elm-examples/sudoku/.idea/compiler.xml | 8 ++ .../inspectionProfiles/Project_Default.xml | 5 + elm-examples/sudoku/.idea/misc.xml | 22 ++++ elm-examples/sudoku/.idea/modules.xml | 8 ++ elm-examples/sudoku/.idea/vcs.xml | 6 + elm-examples/sudoku/.idea/workspace.xml | 124 ++++++++++++++++++ elm-examples/sudoku/elm.json | 24 ++++ elm-examples/sudoku/src/Main.elm | 5 + elm-examples/sudoku/sudoku.iml | 13 ++ 10 files changed, 216 insertions(+) create mode 100644 elm-examples/sudoku/.idea/.name create mode 100644 elm-examples/sudoku/.idea/compiler.xml create mode 100644 elm-examples/sudoku/.idea/inspectionProfiles/Project_Default.xml create mode 100644 elm-examples/sudoku/.idea/misc.xml create mode 100644 elm-examples/sudoku/.idea/modules.xml create mode 100644 elm-examples/sudoku/.idea/vcs.xml create mode 100644 elm-examples/sudoku/.idea/workspace.xml create mode 100644 elm-examples/sudoku/elm.json create mode 100644 elm-examples/sudoku/src/Main.elm create mode 100644 elm-examples/sudoku/sudoku.iml diff --git a/elm-examples/sudoku/.idea/.name b/elm-examples/sudoku/.idea/.name new file mode 100644 index 0000000..bb144c1 --- /dev/null +++ b/elm-examples/sudoku/.idea/.name @@ -0,0 +1 @@ +Sudoku \ No newline at end of file diff --git a/elm-examples/sudoku/.idea/compiler.xml b/elm-examples/sudoku/.idea/compiler.xml new file mode 100644 index 0000000..fa07501 --- /dev/null +++ b/elm-examples/sudoku/.idea/compiler.xml @@ -0,0 +1,8 @@ + + + + /usr/bin/ghc + /usr/bin/cabal + /usr/local/bin/stack + + \ No newline at end of file diff --git a/elm-examples/sudoku/.idea/inspectionProfiles/Project_Default.xml b/elm-examples/sudoku/.idea/inspectionProfiles/Project_Default.xml new file mode 100644 index 0000000..8d66637 --- /dev/null +++ b/elm-examples/sudoku/.idea/inspectionProfiles/Project_Default.xml @@ -0,0 +1,5 @@ + + + + \ No newline at end of file diff --git a/elm-examples/sudoku/.idea/misc.xml b/elm-examples/sudoku/.idea/misc.xml new file mode 100644 index 0000000..3f4c22e --- /dev/null +++ b/elm-examples/sudoku/.idea/misc.xml @@ -0,0 +1,22 @@ + + + + + + + + + + + + + Android + + + + + + + + + \ No newline at end of file diff --git a/elm-examples/sudoku/.idea/modules.xml b/elm-examples/sudoku/.idea/modules.xml new file mode 100644 index 0000000..43cf2bc --- /dev/null +++ b/elm-examples/sudoku/.idea/modules.xml @@ -0,0 +1,8 @@ + + + + + + + + \ No newline at end of file diff --git a/elm-examples/sudoku/.idea/vcs.xml b/elm-examples/sudoku/.idea/vcs.xml new file mode 100644 index 0000000..b2bdec2 --- /dev/null +++ b/elm-examples/sudoku/.idea/vcs.xml @@ -0,0 +1,6 @@ + + + + + + \ No newline at end of file diff --git a/elm-examples/sudoku/.idea/workspace.xml b/elm-examples/sudoku/.idea/workspace.xml new file mode 100644 index 0000000..e5a9aa7 --- /dev/null +++ b/elm-examples/sudoku/.idea/workspace.xml @@ -0,0 +1,124 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + 1.8 + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/elm-examples/sudoku/elm.json b/elm-examples/sudoku/elm.json new file mode 100644 index 0000000..931813a --- /dev/null +++ b/elm-examples/sudoku/elm.json @@ -0,0 +1,24 @@ +{ + "type": "application", + "source-directories": [ + "src" + ], + "elm-version": "0.19.0", + "dependencies": { + "direct": { + "elm/browser": "1.0.1", + "elm/core": "1.0.2", + "elm/html": "1.0.0" + }, + "indirect": { + "elm/json": "1.1.2", + "elm/time": "1.0.0", + "elm/url": "1.0.0", + "elm/virtual-dom": "1.0.2" + } + }, + "test-dependencies": { + "direct": {}, + "indirect": {} + } +} \ No newline at end of file diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm new file mode 100644 index 0000000..5fd87b7 --- /dev/null +++ b/elm-examples/sudoku/src/Main.elm @@ -0,0 +1,5 @@ +module Main exposing (main) + +import Html exposing (text) + +main = text "hi" \ No newline at end of file diff --git a/elm-examples/sudoku/sudoku.iml b/elm-examples/sudoku/sudoku.iml new file mode 100644 index 0000000..f939a9d --- /dev/null +++ b/elm-examples/sudoku/sudoku.iml @@ -0,0 +1,13 @@ + + + + + + + + + + + + + \ No newline at end of file -- GitLab From 99d4aa0fcb13ee8f329f7b3bf49f49663fb55c65 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 12 Apr 2019 15:21:17 +0200 Subject: [PATCH 02/82] first progress on sudoku and elm --- elm-examples/sudoku/.gitignore | 1 + elm-examples/sudoku/.idea/workspace.xml | 203 +- elm-examples/sudoku/index.html | 4387 +++++++++++++++++++++++ elm-examples/sudoku/src/Main.elm | 38 +- 4 files changed, 4607 insertions(+), 22 deletions(-) create mode 100644 elm-examples/sudoku/.gitignore create mode 100644 elm-examples/sudoku/index.html diff --git a/elm-examples/sudoku/.gitignore b/elm-examples/sudoku/.gitignore new file mode 100644 index 0000000..aee9810 --- /dev/null +++ b/elm-examples/sudoku/.gitignore @@ -0,0 +1 @@ +/elm-stuff/ diff --git a/elm-examples/sudoku/.idea/workspace.xml b/elm-examples/sudoku/.idea/workspace.xml index e5a9aa7..df06380 100644 --- a/elm-examples/sudoku/.idea/workspace.xml +++ b/elm-examples/sudoku/.idea/workspace.xml @@ -1,20 +1,48 @@ - - - \ No newline at end of file -- GitLab From 8f3db9286af7ce00217757b5e5ea643fab7b5ba7 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 12 Apr 2019 15:25:03 +0200 Subject: [PATCH 04/82] added .idea to gitignore --- .gitignore | 1 + 1 file changed, 1 insertion(+) create mode 100644 .gitignore diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..21ab93b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +/elm-examples/sudoku/.idea/ -- GitLab From 73f7560159c0349936aefa8dcdf1441686865743 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 12 Apr 2019 15:38:01 +0200 Subject: [PATCH 05/82] table --- elm-examples/sudoku/src/Main.elm | 28 ++++++++++++++++++---------- 1 file changed, 18 insertions(+), 10 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 79dc223..8654f20 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -2,6 +2,8 @@ module Main exposing (main) import Browser +import List exposing (map,repeat) + import Html exposing (Html, div, text, table, tr, td) main = Browser.sandbox{init=init,update=update,view=view} @@ -13,27 +15,33 @@ type Entry = EMPTY | N1 | N2 | N3 | N4 | N5 | N6 | N7 | N8 | N9 type alias Sudoku = List (List Entry) -type alias Model = Int +type alias Model = Sudoku + init : Model -init = 0 +init = repeat 9 (repeat 9 EMPTY) -- Update type Msg = Increment | Decrement update: Msg -> Model -> Model -update msg model = - case msg of - Increment -> - model + 1 - Decrement -> - model - 1 +update msg model = model -- View view : Model -> Html Msg view model = - div [] - [] \ No newline at end of file + div [] [gen_sudoku model] + + +gen_sudoku : Model -> Html Msg +gen_sudoku model = table [] (map gen_row model) + +gen_row : List Entry -> Html Msg +gen_row row = + tr [] (map gen_entry row) + +gen_entry: Entry -> Html Msg +gen_entry entry = td [] [text "Entry"] -- GitLab From 3f9428edbb603dc1ec27c1a3c388e405bf17e872 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Fri, 12 Apr 2019 15:57:37 +0200 Subject: [PATCH 06/82] simple show function for entry --- elm-examples/sudoku/src/Main.elm | 96 ++++++++++++++++++++++++++------ 1 file changed, 80 insertions(+), 16 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 8654f20..975385d 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -1,47 +1,111 @@ module Main exposing (main) -import Browser +import Browser +import Html exposing (Html, div, table, td, text, tr) +import List exposing (map, repeat) -import List exposing (map,repeat) -import Html exposing (Html, div, text, table, tr, td) +main = + Browser.sandbox { init = init, update = update, view = view } + -main = Browser.sandbox{init=init,update=update,view=view} -- Model -type Entry = EMPTY | N1 | N2 | N3 | N4 | N5 | N6 | N7 | N8 | N9 + +type Entry + = EMPTY + | N1 + | N2 + | N3 + | N4 + | N5 + | N6 + | N7 + | N8 + | N9 -type alias Sudoku = List (List Entry) +type alias Sudoku = + List (List Entry) -type alias Model = Sudoku +type alias Model = + Sudoku init : Model -init = repeat 9 (repeat 9 EMPTY) +init = + repeat 9 (repeat 9 EMPTY) + + -- Update -type Msg = Increment | Decrement -update: Msg -> Model -> Model -update msg model = model +type Msg + = Increment + | Decrement + + +update : Msg -> Model -> Model +update msg model = + model + + -- View + view : Model -> Html Msg view model = - div [] [gen_sudoku model] + div [] [ gen_sudoku model ] gen_sudoku : Model -> Html Msg -gen_sudoku model = table [] (map gen_row model) +gen_sudoku model = + table [] (map gen_row model) + gen_row : List Entry -> Html Msg gen_row row = - tr [] (map gen_entry row) + tr [] (map gen_entry row) + + +gen_entry : Entry -> Html Msg +gen_entry entry = + td [] [ text (show entry) ] + + +show : Entry -> String +show e = + case e of + EMPTY -> + " " + + N1 -> + "1" + + N2 -> + "2" + + N3 -> + "2" + + N4 -> + "2" + + N5 -> + "2" + + N6 -> + "2" + + N7 -> + "2" + + N8 -> + "2" -gen_entry: Entry -> Html Msg -gen_entry entry = td [] [text "Entry"] + N9 -> + "9" -- GitLab From 289627f563023b85745baf4d8e4f594f0ec297c9 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 12 Apr 2019 16:06:45 +0200 Subject: [PATCH 07/82] drop down and row alias --- elm-examples/sudoku/src/Main.elm | 41 ++++++++++++++++++++------------ 1 file changed, 26 insertions(+), 15 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 975385d..c9133be 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -1,8 +1,11 @@ module Main exposing (main) import Browser -import Html exposing (Html, div, table, td, text, tr) -import List exposing (map, repeat) +import Html exposing (Html,Attribute, div, text, table, tr, td, input, select, option) + +import Html.Attributes exposing (style) + +import List exposing (map,repeat, map2, range) main = @@ -25,13 +28,16 @@ type Entry | N8 | N9 +all_options = [EMPTY,N1,N2,N3,N4,N5,N6,N7,N8,N9] + + +type alias Row = List Entry + +type alias Sudoku = List (Row) -type alias Sudoku = - List (List Entry) +type alias Model = Sudoku -type alias Model = - Sudoku init : Model @@ -61,20 +67,25 @@ view : Model -> Html Msg view model = div [] [ gen_sudoku model ] +zip : List a -> List b -> List (a,b) +zip a b = map2 simple a b + +simple a b = (a,b) -gen_sudoku : Model -> Html Msg -gen_sudoku model = - table [] (map gen_row model) -gen_row : List Entry -> Html Msg -gen_row row = - tr [] (map gen_entry row) +gen_sudoku : Model -> Html Msg +gen_sudoku model = table [style "border" "1px solid black"] (map gen_row (zip (range 1 9) model)) + +gen_row : (Int, Row)-> Html Msg +gen_row (index, row) = + tr [] (map (gen_entry index) (zip (range 1 9) row)) +gen_entry: Int -> (Int, Entry) -> Html Msg +gen_entry row (collumn, entry) = td [] [select [] (map gen_option all_options)] -gen_entry : Entry -> Html Msg -gen_entry entry = - td [] [ text (show entry) ] +gen_option: Entry -> Html Msg +gen_option entry = option [] [text (show entry)] show : Entry -> String -- GitLab From 1ebdd5cde062548355afba9aedb26b2e3add036b Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Fri, 12 Apr 2019 16:12:55 +0200 Subject: [PATCH 08/82] correct numbers --- elm-examples/sudoku/src/Main.elm | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 975385d..5d012df 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -90,22 +90,22 @@ show e = "2" N3 -> - "2" + "3" N4 -> - "2" + "4" N5 -> - "2" + "5" N6 -> - "2" + "6" N7 -> - "2" + "7" N8 -> - "2" + "8" N9 -> "9" -- GitLab From ac9c7d2163d704b8e30d1eb187506f637142ab22 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Mon, 15 Apr 2019 09:34:50 +0200 Subject: [PATCH 09/82] selected and onClick --- elm-examples/sudoku/src/Main.elm | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 708ddc4..5737a8c 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -3,7 +3,8 @@ module Main exposing (main) import Browser import Html exposing (Html,Attribute, div, text, table, tr, td, input, select, option) -import Html.Attributes exposing (style) +import Html.Attributes exposing (style,selected) +import Html.Events exposing (onClick) import List exposing (map,repeat, map2, range) @@ -37,6 +38,8 @@ type alias Sudoku = List (Row) type alias Model = Sudoku +type alias Position = (Int,Int) + @@ -50,8 +53,7 @@ init = type Msg - = Increment - | Decrement + = Msg Position Entry update : Msg -> Model -> Model @@ -79,13 +81,13 @@ gen_sudoku model = table [style "border" "1px solid black"] (map gen_row (zip (r gen_row : (Int, Row)-> Html Msg gen_row (index, row) = - tr [] (map (gen_entry index) (zip (range 1 9) row)) + tr [] (map gen_entry (zip (zip (repeat 9 index) (range 1 9)) row)) -gen_entry: Int -> (Int, Entry) -> Html Msg -gen_entry row (collumn, entry) = td [] [select [] (map gen_option all_options)] +gen_entry: (Position, Entry) -> Html Msg +gen_entry (position, entry) = td [] [select [] (map (gen_option position entry) all_options)] -gen_option: Entry -> Html Msg -gen_option entry = option [] [text (show entry)] +gen_option: Position-> Entry -> Entry -> Html Msg +gen_option position select entry = option [selected (select==entry), onClick (Msg position entry)] [text (show entry)] show : Entry -> String -- GitLab From c5ef7b1d0d9dbcfaee8dc25e7169c8ce0a1efc3b Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Mon, 15 Apr 2019 10:24:11 +0200 Subject: [PATCH 10/82] check list for duplicates and incomplete get_area_list --- elm-examples/sudoku/src/Main.elm | 77 +++++++++++++++++++++++--------- 1 file changed, 56 insertions(+), 21 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 5737a8c..0b173cd 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -1,12 +1,10 @@ module Main exposing (main) import Browser -import Html exposing (Html,Attribute, div, text, table, tr, td, input, select, option) - -import Html.Attributes exposing (style,selected) +import Html exposing (Attribute, Html, div, input, option, select, table, td, text, tr) +import Html.Attributes exposing (selected, style) import Html.Events exposing (onClick) - -import List exposing (map,repeat, map2, range) +import List exposing (drop, map, map2, member, range, repeat, take) main = @@ -29,18 +27,25 @@ type Entry | N8 | N9 -all_options = [EMPTY,N1,N2,N3,N4,N5,N6,N7,N8,N9] +all_options = + [ EMPTY, N1, N2, N3, N4, N5, N6, N7, N8, N9 ] + + +type alias Row = + List Entry -type alias Row = List Entry -type alias Sudoku = List (Row) +type alias Sudoku = + List Row -type alias Model = Sudoku -type alias Position = (Int,Int) +type alias Model = + Sudoku +type alias Position = + ( Int, Int ) init : Model @@ -61,6 +66,27 @@ update msg model = model +validate_list : List (Maybe Entry) -> Bool +validate_list l = + case l of + [] -> + False + + Nothing :: tail -> + validate_list tail + + m :: tail -> + member m tail && validate_list tail + + +get_area_list : Sudoku -> Position -> List (List Entry) +get_area_list s ( r, c ) = + map (drop (r * 3)) + (take 3 + (drop (c * 3) s) + ) + + -- View @@ -69,25 +95,34 @@ view : Model -> Html Msg view model = div [] [ gen_sudoku model ] -zip : List a -> List b -> List (a,b) -zip a b = map2 simple a b -simple a b = (a,b) +zip : List a -> List b -> List ( a, b ) +zip a b = + map2 simple a b + +simple a b = + ( a, b ) gen_sudoku : Model -> Html Msg -gen_sudoku model = table [style "border" "1px solid black"] (map gen_row (zip (range 1 9) model)) +gen_sudoku model = + table [ style "border" "1px solid black" ] (map gen_row (zip (range 1 9) model)) + + +gen_row : ( Int, Row ) -> Html Msg +gen_row ( index, row ) = + tr [] (map gen_entry (zip (zip (repeat 9 index) (range 1 9)) row)) + -gen_row : (Int, Row)-> Html Msg -gen_row (index, row) = - tr [] (map gen_entry (zip (zip (repeat 9 index) (range 1 9)) row)) +gen_entry : ( Position, Entry ) -> Html Msg +gen_entry ( position, entry ) = + td [] [ select [] (map (gen_option position entry) all_options) ] -gen_entry: (Position, Entry) -> Html Msg -gen_entry (position, entry) = td [] [select [] (map (gen_option position entry) all_options)] -gen_option: Position-> Entry -> Entry -> Html Msg -gen_option position select entry = option [selected (select==entry), onClick (Msg position entry)] [text (show entry)] +gen_option : Position -> Entry -> Entry -> Html Msg +gen_option position select entry = + option [ selected (select == entry), onClick (Msg position entry) ] [ text (show entry) ] show : Entry -> String -- GitLab From 6a0408cc83935c5576f10ce6d59173f34ac53c5e Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Mon, 15 Apr 2019 10:23:08 +0200 Subject: [PATCH 11/82] added extract column and extract row --- elm-examples/sudoku/src/Main.elm | 45 ++++++++++++++++++++------------ 1 file changed, 29 insertions(+), 16 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 0b173cd..aab90b8 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -27,30 +27,23 @@ type Entry | N8 | N9 +all_options = [EMPTY,N1,N2,N3,N4,N5,N6,N7,N8,N9] -all_options = - [ EMPTY, N1, N2, N3, N4, N5, N6, N7, N8, N9 ] +type alias Row = List Entry -type alias Row = - List Entry +type alias Sudoku = List (Row) +type alias Model = (Sudoku, String) -type alias Sudoku = - List Row +type alias Position = (Int,Int) -type alias Model = - Sudoku - - -type alias Position = - ( Int, Int ) init : Model init = - repeat 9 (repeat 9 EMPTY) + (repeat 9 (repeat 9 EMPTY), "Empty") @@ -87,13 +80,33 @@ get_area_list s ( r, c ) = ) + +extract_rows: Sudoku -> List (List Entry) +extract_rows sudoku = sudoku + +extract_columns: Sudoku -> List (List Entry) +extract_columns = transpose + + +transpose: List (List a) -> List (List a) +transpose list = case list of + [] -> [] + x::xs -> map (nth_column list) (range 0 ((List.length x) - 1)) + +nth_column: List (List a) -> Int -> List a +nth_column list index = List.filterMap (element index) list + +element : Int -> List a -> Maybe a +element index list = case List.take 1 (List.drop (index - 1) list) of + [] -> Nothing + x::_ -> Just x -- View view : Model -> Html Msg -view model = - div [] [ gen_sudoku model ] +view (sudoku, msg) = + div [] [ gen_sudoku sudoku , text msg] zip : List a -> List b -> List ( a, b ) @@ -105,7 +118,7 @@ simple a b = ( a, b ) -gen_sudoku : Model -> Html Msg +gen_sudoku : Sudoku-> Html Msg gen_sudoku model = table [ style "border" "1px solid black" ] (map gen_row (zip (range 1 9) model)) -- GitLab From 2938e8dbed0be554e4d012fabb03004ea7779654 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Mon, 15 Apr 2019 10:39:40 +0200 Subject: [PATCH 12/82] added validate function --- elm-examples/sudoku/src/Main.elm | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index aab90b8..e017c62 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -59,7 +59,13 @@ update msg model = model -validate_list : List (Maybe Entry) -> Bool +validate_sudoku: Sudoku -> Bool +validate_sudoku sudoku = List.foldl (&&) True (map (validate_feature sudoku) [extract_rows, extract_columns]) + +validate_feature: Sudoku -> (Sudoku -> List (List Entry)) -> Bool +validate_feature sudoku extractor = List.foldr (&&) True (map validate_list (extractor sudoku)) + +validate_list : List Entry -> Bool validate_list l = case l of [] -> -- GitLab From 6c42579bd8f106fc582765ba89e84f772db352f1 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Mon, 15 Apr 2019 10:51:36 +0200 Subject: [PATCH 13/82] function to get a list of area lists (area = 3x3; sudoku = 9x9) --- elm-examples/sudoku/src/Main.elm | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 0b173cd..04496fd 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -4,7 +4,7 @@ import Browser import Html exposing (Attribute, Html, div, input, option, select, table, td, text, tr) import Html.Attributes exposing (selected, style) import Html.Events exposing (onClick) -import List exposing (drop, map, map2, member, range, repeat, take) +import List exposing (drop, foldr, map, map2, member, range, repeat, take) main = @@ -79,14 +79,26 @@ validate_list l = member m tail && validate_list tail -get_area_list : Sudoku -> Position -> List (List Entry) -get_area_list s ( r, c ) = - map (drop (r * 3)) - (take 3 - (drop (c * 3) s) +get_area_lists : Sudoku -> List (List Entry) +get_area_lists sudoku = + map + (get_area_list sudoku) + (map + (\n -> ( n // 3, remainderBy 3 n )) + (range 0 8) ) +td3 : Int -> List a -> List a +td3 n list = + take 3 (drop (n * 3) list) + + +get_area_list : Sudoku -> Position -> List Entry +get_area_list s ( r, c ) = + foldr append [] (td3 c (td3 r s)) + + -- View @@ -107,12 +119,12 @@ simple a b = gen_sudoku : Model -> Html Msg gen_sudoku model = - table [ style "border" "1px solid black" ] (map gen_row (zip (range 1 9) model)) + table [ style "border" "1px solid black" ] (map gen_row (zip (range 0 8) model)) gen_row : ( Int, Row ) -> Html Msg gen_row ( index, row ) = - tr [] (map gen_entry (zip (zip (repeat 9 index) (range 1 9)) row)) + tr [] (map gen_entry (zip (zip (repeat 9 index) (range 0 8)) row)) gen_entry : ( Position, Entry ) -> Html Msg -- GitLab From 67677adfcffe04af2bc1b88a057a87f41349fc49 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Mon, 15 Apr 2019 10:59:19 +0200 Subject: [PATCH 14/82] started to work on update --- elm-examples/sudoku/src/Main.elm | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index e017c62..6ff5261 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -55,9 +55,16 @@ type Msg update : Msg -> Model -> Model -update msg model = - model +update (Msg position entry) (sudoku, text) = (update sudoku position entry, text) +exchange_entry: List a -> Int -> a -> List a +exchange_entry list index replacement = (take (index - 1) list) ++ [replacement] ++ (drop index list) + +update_sudoku: Sudoku -> Position -> Entry -> Sudoku +update_sudoku sudoku (row, column) entry = exchange_entry sudoku row (update_sudoku_row (List.head (drop (row - 1) sudoku)) column entry) + +update_sudoku_row: Maybe Row -> Int -> Entry-> Row +update_sudoku_row row = exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) validate_sudoku: Sudoku -> Bool validate_sudoku sudoku = List.foldl (&&) True (map (validate_feature sudoku) [extract_rows, extract_columns]) -- GitLab From 26132841fd5b5dccfed8c3097eb4039b8d970fca Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Mon, 15 Apr 2019 11:20:49 +0200 Subject: [PATCH 15/82] fix update and missing import --- elm-examples/sudoku/src/Main.elm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index a19166f..244b49e 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -4,7 +4,7 @@ import Browser import Html exposing (Attribute, Html, div, input, option, select, table, td, text, tr) import Html.Attributes exposing (selected, style) import Html.Events exposing (onClick) -import List exposing (drop, foldr, map, map2, member, range, repeat, take) +import List exposing (append, drop, foldr, map, map2, member, range, repeat, take) main = @@ -63,7 +63,7 @@ type Msg update : Msg -> Model -> Model update (Msg position entry) ( sudoku, text ) = - ( update sudoku position entry, text ) + ( update_sudoku sudoku position entry, text ) exchange_entry : List a -> Int -> a -> List a -- GitLab From 99c9ff5856aa4b9e0f4512aa0161b9861ae6e279 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Mon, 15 Apr 2019 19:51:34 +0200 Subject: [PATCH 16/82] can check if the sudoku is solved --- elm-examples/sudoku/src/Main.elm | 75 +++++++++++++++++++++++++++----- 1 file changed, 63 insertions(+), 12 deletions(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 244b49e..90fc9a2 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -1,10 +1,10 @@ module Main exposing (main) import Browser -import Html exposing (Attribute, Html, div, input, option, select, table, td, text, tr) +import Html exposing (Attribute, Html, div, option, select, table, td, text, tr) import Html.Attributes exposing (selected, style) import Html.Events exposing (onClick) -import List exposing (append, drop, foldr, map, map2, member, range, repeat, take) +import List exposing (append, drop, filter, foldr, map, map2, member, range, repeat, take) main = @@ -12,7 +12,7 @@ main = --- Model +-- Model --------------------------------------------------------------------------------------------------------------- type Entry @@ -54,7 +54,7 @@ init = --- Update +-- Update -------------------------------------------------------------------------------------------------------------- type Msg @@ -81,9 +81,40 @@ update_sudoku_row row = exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) +won_sudoku : Sudoku -> Bool +won_sudoku field = + no_emptys_sudoku field && validate_sudoku field + + + +-- checks if all fields are non Empty + + +no_emptys_sudoku : Sudoku -> Bool +no_emptys_sudoku field = + filter has_emptys field == [] + + +has_emptys : List Entry -> Bool +has_emptys list = + case list of + [] -> + False + + EMPTY :: _ -> + True + + _ :: t -> + has_emptys t + + + +-- checks if the entered configuration is valid + + validate_sudoku : Sudoku -> Bool validate_sudoku sudoku = - List.foldl (&&) True (map (validate_feature sudoku) [ extract_rows, extract_columns ]) + List.foldl (&&) True (map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ]) validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool @@ -104,23 +135,35 @@ validate_list l = member m tail && validate_list tail -get_area_lists : Sudoku -> List (List Entry) -get_area_lists sudoku = + +-- Creates a list of area entry lists + + +extract_areas : Sudoku -> List (List Entry) +extract_areas sudoku = map - (get_area_list sudoku) + (extract_area sudoku) (map (\n -> ( n // 3, remainderBy 3 n )) (range 0 8) ) + +-- Drops the first 3*n elements of a list and returns 3 elements of the remainder + + td3 : Int -> List a -> List a td3 n list = take 3 (drop (n * 3) list) -get_area_list : Sudoku -> Position -> List Entry -get_area_list s ( r, c ) = + +-- Returns a list of 9 entries that form the area defined by the position + + +extract_area : Sudoku -> Position -> List Entry +extract_area s ( r, c ) = foldr append [] (td3 c (td3 r s)) @@ -140,15 +183,23 @@ transpose list = [] -> [] - x :: xs -> + x :: _ -> map (nth_column list) (range 0 (List.length x - 1)) + +-- Returns a list of nth elements if they exist + + nth_column : List (List a) -> Int -> List a nth_column list index = List.filterMap (element index) list + +-- Returns the nth element of a list + + element : Int -> List a -> Maybe a element index list = case List.take 1 (List.drop (index - 1) list) of @@ -160,7 +211,7 @@ element index list = --- View +-- View ---------------------------------------------------------------------------------------------------------------- view : Model -> Html Msg -- GitLab From 3eb33b79cf95f20d510d16a4c0d5235d3a07acd8 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Mon, 15 Apr 2019 20:17:18 +0200 Subject: [PATCH 17/82] fixed the off by one bug --- elm-examples/sudoku/src/Main.elm | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 90fc9a2..ab3e374 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -5,6 +5,7 @@ import Html exposing (Attribute, Html, div, option, select, table, td, text, tr) import Html.Attributes exposing (selected, style) import Html.Events exposing (onClick) import List exposing (append, drop, filter, foldr, map, map2, member, range, repeat, take) +import Maybe exposing (withDefault) main = @@ -68,7 +69,7 @@ update (Msg position entry) ( sudoku, text ) = exchange_entry : List a -> Int -> a -> List a exchange_entry list index replacement = - take (index - 1) list ++ [ replacement ] ++ drop index list + take index list ++ [ replacement ] ++ drop (index + 1) list update_sudoku : Sudoku -> Position -> Entry -> Sudoku @@ -81,6 +82,10 @@ update_sudoku_row row = exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) + +-- checks if the sudoku was solved + + won_sudoku : Sudoku -> Bool won_sudoku field = no_emptys_sudoku field && validate_sudoku field -- GitLab From 20f73c9bd2cd319ad5e61bb4cfd817931c1a8d0f Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Mon, 15 Apr 2019 23:16:53 +0200 Subject: [PATCH 18/82] fixed another off by one error --- elm-examples/sudoku/src/Main.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index ab3e374..1f1cb55 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -74,7 +74,7 @@ exchange_entry list index replacement = update_sudoku : Sudoku -> Position -> Entry -> Sudoku update_sudoku sudoku ( row, column ) entry = - exchange_entry sudoku row (update_sudoku_row (List.head (drop (row - 1) sudoku)) column entry) + exchange_entry sudoku row (update_sudoku_row (List.head (drop (row) sudoku)) column entry) update_sudoku_row : Maybe Row -> Int -> Entry -> Row -- GitLab From ee6fa08ed3bb4a669e9520b36bfd011caad8a22c Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Mon, 15 Apr 2019 23:37:39 +0200 Subject: [PATCH 19/82] added comment --- elm-examples/sudoku/src/Main.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 1f1cb55..235c630 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -137,7 +137,7 @@ validate_list l = validate_list tail m :: tail -> - member m tail && validate_list tail + member m tail && validate_list tail -- TODO shouldn't it be: not (member m tail) instead of: member m tail ? -- GitLab From e0ef24c646b8b8760bce11f1f24e7420eac686fb Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Tue, 16 Apr 2019 11:23:27 +0200 Subject: [PATCH 20/82] startet work on genrating sudoku the field --- elm-examples/sudoku/elm.json | 6 +++++- elm-examples/sudoku/src/Main.elm | 29 ++++++++++++++++++++++++++--- 2 files changed, 31 insertions(+), 4 deletions(-) diff --git a/elm-examples/sudoku/elm.json b/elm-examples/sudoku/elm.json index 931813a..02bce13 100644 --- a/elm-examples/sudoku/elm.json +++ b/elm-examples/sudoku/elm.json @@ -8,9 +8,13 @@ "direct": { "elm/browser": "1.0.1", "elm/core": "1.0.2", - "elm/html": "1.0.0" + "elm/html": "1.0.0", + "elm/http": "2.0.0", + "elm/random": "1.0.0" }, "indirect": { + "elm/bytes": "1.0.8", + "elm/file": "1.0.5", "elm/json": "1.1.2", "elm/time": "1.0.0", "elm/url": "1.0.0", diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index 235c630..dc684e3 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -5,7 +5,7 @@ import Html exposing (Attribute, Html, div, option, select, table, td, text, tr) import Html.Attributes exposing (selected, style) import Html.Events exposing (onClick) import List exposing (append, drop, filter, foldr, map, map2, member, range, repeat, take) -import Maybe exposing (withDefault) +import Random exposing (generate) main = @@ -74,7 +74,7 @@ exchange_entry list index replacement = update_sudoku : Sudoku -> Position -> Entry -> Sudoku update_sudoku sudoku ( row, column ) entry = - exchange_entry sudoku row (update_sudoku_row (List.head (drop (row) sudoku)) column entry) + exchange_entry sudoku row (update_sudoku_row (List.head (drop row sudoku)) column entry) update_sudoku_row : Maybe Row -> Int -> Entry -> Row @@ -137,7 +137,7 @@ validate_list l = validate_list tail m :: tail -> - member m tail && validate_list tail -- TODO shouldn't it be: not (member m tail) instead of: member m tail ? + not (member m tail) && validate_list tail @@ -285,3 +285,26 @@ show e = N9 -> "9" + + + +-- Generate Sudoku ----------------------------------------------------------------------------------------------------- + + +create_sudoku : Sudoku +create_sudoku = + [] + + +rnd : Int +rnd = + let + generator = + Random.int 1 9 + + id = + \n -> n + in + case generate id generator of + Cmd.Cmd m -> + m -- GitLab From 3aa096c04f894b54902b567b440f259bb05fb66c Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Tue, 16 Apr 2019 11:32:34 +0200 Subject: [PATCH 21/82] Split Monoltihic Project into seperate files --- elm-examples/sudoku/elm.json | 1 + elm-examples/sudoku/index.html | 1309 +++++++++++++++++++++++++++- elm-examples/sudoku/src/Main.elm | 308 +------ elm-examples/sudoku/src/Model.elm | 33 + elm-examples/sudoku/src/Types.elm | 38 + elm-examples/sudoku/src/Update.elm | 162 ++++ elm-examples/sudoku/src/View.elm | 114 +++ 7 files changed, 1619 insertions(+), 346 deletions(-) create mode 100644 elm-examples/sudoku/src/Model.elm create mode 100644 elm-examples/sudoku/src/Types.elm create mode 100644 elm-examples/sudoku/src/Update.elm create mode 100644 elm-examples/sudoku/src/View.elm diff --git a/elm-examples/sudoku/elm.json b/elm-examples/sudoku/elm.json index 02bce13..f59c1ec 100644 --- a/elm-examples/sudoku/elm.json +++ b/elm-examples/sudoku/elm.json @@ -8,6 +8,7 @@ "direct": { "elm/browser": "1.0.1", "elm/core": "1.0.2", + "elm/json": "1.1.2", "elm/html": "1.0.0", "elm/http": "2.0.0", "elm/random": "1.0.0" diff --git a/elm-examples/sudoku/index.html b/elm-examples/sudoku/index.html index 0405609..2500fb7 100644 --- a/elm-examples/sudoku/index.html +++ b/elm-examples/sudoku/index.html @@ -3879,23 +3879,447 @@ function _VirtualDom_dekey(keyedNode) b: keyedNode.b }; } -var elm$core$Basics$identity = function (x) { - return x; -}; -var elm$core$Basics$False = {$: 'False'}; -var elm$core$Basics$True = {$: 'True'}; -var elm$core$Result$isOk = function (result) { - if (result.$ === 'Ok') { - return true; - } else { - return false; + + + + +// ELEMENT + + +var _Debugger_element; + +var _Browser_element = _Debugger_element || F4(function(impl, flagDecoder, debugMetadata, args) +{ + return _Platform_initialize( + flagDecoder, + args, + impl.init, + impl.update, + impl.subscriptions, + function(sendToApp, initialModel) { + var view = impl.view; + /**_UNUSED/ + var domNode = args['node']; + //*/ + /**/ + var domNode = args && args['node'] ? args['node'] : _Debug_crash(0); + //*/ + var currNode = _VirtualDom_virtualize(domNode); + + return _Browser_makeAnimator(initialModel, function(model) + { + var nextNode = view(model); + var patches = _VirtualDom_diff(currNode, nextNode); + domNode = _VirtualDom_applyPatches(domNode, currNode, patches, sendToApp); + currNode = nextNode; + }); + } + ); +}); + + + +// DOCUMENT + + +var _Debugger_document; + +var _Browser_document = _Debugger_document || F4(function(impl, flagDecoder, debugMetadata, args) +{ + return _Platform_initialize( + flagDecoder, + args, + impl.init, + impl.update, + impl.subscriptions, + function(sendToApp, initialModel) { + var divertHrefToApp = impl.setup && impl.setup(sendToApp) + var view = impl.view; + var title = _VirtualDom_doc.title; + var bodyNode = _VirtualDom_doc.body; + var currNode = _VirtualDom_virtualize(bodyNode); + return _Browser_makeAnimator(initialModel, function(model) + { + _VirtualDom_divertHrefToApp = divertHrefToApp; + var doc = view(model); + var nextNode = _VirtualDom_node('body')(_List_Nil)(doc.body); + var patches = _VirtualDom_diff(currNode, nextNode); + bodyNode = _VirtualDom_applyPatches(bodyNode, currNode, patches, sendToApp); + currNode = nextNode; + _VirtualDom_divertHrefToApp = 0; + (title !== doc.title) && (_VirtualDom_doc.title = title = doc.title); + }); + } + ); +}); + + + +// ANIMATION + + +var _Browser_cancelAnimationFrame = + typeof cancelAnimationFrame !== 'undefined' + ? cancelAnimationFrame + : function(id) { clearTimeout(id); }; + +var _Browser_requestAnimationFrame = + typeof requestAnimationFrame !== 'undefined' + ? requestAnimationFrame + : function(callback) { return setTimeout(callback, 1000 / 60); }; + + +function _Browser_makeAnimator(model, draw) +{ + draw(model); + + var state = 0; + + function updateIfNeeded() + { + state = state === 1 + ? 0 + : ( _Browser_requestAnimationFrame(updateIfNeeded), draw(model), 1 ); } -}; -var elm$core$Array$branchFactor = 32; -var elm$core$Array$Array_elm_builtin = F4( - function (a, b, c, d) { - return {$: 'Array_elm_builtin', a: a, b: b, c: c, d: d}; + + return function(nextModel, isSync) + { + model = nextModel; + + isSync + ? ( draw(model), + state === 2 && (state = 1) + ) + : ( state === 0 && _Browser_requestAnimationFrame(updateIfNeeded), + state = 2 + ); + }; +} + + + +// APPLICATION + + +function _Browser_application(impl) +{ + var onUrlChange = impl.onUrlChange; + var onUrlRequest = impl.onUrlRequest; + var key = function() { key.a(onUrlChange(_Browser_getUrl())); }; + + return _Browser_document({ + setup: function(sendToApp) + { + key.a = sendToApp; + _Browser_window.addEventListener('popstate', key); + _Browser_window.navigator.userAgent.indexOf('Trident') < 0 || _Browser_window.addEventListener('hashchange', key); + + return F2(function(domNode, event) + { + if (!event.ctrlKey && !event.metaKey && !event.shiftKey && event.button < 1 && !domNode.target && !domNode.hasAttribute('download')) + { + event.preventDefault(); + var href = domNode.href; + var curr = _Browser_getUrl(); + var next = elm$url$Url$fromString(href).a; + sendToApp(onUrlRequest( + (next + && curr.protocol === next.protocol + && curr.host === next.host + && curr.port_.a === next.port_.a + ) + ? elm$browser$Browser$Internal(next) + : elm$browser$Browser$External(href) + )); + } + }); + }, + init: function(flags) + { + return A3(impl.init, flags, _Browser_getUrl(), key); + }, + view: impl.view, + update: impl.update, + subscriptions: impl.subscriptions }); +} + +function _Browser_getUrl() +{ + return elm$url$Url$fromString(_VirtualDom_doc.location.href).a || _Debug_crash(1); +} + +var _Browser_go = F2(function(key, n) +{ + return A2(elm$core$Task$perform, elm$core$Basics$never, _Scheduler_binding(function() { + n && history.go(n); + key(); + })); +}); + +var _Browser_pushUrl = F2(function(key, url) +{ + return A2(elm$core$Task$perform, elm$core$Basics$never, _Scheduler_binding(function() { + history.pushState({}, '', url); + key(); + })); +}); + +var _Browser_replaceUrl = F2(function(key, url) +{ + return A2(elm$core$Task$perform, elm$core$Basics$never, _Scheduler_binding(function() { + history.replaceState({}, '', url); + key(); + })); +}); + + + +// GLOBAL EVENTS + + +var _Browser_fakeNode = { addEventListener: function() {}, removeEventListener: function() {} }; +var _Browser_doc = typeof document !== 'undefined' ? document : _Browser_fakeNode; +var _Browser_window = typeof window !== 'undefined' ? window : _Browser_fakeNode; + +var _Browser_on = F3(function(node, eventName, sendToSelf) +{ + return _Scheduler_spawn(_Scheduler_binding(function(callback) + { + function handler(event) { _Scheduler_rawSpawn(sendToSelf(event)); } + node.addEventListener(eventName, handler, _VirtualDom_passiveSupported && { passive: true }); + return function() { node.removeEventListener(eventName, handler); }; + })); +}); + +var _Browser_decodeEvent = F2(function(decoder, event) +{ + var result = _Json_runHelp(decoder, event); + return elm$core$Result$isOk(result) ? elm$core$Maybe$Just(result.a) : elm$core$Maybe$Nothing; +}); + + + +// PAGE VISIBILITY + + +function _Browser_visibilityInfo() +{ + return (typeof _VirtualDom_doc.hidden !== 'undefined') + ? { hidden: 'hidden', change: 'visibilitychange' } + : + (typeof _VirtualDom_doc.mozHidden !== 'undefined') + ? { hidden: 'mozHidden', change: 'mozvisibilitychange' } + : + (typeof _VirtualDom_doc.msHidden !== 'undefined') + ? { hidden: 'msHidden', change: 'msvisibilitychange' } + : + (typeof _VirtualDom_doc.webkitHidden !== 'undefined') + ? { hidden: 'webkitHidden', change: 'webkitvisibilitychange' } + : { hidden: 'hidden', change: 'visibilitychange' }; +} + + + +// ANIMATION FRAMES + + +function _Browser_rAF() +{ + return _Scheduler_binding(function(callback) + { + var id = _Browser_requestAnimationFrame(function() { + callback(_Scheduler_succeed(Date.now())); + }); + + return function() { + _Browser_cancelAnimationFrame(id); + }; + }); +} + + +function _Browser_now() +{ + return _Scheduler_binding(function(callback) + { + callback(_Scheduler_succeed(Date.now())); + }); +} + + + +// DOM STUFF + + +function _Browser_withNode(id, doStuff) +{ + return _Scheduler_binding(function(callback) + { + _Browser_requestAnimationFrame(function() { + var node = document.getElementById(id); + callback(node + ? _Scheduler_succeed(doStuff(node)) + : _Scheduler_fail(elm$browser$Browser$Dom$NotFound(id)) + ); + }); + }); +} + + +function _Browser_withWindow(doStuff) +{ + return _Scheduler_binding(function(callback) + { + _Browser_requestAnimationFrame(function() { + callback(_Scheduler_succeed(doStuff())); + }); + }); +} + + +// FOCUS and BLUR + + +var _Browser_call = F2(function(functionName, id) +{ + return _Browser_withNode(id, function(node) { + node[functionName](); + return _Utils_Tuple0; + }); +}); + + + +// WINDOW VIEWPORT + + +function _Browser_getViewport() +{ + return { + scene: _Browser_getScene(), + viewport: { + x: _Browser_window.pageXOffset, + y: _Browser_window.pageYOffset, + width: _Browser_doc.documentElement.clientWidth, + height: _Browser_doc.documentElement.clientHeight + } + }; +} + +function _Browser_getScene() +{ + var body = _Browser_doc.body; + var elem = _Browser_doc.documentElement; + return { + width: Math.max(body.scrollWidth, body.offsetWidth, elem.scrollWidth, elem.offsetWidth, elem.clientWidth), + height: Math.max(body.scrollHeight, body.offsetHeight, elem.scrollHeight, elem.offsetHeight, elem.clientHeight) + }; +} + +var _Browser_setViewport = F2(function(x, y) +{ + return _Browser_withWindow(function() + { + _Browser_window.scroll(x, y); + return _Utils_Tuple0; + }); +}); + + + +// ELEMENT VIEWPORT + + +function _Browser_getViewportOf(id) +{ + return _Browser_withNode(id, function(node) + { + return { + scene: { + width: node.scrollWidth, + height: node.scrollHeight + }, + viewport: { + x: node.scrollLeft, + y: node.scrollTop, + width: node.clientWidth, + height: node.clientHeight + } + }; + }); +} + + +var _Browser_setViewportOf = F3(function(id, x, y) +{ + return _Browser_withNode(id, function(node) + { + node.scrollLeft = x; + node.scrollTop = y; + return _Utils_Tuple0; + }); +}); + + + +// ELEMENT + + +function _Browser_getElement(id) +{ + return _Browser_withNode(id, function(node) + { + var rect = node.getBoundingClientRect(); + var x = _Browser_window.pageXOffset; + var y = _Browser_window.pageYOffset; + return { + scene: _Browser_getScene(), + viewport: { + x: x, + y: y, + width: _Browser_doc.documentElement.clientWidth, + height: _Browser_doc.documentElement.clientHeight + }, + element: { + x: x + rect.left, + y: y + rect.top, + width: rect.width, + height: rect.height + } + }; + }); +} + + + +// LOAD and RELOAD + + +function _Browser_reload(skipCache) +{ + return A2(elm$core$Task$perform, elm$core$Basics$never, _Scheduler_binding(function(callback) + { + _VirtualDom_doc.location.reload(skipCache); + })); +} + +function _Browser_load(url) +{ + return A2(elm$core$Task$perform, elm$core$Basics$never, _Scheduler_binding(function(callback) + { + try + { + _Browser_window.location = url; + } + catch(err) + { + // Only Firefox can throw a NS_ERROR_MALFORMED_URI exception here. + // Other browsers reload the page, so let's be consistent about that. + _VirtualDom_doc.location.reload(false); + } + })); +} var elm$core$Basics$EQ = {$: 'EQ'}; var elm$core$Basics$GT = {$: 'GT'}; var elm$core$Basics$LT = {$: 'LT'}; @@ -3976,24 +4400,32 @@ var elm$core$Array$foldr = F3( var elm$core$Array$toList = function (array) { return A3(elm$core$Array$foldr, elm$core$List$cons, _List_Nil, array); }; -var elm$core$Basics$ceiling = _Basics_ceiling; -var elm$core$Basics$fdiv = _Basics_fdiv; -var elm$core$Basics$logBase = F2( - function (base, number) { - return _Basics_log(number) / _Basics_log(base); +var elm$core$Basics$add = _Basics_add; +var elm$core$Basics$append = _Utils_append; +var elm$core$Basics$le = _Utils_le; +var elm$core$Basics$sub = _Basics_sub; +var elm$core$List$drop = F2( + function (n, list) { + drop: + while (true) { + if (n <= 0) { + return list; + } else { + if (!list.b) { + return list; + } else { + var x = list.a; + var xs = list.b; + var $temp$n = n - 1, + $temp$list = xs; + n = $temp$n; + list = $temp$list; + continue drop; + } + } + } }); -var elm$core$Basics$toFloat = _Basics_toFloat; -var elm$core$Array$shiftStep = elm$core$Basics$ceiling( - A2(elm$core$Basics$logBase, 2, elm$core$Array$branchFactor)); -var elm$core$Elm$JsArray$empty = _JsArray_empty; -var elm$core$Array$empty = A4(elm$core$Array$Array_elm_builtin, 0, elm$core$Array$shiftStep, elm$core$Elm$JsArray$empty, elm$core$Elm$JsArray$empty); -var elm$core$Array$Leaf = function (a) { - return {$: 'Leaf', a: a}; -}; -var elm$core$Array$SubTree = function (a) { - return {$: 'SubTree', a: a}; -}; -var elm$core$Elm$JsArray$initializeFromList = _JsArray_initializeFromList; +var elm$core$Basics$gt = _Utils_gt; var elm$core$List$foldl = F3( function (func, acc, list) { foldl: @@ -4016,6 +4448,329 @@ var elm$core$List$foldl = F3( var elm$core$List$reverse = function (list) { return A3(elm$core$List$foldl, elm$core$List$cons, _List_Nil, list); }; +var elm$core$List$takeReverse = F3( + function (n, list, kept) { + takeReverse: + while (true) { + if (n <= 0) { + return kept; + } else { + if (!list.b) { + return kept; + } else { + var x = list.a; + var xs = list.b; + var $temp$n = n - 1, + $temp$list = xs, + $temp$kept = A2(elm$core$List$cons, x, kept); + n = $temp$n; + list = $temp$list; + kept = $temp$kept; + continue takeReverse; + } + } + } + }); +var elm$core$List$takeTailRec = F2( + function (n, list) { + return elm$core$List$reverse( + A3(elm$core$List$takeReverse, n, list, _List_Nil)); + }); +var elm$core$List$takeFast = F3( + function (ctr, n, list) { + if (n <= 0) { + return _List_Nil; + } else { + var _n0 = _Utils_Tuple2(n, list); + _n0$1: + while (true) { + _n0$5: + while (true) { + if (!_n0.b.b) { + return list; + } else { + if (_n0.b.b.b) { + switch (_n0.a) { + case 1: + break _n0$1; + case 2: + var _n2 = _n0.b; + var x = _n2.a; + var _n3 = _n2.b; + var y = _n3.a; + return _List_fromArray( + [x, y]); + case 3: + if (_n0.b.b.b.b) { + var _n4 = _n0.b; + var x = _n4.a; + var _n5 = _n4.b; + var y = _n5.a; + var _n6 = _n5.b; + var z = _n6.a; + return _List_fromArray( + [x, y, z]); + } else { + break _n0$5; + } + default: + if (_n0.b.b.b.b && _n0.b.b.b.b.b) { + var _n7 = _n0.b; + var x = _n7.a; + var _n8 = _n7.b; + var y = _n8.a; + var _n9 = _n8.b; + var z = _n9.a; + var _n10 = _n9.b; + var w = _n10.a; + var tl = _n10.b; + return (ctr > 1000) ? A2( + elm$core$List$cons, + x, + A2( + elm$core$List$cons, + y, + A2( + elm$core$List$cons, + z, + A2( + elm$core$List$cons, + w, + A2(elm$core$List$takeTailRec, n - 4, tl))))) : A2( + elm$core$List$cons, + x, + A2( + elm$core$List$cons, + y, + A2( + elm$core$List$cons, + z, + A2( + elm$core$List$cons, + w, + A3(elm$core$List$takeFast, ctr + 1, n - 4, tl))))); + } else { + break _n0$5; + } + } + } else { + if (_n0.a === 1) { + break _n0$1; + } else { + break _n0$5; + } + } + } + } + return list; + } + var _n1 = _n0.b; + var x = _n1.a; + return _List_fromArray( + [x]); + } + }); +var elm$core$List$take = F2( + function (n, list) { + return A3(elm$core$List$takeFast, 0, n, list); + }); +var author$project$Main$exchange_entry = F3( + function (list, index, replacement) { + return _Utils_ap( + A2(elm$core$List$take, index, list), + _Utils_ap( + _List_fromArray( + [replacement]), + A2(elm$core$List$drop, index + 1, list))); + }); +var author$project$Types$EMPTY = {$: 'EMPTY'}; +var elm$core$List$repeatHelp = F3( + function (result, n, value) { + repeatHelp: + while (true) { + if (n <= 0) { + return result; + } else { + var $temp$result = A2(elm$core$List$cons, value, result), + $temp$n = n - 1, + $temp$value = value; + result = $temp$result; + n = $temp$n; + value = $temp$value; + continue repeatHelp; + } + } + }); +var elm$core$List$repeat = F2( + function (n, value) { + return A3(elm$core$List$repeatHelp, _List_Nil, n, value); + }); +var elm$core$Maybe$withDefault = F2( + function (_default, maybe) { + if (maybe.$ === 'Just') { + var value = maybe.a; + return value; + } else { + return _default; + } + }); +var author$project$Main$update_sudoku_row = function (row) { + return author$project$Main$exchange_entry( + A2( + elm$core$Maybe$withDefault, + A2(elm$core$List$repeat, 9, author$project$Types$EMPTY), + row)); +}; +var elm$core$Maybe$Just = function (a) { + return {$: 'Just', a: a}; +}; +var elm$core$Maybe$Nothing = {$: 'Nothing'}; +var elm$core$List$head = function (list) { + if (list.b) { + var x = list.a; + var xs = list.b; + return elm$core$Maybe$Just(x); + } else { + return elm$core$Maybe$Nothing; + } +}; +var author$project$Main$update_sudoku = F3( + function (sudoku, _n0, entry) { + var row = _n0.a; + var column = _n0.b; + return A3( + author$project$Main$exchange_entry, + sudoku, + row, + A3( + author$project$Main$update_sudoku_row, + elm$core$List$head( + A2(elm$core$List$drop, row, sudoku)), + column, + entry)); + }); +var author$project$Main$update = F2( + function (_n0, _n1) { + var position = _n0.a; + var entry = _n0.b; + var sudoku = _n1.a; + var text = _n1.b; + return _Utils_Tuple2( + A3(author$project$Main$update_sudoku, sudoku, position, entry), + text); + }); +var author$project$Model$init = _Utils_Tuple2( + A2( + elm$core$List$repeat, + 9, + A2(elm$core$List$repeat, 9, author$project$Types$EMPTY)), + 'Empty'); +var author$project$Types$N1 = {$: 'N1'}; +var author$project$Types$N2 = {$: 'N2'}; +var author$project$Types$N3 = {$: 'N3'}; +var author$project$Types$N4 = {$: 'N4'}; +var author$project$Types$N5 = {$: 'N5'}; +var author$project$Types$N6 = {$: 'N6'}; +var author$project$Types$N7 = {$: 'N7'}; +var author$project$Types$N8 = {$: 'N8'}; +var author$project$Types$N9 = {$: 'N9'}; +var author$project$Types$all_options = _List_fromArray( + [author$project$Types$EMPTY, author$project$Types$N1, author$project$Types$N2, author$project$Types$N3, author$project$Types$N4, author$project$Types$N5, author$project$Types$N6, author$project$Types$N7, author$project$Types$N8, author$project$Types$N9]); +var author$project$Types$Msg = F2( + function (a, b) { + return {$: 'Msg', a: a, b: b}; + }); +var author$project$View$parse = function (e) { + switch (e) { + case '1': + return author$project$Types$N1; + case '2': + return author$project$Types$N2; + case '3': + return author$project$Types$N3; + case '4': + return author$project$Types$N4; + case '5': + return author$project$Types$N5; + case '6': + return author$project$Types$N6; + case '7': + return author$project$Types$N7; + case '8': + return author$project$Types$N8; + case '9': + return author$project$Types$N9; + default: + return author$project$Types$EMPTY; + } +}; +var author$project$View$conv_to_msg = F2( + function (pos, a) { + return A2( + author$project$Types$Msg, + pos, + author$project$View$parse(a)); + }); +var author$project$View$show = function (e) { + switch (e.$) { + case 'EMPTY': + return ' '; + case 'N1': + return '1'; + case 'N2': + return '2'; + case 'N3': + return '3'; + case 'N4': + return '4'; + case 'N5': + return '5'; + case 'N6': + return '6'; + case 'N7': + return '7'; + case 'N8': + return '8'; + default: + return '9'; + } +}; +var elm$core$Basics$eq = _Utils_equal; +var elm$core$Basics$identity = function (x) { + return x; +}; +var elm$core$Basics$False = {$: 'False'}; +var elm$core$Basics$True = {$: 'True'}; +var elm$core$Result$isOk = function (result) { + if (result.$ === 'Ok') { + return true; + } else { + return false; + } +}; +var elm$core$Array$branchFactor = 32; +var elm$core$Array$Array_elm_builtin = F4( + function (a, b, c, d) { + return {$: 'Array_elm_builtin', a: a, b: b, c: c, d: d}; + }); +var elm$core$Basics$ceiling = _Basics_ceiling; +var elm$core$Basics$fdiv = _Basics_fdiv; +var elm$core$Basics$logBase = F2( + function (base, number) { + return _Basics_log(number) / _Basics_log(base); + }); +var elm$core$Basics$toFloat = _Basics_toFloat; +var elm$core$Array$shiftStep = elm$core$Basics$ceiling( + A2(elm$core$Basics$logBase, 2, elm$core$Array$branchFactor)); +var elm$core$Elm$JsArray$empty = _JsArray_empty; +var elm$core$Array$empty = A4(elm$core$Array$Array_elm_builtin, 0, elm$core$Array$shiftStep, elm$core$Elm$JsArray$empty, elm$core$Elm$JsArray$empty); +var elm$core$Array$Leaf = function (a) { + return {$: 'Leaf', a: a}; +}; +var elm$core$Array$SubTree = function (a) { + return {$: 'SubTree', a: a}; +}; +var elm$core$Elm$JsArray$initializeFromList = _JsArray_initializeFromList; var elm$core$Array$compressNodes = F2( function (nodes, acc) { compressNodes: @@ -4042,7 +4797,6 @@ var elm$core$Basics$apR = F2( function (x, f) { return f(x); }); -var elm$core$Basics$eq = _Utils_equal; var elm$core$Tuple$first = function (_n0) { var x = _n0.a; return x; @@ -4063,19 +4817,16 @@ var elm$core$Array$treeFromBuilder = F2( } } }); -var elm$core$Basics$add = _Basics_add; var elm$core$Basics$apL = F2( function (f, x) { return f(x); }); var elm$core$Basics$floor = _Basics_floor; -var elm$core$Basics$gt = _Utils_gt; var elm$core$Basics$max = F2( function (x, y) { return (_Utils_cmp(x, y) > 0) ? x : y; }); var elm$core$Basics$mul = _Basics_mul; -var elm$core$Basics$sub = _Basics_sub; var elm$core$Elm$JsArray$length = _JsArray_length; var elm$core$Array$builderToArray = F2( function (reverseNodeList, builder) { @@ -4129,7 +4880,6 @@ var elm$core$Array$initializeHelp = F5( } } }); -var elm$core$Basics$le = _Utils_le; var elm$core$Basics$remainderBy = _Basics_remainderBy; var elm$core$Array$initialize = F2( function (len, fn) { @@ -4142,10 +4892,6 @@ var elm$core$Array$initialize = F2( return A5(elm$core$Array$initializeHelp, fn, initialFromIndex, len, _List_Nil, tail); } }); -var elm$core$Maybe$Just = function (a) { - return {$: 'Just', a: a}; -}; -var elm$core$Maybe$Nothing = {$: 'Nothing'}; var elm$core$Result$Err = function (a) { return {$: 'Err', a: a}; }; @@ -4168,7 +4914,6 @@ var elm$json$Json$Decode$OneOf = function (a) { return {$: 'OneOf', a: a}; }; var elm$core$Basics$and = _Basics_and; -var elm$core$Basics$append = _Utils_append; var elm$core$Basics$or = _Basics_or; var elm$core$Char$toCode = _Char_toCode; var elm$core$Char$isLower = function (_char) { @@ -4372,10 +5117,486 @@ var elm$virtual_dom$VirtualDom$toHandlerInt = function (handler) { return 3; } }; +var elm$html$Html$option = _VirtualDom_node('option'); var elm$virtual_dom$VirtualDom$text = _VirtualDom_text; var elm$html$Html$text = elm$virtual_dom$VirtualDom$text; -var author$project$Main$main = elm$html$Html$text('hi'); -_Platform_export({'Main':{'init':_VirtualDom_init(author$project$Main$main)(0)(0)}});}(this)); +var elm$json$Json$Encode$bool = _Json_wrap; +var elm$html$Html$Attributes$boolProperty = F2( + function (key, bool) { + return A2( + _VirtualDom_property, + key, + elm$json$Json$Encode$bool(bool)); + }); +var elm$html$Html$Attributes$selected = elm$html$Html$Attributes$boolProperty('selected'); +var elm$virtual_dom$VirtualDom$Normal = function (a) { + return {$: 'Normal', a: a}; +}; +var elm$virtual_dom$VirtualDom$on = _VirtualDom_on; +var elm$html$Html$Events$on = F2( + function (event, decoder) { + return A2( + elm$virtual_dom$VirtualDom$on, + event, + elm$virtual_dom$VirtualDom$Normal(decoder)); + }); +var elm$html$Html$Events$onClick = function (msg) { + return A2( + elm$html$Html$Events$on, + 'click', + elm$json$Json$Decode$succeed(msg)); +}; +var author$project$View$gen_option = F3( + function (position, select, entry) { + return A2( + elm$html$Html$option, + _List_fromArray( + [ + elm$html$Html$Attributes$selected( + _Utils_eq(select, entry)), + elm$html$Html$Events$onClick( + A2(author$project$Types$Msg, position, entry)) + ]), + _List_fromArray( + [ + elm$html$Html$text( + author$project$View$show(entry)) + ])); + }); +var elm$core$List$foldrHelper = F4( + function (fn, acc, ctr, ls) { + if (!ls.b) { + return acc; + } else { + var a = ls.a; + var r1 = ls.b; + if (!r1.b) { + return A2(fn, a, acc); + } else { + var b = r1.a; + var r2 = r1.b; + if (!r2.b) { + return A2( + fn, + a, + A2(fn, b, acc)); + } else { + var c = r2.a; + var r3 = r2.b; + if (!r3.b) { + return A2( + fn, + a, + A2( + fn, + b, + A2(fn, c, acc))); + } else { + var d = r3.a; + var r4 = r3.b; + var res = (ctr > 500) ? A3( + elm$core$List$foldl, + fn, + acc, + elm$core$List$reverse(r4)) : A4(elm$core$List$foldrHelper, fn, acc, ctr + 1, r4); + return A2( + fn, + a, + A2( + fn, + b, + A2( + fn, + c, + A2(fn, d, res)))); + } + } + } + } + }); +var elm$core$List$foldr = F3( + function (fn, acc, ls) { + return A4(elm$core$List$foldrHelper, fn, acc, 0, ls); + }); +var elm$core$List$map = F2( + function (f, xs) { + return A3( + elm$core$List$foldr, + F2( + function (x, acc) { + return A2( + elm$core$List$cons, + f(x), + acc); + }), + _List_Nil, + xs); + }); +var elm$html$Html$select = _VirtualDom_node('select'); +var elm$html$Html$td = _VirtualDom_node('td'); +var elm$html$Html$Events$alwaysStop = function (x) { + return _Utils_Tuple2(x, true); +}; +var elm$virtual_dom$VirtualDom$MayStopPropagation = function (a) { + return {$: 'MayStopPropagation', a: a}; +}; +var elm$html$Html$Events$stopPropagationOn = F2( + function (event, decoder) { + return A2( + elm$virtual_dom$VirtualDom$on, + event, + elm$virtual_dom$VirtualDom$MayStopPropagation(decoder)); + }); +var elm$json$Json$Decode$field = _Json_decodeField; +var elm$json$Json$Decode$at = F2( + function (fields, decoder) { + return A3(elm$core$List$foldr, elm$json$Json$Decode$field, decoder, fields); + }); +var elm$json$Json$Decode$string = _Json_decodeString; +var elm$html$Html$Events$targetValue = A2( + elm$json$Json$Decode$at, + _List_fromArray( + ['target', 'value']), + elm$json$Json$Decode$string); +var elm$html$Html$Events$onInput = function (tagger) { + return A2( + elm$html$Html$Events$stopPropagationOn, + 'input', + A2( + elm$json$Json$Decode$map, + elm$html$Html$Events$alwaysStop, + A2(elm$json$Json$Decode$map, tagger, elm$html$Html$Events$targetValue))); +}; +var author$project$View$gen_entry = function (_n0) { + var position = _n0.a; + var entry = _n0.b; + return A2( + elm$html$Html$td, + _List_Nil, + _List_fromArray( + [ + A2( + elm$html$Html$select, + _List_fromArray( + [ + elm$html$Html$Events$onInput( + author$project$View$conv_to_msg(position)) + ]), + A2( + elm$core$List$map, + A2(author$project$View$gen_option, position, entry), + author$project$Types$all_options)) + ])); +}; +var author$project$View$simple = F2( + function (a, b) { + return _Utils_Tuple2(a, b); + }); +var author$project$View$zip = F2( + function (a, b) { + return A3(elm$core$List$map2, author$project$View$simple, a, b); + }); +var elm$html$Html$tr = _VirtualDom_node('tr'); +var author$project$View$gen_row = function (_n0) { + var index = _n0.a; + var row = _n0.b; + return A2( + elm$html$Html$tr, + _List_Nil, + A2( + elm$core$List$map, + author$project$View$gen_entry, + A2( + author$project$View$zip, + A2( + author$project$View$zip, + A2(elm$core$List$repeat, 9, index), + A2(elm$core$List$range, 0, 8)), + row))); +}; +var elm$html$Html$table = _VirtualDom_node('table'); +var elm$virtual_dom$VirtualDom$style = _VirtualDom_style; +var elm$html$Html$Attributes$style = elm$virtual_dom$VirtualDom$style; +var author$project$View$gen_sudoku = function (model) { + return A2( + elm$html$Html$table, + _List_fromArray( + [ + A2(elm$html$Html$Attributes$style, 'border', '1px solid black') + ]), + A2( + elm$core$List$map, + author$project$View$gen_row, + A2( + author$project$View$zip, + A2(elm$core$List$range, 0, 8), + model))); +}; +var elm$html$Html$div = _VirtualDom_node('div'); +var author$project$View$view = function (_n0) { + var sudoku = _n0.a; + var msg = _n0.b; + return A2( + elm$html$Html$div, + _List_Nil, + _List_fromArray( + [ + author$project$View$gen_sudoku(sudoku), + elm$html$Html$text(msg) + ])); +}; +var elm$core$Platform$Cmd$batch = _Platform_batch; +var elm$core$Platform$Cmd$none = elm$core$Platform$Cmd$batch(_List_Nil); +var elm$core$Platform$Sub$batch = _Platform_batch; +var elm$core$Platform$Sub$none = elm$core$Platform$Sub$batch(_List_Nil); +var elm$browser$Browser$External = function (a) { + return {$: 'External', a: a}; +}; +var elm$browser$Browser$Internal = function (a) { + return {$: 'Internal', a: a}; +}; +var elm$browser$Browser$Dom$NotFound = function (a) { + return {$: 'NotFound', a: a}; +}; +var elm$core$Basics$never = function (_n0) { + never: + while (true) { + var nvr = _n0.a; + var $temp$_n0 = nvr; + _n0 = $temp$_n0; + continue never; + } +}; +var elm$core$Task$Perform = function (a) { + return {$: 'Perform', a: a}; +}; +var elm$core$Task$succeed = _Scheduler_succeed; +var elm$core$Task$init = elm$core$Task$succeed(_Utils_Tuple0); +var elm$core$Task$andThen = _Scheduler_andThen; +var elm$core$Task$map = F2( + function (func, taskA) { + return A2( + elm$core$Task$andThen, + function (a) { + return elm$core$Task$succeed( + func(a)); + }, + taskA); + }); +var elm$core$Task$map2 = F3( + function (func, taskA, taskB) { + return A2( + elm$core$Task$andThen, + function (a) { + return A2( + elm$core$Task$andThen, + function (b) { + return elm$core$Task$succeed( + A2(func, a, b)); + }, + taskB); + }, + taskA); + }); +var elm$core$Task$sequence = function (tasks) { + return A3( + elm$core$List$foldr, + elm$core$Task$map2(elm$core$List$cons), + elm$core$Task$succeed(_List_Nil), + tasks); +}; +var elm$core$Platform$sendToApp = _Platform_sendToApp; +var elm$core$Task$spawnCmd = F2( + function (router, _n0) { + var task = _n0.a; + return _Scheduler_spawn( + A2( + elm$core$Task$andThen, + elm$core$Platform$sendToApp(router), + task)); + }); +var elm$core$Task$onEffects = F3( + function (router, commands, state) { + return A2( + elm$core$Task$map, + function (_n0) { + return _Utils_Tuple0; + }, + elm$core$Task$sequence( + A2( + elm$core$List$map, + elm$core$Task$spawnCmd(router), + commands))); + }); +var elm$core$Task$onSelfMsg = F3( + function (_n0, _n1, _n2) { + return elm$core$Task$succeed(_Utils_Tuple0); + }); +var elm$core$Task$cmdMap = F2( + function (tagger, _n0) { + var task = _n0.a; + return elm$core$Task$Perform( + A2(elm$core$Task$map, tagger, task)); + }); +_Platform_effectManagers['Task'] = _Platform_createManager(elm$core$Task$init, elm$core$Task$onEffects, elm$core$Task$onSelfMsg, elm$core$Task$cmdMap); +var elm$core$Task$command = _Platform_leaf('Task'); +var elm$core$Task$perform = F2( + function (toMessage, task) { + return elm$core$Task$command( + elm$core$Task$Perform( + A2(elm$core$Task$map, toMessage, task))); + }); +var elm$core$String$length = _String_length; +var elm$core$String$slice = _String_slice; +var elm$core$String$dropLeft = F2( + function (n, string) { + return (n < 1) ? string : A3( + elm$core$String$slice, + n, + elm$core$String$length(string), + string); + }); +var elm$core$String$startsWith = _String_startsWith; +var elm$url$Url$Http = {$: 'Http'}; +var elm$url$Url$Https = {$: 'Https'}; +var elm$core$String$indexes = _String_indexes; +var elm$core$String$isEmpty = function (string) { + return string === ''; +}; +var elm$core$String$left = F2( + function (n, string) { + return (n < 1) ? '' : A3(elm$core$String$slice, 0, n, string); + }); +var elm$core$String$contains = _String_contains; +var elm$core$String$toInt = _String_toInt; +var elm$url$Url$Url = F6( + function (protocol, host, port_, path, query, fragment) { + return {fragment: fragment, host: host, path: path, port_: port_, protocol: protocol, query: query}; + }); +var elm$url$Url$chompBeforePath = F5( + function (protocol, path, params, frag, str) { + if (elm$core$String$isEmpty(str) || A2(elm$core$String$contains, '@', str)) { + return elm$core$Maybe$Nothing; + } else { + var _n0 = A2(elm$core$String$indexes, ':', str); + if (!_n0.b) { + return elm$core$Maybe$Just( + A6(elm$url$Url$Url, protocol, str, elm$core$Maybe$Nothing, path, params, frag)); + } else { + if (!_n0.b.b) { + var i = _n0.a; + var _n1 = elm$core$String$toInt( + A2(elm$core$String$dropLeft, i + 1, str)); + if (_n1.$ === 'Nothing') { + return elm$core$Maybe$Nothing; + } else { + var port_ = _n1; + return elm$core$Maybe$Just( + A6( + elm$url$Url$Url, + protocol, + A2(elm$core$String$left, i, str), + port_, + path, + params, + frag)); + } + } else { + return elm$core$Maybe$Nothing; + } + } + } + }); +var elm$url$Url$chompBeforeQuery = F4( + function (protocol, params, frag, str) { + if (elm$core$String$isEmpty(str)) { + return elm$core$Maybe$Nothing; + } else { + var _n0 = A2(elm$core$String$indexes, '/', str); + if (!_n0.b) { + return A5(elm$url$Url$chompBeforePath, protocol, '/', params, frag, str); + } else { + var i = _n0.a; + return A5( + elm$url$Url$chompBeforePath, + protocol, + A2(elm$core$String$dropLeft, i, str), + params, + frag, + A2(elm$core$String$left, i, str)); + } + } + }); +var elm$url$Url$chompBeforeFragment = F3( + function (protocol, frag, str) { + if (elm$core$String$isEmpty(str)) { + return elm$core$Maybe$Nothing; + } else { + var _n0 = A2(elm$core$String$indexes, '?', str); + if (!_n0.b) { + return A4(elm$url$Url$chompBeforeQuery, protocol, elm$core$Maybe$Nothing, frag, str); + } else { + var i = _n0.a; + return A4( + elm$url$Url$chompBeforeQuery, + protocol, + elm$core$Maybe$Just( + A2(elm$core$String$dropLeft, i + 1, str)), + frag, + A2(elm$core$String$left, i, str)); + } + } + }); +var elm$url$Url$chompAfterProtocol = F2( + function (protocol, str) { + if (elm$core$String$isEmpty(str)) { + return elm$core$Maybe$Nothing; + } else { + var _n0 = A2(elm$core$String$indexes, '#', str); + if (!_n0.b) { + return A3(elm$url$Url$chompBeforeFragment, protocol, elm$core$Maybe$Nothing, str); + } else { + var i = _n0.a; + return A3( + elm$url$Url$chompBeforeFragment, + protocol, + elm$core$Maybe$Just( + A2(elm$core$String$dropLeft, i + 1, str)), + A2(elm$core$String$left, i, str)); + } + } + }); +var elm$url$Url$fromString = function (str) { + return A2(elm$core$String$startsWith, 'http://', str) ? A2( + elm$url$Url$chompAfterProtocol, + elm$url$Url$Http, + A2(elm$core$String$dropLeft, 7, str)) : (A2(elm$core$String$startsWith, 'https://', str) ? A2( + elm$url$Url$chompAfterProtocol, + elm$url$Url$Https, + A2(elm$core$String$dropLeft, 8, str)) : elm$core$Maybe$Nothing); +}; +var elm$browser$Browser$sandbox = function (impl) { + return _Browser_element( + { + init: function (_n0) { + return _Utils_Tuple2(impl.init, elm$core$Platform$Cmd$none); + }, + subscriptions: function (_n1) { + return elm$core$Platform$Sub$none; + }, + update: F2( + function (msg, model) { + return _Utils_Tuple2( + A2(impl.update, msg, model), + elm$core$Platform$Cmd$none); + }), + view: impl.view + }); +}; +var author$project$Main$main = elm$browser$Browser$sandbox( + {init: author$project$Model$init, update: author$project$Main$update, view: author$project$View$view}); +_Platform_export({'Main':{'init':author$project$Main$main( + elm$json$Json$Decode$succeed(_Utils_Tuple0))(0)}});}(this)); var app = Elm.Main.init({ node: document.getElementById("elm-f0111bc4e658d0f98db96260c16f7e49") }); if (document.getElementById("elm-f0111bc4e658d0f98db96260c16f7e49")) diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index dc684e3..e7de028 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -1,310 +1,14 @@ module Main exposing (main) -import Browser -import Html exposing (Attribute, Html, div, option, select, table, td, text, tr) -import Html.Attributes exposing (selected, style) -import Html.Events exposing (onClick) -import List exposing (append, drop, filter, foldr, map, map2, member, range, repeat, take) -import Random exposing (generate) - - -main = - Browser.sandbox { init = init, update = update, view = view } - - - -- Model --------------------------------------------------------------------------------------------------------------- - - -type Entry - = EMPTY - | N1 - | N2 - | N3 - | N4 - | N5 - | N6 - | N7 - | N8 - | N9 - - -all_options = - [ EMPTY, N1, N2, N3, N4, N5, N6, N7, N8, N9 ] - - -type alias Row = - List Entry - - -type alias Sudoku = - List Row - - -type alias Model = - ( Sudoku, String ) - - -type alias Position = - ( Int, Int ) - - -init : Model -init = - ( repeat 9 (repeat 9 EMPTY), "Empty" ) - - - -- Update -------------------------------------------------------------------------------------------------------------- - - -type Msg - = Msg Position Entry - - -update : Msg -> Model -> Model -update (Msg position entry) ( sudoku, text ) = - ( update_sudoku sudoku position entry, text ) - - -exchange_entry : List a -> Int -> a -> List a -exchange_entry list index replacement = - take index list ++ [ replacement ] ++ drop (index + 1) list - - -update_sudoku : Sudoku -> Position -> Entry -> Sudoku -update_sudoku sudoku ( row, column ) entry = - exchange_entry sudoku row (update_sudoku_row (List.head (drop row sudoku)) column entry) - - -update_sudoku_row : Maybe Row -> Int -> Entry -> Row -update_sudoku_row row = - exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) - - - --- checks if the sudoku was solved - - -won_sudoku : Sudoku -> Bool -won_sudoku field = - no_emptys_sudoku field && validate_sudoku field - - - --- checks if all fields are non Empty - - -no_emptys_sudoku : Sudoku -> Bool -no_emptys_sudoku field = - filter has_emptys field == [] - - -has_emptys : List Entry -> Bool -has_emptys list = - case list of - [] -> - False - - EMPTY :: _ -> - True - - _ :: t -> - has_emptys t - - - --- checks if the entered configuration is valid - - -validate_sudoku : Sudoku -> Bool -validate_sudoku sudoku = - List.foldl (&&) True (map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ]) - - -validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool -validate_feature sudoku extractor = - List.foldr (&&) True (map validate_list (extractor sudoku)) - - -validate_list : List Entry -> Bool -validate_list l = - case l of - [] -> - True - - EMPTY :: tail -> - validate_list tail - - m :: tail -> - not (member m tail) && validate_list tail - - - --- Creates a list of area entry lists - - -extract_areas : Sudoku -> List (List Entry) -extract_areas sudoku = - map - (extract_area sudoku) - (map - (\n -> ( n // 3, remainderBy 3 n )) - (range 0 8) - ) - - - --- Drops the first 3*n elements of a list and returns 3 elements of the remainder - - -td3 : Int -> List a -> List a -td3 n list = - take 3 (drop (n * 3) list) - - - --- Returns a list of 9 entries that form the area defined by the position - - -extract_area : Sudoku -> Position -> List Entry -extract_area s ( r, c ) = - foldr append [] (td3 c (td3 r s)) - - -extract_rows : Sudoku -> List (List Entry) -extract_rows sudoku = - sudoku - - -extract_columns : Sudoku -> List (List Entry) -extract_columns = - transpose - - -transpose : List (List a) -> List (List a) -transpose list = - case list of - [] -> - [] - - x :: _ -> - map (nth_column list) (range 0 (List.length x - 1)) - - - --- Returns a list of nth elements if they exist - - -nth_column : List (List a) -> Int -> List a -nth_column list index = - List.filterMap (element index) list - - - --- Returns the nth element of a list - - -element : Int -> List a -> Maybe a -element index list = - case List.take 1 (List.drop (index - 1) list) of - [] -> - Nothing - - x :: _ -> - Just x - - - -- View ---------------------------------------------------------------------------------------------------------------- +import Browser +import Model exposing (..) +import Update exposing (..) +import View exposing (..) -view : Model -> Html Msg -view ( sudoku, msg ) = - div [] [ gen_sudoku sudoku, text msg ] - - -zip : List a -> List b -> List ( a, b ) -zip a b = - map2 simple a b - - -simple a b = - ( a, b ) - - -gen_sudoku : Sudoku -> Html Msg -gen_sudoku model = - table [ style "border" "1px solid black" ] (map gen_row (zip (range 0 8) model)) - - -gen_row : ( Int, Row ) -> Html Msg -gen_row ( index, row ) = - tr [] (map gen_entry (zip (zip (repeat 9 index) (range 0 8)) row)) - - -gen_entry : ( Position, Entry ) -> Html Msg -gen_entry ( position, entry ) = - td [] [ select [] (map (gen_option position entry) all_options) ] - - -gen_option : Position -> Entry -> Entry -> Html Msg -gen_option position select entry = - option [ selected (select == entry), onClick (Msg position entry) ] [ text (show entry) ] - - -show : Entry -> String -show e = - case e of - EMPTY -> - " " - - N1 -> - "1" - - N2 -> - "2" - - N3 -> - "3" - - N4 -> - "4" - - N5 -> - "5" - - N6 -> - "6" - - N7 -> - "7" - - N8 -> - "8" - - N9 -> - "9" - - - --- Generate Sudoku ----------------------------------------------------------------------------------------------------- - - -create_sudoku : Sudoku -create_sudoku = - [] - - -rnd : Int -rnd = - let - generator = - Random.int 1 9 - id = - \n -> n - in - case generate id generator of - Cmd.Cmd m -> - m +main = + Browser.sandbox { init = init, update = update, view = view } diff --git a/elm-examples/sudoku/src/Model.elm b/elm-examples/sudoku/src/Model.elm new file mode 100644 index 0000000..228e60d --- /dev/null +++ b/elm-examples/sudoku/src/Model.elm @@ -0,0 +1,33 @@ +module Model exposing (init) + +import List exposing (repeat) +import Random exposing (generate) +import Types exposing (..) + + +init : Model +init = + ( repeat 9 (repeat 9 EMPTY), "Empty" ) + + + +-- Generate Sudoku ----------------------------------------------------------------------------------------------------- + + +create_sudoku : Sudoku +create_sudoku = + [] + + +rnd : Int +rnd = + let + generator = + Random.int 1 9 + + id = + \n -> n + in + case generate id generator of + Cmd.Cmd m -> + m diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm new file mode 100644 index 0000000..31f5ffe --- /dev/null +++ b/elm-examples/sudoku/src/Types.elm @@ -0,0 +1,38 @@ +module Types exposing (Entry(..), Model, Msg(..), Position, Row, Sudoku, all_options) + + +type Entry + = EMPTY + | N1 + | N2 + | N3 + | N4 + | N5 + | N6 + | N7 + | N8 + | N9 + + +all_options = + [ EMPTY, N1, N2, N3, N4, N5, N6, N7, N8, N9 ] + + +type alias Row = + List Entry + + +type alias Sudoku = + List Row + + +type alias Model = + ( Sudoku, String ) + + +type alias Position = + ( Int, Int ) + + +type Msg + = Msg Position Entry diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm new file mode 100644 index 0000000..6f8f17f --- /dev/null +++ b/elm-examples/sudoku/src/Update.elm @@ -0,0 +1,162 @@ +module Update exposing (element, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, has_emptys, no_emptys_sudoku, nth_column, td3, transpose, update, update_sudoku, update_sudoku_row, validate_feature, validate_list, validate_sudoku, won_sudoku) + +import List exposing (drop, map, repeat, take) +import Types exposing (..) + + +update : Msg -> Model -> Model +update (Msg position entry) ( sudoku, text ) = + ( update_sudoku sudoku position entry, text ) + + +exchange_entry : List a -> Int -> a -> List a +exchange_entry list index replacement = + take index list ++ [ replacement ] ++ drop (index + 1) list + + + +--take (index - 1) list ++ [ replacement ] ++ drop index list + + +update_sudoku : Sudoku -> Position -> Entry -> Sudoku +update_sudoku sudoku ( row, column ) entry = + exchange_entry sudoku row (update_sudoku_row (List.head (drop row sudoku)) column entry) + + +update_sudoku_row : Maybe Row -> Int -> Entry -> Row +update_sudoku_row row = + exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) + + + +-- checks if the sudoku was solved + + +won_sudoku : Sudoku -> Bool +won_sudoku field = + no_emptys_sudoku field && validate_sudoku field + + + +-- checks if all fields are non Empty + + +no_emptys_sudoku : Sudoku -> Bool +no_emptys_sudoku field = + filter has_emptys field == [] + + +has_emptys : List Entry -> Bool +has_emptys list = + case list of + [] -> + False + + EMPTY :: _ -> + True + + _ :: t -> + has_emptys t + + + +-- checks if the entered configuration is valid + + +validate_sudoku : Sudoku -> Bool +validate_sudoku sudoku = + List.foldl (&&) True (map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ]) + + +validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool +validate_feature sudoku extractor = + List.foldr (&&) True (map validate_list (extractor sudoku)) + + +validate_list : List Entry -> Bool +validate_list l = + case l of + [] -> + True + + EMPTY :: tail -> + validate_list tail + + m :: tail -> + member m tail && validate_list tail + + + +-- TODO shouldn't it be: not (member m tail) instead of: member m tail ? +-- Creates a list of area entry lists + + +extract_areas : Sudoku -> List (List Entry) +extract_areas sudoku = + map + (extract_area sudoku) + (map + (\n -> ( n // 3, remainderBy 3 n )) + (range 0 8) + ) + + + +-- Drops the first 3*n elements of a list and returns 3 elements of the remainder + + +td3 : Int -> List a -> List a +td3 n list = + take 3 (drop (n * 3) list) + + + +-- Returns a list of 9 entries that form the area defined by the position + + +extract_area : Sudoku -> Position -> List Entry +extract_area s ( r, c ) = + foldr append [] (td3 c (td3 r s)) + + +extract_rows : Sudoku -> List (List Entry) +extract_rows sudoku = + sudoku + + +extract_columns : Sudoku -> List (List Entry) +extract_columns = + transpose + + +transpose : List (List a) -> List (List a) +transpose list = + case list of + [] -> + [] + + x :: _ -> + map (nth_column list) (range 0 (List.length x - 1)) + + + +-- Returns a list of nth elements if they exist + + +nth_column : List (List a) -> Int -> List a +nth_column list index = + List.filterMap (element index) list + + + +-- Returns the nth element of a list + + +element : Int -> List a -> Maybe a +element index list = + case List.take 1 (List.drop (index - 1) list) of + [] -> + Nothing + + x :: _ -> + Just x diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm new file mode 100644 index 0000000..90055eb --- /dev/null +++ b/elm-examples/sudoku/src/View.elm @@ -0,0 +1,114 @@ +module View exposing (conv_to_msg, gen_entry, gen_option, gen_row, gen_sudoku, parse, show, view) + +import Html exposing (..) +import Html.Attributes exposing (selected, style) +import Html.Events exposing (onClick, onInput) +import List exposing (map, map2, range, repeat) +import Types exposing (..) + + +zip : List a -> List b -> List ( a, b ) +zip a b = + map2 simple a b + + +simple a b = + ( a, b ) + + +view : Model -> Html Msg +view ( sudoku, msg ) = + div [] [ gen_sudoku sudoku, text msg ] + + +gen_sudoku : Sudoku -> Html Msg +gen_sudoku model = + table [ style "border" "1px solid black" ] (map gen_row (zip (range 0 8) model)) + + +gen_row : ( Int, Row ) -> Html Msg +gen_row ( index, row ) = + tr [] (map gen_entry (zip (zip (repeat 9 index) (range 0 8)) row)) + + +gen_entry : ( Position, Entry ) -> Html Msg +gen_entry ( position, entry ) = + td [] [ select [ onInput (conv_to_msg position) ] (map (gen_option position entry) all_options) ] + + +conv_to_msg : Position -> String -> Msg +conv_to_msg pos a = + Msg pos (parse a) + + +gen_option : Position -> Entry -> Entry -> Html Msg +gen_option position select entry = + option [ selected (select == entry), onClick (Msg position entry) ] [ text (show entry) ] + + +parse : String -> Entry +parse e = + case e of + "1" -> + N1 + + "2" -> + N2 + + "3" -> + N3 + + "4" -> + N4 + + "5" -> + N5 + + "6" -> + N6 + + "7" -> + N7 + + "8" -> + N8 + + "9" -> + N9 + + _ -> + EMPTY + + +show : Entry -> String +show e = + case e of + EMPTY -> + " " + + N1 -> + "1" + + N2 -> + "2" + + N3 -> + "3" + + N4 -> + "4" + + N5 -> + "5" + + N6 -> + "6" + + N7 -> + "7" + + N8 -> + "8" + + N9 -> + "9" -- GitLab From 988296ea50248951b13c4b79ae40722a4d8db453 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Tue, 16 Apr 2019 11:39:40 +0200 Subject: [PATCH 22/82] fixed missing imports and elm.json --- elm-examples/sudoku/elm.json | 1 - elm-examples/sudoku/src/Update.elm | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/elm-examples/sudoku/elm.json b/elm-examples/sudoku/elm.json index f59c1ec..8e18a59 100644 --- a/elm-examples/sudoku/elm.json +++ b/elm-examples/sudoku/elm.json @@ -16,7 +16,6 @@ "indirect": { "elm/bytes": "1.0.8", "elm/file": "1.0.5", - "elm/json": "1.1.2", "elm/time": "1.0.0", "elm/url": "1.0.0", "elm/virtual-dom": "1.0.2" diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 6f8f17f..fa28cc9 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,6 +1,6 @@ module Update exposing (element, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, has_emptys, no_emptys_sudoku, nth_column, td3, transpose, update, update_sudoku, update_sudoku_row, validate_feature, validate_list, validate_sudoku, won_sudoku) -import List exposing (drop, map, repeat, take) +import List exposing (append, drop, filter, foldl, foldr, map, member, range, repeat, take) import Types exposing (..) -- GitLab From 27b5410e863dd37abbc19a0595eef66757233eef Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Tue, 16 Apr 2019 11:42:52 +0200 Subject: [PATCH 23/82] Random message for update --- elm-examples/sudoku/src/Model.elm | 8 +++----- elm-examples/sudoku/src/Types.elm | 1 + 2 files changed, 4 insertions(+), 5 deletions(-) diff --git a/elm-examples/sudoku/src/Model.elm b/elm-examples/sudoku/src/Model.elm index 228e60d..faee34e 100644 --- a/elm-examples/sudoku/src/Model.elm +++ b/elm-examples/sudoku/src/Model.elm @@ -19,15 +19,13 @@ create_sudoku = [] -rnd : Int +rnd : Cmd Msg rnd = let generator = Random.int 1 9 id = - \n -> n + \n -> Random n in - case generate id generator of - Cmd.Cmd m -> - m + generate id generator diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index 31f5ffe..24cad3e 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -36,3 +36,4 @@ type alias Position = type Msg = Msg Position Entry + | Random Int -- GitLab From 80c0e3278333ea9967afa58b6eb33e653d3c7179 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Tue, 16 Apr 2019 11:46:39 +0200 Subject: [PATCH 24/82] changed Msg --- elm-examples/sudoku/src/Update.elm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index fa28cc9..1fef426 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -5,8 +5,13 @@ import Types exposing (..) update : Msg -> Model -> Model -update (Msg position entry) ( sudoku, text ) = - ( update_sudoku sudoku position entry, text ) +update msg ( sudoku, text ) = + case msg of + Msg position entry -> + ( update_sudoku sudoku position entry, text ) + + Random int -> + ( sudoku, text ) exchange_entry : List a -> Int -> a -> List a -- GitLab From 62d05da923d4fd861ca3ee0662efd84385a3f223 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Tue, 16 Apr 2019 11:56:38 +0200 Subject: [PATCH 25/82] changed Entry Type --- elm-examples/sudoku/index.html | 953 +++++++++++++++-------------- elm-examples/sudoku/src/Types.elm | 13 +- elm-examples/sudoku/src/Update.elm | 7 +- elm-examples/sudoku/src/View.elm | 38 +- 4 files changed, 528 insertions(+), 483 deletions(-) diff --git a/elm-examples/sudoku/index.html b/elm-examples/sudoku/index.html index 2500fb7..04911c4 100644 --- a/elm-examples/sudoku/index.html +++ b/elm-examples/sudoku/index.html @@ -90,271 +90,6 @@ function A9(fun, a, b, c, d, e, f, g, h, i) { console.warn('Compiled in DEV mode. Follow the advice at https://elm-lang.org/0.19.0/optimize for better performance and smaller assets.'); -var _List_Nil_UNUSED = { $: 0 }; -var _List_Nil = { $: '[]' }; - -function _List_Cons_UNUSED(hd, tl) { return { $: 1, a: hd, b: tl }; } -function _List_Cons(hd, tl) { return { $: '::', a: hd, b: tl }; } - - -var _List_cons = F2(_List_Cons); - -function _List_fromArray(arr) -{ - var out = _List_Nil; - for (var i = arr.length; i--; ) - { - out = _List_Cons(arr[i], out); - } - return out; -} - -function _List_toArray(xs) -{ - for (var out = []; xs.b; xs = xs.b) // WHILE_CONS - { - out.push(xs.a); - } - return out; -} - -var _List_map2 = F3(function(f, xs, ys) -{ - for (var arr = []; xs.b && ys.b; xs = xs.b, ys = ys.b) // WHILE_CONSES - { - arr.push(A2(f, xs.a, ys.a)); - } - return _List_fromArray(arr); -}); - -var _List_map3 = F4(function(f, xs, ys, zs) -{ - for (var arr = []; xs.b && ys.b && zs.b; xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES - { - arr.push(A3(f, xs.a, ys.a, zs.a)); - } - return _List_fromArray(arr); -}); - -var _List_map4 = F5(function(f, ws, xs, ys, zs) -{ - for (var arr = []; ws.b && xs.b && ys.b && zs.b; ws = ws.b, xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES - { - arr.push(A4(f, ws.a, xs.a, ys.a, zs.a)); - } - return _List_fromArray(arr); -}); - -var _List_map5 = F6(function(f, vs, ws, xs, ys, zs) -{ - for (var arr = []; vs.b && ws.b && xs.b && ys.b && zs.b; vs = vs.b, ws = ws.b, xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES - { - arr.push(A5(f, vs.a, ws.a, xs.a, ys.a, zs.a)); - } - return _List_fromArray(arr); -}); - -var _List_sortBy = F2(function(f, xs) -{ - return _List_fromArray(_List_toArray(xs).sort(function(a, b) { - return _Utils_cmp(f(a), f(b)); - })); -}); - -var _List_sortWith = F2(function(f, xs) -{ - return _List_fromArray(_List_toArray(xs).sort(function(a, b) { - var ord = A2(f, a, b); - return ord === elm$core$Basics$EQ ? 0 : ord === elm$core$Basics$LT ? -1 : 1; - })); -}); - - - -// EQUALITY - -function _Utils_eq(x, y) -{ - for ( - var pair, stack = [], isEqual = _Utils_eqHelp(x, y, 0, stack); - isEqual && (pair = stack.pop()); - isEqual = _Utils_eqHelp(pair.a, pair.b, 0, stack) - ) - {} - - return isEqual; -} - -function _Utils_eqHelp(x, y, depth, stack) -{ - if (depth > 100) - { - stack.push(_Utils_Tuple2(x,y)); - return true; - } - - if (x === y) - { - return true; - } - - if (typeof x !== 'object' || x === null || y === null) - { - typeof x === 'function' && _Debug_crash(5); - return false; - } - - /**/ - if (x.$ === 'Set_elm_builtin') - { - x = elm$core$Set$toList(x); - y = elm$core$Set$toList(y); - } - if (x.$ === 'RBNode_elm_builtin' || x.$ === 'RBEmpty_elm_builtin') - { - x = elm$core$Dict$toList(x); - y = elm$core$Dict$toList(y); - } - //*/ - - /**_UNUSED/ - if (x.$ < 0) - { - x = elm$core$Dict$toList(x); - y = elm$core$Dict$toList(y); - } - //*/ - - for (var key in x) - { - if (!_Utils_eqHelp(x[key], y[key], depth + 1, stack)) - { - return false; - } - } - return true; -} - -var _Utils_equal = F2(_Utils_eq); -var _Utils_notEqual = F2(function(a, b) { return !_Utils_eq(a,b); }); - - - -// COMPARISONS - -// Code in Generate/JavaScript.hs, Basics.js, and List.js depends on -// the particular integer values assigned to LT, EQ, and GT. - -function _Utils_cmp(x, y, ord) -{ - if (typeof x !== 'object') - { - return x === y ? /*EQ*/ 0 : x < y ? /*LT*/ -1 : /*GT*/ 1; - } - - /**/ - if (x instanceof String) - { - var a = x.valueOf(); - var b = y.valueOf(); - return a === b ? 0 : a < b ? -1 : 1; - } - //*/ - - /**_UNUSED/ - if (typeof x.$ === 'undefined') - //*/ - /**/ - if (x.$[0] === '#') - //*/ - { - return (ord = _Utils_cmp(x.a, y.a)) - ? ord - : (ord = _Utils_cmp(x.b, y.b)) - ? ord - : _Utils_cmp(x.c, y.c); - } - - // traverse conses until end of a list or a mismatch - for (; x.b && y.b && !(ord = _Utils_cmp(x.a, y.a)); x = x.b, y = y.b) {} // WHILE_CONSES - return ord || (x.b ? /*GT*/ 1 : y.b ? /*LT*/ -1 : /*EQ*/ 0); -} - -var _Utils_lt = F2(function(a, b) { return _Utils_cmp(a, b) < 0; }); -var _Utils_le = F2(function(a, b) { return _Utils_cmp(a, b) < 1; }); -var _Utils_gt = F2(function(a, b) { return _Utils_cmp(a, b) > 0; }); -var _Utils_ge = F2(function(a, b) { return _Utils_cmp(a, b) >= 0; }); - -var _Utils_compare = F2(function(x, y) -{ - var n = _Utils_cmp(x, y); - return n < 0 ? elm$core$Basics$LT : n ? elm$core$Basics$GT : elm$core$Basics$EQ; -}); - - -// COMMON VALUES - -var _Utils_Tuple0_UNUSED = 0; -var _Utils_Tuple0 = { $: '#0' }; - -function _Utils_Tuple2_UNUSED(a, b) { return { a: a, b: b }; } -function _Utils_Tuple2(a, b) { return { $: '#2', a: a, b: b }; } - -function _Utils_Tuple3_UNUSED(a, b, c) { return { a: a, b: b, c: c }; } -function _Utils_Tuple3(a, b, c) { return { $: '#3', a: a, b: b, c: c }; } - -function _Utils_chr_UNUSED(c) { return c; } -function _Utils_chr(c) { return new String(c); } - - -// RECORDS - -function _Utils_update(oldRecord, updatedFields) -{ - var newRecord = {}; - - for (var key in oldRecord) - { - newRecord[key] = oldRecord[key]; - } - - for (var key in updatedFields) - { - newRecord[key] = updatedFields[key]; - } - - return newRecord; -} - - -// APPEND - -var _Utils_append = F2(_Utils_ap); - -function _Utils_ap(xs, ys) -{ - // append Strings - if (typeof xs === 'string') - { - return xs + ys; - } - - // append Lists - if (!xs.b) - { - return ys; - } - var root = _List_Cons(xs.a, ys); - xs = xs.b - for (var curr = root; xs.b; xs = xs.b) // WHILE_CONS - { - curr = curr.b = _List_Cons(xs.a, ys); - } - return root; -} - - - var _JsArray_empty = []; function _JsArray_singleton(value) @@ -448,61 +183,142 @@ var _JsArray_foldr = F3(function(func, acc, array) return acc; }); -var _JsArray_map = F2(function(func, array) +var _JsArray_map = F2(function(func, array) +{ + var length = array.length; + var result = new Array(length); + + for (var i = 0; i < length; i++) + { + result[i] = func(array[i]); + } + + return result; +}); + +var _JsArray_indexedMap = F3(function(func, offset, array) +{ + var length = array.length; + var result = new Array(length); + + for (var i = 0; i < length; i++) + { + result[i] = A2(func, offset + i, array[i]); + } + + return result; +}); + +var _JsArray_slice = F3(function(from, to, array) +{ + return array.slice(from, to); +}); + +var _JsArray_appendN = F3(function(n, dest, source) +{ + var destLen = dest.length; + var itemsToCopy = n - destLen; + + if (itemsToCopy > source.length) + { + itemsToCopy = source.length; + } + + var size = destLen + itemsToCopy; + var result = new Array(size); + + for (var i = 0; i < destLen; i++) + { + result[i] = dest[i]; + } + + for (var i = 0; i < itemsToCopy; i++) + { + result[i + destLen] = source[i]; + } + + return result; +}); + + + +var _List_Nil_UNUSED = { $: 0 }; +var _List_Nil = { $: '[]' }; + +function _List_Cons_UNUSED(hd, tl) { return { $: 1, a: hd, b: tl }; } +function _List_Cons(hd, tl) { return { $: '::', a: hd, b: tl }; } + + +var _List_cons = F2(_List_Cons); + +function _List_fromArray(arr) +{ + var out = _List_Nil; + for (var i = arr.length; i--; ) + { + out = _List_Cons(arr[i], out); + } + return out; +} + +function _List_toArray(xs) +{ + for (var out = []; xs.b; xs = xs.b) // WHILE_CONS + { + out.push(xs.a); + } + return out; +} + +var _List_map2 = F3(function(f, xs, ys) +{ + for (var arr = []; xs.b && ys.b; xs = xs.b, ys = ys.b) // WHILE_CONSES + { + arr.push(A2(f, xs.a, ys.a)); + } + return _List_fromArray(arr); +}); + +var _List_map3 = F4(function(f, xs, ys, zs) +{ + for (var arr = []; xs.b && ys.b && zs.b; xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES + { + arr.push(A3(f, xs.a, ys.a, zs.a)); + } + return _List_fromArray(arr); +}); + +var _List_map4 = F5(function(f, ws, xs, ys, zs) { - var length = array.length; - var result = new Array(length); - - for (var i = 0; i < length; i++) - { - result[i] = func(array[i]); - } - - return result; + for (var arr = []; ws.b && xs.b && ys.b && zs.b; ws = ws.b, xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES + { + arr.push(A4(f, ws.a, xs.a, ys.a, zs.a)); + } + return _List_fromArray(arr); }); -var _JsArray_indexedMap = F3(function(func, offset, array) +var _List_map5 = F6(function(f, vs, ws, xs, ys, zs) { - var length = array.length; - var result = new Array(length); - - for (var i = 0; i < length; i++) - { - result[i] = A2(func, offset + i, array[i]); - } - - return result; + for (var arr = []; vs.b && ws.b && xs.b && ys.b && zs.b; vs = vs.b, ws = ws.b, xs = xs.b, ys = ys.b, zs = zs.b) // WHILE_CONSES + { + arr.push(A5(f, vs.a, ws.a, xs.a, ys.a, zs.a)); + } + return _List_fromArray(arr); }); -var _JsArray_slice = F3(function(from, to, array) +var _List_sortBy = F2(function(f, xs) { - return array.slice(from, to); + return _List_fromArray(_List_toArray(xs).sort(function(a, b) { + return _Utils_cmp(f(a), f(b)); + })); }); -var _JsArray_appendN = F3(function(n, dest, source) +var _List_sortWith = F2(function(f, xs) { - var destLen = dest.length; - var itemsToCopy = n - destLen; - - if (itemsToCopy > source.length) - { - itemsToCopy = source.length; - } - - var size = destLen + itemsToCopy; - var result = new Array(size); - - for (var i = 0; i < destLen; i++) - { - result[i] = dest[i]; - } - - for (var i = 0; i < itemsToCopy; i++) - { - result[i + destLen] = source[i]; - } - - return result; + return _List_fromArray(_List_toArray(xs).sort(function(a, b) { + var ord = A2(f, a, b); + return ord === elm$core$Basics$EQ ? 0 : ord === elm$core$Basics$LT ? -1 : 1; + })); }); @@ -803,6 +619,190 @@ function _Debug_regionToString(region) +// EQUALITY + +function _Utils_eq(x, y) +{ + for ( + var pair, stack = [], isEqual = _Utils_eqHelp(x, y, 0, stack); + isEqual && (pair = stack.pop()); + isEqual = _Utils_eqHelp(pair.a, pair.b, 0, stack) + ) + {} + + return isEqual; +} + +function _Utils_eqHelp(x, y, depth, stack) +{ + if (depth > 100) + { + stack.push(_Utils_Tuple2(x,y)); + return true; + } + + if (x === y) + { + return true; + } + + if (typeof x !== 'object' || x === null || y === null) + { + typeof x === 'function' && _Debug_crash(5); + return false; + } + + /**/ + if (x.$ === 'Set_elm_builtin') + { + x = elm$core$Set$toList(x); + y = elm$core$Set$toList(y); + } + if (x.$ === 'RBNode_elm_builtin' || x.$ === 'RBEmpty_elm_builtin') + { + x = elm$core$Dict$toList(x); + y = elm$core$Dict$toList(y); + } + //*/ + + /**_UNUSED/ + if (x.$ < 0) + { + x = elm$core$Dict$toList(x); + y = elm$core$Dict$toList(y); + } + //*/ + + for (var key in x) + { + if (!_Utils_eqHelp(x[key], y[key], depth + 1, stack)) + { + return false; + } + } + return true; +} + +var _Utils_equal = F2(_Utils_eq); +var _Utils_notEqual = F2(function(a, b) { return !_Utils_eq(a,b); }); + + + +// COMPARISONS + +// Code in Generate/JavaScript.hs, Basics.js, and List.js depends on +// the particular integer values assigned to LT, EQ, and GT. + +function _Utils_cmp(x, y, ord) +{ + if (typeof x !== 'object') + { + return x === y ? /*EQ*/ 0 : x < y ? /*LT*/ -1 : /*GT*/ 1; + } + + /**/ + if (x instanceof String) + { + var a = x.valueOf(); + var b = y.valueOf(); + return a === b ? 0 : a < b ? -1 : 1; + } + //*/ + + /**_UNUSED/ + if (typeof x.$ === 'undefined') + //*/ + /**/ + if (x.$[0] === '#') + //*/ + { + return (ord = _Utils_cmp(x.a, y.a)) + ? ord + : (ord = _Utils_cmp(x.b, y.b)) + ? ord + : _Utils_cmp(x.c, y.c); + } + + // traverse conses until end of a list or a mismatch + for (; x.b && y.b && !(ord = _Utils_cmp(x.a, y.a)); x = x.b, y = y.b) {} // WHILE_CONSES + return ord || (x.b ? /*GT*/ 1 : y.b ? /*LT*/ -1 : /*EQ*/ 0); +} + +var _Utils_lt = F2(function(a, b) { return _Utils_cmp(a, b) < 0; }); +var _Utils_le = F2(function(a, b) { return _Utils_cmp(a, b) < 1; }); +var _Utils_gt = F2(function(a, b) { return _Utils_cmp(a, b) > 0; }); +var _Utils_ge = F2(function(a, b) { return _Utils_cmp(a, b) >= 0; }); + +var _Utils_compare = F2(function(x, y) +{ + var n = _Utils_cmp(x, y); + return n < 0 ? elm$core$Basics$LT : n ? elm$core$Basics$GT : elm$core$Basics$EQ; +}); + + +// COMMON VALUES + +var _Utils_Tuple0_UNUSED = 0; +var _Utils_Tuple0 = { $: '#0' }; + +function _Utils_Tuple2_UNUSED(a, b) { return { a: a, b: b }; } +function _Utils_Tuple2(a, b) { return { $: '#2', a: a, b: b }; } + +function _Utils_Tuple3_UNUSED(a, b, c) { return { a: a, b: b, c: c }; } +function _Utils_Tuple3(a, b, c) { return { $: '#3', a: a, b: b, c: c }; } + +function _Utils_chr_UNUSED(c) { return c; } +function _Utils_chr(c) { return new String(c); } + + +// RECORDS + +function _Utils_update(oldRecord, updatedFields) +{ + var newRecord = {}; + + for (var key in oldRecord) + { + newRecord[key] = oldRecord[key]; + } + + for (var key in updatedFields) + { + newRecord[key] = updatedFields[key]; + } + + return newRecord; +} + + +// APPEND + +var _Utils_append = F2(_Utils_ap); + +function _Utils_ap(xs, ys) +{ + // append Strings + if (typeof xs === 'string') + { + return xs + ys; + } + + // append Lists + if (!xs.b) + { + return ys; + } + var root = _List_Cons(xs.a, ys); + xs = xs.b + for (var curr = root; xs.b; xs = xs.b) // WHILE_CONS + { + curr = curr.b = _List_Cons(xs.a, ys); + } + return root; +} + + + // MATH var _Basics_add = F2(function(a, b) { return a + b; }); @@ -4320,9 +4320,35 @@ function _Browser_load(url) } })); } +var author$project$Types$EMPTY = {$: 'EMPTY'}; +var elm$core$Elm$JsArray$foldr = _JsArray_foldr; +var elm$core$Array$foldr = F3( + function (func, baseCase, _n0) { + var tree = _n0.c; + var tail = _n0.d; + var helper = F2( + function (node, acc) { + if (node.$ === 'SubTree') { + var subTree = node.a; + return A3(elm$core$Elm$JsArray$foldr, helper, acc, subTree); + } else { + var values = node.a; + return A3(elm$core$Elm$JsArray$foldr, func, acc, values); + } + }); + return A3( + elm$core$Elm$JsArray$foldr, + helper, + A3(elm$core$Elm$JsArray$foldr, func, baseCase, tail), + tree); + }); var elm$core$Basics$EQ = {$: 'EQ'}; -var elm$core$Basics$GT = {$: 'GT'}; var elm$core$Basics$LT = {$: 'LT'}; +var elm$core$List$cons = _List_cons; +var elm$core$Array$toList = function (array) { + return A3(elm$core$Array$foldr, elm$core$List$cons, _List_Nil, array); +}; +var elm$core$Basics$GT = {$: 'GT'}; var elm$core$Dict$foldr = F3( function (func, acc, t) { foldr: @@ -4348,7 +4374,6 @@ var elm$core$Dict$foldr = F3( } } }); -var elm$core$List$cons = _List_cons; var elm$core$Dict$toList = function (dict) { return A3( elm$core$Dict$foldr, @@ -4376,34 +4401,37 @@ var elm$core$Set$toList = function (_n0) { var dict = _n0.a; return elm$core$Dict$keys(dict); }; -var elm$core$Elm$JsArray$foldr = _JsArray_foldr; -var elm$core$Array$foldr = F3( - function (func, baseCase, _n0) { - var tree = _n0.c; - var tail = _n0.d; - var helper = F2( - function (node, acc) { - if (node.$ === 'SubTree') { - var subTree = node.a; - return A3(elm$core$Elm$JsArray$foldr, helper, acc, subTree); - } else { - var values = node.a; - return A3(elm$core$Elm$JsArray$foldr, func, acc, values); - } - }); - return A3( - elm$core$Elm$JsArray$foldr, - helper, - A3(elm$core$Elm$JsArray$foldr, func, baseCase, tail), - tree); +var elm$core$Basics$le = _Utils_le; +var elm$core$Basics$sub = _Basics_sub; +var elm$core$List$repeatHelp = F3( + function (result, n, value) { + repeatHelp: + while (true) { + if (n <= 0) { + return result; + } else { + var $temp$result = A2(elm$core$List$cons, value, result), + $temp$n = n - 1, + $temp$value = value; + result = $temp$result; + n = $temp$n; + value = $temp$value; + continue repeatHelp; + } + } }); -var elm$core$Array$toList = function (array) { - return A3(elm$core$Array$foldr, elm$core$List$cons, _List_Nil, array); -}; +var elm$core$List$repeat = F2( + function (n, value) { + return A3(elm$core$List$repeatHelp, _List_Nil, n, value); + }); +var author$project$Model$init = _Utils_Tuple2( + A2( + elm$core$List$repeat, + 9, + A2(elm$core$List$repeat, 9, author$project$Types$EMPTY)), + 'Empty'); var elm$core$Basics$add = _Basics_add; var elm$core$Basics$append = _Utils_append; -var elm$core$Basics$le = _Utils_le; -var elm$core$Basics$sub = _Basics_sub; var elm$core$List$drop = F2( function (n, list) { drop: @@ -4574,7 +4602,7 @@ var elm$core$List$take = F2( function (n, list) { return A3(elm$core$List$takeFast, 0, n, list); }); -var author$project$Main$exchange_entry = F3( +var author$project$Update$exchange_entry = F3( function (list, index, replacement) { return _Utils_ap( A2(elm$core$List$take, index, list), @@ -4583,28 +4611,6 @@ var author$project$Main$exchange_entry = F3( [replacement]), A2(elm$core$List$drop, index + 1, list))); }); -var author$project$Types$EMPTY = {$: 'EMPTY'}; -var elm$core$List$repeatHelp = F3( - function (result, n, value) { - repeatHelp: - while (true) { - if (n <= 0) { - return result; - } else { - var $temp$result = A2(elm$core$List$cons, value, result), - $temp$n = n - 1, - $temp$value = value; - result = $temp$result; - n = $temp$n; - value = $temp$value; - continue repeatHelp; - } - } - }); -var elm$core$List$repeat = F2( - function (n, value) { - return A3(elm$core$List$repeatHelp, _List_Nil, n, value); - }); var elm$core$Maybe$withDefault = F2( function (_default, maybe) { if (maybe.$ === 'Just') { @@ -4614,8 +4620,8 @@ var elm$core$Maybe$withDefault = F2( return _default; } }); -var author$project$Main$update_sudoku_row = function (row) { - return author$project$Main$exchange_entry( +var author$project$Update$update_sudoku_row = function (row) { + return author$project$Update$exchange_entry( A2( elm$core$Maybe$withDefault, A2(elm$core$List$repeat, 9, author$project$Types$EMPTY), @@ -4634,37 +4640,35 @@ var elm$core$List$head = function (list) { return elm$core$Maybe$Nothing; } }; -var author$project$Main$update_sudoku = F3( +var author$project$Update$update_sudoku = F3( function (sudoku, _n0, entry) { var row = _n0.a; var column = _n0.b; return A3( - author$project$Main$exchange_entry, + author$project$Update$exchange_entry, sudoku, row, A3( - author$project$Main$update_sudoku_row, + author$project$Update$update_sudoku_row, elm$core$List$head( A2(elm$core$List$drop, row, sudoku)), column, entry)); }); -var author$project$Main$update = F2( - function (_n0, _n1) { - var position = _n0.a; - var entry = _n0.b; - var sudoku = _n1.a; - var text = _n1.b; - return _Utils_Tuple2( - A3(author$project$Main$update_sudoku, sudoku, position, entry), - text); +var author$project$Update$update = F2( + function (msg, _n0) { + var sudoku = _n0.a; + var text = _n0.b; + if (msg.$ === 'Msg') { + var position = msg.a; + var entry = msg.b; + var sudoku2 = A3(author$project$Update$update_sudoku, sudoku, position, entry); + return _Utils_Tuple2(sudoku2, text); + } else { + var _int = msg.a; + return _Utils_Tuple2(sudoku, text); + } }); -var author$project$Model$init = _Utils_Tuple2( - A2( - elm$core$List$repeat, - 9, - A2(elm$core$List$repeat, 9, author$project$Types$EMPTY)), - 'Empty'); var author$project$Types$N1 = {$: 'N1'}; var author$project$Types$N2 = {$: 'N2'}; var author$project$Types$N3 = {$: 'N3'}; @@ -4674,8 +4678,88 @@ var author$project$Types$N6 = {$: 'N6'}; var author$project$Types$N7 = {$: 'N7'}; var author$project$Types$N8 = {$: 'N8'}; var author$project$Types$N9 = {$: 'N9'}; -var author$project$Types$all_options = _List_fromArray( - [author$project$Types$EMPTY, author$project$Types$N1, author$project$Types$N2, author$project$Types$N3, author$project$Types$N4, author$project$Types$N5, author$project$Types$N6, author$project$Types$N7, author$project$Types$N8, author$project$Types$N9]); +var author$project$Types$User = function (a) { + return {$: 'User', a: a}; +}; +var elm$core$List$foldrHelper = F4( + function (fn, acc, ctr, ls) { + if (!ls.b) { + return acc; + } else { + var a = ls.a; + var r1 = ls.b; + if (!r1.b) { + return A2(fn, a, acc); + } else { + var b = r1.a; + var r2 = r1.b; + if (!r2.b) { + return A2( + fn, + a, + A2(fn, b, acc)); + } else { + var c = r2.a; + var r3 = r2.b; + if (!r3.b) { + return A2( + fn, + a, + A2( + fn, + b, + A2(fn, c, acc))); + } else { + var d = r3.a; + var r4 = r3.b; + var res = (ctr > 500) ? A3( + elm$core$List$foldl, + fn, + acc, + elm$core$List$reverse(r4)) : A4(elm$core$List$foldrHelper, fn, acc, ctr + 1, r4); + return A2( + fn, + a, + A2( + fn, + b, + A2( + fn, + c, + A2(fn, d, res)))); + } + } + } + } + }); +var elm$core$List$foldr = F3( + function (fn, acc, ls) { + return A4(elm$core$List$foldrHelper, fn, acc, 0, ls); + }); +var elm$core$List$map = F2( + function (f, xs) { + return A3( + elm$core$List$foldr, + F2( + function (x, acc) { + return A2( + elm$core$List$cons, + f(x), + acc); + }), + _List_Nil, + xs); + }); +var author$project$Types$all_options = A2( + elm$core$List$cons, + author$project$Types$EMPTY, + A2( + elm$core$List$map, + function (e) { + return author$project$Types$User(e); + }, + _List_fromArray( + [author$project$Types$N1, author$project$Types$N2, author$project$Types$N3, author$project$Types$N4, author$project$Types$N5, author$project$Types$N6, author$project$Types$N7, author$project$Types$N8, author$project$Types$N9]))); var author$project$Types$Msg = F2( function (a, b) { return {$: 'Msg', a: a, b: b}; @@ -4683,23 +4767,23 @@ var author$project$Types$Msg = F2( var author$project$View$parse = function (e) { switch (e) { case '1': - return author$project$Types$N1; + return author$project$Types$User(author$project$Types$N1); case '2': - return author$project$Types$N2; + return author$project$Types$User(author$project$Types$N2); case '3': - return author$project$Types$N3; + return author$project$Types$User(author$project$Types$N3); case '4': - return author$project$Types$N4; + return author$project$Types$User(author$project$Types$N4); case '5': - return author$project$Types$N5; + return author$project$Types$User(author$project$Types$N5); case '6': - return author$project$Types$N6; + return author$project$Types$User(author$project$Types$N6); case '7': - return author$project$Types$N7; + return author$project$Types$User(author$project$Types$N7); case '8': - return author$project$Types$N8; + return author$project$Types$User(author$project$Types$N8); case '9': - return author$project$Types$N9; + return author$project$Types$User(author$project$Types$N9); default: return author$project$Types$EMPTY; } @@ -4713,8 +4797,6 @@ var author$project$View$conv_to_msg = F2( }); var author$project$View$show = function (e) { switch (e.$) { - case 'EMPTY': - return ' '; case 'N1': return '1'; case 'N2': @@ -4735,6 +4817,18 @@ var author$project$View$show = function (e) { return '9'; } }; +var author$project$View$show_entry = function (entry) { + switch (entry.$) { + case 'EMPTY': + return ''; + case 'User': + var e = entry.a; + return author$project$View$show(e); + default: + var e = entry.a; + return author$project$View$show(e); + } +}; var elm$core$Basics$eq = _Utils_equal; var elm$core$Basics$identity = function (x) { return x; @@ -5160,78 +5254,9 @@ var author$project$View$gen_option = F3( _List_fromArray( [ elm$html$Html$text( - author$project$View$show(entry)) + author$project$View$show_entry(entry)) ])); }); -var elm$core$List$foldrHelper = F4( - function (fn, acc, ctr, ls) { - if (!ls.b) { - return acc; - } else { - var a = ls.a; - var r1 = ls.b; - if (!r1.b) { - return A2(fn, a, acc); - } else { - var b = r1.a; - var r2 = r1.b; - if (!r2.b) { - return A2( - fn, - a, - A2(fn, b, acc)); - } else { - var c = r2.a; - var r3 = r2.b; - if (!r3.b) { - return A2( - fn, - a, - A2( - fn, - b, - A2(fn, c, acc))); - } else { - var d = r3.a; - var r4 = r3.b; - var res = (ctr > 500) ? A3( - elm$core$List$foldl, - fn, - acc, - elm$core$List$reverse(r4)) : A4(elm$core$List$foldrHelper, fn, acc, ctr + 1, r4); - return A2( - fn, - a, - A2( - fn, - b, - A2( - fn, - c, - A2(fn, d, res)))); - } - } - } - } - }); -var elm$core$List$foldr = F3( - function (fn, acc, ls) { - return A4(elm$core$List$foldrHelper, fn, acc, 0, ls); - }); -var elm$core$List$map = F2( - function (f, xs) { - return A3( - elm$core$List$foldr, - F2( - function (x, acc) { - return A2( - elm$core$List$cons, - f(x), - acc); - }), - _List_Nil, - xs); - }); var elm$html$Html$select = _VirtualDom_node('select'); var elm$html$Html$td = _VirtualDom_node('td'); var elm$html$Html$Events$alwaysStop = function (x) { @@ -5594,7 +5619,7 @@ var elm$browser$Browser$sandbox = function (impl) { }); }; var author$project$Main$main = elm$browser$Browser$sandbox( - {init: author$project$Model$init, update: author$project$Main$update, view: author$project$View$view}); + {init: author$project$Model$init, update: author$project$Update$update, view: author$project$View$view}); _Platform_export({'Main':{'init':author$project$Main$main( elm$json$Json$Decode$succeed(_Utils_Tuple0))(0)}});}(this)); diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index 24cad3e..aef2d99 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -1,9 +1,16 @@ -module Types exposing (Entry(..), Model, Msg(..), Position, Row, Sudoku, all_options) +module Types exposing (Entry(..), Model, Msg(..), Position, Row, Sudoku, ValidEntry(..), all_options) + +import List exposing (map) type Entry = EMPTY - | N1 + | User ValidEntry + | Fixed ValidEntry + + +type ValidEntry + = N1 | N2 | N3 | N4 @@ -15,7 +22,7 @@ type Entry all_options = - [ EMPTY, N1, N2, N3, N4, N5, N6, N7, N8, N9 ] + EMPTY :: map (\e -> User e) [ N1, N2, N3, N4, N5, N6, N7, N8, N9 ] type alias Row = diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 1fef426..2a0f283 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -8,7 +8,11 @@ update : Msg -> Model -> Model update msg ( sudoku, text ) = case msg of Msg position entry -> - ( update_sudoku sudoku position entry, text ) + let + sudoku2 = + update_sudoku sudoku position entry + in + ( sudoku2, text ) Random int -> ( sudoku, text ) @@ -92,7 +96,6 @@ validate_list l = --- TODO shouldn't it be: not (member m tail) instead of: member m tail ? -- Creates a list of area entry lists diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index 90055eb..40c71c7 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -43,49 +43,59 @@ conv_to_msg pos a = gen_option : Position -> Entry -> Entry -> Html Msg gen_option position select entry = - option [ selected (select == entry), onClick (Msg position entry) ] [ text (show entry) ] + option [ selected (select == entry), onClick (Msg position entry) ] [ text (show_entry entry) ] parse : String -> Entry parse e = case e of "1" -> - N1 + User N1 "2" -> - N2 + User N2 "3" -> - N3 + User N3 "4" -> - N4 + User N4 "5" -> - N5 + User N5 "6" -> - N6 + User N6 "7" -> - N7 + User N7 "8" -> - N8 + User N8 "9" -> - N9 + User N9 _ -> EMPTY -show : Entry -> String -show e = - case e of +show_entry : Entry -> String +show_entry entry = + case entry of EMPTY -> - " " + "" + + User e -> + show e + + Fixed e -> + show e + +show : ValidEntry -> String +show e = + case e of N1 -> "1" -- GitLab From e0a77a88f164372ef466e70bbbbb257d0a6f1e52 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Wed, 17 Apr 2019 10:40:01 +0200 Subject: [PATCH 26/82] Fix validate_list --- elm-examples/sudoku/src/Update.elm | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 2a0f283..007bc03 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -91,8 +91,11 @@ validate_list l = EMPTY :: tail -> validate_list tail - m :: tail -> - member m tail && validate_list tail + (Fixed m) :: tail -> + (member (Fixed m) tail || member (User m) tail) && validate_list tail + + (User m) :: tail -> + (member (Fixed m) tail || member (User m) tail) && validate_list tail -- GitLab From 6260cb687ca90af30159a2a0cec61b87e397e910 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Wed, 17 Apr 2019 10:42:16 +0200 Subject: [PATCH 27/82] fix validate_list --- elm-examples/sudoku/src/Update.elm | 29 ++++++++++++++++++++++------- 1 file changed, 22 insertions(+), 7 deletions(-) diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 007bc03..da63350 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -84,18 +84,33 @@ validate_feature sudoku extractor = validate_list : List Entry -> Bool validate_list l = + validate_list2 (map entry_to_maybe l) + + +entry_to_maybe : Entry -> Maybe ValidEntry +entry_to_maybe v = + case v of + EMPTY -> + Nothing + + User m -> + Just m + + Fixed m -> + Just m + + +validate_list2 : List (Maybe ValidEntry) -> Bool +validate_list2 l = case l of [] -> True - EMPTY :: tail -> - validate_list tail - - (Fixed m) :: tail -> - (member (Fixed m) tail || member (User m) tail) && validate_list tail + Nothing :: tail -> + validate_list2 tail - (User m) :: tail -> - (member (Fixed m) tail || member (User m) tail) && validate_list tail + m :: tail -> + member m tail && validate_list2 tail -- GitLab From 4f26ee879e3fc4a0c8b50458867c34a3e8a940d6 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Wed, 17 Apr 2019 11:56:47 +0200 Subject: [PATCH 28/82] move most functions regarding Sudoku into new Sudoku module - more work on generating Sudoku --- elm-examples/sudoku/index.html | 1365 ++++++++++++++++++++-------- elm-examples/sudoku/src/Main.elm | 5 +- elm-examples/sudoku/src/Model.elm | 33 +- elm-examples/sudoku/src/Sudoku.elm | 244 +++++ elm-examples/sudoku/src/Types.elm | 2 +- elm-examples/sudoku/src/Update.elm | 150 +-- 6 files changed, 1264 insertions(+), 535 deletions(-) create mode 100644 elm-examples/sudoku/src/Sudoku.elm diff --git a/elm-examples/sudoku/index.html b/elm-examples/sudoku/index.html index 04911c4..84a471c 100644 --- a/elm-examples/sudoku/index.html +++ b/elm-examples/sudoku/index.html @@ -863,6 +863,280 @@ var _Basics_xor = F2(function(a, b) { return a !== b; }); +var _Bitwise_and = F2(function(a, b) +{ + return a & b; +}); + +var _Bitwise_or = F2(function(a, b) +{ + return a | b; +}); + +var _Bitwise_xor = F2(function(a, b) +{ + return a ^ b; +}); + +function _Bitwise_complement(a) +{ + return ~a; +}; + +var _Bitwise_shiftLeftBy = F2(function(offset, a) +{ + return a << offset; +}); + +var _Bitwise_shiftRightBy = F2(function(offset, a) +{ + return a >> offset; +}); + +var _Bitwise_shiftRightZfBy = F2(function(offset, a) +{ + return a >>> offset; +}); + + + +// TASKS + +function _Scheduler_succeed(value) +{ + return { + $: 0, + a: value + }; +} + +function _Scheduler_fail(error) +{ + return { + $: 1, + a: error + }; +} + +function _Scheduler_binding(callback) +{ + return { + $: 2, + b: callback, + c: null + }; +} + +var _Scheduler_andThen = F2(function(callback, task) +{ + return { + $: 3, + b: callback, + d: task + }; +}); + +var _Scheduler_onError = F2(function(callback, task) +{ + return { + $: 4, + b: callback, + d: task + }; +}); + +function _Scheduler_receive(callback) +{ + return { + $: 5, + b: callback + }; +} + + +// PROCESSES + +var _Scheduler_guid = 0; + +function _Scheduler_rawSpawn(task) +{ + var proc = { + $: 0, + e: _Scheduler_guid++, + f: task, + g: null, + h: [] + }; + + _Scheduler_enqueue(proc); + + return proc; +} + +function _Scheduler_spawn(task) +{ + return _Scheduler_binding(function(callback) { + callback(_Scheduler_succeed(_Scheduler_rawSpawn(task))); + }); +} + +function _Scheduler_rawSend(proc, msg) +{ + proc.h.push(msg); + _Scheduler_enqueue(proc); +} + +var _Scheduler_send = F2(function(proc, msg) +{ + return _Scheduler_binding(function(callback) { + _Scheduler_rawSend(proc, msg); + callback(_Scheduler_succeed(_Utils_Tuple0)); + }); +}); + +function _Scheduler_kill(proc) +{ + return _Scheduler_binding(function(callback) { + var task = proc.f; + if (task.$ === 2 && task.c) + { + task.c(); + } + + proc.f = null; + + callback(_Scheduler_succeed(_Utils_Tuple0)); + }); +} + + +/* STEP PROCESSES + +type alias Process = + { $ : tag + , id : unique_id + , root : Task + , stack : null | { $: SUCCEED | FAIL, a: callback, b: stack } + , mailbox : [msg] + } + +*/ + + +var _Scheduler_working = false; +var _Scheduler_queue = []; + + +function _Scheduler_enqueue(proc) +{ + _Scheduler_queue.push(proc); + if (_Scheduler_working) + { + return; + } + _Scheduler_working = true; + while (proc = _Scheduler_queue.shift()) + { + _Scheduler_step(proc); + } + _Scheduler_working = false; +} + + +function _Scheduler_step(proc) +{ + while (proc.f) + { + var rootTag = proc.f.$; + if (rootTag === 0 || rootTag === 1) + { + while (proc.g && proc.g.$ !== rootTag) + { + proc.g = proc.g.i; + } + if (!proc.g) + { + return; + } + proc.f = proc.g.b(proc.f.a); + proc.g = proc.g.i; + } + else if (rootTag === 2) + { + proc.f.c = proc.f.b(function(newRoot) { + proc.f = newRoot; + _Scheduler_enqueue(proc); + }); + return; + } + else if (rootTag === 5) + { + if (proc.h.length === 0) + { + return; + } + proc.f = proc.f.b(proc.h.shift()); + } + else // if (rootTag === 3 || rootTag === 4) + { + proc.g = { + $: rootTag === 3 ? 0 : 1, + b: proc.f.b, + i: proc.g + }; + proc.f = proc.f.d; + } + } +} + + + +function _Time_now(millisToPosix) +{ + return _Scheduler_binding(function(callback) + { + callback(_Scheduler_succeed(millisToPosix(Date.now()))); + }); +} + +var _Time_setInterval = F2(function(interval, task) +{ + return _Scheduler_binding(function(callback) + { + var id = setInterval(function() { _Scheduler_rawSpawn(task); }, interval); + return function() { clearInterval(id); }; + }); +}); + +function _Time_here() +{ + return _Scheduler_binding(function(callback) + { + callback(_Scheduler_succeed( + A2(elm$time$Time$customZone, -(new Date().getTimezoneOffset()), _List_Nil) + )); + }); +} + + +function _Time_getZoneName() +{ + return _Scheduler_binding(function(callback) + { + try + { + var name = elm$time$Time$Name(Intl.DateTimeFormat().resolvedOptions().timeZone); + } + catch (e) + { + var name = elm$time$Time$Offset(new Date().getTimezoneOffset()); + } + callback(_Scheduler_succeed(name)); + }); +} + + + function _Char_toCode(char) { var code = char.charCodeAt(0); @@ -1654,198 +1928,7 @@ var _Json_encodeNull = _Json_wrap(null); -// TASKS - -function _Scheduler_succeed(value) -{ - return { - $: 0, - a: value - }; -} - -function _Scheduler_fail(error) -{ - return { - $: 1, - a: error - }; -} - -function _Scheduler_binding(callback) -{ - return { - $: 2, - b: callback, - c: null - }; -} - -var _Scheduler_andThen = F2(function(callback, task) -{ - return { - $: 3, - b: callback, - d: task - }; -}); - -var _Scheduler_onError = F2(function(callback, task) -{ - return { - $: 4, - b: callback, - d: task - }; -}); - -function _Scheduler_receive(callback) -{ - return { - $: 5, - b: callback - }; -} - - -// PROCESSES - -var _Scheduler_guid = 0; - -function _Scheduler_rawSpawn(task) -{ - var proc = { - $: 0, - e: _Scheduler_guid++, - f: task, - g: null, - h: [] - }; - - _Scheduler_enqueue(proc); - - return proc; -} - -function _Scheduler_spawn(task) -{ - return _Scheduler_binding(function(callback) { - callback(_Scheduler_succeed(_Scheduler_rawSpawn(task))); - }); -} - -function _Scheduler_rawSend(proc, msg) -{ - proc.h.push(msg); - _Scheduler_enqueue(proc); -} - -var _Scheduler_send = F2(function(proc, msg) -{ - return _Scheduler_binding(function(callback) { - _Scheduler_rawSend(proc, msg); - callback(_Scheduler_succeed(_Utils_Tuple0)); - }); -}); - -function _Scheduler_kill(proc) -{ - return _Scheduler_binding(function(callback) { - var task = proc.f; - if (task.$ === 2 && task.c) - { - task.c(); - } - - proc.f = null; - - callback(_Scheduler_succeed(_Utils_Tuple0)); - }); -} - - -/* STEP PROCESSES - -type alias Process = - { $ : tag - , id : unique_id - , root : Task - , stack : null | { $: SUCCEED | FAIL, a: callback, b: stack } - , mailbox : [msg] - } - -*/ - - -var _Scheduler_working = false; -var _Scheduler_queue = []; - - -function _Scheduler_enqueue(proc) -{ - _Scheduler_queue.push(proc); - if (_Scheduler_working) - { - return; - } - _Scheduler_working = true; - while (proc = _Scheduler_queue.shift()) - { - _Scheduler_step(proc); - } - _Scheduler_working = false; -} - - -function _Scheduler_step(proc) -{ - while (proc.f) - { - var rootTag = proc.f.$; - if (rootTag === 0 || rootTag === 1) - { - while (proc.g && proc.g.$ !== rootTag) - { - proc.g = proc.g.i; - } - if (!proc.g) - { - return; - } - proc.f = proc.g.b(proc.f.a); - proc.g = proc.g.i; - } - else if (rootTag === 2) - { - proc.f.c = proc.f.b(function(newRoot) { - proc.f = newRoot; - _Scheduler_enqueue(proc); - }); - return; - } - else if (rootTag === 5) - { - if (proc.h.length === 0) - { - return; - } - proc.f = proc.f.b(proc.h.shift()); - } - else // if (rootTag === 3 || rootTag === 4) - { - proc.g = { - $: rootTag === 3 ? 0 : 1, - b: proc.f.b, - i: proc.g - }; - proc.f = proc.f.d; - } - } -} - - - -function _Process_sleep(time) +function _Process_sleep(time) { return _Scheduler_binding(function(callback) { var id = setTimeout(function() { @@ -4424,13 +4507,69 @@ var elm$core$List$repeat = F2( function (n, value) { return A3(elm$core$List$repeatHelp, _List_Nil, n, value); }); -var author$project$Model$init = _Utils_Tuple2( - A2( - elm$core$List$repeat, - 9, - A2(elm$core$List$repeat, 9, author$project$Types$EMPTY)), - 'Empty'); +var author$project$Sudoku$empty_sudoku = A2( + elm$core$List$repeat, + 9, + A2(elm$core$List$repeat, 9, author$project$Types$EMPTY)); +var elm$core$Basics$False = {$: 'False'}; +var elm$core$Basics$True = {$: 'True'}; var elm$core$Basics$add = _Basics_add; +var author$project$Sudoku$next = function (_n0) { + var x = _n0.a; + var y = _n0.b; + var _n1 = _Utils_Tuple2(x, y); + if (_n1.b === 8) { + if (_n1.a === 8) { + return _Utils_Tuple2( + _Utils_Tuple2(8, 8), + true); + } else { + var l = _n1.a; + return _Utils_Tuple2( + _Utils_Tuple2(l + 1, 0), + false); + } + } else { + var l = _n1.a; + var s = _n1.b; + return _Utils_Tuple2( + _Utils_Tuple2(l, s + 1), + false); + } +}; +var author$project$Types$N1 = {$: 'N1'}; +var author$project$Types$N2 = {$: 'N2'}; +var author$project$Types$N3 = {$: 'N3'}; +var author$project$Types$N4 = {$: 'N4'}; +var author$project$Types$N5 = {$: 'N5'}; +var author$project$Types$N6 = {$: 'N6'}; +var author$project$Types$N7 = {$: 'N7'}; +var author$project$Types$N8 = {$: 'N8'}; +var author$project$Types$N9 = {$: 'N9'}; +var author$project$Sudoku$parse = function (e) { + switch (e) { + case 1: + return author$project$Types$N1; + case 2: + return author$project$Types$N2; + case 3: + return author$project$Types$N3; + case 4: + return author$project$Types$N4; + case 5: + return author$project$Types$N5; + case 6: + return author$project$Types$N6; + case 7: + return author$project$Types$N7; + case 8: + return author$project$Types$N8; + case 9: + return author$project$Types$N9; + default: + return author$project$Types$N9; + } +}; var elm$core$Basics$append = _Utils_append; var elm$core$List$drop = F2( function (n, list) { @@ -4602,7 +4741,7 @@ var elm$core$List$take = F2( function (n, list) { return A3(elm$core$List$takeFast, 0, n, list); }); -var author$project$Update$exchange_entry = F3( +var author$project$Sudoku$exchange_entry = F3( function (list, index, replacement) { return _Utils_ap( A2(elm$core$List$take, index, list), @@ -4620,8 +4759,8 @@ var elm$core$Maybe$withDefault = F2( return _default; } }); -var author$project$Update$update_sudoku_row = function (row) { - return author$project$Update$exchange_entry( +var author$project$Sudoku$update_sudoku_row = function (row) { + return author$project$Sudoku$exchange_entry( A2( elm$core$Maybe$withDefault, A2(elm$core$List$repeat, 9, author$project$Types$EMPTY), @@ -4640,47 +4779,29 @@ var elm$core$List$head = function (list) { return elm$core$Maybe$Nothing; } }; -var author$project$Update$update_sudoku = F3( +var author$project$Sudoku$update_sudoku = F3( function (sudoku, _n0, entry) { var row = _n0.a; var column = _n0.b; return A3( - author$project$Update$exchange_entry, + author$project$Sudoku$exchange_entry, sudoku, row, A3( - author$project$Update$update_sudoku_row, + author$project$Sudoku$update_sudoku_row, elm$core$List$head( A2(elm$core$List$drop, row, sudoku)), column, entry)); }); -var author$project$Update$update = F2( - function (msg, _n0) { - var sudoku = _n0.a; - var text = _n0.b; - if (msg.$ === 'Msg') { - var position = msg.a; - var entry = msg.b; - var sudoku2 = A3(author$project$Update$update_sudoku, sudoku, position, entry); - return _Utils_Tuple2(sudoku2, text); - } else { - var _int = msg.a; - return _Utils_Tuple2(sudoku, text); - } +var elm$core$Basics$mul = _Basics_mul; +var author$project$Sudoku$td3 = F2( + function (n, list) { + return A2( + elm$core$List$take, + 3, + A2(elm$core$List$drop, n * 3, list)); }); -var author$project$Types$N1 = {$: 'N1'}; -var author$project$Types$N2 = {$: 'N2'}; -var author$project$Types$N3 = {$: 'N3'}; -var author$project$Types$N4 = {$: 'N4'}; -var author$project$Types$N5 = {$: 'N5'}; -var author$project$Types$N6 = {$: 'N6'}; -var author$project$Types$N7 = {$: 'N7'}; -var author$project$Types$N8 = {$: 'N8'}; -var author$project$Types$N9 = {$: 'N9'}; -var author$project$Types$User = function (a) { - return {$: 'User', a: a}; -}; var elm$core$List$foldrHelper = F4( function (fn, acc, ctr, ls) { if (!ls.b) { @@ -4736,6 +4857,29 @@ var elm$core$List$foldr = F3( function (fn, acc, ls) { return A4(elm$core$List$foldrHelper, fn, acc, 0, ls); }); +var elm$core$List$append = F2( + function (xs, ys) { + if (!ys.b) { + return xs; + } else { + return A3(elm$core$List$foldr, elm$core$List$cons, ys, xs); + } + }); +var author$project$Sudoku$extract_area = F2( + function (s, _n0) { + var r = _n0.a; + var c = _n0.b; + return A3( + elm$core$List$foldr, + elm$core$List$append, + _List_Nil, + A2( + author$project$Sudoku$td3, + c, + A2(author$project$Sudoku$td3, r, s))); + }); +var elm$core$Basics$idiv = _Basics_idiv; +var elm$core$Basics$remainderBy = _Basics_remainderBy; var elm$core$List$map = F2( function (f, xs) { return A3( @@ -4750,91 +4894,475 @@ var elm$core$List$map = F2( _List_Nil, xs); }); -var author$project$Types$all_options = A2( - elm$core$List$cons, - author$project$Types$EMPTY, - A2( - elm$core$List$map, - function (e) { - return author$project$Types$User(e); - }, - _List_fromArray( - [author$project$Types$N1, author$project$Types$N2, author$project$Types$N3, author$project$Types$N4, author$project$Types$N5, author$project$Types$N6, author$project$Types$N7, author$project$Types$N8, author$project$Types$N9]))); -var author$project$Types$Msg = F2( - function (a, b) { - return {$: 'Msg', a: a, b: b}; +var elm$core$List$rangeHelp = F3( + function (lo, hi, list) { + rangeHelp: + while (true) { + if (_Utils_cmp(lo, hi) < 1) { + var $temp$lo = lo, + $temp$hi = hi - 1, + $temp$list = A2(elm$core$List$cons, hi, list); + lo = $temp$lo; + hi = $temp$hi; + list = $temp$list; + continue rangeHelp; + } else { + return list; + } + } }); -var author$project$View$parse = function (e) { - switch (e) { - case '1': - return author$project$Types$User(author$project$Types$N1); - case '2': - return author$project$Types$User(author$project$Types$N2); - case '3': - return author$project$Types$User(author$project$Types$N3); - case '4': - return author$project$Types$User(author$project$Types$N4); - case '5': - return author$project$Types$User(author$project$Types$N5); - case '6': - return author$project$Types$User(author$project$Types$N6); - case '7': - return author$project$Types$User(author$project$Types$N7); - case '8': - return author$project$Types$User(author$project$Types$N8); - case '9': - return author$project$Types$User(author$project$Types$N9); - default: - return author$project$Types$EMPTY; - } +var elm$core$List$range = F2( + function (lo, hi) { + return A3(elm$core$List$rangeHelp, lo, hi, _List_Nil); + }); +var author$project$Sudoku$extract_areas = function (sudoku) { + return A2( + elm$core$List$map, + author$project$Sudoku$extract_area(sudoku), + A2( + elm$core$List$map, + function (n) { + return _Utils_Tuple2((n / 3) | 0, n % 3); + }, + A2(elm$core$List$range, 0, 8))); }; -var author$project$View$conv_to_msg = F2( - function (pos, a) { +var author$project$Sudoku$element = F2( + function (index, list) { + var _n0 = A2( + elm$core$List$take, + 1, + A2(elm$core$List$drop, index - 1, list)); + if (!_n0.b) { + return elm$core$Maybe$Nothing; + } else { + var x = _n0.a; + return elm$core$Maybe$Just(x); + } + }); +var elm$core$List$maybeCons = F3( + function (f, mx, xs) { + var _n0 = f(mx); + if (_n0.$ === 'Just') { + var x = _n0.a; + return A2(elm$core$List$cons, x, xs); + } else { + return xs; + } + }); +var elm$core$List$filterMap = F2( + function (f, xs) { + return A3( + elm$core$List$foldr, + elm$core$List$maybeCons(f), + _List_Nil, + xs); + }); +var author$project$Sudoku$nth_column = F2( + function (list, index) { return A2( - author$project$Types$Msg, - pos, - author$project$View$parse(a)); + elm$core$List$filterMap, + author$project$Sudoku$element(index), + list); }); -var author$project$View$show = function (e) { - switch (e.$) { - case 'N1': - return '1'; - case 'N2': - return '2'; - case 'N3': - return '3'; - case 'N4': - return '4'; - case 'N5': - return '5'; - case 'N6': - return '6'; - case 'N7': - return '7'; - case 'N8': - return '8'; - default: - return '9'; +var elm$core$List$length = function (xs) { + return A3( + elm$core$List$foldl, + F2( + function (_n0, i) { + return i + 1; + }), + 0, + xs); +}; +var author$project$Sudoku$transpose = function (list) { + if (!list.b) { + return _List_Nil; + } else { + var x = list.a; + return A2( + elm$core$List$map, + author$project$Sudoku$nth_column(list), + A2( + elm$core$List$range, + 0, + elm$core$List$length(x) - 1)); } }; -var author$project$View$show_entry = function (entry) { - switch (entry.$) { +var author$project$Sudoku$extract_columns = author$project$Sudoku$transpose; +var author$project$Sudoku$extract_rows = function (sudoku) { + return sudoku; +}; +var author$project$Sudoku$entry_to_maybe = function (v) { + switch (v.$) { case 'EMPTY': - return ''; + return elm$core$Maybe$Nothing; case 'User': - var e = entry.a; - return author$project$View$show(e); + var m = v.a; + return elm$core$Maybe$Just(m); default: - var e = entry.a; - return author$project$View$show(e); + var m = v.a; + return elm$core$Maybe$Just(m); } }; +var elm$core$Basics$and = _Basics_and; var elm$core$Basics$eq = _Utils_equal; +var elm$core$List$any = F2( + function (isOkay, list) { + any: + while (true) { + if (!list.b) { + return false; + } else { + var x = list.a; + var xs = list.b; + if (isOkay(x)) { + return true; + } else { + var $temp$isOkay = isOkay, + $temp$list = xs; + isOkay = $temp$isOkay; + list = $temp$list; + continue any; + } + } + } + }); +var elm$core$List$member = F2( + function (x, xs) { + return A2( + elm$core$List$any, + function (a) { + return _Utils_eq(a, x); + }, + xs); + }); +var author$project$Sudoku$validate_list2 = function (l) { + validate_list2: + while (true) { + if (!l.b) { + return true; + } else { + if (l.a.$ === 'Nothing') { + var _n1 = l.a; + var tail = l.b; + var $temp$l = tail; + l = $temp$l; + continue validate_list2; + } else { + var m = l.a; + var tail = l.b; + return A2(elm$core$List$member, m, tail) && author$project$Sudoku$validate_list2(tail); + } + } + } +}; +var author$project$Sudoku$validate_list = function (l) { + return author$project$Sudoku$validate_list2( + A2(elm$core$List$map, author$project$Sudoku$entry_to_maybe, l)); +}; +var author$project$Sudoku$validate_feature = F2( + function (sudoku, extractor) { + return A3( + elm$core$List$foldr, + elm$core$Basics$and, + true, + A2( + elm$core$List$map, + author$project$Sudoku$validate_list, + extractor(sudoku))); + }); +var author$project$Sudoku$validate_sudoku = function (sudoku) { + return A3( + elm$core$List$foldl, + elm$core$Basics$and, + true, + A2( + elm$core$List$map, + author$project$Sudoku$validate_feature(sudoku), + _List_fromArray( + [author$project$Sudoku$extract_rows, author$project$Sudoku$extract_columns, author$project$Sudoku$extract_areas]))); +}; +var author$project$Types$Fixed = function (a) { + return {$: 'Fixed', a: a}; +}; +var elm$core$Basics$apL = F2( + function (f, x) { + return f(x); + }); var elm$core$Basics$identity = function (x) { return x; }; -var elm$core$Basics$False = {$: 'False'}; -var elm$core$Basics$True = {$: 'True'}; +var elm$random$Random$Generator = function (a) { + return {$: 'Generator', a: a}; +}; +var elm$random$Random$andThen = F2( + function (callback, _n0) { + var genA = _n0.a; + return elm$random$Random$Generator( + function (seed) { + var _n1 = genA(seed); + var result = _n1.a; + var newSeed = _n1.b; + var _n2 = callback(result); + var genB = _n2.a; + return genB(newSeed); + }); + }); +var elm$random$Random$constant = function (value) { + return elm$random$Random$Generator( + function (seed) { + return _Utils_Tuple2(value, seed); + }); +}; +var elm$core$Basics$lt = _Utils_lt; +var elm$core$Basics$negate = function (n) { + return -n; +}; +var elm$core$Bitwise$and = _Bitwise_and; +var elm$core$Bitwise$shiftRightZfBy = _Bitwise_shiftRightZfBy; +var elm$random$Random$Seed = F2( + function (a, b) { + return {$: 'Seed', a: a, b: b}; + }); +var elm$random$Random$next = function (_n0) { + var state0 = _n0.a; + var incr = _n0.b; + return A2(elm$random$Random$Seed, ((state0 * 1664525) + incr) >>> 0, incr); +}; +var elm$core$Bitwise$xor = _Bitwise_xor; +var elm$random$Random$peel = function (_n0) { + var state = _n0.a; + var word = (state ^ (state >>> ((state >>> 28) + 4))) * 277803737; + return ((word >>> 22) ^ word) >>> 0; +}; +var elm$random$Random$int = F2( + function (a, b) { + return elm$random$Random$Generator( + function (seed0) { + var _n0 = (_Utils_cmp(a, b) < 0) ? _Utils_Tuple2(a, b) : _Utils_Tuple2(b, a); + var lo = _n0.a; + var hi = _n0.b; + var range = (hi - lo) + 1; + if (!((range - 1) & range)) { + return _Utils_Tuple2( + (((range - 1) & elm$random$Random$peel(seed0)) >>> 0) + lo, + elm$random$Random$next(seed0)); + } else { + var threshhold = (((-range) >>> 0) % range) >>> 0; + var accountForBias = function (seed) { + accountForBias: + while (true) { + var x = elm$random$Random$peel(seed); + var seedN = elm$random$Random$next(seed); + if (_Utils_cmp(x, threshhold) < 0) { + var $temp$seed = seedN; + seed = $temp$seed; + continue accountForBias; + } else { + return _Utils_Tuple2((x % range) + lo, seedN); + } + } + }; + return accountForBias(seed0); + } + }); + }); +var elm$random$Random$lazy = function (callback) { + return elm$random$Random$Generator( + function (seed) { + var _n0 = callback(_Utils_Tuple0); + var gen = _n0.a; + return gen(seed); + }); +}; +var elm$random$Random$addOne = function (value) { + return _Utils_Tuple2(1, value); +}; +var elm$core$Basics$abs = function (n) { + return (n < 0) ? (-n) : n; +}; +var elm$core$List$sum = function (numbers) { + return A3(elm$core$List$foldl, elm$core$Basics$add, 0, numbers); +}; +var elm$core$Basics$fdiv = _Basics_fdiv; +var elm$core$Basics$toFloat = _Basics_toFloat; +var elm$random$Random$float = F2( + function (a, b) { + return elm$random$Random$Generator( + function (seed0) { + var seed1 = elm$random$Random$next(seed0); + var range = elm$core$Basics$abs(b - a); + var n1 = elm$random$Random$peel(seed1); + var n0 = elm$random$Random$peel(seed0); + var lo = (134217727 & n1) * 1.0; + var hi = (67108863 & n0) * 1.0; + var val = ((hi * 1.34217728e8) + lo) / 9.007199254740992e15; + var scaled = (val * range) + a; + return _Utils_Tuple2( + scaled, + elm$random$Random$next(seed1)); + }); + }); +var elm$random$Random$getByWeight = F3( + function (_n0, others, countdown) { + getByWeight: + while (true) { + var weight = _n0.a; + var value = _n0.b; + if (!others.b) { + return value; + } else { + var second = others.a; + var otherOthers = others.b; + if (_Utils_cmp( + countdown, + elm$core$Basics$abs(weight)) < 1) { + return value; + } else { + var $temp$_n0 = second, + $temp$others = otherOthers, + $temp$countdown = countdown - elm$core$Basics$abs(weight); + _n0 = $temp$_n0; + others = $temp$others; + countdown = $temp$countdown; + continue getByWeight; + } + } + } + }); +var elm$random$Random$map = F2( + function (func, _n0) { + var genA = _n0.a; + return elm$random$Random$Generator( + function (seed0) { + var _n1 = genA(seed0); + var a = _n1.a; + var seed1 = _n1.b; + return _Utils_Tuple2( + func(a), + seed1); + }); + }); +var elm$random$Random$weighted = F2( + function (first, others) { + var normalize = function (_n0) { + var weight = _n0.a; + return elm$core$Basics$abs(weight); + }; + var total = normalize(first) + elm$core$List$sum( + A2(elm$core$List$map, normalize, others)); + return A2( + elm$random$Random$map, + A2(elm$random$Random$getByWeight, first, others), + A2(elm$random$Random$float, 0, total)); + }); +var elm$random$Random$uniform = F2( + function (value, valueList) { + return A2( + elm$random$Random$weighted, + elm$random$Random$addOne(value), + A2(elm$core$List$map, elm$random$Random$addOne, valueList)); + }); +var author$project$Sudoku$try_insert = F3( + function (p, s, _int) { + var possibleMaybeValues = A2( + elm$core$List$map, + function (a) { + return elm$core$Maybe$Just(a); + }, + A2(elm$core$List$range, 1, 9)); + var _new = A3( + author$project$Sudoku$update_sudoku, + s, + p, + author$project$Types$Fixed( + author$project$Sudoku$parse(_int))); + var _n0 = author$project$Sudoku$next(p); + var n = _n0.a; + var done = _n0.b; + var res = function () { + var _n1 = author$project$Sudoku$validate_sudoku(s); + if (_n1) { + if (done) { + return elm$random$Random$constant( + elm$core$Maybe$Just(_new)); + } else { + return A2( + elm$random$Random$andThen, + function (may) { + if (may.$ === 'Just') { + var a = may.a; + return A3(author$project$Sudoku$try_insert, n, _new, a); + } else { + return elm$random$Random$constant(elm$core$Maybe$Nothing); + } + }, + elm$random$Random$lazy( + function (_n4) { + return A2(elm$random$Random$uniform, elm$core$Maybe$Nothing, possibleMaybeValues); + })); + } + } else { + return A2( + elm$random$Random$andThen, + A2(author$project$Sudoku$try_insert, p, s), + A2(elm$random$Random$int, 1, 9)); + } + }(); + return res; + }); +var author$project$Sudoku$gen_sudoku = A2( + elm$random$Random$andThen, + A2( + author$project$Sudoku$try_insert, + _Utils_Tuple2(0, 0), + author$project$Sudoku$empty_sudoku), + A2(elm$random$Random$int, 1, 9)); +var author$project$Types$Random = function (a) { + return {$: 'Random', a: a}; +}; +var elm$random$Random$Generate = function (a) { + return {$: 'Generate', a: a}; +}; +var elm$core$Task$andThen = _Scheduler_andThen; +var elm$core$Task$succeed = _Scheduler_succeed; +var elm$random$Random$initialSeed = function (x) { + var _n0 = elm$random$Random$next( + A2(elm$random$Random$Seed, 0, 1013904223)); + var state1 = _n0.a; + var incr = _n0.b; + var state2 = (state1 + x) >>> 0; + return elm$random$Random$next( + A2(elm$random$Random$Seed, state2, incr)); +}; +var elm$time$Time$Name = function (a) { + return {$: 'Name', a: a}; +}; +var elm$time$Time$Offset = function (a) { + return {$: 'Offset', a: a}; +}; +var elm$time$Time$Zone = F2( + function (a, b) { + return {$: 'Zone', a: a, b: b}; + }); +var elm$time$Time$customZone = elm$time$Time$Zone; +var elm$time$Time$Posix = function (a) { + return {$: 'Posix', a: a}; +}; +var elm$time$Time$millisToPosix = elm$time$Time$Posix; +var elm$time$Time$now = _Time_now(elm$time$Time$millisToPosix); +var elm$time$Time$posixToMillis = function (_n0) { + var millis = _n0.a; + return millis; +}; +var elm$random$Random$init = A2( + elm$core$Task$andThen, + function (time) { + return elm$core$Task$succeed( + elm$random$Random$initialSeed( + elm$time$Time$posixToMillis(time))); + }, + elm$time$Time$now); var elm$core$Result$isOk = function (result) { if (result.$ === 'Ok') { return true; @@ -4848,12 +5376,10 @@ var elm$core$Array$Array_elm_builtin = F4( return {$: 'Array_elm_builtin', a: a, b: b, c: c, d: d}; }); var elm$core$Basics$ceiling = _Basics_ceiling; -var elm$core$Basics$fdiv = _Basics_fdiv; var elm$core$Basics$logBase = F2( function (base, number) { return _Basics_log(number) / _Basics_log(base); }); -var elm$core$Basics$toFloat = _Basics_toFloat; var elm$core$Array$shiftStep = elm$core$Basics$ceiling( A2(elm$core$Basics$logBase, 2, elm$core$Array$branchFactor)); var elm$core$Elm$JsArray$empty = _JsArray_empty; @@ -4911,16 +5437,11 @@ var elm$core$Array$treeFromBuilder = F2( } } }); -var elm$core$Basics$apL = F2( - function (f, x) { - return f(x); - }); var elm$core$Basics$floor = _Basics_floor; var elm$core$Basics$max = F2( function (x, y) { return (_Utils_cmp(x, y) > 0) ? x : y; }); -var elm$core$Basics$mul = _Basics_mul; var elm$core$Elm$JsArray$length = _JsArray_length; var elm$core$Array$builderToArray = F2( function (reverseNodeList, builder) { @@ -4945,8 +5466,6 @@ var elm$core$Array$builderToArray = F2( builder.tail); } }); -var elm$core$Basics$idiv = _Basics_idiv; -var elm$core$Basics$lt = _Utils_lt; var elm$core$Elm$JsArray$initialize = _JsArray_initialize; var elm$core$Array$initializeHelp = F5( function (fn, fromIndex, len, nodeList, tail) { @@ -4974,7 +5493,6 @@ var elm$core$Array$initializeHelp = F5( } } }); -var elm$core$Basics$remainderBy = _Basics_remainderBy; var elm$core$Array$initialize = F2( function (len, fn) { if (len <= 0) { @@ -5007,7 +5525,6 @@ var elm$json$Json$Decode$Index = F2( var elm$json$Json$Decode$OneOf = function (a) { return {$: 'OneOf', a: a}; }; -var elm$core$Basics$and = _Basics_and; var elm$core$Basics$or = _Basics_or; var elm$core$Char$toCode = _Char_toCode; var elm$core$Char$isLower = function (_char) { @@ -5028,38 +5545,7 @@ var elm$core$Char$isDigit = function (_char) { var elm$core$Char$isAlphaNum = function (_char) { return elm$core$Char$isLower(_char) || (elm$core$Char$isUpper(_char) || elm$core$Char$isDigit(_char)); }; -var elm$core$List$length = function (xs) { - return A3( - elm$core$List$foldl, - F2( - function (_n0, i) { - return i + 1; - }), - 0, - xs); -}; var elm$core$List$map2 = _List_map2; -var elm$core$List$rangeHelp = F3( - function (lo, hi, list) { - rangeHelp: - while (true) { - if (_Utils_cmp(lo, hi) < 1) { - var $temp$lo = lo, - $temp$hi = hi - 1, - $temp$list = A2(elm$core$List$cons, hi, list); - lo = $temp$lo; - hi = $temp$hi; - list = $temp$list; - continue rangeHelp; - } else { - return list; - } - } - }); -var elm$core$List$range = F2( - function (lo, hi) { - return A3(elm$core$List$rangeHelp, lo, hi, _List_Nil); - }); var elm$core$List$indexedMap = F2( function (f, xs) { return A3( @@ -5196,6 +5682,173 @@ var elm$json$Json$Decode$errorToStringHelp = F2( } } }); +var elm$core$Platform$sendToApp = _Platform_sendToApp; +var elm$random$Random$step = F2( + function (_n0, seed) { + var generator = _n0.a; + return generator(seed); + }); +var elm$random$Random$onEffects = F3( + function (router, commands, seed) { + if (!commands.b) { + return elm$core$Task$succeed(seed); + } else { + var generator = commands.a.a; + var rest = commands.b; + var _n1 = A2(elm$random$Random$step, generator, seed); + var value = _n1.a; + var newSeed = _n1.b; + return A2( + elm$core$Task$andThen, + function (_n2) { + return A3(elm$random$Random$onEffects, router, rest, newSeed); + }, + A2(elm$core$Platform$sendToApp, router, value)); + } + }); +var elm$random$Random$onSelfMsg = F3( + function (_n0, _n1, seed) { + return elm$core$Task$succeed(seed); + }); +var elm$random$Random$cmdMap = F2( + function (func, _n0) { + var generator = _n0.a; + return elm$random$Random$Generate( + A2(elm$random$Random$map, func, generator)); + }); +_Platform_effectManagers['Random'] = _Platform_createManager(elm$random$Random$init, elm$random$Random$onEffects, elm$random$Random$onSelfMsg, elm$random$Random$cmdMap); +var elm$random$Random$command = _Platform_leaf('Random'); +var elm$random$Random$generate = F2( + function (tagger, generator) { + return elm$random$Random$command( + elm$random$Random$Generate( + A2(elm$random$Random$map, tagger, generator))); + }); +var author$project$Sudoku$rnd = A2( + elm$random$Random$generate, + function (i) { + return author$project$Types$Random(i); + }, + author$project$Sudoku$gen_sudoku); +var author$project$Model$init = function (_n0) { + return _Utils_Tuple2( + _Utils_Tuple2(author$project$Sudoku$empty_sudoku, 'Empty'), + author$project$Sudoku$rnd); +}; +var elm$core$Platform$Sub$batch = _Platform_batch; +var elm$core$Platform$Sub$none = elm$core$Platform$Sub$batch(_List_Nil); +var author$project$Model$subs = function (_n0) { + return elm$core$Platform$Sub$none; +}; +var elm$core$Platform$Cmd$batch = _Platform_batch; +var elm$core$Platform$Cmd$none = elm$core$Platform$Cmd$batch(_List_Nil); +var author$project$Update$update = F2( + function (msg, _n0) { + var sudoku = _n0.a; + var text = _n0.b; + if (msg.$ === 'Msg') { + var position = msg.a; + var entry = msg.b; + var sudoku2 = A3(author$project$Sudoku$update_sudoku, sudoku, position, entry); + return _Utils_Tuple2( + _Utils_Tuple2(sudoku2, text), + elm$core$Platform$Cmd$none); + } else { + if (msg.a.$ === 'Nothing') { + var _n2 = msg.a; + return _Utils_Tuple2( + _Utils_Tuple2(sudoku, text), + author$project$Sudoku$rnd); + } else { + var s = msg.a.a; + return _Utils_Tuple2( + _Utils_Tuple2(s, text), + elm$core$Platform$Cmd$none); + } + } + }); +var author$project$Types$User = function (a) { + return {$: 'User', a: a}; +}; +var author$project$Types$all_options = A2( + elm$core$List$cons, + author$project$Types$EMPTY, + A2( + elm$core$List$map, + function (e) { + return author$project$Types$User(e); + }, + _List_fromArray( + [author$project$Types$N1, author$project$Types$N2, author$project$Types$N3, author$project$Types$N4, author$project$Types$N5, author$project$Types$N6, author$project$Types$N7, author$project$Types$N8, author$project$Types$N9]))); +var author$project$Types$Msg = F2( + function (a, b) { + return {$: 'Msg', a: a, b: b}; + }); +var author$project$View$parse = function (e) { + switch (e) { + case '1': + return author$project$Types$User(author$project$Types$N1); + case '2': + return author$project$Types$User(author$project$Types$N2); + case '3': + return author$project$Types$User(author$project$Types$N3); + case '4': + return author$project$Types$User(author$project$Types$N4); + case '5': + return author$project$Types$User(author$project$Types$N5); + case '6': + return author$project$Types$User(author$project$Types$N6); + case '7': + return author$project$Types$User(author$project$Types$N7); + case '8': + return author$project$Types$User(author$project$Types$N8); + case '9': + return author$project$Types$User(author$project$Types$N9); + default: + return author$project$Types$EMPTY; + } +}; +var author$project$View$conv_to_msg = F2( + function (pos, a) { + return A2( + author$project$Types$Msg, + pos, + author$project$View$parse(a)); + }); +var author$project$View$show = function (e) { + switch (e.$) { + case 'N1': + return '1'; + case 'N2': + return '2'; + case 'N3': + return '3'; + case 'N4': + return '4'; + case 'N5': + return '5'; + case 'N6': + return '6'; + case 'N7': + return '7'; + case 'N8': + return '8'; + default: + return '9'; + } +}; +var author$project$View$show_entry = function (entry) { + switch (entry.$) { + case 'EMPTY': + return ''; + case 'User': + var e = entry.a; + return author$project$View$show(e); + default: + var e = entry.a; + return author$project$View$show(e); + } +}; var elm$json$Json$Decode$map = _Json_map1; var elm$json$Json$Decode$map2 = _Json_map2; var elm$json$Json$Decode$succeed = _Json_succeed; @@ -5370,10 +6023,6 @@ var author$project$View$view = function (_n0) { elm$html$Html$text(msg) ])); }; -var elm$core$Platform$Cmd$batch = _Platform_batch; -var elm$core$Platform$Cmd$none = elm$core$Platform$Cmd$batch(_List_Nil); -var elm$core$Platform$Sub$batch = _Platform_batch; -var elm$core$Platform$Sub$none = elm$core$Platform$Sub$batch(_List_Nil); var elm$browser$Browser$External = function (a) { return {$: 'External', a: a}; }; @@ -5395,9 +6044,7 @@ var elm$core$Basics$never = function (_n0) { var elm$core$Task$Perform = function (a) { return {$: 'Perform', a: a}; }; -var elm$core$Task$succeed = _Scheduler_succeed; var elm$core$Task$init = elm$core$Task$succeed(_Utils_Tuple0); -var elm$core$Task$andThen = _Scheduler_andThen; var elm$core$Task$map = F2( function (func, taskA) { return A2( @@ -5430,7 +6077,6 @@ var elm$core$Task$sequence = function (tasks) { elm$core$Task$succeed(_List_Nil), tasks); }; -var elm$core$Platform$sendToApp = _Platform_sendToApp; var elm$core$Task$spawnCmd = F2( function (router, _n0) { var task = _n0.a; @@ -5600,26 +6246,9 @@ var elm$url$Url$fromString = function (str) { elm$url$Url$Https, A2(elm$core$String$dropLeft, 8, str)) : elm$core$Maybe$Nothing); }; -var elm$browser$Browser$sandbox = function (impl) { - return _Browser_element( - { - init: function (_n0) { - return _Utils_Tuple2(impl.init, elm$core$Platform$Cmd$none); - }, - subscriptions: function (_n1) { - return elm$core$Platform$Sub$none; - }, - update: F2( - function (msg, model) { - return _Utils_Tuple2( - A2(impl.update, msg, model), - elm$core$Platform$Cmd$none); - }), - view: impl.view - }); -}; -var author$project$Main$main = elm$browser$Browser$sandbox( - {init: author$project$Model$init, update: author$project$Update$update, view: author$project$View$view}); +var elm$browser$Browser$element = _Browser_element; +var author$project$Main$main = elm$browser$Browser$element( + {init: author$project$Model$init, subscriptions: author$project$Model$subs, update: author$project$Update$update, view: author$project$View$view}); _Platform_export({'Main':{'init':author$project$Main$main( elm$json$Json$Decode$succeed(_Utils_Tuple0))(0)}});}(this)); diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index e7de028..fb3b6e6 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -5,10 +5,13 @@ module Main exposing (main) -- View ---------------------------------------------------------------------------------------------------------------- import Browser +import Html exposing (Html) import Model exposing (..) +import Types exposing (Model, Msg) import Update exposing (..) import View exposing (..) +main : Program () Model Msg main = - Browser.sandbox { init = init, update = update, view = view } + Browser.element { init = init, update = update, view = view, subscriptions = subs } diff --git a/elm-examples/sudoku/src/Model.elm b/elm-examples/sudoku/src/Model.elm index faee34e..de10a85 100644 --- a/elm-examples/sudoku/src/Model.elm +++ b/elm-examples/sudoku/src/Model.elm @@ -1,31 +1,14 @@ -module Model exposing (init) +module Model exposing (init, subs) -import List exposing (repeat) -import Random exposing (generate) +import Sudoku exposing (empty_sudoku, rnd) import Types exposing (..) -init : Model -init = - ( repeat 9 (repeat 9 EMPTY), "Empty" ) +init : a -> ( Model, Cmd Msg ) +init _ = + ( ( empty_sudoku, "Empty" ), rnd ) - --- Generate Sudoku ----------------------------------------------------------------------------------------------------- - - -create_sudoku : Sudoku -create_sudoku = - [] - - -rnd : Cmd Msg -rnd = - let - generator = - Random.int 1 9 - - id = - \n -> Random n - in - generate id generator +subs : Model -> Sub Msg +subs _ = + Sub.none diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm new file mode 100644 index 0000000..92313a2 --- /dev/null +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -0,0 +1,244 @@ +module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, next, nth_column, parse, rnd, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_feature, validate_list, validate_list2, validate_sudoku) + +import List exposing (..) +import Random exposing (Generator, generate) +import Types exposing (..) + + +empty_sudoku : Sudoku +empty_sudoku = + repeat 9 (repeat 9 EMPTY) + + +validate_sudoku : Sudoku -> Bool +validate_sudoku sudoku = + List.foldl (&&) True (map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ]) + + +validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool +validate_feature sudoku extractor = + List.foldr (&&) True (map validate_list (extractor sudoku)) + + +validate_list : List Entry -> Bool +validate_list l = + validate_list2 (map entry_to_maybe l) + + +entry_to_maybe : Entry -> Maybe ValidEntry +entry_to_maybe v = + case v of + EMPTY -> + Nothing + + User m -> + Just m + + Fixed m -> + Just m + + +validate_list2 : List (Maybe ValidEntry) -> Bool +validate_list2 l = + case l of + [] -> + True + + Nothing :: tail -> + validate_list2 tail + + m :: tail -> + member m tail && validate_list2 tail + + + +-- Creates a list of area entry lists + + +extract_areas : Sudoku -> List (List Entry) +extract_areas sudoku = + map + (extract_area sudoku) + (map + (\n -> ( n // 3, remainderBy 3 n )) + (range 0 8) + ) + + + +-- Drops the first 3*n elements of a list and returns 3 elements of the remainder + + +td3 : Int -> List a -> List a +td3 n list = + take 3 (drop (n * 3) list) + + + +-- Returns a list of 9 entries that form the area defined by the position + + +extract_area : Sudoku -> Position -> List Entry +extract_area s ( r, c ) = + foldr append [] (td3 c (td3 r s)) + + +extract_rows : Sudoku -> List (List Entry) +extract_rows sudoku = + sudoku + + +extract_columns : Sudoku -> List (List Entry) +extract_columns = + transpose + + +transpose : List (List a) -> List (List a) +transpose list = + case list of + [] -> + [] + + x :: _ -> + map (nth_column list) (range 0 (List.length x - 1)) + + + +-- Returns a list of nth elements if they exist + + +nth_column : List (List a) -> Int -> List a +nth_column list index = + List.filterMap (element index) list + + + +-- Returns the nth element of a list + + +element : Int -> List a -> Maybe a +element index list = + case List.take 1 (List.drop (index - 1) list) of + [] -> + Nothing + + x :: _ -> + Just x + + + +-- Generate Sudoku ----------------------------------------------------------------------------------------------------- + + +update_sudoku : Sudoku -> Position -> Entry -> Sudoku +update_sudoku sudoku ( row, column ) entry = + exchange_entry sudoku row (update_sudoku_row (List.head (drop row sudoku)) column entry) + + +update_sudoku_row : Maybe Row -> Int -> Entry -> Row +update_sudoku_row row = + exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) + + +exchange_entry : List a -> Int -> a -> List a +exchange_entry list index replacement = + take index list ++ [ replacement ] ++ drop (index + 1) list + + + +--take (index - 1) list ++ [ replacement ] ++ drop index list + + +rnd : Cmd Msg +rnd = + generate (\i -> Random i) gen_sudoku + + +gen_sudoku : Generator (Maybe Sudoku) +gen_sudoku = + Random.andThen (try_insert ( 0, 0 ) empty_sudoku) (Random.int 1 9) + + +try_insert : Position -> Sudoku -> Int -> Generator (Maybe Sudoku) +try_insert p s int = + let + new = + update_sudoku s p (Fixed (parse int)) + + ( n, done ) = + next p + + possibleMaybeValues = + List.map (\a -> Just a) <| List.range 1 9 + + res = + case validate_sudoku s of + True -> + case done of + True -> + Random.constant <| Just new + + False -> + Random.andThen + (\may -> + case may of + Just a -> + try_insert n new a + + Nothing -> + Random.constant Nothing + ) + <| + Random.lazy (\_ -> Random.uniform Nothing possibleMaybeValues) + + False -> + Random.andThen (try_insert p s) <| Random.int 1 9 + in + res + + +next : ( Int, Int ) -> ( ( Int, Int ), Bool ) +next ( x, y ) = + case ( x, y ) of + ( 8, 8 ) -> + ( ( 8, 8 ), True ) + + ( l, 8 ) -> + ( ( l + 1, 0 ), False ) + + ( l, s ) -> + ( ( l, s + 1 ), False ) + + +parse : Int -> ValidEntry +parse e = + case e of + 1 -> + N1 + + 2 -> + N2 + + 3 -> + N3 + + 4 -> + N4 + + 5 -> + N5 + + 6 -> + N6 + + 7 -> + N7 + + 8 -> + N8 + + 9 -> + N9 + + _ -> + N9 diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index aef2d99..e8ce0de 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -43,4 +43,4 @@ type alias Position = type Msg = Msg Position Entry - | Random Int + | Random (Maybe Sudoku) diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index da63350..3a1ec34 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,40 +1,26 @@ -module Update exposing (element, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, has_emptys, no_emptys_sudoku, nth_column, td3, transpose, update, update_sudoku, update_sudoku_row, validate_feature, validate_list, validate_sudoku, won_sudoku) +module Update exposing (has_emptys, no_emptys_sudoku, update, won_sudoku) import List exposing (append, drop, filter, foldl, foldr, map, member, range, repeat, take) +import Platform.Cmd +import Sudoku exposing (..) import Types exposing (..) -update : Msg -> Model -> Model +update : Msg -> Model -> ( Model, Cmd Msg ) update msg ( sudoku, text ) = case msg of Msg position entry -> let sudoku2 = - update_sudoku sudoku position entry + Sudoku.update_sudoku sudoku position entry in - ( sudoku2, text ) + ( ( sudoku2, text ), Cmd.none ) - Random int -> - ( sudoku, text ) + Random Nothing -> + ( ( sudoku, text ), Sudoku.rnd ) - -exchange_entry : List a -> Int -> a -> List a -exchange_entry list index replacement = - take index list ++ [ replacement ] ++ drop (index + 1) list - - - ---take (index - 1) list ++ [ replacement ] ++ drop index list - - -update_sudoku : Sudoku -> Position -> Entry -> Sudoku -update_sudoku sudoku ( row, column ) entry = - exchange_entry sudoku row (update_sudoku_row (List.head (drop row sudoku)) column entry) - - -update_sudoku_row : Maybe Row -> Int -> Entry -> Row -update_sudoku_row row = - exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) + Random (Just s) -> + ( ( s, text ), Cmd.none ) @@ -70,119 +56,3 @@ has_emptys list = -- checks if the entered configuration is valid - - -validate_sudoku : Sudoku -> Bool -validate_sudoku sudoku = - List.foldl (&&) True (map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ]) - - -validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool -validate_feature sudoku extractor = - List.foldr (&&) True (map validate_list (extractor sudoku)) - - -validate_list : List Entry -> Bool -validate_list l = - validate_list2 (map entry_to_maybe l) - - -entry_to_maybe : Entry -> Maybe ValidEntry -entry_to_maybe v = - case v of - EMPTY -> - Nothing - - User m -> - Just m - - Fixed m -> - Just m - - -validate_list2 : List (Maybe ValidEntry) -> Bool -validate_list2 l = - case l of - [] -> - True - - Nothing :: tail -> - validate_list2 tail - - m :: tail -> - member m tail && validate_list2 tail - - - --- Creates a list of area entry lists - - -extract_areas : Sudoku -> List (List Entry) -extract_areas sudoku = - map - (extract_area sudoku) - (map - (\n -> ( n // 3, remainderBy 3 n )) - (range 0 8) - ) - - - --- Drops the first 3*n elements of a list and returns 3 elements of the remainder - - -td3 : Int -> List a -> List a -td3 n list = - take 3 (drop (n * 3) list) - - - --- Returns a list of 9 entries that form the area defined by the position - - -extract_area : Sudoku -> Position -> List Entry -extract_area s ( r, c ) = - foldr append [] (td3 c (td3 r s)) - - -extract_rows : Sudoku -> List (List Entry) -extract_rows sudoku = - sudoku - - -extract_columns : Sudoku -> List (List Entry) -extract_columns = - transpose - - -transpose : List (List a) -> List (List a) -transpose list = - case list of - [] -> - [] - - x :: _ -> - map (nth_column list) (range 0 (List.length x - 1)) - - - --- Returns a list of nth elements if they exist - - -nth_column : List (List a) -> Int -> List a -nth_column list index = - List.filterMap (element index) list - - - --- Returns the nth element of a list - - -element : Int -> List a -> Maybe a -element index list = - case List.take 1 (List.drop (index - 1) list) of - [] -> - Nothing - - x :: _ -> - Just x -- GitLab From 711b511f3b2662a7660d17bff0313ccfafcd965b Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Wed, 17 Apr 2019 12:06:37 +0200 Subject: [PATCH 29/82] add possible_values function --- elm-examples/sudoku/src/Sudoku.elm | 18 ++++++++++++++++++ elm-examples/sudoku/src/Update.elm | 4 ---- 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 92313a2..b9cc5a6 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -25,6 +25,24 @@ validate_list l = validate_list2 (map entry_to_maybe l) + +{- validates if a sudoku with the value at the position would be valid -} + + +validate_entry : Sudoku -> Position -> Entry -> Bool +validate_entry s p e = + validate_sudoku (update_sudoku s p e) + + + +{- creates a list of possible entries for a position -} + + +possible_values : Sudoku -> Position -> List Entry +possible_values s p = + List.filter (validate_entry s p) all_options + + entry_to_maybe : Entry -> Maybe ValidEntry entry_to_maybe v = case v of diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 3a1ec34..72ff448 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -52,7 +52,3 @@ has_emptys list = _ :: t -> has_emptys t - - - --- checks if the entered configuration is valid -- GitLab From ed8d1dcc41c93c215077c7718cffc70b3848e3e9 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Wed, 17 Apr 2019 12:22:46 +0200 Subject: [PATCH 30/82] use possible_values list for generation --- elm-examples/sudoku/src/Sudoku.elm | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index b9cc5a6..165642b 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -29,18 +29,18 @@ validate_list l = {- validates if a sudoku with the value at the position would be valid -} -validate_entry : Sudoku -> Position -> Entry -> Bool +validate_entry : Sudoku -> Position -> Int -> Bool validate_entry s p e = - validate_sudoku (update_sudoku s p e) + validate_sudoku (update_sudoku s p (User (parse e))) {- creates a list of possible entries for a position -} -possible_values : Sudoku -> Position -> List Entry +possible_values : Sudoku -> Position -> List Int possible_values s p = - List.filter (validate_entry s p) all_options + List.filter (validate_entry s p) (range 1 9) entry_to_maybe : Entry -> Maybe ValidEntry @@ -187,7 +187,7 @@ try_insert p s int = next p possibleMaybeValues = - List.map (\a -> Just a) <| List.range 1 9 + List.map (\a -> Just a) <| possible_values new n res = case validate_sudoku s of -- GitLab From e9e98454b41277c70c585725f0b3cc98254ba994 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Wed, 17 Apr 2019 12:23:31 +0200 Subject: [PATCH 31/82] fix validate_sudoku add messages to update --- elm-examples/sudoku/src/Sudoku.elm | 2 +- elm-examples/sudoku/src/Update.elm | 15 +++++++++++++-- 2 files changed, 14 insertions(+), 3 deletions(-) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 165642b..aa203e1 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -66,7 +66,7 @@ validate_list2 l = validate_list2 tail m :: tail -> - member m tail && validate_list2 tail + not (member m tail) && validate_list2 tail diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 72ff448..641714a 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,6 +1,6 @@ module Update exposing (has_emptys, no_emptys_sudoku, update, won_sudoku) -import List exposing (append, drop, filter, foldl, foldr, map, member, range, repeat, take) +import List exposing (filter) import Platform.Cmd import Sudoku exposing (..) import Types exposing (..) @@ -13,8 +13,19 @@ update msg ( sudoku, text ) = let sudoku2 = Sudoku.update_sudoku sudoku position entry + + resp = + if Sudoku.validate_sudoku sudoku2 then + if won_sudoku sudoku2 then + "Yay you have made it!" + + else + "Incomplete" + + else + "Your Sudoku is self inconsistent!" in - ( ( sudoku2, text ), Cmd.none ) + ( ( sudoku2, resp ), Cmd.none ) Random Nothing -> ( ( sudoku, text ), Sudoku.rnd ) -- GitLab From 3cbc6ab17a39ce59cf23cb2202d51c0a4fd46ac9 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Wed, 17 Apr 2019 12:28:04 +0200 Subject: [PATCH 32/82] add mayUniform --- elm-examples/sudoku/src/Sudoku.elm | 43 +++++++++++++++++------------- 1 file changed, 24 insertions(+), 19 deletions(-) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index aa203e1..bbb05c3 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -187,34 +187,39 @@ try_insert p s int = next p possibleMaybeValues = - List.map (\a -> Just a) <| possible_values new n + possible_values new n res = - case validate_sudoku s of + case done of True -> - case done of - True -> - Random.constant <| Just new - - False -> - Random.andThen - (\may -> - case may of - Just a -> - try_insert n new a - - Nothing -> - Random.constant Nothing - ) - <| - Random.lazy (\_ -> Random.uniform Nothing possibleMaybeValues) + Random.constant <| Just new False -> - Random.andThen (try_insert p s) <| Random.int 1 9 + Random.andThen + (\may -> + case may of + Just a -> + try_insert n new a + + Nothing -> + Random.constant Nothing + ) + <| + Random.lazy (\_ -> mayUniform possibleMaybeValues) in res +mayUniform : List a -> Generator (Maybe a) +mayUniform list = + case list of + [] -> + Random.constant Nothing + + x :: xs -> + Random.uniform (Just x) <| map (\y -> Just y) xs + + next : ( Int, Int ) -> ( ( Int, Int ), Bool ) next ( x, y ) = case ( x, y ) of -- GitLab From c002f3c294d3975c48062a4b33eeb6d4784951bd Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Wed, 17 Apr 2019 12:28:18 +0200 Subject: [PATCH 33/82] remove index.html --- elm-examples/sudoku/index.html | 6262 -------------------------------- 1 file changed, 6262 deletions(-) delete mode 100644 elm-examples/sudoku/index.html diff --git a/elm-examples/sudoku/index.html b/elm-examples/sudoku/index.html deleted file mode 100644 index 84a471c..0000000 --- a/elm-examples/sudoku/index.html +++ /dev/null @@ -1,6262 +0,0 @@ - - - - - Main - - - -
- - - \ No newline at end of file -- GitLab From 94560f75ee17b247c339cde6108a0a844664a387 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Wed, 17 Apr 2019 12:42:27 +0200 Subject: [PATCH 34/82] move res function in try_insert from let --- elm-examples/sudoku/src/Sudoku.elm | 35 ++++++++++++++---------------- 1 file changed, 16 insertions(+), 19 deletions(-) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index bbb05c3..7230aad 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -188,26 +188,23 @@ try_insert p s int = possibleMaybeValues = possible_values new n - - res = - case done of - True -> - Random.constant <| Just new - - False -> - Random.andThen - (\may -> - case may of - Just a -> - try_insert n new a - - Nothing -> - Random.constant Nothing - ) - <| - Random.lazy (\_ -> mayUniform possibleMaybeValues) in - res + case done of + True -> + Random.constant <| Just new + + False -> + Random.andThen + (\may -> + case may of + Just a -> + try_insert n new a + + Nothing -> + Random.constant Nothing + ) + <| + Random.lazy (\_ -> mayUniform possibleMaybeValues) mayUniform : List a -> Generator (Maybe a) -- GitLab From 5a3ed8d7721c1d8714a135f931a8f62c4b4cda06 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Wed, 17 Apr 2019 13:33:31 +0200 Subject: [PATCH 35/82] add Hardcoded Sudoku fix Changeable Preset Fields --- elm-examples/sudoku/src/HardCoded.elm | 75 +++++++++++++++++++++++++++ elm-examples/sudoku/src/Sudoku.elm | 12 ++++- elm-examples/sudoku/src/Update.elm | 4 +- elm-examples/sudoku/src/View.elm | 9 +++- 4 files changed, 95 insertions(+), 5 deletions(-) create mode 100644 elm-examples/sudoku/src/HardCoded.elm diff --git a/elm-examples/sudoku/src/HardCoded.elm b/elm-examples/sudoku/src/HardCoded.elm new file mode 100644 index 0000000..617503a --- /dev/null +++ b/elm-examples/sudoku/src/HardCoded.elm @@ -0,0 +1,75 @@ +module HardCoded exposing (sudokus) + +import List exposing (map) +import Types exposing (Entry(..), Row, Sudoku, ValidEntry(..)) + + +sudokus : List Sudoku +sudokus = + [ s1 ] + + +to_sudoku : List (List (Maybe Int)) -> Sudoku +to_sudoku list = + map to_sudoku_row list + + +to_sudoku_row row = + map to_entry row + + +to_entry may = + case may of + Nothing -> + EMPTY + + Just a -> + Fixed <| parse a + + +parse : Int -> ValidEntry +parse e = + case e of + 1 -> + N1 + + 2 -> + N2 + + 3 -> + N3 + + 4 -> + N4 + + 5 -> + N5 + + 6 -> + N6 + + 7 -> + N7 + + 8 -> + N8 + + 9 -> + N9 + + _ -> + N9 + + +s1 = + to_sudoku + [ [ Just 8, Just 2, Nothing, Just 9, Nothing, Nothing, Nothing, Nothing, Just 7 ] + , [ Just 7, Nothing, Just 9, Nothing, Just 5, Nothing, Just 2, Just 1, Nothing ] + , [ Just 4, Nothing, Nothing, Just 2, Nothing, Just 7, Nothing, Just 6, Nothing ] + , [ Just 9, Nothing, Just 2, Just 1, Nothing, Nothing, Nothing, Nothing, Just 6 ] + , [ Just 5, Just 8, Nothing, Nothing, Just 9, Just 2, Nothing, Nothing, Just 1 ] + , [ Nothing, Nothing, Nothing, Just 6, Just 7, Just 8, Nothing, Nothing, Nothing ] + , [ Just 6, Just 4, Nothing, Nothing, Just 8, Nothing, Nothing, Just 2, Nothing ] + , [ Just 3, Nothing, Just 8, Nothing, Nothing, Nothing, Nothing, Just 4, Just 5 ] + , [ Nothing, Nothing, Nothing, Nothing, Nothing, Just 9, Nothing, Just 7, Nothing ] + ] diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 7230aad..6991a60 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,5 +1,6 @@ module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, next, nth_column, parse, rnd, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_feature, validate_list, validate_list2, validate_sudoku) +import HardCoded import List exposing (..) import Random exposing (Generator, generate) import Types exposing (..) @@ -174,7 +175,16 @@ rnd = gen_sudoku : Generator (Maybe Sudoku) gen_sudoku = - Random.andThen (try_insert ( 0, 0 ) empty_sudoku) (Random.int 1 9) + case HardCoded.sudokus of + [] -> + Random.constant Nothing + + x :: xa -> + Random.uniform (Just x) <| map (\s -> Just s) xa + + + +--Random.andThen (try_insert ( 0, 0 ) empty_sudoku) (Random.int 1 9) try_insert : Position -> Sudoku -> Int -> Generator (Maybe Sudoku) diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 641714a..c87979f 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -28,10 +28,10 @@ update msg ( sudoku, text ) = ( ( sudoku2, resp ), Cmd.none ) Random Nothing -> - ( ( sudoku, text ), Sudoku.rnd ) + ( ( sudoku, "Test 2" ), Sudoku.rnd ) Random (Just s) -> - ( ( s, text ), Cmd.none ) + ( ( s, "Test" ), Cmd.none ) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index 40c71c7..cf638a8 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -33,7 +33,12 @@ gen_row ( index, row ) = gen_entry : ( Position, Entry ) -> Html Msg gen_entry ( position, entry ) = - td [] [ select [ onInput (conv_to_msg position) ] (map (gen_option position entry) all_options) ] + case entry of + Fixed _ -> + td [] [ text <| show_entry entry ] + + _ -> + td [] [ select [ onInput (conv_to_msg position) ] (map (gen_option position entry) all_options) ] conv_to_msg : Position -> String -> Msg @@ -43,7 +48,7 @@ conv_to_msg pos a = gen_option : Position -> Entry -> Entry -> Html Msg gen_option position select entry = - option [ selected (select == entry), onClick (Msg position entry) ] [ text (show_entry entry) ] + option [ selected <| select == entry, onClick (Msg position select) ] [ text (show_entry entry) ] parse : String -> Entry -- GitLab From a09c44d1625718917ed6ce19218bb24938295380 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Wed, 17 Apr 2019 13:58:17 +0200 Subject: [PATCH 36/82] add brute force solver --- elm-examples/sudoku/src/GenSudoku.elm | 45 +++++++++++++++++++++++++++ elm-examples/sudoku/src/Sudoku.elm | 2 +- 2 files changed, 46 insertions(+), 1 deletion(-) create mode 100644 elm-examples/sudoku/src/GenSudoku.elm diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm new file mode 100644 index 0000000..a7ddc90 --- /dev/null +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -0,0 +1,45 @@ +module GenSudoku exposing (get_entry, has_entry) + +import List exposing (map) +import Maybe exposing (andThen) +import Sudoku exposing (element, next, nth_column, parse, possible_values, update_sudoku) +import Types exposing (Entry(..), Position, Sudoku) + + +get_entry : Sudoku -> Position -> Maybe Entry +get_entry s ( row, column ) = + Maybe.andThen (element column) (element row s) + + +has_entry s p = + case get_entry s p of + Nothing -> + False + + Just EMPTY -> + False + + Just _ -> + True + + +solver : Sudoku -> Sudoku + + +solver_helper : Position -> Sudoku -> Maybe Sudoku +solver_helper p s = + if has_entry s p then + solver_helper (next p) s + + else + case map (update_sudoku s p) (map (\n -> Fixed <| parse n) (possible_values s p)) of + [] -> + Nothingpossible_values, + + new -> + case List.filterMap (solver_helper (next p)) new of + [] -> + Nothing + + a :: l -> + a diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 7230aad..109638d 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,4 +1,4 @@ -module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, next, nth_column, parse, rnd, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, next, nth_column, parse, possible_values, rnd, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_feature, validate_list, validate_list2, validate_sudoku) import List exposing (..) import Random exposing (Generator, generate) -- GitLab From 19a0465978c3387097f3b1e5f70dd789be533067 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Wed, 17 Apr 2019 13:56:09 +0200 Subject: [PATCH 37/82] split validate_sudoku --- .gitignore | 1 + elm-examples/sudoku/src/Sudoku.elm | 9 +++++++-- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/.gitignore b/.gitignore index 21ab93b..05f7c1d 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,2 @@ /elm-examples/sudoku/.idea/ +*.html diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index f629c18..0b3de5e 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,4 +1,4 @@ -module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, next, nth_column, parse, possible_values, rnd, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, mayUniform, next, nth_column, parse, possible_values, rnd, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku, validate_sudoku_features) import HardCoded import List exposing (..) @@ -13,7 +13,12 @@ empty_sudoku = validate_sudoku : Sudoku -> Bool validate_sudoku sudoku = - List.foldl (&&) True (map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ]) + List.foldl (&&) True <| validate_sudoku_features sudoku + + +validate_sudoku_features : Sudoku -> List Bool +validate_sudoku_features sudoku = + map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ] validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool -- GitLab From 4b8325cd23a1b7e32f6622f988c407aa5c371e91 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Wed, 17 Apr 2019 16:04:41 +0200 Subject: [PATCH 38/82] Fix extract_area --- elm-examples/sudoku/src/Sudoku.elm | 19 ++++++++++++------- elm-examples/sudoku/src/Update.elm | 15 ++++++++------- 2 files changed, 20 insertions(+), 14 deletions(-) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index f629c18..2096871 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -3,6 +3,7 @@ module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, e import HardCoded import List exposing (..) import Random exposing (Generator, generate) +import Tuple exposing (first) import Types exposing (..) @@ -13,7 +14,14 @@ empty_sudoku = validate_sudoku : Sudoku -> Bool validate_sudoku sudoku = - List.foldl (&&) True (map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ]) + let + res_list = + map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ] + + res = + List.foldl (&&) True res_list + in + List.foldl (&&) True res_list validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool @@ -77,11 +85,8 @@ validate_list2 l = extract_areas : Sudoku -> List (List Entry) extract_areas sudoku = map - (extract_area sudoku) - (map - (\n -> ( n // 3, remainderBy 3 n )) - (range 0 8) - ) + (\n -> extract_area sudoku ( n // 3, remainderBy 3 n )) + (range 0 8) @@ -99,7 +104,7 @@ td3 n list = extract_area : Sudoku -> Position -> List Entry extract_area s ( r, c ) = - foldr append [] (td3 c (td3 r s)) + foldr (\n -> append (td3 c n)) [] (td3 r s) extract_rows : Sudoku -> List (List Entry) diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index c87979f..fe74c0d 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -15,15 +15,16 @@ update msg ( sudoku, text ) = Sudoku.update_sudoku sudoku position entry resp = - if Sudoku.validate_sudoku sudoku2 then - if won_sudoku sudoku2 then - "Yay you have made it!" + case Sudoku.validate_sudoku sudoku2 of + True -> + if won_sudoku sudoku2 then + "Yay you have made it!" - else - "Incomplete" + else + "Incomplete" - else - "Your Sudoku is self inconsistent!" + False -> + "Your Sudoku is self inconsistent!" in ( ( sudoku2, resp ), Cmd.none ) -- GitLab From fb46d6e84869726239583915145fbbd85e4ef9e9 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Wed, 17 Apr 2019 16:39:50 +0200 Subject: [PATCH 39/82] implement solver --- elm-examples/sudoku/src/GenSudoku.elm | 50 ++++++++++++++++----------- elm-examples/sudoku/src/Sudoku.elm | 23 +++++++++--- 2 files changed, 48 insertions(+), 25 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index a7ddc90..9c23e54 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,29 +1,19 @@ -module GenSudoku exposing (get_entry, has_entry) +module GenSudoku exposing (solver) import List exposing (map) import Maybe exposing (andThen) -import Sudoku exposing (element, next, nth_column, parse, possible_values, update_sudoku) +import Sudoku exposing (element, has_entry, next, nth_column, parse, possible_values, update_sudoku) import Types exposing (Entry(..), Position, Sudoku) -get_entry : Sudoku -> Position -> Maybe Entry -get_entry s ( row, column ) = - Maybe.andThen (element column) (element row s) - - -has_entry s p = - case get_entry s p of +solver : Sudoku -> Sudoku +solver s = + case solver_helper ( 0, 0 ) s of Nothing -> - False + s - Just EMPTY -> - False - - Just _ -> - True - - -solver : Sudoku -> Sudoku + Just rets -> + rets solver_helper : Position -> Sudoku -> Maybe Sudoku @@ -32,9 +22,14 @@ solver_helper p s = solver_helper (next p) s else - case map (update_sudoku s p) (map (\n -> Fixed <| parse n) (possible_values s p)) of + let + fixed_possible_values : List Entry + fixed_possible_values = + map (\n -> Fixed <| parse n) (possible_values s p) + in + case map (update_sudoku s p) fixed_possible_values of [] -> - Nothingpossible_values, + Nothing new -> case List.filterMap (solver_helper (next p)) new of @@ -43,3 +38,18 @@ solver_helper p s = a :: l -> a + + +lmap1 : (a -> Maybe b) -> List a -> Maybe b +lmap1 f l = + case l of + [] -> + Nothing + + a :: t -> + case f a of + Nothing -> + lmap1 f t + + b -> + b diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 629ff87..dde991f 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,9 +1,8 @@ -module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, mayUniform, next, nth_column, parse, possible_values, rnd, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku, validate_sudoku_features) +module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, parse, possible_values, rnd, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) import HardCoded import List exposing (..) import Random exposing (Generator, generate) -import Tuple exposing (first) import Types exposing (..) @@ -17,9 +16,6 @@ validate_sudoku sudoku = let res_list = map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ] - - res = - List.foldl (&&) True res_list in List.foldl (&&) True res_list @@ -277,3 +273,20 @@ parse e = _ -> N9 + + +get_entry : Sudoku -> Position -> Maybe Entry +get_entry s ( row, column ) = + Maybe.andThen (element column) (element row s) + + +has_entry s p = + case get_entry s p of + Nothing -> + False + + Just EMPTY -> + False + + Just _ -> + True -- GitLab From 0fd9bdd5999465bc477a74030835409098aeeab4 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Thu, 18 Apr 2019 10:49:11 +0200 Subject: [PATCH 40/82] Fix solver_helper & Move sudoku generation --- elm-examples/sudoku/src/GenSudoku.elm | 81 +++++++++++++++++++-------- elm-examples/sudoku/src/Model.elm | 3 +- elm-examples/sudoku/src/Sudoku.elm | 22 +------- elm-examples/sudoku/src/Update.elm | 3 +- 4 files changed, 64 insertions(+), 45 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 9c23e54..9f55484 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,14 +1,15 @@ -module GenSudoku exposing (solver) +module GenSudoku exposing (rnd, solver) -import List exposing (map) -import Maybe exposing (andThen) -import Sudoku exposing (element, has_entry, next, nth_column, parse, possible_values, update_sudoku) -import Types exposing (Entry(..), Position, Sudoku) +import List exposing (map, range, repeat) +import Maybe +import Random exposing (Generator, generate) +import Sudoku exposing (has_entry, next, parse, possible_values, update_sudoku) +import Types exposing (Entry(..), Msg(..), Position, Sudoku, ValidEntry(..)) solver : Sudoku -> Sudoku solver s = - case solver_helper ( 0, 0 ) s of + case solver_helper ( ( 0, 0 ), False ) s of Nothing -> s @@ -16,9 +17,12 @@ solver s = rets -solver_helper : Position -> Sudoku -> Maybe Sudoku -solver_helper p s = - if has_entry s p then +solver_helper : ( Position, Bool ) -> Sudoku -> Maybe Sudoku +solver_helper ( p, b ) s = + if b then + Just s + + else if has_entry s p then solver_helper (next p) s else @@ -36,20 +40,53 @@ solver_helper p s = [] -> Nothing - a :: l -> - a + a :: _ -> + Just a + + + +{- not used -> should it be needed, include suggestions by Sandra } + + + firstJust : (a -> Maybe b) -> List a -> Maybe b + firstJust f l = + case l of + [] -> + Nothing + + a :: t -> + case f a of + Nothing -> + lmap1 f t + + b -> + b + + + + -- +-} + + +rnd : Cmd Msg +rnd = + generate (\i -> Random i) gen_sudoku + + +gen_sudoku : Generator (Maybe Sudoku) +gen_sudoku = + Random.constant + (Just + (solver (map (\n -> Fixed <| parse n) (range 1 9) :: repeat 8 (repeat 9 EMPTY))) + ) -lmap1 : (a -> Maybe b) -> List a -> Maybe b -lmap1 f l = - case l of - [] -> - Nothing - a :: t -> - case f a of - Nothing -> - lmap1 f t +{- } case HardCoded.sudokus of + [] -> + Random.constant Nothing - b -> - b + x :: xa -> + Random.uniform (Just x) <| map (\s -> Just s) xa { +-} +--Random.andThen (try_insert ( 0, 0 ) empty_sudoku) (Random.int 1 9) diff --git a/elm-examples/sudoku/src/Model.elm b/elm-examples/sudoku/src/Model.elm index de10a85..de3b565 100644 --- a/elm-examples/sudoku/src/Model.elm +++ b/elm-examples/sudoku/src/Model.elm @@ -1,6 +1,7 @@ module Model exposing (init, subs) -import Sudoku exposing (empty_sudoku, rnd) +import GenSudoku exposing (rnd) +import Sudoku exposing (empty_sudoku) import Types exposing (..) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index dde991f..00ce2a1 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,6 +1,5 @@ -module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, parse, possible_values, rnd, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, get_entry, has_entry, mayUniform, next, nth_column, parse, possible_values, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) -import HardCoded import List exposing (..) import Random exposing (Generator, generate) import Types exposing (..) @@ -169,25 +168,6 @@ exchange_entry list index replacement = --take (index - 1) list ++ [ replacement ] ++ drop index list -rnd : Cmd Msg -rnd = - generate (\i -> Random i) gen_sudoku - - -gen_sudoku : Generator (Maybe Sudoku) -gen_sudoku = - case HardCoded.sudokus of - [] -> - Random.constant Nothing - - x :: xa -> - Random.uniform (Just x) <| map (\s -> Just s) xa - - - ---Random.andThen (try_insert ( 0, 0 ) empty_sudoku) (Random.int 1 9) - - try_insert : Position -> Sudoku -> Int -> Generator (Maybe Sudoku) try_insert p s int = let diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index fe74c0d..952ba81 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,5 +1,6 @@ module Update exposing (has_emptys, no_emptys_sudoku, update, won_sudoku) +import GenSudoku import List exposing (filter) import Platform.Cmd import Sudoku exposing (..) @@ -29,7 +30,7 @@ update msg ( sudoku, text ) = ( ( sudoku2, resp ), Cmd.none ) Random Nothing -> - ( ( sudoku, "Test 2" ), Sudoku.rnd ) + ( ( sudoku, "Test 2" ), GenSudoku.rnd ) Random (Just s) -> ( ( s, "Test" ), Cmd.none ) -- GitLab From 1cb982d4055452542c1baf9101c317ef70c13e4f Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Thu, 18 Apr 2019 11:31:20 +0200 Subject: [PATCH 41/82] fix solver runs too long --- elm-examples/sudoku/src/GenSudoku.elm | 44 ++++++++++----------------- 1 file changed, 16 insertions(+), 28 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 9f55484..752ca62 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -30,42 +30,30 @@ solver_helper ( p, b ) s = fixed_possible_values : List Entry fixed_possible_values = map (\n -> Fixed <| parse n) (possible_values s p) - in - case map (update_sudoku s p) fixed_possible_values of - [] -> - Nothing - - new -> - case List.filterMap (solver_helper (next p)) new of - [] -> - Nothing - - a :: _ -> - Just a - - -{- not used -> should it be needed, include suggestions by Sandra } + solve_updated = + \v -> solver_helper (next p) (update_sudoku s p v) + in + calc_to_first_Just solve_updated fixed_possible_values - firstJust : (a -> Maybe b) -> List a -> Maybe b - firstJust f l = - case l of - [] -> - Nothing - a :: t -> - case f a of - Nothing -> - lmap1 f t +{- TODO include suggestions by Sandra -} - b -> - b +calc_to_first_Just : (a -> Maybe b) -> List a -> Maybe b +calc_to_first_Just f l = + case l of + [] -> + Nothing + a :: t -> + case f a of + Nothing -> + calc_to_first_Just f t - -- --} + b -> + b rnd : Cmd Msg -- GitLab From daebd3310a5419d554e3992d0105b416c994317e Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Thu, 18 Apr 2019 12:35:31 +0200 Subject: [PATCH 42/82] change calc_to_first_Just to use foldr --- elm-examples/sudoku/elm.json | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/elm-examples/sudoku/elm.json b/elm-examples/sudoku/elm.json index 8e18a59..0501547 100644 --- a/elm-examples/sudoku/elm.json +++ b/elm-examples/sudoku/elm.json @@ -11,7 +11,8 @@ "elm/json": "1.1.2", "elm/html": "1.0.0", "elm/http": "2.0.0", - "elm/random": "1.0.0" + "elm/random": "1.0.0", + "elm-community/maybe-extra": "5.0.0" }, "indirect": { "elm/bytes": "1.0.8", -- GitLab From c6174c503c3d866276eb37cfbcfed8047494b563 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Thu, 18 Apr 2019 12:40:39 +0200 Subject: [PATCH 43/82] change calc_to_first_Just to use foldr --- elm-examples/sudoku/elm.json | 3 ++- elm-examples/sudoku/src/GenSudoku.elm | 31 ++++++++++++++------------- 2 files changed, 18 insertions(+), 16 deletions(-) diff --git a/elm-examples/sudoku/elm.json b/elm-examples/sudoku/elm.json index 8e18a59..0501547 100644 --- a/elm-examples/sudoku/elm.json +++ b/elm-examples/sudoku/elm.json @@ -11,7 +11,8 @@ "elm/json": "1.1.2", "elm/html": "1.0.0", "elm/http": "2.0.0", - "elm/random": "1.0.0" + "elm/random": "1.0.0", + "elm-community/maybe-extra": "5.0.0" }, "indirect": { "elm/bytes": "1.0.8", diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 752ca62..075d909 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -2,6 +2,7 @@ module GenSudoku exposing (rnd, solver) import List exposing (map, range, repeat) import Maybe +import Maybe.Extra import Random exposing (Generator, generate) import Sudoku exposing (has_entry, next, parse, possible_values, update_sudoku) import Types exposing (Entry(..), Msg(..), Position, Sudoku, ValidEntry(..)) @@ -31,29 +32,29 @@ solver_helper ( p, b ) s = fixed_possible_values = map (\n -> Fixed <| parse n) (possible_values s p) + solve_updated : Entry -> Maybe Sudoku solve_updated = \v -> solver_helper (next p) (update_sudoku s p v) in calc_to_first_Just solve_updated fixed_possible_values - -{- TODO include suggestions by Sandra -} - - calc_to_first_Just : (a -> Maybe b) -> List a -> Maybe b calc_to_first_Just f l = - case l of - [] -> - Nothing - - a :: t -> - case f a of - Nothing -> - calc_to_first_Just f t - - b -> - b + List.foldr + (\x acc -> + let + res = + f x + in + if Maybe.Extra.isJust acc then + acc + + else + res + ) + Nothing + l rnd : Cmd Msg -- GitLab From e6d2b2a01371e0f10d7c034a8f37b8108ba413e7 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Thu, 18 Apr 2019 17:55:14 +0200 Subject: [PATCH 44/82] fix skipping lines on generating --- elm-examples/sudoku/src/GenSudoku.elm | 2 +- elm-examples/sudoku/src/Update.elm | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 075d909..8e9fa5c 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -34,7 +34,7 @@ solver_helper ( p, b ) s = solve_updated : Entry -> Maybe Sudoku solve_updated = - \v -> solver_helper (next p) (update_sudoku s p v) + \v -> solver_helper ( p, b ) (update_sudoku s p v) in calc_to_first_Just solve_updated fixed_possible_values diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 952ba81..9a92af1 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -30,7 +30,7 @@ update msg ( sudoku, text ) = ( ( sudoku2, resp ), Cmd.none ) Random Nothing -> - ( ( sudoku, "Test 2" ), GenSudoku.rnd ) + ( ( sudoku, "Doctor is regenerating" ), Cmd.none ) Random (Just s) -> ( ( s, "Test" ), Cmd.none ) -- GitLab From b6cf0fde40f8d7e2b8b581ec511d5f5993ff5152 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Wed, 17 Apr 2019 22:59:25 +0200 Subject: [PATCH 45/82] try to rewrite the sudoku solver --- elm-examples/sudoku/elm.json | 7 +- elm-examples/sudoku/src/GenSudoku.elm | 180 +++++++++++++++----------- elm-examples/sudoku/src/HardCoded.elm | 19 +-- elm-examples/sudoku/src/Model.elm | 5 +- elm-examples/sudoku/src/View.elm | 21 +-- 5 files changed, 122 insertions(+), 110 deletions(-) diff --git a/elm-examples/sudoku/elm.json b/elm-examples/sudoku/elm.json index 0501547..783ce86 100644 --- a/elm-examples/sudoku/elm.json +++ b/elm-examples/sudoku/elm.json @@ -12,6 +12,8 @@ "elm/html": "1.0.0", "elm/http": "2.0.0", "elm/random": "1.0.0", + "elm-community/list-extra": "8.2.0", + "elm-community/random-extra": "3.1.0" "elm-community/maybe-extra": "5.0.0" }, "indirect": { @@ -19,11 +21,12 @@ "elm/file": "1.0.5", "elm/time": "1.0.0", "elm/url": "1.0.0", - "elm/virtual-dom": "1.0.2" + "elm/virtual-dom": "1.0.2", + "owanturist/elm-union-find": "1.0.0" } }, "test-dependencies": { "direct": {}, "indirect": {} } -} \ No newline at end of file +} diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 8e9fa5c..0436f77 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,81 +1,107 @@ -module GenSudoku exposing (rnd, solver) +module GenSudoku exposing (..) -import List exposing (map, range, repeat) +import List exposing (map, concatMap,indexedMap,filterMap, sortBy,any,isEmpty) import Maybe import Maybe.Extra -import Random exposing (Generator, generate) -import Sudoku exposing (has_entry, next, parse, possible_values, update_sudoku) -import Types exposing (Entry(..), Msg(..), Position, Sudoku, ValidEntry(..)) +import Sudoku exposing (parse, possible_values) +import Types exposing (Entry(..), Position, Sudoku,Row) +import List.Extra exposing (gatherEqualsBy,remove) +import Basics exposing ((>>),(<<),(||)) + +import Random exposing (Generator,uniform,constant) +import Random.Extra exposing (combine) + +rmap = Random.map + +gen_full_sudoku : Generator (Maybe Sudoku) +gen_full_sudoku = solve_sudoku Sudoku.empty_sudoku + +solve_sudoku : Sudoku -> Generator (Maybe Sudoku) +solve_sudoku sudoku = let + empty = list_of_empty sudoku + in + solve_sudoku_smart sudoku empty + + +-- Tries to solve the given Sudoku at all provided Positions +solve_sudoku_smart : Sudoku -> List Position -> Generator (Maybe Sudoku) +solve_sudoku_smart sudoku empty_pos = let + -- list of (position, not obvious invalid entries for position) + possible = sortBy Tuple.second <| map (Tuple.mapSecond <| possible_values sudoku) <| map (\a -> (a,a)) empty_pos + in if any (List.isEmpty << Tuple.second) possible || isEmpty possible then + Random.constant Nothing -- one field with no possible inputs exists + else case gatherEqualsBy (List.length << Tuple.second) possible of + [] -> Random.constant Nothing -- should never happen + ((x,xs)::_) -> case x of + (_, [_]) -> let -- single possible value + -- all pairs in x::xs should have only one possible entry therefor we apply all at once + pairs = filterMap (\(pos,entries) -> case entries of + [p] -> Just (pos,p) + _ -> Nothing -- should never happen + ) <| x::xs + in + apply_all empty_pos pairs sudoku + + _ -> let -- x,xs (head,tail) of list of fields with least options + -- at this points we have more than one possibility to try for each field + + some_solutions = (x::xs) + -- all combinations that we might want to try + |> map (\(pos,entries) -> (pos,map (parse >> Fixed) entries)) + -- all combinations applied and the fields position we just fill + |> concatMap (\(pos,opt) -> map ( Tuple.pair pos << Sudoku.update_sudoku sudoku pos ) opt ) + -- all combinations applied and the fields position we still need to fill + |> map (Tuple.mapFirst (\a -> remove a empty_pos)) + -- apply solve_sudoku_smart to each combination + |> map apply + -- turn the List of Generators into a Generator of List + |> combine + -- remove Nothings from list + |> rmap (filterMap identity) + in + -- return Just the first solution or Nothing should none exist + select_solution some_solutions + +apply_all: List Position -> List (Position,Int) -> Sudoku -> Generator (Maybe Sudoku) +apply_all empty_pos pairs sudoku = + let + -- sudoku with all position entry pairs applied + res_sudoku = List.foldr (\(pos,entry) s -> Sudoku.update_sudoku s pos <| parse >> Fixed <| entry) sudoku pairs + -- positions unapplied + remaining = empty_pos + in + -- if the Sudoku is invalid this sudoku does not have any solutions therefor return Noting to caller + if not <| Sudoku.validate_sudoku res_sudoku then + constant Nothing + else if isEmpty remaining then + -- valid sudoku and no fields remaining to be filled, we are done + constant <| Just res_sudoku + else + -- valid sudoku and fields remaining to be filled, recurse + solve_sudoku_smart res_sudoku remaining + +-- list_of_empty returns the Positions of the EMPTY entries in the Sudoku + +select_solution : Generator (List a) -> Generator (Maybe a) +select_solution = Random.andThen (\list -> + case list of + [] -> Random.constant Nothing + (l::ls) -> Random.constant <| Just l + ) + +-- applies the position list and sudoku from the tuple to solve_sudoku_smart +apply: (List Position , Sudoku) -> Generator (Maybe Sudoku) +apply (l, s) = solve_sudoku_smart s l + +-- return all positions containing an EMPTY value +list_of_empty : Sudoku -> List Position +list_of_empty sudoku = concatMap list_of_empty_row <| indexedMap Tuple.pair sudoku + +-- list_of_empty_row returns the Positions of the EMPTY entries in the Row + +list_of_empty_row : (Int, Row) -> List Position +list_of_empty_row (row_index,row) = filterMap (\(column_index, entry) -> case entry of + EMPTY -> Just (row_index, column_index) + _ -> Nothing + ) <| indexedMap Tuple.pair row - -solver : Sudoku -> Sudoku -solver s = - case solver_helper ( ( 0, 0 ), False ) s of - Nothing -> - s - - Just rets -> - rets - - -solver_helper : ( Position, Bool ) -> Sudoku -> Maybe Sudoku -solver_helper ( p, b ) s = - if b then - Just s - - else if has_entry s p then - solver_helper (next p) s - - else - let - fixed_possible_values : List Entry - fixed_possible_values = - map (\n -> Fixed <| parse n) (possible_values s p) - - solve_updated : Entry -> Maybe Sudoku - solve_updated = - \v -> solver_helper ( p, b ) (update_sudoku s p v) - in - calc_to_first_Just solve_updated fixed_possible_values - - -calc_to_first_Just : (a -> Maybe b) -> List a -> Maybe b -calc_to_first_Just f l = - List.foldr - (\x acc -> - let - res = - f x - in - if Maybe.Extra.isJust acc then - acc - - else - res - ) - Nothing - l - - -rnd : Cmd Msg -rnd = - generate (\i -> Random i) gen_sudoku - - -gen_sudoku : Generator (Maybe Sudoku) -gen_sudoku = - Random.constant - (Just - (solver (map (\n -> Fixed <| parse n) (range 1 9) :: repeat 8 (repeat 9 EMPTY))) - ) - - - -{- } case HardCoded.sudokus of - [] -> - Random.constant Nothing - - x :: xa -> - Random.uniform (Just x) <| map (\s -> Just s) xa { --} ---Random.andThen (try_insert ( 0, 0 ) empty_sudoku) (Random.int 1 9) diff --git a/elm-examples/sudoku/src/HardCoded.elm b/elm-examples/sudoku/src/HardCoded.elm index 617503a..e2d176a 100644 --- a/elm-examples/sudoku/src/HardCoded.elm +++ b/elm-examples/sudoku/src/HardCoded.elm @@ -10,22 +10,13 @@ sudokus = to_sudoku : List (List (Maybe Int)) -> Sudoku -to_sudoku list = - map to_sudoku_row list +to_sudoku list = map to_sudoku_row list +to_sudoku_row : List (Maybe Int) -> Row +to_sudoku_row row = map to_entry row -to_sudoku_row row = - map to_entry row - - -to_entry may = - case may of - Nothing -> - EMPTY - - Just a -> - Fixed <| parse a - +to_entry : Maybe Int -> Entry +to_entry = Maybe.map (parse >> Fixed) >> Maybe.withDefault EMPTY parse : Int -> ValidEntry parse e = diff --git a/elm-examples/sudoku/src/Model.elm b/elm-examples/sudoku/src/Model.elm index de3b565..c759f96 100644 --- a/elm-examples/sudoku/src/Model.elm +++ b/elm-examples/sudoku/src/Model.elm @@ -3,11 +3,12 @@ module Model exposing (init, subs) import GenSudoku exposing (rnd) import Sudoku exposing (empty_sudoku) import Types exposing (..) - +import Random +import GenSudoku init : a -> ( Model, Cmd Msg ) init _ = - ( ( empty_sudoku, "Empty" ), rnd ) + ( ( empty_sudoku, "Empty" ), Random.generate (Random) GenSudoku.gen_full_sudoku ) subs : Model -> Sub Msg diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index cf638a8..0345e6e 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -6,15 +6,7 @@ import Html.Events exposing (onClick, onInput) import List exposing (map, map2, range, repeat) import Types exposing (..) - -zip : List a -> List b -> List ( a, b ) -zip a b = - map2 simple a b - - -simple a b = - ( a, b ) - +import List.Extra exposing (zip) view : Model -> Html Msg view ( sudoku, msg ) = @@ -23,12 +15,12 @@ view ( sudoku, msg ) = gen_sudoku : Sudoku -> Html Msg gen_sudoku model = - table [ style "border" "1px solid black" ] (map gen_row (zip (range 0 8) model)) + table [ style "border" "1px solid black" ] <| map gen_row <| zip (range 0 8) model gen_row : ( Int, Row ) -> Html Msg gen_row ( index, row ) = - tr [] (map gen_entry (zip (zip (repeat 9 index) (range 0 8)) row)) + tr [] <| map gen_entry <| zip (zip (repeat 9 index) <| range 0 8) row gen_entry : ( Position, Entry ) -> Html Msg @@ -38,17 +30,16 @@ gen_entry ( position, entry ) = td [] [ text <| show_entry entry ] _ -> - td [] [ select [ onInput (conv_to_msg position) ] (map (gen_option position entry) all_options) ] + td [] [ select [ onInput <| conv_to_msg position ] <| map (gen_option position entry) all_options ] conv_to_msg : Position -> String -> Msg -conv_to_msg pos a = - Msg pos (parse a) +conv_to_msg pos = parse >> Msg pos gen_option : Position -> Entry -> Entry -> Html Msg gen_option position select entry = - option [ selected <| select == entry, onClick (Msg position select) ] [ text (show_entry entry) ] + option [ selected <| select == entry, onClick <| Msg position select ] [ text <| show_entry entry ] parse : String -> Entry -- GitLab From 2d90914f91e6db2c576ef5ae499b1ee888bd0f45 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Thu, 18 Apr 2019 13:14:28 +0200 Subject: [PATCH 46/82] work more on rewriting the sudoku solver --- elm-examples/sudoku/src/GenSudoku.elm | 228 ++++++++++++++++---------- elm-examples/sudoku/src/HardCoded.elm | 48 +++--- elm-examples/sudoku/src/Main.elm | 1 - elm-examples/sudoku/src/Update.elm | 4 +- 4 files changed, 174 insertions(+), 107 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 0436f77..3249434 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,107 +1,165 @@ -module GenSudoku exposing (..) +module GenSudoku exposing (apply, apply_all, gen_full_sudoku, list_of_empty, list_of_empty_row, rmap, solve_sudoku, solve_sudoku_smart) -import List exposing (map, concatMap,indexedMap,filterMap, sortBy,any,isEmpty) +import Basics exposing ((<<), (>>), (||)) +import HardCoded +import List exposing (any, concatMap, filterMap, indexedMap, isEmpty, map, range, sortBy) +import List.Extra exposing (gatherEqualsBy, remove) import Maybe import Maybe.Extra +import Random exposing (Generator, constant) +import Random.List exposing (shuffle) import Sudoku exposing (parse, possible_values) -import Types exposing (Entry(..), Position, Sudoku,Row) -import List.Extra exposing (gatherEqualsBy,remove) -import Basics exposing ((>>),(<<),(||)) +import Types exposing (Entry(..), Position, Row, Sudoku) -import Random exposing (Generator,uniform,constant) -import Random.Extra exposing (combine) -rmap = Random.map +rmap = + Random.map + + +randThen = + Random.andThen + gen_full_sudoku : Generator (Maybe Sudoku) -gen_full_sudoku = solve_sudoku Sudoku.empty_sudoku +gen_full_sudoku = + --generate a random first row + range 0 9 + |> map Just + |> shuffle + -- insert Row into Empty Sudoku + |> rmap (\list -> List.Extra.setAt 0 (HardCoded.to_sudoku_row list) Sudoku.empty_sudoku) + -- solve remaining Sudoku + |> rmap solve_sudoku + + + +-- solve sudoku in all empty fields + + +solve_sudoku : Sudoku -> Maybe Sudoku +solve_sudoku sudoku = + solve_sudoku_smart sudoku <| list_of_empty sudoku -solve_sudoku : Sudoku -> Generator (Maybe Sudoku) -solve_sudoku sudoku = let - empty = list_of_empty sudoku - in - solve_sudoku_smart sudoku empty -- Tries to solve the given Sudoku at all provided Positions -solve_sudoku_smart : Sudoku -> List Position -> Generator (Maybe Sudoku) -solve_sudoku_smart sudoku empty_pos = let - -- list of (position, not obvious invalid entries for position) - possible = sortBy Tuple.second <| map (Tuple.mapSecond <| possible_values sudoku) <| map (\a -> (a,a)) empty_pos - in if any (List.isEmpty << Tuple.second) possible || isEmpty possible then - Random.constant Nothing -- one field with no possible inputs exists - else case gatherEqualsBy (List.length << Tuple.second) possible of - [] -> Random.constant Nothing -- should never happen - ((x,xs)::_) -> case x of - (_, [_]) -> let -- single possible value - -- all pairs in x::xs should have only one possible entry therefor we apply all at once - pairs = filterMap (\(pos,entries) -> case entries of - [p] -> Just (pos,p) - _ -> Nothing -- should never happen - ) <| x::xs - in - apply_all empty_pos pairs sudoku - - _ -> let -- x,xs (head,tail) of list of fields with least options - -- at this points we have more than one possibility to try for each field - - some_solutions = (x::xs) - -- all combinations that we might want to try - |> map (\(pos,entries) -> (pos,map (parse >> Fixed) entries)) - -- all combinations applied and the fields position we just fill - |> concatMap (\(pos,opt) -> map ( Tuple.pair pos << Sudoku.update_sudoku sudoku pos ) opt ) - -- all combinations applied and the fields position we still need to fill - |> map (Tuple.mapFirst (\a -> remove a empty_pos)) - -- apply solve_sudoku_smart to each combination - |> map apply - -- turn the List of Generators into a Generator of List - |> combine - -- remove Nothings from list - |> rmap (filterMap identity) - in - -- return Just the first solution or Nothing should none exist - select_solution some_solutions - -apply_all: List Position -> List (Position,Int) -> Sudoku -> Generator (Maybe Sudoku) + + +solve_sudoku_smart : Sudoku -> List Position -> Maybe Sudoku +solve_sudoku_smart sudoku empty_pos = + let + -- list of (position, not obvious invalid entries for position) + possible = + -- turn pos into tuple of identical entries + map (\a -> ( a, a )) empty_pos + -- map second entry to possible values at that position + |> map (Tuple.mapSecond <| possible_values sudoku) + -- sort by the amount of possible entries + |> sortBy (List.length << Tuple.second) + in + if any (List.isEmpty << Tuple.second) possible then + -- one field with no possible inputs exists + Nothing + + else + case gatherEqualsBy (List.length << Tuple.second) possible of + [] -> + Nothing + + (( _, [ _ ] ) as x) :: xs -> + let + -- single possible value + -- all pairs in x::xs should have only one possible entry therefor we apply all at once + pairs = + (x :: xs) + |> filterMap + (\( pos, entries ) -> + case entries of + [ p ] -> + Just ( pos, p ) + + _ -> + -- should never happen + Nothing + ) + in + apply_all empty_pos pairs sudoku + + ( x, _ ) :: _ -> + let + -- x,xs (head,tail) of list of fields with least options + -- at this points we have more than one possibility to try for each field + some_solutions = + -- try all possibilities for the first position + x + |> (\( pos, entries ) -> ( pos, map (parse >> Fixed) entries )) + -- all combinations applied and the fields position we just fill + |> (\( pos, opt ) -> map (Tuple.pair pos << Sudoku.update_sudoku sudoku pos) opt) + -- all combinations applied and the fields position we still need to fill + |> map (Tuple.mapFirst (\a -> remove a empty_pos)) + -- apply solve_sudoku_smart to each combination filtering Nothings + |> filterMap apply + in + -- return Just the first solution or Nothing should none exist + List.head some_solutions + + +apply_all : List Position -> List ( Position, Int ) -> Sudoku -> Maybe Sudoku apply_all empty_pos pairs sudoku = - let - -- sudoku with all position entry pairs applied - res_sudoku = List.foldr (\(pos,entry) s -> Sudoku.update_sudoku s pos <| parse >> Fixed <| entry) sudoku pairs - -- positions unapplied - remaining = empty_pos - in - -- if the Sudoku is invalid this sudoku does not have any solutions therefor return Noting to caller - if not <| Sudoku.validate_sudoku res_sudoku then - constant Nothing - else if isEmpty remaining then - -- valid sudoku and no fields remaining to be filled, we are done - constant <| Just res_sudoku - else - -- valid sudoku and fields remaining to be filled, recurse - solve_sudoku_smart res_sudoku remaining - --- list_of_empty returns the Positions of the EMPTY entries in the Sudoku - -select_solution : Generator (List a) -> Generator (Maybe a) -select_solution = Random.andThen (\list -> - case list of - [] -> Random.constant Nothing - (l::ls) -> Random.constant <| Just l - ) + let + -- sudoku with all position entry pairs applied + res_sudoku = + List.foldr (\( pos, entry ) s -> Sudoku.update_sudoku s pos <| parse >> Fixed <| entry) sudoku pairs + + -- positions unapplied + remaining = + empty_pos + in + -- if the Sudoku is invalid this sudoku does not have any solutions therefor return Noting to caller + if not <| Sudoku.validate_sudoku res_sudoku then + Nothing + + else if isEmpty remaining then + -- valid sudoku and no fields remaining to be filled, we are done + Just res_sudoku + + else + -- valid sudoku and fields remaining to be filled, recurse + solve_sudoku_smart res_sudoku remaining + + -- applies the position list and sudoku from the tuple to solve_sudoku_smart -apply: (List Position , Sudoku) -> Generator (Maybe Sudoku) -apply (l, s) = solve_sudoku_smart s l + + +apply : ( List Position, Sudoku ) -> Maybe Sudoku +apply ( l, s ) = + solve_sudoku_smart s l + + -- return all positions containing an EMPTY value + + list_of_empty : Sudoku -> List Position -list_of_empty sudoku = concatMap list_of_empty_row <| indexedMap Tuple.pair sudoku +list_of_empty sudoku = + concatMap list_of_empty_row <| indexedMap Tuple.pair sudoku + + -- list_of_empty_row returns the Positions of the EMPTY entries in the Row -list_of_empty_row : (Int, Row) -> List Position -list_of_empty_row (row_index,row) = filterMap (\(column_index, entry) -> case entry of - EMPTY -> Just (row_index, column_index) - _ -> Nothing - ) <| indexedMap Tuple.pair row +list_of_empty_row : ( Int, Row ) -> List Position +list_of_empty_row ( row_index, row ) = + filterMap + (\( column_index, entry ) -> + case entry of + EMPTY -> + Just ( row_index, column_index ) + + _ -> + Nothing + ) + <| + indexedMap Tuple.pair row diff --git a/elm-examples/sudoku/src/HardCoded.elm b/elm-examples/sudoku/src/HardCoded.elm index e2d176a..7823922 100644 --- a/elm-examples/sudoku/src/HardCoded.elm +++ b/elm-examples/sudoku/src/HardCoded.elm @@ -1,4 +1,4 @@ -module HardCoded exposing (sudokus) +module HardCoded exposing (sudokus, to_sudoku_row) import List exposing (map) import Types exposing (Entry(..), Row, Sudoku, ValidEntry(..)) @@ -6,17 +6,18 @@ import Types exposing (Entry(..), Row, Sudoku, ValidEntry(..)) sudokus : List Sudoku sudokus = - [ s1 ] + [] -to_sudoku : List (List (Maybe Int)) -> Sudoku -to_sudoku list = map to_sudoku_row list - to_sudoku_row : List (Maybe Int) -> Row -to_sudoku_row row = map to_entry row +to_sudoku_row row = + map to_entry row + to_entry : Maybe Int -> Entry -to_entry = Maybe.map (parse >> Fixed) >> Maybe.withDefault EMPTY +to_entry = + Maybe.map (parse >> Fixed) >> Maybe.withDefault EMPTY + parse : Int -> ValidEntry parse e = @@ -52,15 +53,24 @@ parse e = N9 -s1 = - to_sudoku - [ [ Just 8, Just 2, Nothing, Just 9, Nothing, Nothing, Nothing, Nothing, Just 7 ] - , [ Just 7, Nothing, Just 9, Nothing, Just 5, Nothing, Just 2, Just 1, Nothing ] - , [ Just 4, Nothing, Nothing, Just 2, Nothing, Just 7, Nothing, Just 6, Nothing ] - , [ Just 9, Nothing, Just 2, Just 1, Nothing, Nothing, Nothing, Nothing, Just 6 ] - , [ Just 5, Just 8, Nothing, Nothing, Just 9, Just 2, Nothing, Nothing, Just 1 ] - , [ Nothing, Nothing, Nothing, Just 6, Just 7, Just 8, Nothing, Nothing, Nothing ] - , [ Just 6, Just 4, Nothing, Nothing, Just 8, Nothing, Nothing, Just 2, Nothing ] - , [ Just 3, Nothing, Just 8, Nothing, Nothing, Nothing, Nothing, Just 4, Just 5 ] - , [ Nothing, Nothing, Nothing, Nothing, Nothing, Just 9, Nothing, Just 7, Nothing ] - ] + +{- + + + to_sudoku : List (List (Maybe Int)) -> Sudoku + to_sudoku list = + map to_sudoku_row list + + s1 = + to_sudoku + [ [ Just 8, Just 2, Nothing, Just 9, Nothing, Nothing, Nothing, Nothing, Just 7 ] + , [ Just 7, Nothing, Just 9, Nothing, Just 5, Nothing, Just 2, Just 1, Nothing ] + , [ Just 4, Nothing, Nothing, Just 2, Nothing, Just 7, Nothing, Just 6, Nothing ] + , [ Just 9, Nothing, Just 2, Just 1, Nothing, Nothing, Nothing, Nothing, Just 6 ] + , [ Just 5, Just 8, Nothing, Nothing, Just 9, Just 2, Nothing, Nothing, Just 1 ] + , [ Nothing, Nothing, Nothing, Just 6, Just 7, Just 8, Nothing, Nothing, Nothing ] + , [ Just 6, Just 4, Nothing, Nothing, Just 8, Nothing, Nothing, Just 2, Nothing ] + , [ Just 3, Nothing, Just 8, Nothing, Nothing, Nothing, Nothing, Just 4, Just 5 ] + , [ Nothing, Nothing, Nothing, Nothing, Nothing, Just 9, Nothing, Just 7, Nothing ] + ] +-} diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index fb3b6e6..c5598dd 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -5,7 +5,6 @@ module Main exposing (main) -- View ---------------------------------------------------------------------------------------------------------------- import Browser -import Html exposing (Html) import Model exposing (..) import Types exposing (Model, Msg) import Update exposing (..) diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 9a92af1..ffcf496 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -30,10 +30,10 @@ update msg ( sudoku, text ) = ( ( sudoku2, resp ), Cmd.none ) Random Nothing -> - ( ( sudoku, "Doctor is regenerating" ), Cmd.none ) + ( ( sudoku, "Failed to Generate Sudoku" ), Cmd.none ) Random (Just s) -> - ( ( s, "Test" ), Cmd.none ) + ( ( s, "Sudoku Generated" ), Cmd.none ) -- GitLab From c8061f1f144ad13b2d75a6d7507490a1a00dab2a Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Thu, 18 Apr 2019 13:18:21 +0200 Subject: [PATCH 47/82] fix error from latest commit --- elm-examples/sudoku/src/GenSudoku.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 3249434..0c07c1b 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -66,7 +66,7 @@ solve_sudoku_smart sudoku empty_pos = [] -> Nothing - (( _, [ _ ] ) as x) :: xs -> + ( ( _, [ _ ] ) as x, xs ) :: _ -> let -- single possible value -- all pairs in x::xs should have only one possible entry therefor we apply all at once -- GitLab From 8d26971bb0e348324c7dd3b4b8bb748b641b448e Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Thu, 18 Apr 2019 13:56:38 +0200 Subject: [PATCH 48/82] fix range --- elm-examples/sudoku/src/GenSudoku.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 0c07c1b..a887408 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -23,7 +23,7 @@ randThen = gen_full_sudoku : Generator (Maybe Sudoku) gen_full_sudoku = --generate a random first row - range 0 9 + range 1 9 |> map Just |> shuffle -- insert Row into Empty Sudoku -- GitLab From e705a47bc5728b7e960453afe13ccdd8fba0719a Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Thu, 18 Apr 2019 13:57:28 +0200 Subject: [PATCH 49/82] optimize validate_entry use libraries instead of implementing things like transpose yourself --- elm-examples/sudoku/src/Sudoku.elm | 63 +++++++++++++++++++++--------- 1 file changed, 45 insertions(+), 18 deletions(-) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 00ce2a1..24ab7a6 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,6 +1,8 @@ -module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, get_entry, has_entry, mayUniform, next, nth_column, parse, possible_values, td3, transpose, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, parse, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) +import HardCoded import List exposing (..) +import List.Extra exposing (transpose) import Random exposing (Generator, generate) import Types exposing (..) @@ -35,10 +37,16 @@ validate_list l = validate_entry : Sudoku -> Position -> Int -> Bool validate_entry s p e = - validate_sudoku (update_sudoku s p (User (parse e))) + not <| List.member (Fixed <| parse e) <| concatMap (\a -> a s p) [ extract_row, extract_column, extract_area ] +{- validate_sudoku = let + res_list = + map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ] + in + List.foldl (&&) True res_list +-} {- creates a list of possible entries for a position -} @@ -84,6 +92,11 @@ extract_areas sudoku = (range 0 8) +extract_area_from_position : Sudoku -> Position -> List Entry +extract_area_from_position sudoku ( row, column ) = + extract_area sudoku ( row // 3, column // 3 ) + + -- Drops the first 3*n elements of a list and returns 3 elements of the remainder @@ -107,19 +120,19 @@ extract_rows sudoku = sudoku +extract_row : Sudoku -> Position -> List Entry +extract_row sudoku ( row, _ ) = + Maybe.withDefault [] <| element row sudoku + + extract_columns : Sudoku -> List (List Entry) extract_columns = - transpose - + List.Extra.transpose -transpose : List (List a) -> List (List a) -transpose list = - case list of - [] -> - [] - x :: _ -> - map (nth_column list) (range 0 (List.length x - 1)) +extract_column : Sudoku -> Position -> List Entry +extract_column sudoku ( _, column ) = + filterMap (element column) sudoku @@ -136,13 +149,8 @@ nth_column list index = element : Int -> List a -> Maybe a -element index list = - case List.take 1 (List.drop (index - 1) list) of - [] -> - Nothing - - x :: _ -> - Just x +element = + List.Extra.getAt @@ -168,6 +176,25 @@ exchange_entry list index replacement = --take (index - 1) list ++ [ replacement ] ++ drop index list +rnd : Cmd Msg +rnd = + generate (\i -> Random i) gen_sudoku + + +gen_sudoku : Generator (Maybe Sudoku) +gen_sudoku = + case HardCoded.sudokus of + [] -> + Random.constant Nothing + + x :: xa -> + Random.uniform (Just x) <| map (\s -> Just s) xa + + + +--Random.andThen (try_insert ( 0, 0 ) empty_sudoku) (Random.int 1 9) + + try_insert : Position -> Sudoku -> Int -> Generator (Maybe Sudoku) try_insert p s int = let -- GitLab From bcfc462a213bc83e0005eda41dc5c1aa17fb8a70 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Thu, 18 Apr 2019 15:00:38 +0200 Subject: [PATCH 50/82] use already existing functionality --- elm-examples/sudoku/src/Sudoku.elm | 18 +++++++----------- 1 file changed, 7 insertions(+), 11 deletions(-) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 24ab7a6..f69489b 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -14,16 +14,12 @@ empty_sudoku = validate_sudoku : Sudoku -> Bool validate_sudoku sudoku = - let - res_list = - map (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ] - in - List.foldl (&&) True res_list + all (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ] validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool validate_feature sudoku extractor = - List.foldr (&&) True (map validate_list (extractor sudoku)) + all validate_list (extractor sudoku) validate_list : List Entry -> Bool @@ -37,7 +33,7 @@ validate_list l = validate_entry : Sudoku -> Position -> Int -> Bool validate_entry s p e = - not <| List.member (Fixed <| parse e) <| concatMap (\a -> a s p) [ extract_row, extract_column, extract_area ] + all (List.Extra.notMember (Fixed <| parse e)) <| map (\a -> a s p) [ extract_row, extract_column, extract_area ] @@ -116,8 +112,8 @@ extract_area s ( r, c ) = extract_rows : Sudoku -> List (List Entry) -extract_rows sudoku = - sudoku +extract_rows = + identity extract_row : Sudoku -> Position -> List Entry @@ -169,7 +165,7 @@ update_sudoku_row row = exchange_entry : List a -> Int -> a -> List a exchange_entry list index replacement = - take index list ++ [ replacement ] ++ drop (index + 1) list + List.Extra.setAt index replacement list @@ -178,7 +174,7 @@ exchange_entry list index replacement = rnd : Cmd Msg rnd = - generate (\i -> Random i) gen_sudoku + generate Random gen_sudoku gen_sudoku : Generator (Maybe Sudoku) -- GitLab From 7d3746e6e43666bc6b1f3a3efe348a2693ff8dec Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Thu, 18 Apr 2019 16:49:33 +0200 Subject: [PATCH 51/82] change from using List to using Seq (Lazy List) --- elm-examples/sudoku/elm.json | 3 +- elm-examples/sudoku/src/GenSudoku.elm | 39 ++++---- elm-examples/sudoku/src/HardCoded.elm | 48 +++++----- elm-examples/sudoku/src/Seq/Extra.elm | 120 +++++++++++++++++++++++++ elm-examples/sudoku/src/Seq/Random.elm | 15 ++++ elm-examples/sudoku/src/Sudoku.elm | 104 +++++++++++---------- elm-examples/sudoku/src/Types.elm | 5 +- elm-examples/sudoku/src/Update.elm | 18 +--- elm-examples/sudoku/src/View.elm | 10 ++- 9 files changed, 249 insertions(+), 113 deletions(-) create mode 100644 elm-examples/sudoku/src/Seq/Extra.elm create mode 100644 elm-examples/sudoku/src/Seq/Random.elm diff --git a/elm-examples/sudoku/elm.json b/elm-examples/sudoku/elm.json index 783ce86..d5774ca 100644 --- a/elm-examples/sudoku/elm.json +++ b/elm-examples/sudoku/elm.json @@ -13,7 +13,8 @@ "elm/http": "2.0.0", "elm/random": "1.0.0", "elm-community/list-extra": "8.2.0", - "elm-community/random-extra": "3.1.0" + "elm-community/random-extra": "3.1.0", + "the-sett/lazy-list": "1.1.1", "elm-community/maybe-extra": "5.0.0" }, "indirect": { diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index a887408..acd8dc4 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -2,12 +2,15 @@ module GenSudoku exposing (apply, apply_all, gen_full_sudoku, list_of_empty, lis import Basics exposing ((<<), (>>), (||)) import HardCoded -import List exposing (any, concatMap, filterMap, indexedMap, isEmpty, map, range, sortBy) -import List.Extra exposing (gatherEqualsBy, remove) +import List +import List.Extra import Maybe import Maybe.Extra import Random exposing (Generator, constant) import Random.List exposing (shuffle) +import Seq exposing (..) +import Seq.Extra exposing (..) +import Seq.Random exposing (..) import Sudoku exposing (parse, possible_values) import Types exposing (Entry(..), Position, Row, Sudoku) @@ -27,7 +30,7 @@ gen_full_sudoku = |> map Just |> shuffle -- insert Row into Empty Sudoku - |> rmap (\list -> List.Extra.setAt 0 (HardCoded.to_sudoku_row list) Sudoku.empty_sudoku) + |> rmap (\list -> setAt 0 (HardCoded.to_sudoku_row list) Sudoku.empty_sudoku) -- solve remaining Sudoku |> rmap solve_sudoku @@ -45,24 +48,24 @@ solve_sudoku sudoku = -- Tries to solve the given Sudoku at all provided Positions -solve_sudoku_smart : Sudoku -> List Position -> Maybe Sudoku +solve_sudoku_smart : Sudoku -> Seq Position -> Maybe Sudoku solve_sudoku_smart sudoku empty_pos = let -- list of (position, not obvious invalid entries for position) possible = -- turn pos into tuple of identical entries - map (\a -> ( a, a )) empty_pos + List.map (\a -> ( a, a )) (toList empty_pos) -- map second entry to possible values at that position - |> map (Tuple.mapSecond <| possible_values sudoku) + |> List.map (Tuple.mapSecond <| toList << possible_values sudoku) -- sort by the amount of possible entries - |> sortBy (List.length << Tuple.second) + |> List.sortBy (List.length << Tuple.second) in - if any (List.isEmpty << Tuple.second) possible then + if List.any (List.isEmpty << Tuple.second) possible then -- one field with no possible inputs exists Nothing else - case gatherEqualsBy (List.length << Tuple.second) possible of + case List.Extra.gatherEqualsBy (List.length << Tuple.second) possible of [] -> Nothing @@ -72,6 +75,7 @@ solve_sudoku_smart sudoku empty_pos = -- all pairs in x::xs should have only one possible entry therefor we apply all at once pairs = (x :: xs) + |> fromList |> filterMap (\( pos, entries ) -> case entries of @@ -92,7 +96,8 @@ solve_sudoku_smart sudoku empty_pos = some_solutions = -- try all possibilities for the first position x - |> (\( pos, entries ) -> ( pos, map (parse >> Fixed) entries )) + |> Tuple.mapSecond fromList + |> Tuple.mapSecond (map (parse >> Fixed)) -- all combinations applied and the fields position we just fill |> (\( pos, opt ) -> map (Tuple.pair pos << Sudoku.update_sudoku sudoku pos) opt) -- all combinations applied and the fields position we still need to fill @@ -101,15 +106,15 @@ solve_sudoku_smart sudoku empty_pos = |> filterMap apply in -- return Just the first solution or Nothing should none exist - List.head some_solutions + head some_solutions -apply_all : List Position -> List ( Position, Int ) -> Sudoku -> Maybe Sudoku +apply_all : Seq Position -> Seq ( Position, Int ) -> Sudoku -> Maybe Sudoku apply_all empty_pos pairs sudoku = let -- sudoku with all position entry pairs applied res_sudoku = - List.foldr (\( pos, entry ) s -> Sudoku.update_sudoku s pos <| parse >> Fixed <| entry) sudoku pairs + foldr (\( pos, entry ) s -> Sudoku.update_sudoku s pos <| parse >> Fixed <| entry) sudoku pairs -- positions unapplied remaining = @@ -132,7 +137,7 @@ apply_all empty_pos pairs sudoku = -- applies the position list and sudoku from the tuple to solve_sudoku_smart -apply : ( List Position, Sudoku ) -> Maybe Sudoku +apply : ( Seq Position, Sudoku ) -> Maybe Sudoku apply ( l, s ) = solve_sudoku_smart s l @@ -141,16 +146,16 @@ apply ( l, s ) = -- return all positions containing an EMPTY value -list_of_empty : Sudoku -> List Position +list_of_empty : Sudoku -> Seq Position list_of_empty sudoku = - concatMap list_of_empty_row <| indexedMap Tuple.pair sudoku + andThen list_of_empty_row <| indexedMap Tuple.pair sudoku -- list_of_empty_row returns the Positions of the EMPTY entries in the Row -list_of_empty_row : ( Int, Row ) -> List Position +list_of_empty_row : ( Int, Row ) -> Seq Position list_of_empty_row ( row_index, row ) = filterMap (\( column_index, entry ) -> diff --git a/elm-examples/sudoku/src/HardCoded.elm b/elm-examples/sudoku/src/HardCoded.elm index 7823922..dc30670 100644 --- a/elm-examples/sudoku/src/HardCoded.elm +++ b/elm-examples/sudoku/src/HardCoded.elm @@ -1,15 +1,15 @@ module HardCoded exposing (sudokus, to_sudoku_row) -import List exposing (map) +import Seq exposing (..) import Types exposing (Entry(..), Row, Sudoku, ValidEntry(..)) -sudokus : List Sudoku +sudokus : Seq Sudoku sudokus = - [] + Nil -to_sudoku_row : List (Maybe Int) -> Row +to_sudoku_row : Seq (Maybe Int) -> Row to_sudoku_row row = map to_entry row @@ -53,24 +53,22 @@ parse e = N9 - -{- - - - to_sudoku : List (List (Maybe Int)) -> Sudoku - to_sudoku list = - map to_sudoku_row list - - s1 = - to_sudoku - [ [ Just 8, Just 2, Nothing, Just 9, Nothing, Nothing, Nothing, Nothing, Just 7 ] - , [ Just 7, Nothing, Just 9, Nothing, Just 5, Nothing, Just 2, Just 1, Nothing ] - , [ Just 4, Nothing, Nothing, Just 2, Nothing, Just 7, Nothing, Just 6, Nothing ] - , [ Just 9, Nothing, Just 2, Just 1, Nothing, Nothing, Nothing, Nothing, Just 6 ] - , [ Just 5, Just 8, Nothing, Nothing, Just 9, Just 2, Nothing, Nothing, Just 1 ] - , [ Nothing, Nothing, Nothing, Just 6, Just 7, Just 8, Nothing, Nothing, Nothing ] - , [ Just 6, Just 4, Nothing, Nothing, Just 8, Nothing, Nothing, Just 2, Nothing ] - , [ Just 3, Nothing, Just 8, Nothing, Nothing, Nothing, Nothing, Just 4, Just 5 ] - , [ Nothing, Nothing, Nothing, Nothing, Nothing, Just 9, Nothing, Just 7, Nothing ] - ] --} +to_sudoku : Seq (Seq (Maybe Int)) -> Sudoku +to_sudoku list = + map to_sudoku_row list + + +s1 = + to_sudoku <| + map fromList <| + fromList + [ [ Just 8, Just 2, Nothing, Just 9, Nothing, Nothing, Nothing, Nothing, Just 7 ] + , [ Just 7, Nothing, Just 9, Nothing, Just 5, Nothing, Just 2, Just 1, Nothing ] + , [ Just 4, Nothing, Nothing, Just 2, Nothing, Just 7, Nothing, Just 6, Nothing ] + , [ Just 9, Nothing, Just 2, Just 1, Nothing, Nothing, Nothing, Nothing, Just 6 ] + , [ Just 5, Just 8, Nothing, Nothing, Just 9, Just 2, Nothing, Nothing, Just 1 ] + , [ Nothing, Nothing, Nothing, Just 6, Just 7, Just 8, Nothing, Nothing, Nothing ] + , [ Just 6, Just 4, Nothing, Nothing, Just 8, Nothing, Nothing, Just 2, Nothing ] + , [ Just 3, Nothing, Just 8, Nothing, Nothing, Nothing, Nothing, Just 4, Just 5 ] + , [ Nothing, Nothing, Nothing, Nothing, Nothing, Just 9, Nothing, Just 7, Nothing ] + ] diff --git a/elm-examples/sudoku/src/Seq/Extra.elm b/elm-examples/sudoku/src/Seq/Extra.elm new file mode 100644 index 0000000..5a708ed --- /dev/null +++ b/elm-examples/sudoku/src/Seq/Extra.elm @@ -0,0 +1,120 @@ +module Seq.Extra exposing (all, any, filter, getAt, indexedMap, limitRepeat, notMember, range, remove, setAt) + +import Seq exposing (..) + + +all : (a -> Bool) -> Seq a -> Bool +all predicate seq = + case seq of + Nil -> + True + + Cons a fun -> + case predicate a of + True -> + all predicate <| fun () + + False -> + False + + +any : (a -> Bool) -> Seq a -> Bool +any predicate seq = + case seq of + Nil -> + False + + Cons a fun -> + case predicate a of + False -> + all predicate <| fun () + + True -> + True + + +getAt : Int -> Seq a -> Maybe a +getAt index seq = + case seq of + Nil -> + Nothing + + a -> + head <| drop index a + + +setAt : Int -> a -> Seq a -> Seq a +setAt index replacement seq = + if index < 0 then + seq + + else + let + head = + take index seq + + tail = + drop index seq + in + case tail of + Cons a rem -> + append head <| Cons replacement rem + + Nil -> + seq + + +remove : a -> Seq a -> Seq a +remove sentinal seq = + case seq of + Nil -> + Nil + + Cons a tail -> + if a == sentinal then + tail () + + else + Cons a (\_ -> remove sentinal <| tail ()) + + +limitRepeat : Int -> a -> Seq a +limitRepeat count value = + repeat value |> take count + + +notMember : a -> Seq a -> Bool +notMember a seq = + not <| member a seq + + +filter : (a -> Bool) -> Seq a -> Seq a +filter predicate seq = + filterMap + (\v -> + if predicate v then + Just v + + else + Nothing + ) + seq + + +range : Int -> Int -> Seq Int +range from to = + fromList <| List.range from to + + +indexedMap : (Int -> a -> b) -> Seq a -> Seq b +indexedMap = + let + internIndexMap index fun seq = + case seq of + Nil -> + Nil + + Cons a tail -> + Cons (fun index a) (\_ -> internIndexMap (index + 1) fun <| tail ()) + in + internIndexMap 0 diff --git a/elm-examples/sudoku/src/Seq/Random.elm b/elm-examples/sudoku/src/Seq/Random.elm new file mode 100644 index 0000000..8035b7c --- /dev/null +++ b/elm-examples/sudoku/src/Seq/Random.elm @@ -0,0 +1,15 @@ +module Seq.Random exposing (shuffle, uniform) + +import Random exposing (Generator) +import Random.List +import Seq exposing (..) + + +shuffle : Seq a -> Generator (Seq a) +shuffle seq = + toList seq |> Random.List.shuffle |> Random.map fromList + + +uniform : a -> Seq a -> Generator a +uniform a seq = + Random.uniform a <| toList seq diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index f69489b..23e95fb 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,28 +1,30 @@ -module Sudoku exposing (element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, parse, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing (empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, parse, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) import HardCoded -import List exposing (..) import List.Extra exposing (transpose) import Random exposing (Generator, generate) +import Seq exposing (..) +import Seq.Extra exposing (..) +import Seq.Random exposing (..) import Types exposing (..) empty_sudoku : Sudoku empty_sudoku = - repeat 9 (repeat 9 EMPTY) + repeat (repeat EMPTY |> take 9) |> take 9 validate_sudoku : Sudoku -> Bool validate_sudoku sudoku = - all (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ] + all (validate_feature sudoku) <| fromList [ extract_rows, extract_columns, extract_areas ] -validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool +validate_feature : Sudoku -> (Sudoku -> Seq (Seq Entry)) -> Bool validate_feature sudoku extractor = all validate_list (extractor sudoku) -validate_list : List Entry -> Bool +validate_list : Seq Entry -> Bool validate_list l = validate_list2 (map entry_to_maybe l) @@ -33,7 +35,7 @@ validate_list l = validate_entry : Sudoku -> Position -> Int -> Bool validate_entry s p e = - all (List.Extra.notMember (Fixed <| parse e)) <| map (\a -> a s p) [ extract_row, extract_column, extract_area ] + all (notMember (Fixed <| parse e)) <| map (\a -> a s p) <| fromList [ extract_row, extract_column, extract_area ] @@ -46,9 +48,9 @@ validate_entry s p e = {- creates a list of possible entries for a position -} -possible_values : Sudoku -> Position -> List Int +possible_values : Sudoku -> Position -> Seq Int possible_values s p = - List.filter (validate_entry s p) (range 1 9) + filter (validate_entry s p) (range 1 9) entry_to_maybe : Entry -> Maybe ValidEntry @@ -64,31 +66,39 @@ entry_to_maybe v = Just m -validate_list2 : List (Maybe ValidEntry) -> Bool + +-- TODO convert here seq to list as the member check and the recursive call would both evaluate the whole sequence + + +validate_list2 : Seq (Maybe ValidEntry) -> Bool validate_list2 l = case l of - [] -> + Nil -> True - Nothing :: tail -> - validate_list2 tail + Cons Nothing tail -> + validate_list2 <| tail () - m :: tail -> - not (member m tail) && validate_list2 tail + Cons m tail -> + let + t = + tail () + in + not (member m t) && validate_list2 t -- Creates a list of area entry lists -extract_areas : Sudoku -> List (List Entry) +extract_areas : Sudoku -> Seq (Seq Entry) extract_areas sudoku = map (\n -> extract_area sudoku ( n // 3, remainderBy 3 n )) (range 0 8) -extract_area_from_position : Sudoku -> Position -> List Entry +extract_area_from_position : Sudoku -> Position -> Seq Entry extract_area_from_position sudoku ( row, column ) = extract_area sudoku ( row // 3, column // 3 ) @@ -97,7 +107,7 @@ extract_area_from_position sudoku ( row, column ) = -- Drops the first 3*n elements of a list and returns 3 elements of the remainder -td3 : Int -> List a -> List a +td3 : Int -> Seq a -> Seq a td3 n list = take 3 (drop (n * 3) list) @@ -106,66 +116,62 @@ td3 n list = -- Returns a list of 9 entries that form the area defined by the position -extract_area : Sudoku -> Position -> List Entry +extract_area : Sudoku -> Position -> Seq Entry extract_area s ( r, c ) = - foldr (\n -> append (td3 c n)) [] (td3 r s) + foldr (\n -> append (td3 c n)) Nil (td3 r s) -extract_rows : Sudoku -> List (List Entry) +extract_rows : Sudoku -> Seq (Seq Entry) extract_rows = identity -extract_row : Sudoku -> Position -> List Entry +extract_row : Sudoku -> Position -> Seq Entry extract_row sudoku ( row, _ ) = - Maybe.withDefault [] <| element row sudoku + Maybe.withDefault Nil <| getAt row sudoku + + + +-- todo might want to implement this our selves for better efficiency -extract_columns : Sudoku -> List (List Entry) +extract_columns : Sudoku -> Seq (Seq Entry) extract_columns = - List.Extra.transpose + map toList >> toList >> List.Extra.transpose >> fromList >> map fromList -extract_column : Sudoku -> Position -> List Entry +extract_column : Sudoku -> Position -> Seq Entry extract_column sudoku ( _, column ) = - filterMap (element column) sudoku + filterMap (getAt column) sudoku -- Returns a list of nth elements if they exist -nth_column : List (List a) -> Int -> List a +nth_column : Seq (Seq a) -> Int -> Seq a nth_column list index = - List.filterMap (element index) list + filterMap (getAt index) list -- Returns the nth element of a list - - -element : Int -> List a -> Maybe a -element = - List.Extra.getAt - - - -- Generate Sudoku ----------------------------------------------------------------------------------------------------- update_sudoku : Sudoku -> Position -> Entry -> Sudoku update_sudoku sudoku ( row, column ) entry = - exchange_entry sudoku row (update_sudoku_row (List.head (drop row sudoku)) column entry) + exchange_entry sudoku row (update_sudoku_row (head (drop row sudoku)) column entry) update_sudoku_row : Maybe Row -> Int -> Entry -> Row update_sudoku_row row = - exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) + exchange_entry (Maybe.withDefault (limitRepeat 9 EMPTY) row) -exchange_entry : List a -> Int -> a -> List a +exchange_entry : Seq a -> Int -> a -> Seq a exchange_entry list index replacement = - List.Extra.setAt index replacement list + setAt index replacement list @@ -180,11 +186,11 @@ rnd = gen_sudoku : Generator (Maybe Sudoku) gen_sudoku = case HardCoded.sudokus of - [] -> + Nil -> Random.constant Nothing - x :: xa -> - Random.uniform (Just x) <| map (\s -> Just s) xa + Cons x xa -> + uniform (Just x) <| map (\s -> Just s) <| xa () @@ -221,14 +227,14 @@ try_insert p s int = Random.lazy (\_ -> mayUniform possibleMaybeValues) -mayUniform : List a -> Generator (Maybe a) +mayUniform : Seq a -> Generator (Maybe a) mayUniform list = case list of - [] -> + Nil -> Random.constant Nothing - x :: xs -> - Random.uniform (Just x) <| map (\y -> Just y) xs + Cons x xs -> + uniform (Just x) <| map (\y -> Just y) <| xs () next : ( Int, Int ) -> ( ( Int, Int ), Bool ) @@ -280,7 +286,7 @@ parse e = get_entry : Sudoku -> Position -> Maybe Entry get_entry s ( row, column ) = - Maybe.andThen (element column) (element row s) + Maybe.andThen (getAt column) (getAt row s) has_entry s p = diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index e8ce0de..30ed90c 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -1,6 +1,7 @@ module Types exposing (Entry(..), Model, Msg(..), Position, Row, Sudoku, ValidEntry(..), all_options) import List exposing (map) +import Seq exposing (Seq(..)) type Entry @@ -26,11 +27,11 @@ all_options = type alias Row = - List Entry + Seq Entry type alias Sudoku = - List Row + Seq Row type alias Model = diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index ffcf496..aa2ae6b 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,8 +1,9 @@ -module Update exposing (has_emptys, no_emptys_sudoku, update, won_sudoku) +module Update exposing (no_emptys_sudoku, update, won_sudoku) import GenSudoku import List exposing (filter) import Platform.Cmd +import Seq.Extra exposing (all) import Sudoku exposing (..) import Types exposing (..) @@ -51,17 +52,4 @@ won_sudoku field = no_emptys_sudoku : Sudoku -> Bool no_emptys_sudoku field = - filter has_emptys field == [] - - -has_emptys : List Entry -> Bool -has_emptys list = - case list of - [] -> - False - - EMPTY :: _ -> - True - - _ :: t -> - has_emptys t + all (all <| (/=) EMPTY) field diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index 0345e6e..a8b9a8d 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -4,9 +4,10 @@ import Html exposing (..) import Html.Attributes exposing (selected, style) import Html.Events exposing (onClick, onInput) import List exposing (map, map2, range, repeat) +import List.Extra exposing (zip) +import Seq exposing (toList) import Types exposing (..) -import List.Extra exposing (zip) view : Model -> Html Msg view ( sudoku, msg ) = @@ -15,12 +16,12 @@ view ( sudoku, msg ) = gen_sudoku : Sudoku -> Html Msg gen_sudoku model = - table [ style "border" "1px solid black" ] <| map gen_row <| zip (range 0 8) model + table [ style "border" "1px solid black" ] <| map gen_row <| zip (range 0 8) <| toList model gen_row : ( Int, Row ) -> Html Msg gen_row ( index, row ) = - tr [] <| map gen_entry <| zip (zip (repeat 9 index) <| range 0 8) row + tr [] <| map gen_entry <| zip (zip (repeat 9 index) <| range 0 8) <| toList row gen_entry : ( Position, Entry ) -> Html Msg @@ -34,7 +35,8 @@ gen_entry ( position, entry ) = conv_to_msg : Position -> String -> Msg -conv_to_msg pos = parse >> Msg pos +conv_to_msg pos = + parse >> Msg pos gen_option : Position -> Entry -> Entry -> Html Msg -- GitLab From 55e3fa4ddb414e39d341cb5b387ced5b110aa4f1 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 12:58:16 +0200 Subject: [PATCH 52/82] fix some rebase errors --- elm-examples/sudoku/src/GenSudoku.elm | 6 ++---- elm-examples/sudoku/src/Model.elm | 8 ++++---- 2 files changed, 6 insertions(+), 8 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index acd8dc4..88d93d8 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -5,12 +5,10 @@ import HardCoded import List import List.Extra import Maybe -import Maybe.Extra -import Random exposing (Generator, constant) -import Random.List exposing (shuffle) +import Random exposing (Generator) import Seq exposing (..) import Seq.Extra exposing (..) -import Seq.Random exposing (..) +import Seq.Random exposing (shuffle) import Sudoku exposing (parse, possible_values) import Types exposing (Entry(..), Position, Row, Sudoku) diff --git a/elm-examples/sudoku/src/Model.elm b/elm-examples/sudoku/src/Model.elm index c759f96..e541eb2 100644 --- a/elm-examples/sudoku/src/Model.elm +++ b/elm-examples/sudoku/src/Model.elm @@ -1,14 +1,14 @@ module Model exposing (init, subs) -import GenSudoku exposing (rnd) +import GenSudoku +import Random import Sudoku exposing (empty_sudoku) import Types exposing (..) -import Random -import GenSudoku + init : a -> ( Model, Cmd Msg ) init _ = - ( ( empty_sudoku, "Empty" ), Random.generate (Random) GenSudoku.gen_full_sudoku ) + ( ( empty_sudoku, "Empty" ), Random.generate Random GenSudoku.gen_full_sudoku ) subs : Model -> Sub Msg -- GitLab From 69afc711a28a9431d516939f20951111cd89c185 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 13:26:14 +0200 Subject: [PATCH 53/82] change the Entry Type of Sudoku --- elm-examples/sudoku/src/GenSudoku.elm | 12 ++-- elm-examples/sudoku/src/HardCoded.elm | 83 ++++++++------------------- elm-examples/sudoku/src/Sudoku.elm | 51 +++------------- elm-examples/sudoku/src/Types.elm | 27 ++++----- elm-examples/sudoku/src/Update.elm | 2 - elm-examples/sudoku/src/View.elm | 48 ++++++++-------- 6 files changed, 73 insertions(+), 150 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 88d93d8..25e5ab2 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,7 +1,7 @@ module GenSudoku exposing (apply, apply_all, gen_full_sudoku, list_of_empty, list_of_empty_row, rmap, solve_sudoku, solve_sudoku_smart) import Basics exposing ((<<), (>>), (||)) -import HardCoded +import HardCoded exposing (to_entry) import List import List.Extra import Maybe @@ -9,8 +9,8 @@ import Random exposing (Generator) import Seq exposing (..) import Seq.Extra exposing (..) import Seq.Random exposing (shuffle) -import Sudoku exposing (parse, possible_values) -import Types exposing (Entry(..), Position, Row, Sudoku) +import Sudoku exposing (possible_values) +import Types exposing (Entry(..), EntryType(..), Position, Row, Sudoku) rmap = @@ -28,7 +28,7 @@ gen_full_sudoku = |> map Just |> shuffle -- insert Row into Empty Sudoku - |> rmap (\list -> setAt 0 (HardCoded.to_sudoku_row list) Sudoku.empty_sudoku) + |> rmap (\list -> setAt 0 (map to_entry list) Sudoku.empty_sudoku) -- solve remaining Sudoku |> rmap solve_sudoku @@ -95,7 +95,7 @@ solve_sudoku_smart sudoku empty_pos = -- try all possibilities for the first position x |> Tuple.mapSecond fromList - |> Tuple.mapSecond (map (parse >> Fixed)) + |> Tuple.mapSecond (map (Entry Fixed)) -- all combinations applied and the fields position we just fill |> (\( pos, opt ) -> map (Tuple.pair pos << Sudoku.update_sudoku sudoku pos) opt) -- all combinations applied and the fields position we still need to fill @@ -112,7 +112,7 @@ apply_all empty_pos pairs sudoku = let -- sudoku with all position entry pairs applied res_sudoku = - foldr (\( pos, entry ) s -> Sudoku.update_sudoku s pos <| parse >> Fixed <| entry) sudoku pairs + foldr (\( pos, entry ) s -> Sudoku.update_sudoku s pos <| Entry Fixed <| entry) sudoku pairs -- positions unapplied remaining = diff --git a/elm-examples/sudoku/src/HardCoded.elm b/elm-examples/sudoku/src/HardCoded.elm index dc30670..42eb6d1 100644 --- a/elm-examples/sudoku/src/HardCoded.elm +++ b/elm-examples/sudoku/src/HardCoded.elm @@ -1,74 +1,39 @@ -module HardCoded exposing (sudokus, to_sudoku_row) +module HardCoded exposing (sudokus, to_entry, to_sudoku) import Seq exposing (..) -import Types exposing (Entry(..), Row, Sudoku, ValidEntry(..)) +import Types exposing (..) sudokus : Seq Sudoku sudokus = - Nil - - -to_sudoku_row : Seq (Maybe Int) -> Row -to_sudoku_row row = - map to_entry row + Cons s1 <| \_ -> Nil to_entry : Maybe Int -> Entry to_entry = - Maybe.map (parse >> Fixed) >> Maybe.withDefault EMPTY - - -parse : Int -> ValidEntry -parse e = - case e of - 1 -> - N1 - - 2 -> - N2 - - 3 -> - N3 - - 4 -> - N4 - - 5 -> - N5 - - 6 -> - N6 - - 7 -> - N7 - - 8 -> - N8 - - 9 -> - N9 - - _ -> - N9 + Maybe.map (Entry Fixed) >> Maybe.withDefault EMPTY -to_sudoku : Seq (Seq (Maybe Int)) -> Sudoku -to_sudoku list = - map to_sudoku_row list +to_sudoku : List (List (Maybe Int)) -> Sudoku +to_sudoku = + -- map Maybe Int to Entry + List.map (List.map to_entry) + -- map inner List to Seq + >> List.map fromList + -- map outer List to Seq + >> fromList +s1 : Seq (Seq Entry) s1 = - to_sudoku <| - map fromList <| - fromList - [ [ Just 8, Just 2, Nothing, Just 9, Nothing, Nothing, Nothing, Nothing, Just 7 ] - , [ Just 7, Nothing, Just 9, Nothing, Just 5, Nothing, Just 2, Just 1, Nothing ] - , [ Just 4, Nothing, Nothing, Just 2, Nothing, Just 7, Nothing, Just 6, Nothing ] - , [ Just 9, Nothing, Just 2, Just 1, Nothing, Nothing, Nothing, Nothing, Just 6 ] - , [ Just 5, Just 8, Nothing, Nothing, Just 9, Just 2, Nothing, Nothing, Just 1 ] - , [ Nothing, Nothing, Nothing, Just 6, Just 7, Just 8, Nothing, Nothing, Nothing ] - , [ Just 6, Just 4, Nothing, Nothing, Just 8, Nothing, Nothing, Just 2, Nothing ] - , [ Just 3, Nothing, Just 8, Nothing, Nothing, Nothing, Nothing, Just 4, Just 5 ] - , [ Nothing, Nothing, Nothing, Nothing, Nothing, Just 9, Nothing, Just 7, Nothing ] - ] + to_sudoku + [ [ Just 8, Just 2, Nothing, Just 9, Nothing, Nothing, Nothing, Nothing, Just 7 ] + , [ Just 7, Nothing, Just 9, Nothing, Just 5, Nothing, Just 2, Just 1, Nothing ] + , [ Just 4, Nothing, Nothing, Just 2, Nothing, Just 7, Nothing, Just 6, Nothing ] + , [ Just 9, Nothing, Just 2, Just 1, Nothing, Nothing, Nothing, Nothing, Just 6 ] + , [ Just 5, Just 8, Nothing, Nothing, Just 9, Just 2, Nothing, Nothing, Just 1 ] + , [ Nothing, Nothing, Nothing, Just 6, Just 7, Just 8, Nothing, Nothing, Nothing ] + , [ Just 6, Just 4, Nothing, Nothing, Just 8, Nothing, Nothing, Just 2, Nothing ] + , [ Just 3, Nothing, Just 8, Nothing, Nothing, Nothing, Nothing, Just 4, Just 5 ] + , [ Nothing, Nothing, Nothing, Nothing, Nothing, Just 9, Nothing, Just 7, Nothing ] + ] diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 23e95fb..69bec4d 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,7 +1,7 @@ -module Sudoku exposing (empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, parse, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing (empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) import HardCoded -import List.Extra exposing (transpose) +import List.Extra import Random exposing (Generator, generate) import Seq exposing (..) import Seq.Extra exposing (..) @@ -35,7 +35,7 @@ validate_list l = validate_entry : Sudoku -> Position -> Int -> Bool validate_entry s p e = - all (notMember (Fixed <| parse e)) <| map (\a -> a s p) <| fromList [ extract_row, extract_column, extract_area ] + all (notMember (Entry Fixed e)) <| map (\a -> a s p) <| fromList [ extract_row, extract_column, extract_area ] @@ -53,16 +53,13 @@ possible_values s p = filter (validate_entry s p) (range 1 9) -entry_to_maybe : Entry -> Maybe ValidEntry +entry_to_maybe : Entry -> Maybe EntryValue entry_to_maybe v = case v of EMPTY -> Nothing - User m -> - Just m - - Fixed m -> + Entry _ m -> Just m @@ -70,7 +67,7 @@ entry_to_maybe v = -- TODO convert here seq to list as the member check and the recursive call would both evaluate the whole sequence -validate_list2 : Seq (Maybe ValidEntry) -> Bool +validate_list2 : Seq (Maybe EntryValue) -> Bool validate_list2 l = case l of Nil -> @@ -201,7 +198,7 @@ try_insert : Position -> Sudoku -> Int -> Generator (Maybe Sudoku) try_insert p s int = let new = - update_sudoku s p (Fixed (parse int)) + update_sudoku s p (Entry Fixed int) ( n, done ) = next p @@ -250,40 +247,6 @@ next ( x, y ) = ( ( l, s + 1 ), False ) -parse : Int -> ValidEntry -parse e = - case e of - 1 -> - N1 - - 2 -> - N2 - - 3 -> - N3 - - 4 -> - N4 - - 5 -> - N5 - - 6 -> - N6 - - 7 -> - N7 - - 8 -> - N8 - - 9 -> - N9 - - _ -> - N9 - - get_entry : Sudoku -> Position -> Maybe Entry get_entry s ( row, column ) = Maybe.andThen (getAt column) (getAt row s) diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index 30ed90c..18eeb5a 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -1,29 +1,26 @@ -module Types exposing (Entry(..), Model, Msg(..), Position, Row, Sudoku, ValidEntry(..), all_options) +module Types exposing (Entry(..), EntryType(..), EntryValue, Model, Msg(..), Position, Row, Sudoku, all_options) -import List exposing (map) +import List exposing (map, range) import Seq exposing (Seq(..)) type Entry = EMPTY - | User ValidEntry - | Fixed ValidEntry + | Entry EntryType EntryValue -type ValidEntry - = N1 - | N2 - | N3 - | N4 - | N5 - | N6 - | N7 - | N8 - | N9 +type EntryType + = Fixed + | User +type alias EntryValue = + Int + + +all_options : List Entry all_options = - EMPTY :: map (\e -> User e) [ N1, N2, N3, N4, N5, N6, N7, N8, N9 ] + EMPTY :: map (Entry User) (range 1 9) type alias Row = diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index aa2ae6b..fc93620 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,7 +1,5 @@ module Update exposing (no_emptys_sudoku, update, won_sudoku) -import GenSudoku -import List exposing (filter) import Platform.Cmd import Seq.Extra exposing (all) import Sudoku exposing (..) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index a8b9a8d..a2740d5 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -27,7 +27,7 @@ gen_row ( index, row ) = gen_entry : ( Position, Entry ) -> Html Msg gen_entry ( position, entry ) = case entry of - Fixed _ -> + Entry Fixed _ -> td [] [ text <| show_entry entry ] _ -> @@ -48,31 +48,31 @@ parse : String -> Entry parse e = case e of "1" -> - User N1 + Entry User 1 "2" -> - User N2 + Entry User 2 "3" -> - User N3 + Entry User 3 "4" -> - User N4 + Entry User 4 "5" -> - User N5 + Entry User 5 "6" -> - User N6 + Entry User 6 "7" -> - User N7 + Entry User 7 "8" -> - User N8 + Entry User 8 "9" -> - User N9 + Entry User 9 _ -> EMPTY @@ -84,39 +84,39 @@ show_entry entry = EMPTY -> "" - User e -> - show e - - Fixed e -> + Entry _ e -> show e -show : ValidEntry -> String +show : EntryValue -> String show e = case e of - N1 -> + 1 -> "1" - N2 -> + 2 -> "2" - N3 -> + 3 -> "3" - N4 -> + 4 -> "4" - N5 -> + 5 -> "5" - N6 -> + 6 -> "6" - N7 -> + 7 -> "7" - N8 -> + 8 -> "8" - N9 -> + 9 -> "9" + + _ -> + "" -- GitLab From 3c1a09d47d011208a8f1ed5cd9b48f420932b906 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 14:44:04 +0200 Subject: [PATCH 54/82] add todo to function that can now probably be replaced by standart library functions --- elm-examples/sudoku/src/View.elm | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index a2740d5..adfd248 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -44,6 +44,10 @@ gen_option position select entry = option [ selected <| select == entry, onClick <| Msg position select ] [ text <| show_entry entry ] + +-- todo there is probably a function for String to int conversion + + parse : String -> Entry parse e = case e of @@ -88,6 +92,10 @@ show_entry entry = show e + +-- todo there is probably a function for int to String conversion + + show : EntryValue -> String show e = case e of -- GitLab From a2ae33ace3b2a57d0ac72dcd1c317ea18493d38c Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 14:45:18 +0200 Subject: [PATCH 55/82] start to rewrite solver again --- elm-examples/sudoku/src/GenSudoku.elm | 141 +++++++++++++++++++++++++- 1 file changed, 140 insertions(+), 1 deletion(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 25e5ab2..09e6729 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -10,7 +10,7 @@ import Seq exposing (..) import Seq.Extra exposing (..) import Seq.Random exposing (shuffle) import Sudoku exposing (possible_values) -import Types exposing (Entry(..), EntryType(..), Position, Row, Sudoku) +import Types exposing (..) rmap = @@ -21,6 +21,14 @@ randThen = Random.andThen + +-- as the SmartSudoku is traversed multiple times for each recursion step I did not choose Seq here as this would evaluate the content of the Sequence multiple times + + +type alias SmartSudoku = + List (List (List Int)) + + gen_full_sudoku : Generator (Maybe Sudoku) gen_full_sudoku = --generate a random first row @@ -42,6 +50,137 @@ solve_sudoku sudoku = solve_sudoku_smart sudoku <| list_of_empty sudoku +solve_sudoku_reimp : Sudoku -> Maybe Sudoku +solve_sudoku_reimp = + to_smart >> solve_sudoku_smart_reimp >> Maybe.map from_smart + + +to_smart : Sudoku -> SmartSudoku +to_smart sudoku = + sudoku + |> toList + << indexedMap + (\rowIndex -> + toList + << indexedMap + (\columnIndex entry -> + case entry of + EMPTY -> + toList <| possible_values sudoku ( rowIndex, columnIndex ) + + Entry _ num -> + [ num ] + ) + ) + + +from_smart : SmartSudoku -> Sudoku +from_smart = + fromList << List.map (fromList << List.map options_to_entry) + + +options_to_entry : List Int -> Entry +options_to_entry seq = + case seq of + -- no possible entry remaining, leaving entry as this is the best we can do + [] -> + EMPTY + + -- only one entry remaining using that + [ a ] -> + Entry Fixed a + + -- more than one possibility leaving empty as this is not for us to decide + _ :: _ -> + EMPTY + + +solve_sudoku_smart_reimp : SmartSudoku -> Maybe SmartSudoku +solve_sudoku_smart_reimp sudoku = + if List.any (List.any List.isEmpty) sudoku then + -- a field has no entries remaining, no solution to be found + Nothing + + else if List.all (List.all (List.length >> (==) 1)) sudoku then + -- all fields have one entry remaining we are done + Just sudoku + + else + -- find a possition with least options, but more than one remaining and try them + List.concatMap (\row -> List.map (\collumn -> Tuple.pair row collumn) <| List.range 0 8) (List.range 0 8) + -- filter positions with 1 (or less entries) + |> List.filter (\pos -> get_entry_at pos sudoku |> Maybe.withDefault [] |> List.length >> (>) 1) + -- the default should never be needed + |> List.sortBy (\pos -> get_entry_at pos sudoku |> Maybe.map List.length |> Maybe.withDefault 9) + -- get a possition with least options + |> List.head + -- try all options lazy + |> Maybe.map (try_all_options sudoku) + |> Maybe.withDefault Nil + -- take first if exist else Nothing + |> head + + +try_all_options : SmartSudoku -> Position -> Seq SmartSudoku +try_all_options sudoku position = + get_entry_at position sudoku |> Maybe.withDefault [] |> fromList |> filterMap (try_entry_at sudoku position) + + +try_entry_at : SmartSudoku -> Position -> EntryValue -> Maybe SmartSudoku +try_entry_at sudoku (( row, column ) as pos) entry = + set_entry_at [ entry ] pos sudoku + |> update_sorounding pos entry + + +update_sorounding : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku +update_sorounding pos entry sudoku = + update_sorounding_row pos entry sudoku + |> Maybe.andThen (update_sorounding_column pos entry) + |> Maybe.andThen (update_sorounding_section pos entry) + + + +-- todo + + +update_sorounding_row : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku +update_sorounding_row ( row, _ ) entry = + \_ -> Nothing + + + +-- todo + + +update_sorounding_column : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku +update_sorounding_column ( _, column ) entry = + \_ -> Nothing + + + +-- todo + + +update_sorounding_section : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku +update_sorounding_section ( row, column ) entry = + \_ -> Nothing + + +get_entry_at : Position -> SmartSudoku -> Maybe (List EntryValue) +get_entry_at ( row, column ) = + List.Extra.getAt row >> Maybe.andThen (List.Extra.getAt column) + + +set_entry_at : List EntryValue -> Position -> SmartSudoku -> SmartSudoku +set_entry_at entry = + update_entry_at (always entry) + + +update_entry_at : (List EntryValue -> List EntryValue) -> Position -> SmartSudoku -> SmartSudoku +update_entry_at updater ( row, column ) = + List.Extra.updateAt row (List.Extra.updateAt column updater) + + -- Tries to solve the given Sudoku at all provided Positions -- GitLab From 2784c577b767ba790fc808c698cee7888a6991d3 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 16:08:27 +0200 Subject: [PATCH 56/82] add button for sudoku generation instead of on first load finished reimplementation of solve , old code not yet deleted --- elm-examples/sudoku/src/GenSudoku.elm | 91 ++++++++++++++++++--------- elm-examples/sudoku/src/Model.elm | 2 +- elm-examples/sudoku/src/Seq/Extra.elm | 11 +++- elm-examples/sudoku/src/Sudoku.elm | 23 ++++++- elm-examples/sudoku/src/Types.elm | 1 + elm-examples/sudoku/src/Update.elm | 7 ++- elm-examples/sudoku/src/View.elm | 2 +- 7 files changed, 102 insertions(+), 35 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 09e6729..3630233 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,7 +1,7 @@ module GenSudoku exposing (apply, apply_all, gen_full_sudoku, list_of_empty, list_of_empty_row, rmap, solve_sudoku, solve_sudoku_smart) import Basics exposing ((<<), (>>), (||)) -import HardCoded exposing (to_entry) +import HardCoded import List import List.Extra import Maybe @@ -21,12 +21,35 @@ randThen = Random.andThen +abortingFoldl : (b -> a -> Maybe b) -> b -> List a -> Maybe b +abortingFoldl fun init list = + case list of + [] -> + Just init + + x :: xs -> + case fun init x of + Nothing -> + Nothing + + Just next -> + abortingFoldl fun next xs + + -- as the SmartSudoku is traversed multiple times for each recursion step I did not choose Seq here as this would evaluate the content of the Sequence multiple times type alias SmartSudoku = - List (List (List Int)) + List SmartRow + + +type alias SmartRow = + List SmartEntry + + +type alias SmartEntry = + List EntryValue gen_full_sudoku : Generator (Maybe Sudoku) @@ -35,10 +58,11 @@ gen_full_sudoku = range 1 9 |> map Just |> shuffle + |> rmap (zip (fromList <| Sudoku.area_coordinates ( 0, 0 ))) -- insert Row into Empty Sudoku - |> rmap (\list -> setAt 0 (map to_entry list) Sudoku.empty_sudoku) + |> rmap (\list -> foldr (\( pos, value ) -> set_entry_at_seq (HardCoded.to_entry value) pos) Sudoku.empty_sudoku list) -- solve remaining Sudoku - |> rmap solve_sudoku + |> rmap solve_sudoku_reimp @@ -123,47 +147,48 @@ solve_sudoku_smart_reimp sudoku = try_all_options : SmartSudoku -> Position -> Seq SmartSudoku try_all_options sudoku position = - get_entry_at position sudoku |> Maybe.withDefault [] |> fromList |> filterMap (try_entry_at sudoku position) + get_entry_at position sudoku |> Maybe.withDefault [] |> fromList |> filterMap (\entry -> try_entry_at position entry sudoku) -try_entry_at : SmartSudoku -> Position -> EntryValue -> Maybe SmartSudoku -try_entry_at sudoku (( row, column ) as pos) entry = +try_entry_at : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku +try_entry_at (( row, column ) as pos) entry sudoku = set_entry_at [ entry ] pos sudoku |> update_sorounding pos entry update_sorounding : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -update_sorounding pos entry sudoku = - update_sorounding_row pos entry sudoku - |> Maybe.andThen (update_sorounding_column pos entry) - |> Maybe.andThen (update_sorounding_section pos entry) - +update_sorounding pos entry = + update_sorounding_row pos entry + >> Maybe.andThen (update_sorounding_column pos entry) + >> Maybe.andThen (update_sorounding_section pos entry) --- todo - +update_sorounding_entry : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku +update_sorounding_entry pos entry sudoku = + case List.Extra.remove entry <| Maybe.withDefault [] <| get_entry_at pos sudoku of + [] -> + Nothing -update_sorounding_row : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -update_sorounding_row ( row, _ ) entry = - \_ -> Nothing + [ x ] -> + try_entry_at pos x sudoku + list -> + Just <| set_entry_at list pos sudoku --- todo +update_sorounding_row : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku +update_sorounding_row ( row, column ) entry sudoku = + List.range 0 8 |> List.Extra.remove column |> abortingFoldl (\s c -> update_sorounding_entry ( row, c ) entry s) sudoku update_sorounding_column : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -update_sorounding_column ( _, column ) entry = - \_ -> Nothing - - - --- todo +update_sorounding_column ( row, column ) entry sudoku = + List.range 0 8 |> List.Extra.remove row |> abortingFoldl (\s r -> update_sorounding_entry ( r, column ) entry s) sudoku update_sorounding_section : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -update_sorounding_section ( row, column ) entry = - \_ -> Nothing +update_sorounding_section pos entry sudoku = + Sudoku.area_coordinates pos |> List.Extra.remove pos |> abortingFoldl (\s p -> update_sorounding_entry p entry s) sudoku get_entry_at : Position -> SmartSudoku -> Maybe (List EntryValue) @@ -171,16 +196,26 @@ get_entry_at ( row, column ) = List.Extra.getAt row >> Maybe.andThen (List.Extra.getAt column) -set_entry_at : List EntryValue -> Position -> SmartSudoku -> SmartSudoku +set_entry_at : a -> Position -> List (List a) -> List (List a) set_entry_at entry = update_entry_at (always entry) -update_entry_at : (List EntryValue -> List EntryValue) -> Position -> SmartSudoku -> SmartSudoku +set_entry_at_seq : a -> Position -> Seq (Seq a) -> Seq (Seq a) +set_entry_at_seq entry = + update_entry_at_seq (always entry) + + +update_entry_at : (a -> a) -> Position -> List (List a) -> List (List a) update_entry_at updater ( row, column ) = List.Extra.updateAt row (List.Extra.updateAt column updater) +update_entry_at_seq : (a -> a) -> Position -> Seq (Seq a) -> Seq (Seq a) +update_entry_at_seq updater ( row, column ) = + updateAt row (updateAt column updater) + + -- Tries to solve the given Sudoku at all provided Positions diff --git a/elm-examples/sudoku/src/Model.elm b/elm-examples/sudoku/src/Model.elm index e541eb2..78710c1 100644 --- a/elm-examples/sudoku/src/Model.elm +++ b/elm-examples/sudoku/src/Model.elm @@ -8,7 +8,7 @@ import Types exposing (..) init : a -> ( Model, Cmd Msg ) init _ = - ( ( empty_sudoku, "Empty" ), Random.generate Random GenSudoku.gen_full_sudoku ) + ( ( empty_sudoku, "Empty" ), Cmd.none ) subs : Model -> Sub Msg diff --git a/elm-examples/sudoku/src/Seq/Extra.elm b/elm-examples/sudoku/src/Seq/Extra.elm index 5a708ed..fbf9f79 100644 --- a/elm-examples/sudoku/src/Seq/Extra.elm +++ b/elm-examples/sudoku/src/Seq/Extra.elm @@ -1,4 +1,4 @@ -module Seq.Extra exposing (all, any, filter, getAt, indexedMap, limitRepeat, notMember, range, remove, setAt) +module Seq.Extra exposing (all, any, filter, getAt, indexedMap, limitRepeat, notMember, range, remove, setAt, updateAt) import Seq exposing (..) @@ -44,7 +44,12 @@ getAt index seq = setAt : Int -> a -> Seq a -> Seq a -setAt index replacement seq = +setAt index a = + updateAt index (always a) + + +updateAt : Int -> (a -> a) -> Seq a -> Seq a +updateAt index fun seq = if index < 0 then seq @@ -58,7 +63,7 @@ setAt index replacement seq = in case tail of Cons a rem -> - append head <| Cons replacement rem + append head <| Cons (fun a) rem Nil -> seq diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 69bec4d..f16c07a 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,4 +1,4 @@ -module Sudoku exposing (empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_areas, extract_columns, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing (area_coordinates, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_area_from_position, extract_areas, extract_column, extract_columns, extract_row, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) import HardCoded import List.Extra @@ -95,6 +95,27 @@ extract_areas sudoku = (range 0 8) +area_coordinates : Position -> List Position +area_coordinates ( row, column ) = + let + base_row = + row // 3 * 3 + + base_column = + column // 3 * 3 + + base = + ( base_row, base_column ) + + add ( x, y ) ( t, s ) = + ( x + t, y + s ) + + offsets = + List.range 0 2 |> List.concatMap (\r -> List.map (Tuple.pair r) <| List.range 0 2) + in + List.map (add base) offsets + + extract_area_from_position : Sudoku -> Position -> Seq Entry extract_area_from_position sudoku ( row, column ) = extract_area sudoku ( row // 3, column // 3 ) diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index 18eeb5a..18237c4 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -42,3 +42,4 @@ type alias Position = type Msg = Msg Position Entry | Random (Maybe Sudoku) + | Generate diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index fc93620..c36335d 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,13 +1,15 @@ module Update exposing (no_emptys_sudoku, update, won_sudoku) +import GenSudoku import Platform.Cmd +import Random import Seq.Extra exposing (all) import Sudoku exposing (..) import Types exposing (..) update : Msg -> Model -> ( Model, Cmd Msg ) -update msg ( sudoku, text ) = +update msg (( sudoku, text ) as model) = case msg of Msg position entry -> let @@ -28,6 +30,9 @@ update msg ( sudoku, text ) = in ( ( sudoku2, resp ), Cmd.none ) + Generate -> + ( model, Random.generate Random GenSudoku.gen_full_sudoku ) + Random Nothing -> ( ( sudoku, "Failed to Generate Sudoku" ), Cmd.none ) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index adfd248..d875eff 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -11,7 +11,7 @@ import Types exposing (..) view : Model -> Html Msg view ( sudoku, msg ) = - div [] [ gen_sudoku sudoku, text msg ] + div [] [ gen_sudoku sudoku, text msg, button [ onClick Generate ] [ text "Generate" ] ] gen_sudoku : Sudoku -> Html Msg -- GitLab From 50732b5e84518b7fe193640f9703e41f85229100 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 16:22:23 +0200 Subject: [PATCH 57/82] put button not after text, to stop button from jumping add br to have text on a new line --- elm-examples/sudoku/src/View.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index d875eff..c0c4933 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -11,7 +11,7 @@ import Types exposing (..) view : Model -> Html Msg view ( sudoku, msg ) = - div [] [ gen_sudoku sudoku, text msg, button [ onClick Generate ] [ text "Generate" ] ] + div [] [ gen_sudoku sudoku, button [ onClick Generate ] [ text "Generate" ], br [] [], text msg ] gen_sudoku : Sudoku -> Html Msg -- GitLab From e049710f02fa62db30088106e4d52edeba3bb020 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 16:23:04 +0200 Subject: [PATCH 58/82] split gen_full_sudoku in two --- elm-examples/sudoku/src/GenSudoku.elm | 22 +++++++++++++++++----- 1 file changed, 17 insertions(+), 5 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 3630233..53ded4b 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,4 +1,4 @@ -module GenSudoku exposing (apply, apply_all, gen_full_sudoku, list_of_empty, list_of_empty_row, rmap, solve_sudoku, solve_sudoku_smart) +module GenSudoku exposing (apply, apply_all, gen_full_sudoku, gen_start_sudoku, list_of_empty, list_of_empty_row, rmap, solve_sudoku, solve_sudoku_smart) import Basics exposing ((<<), (>>), (||)) import HardCoded @@ -52,8 +52,12 @@ type alias SmartEntry = List EntryValue -gen_full_sudoku : Generator (Maybe Sudoku) -gen_full_sudoku = + +-- generates a partially filled sudoku to start solving + + +gen_start_sudoku : Generator Sudoku +gen_start_sudoku = --generate a random first row range 1 9 |> map Just @@ -61,8 +65,16 @@ gen_full_sudoku = |> rmap (zip (fromList <| Sudoku.area_coordinates ( 0, 0 ))) -- insert Row into Empty Sudoku |> rmap (\list -> foldr (\( pos, value ) -> set_entry_at_seq (HardCoded.to_entry value) pos) Sudoku.empty_sudoku list) - -- solve remaining Sudoku - |> rmap solve_sudoku_reimp + + + +-- generate a filled out sudoku by solving a start_sudoku + + +gen_full_sudoku : Generator (Maybe Sudoku) +gen_full_sudoku = + -- solve remaining Sudoku + gen_start_sudoku |> rmap solve_sudoku_reimp -- GitLab From 20246fcda4e829b6f9d59b6f0ce95f434f718489 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 16:59:17 +0200 Subject: [PATCH 59/82] Revert "change from using List to using Seq (Lazy List)" This reverts commit 7d3746e6e43666bc6b1f3a3efe348a2693ff8dec. # Conflicts: # elm-examples/sudoku/src/GenSudoku.elm # elm-examples/sudoku/src/HardCoded.elm # elm-examples/sudoku/src/Seq/Extra.elm # elm-examples/sudoku/src/Sudoku.elm # elm-examples/sudoku/src/Types.elm # elm-examples/sudoku/src/Update.elm --- elm-examples/sudoku/src/GenSudoku.elm | 79 ++++++++++--------- elm-examples/sudoku/src/HardCoded.elm | 14 ++-- elm-examples/sudoku/src/Sudoku.elm | 104 ++++++++++++-------------- elm-examples/sudoku/src/Types.elm | 5 +- elm-examples/sudoku/src/Update.elm | 4 +- elm-examples/sudoku/src/View.elm | 10 +-- 6 files changed, 100 insertions(+), 116 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 53ded4b..38bd10f 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -2,13 +2,13 @@ module GenSudoku exposing (apply, apply_all, gen_full_sudoku, gen_start_sudoku, import Basics exposing ((<<), (>>), (||)) import HardCoded -import List -import List.Extra +import List exposing (..) +import List.Extra exposing (gatherEqualsBy, remove, zip) import Maybe import Random exposing (Generator) -import Seq exposing (..) -import Seq.Extra exposing (..) -import Seq.Random exposing (shuffle) +import Random.List exposing (shuffle) +import Seq exposing (Seq(..)) +import Seq.Extra import Sudoku exposing (possible_values) import Types exposing (..) @@ -62,9 +62,9 @@ gen_start_sudoku = range 1 9 |> map Just |> shuffle - |> rmap (zip (fromList <| Sudoku.area_coordinates ( 0, 0 ))) + |> rmap (zip (Sudoku.area_coordinates ( 0, 0 ))) -- insert Row into Empty Sudoku - |> rmap (\list -> foldr (\( pos, value ) -> set_entry_at_seq (HardCoded.to_entry value) pos) Sudoku.empty_sudoku list) + |> rmap (\list -> foldr (\( pos, value ) -> set_entry_at (HardCoded.to_entry value) pos) Sudoku.empty_sudoku list) @@ -94,25 +94,23 @@ solve_sudoku_reimp = to_smart : Sudoku -> SmartSudoku to_smart sudoku = sudoku - |> toList - << indexedMap + |> indexedMap (\rowIndex -> - toList - << indexedMap - (\columnIndex entry -> - case entry of - EMPTY -> - toList <| possible_values sudoku ( rowIndex, columnIndex ) - - Entry _ num -> - [ num ] - ) + indexedMap + (\columnIndex entry -> + case entry of + EMPTY -> + possible_values sudoku ( rowIndex, columnIndex ) + + Entry _ num -> + [ num ] + ) ) from_smart : SmartSudoku -> Sudoku from_smart = - fromList << List.map (fromList << List.map options_to_entry) + map (map options_to_entry) options_to_entry : List Int -> Entry @@ -154,12 +152,12 @@ solve_sudoku_smart_reimp sudoku = |> Maybe.map (try_all_options sudoku) |> Maybe.withDefault Nil -- take first if exist else Nothing - |> head + |> Seq.head try_all_options : SmartSudoku -> Position -> Seq SmartSudoku try_all_options sudoku position = - get_entry_at position sudoku |> Maybe.withDefault [] |> fromList |> filterMap (\entry -> try_entry_at position entry sudoku) + get_entry_at position sudoku |> Maybe.map Seq.fromList |> Maybe.withDefault Nil |> Seq.filterMap (\entry -> try_entry_at position entry sudoku) try_entry_at : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku @@ -225,31 +223,31 @@ update_entry_at updater ( row, column ) = update_entry_at_seq : (a -> a) -> Position -> Seq (Seq a) -> Seq (Seq a) update_entry_at_seq updater ( row, column ) = - updateAt row (updateAt column updater) + Seq.Extra.updateAt row (Seq.Extra.updateAt column updater) -- Tries to solve the given Sudoku at all provided Positions -solve_sudoku_smart : Sudoku -> Seq Position -> Maybe Sudoku +solve_sudoku_smart : Sudoku -> List Position -> Maybe Sudoku solve_sudoku_smart sudoku empty_pos = let -- list of (position, not obvious invalid entries for position) possible = -- turn pos into tuple of identical entries - List.map (\a -> ( a, a )) (toList empty_pos) + map (\a -> ( a, a )) empty_pos -- map second entry to possible values at that position - |> List.map (Tuple.mapSecond <| toList << possible_values sudoku) + |> map (Tuple.mapSecond <| possible_values sudoku) -- sort by the amount of possible entries - |> List.sortBy (List.length << Tuple.second) + |> sortBy (List.length << Tuple.second) in - if List.any (List.isEmpty << Tuple.second) possible then + if any (List.isEmpty << Tuple.second) possible then -- one field with no possible inputs exists Nothing else - case List.Extra.gatherEqualsBy (List.length << Tuple.second) possible of + case gatherEqualsBy (List.length << Tuple.second) possible of [] -> Nothing @@ -259,7 +257,6 @@ solve_sudoku_smart sudoku empty_pos = -- all pairs in x::xs should have only one possible entry therefor we apply all at once pairs = (x :: xs) - |> fromList |> filterMap (\( pos, entries ) -> case entries of @@ -280,20 +277,20 @@ solve_sudoku_smart sudoku empty_pos = some_solutions = -- try all possibilities for the first position x - |> Tuple.mapSecond fromList - |> Tuple.mapSecond (map (Entry Fixed)) + |> Tuple.mapSecond Seq.fromList + |> Tuple.mapSecond (Seq.map (Entry Fixed)) -- all combinations applied and the fields position we just fill - |> (\( pos, opt ) -> map (Tuple.pair pos << Sudoku.update_sudoku sudoku pos) opt) + |> (\( pos, opt ) -> Seq.map (Tuple.pair pos << Sudoku.update_sudoku sudoku pos) opt) -- all combinations applied and the fields position we still need to fill - |> map (Tuple.mapFirst (\a -> remove a empty_pos)) + |> Seq.map (Tuple.mapFirst (\a -> remove a empty_pos)) -- apply solve_sudoku_smart to each combination filtering Nothings - |> filterMap apply + |> Seq.filterMap apply in -- return Just the first solution or Nothing should none exist - head some_solutions + Seq.head some_solutions -apply_all : Seq Position -> Seq ( Position, Int ) -> Sudoku -> Maybe Sudoku +apply_all : List Position -> List ( Position, Int ) -> Sudoku -> Maybe Sudoku apply_all empty_pos pairs sudoku = let -- sudoku with all position entry pairs applied @@ -321,7 +318,7 @@ apply_all empty_pos pairs sudoku = -- applies the position list and sudoku from the tuple to solve_sudoku_smart -apply : ( Seq Position, Sudoku ) -> Maybe Sudoku +apply : ( List Position, Sudoku ) -> Maybe Sudoku apply ( l, s ) = solve_sudoku_smart s l @@ -330,16 +327,16 @@ apply ( l, s ) = -- return all positions containing an EMPTY value -list_of_empty : Sudoku -> Seq Position +list_of_empty : Sudoku -> List Position list_of_empty sudoku = - andThen list_of_empty_row <| indexedMap Tuple.pair sudoku + concatMap list_of_empty_row <| indexedMap Tuple.pair sudoku -- list_of_empty_row returns the Positions of the EMPTY entries in the Row -list_of_empty_row : ( Int, Row ) -> Seq Position +list_of_empty_row : ( Int, Row ) -> List Position list_of_empty_row ( row_index, row ) = filterMap (\( column_index, entry ) -> diff --git a/elm-examples/sudoku/src/HardCoded.elm b/elm-examples/sudoku/src/HardCoded.elm index 42eb6d1..1e2e690 100644 --- a/elm-examples/sudoku/src/HardCoded.elm +++ b/elm-examples/sudoku/src/HardCoded.elm @@ -1,12 +1,12 @@ -module HardCoded exposing (sudokus, to_entry, to_sudoku) +module HardCoded exposing (s1, sudokus, to_entry, to_sudoku) -import Seq exposing (..) +import List exposing (..) import Types exposing (..) -sudokus : Seq Sudoku +sudokus : List Sudoku sudokus = - Cons s1 <| \_ -> Nil + [] to_entry : Maybe Int -> Entry @@ -18,13 +18,9 @@ to_sudoku : List (List (Maybe Int)) -> Sudoku to_sudoku = -- map Maybe Int to Entry List.map (List.map to_entry) - -- map inner List to Seq - >> List.map fromList - -- map outer List to Seq - >> fromList -s1 : Seq (Seq Entry) +s1 : Sudoku s1 = to_sudoku [ [ Just 8, Just 2, Nothing, Just 9, Nothing, Nothing, Nothing, Nothing, Just 7 ] diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index f16c07a..9c3aac0 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,30 +1,28 @@ -module Sudoku exposing (area_coordinates, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_area_from_position, extract_areas, extract_column, extract_columns, extract_row, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing (area_coordinates, element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_area_from_position, extract_areas, extract_column, extract_columns, extract_row, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) import HardCoded -import List.Extra +import List exposing (..) +import List.Extra exposing (notMember, transpose) import Random exposing (Generator, generate) -import Seq exposing (..) -import Seq.Extra exposing (..) -import Seq.Random exposing (..) import Types exposing (..) empty_sudoku : Sudoku empty_sudoku = - repeat (repeat EMPTY |> take 9) |> take 9 + repeat 9 (repeat 9 EMPTY) validate_sudoku : Sudoku -> Bool validate_sudoku sudoku = - all (validate_feature sudoku) <| fromList [ extract_rows, extract_columns, extract_areas ] + all (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ] -validate_feature : Sudoku -> (Sudoku -> Seq (Seq Entry)) -> Bool +validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool validate_feature sudoku extractor = all validate_list (extractor sudoku) -validate_list : Seq Entry -> Bool +validate_list : List Entry -> Bool validate_list l = validate_list2 (map entry_to_maybe l) @@ -35,7 +33,7 @@ validate_list l = validate_entry : Sudoku -> Position -> Int -> Bool validate_entry s p e = - all (notMember (Entry Fixed e)) <| map (\a -> a s p) <| fromList [ extract_row, extract_column, extract_area ] + all (notMember (Entry Fixed e)) <| map (\a -> a s p) [ extract_row, extract_column, extract_area ] @@ -48,7 +46,7 @@ validate_entry s p e = {- creates a list of possible entries for a position -} -possible_values : Sudoku -> Position -> Seq Int +possible_values : Sudoku -> Position -> List Int possible_values s p = filter (validate_entry s p) (range 1 9) @@ -63,32 +61,24 @@ entry_to_maybe v = Just m - --- TODO convert here seq to list as the member check and the recursive call would both evaluate the whole sequence - - -validate_list2 : Seq (Maybe EntryValue) -> Bool +validate_list2 : List (Maybe EntryValue) -> Bool validate_list2 l = case l of - Nil -> + [] -> True - Cons Nothing tail -> - validate_list2 <| tail () + Nothing :: tail -> + validate_list2 tail - Cons m tail -> - let - t = - tail () - in - not (member m t) && validate_list2 t + m :: tail -> + not (member m tail) && validate_list2 tail -- Creates a list of area entry lists -extract_areas : Sudoku -> Seq (Seq Entry) +extract_areas : Sudoku -> List (List Entry) extract_areas sudoku = map (\n -> extract_area sudoku ( n // 3, remainderBy 3 n )) @@ -116,7 +106,7 @@ area_coordinates ( row, column ) = List.map (add base) offsets -extract_area_from_position : Sudoku -> Position -> Seq Entry +extract_area_from_position : Sudoku -> Position -> List Entry extract_area_from_position sudoku ( row, column ) = extract_area sudoku ( row // 3, column // 3 ) @@ -125,7 +115,7 @@ extract_area_from_position sudoku ( row, column ) = -- Drops the first 3*n elements of a list and returns 3 elements of the remainder -td3 : Int -> Seq a -> Seq a +td3 : Int -> List a -> List a td3 n list = take 3 (drop (n * 3) list) @@ -134,62 +124,66 @@ td3 n list = -- Returns a list of 9 entries that form the area defined by the position -extract_area : Sudoku -> Position -> Seq Entry +extract_area : Sudoku -> Position -> List Entry extract_area s ( r, c ) = - foldr (\n -> append (td3 c n)) Nil (td3 r s) + foldr (\n -> append (td3 c n)) [] (td3 r s) -extract_rows : Sudoku -> Seq (Seq Entry) +extract_rows : Sudoku -> List (List Entry) extract_rows = identity -extract_row : Sudoku -> Position -> Seq Entry +extract_row : Sudoku -> Position -> List Entry extract_row sudoku ( row, _ ) = - Maybe.withDefault Nil <| getAt row sudoku - - - --- todo might want to implement this our selves for better efficiency + Maybe.withDefault [] <| element row sudoku -extract_columns : Sudoku -> Seq (Seq Entry) +extract_columns : Sudoku -> List (List Entry) extract_columns = - map toList >> toList >> List.Extra.transpose >> fromList >> map fromList + transpose -extract_column : Sudoku -> Position -> Seq Entry +extract_column : Sudoku -> Position -> List Entry extract_column sudoku ( _, column ) = - filterMap (getAt column) sudoku + filterMap (element column) sudoku -- Returns a list of nth elements if they exist -nth_column : Seq (Seq a) -> Int -> Seq a +nth_column : List (List a) -> Int -> List a nth_column list index = - filterMap (getAt index) list + List.filterMap (element index) list -- Returns the nth element of a list + + +element : Int -> List a -> Maybe a +element = + List.Extra.getAt + + + -- Generate Sudoku ----------------------------------------------------------------------------------------------------- update_sudoku : Sudoku -> Position -> Entry -> Sudoku update_sudoku sudoku ( row, column ) entry = - exchange_entry sudoku row (update_sudoku_row (head (drop row sudoku)) column entry) + exchange_entry sudoku row (update_sudoku_row (List.head (drop row sudoku)) column entry) update_sudoku_row : Maybe Row -> Int -> Entry -> Row update_sudoku_row row = - exchange_entry (Maybe.withDefault (limitRepeat 9 EMPTY) row) + exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) -exchange_entry : Seq a -> Int -> a -> Seq a +exchange_entry : List a -> Int -> a -> List a exchange_entry list index replacement = - setAt index replacement list + List.Extra.setAt index replacement list @@ -204,11 +198,11 @@ rnd = gen_sudoku : Generator (Maybe Sudoku) gen_sudoku = case HardCoded.sudokus of - Nil -> + [] -> Random.constant Nothing - Cons x xa -> - uniform (Just x) <| map (\s -> Just s) <| xa () + x :: xa -> + Random.uniform (Just x) <| map (\s -> Just s) xa @@ -245,14 +239,14 @@ try_insert p s int = Random.lazy (\_ -> mayUniform possibleMaybeValues) -mayUniform : Seq a -> Generator (Maybe a) +mayUniform : List a -> Generator (Maybe a) mayUniform list = case list of - Nil -> + [] -> Random.constant Nothing - Cons x xs -> - uniform (Just x) <| map (\y -> Just y) <| xs () + x :: xs -> + Random.uniform (Just x) <| map (\y -> Just y) xs next : ( Int, Int ) -> ( ( Int, Int ), Bool ) @@ -270,7 +264,7 @@ next ( x, y ) = get_entry : Sudoku -> Position -> Maybe Entry get_entry s ( row, column ) = - Maybe.andThen (getAt column) (getAt row s) + Maybe.andThen (element column) (element row s) has_entry s p = diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index 18237c4..7b78686 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -1,7 +1,6 @@ module Types exposing (Entry(..), EntryType(..), EntryValue, Model, Msg(..), Position, Row, Sudoku, all_options) import List exposing (map, range) -import Seq exposing (Seq(..)) type Entry @@ -24,11 +23,11 @@ all_options = type alias Row = - Seq Entry + List Entry type alias Sudoku = - Seq Row + List Row type alias Model = diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index c36335d..cd3939f 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,9 +1,9 @@ module Update exposing (no_emptys_sudoku, update, won_sudoku) import GenSudoku +import List exposing (all, filter) import Platform.Cmd -import Random -import Seq.Extra exposing (all) +import Random exposing (generate) import Sudoku exposing (..) import Types exposing (..) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index c0c4933..f9ac1e0 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -4,10 +4,9 @@ import Html exposing (..) import Html.Attributes exposing (selected, style) import Html.Events exposing (onClick, onInput) import List exposing (map, map2, range, repeat) -import List.Extra exposing (zip) -import Seq exposing (toList) import Types exposing (..) +import List.Extra exposing (zip) view : Model -> Html Msg view ( sudoku, msg ) = @@ -16,12 +15,12 @@ view ( sudoku, msg ) = gen_sudoku : Sudoku -> Html Msg gen_sudoku model = - table [ style "border" "1px solid black" ] <| map gen_row <| zip (range 0 8) <| toList model + table [ style "border" "1px solid black" ] <| map gen_row <| zip (range 0 8) model gen_row : ( Int, Row ) -> Html Msg gen_row ( index, row ) = - tr [] <| map gen_entry <| zip (zip (repeat 9 index) <| range 0 8) <| toList row + tr [] <| map gen_entry <| zip (zip (repeat 9 index) <| range 0 8) row gen_entry : ( Position, Entry ) -> Html Msg @@ -35,8 +34,7 @@ gen_entry ( position, entry ) = conv_to_msg : Position -> String -> Msg -conv_to_msg pos = - parse >> Msg pos +conv_to_msg pos = parse >> Msg pos gen_option : Position -> Entry -> Entry -> Html Msg -- GitLab From 9f0da77cd646f44cafbf344cb13d1908dd138c80 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 17:07:25 +0200 Subject: [PATCH 60/82] fix capitalization of Empty and use auto formating --- elm-examples/sudoku/src/GenSudoku.elm | 8 ++++---- elm-examples/sudoku/src/HardCoded.elm | 2 +- elm-examples/sudoku/src/Sudoku.elm | 6 +++--- elm-examples/sudoku/src/Types.elm | 4 ++-- elm-examples/sudoku/src/Update.elm | 2 +- elm-examples/sudoku/src/View.elm | 11 ++++++----- 6 files changed, 17 insertions(+), 16 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 38bd10f..9995391 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -99,7 +99,7 @@ to_smart sudoku = indexedMap (\columnIndex entry -> case entry of - EMPTY -> + Empty -> possible_values sudoku ( rowIndex, columnIndex ) Entry _ num -> @@ -118,7 +118,7 @@ options_to_entry seq = case seq of -- no possible entry remaining, leaving entry as this is the best we can do [] -> - EMPTY + Empty -- only one entry remaining using that [ a ] -> @@ -126,7 +126,7 @@ options_to_entry seq = -- more than one possibility leaving empty as this is not for us to decide _ :: _ -> - EMPTY + Empty solve_sudoku_smart_reimp : SmartSudoku -> Maybe SmartSudoku @@ -341,7 +341,7 @@ list_of_empty_row ( row_index, row ) = filterMap (\( column_index, entry ) -> case entry of - EMPTY -> + Empty -> Just ( row_index, column_index ) _ -> diff --git a/elm-examples/sudoku/src/HardCoded.elm b/elm-examples/sudoku/src/HardCoded.elm index 1e2e690..876be66 100644 --- a/elm-examples/sudoku/src/HardCoded.elm +++ b/elm-examples/sudoku/src/HardCoded.elm @@ -11,7 +11,7 @@ sudokus = to_entry : Maybe Int -> Entry to_entry = - Maybe.map (Entry Fixed) >> Maybe.withDefault EMPTY + Maybe.map (Entry Fixed) >> Maybe.withDefault Empty to_sudoku : List (List (Maybe Int)) -> Sudoku diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 9c3aac0..c255f84 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -9,7 +9,7 @@ import Types exposing (..) empty_sudoku : Sudoku empty_sudoku = - repeat 9 (repeat 9 EMPTY) + repeat 9 (repeat 9 Empty) validate_sudoku : Sudoku -> Bool @@ -54,7 +54,7 @@ possible_values s p = entry_to_maybe : Entry -> Maybe EntryValue entry_to_maybe v = case v of - EMPTY -> + Empty -> Nothing Entry _ m -> @@ -178,7 +178,7 @@ update_sudoku sudoku ( row, column ) entry = update_sudoku_row : Maybe Row -> Int -> Entry -> Row update_sudoku_row row = - exchange_entry (Maybe.withDefault (repeat 9 EMPTY) row) + exchange_entry (Maybe.withDefault (repeat 9 Empty) row) exchange_entry : List a -> Int -> a -> List a diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index 7b78686..98f024b 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -4,7 +4,7 @@ import List exposing (map, range) type Entry - = EMPTY + = Empty | Entry EntryType EntryValue @@ -19,7 +19,7 @@ type alias EntryValue = all_options : List Entry all_options = - EMPTY :: map (Entry User) (range 1 9) + Empty :: map (Entry User) (range 1 9) type alias Row = diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index cd3939f..feeff40 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -55,4 +55,4 @@ won_sudoku field = no_emptys_sudoku : Sudoku -> Bool no_emptys_sudoku field = - all (all <| (/=) EMPTY) field + all (all <| (/=) Empty) field diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index f9ac1e0..a017279 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -4,9 +4,9 @@ import Html exposing (..) import Html.Attributes exposing (selected, style) import Html.Events exposing (onClick, onInput) import List exposing (map, map2, range, repeat) +import List.Extra exposing (zip) import Types exposing (..) -import List.Extra exposing (zip) view : Model -> Html Msg view ( sudoku, msg ) = @@ -20,7 +20,7 @@ gen_sudoku model = gen_row : ( Int, Row ) -> Html Msg gen_row ( index, row ) = - tr [] <| map gen_entry <| zip (zip (repeat 9 index) <| range 0 8) row + tr [] <| map gen_entry <| zip (zip (repeat 9 index) <| range 0 8) row gen_entry : ( Position, Entry ) -> Html Msg @@ -34,7 +34,8 @@ gen_entry ( position, entry ) = conv_to_msg : Position -> String -> Msg -conv_to_msg pos = parse >> Msg pos +conv_to_msg pos = + parse >> Msg pos gen_option : Position -> Entry -> Entry -> Html Msg @@ -77,13 +78,13 @@ parse e = Entry User 9 _ -> - EMPTY + Empty show_entry : Entry -> String show_entry entry = case entry of - EMPTY -> + Empty -> "" Entry _ e -> -- GitLab From b63a7c22fb4a13b10860ce2a604ba931b13d1b3e Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 17:22:33 +0200 Subject: [PATCH 61/82] remove unused functions --- elm-examples/sudoku/src/Sudoku.elm | 19 +------------------ 1 file changed, 1 insertion(+), 18 deletions(-) diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index c255f84..d4763c3 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,4 +1,4 @@ -module Sudoku exposing (area_coordinates, element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_area_from_position, extract_areas, extract_column, extract_columns, extract_row, extract_rows, gen_sudoku, get_entry, has_entry, mayUniform, next, nth_column, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing (area_coordinates, element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_area_from_position, extract_areas, extract_column, extract_columns, extract_row, extract_rows, gen_sudoku, mayUniform, next, nth_column, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) import HardCoded import List exposing (..) @@ -260,20 +260,3 @@ next ( x, y ) = ( l, s ) -> ( ( l, s + 1 ), False ) - - -get_entry : Sudoku -> Position -> Maybe Entry -get_entry s ( row, column ) = - Maybe.andThen (element column) (element row s) - - -has_entry s p = - case get_entry s p of - Nothing -> - False - - Just EMPTY -> - False - - Just _ -> - True -- GitLab From d9549f128220257523d5054eae5f94310c21ab39 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 17:25:22 +0200 Subject: [PATCH 62/82] clean up remove old solve_sudoku_smart remove _reimpl suffix from new solver functions --- elm-examples/sudoku/src/GenSudoku.elm | 173 +++----------------------- 1 file changed, 16 insertions(+), 157 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 9995391..55fa35c 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,14 +1,13 @@ -module GenSudoku exposing (apply, apply_all, gen_full_sudoku, gen_start_sudoku, list_of_empty, list_of_empty_row, rmap, solve_sudoku, solve_sudoku_smart) +module GenSudoku exposing (SmartEntry, SmartRow, SmartSudoku, from_smart, gen_full_sudoku, gen_start_sudoku, get_entry_at, maybeFoldl, mmap, options_to_entry, rmap, set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, try_all_options, try_entry_at, update_entry_at, update_sorounding, update_sorounding_column, update_sorounding_entry, update_sorounding_row, update_sorounding_section) import Basics exposing ((<<), (>>), (||)) import HardCoded import List exposing (..) -import List.Extra exposing (gatherEqualsBy, remove, zip) +import List.Extra exposing (zip) import Maybe import Random exposing (Generator) import Random.List exposing (shuffle) import Seq exposing (Seq(..)) -import Seq.Extra import Sudoku exposing (possible_values) import Types exposing (..) @@ -17,23 +16,23 @@ rmap = Random.map -randThen = - Random.andThen +mmap = + Maybe.map -abortingFoldl : (b -> a -> Maybe b) -> b -> List a -> Maybe b -abortingFoldl fun init list = +maybeFoldl : (a -> b -> Maybe b) -> b -> List a -> Maybe b +maybeFoldl fun init list = case list of [] -> Just init x :: xs -> - case fun init x of + case fun x init of Nothing -> Nothing Just next -> - abortingFoldl fun next xs + maybeFoldl fun next xs @@ -74,7 +73,7 @@ gen_start_sudoku = gen_full_sudoku : Generator (Maybe Sudoku) gen_full_sudoku = -- solve remaining Sudoku - gen_start_sudoku |> rmap solve_sudoku_reimp + gen_start_sudoku |> rmap solve_sudoku @@ -82,13 +81,8 @@ gen_full_sudoku = solve_sudoku : Sudoku -> Maybe Sudoku -solve_sudoku sudoku = - solve_sudoku_smart sudoku <| list_of_empty sudoku - - -solve_sudoku_reimp : Sudoku -> Maybe Sudoku -solve_sudoku_reimp = - to_smart >> solve_sudoku_smart_reimp >> Maybe.map from_smart +solve_sudoku = + to_smart >> solve_sudoku_smart >> mmap from_smart to_smart : Sudoku -> SmartSudoku @@ -129,8 +123,8 @@ options_to_entry seq = Empty -solve_sudoku_smart_reimp : SmartSudoku -> Maybe SmartSudoku -solve_sudoku_smart_reimp sudoku = +solve_sudoku_smart : SmartSudoku -> Maybe SmartSudoku +solve_sudoku_smart sudoku = if List.any (List.any List.isEmpty) sudoku then -- a field has no entries remaining, no solution to be found Nothing @@ -188,17 +182,17 @@ update_sorounding_entry pos entry sudoku = update_sorounding_row : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku update_sorounding_row ( row, column ) entry sudoku = - List.range 0 8 |> List.Extra.remove column |> abortingFoldl (\s c -> update_sorounding_entry ( row, c ) entry s) sudoku + List.range 0 8 |> List.Extra.remove column |> maybeFoldl (\c -> update_sorounding_entry ( row, c ) entry) sudoku update_sorounding_column : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku update_sorounding_column ( row, column ) entry sudoku = - List.range 0 8 |> List.Extra.remove row |> abortingFoldl (\s r -> update_sorounding_entry ( r, column ) entry s) sudoku + List.range 0 8 |> List.Extra.remove row |> maybeFoldl (\r -> update_sorounding_entry ( r, column ) entry) sudoku update_sorounding_section : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku update_sorounding_section pos entry sudoku = - Sudoku.area_coordinates pos |> List.Extra.remove pos |> abortingFoldl (\s p -> update_sorounding_entry p entry s) sudoku + Sudoku.area_coordinates pos |> List.Extra.remove pos |> maybeFoldl (\p -> update_sorounding_entry p entry) sudoku get_entry_at : Position -> SmartSudoku -> Maybe (List EntryValue) @@ -211,141 +205,6 @@ set_entry_at entry = update_entry_at (always entry) -set_entry_at_seq : a -> Position -> Seq (Seq a) -> Seq (Seq a) -set_entry_at_seq entry = - update_entry_at_seq (always entry) - - update_entry_at : (a -> a) -> Position -> List (List a) -> List (List a) update_entry_at updater ( row, column ) = List.Extra.updateAt row (List.Extra.updateAt column updater) - - -update_entry_at_seq : (a -> a) -> Position -> Seq (Seq a) -> Seq (Seq a) -update_entry_at_seq updater ( row, column ) = - Seq.Extra.updateAt row (Seq.Extra.updateAt column updater) - - - --- Tries to solve the given Sudoku at all provided Positions - - -solve_sudoku_smart : Sudoku -> List Position -> Maybe Sudoku -solve_sudoku_smart sudoku empty_pos = - let - -- list of (position, not obvious invalid entries for position) - possible = - -- turn pos into tuple of identical entries - map (\a -> ( a, a )) empty_pos - -- map second entry to possible values at that position - |> map (Tuple.mapSecond <| possible_values sudoku) - -- sort by the amount of possible entries - |> sortBy (List.length << Tuple.second) - in - if any (List.isEmpty << Tuple.second) possible then - -- one field with no possible inputs exists - Nothing - - else - case gatherEqualsBy (List.length << Tuple.second) possible of - [] -> - Nothing - - ( ( _, [ _ ] ) as x, xs ) :: _ -> - let - -- single possible value - -- all pairs in x::xs should have only one possible entry therefor we apply all at once - pairs = - (x :: xs) - |> filterMap - (\( pos, entries ) -> - case entries of - [ p ] -> - Just ( pos, p ) - - _ -> - -- should never happen - Nothing - ) - in - apply_all empty_pos pairs sudoku - - ( x, _ ) :: _ -> - let - -- x,xs (head,tail) of list of fields with least options - -- at this points we have more than one possibility to try for each field - some_solutions = - -- try all possibilities for the first position - x - |> Tuple.mapSecond Seq.fromList - |> Tuple.mapSecond (Seq.map (Entry Fixed)) - -- all combinations applied and the fields position we just fill - |> (\( pos, opt ) -> Seq.map (Tuple.pair pos << Sudoku.update_sudoku sudoku pos) opt) - -- all combinations applied and the fields position we still need to fill - |> Seq.map (Tuple.mapFirst (\a -> remove a empty_pos)) - -- apply solve_sudoku_smart to each combination filtering Nothings - |> Seq.filterMap apply - in - -- return Just the first solution or Nothing should none exist - Seq.head some_solutions - - -apply_all : List Position -> List ( Position, Int ) -> Sudoku -> Maybe Sudoku -apply_all empty_pos pairs sudoku = - let - -- sudoku with all position entry pairs applied - res_sudoku = - foldr (\( pos, entry ) s -> Sudoku.update_sudoku s pos <| Entry Fixed <| entry) sudoku pairs - - -- positions unapplied - remaining = - empty_pos - in - -- if the Sudoku is invalid this sudoku does not have any solutions therefor return Noting to caller - if not <| Sudoku.validate_sudoku res_sudoku then - Nothing - - else if isEmpty remaining then - -- valid sudoku and no fields remaining to be filled, we are done - Just res_sudoku - - else - -- valid sudoku and fields remaining to be filled, recurse - solve_sudoku_smart res_sudoku remaining - - - --- applies the position list and sudoku from the tuple to solve_sudoku_smart - - -apply : ( List Position, Sudoku ) -> Maybe Sudoku -apply ( l, s ) = - solve_sudoku_smart s l - - - --- return all positions containing an EMPTY value - - -list_of_empty : Sudoku -> List Position -list_of_empty sudoku = - concatMap list_of_empty_row <| indexedMap Tuple.pair sudoku - - - --- list_of_empty_row returns the Positions of the EMPTY entries in the Row - - -list_of_empty_row : ( Int, Row ) -> List Position -list_of_empty_row ( row_index, row ) = - filterMap - (\( column_index, entry ) -> - case entry of - Empty -> - Just ( row_index, column_index ) - - _ -> - Nothing - ) - <| - indexedMap Tuple.pair row -- GitLab From f48612eb9d668ca8b12c2cb441f269fb469d0578 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 17:40:50 +0200 Subject: [PATCH 63/82] fix spelling switch parameter order to of the update_surrounding functions to be nicer move maybeFoldl to List.Maybe module --- elm-examples/sudoku/src/GenSudoku.elm | 60 ++++++++++---------------- elm-examples/sudoku/src/List/Maybe.elm | 18 ++++++++ 2 files changed, 41 insertions(+), 37 deletions(-) create mode 100644 elm-examples/sudoku/src/List/Maybe.elm diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 55fa35c..59470e2 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,9 +1,10 @@ -module GenSudoku exposing (SmartEntry, SmartRow, SmartSudoku, from_smart, gen_full_sudoku, gen_start_sudoku, get_entry_at, maybeFoldl, mmap, options_to_entry, rmap, set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, try_all_options, try_entry_at, update_entry_at, update_sorounding, update_sorounding_column, update_sorounding_entry, update_sorounding_row, update_sorounding_section) +module GenSudoku exposing (SmartEntry, SmartRow, SmartSudoku, from_smart, gen_full_sudoku, gen_start_sudoku, get_entry_at, mmap, options_to_entry, rmap, set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, try_all_options, try_entry_at, update_entry_at, update_sorounding, update_surrounding_column, update_surrounding_entry, update_surrounding_row, update_surrounding_section) import Basics exposing ((<<), (>>), (||)) import HardCoded import List exposing (..) import List.Extra exposing (zip) +import List.Maybe exposing (maybeFoldl) import Maybe import Random exposing (Generator) import Random.List exposing (shuffle) @@ -20,21 +21,6 @@ mmap = Maybe.map -maybeFoldl : (a -> b -> Maybe b) -> b -> List a -> Maybe b -maybeFoldl fun init list = - case list of - [] -> - Just init - - x :: xs -> - case fun x init of - Nothing -> - Nothing - - Just next -> - maybeFoldl fun next xs - - -- as the SmartSudoku is traversed multiple times for each recursion step I did not choose Seq here as this would evaluate the content of the Sequence multiple times @@ -134,13 +120,13 @@ solve_sudoku_smart sudoku = Just sudoku else - -- find a possition with least options, but more than one remaining and try them - List.concatMap (\row -> List.map (\collumn -> Tuple.pair row collumn) <| List.range 0 8) (List.range 0 8) + -- find a position with least options, but more than one remaining and try them + List.concatMap (\row -> List.map (\column -> Tuple.pair row column) <| List.range 0 8) (List.range 0 8) -- filter positions with 1 (or less entries) |> List.filter (\pos -> get_entry_at pos sudoku |> Maybe.withDefault [] |> List.length >> (>) 1) -- the default should never be needed |> List.sortBy (\pos -> get_entry_at pos sudoku |> Maybe.map List.length |> Maybe.withDefault 9) - -- get a possition with least options + -- get a position with least options |> List.head -- try all options lazy |> Maybe.map (try_all_options sudoku) @@ -155,20 +141,20 @@ try_all_options sudoku position = try_entry_at : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -try_entry_at (( row, column ) as pos) entry sudoku = +try_entry_at pos entry sudoku = set_entry_at [ entry ] pos sudoku - |> update_sorounding pos entry + |> update_sorounding entry pos -update_sorounding : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -update_sorounding pos entry = - update_sorounding_row pos entry - >> Maybe.andThen (update_sorounding_column pos entry) - >> Maybe.andThen (update_sorounding_section pos entry) +update_sorounding : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_sorounding entry pos = + update_surrounding_row entry pos + >> Maybe.andThen (update_surrounding_column entry pos) + >> Maybe.andThen (update_surrounding_section entry pos) -update_sorounding_entry : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -update_sorounding_entry pos entry sudoku = +update_surrounding_entry : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_surrounding_entry entry pos sudoku = case List.Extra.remove entry <| Maybe.withDefault [] <| get_entry_at pos sudoku of [] -> Nothing @@ -180,19 +166,19 @@ update_sorounding_entry pos entry sudoku = Just <| set_entry_at list pos sudoku -update_sorounding_row : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -update_sorounding_row ( row, column ) entry sudoku = - List.range 0 8 |> List.Extra.remove column |> maybeFoldl (\c -> update_sorounding_entry ( row, c ) entry) sudoku +update_surrounding_row : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_surrounding_row entry ( row, column ) sudoku = + List.range 0 8 |> List.Extra.remove column |> maybeFoldl (update_surrounding_entry entry << Tuple.pair row) sudoku -update_sorounding_column : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -update_sorounding_column ( row, column ) entry sudoku = - List.range 0 8 |> List.Extra.remove row |> maybeFoldl (\r -> update_sorounding_entry ( r, column ) entry) sudoku +update_surrounding_column : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_surrounding_column entry ( row, column ) sudoku = + List.range 0 8 |> List.Extra.remove row |> maybeFoldl (update_surrounding_entry entry << (\r -> ( r, column ))) sudoku -update_sorounding_section : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -update_sorounding_section pos entry sudoku = - Sudoku.area_coordinates pos |> List.Extra.remove pos |> maybeFoldl (\p -> update_sorounding_entry p entry) sudoku +update_surrounding_section : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_surrounding_section entry pos sudoku = + Sudoku.area_coordinates pos |> List.Extra.remove pos |> maybeFoldl (update_surrounding_entry entry) sudoku get_entry_at : Position -> SmartSudoku -> Maybe (List EntryValue) diff --git a/elm-examples/sudoku/src/List/Maybe.elm b/elm-examples/sudoku/src/List/Maybe.elm new file mode 100644 index 0000000..de67a1c --- /dev/null +++ b/elm-examples/sudoku/src/List/Maybe.elm @@ -0,0 +1,18 @@ +module List.Maybe exposing (maybeFoldl) + +import Maybe exposing (..) + + +maybeFoldl : (a -> b -> Maybe b) -> b -> List a -> Maybe b +maybeFoldl fun init list = + case list of + [] -> + Just init + + x :: xs -> + case fun x init of + Nothing -> + Nothing + + Just next -> + maybeFoldl fun next xs -- GitLab From d70586b1e7092db18ffd1d6d5da10aea0f8e9a90 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 17:49:19 +0200 Subject: [PATCH 64/82] use a less confusing name --- elm-examples/sudoku/src/GenSudoku.elm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 59470e2..f88f678 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -162,8 +162,8 @@ update_surrounding_entry entry pos sudoku = [ x ] -> try_entry_at pos x sudoku - list -> - Just <| set_entry_at list pos sudoku + value -> + Just <| set_entry_at value pos sudoku update_surrounding_row : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku -- GitLab From 0a5bd29394a710e2fabbc8ba69e9e5de62a3d35e Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 18:02:54 +0200 Subject: [PATCH 65/82] clean up some more --- elm-examples/sudoku/src/GenSudoku.elm | 45 ++++++++++++++------------- 1 file changed, 23 insertions(+), 22 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index f88f678..c0bb5b8 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,15 +1,16 @@ module GenSudoku exposing (SmartEntry, SmartRow, SmartSudoku, from_smart, gen_full_sudoku, gen_start_sudoku, get_entry_at, mmap, options_to_entry, rmap, set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, try_all_options, try_entry_at, update_entry_at, update_sorounding, update_surrounding_column, update_surrounding_entry, update_surrounding_row, update_surrounding_section) import Basics exposing ((<<), (>>), (||)) -import HardCoded +import HardCoded exposing (to_entry) import List exposing (..) -import List.Extra exposing (zip) +import List.Extra exposing (getAt, remove, updateAt, zip) import List.Maybe exposing (maybeFoldl) -import Maybe +import Maybe exposing (andThen, withDefault) import Random exposing (Generator) import Random.List exposing (shuffle) -import Seq exposing (Seq(..)) +import Seq exposing (Seq(..), fromList, toList) import Sudoku exposing (possible_values) +import Tuple exposing (pair) import Types exposing (..) @@ -49,7 +50,7 @@ gen_start_sudoku = |> shuffle |> rmap (zip (Sudoku.area_coordinates ( 0, 0 ))) -- insert Row into Empty Sudoku - |> rmap (\list -> foldr (\( pos, value ) -> set_entry_at (HardCoded.to_entry value) pos) Sudoku.empty_sudoku list) + |> rmap (\list -> foldr (\( pos, value ) -> set_entry_at (to_entry value) pos) Sudoku.empty_sudoku list) @@ -111,33 +112,33 @@ options_to_entry seq = solve_sudoku_smart : SmartSudoku -> Maybe SmartSudoku solve_sudoku_smart sudoku = - if List.any (List.any List.isEmpty) sudoku then + if any (any isEmpty) sudoku then -- a field has no entries remaining, no solution to be found Nothing - else if List.all (List.all (List.length >> (==) 1)) sudoku then + else if all (all (length >> (==) 1)) sudoku then -- all fields have one entry remaining we are done Just sudoku else -- find a position with least options, but more than one remaining and try them - List.concatMap (\row -> List.map (\column -> Tuple.pair row column) <| List.range 0 8) (List.range 0 8) + concatMap (\row -> map (\column -> pair row column) <| range 0 8) (range 0 8) -- filter positions with 1 (or less entries) - |> List.filter (\pos -> get_entry_at pos sudoku |> Maybe.withDefault [] |> List.length >> (>) 1) + |> filter (\pos -> get_entry_at pos sudoku |> withDefault [] |> length >> (>) 1) -- the default should never be needed - |> List.sortBy (\pos -> get_entry_at pos sudoku |> Maybe.map List.length |> Maybe.withDefault 9) + |> sortBy (\pos -> get_entry_at pos sudoku |> mmap length |> withDefault 9) -- get a position with least options - |> List.head + |> head -- try all options lazy - |> Maybe.map (try_all_options sudoku) - |> Maybe.withDefault Nil + |> mmap (try_all_options sudoku) + |> withDefault Nil -- take first if exist else Nothing |> Seq.head try_all_options : SmartSudoku -> Position -> Seq SmartSudoku try_all_options sudoku position = - get_entry_at position sudoku |> Maybe.map Seq.fromList |> Maybe.withDefault Nil |> Seq.filterMap (\entry -> try_entry_at position entry sudoku) + get_entry_at position sudoku |> mmap fromList |> withDefault Nil |> Seq.filterMap (\entry -> try_entry_at position entry sudoku) try_entry_at : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku @@ -149,13 +150,13 @@ try_entry_at pos entry sudoku = update_sorounding : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_sorounding entry pos = update_surrounding_row entry pos - >> Maybe.andThen (update_surrounding_column entry pos) - >> Maybe.andThen (update_surrounding_section entry pos) + >> andThen (update_surrounding_column entry pos) + >> andThen (update_surrounding_section entry pos) update_surrounding_entry : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_entry entry pos sudoku = - case List.Extra.remove entry <| Maybe.withDefault [] <| get_entry_at pos sudoku of + case remove entry <| withDefault [] <| get_entry_at pos sudoku of [] -> Nothing @@ -168,22 +169,22 @@ update_surrounding_entry entry pos sudoku = update_surrounding_row : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_row entry ( row, column ) sudoku = - List.range 0 8 |> List.Extra.remove column |> maybeFoldl (update_surrounding_entry entry << Tuple.pair row) sudoku + range 0 8 |> remove column |> maybeFoldl (update_surrounding_entry entry << pair row) sudoku update_surrounding_column : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_column entry ( row, column ) sudoku = - List.range 0 8 |> List.Extra.remove row |> maybeFoldl (update_surrounding_entry entry << (\r -> ( r, column ))) sudoku + range 0 8 |> remove row |> maybeFoldl (update_surrounding_entry entry << (\r -> ( r, column ))) sudoku update_surrounding_section : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_section entry pos sudoku = - Sudoku.area_coordinates pos |> List.Extra.remove pos |> maybeFoldl (update_surrounding_entry entry) sudoku + Sudoku.area_coordinates pos |> remove pos |> maybeFoldl (update_surrounding_entry entry) sudoku get_entry_at : Position -> SmartSudoku -> Maybe (List EntryValue) get_entry_at ( row, column ) = - List.Extra.getAt row >> Maybe.andThen (List.Extra.getAt column) + getAt row >> andThen (getAt column) set_entry_at : a -> Position -> List (List a) -> List (List a) @@ -193,4 +194,4 @@ set_entry_at entry = update_entry_at : (a -> a) -> Position -> List (List a) -> List (List a) update_entry_at updater ( row, column ) = - List.Extra.updateAt row (List.Extra.updateAt column updater) + updateAt row <| updateAt column updater -- GitLab From 662cb60278ee05f1e560f8e38cbd32616f916db5 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 18:13:38 +0200 Subject: [PATCH 66/82] fix infinite recursion error and incorrect comparison error (< vs. >) --- elm-examples/sudoku/src/GenSudoku.elm | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index c0bb5b8..07be283 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -122,9 +122,10 @@ solve_sudoku_smart sudoku = else -- find a position with least options, but more than one remaining and try them + -- generate a list containing all position (0,0) to (8,8) concatMap (\row -> map (\column -> pair row column) <| range 0 8) (range 0 8) -- filter positions with 1 (or less entries) - |> filter (\pos -> get_entry_at pos sudoku |> withDefault [] |> length >> (>) 1) + |> filter (\pos -> get_entry_at pos sudoku |> mmap length |> withDefault 0 |> (<) 1) -- the default should never be needed |> sortBy (\pos -> get_entry_at pos sudoku |> mmap length |> withDefault 9) -- get a position with least options @@ -156,14 +157,25 @@ update_sorounding entry pos = update_surrounding_entry : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_entry entry pos sudoku = - case remove entry <| withDefault [] <| get_entry_at pos sudoku of + let + old = + get_entry_at pos sudoku |> withDefault [] + in + case remove entry old of [] -> Nothing [ x ] -> - try_entry_at pos x sudoku + if [ x ] /= old then + -- we reduced the list to one entry we need to recurse + try_entry_at pos x sudoku + + else + -- nothing changed + Just sudoku value -> + -- we still have choices to make here in the future Just <| set_entry_at value pos sudoku -- GitLab From e5cd4dbfe20babb2be5aac36620313d1a9250516 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 18:15:50 +0200 Subject: [PATCH 67/82] fix recursion of depth one only --- elm-examples/sudoku/src/GenSudoku.elm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 07be283..6fab175 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -139,7 +139,7 @@ solve_sudoku_smart sudoku = try_all_options : SmartSudoku -> Position -> Seq SmartSudoku try_all_options sudoku position = - get_entry_at position sudoku |> mmap fromList |> withDefault Nil |> Seq.filterMap (\entry -> try_entry_at position entry sudoku) + get_entry_at position sudoku |> mmap fromList |> withDefault Nil |> Seq.filterMap (\entry -> try_entry_at position entry sudoku |> andThen solve_sudoku_smart) try_entry_at : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku -- GitLab From 1576471a3c274a53c632db22784e3108ae6fe5f6 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 19:34:20 +0200 Subject: [PATCH 68/82] add shuffle to try_all_options, this way we can generate all sudokus --- elm-examples/sudoku/src/GenSudoku.elm | 99 ++++++++++++++++++++------- 1 file changed, 73 insertions(+), 26 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 6fab175..a43e835 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -6,7 +6,8 @@ import List exposing (..) import List.Extra exposing (getAt, remove, updateAt, zip) import List.Maybe exposing (maybeFoldl) import Maybe exposing (andThen, withDefault) -import Random exposing (Generator) +import Maybe.Extra exposing (unwrap) +import Random exposing (Generator, constant) import Random.List exposing (shuffle) import Seq exposing (Seq(..), fromList, toList) import Sudoku exposing (possible_values) @@ -14,10 +15,17 @@ import Tuple exposing (pair) import Types exposing (..) +rmap : (a -> b) -> Generator a -> Generator b rmap = Random.map +randThen : (a -> Generator b) -> Generator a -> Generator b +randThen = + Random.andThen + + +mmap : (a -> b) -> Maybe a -> Maybe b mmap = Maybe.map @@ -60,16 +68,16 @@ gen_start_sudoku = gen_full_sudoku : Generator (Maybe Sudoku) gen_full_sudoku = -- solve remaining Sudoku - gen_start_sudoku |> rmap solve_sudoku + Random.andThen solve_sudoku gen_start_sudoku -- solve sudoku in all empty fields -solve_sudoku : Sudoku -> Maybe Sudoku +solve_sudoku : Sudoku -> Generator (Maybe Sudoku) solve_sudoku = - to_smart >> solve_sudoku_smart >> mmap from_smart + to_smart >> solve_sudoku_smart >> rmap (mmap from_smart) to_smart : Sudoku -> SmartSudoku @@ -110,15 +118,15 @@ options_to_entry seq = Empty -solve_sudoku_smart : SmartSudoku -> Maybe SmartSudoku +solve_sudoku_smart : SmartSudoku -> Generator (Maybe SmartSudoku) solve_sudoku_smart sudoku = if any (any isEmpty) sudoku then -- a field has no entries remaining, no solution to be found - Nothing + constant Nothing else if all (all (length >> (==) 1)) sudoku then -- all fields have one entry remaining we are done - Just sudoku + constant <| Just sudoku else -- find a position with least options, but more than one remaining and try them @@ -132,30 +140,50 @@ solve_sudoku_smart sudoku = |> head -- try all options lazy |> mmap (try_all_options sudoku) - |> withDefault Nil - -- take first if exist else Nothing - |> Seq.head + |> withDefault (constant Nothing) -try_all_options : SmartSudoku -> Position -> Seq SmartSudoku +try_all_options : SmartSudoku -> Position -> Generator (Maybe SmartSudoku) try_all_options sudoku position = - get_entry_at position sudoku |> mmap fromList |> withDefault Nil |> Seq.filterMap (\entry -> try_entry_at position entry sudoku |> andThen solve_sudoku_smart) + get_entry_at position sudoku + |> mmap shuffle + |> withDefault (constant []) + |> randThen (\list -> to_be_named list (\entry -> try_entry_at position entry sudoku |> randThen (unwrap (constant Nothing) solve_sudoku_smart))) + + +to_be_named : List EntryValue -> (EntryValue -> Generator (Maybe SmartSudoku)) -> Generator (Maybe SmartSudoku) +to_be_named list fun = + case list of + [] -> + constant Nothing + + x :: xs -> + fun x + |> randThen + (\result -> + case result of + Just _ -> + constant result + + Nothing -> + to_be_named xs fun + ) -try_entry_at : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku +try_entry_at : Position -> EntryValue -> SmartSudoku -> Generator (Maybe SmartSudoku) try_entry_at pos entry sudoku = set_entry_at [ entry ] pos sudoku |> update_sorounding entry pos -update_sorounding : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_sorounding : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_sorounding entry pos = update_surrounding_row entry pos - >> andThen (update_surrounding_column entry pos) - >> andThen (update_surrounding_section entry pos) + >> Random.andThen (unwrap (constant Nothing) <| update_surrounding_column entry pos) + >> Random.andThen (unwrap (constant Nothing) <| update_surrounding_section entry pos) -update_surrounding_entry : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_surrounding_entry : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_surrounding_entry entry pos sudoku = let old = @@ -163,7 +191,7 @@ update_surrounding_entry entry pos sudoku = in case remove entry old of [] -> - Nothing + constant Nothing [ x ] -> if [ x ] /= old then @@ -172,26 +200,45 @@ update_surrounding_entry entry pos sudoku = else -- nothing changed - Just sudoku + constant <| Just sudoku value -> -- we still have choices to make here in the future - Just <| set_entry_at value pos sudoku + constant <| Just <| set_entry_at value pos sudoku + + +maybeGeneratorFoldl : (a -> b -> Generator (Maybe b)) -> b -> List a -> Generator (Maybe b) +maybeGeneratorFoldl fun init list = + case list of + [] -> + constant <| Just init + + x :: xs -> + fun x init + |> Random.andThen + (\may -> + case may of + Nothing -> + constant Nothing + + Just next -> + maybeGeneratorFoldl fun next xs + ) -update_surrounding_row : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_surrounding_row : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_surrounding_row entry ( row, column ) sudoku = - range 0 8 |> remove column |> maybeFoldl (update_surrounding_entry entry << pair row) sudoku + range 0 8 |> remove column |> maybeGeneratorFoldl (update_surrounding_entry entry << pair row) sudoku -update_surrounding_column : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_surrounding_column : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_surrounding_column entry ( row, column ) sudoku = - range 0 8 |> remove row |> maybeFoldl (update_surrounding_entry entry << (\r -> ( r, column ))) sudoku + range 0 8 |> remove row |> maybeGeneratorFoldl (update_surrounding_entry entry << (\r -> ( r, column ))) sudoku -update_surrounding_section : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku +update_surrounding_section : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_surrounding_section entry pos sudoku = - Sudoku.area_coordinates pos |> remove pos |> maybeFoldl (update_surrounding_entry entry) sudoku + Sudoku.area_coordinates pos |> remove pos |> maybeGeneratorFoldl (update_surrounding_entry entry) sudoku get_entry_at : Position -> SmartSudoku -> Maybe (List EntryValue) -- GitLab From 3d7a9163ad744f6f73eeb2e0347996a224127cb0 Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 19:41:32 +0200 Subject: [PATCH 69/82] add Solve Sudoku button --- elm-examples/sudoku/src/Types.elm | 1 + elm-examples/sudoku/src/Update.elm | 5 ++++- elm-examples/sudoku/src/View.elm | 2 +- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index 98f024b..fb569ec 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -42,3 +42,4 @@ type Msg = Msg Position Entry | Random (Maybe Sudoku) | Generate + | Solve diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index feeff40..6e58630 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -33,8 +33,11 @@ update msg (( sudoku, text ) as model) = Generate -> ( model, Random.generate Random GenSudoku.gen_full_sudoku ) + Solve -> + ( model, Random.generate Random <| GenSudoku.solve_sudoku sudoku ) + Random Nothing -> - ( ( sudoku, "Failed to Generate Sudoku" ), Cmd.none ) + ( ( sudoku, "Failed to Generate/Solve Sudoku" ), Cmd.none ) Random (Just s) -> ( ( s, "Sudoku Generated" ), Cmd.none ) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index a017279..8fc71be 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -10,7 +10,7 @@ import Types exposing (..) view : Model -> Html Msg view ( sudoku, msg ) = - div [] [ gen_sudoku sudoku, button [ onClick Generate ] [ text "Generate" ], br [] [], text msg ] + div [] [ gen_sudoku sudoku, button [ onClick Generate ] [ text "Generate New Sudoku" ], button [ onClick Solve ] [ text "Solve Sudoku" ], br [] [], text msg ] gen_sudoku : Sudoku -> Html Msg -- GitLab From 0bda049589748767e45d1758b422c4a97e46d98e Mon Sep 17 00:00:00 2001 From: BB20101997 Date: Fri, 19 Apr 2019 20:03:57 +0200 Subject: [PATCH 70/82] add comments clean up imports --- elm-examples/sudoku/src/GenSudoku.elm | 73 +++++++++++++++++++++++++-- elm-examples/sudoku/src/Update.elm | 8 +-- 2 files changed, 72 insertions(+), 9 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index a43e835..0568b62 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -4,17 +4,19 @@ import Basics exposing ((<<), (>>), (||)) import HardCoded exposing (to_entry) import List exposing (..) import List.Extra exposing (getAt, remove, updateAt, zip) -import List.Maybe exposing (maybeFoldl) import Maybe exposing (andThen, withDefault) import Maybe.Extra exposing (unwrap) import Random exposing (Generator, constant) import Random.List exposing (shuffle) -import Seq exposing (Seq(..), fromList, toList) import Sudoku exposing (possible_values) import Tuple exposing (pair) import Types exposing (..) + +-- aliassing of different functions whos names are already in use + + rmap : (a -> b) -> Generator a -> Generator b rmap = Random.map @@ -31,7 +33,7 @@ mmap = --- as the SmartSudoku is traversed multiple times for each recursion step I did not choose Seq here as this would evaluate the content of the Sequence multiple times +-- SmartSudoku is used in Solving a Sudoku type alias SmartSudoku = @@ -47,7 +49,7 @@ type alias SmartEntry = --- generates a partially filled sudoku to start solving +-- generates a sudoku that is only filled in the top left section gen_start_sudoku : Generator Sudoku @@ -80,6 +82,10 @@ solve_sudoku = to_smart >> solve_sudoku_smart >> rmap (mmap from_smart) + +-- converts a Sudoku to a SmartSudoku + + to_smart : Sudoku -> SmartSudoku to_smart sudoku = sudoku @@ -97,11 +103,19 @@ to_smart sudoku = ) + +-- converts a SmartSudoku to a Sudoku + + from_smart : SmartSudoku -> Sudoku from_smart = map (map options_to_entry) + +-- converts a List of Ints to an Entry + + options_to_entry : List Int -> Entry options_to_entry seq = case seq of @@ -118,6 +132,10 @@ options_to_entry seq = Empty + +-- tries to solve a SmartSudoku + + solve_sudoku_smart : SmartSudoku -> Generator (Maybe SmartSudoku) solve_sudoku_smart sudoku = if any (any isEmpty) sudoku then @@ -143,6 +161,10 @@ solve_sudoku_smart sudoku = |> withDefault (constant Nothing) + +-- tries all options still possible at the position in a random order + + try_all_options : SmartSudoku -> Position -> Generator (Maybe SmartSudoku) try_all_options sudoku position = get_entry_at position sudoku @@ -170,12 +192,20 @@ to_be_named list fun = ) + +-- tries to solve the sudoku with entry at pos + + try_entry_at : Position -> EntryValue -> SmartSudoku -> Generator (Maybe SmartSudoku) try_entry_at pos entry sudoku = set_entry_at [ entry ] pos sudoku |> update_sorounding entry pos + +-- updates the surrounding of pos after inserting entry, this might cascade + + update_sorounding : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_sorounding entry pos = update_surrounding_row entry pos @@ -183,6 +213,10 @@ update_sorounding entry pos = >> Random.andThen (unwrap (constant Nothing) <| update_surrounding_section entry pos) + +-- updates the pos after inserting entry in a surrounding field , this might cascade + + update_surrounding_entry : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_surrounding_entry entry pos sudoku = let @@ -207,6 +241,11 @@ update_surrounding_entry entry pos sudoku = constant <| Just <| set_entry_at value pos sudoku + +-- a version of foldl that stops at the first nothing +-- similar to our List.Maybe.maybeFold but adopted to work with a maybe thats inside a Generator + + maybeGeneratorFoldl : (a -> b -> Generator (Maybe b)) -> b -> List a -> Generator (Maybe b) maybeGeneratorFoldl fun init list = case list of @@ -226,31 +265,55 @@ maybeGeneratorFoldl fun init list = ) + +-- updates the surrounding row of pos after inserting entry, this might cascade + + update_surrounding_row : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_surrounding_row entry ( row, column ) sudoku = range 0 8 |> remove column |> maybeGeneratorFoldl (update_surrounding_entry entry << pair row) sudoku + +-- updates the surrounding column of pos after inserting entry, this might cascade + + update_surrounding_column : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_surrounding_column entry ( row, column ) sudoku = range 0 8 |> remove row |> maybeGeneratorFoldl (update_surrounding_entry entry << (\r -> ( r, column ))) sudoku + +-- updates the surrounding section of pos after inserting entry, this might cascade + + update_surrounding_section : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) update_surrounding_section entry pos sudoku = Sudoku.area_coordinates pos |> remove pos |> maybeGeneratorFoldl (update_surrounding_entry entry) sudoku -get_entry_at : Position -> SmartSudoku -> Maybe (List EntryValue) + +-- gets the value at (row, column) in the 2d list if it exists + + +get_entry_at : Position -> List (List a) -> Maybe a get_entry_at ( row, column ) = getAt row >> andThen (getAt column) + +-- sets the entry at (row, column) in the 2d list should that position exits + + set_entry_at : a -> Position -> List (List a) -> List (List a) set_entry_at entry = update_entry_at (always entry) + +-- updates the entry at (row, column) in the 2d list should that position exits, by passing the old value to the function to get the new value + + update_entry_at : (a -> a) -> Position -> List (List a) -> List (List a) update_entry_at updater ( row, column ) = updateAt row <| updateAt column updater diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 6e58630..2a1484e 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,7 +1,7 @@ module Update exposing (no_emptys_sudoku, update, won_sudoku) -import GenSudoku -import List exposing (all, filter) +import GenSudoku exposing (gen_full_sudoku, solve_sudoku) +import List exposing (all) import Platform.Cmd import Random exposing (generate) import Sudoku exposing (..) @@ -31,10 +31,10 @@ update msg (( sudoku, text ) as model) = ( ( sudoku2, resp ), Cmd.none ) Generate -> - ( model, Random.generate Random GenSudoku.gen_full_sudoku ) + ( model, generate Random gen_full_sudoku ) Solve -> - ( model, Random.generate Random <| GenSudoku.solve_sudoku sudoku ) + ( model, generate Random <| solve_sudoku sudoku ) Random Nothing -> ( ( sudoku, "Failed to Generate/Solve Sudoku" ), Cmd.none ) -- GitLab From c39e2ed07d88849a6dfa09c7e7c1a47c25ba1a30 Mon Sep 17 00:00:00 2001 From: stu201758 Date: Sat, 20 Apr 2019 14:07:59 +0200 Subject: [PATCH 71/82] add CSS to make the Table look better --- elm-examples/sudoku/src/View.elm | 35 ++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index 8fc71be..d94dc25 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -10,12 +10,43 @@ import Types exposing (..) view : Model -> Html Msg view ( sudoku, msg ) = - div [] [ gen_sudoku sudoku, button [ onClick Generate ] [ text "Generate New Sudoku" ], button [ onClick Solve ] [ text "Solve Sudoku" ], br [] [], text msg ] + div [] [ node "style" [] [ css_style ], gen_sudoku sudoku, button [ onClick Generate ] [ text "Generate New Sudoku" ], button [ onClick Solve ] [ text "Solve Sudoku" ], br [] [], text msg ] + + +css_style = + text """ + table { + border: 3px double black; + border-collapse: collapse; + } + + td { + width: 25px; + height: 25px; + border: 1px solid black; + } + + td:nth-child(3n):not(:last-child) { + border-style: solid double solid solid; + border-width: 1px 3px 1px 1px; + } + + tr:nth-child(3n):not(:last-child) > td { + border-style: solid solid double solid; + border-width: 1px 1px 3px 1px; + } + + tr:nth-child(3n):not(:last-child) > td:nth-child(3n):not(:last-child) { + border-style: solid double double solid; + border-width: 1px 3px 3px 1px; + } + + """ gen_sudoku : Sudoku -> Html Msg gen_sudoku model = - table [ style "border" "1px solid black" ] <| map gen_row <| zip (range 0 8) model + table [] <| map gen_row <| zip (range 0 8) model gen_row : ( Int, Row ) -> Html Msg -- GitLab From 209453b4b4213f3dcaf508f51c91dbc267cffba5 Mon Sep 17 00:00:00 2001 From: stu201758 Date: Sat, 20 Apr 2019 14:13:34 +0200 Subject: [PATCH 72/82] make fixed entries be centered make user select not cause the table to be bigger --- elm-examples/sudoku/src/View.elm | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index d94dc25..efac9d6 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -20,10 +20,15 @@ css_style = border-collapse: collapse; } + select { + width: 100%; + } + td { - width: 25px; - height: 25px; + width: 30px; + height: 30px; border: 1px solid black; + text-align: center; } td:nth-child(3n):not(:last-child) { -- GitLab From 0ce2e2066982484726a8d82ffbc90a6b1bce93a3 Mon Sep 17 00:00:00 2001 From: stu201758 Date: Sat, 20 Apr 2019 17:15:14 +0200 Subject: [PATCH 73/82] don't present the Usere a fully filled Sudoku after clicking "Generate Sudoku" --- elm-examples/sudoku/src/GenSudoku.elm | 31 ++++++++++++++++++++++++++- elm-examples/sudoku/src/Update.elm | 4 ++-- 2 files changed, 32 insertions(+), 3 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 0568b62..eaa47cb 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,4 +1,4 @@ -module GenSudoku exposing (SmartEntry, SmartRow, SmartSudoku, from_smart, gen_full_sudoku, gen_start_sudoku, get_entry_at, mmap, options_to_entry, rmap, set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, try_all_options, try_entry_at, update_entry_at, update_sorounding, update_surrounding_column, update_surrounding_entry, update_surrounding_row, update_surrounding_section) +module GenSudoku exposing (SmartEntry, SmartRow, SmartSudoku, from_smart, gen_full_sudoku, gen_partially_filled, gen_start_sudoku, get_entry_at, mmap, options_to_entry, rmap, set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, try_all_options, try_entry_at, update_entry_at, update_sorounding, update_surrounding_column, update_surrounding_entry, update_surrounding_row, update_surrounding_section) import Basics exposing ((<<), (>>), (||)) import HardCoded exposing (to_entry) @@ -48,6 +48,35 @@ type alias SmartEntry = List EntryValue +list_of_all_postions : List Position +list_of_all_postions = + concatMap (\row -> map (pair row) <| range 0 8) <| range 0 8 + + +gen_partially_filled : Generator (Maybe Sudoku) +gen_partially_filled = + randThen (\sudoku -> rmap (pair sudoku) <| shuffle list_of_all_postions) gen_full_sudoku |> rmap (\( sudoku, posList ) -> mmap (\s -> erase_where_obviouse s posList) sudoku) + + +erase_where_obviouse : Sudoku -> List Position -> Sudoku +erase_where_obviouse sudoku list = + case list of + [] -> + sudoku + + x :: xs -> + let + next = + update_entry_at (\_ -> Empty) x sudoku + in + case possible_values next x of + [ _ ] -> + erase_where_obviouse next xs + + _ -> + erase_where_obviouse sudoku xs + + -- generates a sudoku that is only filled in the top left section diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 2a1484e..445ef47 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,6 +1,6 @@ module Update exposing (no_emptys_sudoku, update, won_sudoku) -import GenSudoku exposing (gen_full_sudoku, solve_sudoku) +import GenSudoku exposing (gen_full_sudoku, gen_partially_filled, solve_sudoku) import List exposing (all) import Platform.Cmd import Random exposing (generate) @@ -31,7 +31,7 @@ update msg (( sudoku, text ) as model) = ( ( sudoku2, resp ), Cmd.none ) Generate -> - ( model, generate Random gen_full_sudoku ) + ( model, generate Random gen_partially_filled ) Solve -> ( model, generate Random <| solve_sudoku sudoku ) -- GitLab From b3f02f3a0a3c1ee8d3e5e43069ea092ded5a9ba5 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Sun, 21 Apr 2019 10:59:51 +0200 Subject: [PATCH 74/82] fix typos and formating --- elm-examples/sudoku/src/GenSudoku.elm | 62 +++++++++++++++++++-------- 1 file changed, 44 insertions(+), 18 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index eaa47cb..a381c32 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,4 +1,4 @@ -module GenSudoku exposing (SmartEntry, SmartRow, SmartSudoku, from_smart, gen_full_sudoku, gen_partially_filled, gen_start_sudoku, get_entry_at, mmap, options_to_entry, rmap, set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, try_all_options, try_entry_at, update_entry_at, update_sorounding, update_surrounding_column, update_surrounding_entry, update_surrounding_row, update_surrounding_section) +module GenSudoku exposing (SmartEntry, SmartRow, SmartSudoku, from_smart, gen_full_sudoku, gen_partially_filled, gen_start_sudoku, get_entry_at, mmap, options_to_entry, rmap, set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, try_all_options, try_entry_at, update_entry_at, update_surrounding, update_surrounding_column, update_surrounding_entry, update_surrounding_row, update_surrounding_section) import Basics exposing ((<<), (>>), (||)) import HardCoded exposing (to_entry) @@ -14,7 +14,7 @@ import Types exposing (..) --- aliassing of different functions whos names are already in use +-- alias of different functions who's names are already in use rmap : (a -> b) -> Generator a -> Generator b @@ -48,18 +48,28 @@ type alias SmartEntry = List EntryValue -list_of_all_postions : List Position -list_of_all_postions = +list_of_all_positions : List Position +list_of_all_positions = concatMap (\row -> map (pair row) <| range 0 8) <| range 0 8 gen_partially_filled : Generator (Maybe Sudoku) gen_partially_filled = - randThen (\sudoku -> rmap (pair sudoku) <| shuffle list_of_all_postions) gen_full_sudoku |> rmap (\( sudoku, posList ) -> mmap (\s -> erase_where_obviouse s posList) sudoku) + randThen + (\sudoku -> + rmap (pair sudoku) <| + shuffle list_of_all_positions + ) + gen_full_sudoku + |> rmap + (\( sudoku, posList ) -> + mmap (\s -> erase_where_obvious s posList) + sudoku + ) -erase_where_obviouse : Sudoku -> List Position -> Sudoku -erase_where_obviouse sudoku list = +erase_where_obvious : Sudoku -> List Position -> Sudoku +erase_where_obvious sudoku list = case list of [] -> sudoku @@ -71,10 +81,10 @@ erase_where_obviouse sudoku list = in case possible_values next x of [ _ ] -> - erase_where_obviouse next xs + erase_where_obvious next xs _ -> - erase_where_obviouse sudoku xs + erase_where_obvious sudoku xs @@ -89,7 +99,13 @@ gen_start_sudoku = |> shuffle |> rmap (zip (Sudoku.area_coordinates ( 0, 0 ))) -- insert Row into Empty Sudoku - |> rmap (\list -> foldr (\( pos, value ) -> set_entry_at (to_entry value) pos) Sudoku.empty_sudoku list) + |> rmap + (\list -> + foldr + (\( pos, value ) -> set_entry_at (to_entry value) pos) + Sudoku.empty_sudoku + list + ) @@ -199,11 +215,21 @@ try_all_options sudoku position = get_entry_at position sudoku |> mmap shuffle |> withDefault (constant []) - |> randThen (\list -> to_be_named list (\entry -> try_entry_at position entry sudoku |> randThen (unwrap (constant Nothing) solve_sudoku_smart))) + |> randThen + (\list -> + first_just_result + list + (\entry -> + try_entry_at position + entry + sudoku + |> randThen (unwrap (constant Nothing) solve_sudoku_smart) + ) + ) -to_be_named : List EntryValue -> (EntryValue -> Generator (Maybe SmartSudoku)) -> Generator (Maybe SmartSudoku) -to_be_named list fun = +first_just_result : List EntryValue -> (EntryValue -> Generator (Maybe SmartSudoku)) -> Generator (Maybe SmartSudoku) +first_just_result list fun = case list of [] -> constant Nothing @@ -217,7 +243,7 @@ to_be_named list fun = constant result Nothing -> - to_be_named xs fun + first_just_result xs fun ) @@ -228,15 +254,15 @@ to_be_named list fun = try_entry_at : Position -> EntryValue -> SmartSudoku -> Generator (Maybe SmartSudoku) try_entry_at pos entry sudoku = set_entry_at [ entry ] pos sudoku - |> update_sorounding entry pos + |> update_surrounding entry pos -- updates the surrounding of pos after inserting entry, this might cascade -update_sorounding : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) -update_sorounding entry pos = +update_surrounding : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) +update_surrounding entry pos = update_surrounding_row entry pos >> Random.andThen (unwrap (constant Nothing) <| update_surrounding_column entry pos) >> Random.andThen (unwrap (constant Nothing) <| update_surrounding_section entry pos) @@ -272,7 +298,7 @@ update_surrounding_entry entry pos sudoku = -- a version of foldl that stops at the first nothing --- similar to our List.Maybe.maybeFold but adopted to work with a maybe thats inside a Generator +-- similar to our List.Maybe.maybeFold but adopted to work with a maybe that's inside a Generator maybeGeneratorFoldl : (a -> b -> Generator (Maybe b)) -> b -> List a -> Generator (Maybe b) -- GitLab From 00cf6368b4067b4c89ea151c09a58331b6fdec8a Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Sun, 21 Apr 2019 12:44:40 +0200 Subject: [PATCH 75/82] Remove unnecessary use of Generators --- elm-examples/sudoku/src/GenSudoku.elm | 55 ++++++++------------------- 1 file changed, 16 insertions(+), 39 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index a381c32..70336c5 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -4,6 +4,7 @@ import Basics exposing ((<<), (>>), (||)) import HardCoded exposing (to_entry) import List exposing (..) import List.Extra exposing (getAt, remove, updateAt, zip) +import List.Maybe exposing (maybeFoldl) import Maybe exposing (andThen, withDefault) import Maybe.Extra exposing (unwrap) import Random exposing (Generator, constant) @@ -223,7 +224,7 @@ try_all_options sudoku position = try_entry_at position entry sudoku - |> randThen (unwrap (constant Nothing) solve_sudoku_smart) + |> unwrap (constant Nothing) solve_sudoku_smart ) ) @@ -251,7 +252,7 @@ first_just_result list fun = -- tries to solve the sudoku with entry at pos -try_entry_at : Position -> EntryValue -> SmartSudoku -> Generator (Maybe SmartSudoku) +try_entry_at : Position -> EntryValue -> SmartSudoku -> Maybe SmartSudoku try_entry_at pos entry sudoku = set_entry_at [ entry ] pos sudoku |> update_surrounding entry pos @@ -261,18 +262,18 @@ try_entry_at pos entry sudoku = -- updates the surrounding of pos after inserting entry, this might cascade -update_surrounding : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) +update_surrounding : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding entry pos = update_surrounding_row entry pos - >> Random.andThen (unwrap (constant Nothing) <| update_surrounding_column entry pos) - >> Random.andThen (unwrap (constant Nothing) <| update_surrounding_section entry pos) + >> (unwrap Nothing <| update_surrounding_column entry pos) + >> (unwrap Nothing <| update_surrounding_section entry pos) -- updates the pos after inserting entry in a surrounding field , this might cascade -update_surrounding_entry : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) +update_surrounding_entry : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_entry entry pos sudoku = let old = @@ -280,7 +281,7 @@ update_surrounding_entry entry pos sudoku = in case remove entry old of [] -> - constant Nothing + Nothing [ x ] -> if [ x ] /= old then @@ -289,62 +290,38 @@ update_surrounding_entry entry pos sudoku = else -- nothing changed - constant <| Just sudoku + Just sudoku value -> -- we still have choices to make here in the future - constant <| Just <| set_entry_at value pos sudoku - - - --- a version of foldl that stops at the first nothing --- similar to our List.Maybe.maybeFold but adopted to work with a maybe that's inside a Generator - - -maybeGeneratorFoldl : (a -> b -> Generator (Maybe b)) -> b -> List a -> Generator (Maybe b) -maybeGeneratorFoldl fun init list = - case list of - [] -> - constant <| Just init - - x :: xs -> - fun x init - |> Random.andThen - (\may -> - case may of - Nothing -> - constant Nothing - - Just next -> - maybeGeneratorFoldl fun next xs - ) + Just <| set_entry_at value pos sudoku -- updates the surrounding row of pos after inserting entry, this might cascade -update_surrounding_row : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) +update_surrounding_row : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_row entry ( row, column ) sudoku = - range 0 8 |> remove column |> maybeGeneratorFoldl (update_surrounding_entry entry << pair row) sudoku + range 0 8 |> remove column |> maybeFoldl (update_surrounding_entry entry << pair row) sudoku -- updates the surrounding column of pos after inserting entry, this might cascade -update_surrounding_column : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) +update_surrounding_column : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_column entry ( row, column ) sudoku = - range 0 8 |> remove row |> maybeGeneratorFoldl (update_surrounding_entry entry << (\r -> ( r, column ))) sudoku + range 0 8 |> remove row |> maybeFoldl (update_surrounding_entry entry << (\r -> ( r, column ))) sudoku -- updates the surrounding section of pos after inserting entry, this might cascade -update_surrounding_section : EntryValue -> Position -> SmartSudoku -> Generator (Maybe SmartSudoku) +update_surrounding_section : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_section entry pos sudoku = - Sudoku.area_coordinates pos |> remove pos |> maybeGeneratorFoldl (update_surrounding_entry entry) sudoku + Sudoku.area_coordinates pos |> remove pos |> maybeFoldl (update_surrounding_entry entry) sudoku -- GitLab From f1d075067f1d3b087e89eb2434b5c473880aa81f Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Tue, 23 Apr 2019 10:56:36 +0200 Subject: [PATCH 76/82] remove dropdown arrows from view --- elm-examples/sudoku/src/View.elm | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index efac9d6..e13a881 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -16,7 +16,7 @@ view ( sudoku, msg ) = css_style = text """ table { - border: 3px double black; + border: 5px double black; border-collapse: collapse; } @@ -32,18 +32,22 @@ css_style = } td:nth-child(3n):not(:last-child) { - border-style: solid double solid solid; - border-width: 1px 3px 1px 1px; + border-style: solid double solid solid; + border-width: 1px 5px 1px 1px; } tr:nth-child(3n):not(:last-child) > td { - border-style: solid solid double solid; - border-width: 1px 1px 3px 1px; + border-style: solid solid double solid; + border-width: 1px 1px 5px 1px; } tr:nth-child(3n):not(:last-child) > td:nth-child(3n):not(:last-child) { - border-style: solid double double solid; - border-width: 1px 3px 3px 1px; + border-style: solid double double solid; + border-width: 1px 5px 5px 1px; + } + + select { + -webkit-appearance: none; } """ -- GitLab From fea2c8db33ba172f1b0bd1c73fc25ee551aa0b1e Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Fri, 26 Apr 2019 16:03:59 +0200 Subject: [PATCH 77/82] the required Readme file --- elm-examples/sudoku/README.md | 31 +++++++++++++++++++++++++++++++ 1 file changed, 31 insertions(+) diff --git a/elm-examples/sudoku/README.md b/elm-examples/sudoku/README.md index e69de29..20ec559 100644 --- a/elm-examples/sudoku/README.md +++ b/elm-examples/sudoku/README.md @@ -0,0 +1,31 @@ +* Sudoku + +An implementation of Sudoku (9x9) in elm. This project aims to run in Chromium based browsers and in Firefox. + +** Building and Testing + +In order to build the project type `elm make src/Main.elm`. This will download the libraries mentioned in the `elm.json` and create the `index.html` with the javascript. + +For testing purposes type `elm reactor`. For this to work the mentionend libraries are needed and therefore `elm make` should be run at least once first. + +** Project structure + +- `elm.json` contains basic elm settings and the needed dependencies +- `src/` + - `Main.elm` + Entry point + - `Update.elm` + The update function for the page + - `View.elm` + Functions to show the sudoku and create the buttons + - `Types.elm` + The basic types for handling the sudoku and the `Msg` type for the browser module + - `Sudoku.elm` + A module for the sudoku logic. This contains functions to check the validity of the sudoku and functions to adjust the sudoku. + - `GenSudoku.elm` + A module with functions to generate a sudoku by solving it first and removing values afterwards. + The solving capabilities can/are also used to solve sudokus, but seem to be incomplete (). This only affects sudoku solving but not the generation of sudokus. + - `List/Maybe.elm` + Contains a function like foldl for lists, but with Maybe which aborts if Nothing is returned even once + - `Seq/Extra.elm` + Two additional functions for Seq (lazy lists). -- GitLab From 907a42a0555a94b9f88932dd86437cb846654350 Mon Sep 17 00:00:00 2001 From: Kai-Oliver Prott Date: Fri, 26 Apr 2019 14:26:17 +0200 Subject: [PATCH 78/82] Prettify Code --- elm-examples/sudoku/src/GenSudoku.elm | 16 +++- elm-examples/sudoku/src/Main.elm | 11 +-- elm-examples/sudoku/src/Sudoku.elm | 80 ++++++++------------ elm-examples/sudoku/src/Types.elm | 4 +- elm-examples/sudoku/src/Update.elm | 7 +- elm-examples/sudoku/src/View.elm | 104 +++++++------------------- 6 files changed, 81 insertions(+), 141 deletions(-) diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 70336c5..8b343f6 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,4 +1,11 @@ -module GenSudoku exposing (SmartEntry, SmartRow, SmartSudoku, from_smart, gen_full_sudoku, gen_partially_filled, gen_start_sudoku, get_entry_at, mmap, options_to_entry, rmap, set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, try_all_options, try_entry_at, update_entry_at, update_surrounding, update_surrounding_column, update_surrounding_entry, update_surrounding_row, update_surrounding_section) +module GenSudoku exposing + (SmartEntry, SmartRow, SmartSudoku, + from_smart, gen_full_sudoku, gen_partially_filled, + gen_start_sudoku, get_entry_at, mmap, options_to_entry, rmap, + set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, + try_all_options, try_entry_at, update_entry_at, update_surrounding, + update_surrounding_column, update_surrounding_entry, update_surrounding_row, + update_surrounding_section) import Basics exposing ((<<), (>>), (||)) import HardCoded exposing (to_entry) @@ -12,6 +19,7 @@ import Random.List exposing (shuffle) import Sudoku exposing (possible_values) import Tuple exposing (pair) import Types exposing (..) +import Debug @@ -196,7 +204,7 @@ solve_sudoku_smart sudoku = -- find a position with least options, but more than one remaining and try them -- generate a list containing all position (0,0) to (8,8) concatMap (\row -> map (\column -> pair row column) <| range 0 8) (range 0 8) - -- filter positions with 1 (or less entries) + -- remove positions with 1 (or less entries) |> filter (\pos -> get_entry_at pos sudoku |> mmap length |> withDefault 0 |> (<) 1) -- the default should never be needed |> sortBy (\pos -> get_entry_at pos sudoku |> mmap length |> withDefault 9) @@ -229,7 +237,7 @@ try_all_options sudoku position = ) -first_just_result : List EntryValue -> (EntryValue -> Generator (Maybe SmartSudoku)) -> Generator (Maybe SmartSudoku) +first_just_result : List a -> (a -> Generator (Maybe b)) -> Generator (Maybe b) first_just_result list fun = case list of [] -> @@ -321,7 +329,7 @@ update_surrounding_column entry ( row, column ) sudoku = update_surrounding_section : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_section entry pos sudoku = - Sudoku.area_coordinates pos |> remove pos |> maybeFoldl (update_surrounding_entry entry) sudoku + Sudoku.area_coordinates_diag pos |> maybeFoldl (update_surrounding_entry entry) sudoku diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index c5598dd..d410dcc 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -1,9 +1,5 @@ module Main exposing (main) --- Model --------------------------------------------------------------------------------------------------------------- --- Update -------------------------------------------------------------------------------------------------------------- --- View ---------------------------------------------------------------------------------------------------------------- - import Browser import Model exposing (..) import Types exposing (Model, Msg) @@ -13,4 +9,9 @@ import View exposing (..) main : Program () Model Msg main = - Browser.element { init = init, update = update, view = view, subscriptions = subs } + Browser.element { + init = init, + update = update, + view = view, + subscriptions = subs + } diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index d4763c3..7873f41 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,10 +1,19 @@ -module Sudoku exposing (area_coordinates, element, empty_sudoku, entry_to_maybe, exchange_entry, extract_area, extract_area_from_position, extract_areas, extract_column, extract_columns, extract_row, extract_rows, gen_sudoku, mayUniform, next, nth_column, possible_values, rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, validate_feature, validate_list, validate_list2, validate_sudoku) +module Sudoku exposing + (area_coordinates, area_coordinates_diag, + element, empty_sudoku, entry_to_maybe, + exchange_entry, extract_area, extract_area_from_position, + extract_areas, extract_column, extract_columns, extract_row, + extract_rows, gen_sudoku, mayUniform, next, nth_column, possible_values, + rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, + validate_feature, validate_list, validate_sudoku) +-- you really want to expose all of this? import HardCoded import List exposing (..) import List.Extra exposing (notMember, transpose) import Random exposing (Generator, generate) import Types exposing (..) +import Debug empty_sudoku : Sudoku @@ -14,26 +23,19 @@ empty_sudoku = validate_sudoku : Sudoku -> Bool validate_sudoku sudoku = - all (validate_feature sudoku) [ extract_rows, extract_columns, extract_areas ] + all (validate_feature sudoku) + [ extract_rows, extract_columns, extract_areas ] validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool validate_feature sudoku extractor = - all validate_list (extractor sudoku) - - -validate_list : List Entry -> Bool -validate_list l = - validate_list2 (map entry_to_maybe l) - - + all (validate_list << map entry_to_maybe) (extractor sudoku) {- validates if a sudoku with the value at the position would be valid -} - - validate_entry : Sudoku -> Position -> Int -> Bool validate_entry s p e = - all (notMember (Entry Fixed e)) <| map (\a -> a s p) [ extract_row, extract_column, extract_area ] + all (notMember (Entry Fixed e)) <| map (\a -> a s p) + [ extract_row, extract_column, extract_area ] @@ -43,9 +45,8 @@ validate_entry s p e = in List.foldl (&&) True res_list -} -{- creates a list of possible entries for a position -} - +{- creates a list of possible entries for a position -} possible_values : Sudoku -> Position -> List Int possible_values s p = filter (validate_entry s p) (range 1 9) @@ -61,23 +62,19 @@ entry_to_maybe v = Just m -validate_list2 : List (Maybe EntryValue) -> Bool -validate_list2 l = +validate_list : List (Maybe EntryValue) -> Bool +validate_list l = case l of [] -> True Nothing :: tail -> - validate_list2 tail + validate_list tail m :: tail -> - not (member m tail) && validate_list2 tail - - + not (member m tail) && validate_list tail -- Creates a list of area entry lists - - extract_areas : Sudoku -> List (List Entry) extract_areas sudoku = map @@ -101,10 +98,16 @@ area_coordinates ( row, column ) = ( x + t, y + s ) offsets = - List.range 0 2 |> List.concatMap (\r -> List.map (Tuple.pair r) <| List.range 0 2) + List.range 0 2 |> + List.concatMap (\r -> List.map (Tuple.pair r) <| List.range 0 2) in List.map (add base) offsets +area_coordinates_diag : Position -> List Position +area_coordinates_diag ( row, column ) = + let d = List.filter (\(x, y) -> x /= row && y /= column) + (area_coordinates (row, column)) + in d extract_area_from_position : Sudoku -> Position -> List Entry extract_area_from_position sudoku ( row, column ) = @@ -113,8 +116,6 @@ extract_area_from_position sudoku ( row, column ) = -- Drops the first 3*n elements of a list and returns 3 elements of the remainder - - td3 : Int -> List a -> List a td3 n list = take 3 (drop (n * 3) list) @@ -122,8 +123,6 @@ td3 n list = -- Returns a list of 9 entries that form the area defined by the position - - extract_area : Sudoku -> Position -> List Entry extract_area s ( r, c ) = foldr (\n -> append (td3 c n)) [] (td3 r s) @@ -143,25 +142,16 @@ extract_columns : Sudoku -> List (List Entry) extract_columns = transpose - extract_column : Sudoku -> Position -> List Entry extract_column sudoku ( _, column ) = filterMap (element column) sudoku - - -- Returns a list of nth elements if they exist - - nth_column : List (List a) -> Int -> List a nth_column list index = List.filterMap (element index) list - - -- Returns the nth element of a list - - element : Int -> List a -> Maybe a element = List.Extra.getAt @@ -173,7 +163,9 @@ element = update_sudoku : Sudoku -> Position -> Entry -> Sudoku update_sudoku sudoku ( row, column ) entry = - exchange_entry sudoku row (update_sudoku_row (List.head (drop row sudoku)) column entry) + exchange_entry sudoku row <| + update_sudoku_row (List.head (drop row sudoku)) + column entry update_sudoku_row : Maybe Row -> Int -> Entry -> Row @@ -185,8 +177,6 @@ exchange_entry : List a -> Int -> a -> List a exchange_entry list index replacement = List.Extra.setAt index replacement list - - --take (index - 1) list ++ [ replacement ] ++ drop index list @@ -196,15 +186,7 @@ rnd = gen_sudoku : Generator (Maybe Sudoku) -gen_sudoku = - case HardCoded.sudokus of - [] -> - Random.constant Nothing - - x :: xa -> - Random.uniform (Just x) <| map (\s -> Just s) xa - - +gen_sudoku = mayUniform HardCoded.sudokus --Random.andThen (try_insert ( 0, 0 ) empty_sudoku) (Random.int 1 9) diff --git a/elm-examples/sudoku/src/Types.elm b/elm-examples/sudoku/src/Types.elm index fb569ec..5fd8e5e 100644 --- a/elm-examples/sudoku/src/Types.elm +++ b/elm-examples/sudoku/src/Types.elm @@ -1,4 +1,6 @@ -module Types exposing (Entry(..), EntryType(..), EntryValue, Model, Msg(..), Position, Row, Sudoku, all_options) +module Types exposing + (Entry(..), EntryType(..), EntryValue, Model, Msg(..), Position, + Row, Sudoku, all_options) import List exposing (map, range) diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 445ef47..9d2f8ac 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,4 +1,5 @@ module Update exposing (no_emptys_sudoku, update, won_sudoku) +-- you really want to expose all of this? import GenSudoku exposing (gen_full_sudoku, gen_partially_filled, solve_sudoku) import List exposing (all) @@ -26,7 +27,7 @@ update msg (( sudoku, text ) as model) = "Incomplete" False -> - "Your Sudoku is self inconsistent!" + "Your Sudoku is self inconsistent!" -- warum self? in ( ( sudoku2, resp ), Cmd.none ) @@ -37,10 +38,10 @@ update msg (( sudoku, text ) as model) = ( model, generate Random <| solve_sudoku sudoku ) Random Nothing -> - ( ( sudoku, "Failed to Generate/Solve Sudoku" ), Cmd.none ) + ( ( sudoku, "Failed to generate/solve Sudoku" ), Cmd.none ) Random (Just s) -> - ( ( s, "Sudoku Generated" ), Cmd.none ) + ( ( s, "Sudoku generated" ), Cmd.none ) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index e13a881..66a099c 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -1,4 +1,6 @@ -module View exposing (conv_to_msg, gen_entry, gen_option, gen_row, gen_sudoku, parse, show, view) +module View exposing + (conv_to_msg, gen_entry, gen_option, gen_row, gen_sudoku, parse, show, view) +-- you really want to expose all of this? import Html exposing (..) import Html.Attributes exposing (selected, style) @@ -10,10 +12,17 @@ import Types exposing (..) view : Model -> Html Msg view ( sudoku, msg ) = - div [] [ node "style" [] [ css_style ], gen_sudoku sudoku, button [ onClick Generate ] [ text "Generate New Sudoku" ], button [ onClick Solve ] [ text "Solve Sudoku" ], br [] [], text msg ] + div [] [ + css_style , + gen_sudoku sudoku, + button [ onClick Generate ] [ text "Generate New Sudoku" ], + button [ onClick Solve ] [ text "Solve Sudoku" ], + br [] [], + text msg + ] -css_style = +css_style = node "style" [] <| (\c -> [c]) <| text """ table { border: 5px double black; @@ -53,6 +62,8 @@ css_style = """ +-- this could be done withing css to simpplify view generation, +-- but that is "geschmackssache" gen_sudoku : Sudoku -> Html Msg gen_sudoku model = table [] <| map gen_row <| zip (range 0 8) model @@ -70,55 +81,25 @@ gen_entry ( position, entry ) = td [] [ text <| show_entry entry ] _ -> - td [] [ select [ onInput <| conv_to_msg position ] <| map (gen_option position entry) all_options ] + td [] [ select [ onInput <| conv_to_msg position ] <| + map (gen_option position entry) + all_options ] conv_to_msg : Position -> String -> Msg -conv_to_msg pos = - parse >> Msg pos - +conv_to_msg pos = parse >> Msg pos gen_option : Position -> Entry -> Entry -> Html Msg gen_option position select entry = - option [ selected <| select == entry, onClick <| Msg position select ] [ text <| show_entry entry ] - - - --- todo there is probably a function for String to int conversion - + option [ selected <| select == entry, + onClick <| Msg position select ] + [ text <| show_entry entry ] parse : String -> Entry parse e = - case e of - "1" -> - Entry User 1 - - "2" -> - Entry User 2 - - "3" -> - Entry User 3 - - "4" -> - Entry User 4 - - "5" -> - Entry User 5 - - "6" -> - Entry User 6 - - "7" -> - Entry User 7 - - "8" -> - Entry User 8 - - "9" -> - Entry User 9 - - _ -> - Empty + case String.toInt e of + Just n -> if n >= 1 && n <= 9 then Entry User n else Empty + Nothing -> Empty show_entry : Entry -> String @@ -130,40 +111,5 @@ show_entry entry = Entry _ e -> show e - - --- todo there is probably a function for int to String conversion - - show : EntryValue -> String -show e = - case e of - 1 -> - "1" - - 2 -> - "2" - - 3 -> - "3" - - 4 -> - "4" - - 5 -> - "5" - - 6 -> - "6" - - 7 -> - "7" - - 8 -> - "8" - - 9 -> - "9" - - _ -> - "" +show e = if e >= 1 && e <= 9 then String.fromInt e else "" -- GitLab From 484a4d9d5ba09c91abbd32efc41e424a92189524 Mon Sep 17 00:00:00 2001 From: stu201758 Date: Fri, 26 Apr 2019 16:03:58 +0200 Subject: [PATCH 79/82] major cleanup and incorporation of the review --- elm-examples/sudoku/src/GenSudoku.elm | 26 +++--- elm-examples/sudoku/src/HardCoded.elm | 35 --------- elm-examples/sudoku/src/List/Maybe.elm | 6 +- elm-examples/sudoku/src/Main.elm | 18 ++--- elm-examples/sudoku/src/Model.elm | 4 +- elm-examples/sudoku/src/Seq/Extra.elm | 105 +++---------------------- elm-examples/sudoku/src/Seq/Random.elm | 15 ---- elm-examples/sudoku/src/Sudoku.elm | 74 +++++++---------- elm-examples/sudoku/src/Update.elm | 11 ++- elm-examples/sudoku/src/View.elm | 81 ++++++++++++------- 10 files changed, 125 insertions(+), 250 deletions(-) delete mode 100644 elm-examples/sudoku/src/HardCoded.elm delete mode 100644 elm-examples/sudoku/src/Seq/Random.elm diff --git a/elm-examples/sudoku/src/GenSudoku.elm b/elm-examples/sudoku/src/GenSudoku.elm index 8b343f6..b552633 100644 --- a/elm-examples/sudoku/src/GenSudoku.elm +++ b/elm-examples/sudoku/src/GenSudoku.elm @@ -1,15 +1,7 @@ -module GenSudoku exposing - (SmartEntry, SmartRow, SmartSudoku, - from_smart, gen_full_sudoku, gen_partially_filled, - gen_start_sudoku, get_entry_at, mmap, options_to_entry, rmap, - set_entry_at, solve_sudoku, solve_sudoku_smart, to_smart, - try_all_options, try_entry_at, update_entry_at, update_surrounding, - update_surrounding_column, update_surrounding_entry, update_surrounding_row, - update_surrounding_section) +module GenSudoku exposing (gen_full_sudoku, gen_partially_filled, solve_sudoku) import Basics exposing ((<<), (>>), (||)) -import HardCoded exposing (to_entry) -import List exposing (..) +import List exposing (all, any, concatMap, filter, foldr, head, indexedMap, isEmpty, length, map, range, sortBy) import List.Extra exposing (getAt, remove, updateAt, zip) import List.Maybe exposing (maybeFoldl) import Maybe exposing (andThen, withDefault) @@ -18,8 +10,7 @@ import Random exposing (Generator, constant) import Random.List exposing (shuffle) import Sudoku exposing (possible_values) import Tuple exposing (pair) -import Types exposing (..) -import Debug +import Types exposing (Entry(..), EntryType(..), EntryValue, Position, Row, Sudoku) @@ -118,6 +109,15 @@ gen_start_sudoku = +-- converts an int the corresponding Fixed Entry + + +to_entry : Maybe Int -> Entry +to_entry = + Maybe.map (Entry Fixed) >> Maybe.withDefault Empty + + + -- generate a filled out sudoku by solving a start_sudoku @@ -329,7 +329,7 @@ update_surrounding_column entry ( row, column ) sudoku = update_surrounding_section : EntryValue -> Position -> SmartSudoku -> Maybe SmartSudoku update_surrounding_section entry pos sudoku = - Sudoku.area_coordinates_diag pos |> maybeFoldl (update_surrounding_entry entry) sudoku + Sudoku.area_coordinates pos |> maybeFoldl (update_surrounding_entry entry) sudoku diff --git a/elm-examples/sudoku/src/HardCoded.elm b/elm-examples/sudoku/src/HardCoded.elm deleted file mode 100644 index 876be66..0000000 --- a/elm-examples/sudoku/src/HardCoded.elm +++ /dev/null @@ -1,35 +0,0 @@ -module HardCoded exposing (s1, sudokus, to_entry, to_sudoku) - -import List exposing (..) -import Types exposing (..) - - -sudokus : List Sudoku -sudokus = - [] - - -to_entry : Maybe Int -> Entry -to_entry = - Maybe.map (Entry Fixed) >> Maybe.withDefault Empty - - -to_sudoku : List (List (Maybe Int)) -> Sudoku -to_sudoku = - -- map Maybe Int to Entry - List.map (List.map to_entry) - - -s1 : Sudoku -s1 = - to_sudoku - [ [ Just 8, Just 2, Nothing, Just 9, Nothing, Nothing, Nothing, Nothing, Just 7 ] - , [ Just 7, Nothing, Just 9, Nothing, Just 5, Nothing, Just 2, Just 1, Nothing ] - , [ Just 4, Nothing, Nothing, Just 2, Nothing, Just 7, Nothing, Just 6, Nothing ] - , [ Just 9, Nothing, Just 2, Just 1, Nothing, Nothing, Nothing, Nothing, Just 6 ] - , [ Just 5, Just 8, Nothing, Nothing, Just 9, Just 2, Nothing, Nothing, Just 1 ] - , [ Nothing, Nothing, Nothing, Just 6, Just 7, Just 8, Nothing, Nothing, Nothing ] - , [ Just 6, Just 4, Nothing, Nothing, Just 8, Nothing, Nothing, Just 2, Nothing ] - , [ Just 3, Nothing, Just 8, Nothing, Nothing, Nothing, Nothing, Just 4, Just 5 ] - , [ Nothing, Nothing, Nothing, Nothing, Nothing, Just 9, Nothing, Just 7, Nothing ] - ] diff --git a/elm-examples/sudoku/src/List/Maybe.elm b/elm-examples/sudoku/src/List/Maybe.elm index de67a1c..77835ca 100644 --- a/elm-examples/sudoku/src/List/Maybe.elm +++ b/elm-examples/sudoku/src/List/Maybe.elm @@ -1,6 +1,10 @@ module List.Maybe exposing (maybeFoldl) -import Maybe exposing (..) +import Maybe exposing (Maybe(..)) + + + +-- maybeFoldl acts like foldl and aborts if the accumulation function returns Nothing resulting in Nothing otherwise in the final Just value maybeFoldl : (a -> b -> Maybe b) -> b -> List a -> Maybe b diff --git a/elm-examples/sudoku/src/Main.elm b/elm-examples/sudoku/src/Main.elm index d410dcc..054c2f2 100644 --- a/elm-examples/sudoku/src/Main.elm +++ b/elm-examples/sudoku/src/Main.elm @@ -1,17 +1,17 @@ module Main exposing (main) import Browser -import Model exposing (..) +import Model exposing (init, subs) import Types exposing (Model, Msg) -import Update exposing (..) -import View exposing (..) +import Update exposing (update) +import View exposing (view) main : Program () Model Msg main = - Browser.element { - init = init, - update = update, - view = view, - subscriptions = subs - } + Browser.element + { init = init + , update = update + , view = view + , subscriptions = subs + } diff --git a/elm-examples/sudoku/src/Model.elm b/elm-examples/sudoku/src/Model.elm index 78710c1..138ce0e 100644 --- a/elm-examples/sudoku/src/Model.elm +++ b/elm-examples/sudoku/src/Model.elm @@ -1,9 +1,7 @@ module Model exposing (init, subs) -import GenSudoku -import Random import Sudoku exposing (empty_sudoku) -import Types exposing (..) +import Types exposing (Model, Msg) init : a -> ( Model, Cmd Msg ) diff --git a/elm-examples/sudoku/src/Seq/Extra.elm b/elm-examples/sudoku/src/Seq/Extra.elm index fbf9f79..c66cf05 100644 --- a/elm-examples/sudoku/src/Seq/Extra.elm +++ b/elm-examples/sudoku/src/Seq/Extra.elm @@ -1,6 +1,10 @@ -module Seq.Extra exposing (all, any, filter, getAt, indexedMap, limitRepeat, notMember, range, remove, setAt, updateAt) +module Seq.Extra exposing (all, remove) -import Seq exposing (..) +import Seq exposing (Seq(..)) + + + +-- like all for List, returns true iff all elements fulfill the predicate all : (a -> Bool) -> Seq a -> Bool @@ -18,108 +22,19 @@ all predicate seq = False -any : (a -> Bool) -> Seq a -> Bool -any predicate seq = - case seq of - Nil -> - False - - Cons a fun -> - case predicate a of - False -> - all predicate <| fun () - - True -> - True - - -getAt : Int -> Seq a -> Maybe a -getAt index seq = - case seq of - Nil -> - Nothing - - a -> - head <| drop index a - -setAt : Int -> a -> Seq a -> Seq a -setAt index a = - updateAt index (always a) - - -updateAt : Int -> (a -> a) -> Seq a -> Seq a -updateAt index fun seq = - if index < 0 then - seq - - else - let - head = - take index seq - - tail = - drop index seq - in - case tail of - Cons a rem -> - append head <| Cons (fun a) rem - - Nil -> - seq +-- removed the first occurrence the value from the Sequence remove : a -> Seq a -> Seq a -remove sentinal seq = +remove sentinel seq = case seq of Nil -> Nil Cons a tail -> - if a == sentinal then + if a == sentinel then tail () else - Cons a (\_ -> remove sentinal <| tail ()) - - -limitRepeat : Int -> a -> Seq a -limitRepeat count value = - repeat value |> take count - - -notMember : a -> Seq a -> Bool -notMember a seq = - not <| member a seq - - -filter : (a -> Bool) -> Seq a -> Seq a -filter predicate seq = - filterMap - (\v -> - if predicate v then - Just v - - else - Nothing - ) - seq - - -range : Int -> Int -> Seq Int -range from to = - fromList <| List.range from to - - -indexedMap : (Int -> a -> b) -> Seq a -> Seq b -indexedMap = - let - internIndexMap index fun seq = - case seq of - Nil -> - Nil - - Cons a tail -> - Cons (fun index a) (\_ -> internIndexMap (index + 1) fun <| tail ()) - in - internIndexMap 0 + Cons a (\_ -> remove sentinel <| tail ()) diff --git a/elm-examples/sudoku/src/Seq/Random.elm b/elm-examples/sudoku/src/Seq/Random.elm deleted file mode 100644 index 8035b7c..0000000 --- a/elm-examples/sudoku/src/Seq/Random.elm +++ /dev/null @@ -1,15 +0,0 @@ -module Seq.Random exposing (shuffle, uniform) - -import Random exposing (Generator) -import Random.List -import Seq exposing (..) - - -shuffle : Seq a -> Generator (Seq a) -shuffle seq = - toList seq |> Random.List.shuffle |> Random.map fromList - - -uniform : a -> Seq a -> Generator a -uniform a seq = - Random.uniform a <| toList seq diff --git a/elm-examples/sudoku/src/Sudoku.elm b/elm-examples/sudoku/src/Sudoku.elm index 7873f41..aeec318 100644 --- a/elm-examples/sudoku/src/Sudoku.elm +++ b/elm-examples/sudoku/src/Sudoku.elm @@ -1,19 +1,9 @@ -module Sudoku exposing - (area_coordinates, area_coordinates_diag, - element, empty_sudoku, entry_to_maybe, - exchange_entry, extract_area, extract_area_from_position, - extract_areas, extract_column, extract_columns, extract_row, - extract_rows, gen_sudoku, mayUniform, next, nth_column, possible_values, - rnd, td3, try_insert, update_sudoku, update_sudoku_row, validate_entry, - validate_feature, validate_list, validate_sudoku) --- you really want to expose all of this? - -import HardCoded -import List exposing (..) +module Sudoku exposing (area_coordinates, empty_sudoku, possible_values, update_sudoku, validate_sudoku) + +import List exposing (all, append, drop, filter, filterMap, foldr, map, member, range, repeat, take) import List.Extra exposing (notMember, transpose) -import Random exposing (Generator, generate) -import Types exposing (..) -import Debug +import Random exposing (Generator) +import Types exposing (Entry(..), EntryType(..), EntryValue, Msg(..), Position, Row, Sudoku) empty_sudoku : Sudoku @@ -31,11 +21,16 @@ validate_feature : Sudoku -> (Sudoku -> List (List Entry)) -> Bool validate_feature sudoku extractor = all (validate_list << map entry_to_maybe) (extractor sudoku) + + {- validates if a sudoku with the value at the position would be valid -} + + validate_entry : Sudoku -> Position -> Int -> Bool validate_entry s p e = - all (notMember (Entry Fixed e)) <| map (\a -> a s p) - [ extract_row, extract_column, extract_area ] + all (notMember (Entry Fixed e)) <| + map (\a -> a s p) + [ extract_row, extract_column, extract_area ] @@ -45,8 +40,9 @@ validate_entry s p e = in List.foldl (&&) True res_list -} - {- creates a list of possible entries for a position -} + + possible_values : Sudoku -> Position -> List Int possible_values s p = filter (validate_entry s p) (range 1 9) @@ -74,7 +70,11 @@ validate_list l = m :: tail -> not (member m tail) && validate_list tail + + -- Creates a list of area entry lists + + extract_areas : Sudoku -> List (List Entry) extract_areas sudoku = map @@ -98,24 +98,16 @@ area_coordinates ( row, column ) = ( x + t, y + s ) offsets = - List.range 0 2 |> - List.concatMap (\r -> List.map (Tuple.pair r) <| List.range 0 2) + List.range 0 2 + |> List.concatMap (\r -> List.map (Tuple.pair r) <| List.range 0 2) in List.map (add base) offsets -area_coordinates_diag : Position -> List Position -area_coordinates_diag ( row, column ) = - let d = List.filter (\(x, y) -> x /= row && y /= column) - (area_coordinates (row, column)) - in d -extract_area_from_position : Sudoku -> Position -> List Entry -extract_area_from_position sudoku ( row, column ) = - extract_area sudoku ( row // 3, column // 3 ) +-- Drops the first 3*n elements of a list and returns 3 elements of the remainder --- Drops the first 3*n elements of a list and returns 3 elements of the remainder td3 : Int -> List a -> List a td3 n list = take 3 (drop (n * 3) list) @@ -123,6 +115,8 @@ td3 n list = -- Returns a list of 9 entries that form the area defined by the position + + extract_area : Sudoku -> Position -> List Entry extract_area s ( r, c ) = foldr (\n -> append (td3 c n)) [] (td3 r s) @@ -142,16 +136,16 @@ extract_columns : Sudoku -> List (List Entry) extract_columns = transpose + extract_column : Sudoku -> Position -> List Entry extract_column sudoku ( _, column ) = filterMap (element column) sudoku --- Returns a list of nth elements if they exist -nth_column : List (List a) -> Int -> List a -nth_column list index = - List.filterMap (element index) list + -- Returns the nth element of a list + + element : Int -> List a -> Maybe a element = List.Extra.getAt @@ -164,8 +158,9 @@ element = update_sudoku : Sudoku -> Position -> Entry -> Sudoku update_sudoku sudoku ( row, column ) entry = exchange_entry sudoku row <| - update_sudoku_row (List.head (drop row sudoku)) - column entry + update_sudoku_row (List.head (drop row sudoku)) + column + entry update_sudoku_row : Maybe Row -> Int -> Entry -> Row @@ -177,16 +172,7 @@ exchange_entry : List a -> Int -> a -> List a exchange_entry list index replacement = List.Extra.setAt index replacement list ---take (index - 1) list ++ [ replacement ] ++ drop index list - - -rnd : Cmd Msg -rnd = - generate Random gen_sudoku - -gen_sudoku : Generator (Maybe Sudoku) -gen_sudoku = mayUniform HardCoded.sudokus --Random.andThen (try_insert ( 0, 0 ) empty_sudoku) (Random.int 1 9) diff --git a/elm-examples/sudoku/src/Update.elm b/elm-examples/sudoku/src/Update.elm index 9d2f8ac..2eb5789 100644 --- a/elm-examples/sudoku/src/Update.elm +++ b/elm-examples/sudoku/src/Update.elm @@ -1,16 +1,15 @@ module Update exposing (no_emptys_sudoku, update, won_sudoku) --- you really want to expose all of this? -import GenSudoku exposing (gen_full_sudoku, gen_partially_filled, solve_sudoku) +import GenSudoku exposing (gen_partially_filled, solve_sudoku) import List exposing (all) import Platform.Cmd import Random exposing (generate) -import Sudoku exposing (..) -import Types exposing (..) +import Sudoku exposing (validate_sudoku) +import Types exposing (Entry(..), Model, Msg(..), Sudoku) update : Msg -> Model -> ( Model, Cmd Msg ) -update msg (( sudoku, text ) as model) = +update msg (( sudoku, _ ) as model) = case msg of Msg position entry -> let @@ -27,7 +26,7 @@ update msg (( sudoku, text ) as model) = "Incomplete" False -> - "Your Sudoku is self inconsistent!" -- warum self? + "Your Sudoku is inconsistent!" in ( ( sudoku2, resp ), Cmd.none ) diff --git a/elm-examples/sudoku/src/View.elm b/elm-examples/sudoku/src/View.elm index 66a099c..e5a8fa0 100644 --- a/elm-examples/sudoku/src/View.elm +++ b/elm-examples/sudoku/src/View.elm @@ -1,29 +1,29 @@ -module View exposing - (conv_to_msg, gen_entry, gen_option, gen_row, gen_sudoku, parse, show, view) --- you really want to expose all of this? +module View exposing (conv_to_msg, gen_entry, gen_option, gen_row, gen_sudoku, parse, show, view) -import Html exposing (..) -import Html.Attributes exposing (selected, style) +import Html exposing (Html, br, button, div, node, option, select, table, td, text, tr) +import Html.Attributes exposing (selected) import Html.Events exposing (onClick, onInput) -import List exposing (map, map2, range, repeat) +import List exposing (map, range, repeat) import List.Extra exposing (zip) -import Types exposing (..) +import Types exposing (Entry(..), EntryType(..), EntryValue, Model, Msg(..), Position, Row, Sudoku, all_options) view : Model -> Html Msg view ( sudoku, msg ) = - div [] [ - css_style , - gen_sudoku sudoku, - button [ onClick Generate ] [ text "Generate New Sudoku" ], - button [ onClick Solve ] [ text "Solve Sudoku" ], - br [] [], - text msg - ] - - -css_style = node "style" [] <| (\c -> [c]) <| - text """ + div [] + [ css_style + , gen_sudoku sudoku + , button [ onClick Generate ] [ text "Generate New Sudoku" ] + , button [ onClick Solve ] [ text "Solve Sudoku" ] + , br [] [] + , text msg + ] + + +css_style = + node "style" [] <| + (\c -> [ c ]) <| + text """ table { border: 5px double black; border-collapse: collapse; @@ -62,8 +62,11 @@ css_style = node "style" [] <| (\c -> [c]) <| """ + -- this could be done withing css to simpplify view generation, -- but that is "geschmackssache" + + gen_sudoku : Sudoku -> Html Msg gen_sudoku model = table [] <| map gen_row <| zip (range 0 8) model @@ -81,25 +84,39 @@ gen_entry ( position, entry ) = td [] [ text <| show_entry entry ] _ -> - td [] [ select [ onInput <| conv_to_msg position ] <| + td [] + [ select [ onInput <| conv_to_msg position ] <| map (gen_option position entry) - all_options ] + all_options + ] conv_to_msg : Position -> String -> Msg -conv_to_msg pos = parse >> Msg pos +conv_to_msg pos = + parse >> Msg pos + gen_option : Position -> Entry -> Entry -> Html Msg gen_option position select entry = - option [ selected <| select == entry, - onClick <| Msg position select ] - [ text <| show_entry entry ] + option + [ selected <| select == entry + , onClick <| Msg position select + ] + [ text <| show_entry entry ] + parse : String -> Entry parse e = - case String.toInt e of - Just n -> if n >= 1 && n <= 9 then Entry User n else Empty - Nothing -> Empty + case String.toInt e of + Just n -> + if n >= 1 && n <= 9 then + Entry User n + + else + Empty + + Nothing -> + Empty show_entry : Entry -> String @@ -111,5 +128,11 @@ show_entry entry = Entry _ e -> show e + show : EntryValue -> String -show e = if e >= 1 && e <= 9 then String.fromInt e else "" +show e = + if e >= 1 && e <= 9 then + String.fromInt e + + else + "" -- GitLab From 47293b5d0d7b4c43be8b588a946b8d24bca00cdb Mon Sep 17 00:00:00 2001 From: stu201758 Date: Fri, 26 Apr 2019 16:06:09 +0200 Subject: [PATCH 80/82] changed to ignore all .idea folders --- .gitignore | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.gitignore b/.gitignore index 05f7c1d..f752033 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,2 @@ -/elm-examples/sudoku/.idea/ +**/.idea/ *.html -- GitLab From bf1214245d6dc564883ccadfb10b7bd84c65d1a3 Mon Sep 17 00:00:00 2001 From: stu201758 Date: Fri, 26 Apr 2019 16:07:12 +0200 Subject: [PATCH 81/82] changed to ignore all elm-stuff folders --- .gitignore | 1 + 1 file changed, 1 insertion(+) diff --git a/.gitignore b/.gitignore index f752033..387ee11 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ **/.idea/ *.html +**/elm-stuff/ -- GitLab From 06cab7176f54d3535488ef5f22c560c162fe14d3 Mon Sep 17 00:00:00 2001 From: Tammo Heilemann Date: Fri, 26 Apr 2019 16:11:13 +0200 Subject: [PATCH 82/82] Update README.md --- elm-examples/sudoku/README.md | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/elm-examples/sudoku/README.md b/elm-examples/sudoku/README.md index 20ec559..e52afa0 100644 --- a/elm-examples/sudoku/README.md +++ b/elm-examples/sudoku/README.md @@ -1,14 +1,24 @@ -* Sudoku +# Sudoku An implementation of Sudoku (9x9) in elm. This project aims to run in Chromium based browsers and in Firefox. -** Building and Testing +## Building and Testing -In order to build the project type `elm make src/Main.elm`. This will download the libraries mentioned in the `elm.json` and create the `index.html` with the javascript. +In order to build the project type + +``` sh +elm make src/Main.elm +``` -For testing purposes type `elm reactor`. For this to work the mentionend libraries are needed and therefore `elm make` should be run at least once first. +This will download the libraries mentioned in the `elm.json` and create the `index.html` with the javascript. -** Project structure +For testing purposes type +``` sh +elm reactor +``` +For this to work the mentionend libraries are needed and therefore `elm make` should be run at least once first. + +## Project structure - `elm.json` contains basic elm settings and the needed dependencies - `src/` -- GitLab