Sudoku Solver in SML with Backtracking - sml

I'm working on creating a Sudoku Solver with SML/NJ. I've got all of the functions in place to actually manipulate the input data (check for legality of rows, forcing the empty spaces, etc) but I'm having trouble with the backtracking part.
I came across this question but I'm confused on how to implement it in SML.
Note that a board is input as a list of lists that represent the numbers in each row, 0 for an unknown spot
[[0,0,0, 2,6,0, 7,0,1],
[6,8,0, 0,7,0, 0,9,0],
[1,9,0, 0,0,4, 5,0,0],
[8,2,0, 1,0,0, 0,4,0],
[0,0,4, 6,0,2, 9,0,0],
[0,5,0, 0,0,3, 0,2,8],
[0,0,9, 3,0,0, 0,7,4],
[0,4,0, 0,5,0, 0,3,6],
[7,0,3, 0,1,8, 0,0,0]]
Here is my (edited) solve function.
exception Sudoku;
fun solve board =
let fun solve' board k =
(* k is the row we are working on, so if it's 9, we SHOULD be done *)
if k = 9 then board else
let
(* get row k from the board *)
val row = (List.nth (board, k));
fun trySpot number col =
(* if number >= 10, raise an exception to backtrack *)
if number > (length row) then raise Sudoku
(* if col = 9, raise an exception to backtrack *)
else if col = 9 then raise Sudoku
(* if row[col] is not a zero, move to next col *)
else if not (List.nth(row, col) = 0) then trySpot number (col + 1)
(* row doesn't contain this num already *)
else if length (List.filter (fn x => x = number) row) = 0 then
let
(* build the new row and board and check if legal (this works fine) *)
val newRow = delete(col + 1, (insertAtPos row number col));
val newBoard = delete(k + 1, (insertAtPos board newRow k));
val isLegal = checkLegal newBoard;
in
(* if legal, keep solving with new board as base *)
if isLegal then
solve' (force newBoard) 0
handle Sudoku => solve' (force board) (k + 1)
(* not legal, try with next num *)
else trySpot (number + 1) col
end
(* row already has this number, skipping *)
else trySpot (number + 1) col
in
(* if board is complete and legal we're done *)
if completedBoard board andalso checkLegal board then board
(* if row has a zero then try a spot *)
else if (zeroInList row) then trySpot 1 0
(* otherwise move to next row *)
else solve' (force board) (k + 1)
end
in
(* initial solve *)
solve' (force board) 0
end;
Calling solve on the sample data above returns the following lists
[[4,3,5,2,6,9,7,8,1],
[6,8,2,5,7,1,4,9,3],
[1,9,7,8,3,4,5,6,2],
[8,2,6,1,9,5,3,4,7],
[3,1,4,6,8,2,9,0,0],
[0,5,0,0,0,3,0,2,8],
[0,0,9,3,0,0,0,7,4],
[2,4,0,0,5,0,0,3,6],
[7,0,3,0,1,8,0,0,0]]
Now this is partially correct. The first four rows look to be fully correct based on an online sudoku solver I used to check, but it gets messed up on the 5th row. I presume it's because it's not able to backtrack all the way.
The only place it "backs up" is on this line
handle Sudoku => solve' (force board) (k + 1)
This tells it to just try solving the old board (without the new number) but this is preventing it from backtracking more than one step (I think). How could this be accomplished?
If anyone is curious to see the full code, you can find it here.
Thanks in advance!

I seem to have gotten my solve function to work with all of the cases I've tried. The trick was to keep track of a list of illegal numbers for the spot we were working on. The solver will now skip over these numbers, and backtrack if it can't find a path forward.
exception Sudoku;
(* solves a soduku board input that gives a list of lists representing the rows of a board (0 for unknown spaces) *)
fun solve board =
let fun solve' board row illegalNums =
(* if we are on row 9 and board is complete/legal, we are done *)
if row = 9 andalso completedBoard board andalso checkLegal board then board else
(* if we are on row 9 but the board is not complete/legal, throw an exception to backtrack *)
if row = 9 then raise Sudoku else
let
(* get the current row we are working on *)
val cRow = (List.nth (board, row));
(* trys a row[col] on the board with a certain number *)
fun trySpot num cRow col =
(* if number >= 10, raise an exception to backtrack *)
if num > 9 then raise Sudoku
(* if row[col] is not a 0, try next col *)
else if not (List.nth (cRow, col) = 0) then trySpot num cRow (col + 1)
(* if we know that the number we are on isn't allowed, skip to next number *)
else if length (List.filter (fn x=> x = num) illegalNums) > 0 then trySpot (num + 1) cRow col
(* if row already has this number, skip to next number *)
else if length (List.filter (fn x=> x = num) cRow) > 0 then trySpot (num + 1) cRow col
(* if col already has this number, skip to next number *)
else if length (List.filter (fn x=> x = num) (List.nth((rowsToCols board), col))) > 0 then trySpot (num + 1) cRow col
else
let
(* make our new row and board *)
val newRow = delete(col + 1, (insertAtPos cRow num col));
val newBoard = delete(row + 1, (insertAtPos board newRow row));
in
(* if new board is legal, continue solving *)
if checkLegal newBoard then
solve' (force newBoard) 0 []
(* handle any exceptions by adding the number to our list of illegal numbers, thereby backtracking *)
handle Sudoku => solve' (force board) row (illegalNums#[num])
(* if new board is not legal, try next number *)
else trySpot (num + 1) cRow col
end
in
(* if board is completed and legal, return board *)
if completedBoard board andalso checkLegal board then board
(* if current row has at least one 0, try a number in that row (beginning at col 1) *)
else if (zeroInList cRow) then trySpot 1 cRow 0
(* else, skip to next row and solve *)
else solve' (force board) (row + 1) []
end
in
(* initial solve *)
solve' (force board) 0 []
end;
The harder boards can take quite a while to fully solve, but every one I've tested eventually gets there. I'm sure there are a ton of optimizations I can do in my code, so I'm open to suggestions.

Related

How should I implement this algorithm with zarith? Because it only works till 26

Well, I wrote this code and I'm trying to implement the zarith library, to have access to bigger integers, otherwise I'm not able to process the algorithm more than when n=25.
let (~~) = Z.of_int
let (&*) = Z.mul
let (&/) = Z.div
let (&-) = Z.sub
let rec s n chamadas =
if n < 0 || n > 10_000 then invalid_arg "ERRO"
else
match n with
| 0 -> (Z.one , chamadas + 1)
| 1 -> (~~ 2, chamadas + 1)
| _ ->
let (~~ resultado, counter) = s (n - 1) (chamadas + 1) in
let (~~ resultado', counter) = sum_s n 1 counter in
(~~ 3 &* ~~ resultado &+ ~~ resultado', counter)
and sum_s n k chamadas =
let rec aux_sum_s n k chamadas =
if n - 2 < 1 || k > n - 2 then
(0, chamadas)
else
let (~~ resultado, counter) = s k chamadas in
let (~~ resultado', counter) = s (n - k - 1) counter in
let (~~ resultado'', counter) = aux_sum_s n (k + 1) counter in
(~~ resultado &* ~~ resultado' &+ ~~ resultado'', counter)
in
aux_sum_s n 1 chamadas
that's what I understood from the documentation
The first character of an infix operator defines its precedence (priority over other operators) and associativity (how operators with equal precedence are grouped). Therefore, your choice of prefixing the operators that work with Zarith numbers with & is probably the worst possible. Not only does it put all arithmetic operators on the same level, so that the multiplication has no precedence over addition, but it also groups them from right to left!
Therefore,
x &* y &+ z
is parsed as,
x &* (y &+ z)
This basically invalidates all your code.
The right way is to append characters to the infix operator, cf. the floating-point operators, e.g., *., +., etc.
So you can either do,
let ( *& ) = Z.mul
let ( /& ) = Z.div
let ( -& ) = Z.sub
or just use the infix operators that are already provided by the Zarith library together with the local opens, e.g.,
Z.(x * y + z)
is the same as,
x *& y *& +& z
provided you have the above bindings. I believe that the former is much easier to read than the latter.
In addition, you have to keep all numbers in Z.t if you will keep converting them back and forth, then you will lose precision with each conversion to int. It would be much easier if you will keep everything in Z.t.
Finally,
let (~~ resultado, counter) = s (n - 1) (chamadas + 1) in
Is not valid OCaml at all, what you wanted to say could be expressed with the following syntactically valid OCaml
let (resultado, counter) = s (n - 1) (chamadas + 1) in
let resultado = ~~resultado in
But it still doesn't make much sense, since your s function returns the value of type Z.t and applying Z.of_int to doesn't make any sense. And using ~~ for Z.of_int is probably also not the best choice of name, as looks very much like negation. Zarith itself, provides the ~$ operator for that.

How to find N points on an infinite axis so that sum of distances from M points to its nearest N is smallest?

Consider there are N houses on a single road. I have M lightpoles. Given that M < N. Distance between all adjacent houses are different. Lightpole can be placed at the house only. And I have to place all lightpoles at house so that sum of distances from each house to its nearest lightpole is smallest. How can I code this problem?
After a little research I came to know that I have to use dynamic programming for this problem. But I don't know how to approach it to this problem.
Here's a naive dynamic program with search space O(n^2 * m). Perhaps others know of another speedup? The recurrence should be clear from the function f in the code.
JavaScript code:
// We can calculate these in O(1)
// by using our prefixes (ps) and
// the formula for a subarray, (j, i),
// reaching for a pole at i:
//
// ps[i] - ps[j-1] - (A[i] - A[j-1]) * j
//
// Examples:
// A: [1,2,5,10]
// ps: [0,1,7,22]
// (2, 3) =>
// 22 - 1 - (10 - 2) * 2
// = 5
// = 10-5
// (1, 3) =>
// 22 - 0 - (10 - 1) * 1
// = 13
// = 10-5 + 10-2
function sumParts(A, j, i, isAssigned){
let result = 0
for (let k=j; k<=i; k++){
if (isAssigned)
result += Math.min(A[k] - A[j], A[i] - A[k])
else
result += A[k] - A[j]
}
return result
}
function f(A, ps, i, m, isAssigned){
if (m == 1 && isAssigned)
return ps[i]
const start = m - (isAssigned ? 2 : 1)
const _m = m - (isAssigned ? 1 : 0)
let result = Infinity
for (let j=start; j<i; j++)
result = Math.min(
result,
sumParts(A, j, i, isAssigned)
+ f(A, ps, j, _m, true)
)
return result
}
var A = [1, 2, 5, 10]
var m = 2
var ps = [0]
for (let i=1; i<A.length; i++)
ps[i] = ps[i-1] + (A[i] - A[i-1]) * i
var result = Math.min(
f(A, ps, A.length - 1, m, true),
f(A, ps, A.length - 1, m, false))
console.log(`A: ${ JSON.stringify(A) }`)
console.log(`ps: ${ JSON.stringify(ps) }`)
console.log(`m: ${ m }`)
console.log(`Result: ${ result }`)
I got you covered bud. I will write to explain the dynamic programming algorithm first and if you are not able to code it, let me know.
A-> array containing points so that A[i]-A[i-1] will be the distance between A[i] and A[i-1]. A[0] is the first point. When you are doing memoization top-down, you will have to handle cases when you would want to place a light pole at the current house or you would want to place it at a lower index. If you place it now, you recurse with one less light pole available and calculate the sum of distances with previous houses. You handle the base case when you are not left with any ligh pole or you are done with all the houses.

Overload Conflict in SML/NJ

I have the following code to compute the Hofstadter H Sequence, but I am getting an overload conflict error message. I am fairly new to SML therefore i am sure what the error is referring to.
(* Hofstadter H-Sequence *)
fun H(0) = [0]
| H(n) = if n = 0 then [0] else x :: (n - H(H(H(n - 1))));
My goal is to insert the value of each iteration into a list and display it.
Ex: H 10; -->[1, 1, 2, 3, 4, 4, 5, 5, 6, 7]
You're trying to write a function with the type int -> int list.
(It's a good idea to think about the types while writing, even though SML will infer them. A good type system is like autofocus for the mind.)
You can't subtract the result of this function from a number (n - H(...)) since it is a list, nor can you pass a list to to this function – H(H(n - 1)) – since it wants a number.
(And where did the first element, x, come from?)
Start simple, with a function that's just the definition of H(n):
fun H 0 = 0
| H n = n - H(H(H(n-1)))
Test:
- H 0;
val it = 0 : int
- H 1;
val it = 1 : int
- H 2;
val it = 1 : int
- H 4;
val it = 3 : int
Then use that to build a list incrementally.
This variant uses a locally defined helper function that uses the current index and a counter:
fun H_seq n = let fun H_seq' m e =
if m < e
then (H m) :: (H_seq' (m+1) e)
else []
in
H_seq' 0 n
end;
Example:
- H_seq 10;
val it = [0,1,1,2,3,4,4,5,5,6] : int list
This is pretty inefficient, but fixing that is part of the more advanced course...

Addition between int option and int

I have an integer matrix of n rows by m cols representing a game board, and have written two functions that allow me to retrieve and set values within the matrix.
let get_val board (row, col) =
if row < 0
|| col < 0
|| (Array.length data) < (row + 1)
|| (Array.length data.(row)) < (col + 1)
then None
else if (board.(row).(col)) = (-1)
then None
else Some (board.(row).(col)) ;;
let set_val board (row, col) i =
if row < 0
|| col < 0
|| (Array.length data) < row+1
|| (Array.length data.(row)) < col+1
|| i < 0
then invalid_arg "set: invalid arguments"
else board.(row).(col) <- i;
board ;;
let board = Array.make_matrix 4 4 ;;
All positions are set to -1 initially to represent an empty square. Basically, if I try to retrieve a value outside of the board, I get a None. If the location is valid and not an empty square, I get can retrieve the value at that matrix as a Some type. I would like to increment a position by 1 in a board by using these two functions.
My first attempt in the board by 1 by doing the following:
let board = set_val board (2, 2) ((get_val board (2, 2)) + 1)
However, I run into the type issue,
This expression has type int option but an expression was expected of type int
, which I understand is because "get_val" returns a Some type, and 1 is an integer. I also tried:
let board = set_val board (2, 2) ((get_val board (2, 2)) + (Some 1))
, but board is an integer matrix. The constraints of the problem require me to return a Some/None from "get_val", but I need a way to retrieve the values from the function "get" as an int, not a Some. I've looked into how to convert from an Option to an int, but came up with nothing, since I'm not allowed access to the Option module. I suspect I'm not looking up the correct thing, but have run out of places to look. How would I be able to use the result of "get_val" in a way that I can increment the new value for a position on the board?
The best/idiomatic Ocaml way to do this is using pattern matching.
let board = match (S.get grid (row, col)) with
| None -> S.set grid (row, col) 1
| Some v -> S.set grid (row, col) (v+1)
Apparently, this way you can strip the Some part of the v and just get the actual value.

Miller-Rabin test: bug in my code

I've written a Miller-Rabin primality test based on the following pseudo code:
Input: n > 2, an odd integer to be tested for primality;
k, a parameter that determines the accuracy of the test
Output: composite if n is composite, otherwise probably prime
write n − 1 as 2s·d with d odd by factoring powers of 2 from n − 1
LOOP: repeat k times:
pick a randomly in the range [2, n − 1]
x ← ad mod n
if x = 1 or x = n − 1 then do next LOOP
for r = 1 .. s − 1
x ← x2 mod n
if x = 1 then return composite
if x = n − 1 then do next LOOP
return composite
return probably prime
The code I have rarely gets past 31 (if I put it in a loop to test numbers from 2 to 100). There must be something wrong but I can't see what it is.
bool isProbablePrime(ulong n, int k) {
if (n < 2 || n % 2 == 0)
return n == 2;
ulong d = n - 1;
ulong s = 0;
while (d % 2 == 0) {
d /= 2;
s++;
}
assert(2 ^^ s * d == n - 1);
outer:
foreach (_; 0 .. k) {
ulong a = uniform(2, n);
ulong x = (a ^^ d) % n;
if (x == 1 || x == n - 1)
continue;
foreach (__; 1 .. s) {
x = (x ^^ 2) % n;
if (x == 1) return false;
if (x == n - 1) continue outer;
}
return false;
}
return true;
}
I've also tried the variant
...
foreach (__; 1 .. s) {
x = (x ^^ 2) % n;
if (x == 1) return false;
if (x == n - 1) continue outer;
}
if ( x != n - 1) return false; // this is different
...
I have a different version of the test that works correctly but it uses modpow. I'd like to have a version that stays closer to the pseudo code that's part of the rossetta.org task description.
Edit: Re: overflow problem. I suspected something like that. I'm still puzzled why the Ruby version doesn't have that problem. It probably handles it differently under the hood.
If I use BigInt, the code does work, but becomes a lot slower than when I use modpow. So I guess I can't get away from that. It's a pity Phobos doesn't have a modpow built-in, or I must have overlooked it.
ulong x = ((BigInt(a) ^^ d) % BigInt(n)).toLong();
In this statement
ulong x = (a ^^ d) % n;
the quantity (a ^^ d) is probably overflowing before the mod operation can take place. The modpow version wouldn't suffer from this problem, since that algorithm avoids the need for arbitrarily large intermediate values.