sudoku backtracking algorithm in Scheme - recursion

I have a problem with my sudoku-solver function, it's not doing the backtracking process and i can't see why, just when the backtracking comes, the function stops, here is the code:
(define (solve-sudoku grid)
(define blank-space (check-for-empty-space 0 '()))
(cond [(empty? blank-space) (begin (display "FIN\n") true)])
(define x (first blank-space))
(define y (first (rest blank-space)))
(display x) (display y) (display "\n")
(cond [(eqv? #f (try-value grid 1 x y )) false])
)
(define (try-value grid num x y )
(cond [(> num 9) false]
[(is-safe grid num x y)
(begin
(assign-to-pos grid num x y)
(cond [(solve-sudoku grid) true]
[else (begin (display "reset\n")
(assign-to-pos grid 0 x y))]
))]
[else (try-value grid (+ 1 num) x y)])
)
I have a matrix for tests:
;---------------+-----+-----+-----+--
(define row0 (vector 3 0 6 5 0 8 4 0 0 ))
(define row1 (vector 5 2 0 0 0 0 0 0 0 ))
(define row2 (vector 0 8 7 0 0 0 0 3 1 ))
;---------------+-----+-----+-----+--
(define row3 (vector 0 0 3 0 1 0 0 8 0 ))
(define row4 (vector 9 0 0 8 6 3 0 0 5 ))
(define row5 (vector 0 5 0 0 9 0 6 0 0 ))
;---------------+-----+-----+-----+--
(define row6 (vector 1 3 0 0 0 0 2 5 0 ))
(define row7 (vector 0 0 0 0 0 0 0 7 4 ))
(define row8 (vector 0 0 5 2 0 6 3 0 0 ))
;---------------+-----+-----+-----+--
(define grid (vector row0 row1 row2 row3 row4 row5 row6 row7 row8))
The output is:
empty-position: 0,1
empty-position: 0,4
empty-position: 0,7
empty-position: 0,8
empty-position: 1,2
empty-position: 1,3
empty-position: 1,4
empty-position: 1,5
empty-position: 1,6
empty-position: 1,7
empty-position: 1,8
reset
result
'#(#(3 1 6 5 2 8 4 9 7)
#(5 2 4 1 3 7 8 0 0)
#(0 8 7 0 0 0 0 3 1)
#(0 0 3 0 1 0 0 8 0)
#(9 0 0 8 6 3 0 0 5)
#(0 5 0 0 9 0 6 0 0)
#(1 3 0 0 0 0 2 5 0)
#(0 0 0 0 0 0 0 7 4)
#(0 0 5 2 0 6 3 0 0))

Your test case is enormous, and I can see why it would be really hard to figure out what's going wrong. Rather than trying to debug the whole huge thing, test small pieces first. I can't see all of your program, but it sounds like you need to write many small tests for all of the functions in your program.

Related

Deleting rows have most of the value zero [duplicate]

This question already has an answer here:
Count number of zeros per row, and remove rows with more than n zeros
(1 answer)
Closed 3 years ago.
File-
i j k l m n
a 0 0 0 1 0 1
b 8 6 34 1 0 0
c 0 9 12 0 8 0
d 7 9 3 7 0 5
e 0 0 0 1 0 0
f 2 3 9 6 8 9
g 0 1 0 3 1 5
h 0 9 0 8 4 0
I want to delete those rows which vane value 0 in more than 3 cells.
Expected output-
i j k l m n
b 8 6 34 1 0 0
d 7 9 3 7 0 5
f 2 3 9 6 8 9
g 0 1 0 3 1 5
We can use rowSums
df[rowSums(df == 0) < 3, ]
# i j k l m n
#b 8 6 34 1 0 0
#d 7 9 3 7 0 5
#f 2 3 9 6 8 9
#g 0 1 0 3 1 5
We can also use apply and count row-wise number of 0's and then subset
df[apply(df == 0, 1, sum) < 3, ]

R: Calculate factors of a number in R

I was playing with R a little bit and I came out with this behavior that I don't understand:
num <- seq(1,20,1)
num[num %% c(1,2) == 0]
[1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
So it seems to be an analog expression of
num[num %% 1 == 0 | num %% 2 == 0]
But when I do the following gets weird:
num[num %% c(1,3) == 0]
[1] 1 3 5 6 7 9 11 12 13 15 17 18 19
num[num %% c(1,4) == 0]
[1] 1 3 4 5 7 8 9 11 12 13 15 16 17 19 20
I have been thinking about it, but I can't come out with an explanation for this. It's just out of curiosity, but if someone has a reason it would be very interesting to hear!.
Thanks!
As jogo says, it's the recycling rule.
The result of num %% 1 is
[1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
whilst the result of num %% 3 is
[1] 1 2 0 1 2 0 1 2 0 1 2 0 1 2 0 1 2 0 1 2
Looking at the result of num %% c(1,3)
[1] 0 2 0 1 0 0 0 2 0 1 0 0 0 2 0 1 0 0 0 2
The first number in the result is taken from the first number of the num %% 1 result, the second from the second number of the num %% 3 result, the third from the third in num %% 1 and so on.

Randomly assign elements repeatedly to a limited number of groups

There are N groups (aka judges, let's say 17), and M elements (let's call them cases, let's say 22) such that 3*M <= 4*N.
N <- LETTERS[1:17]
M <- 1:22
I want to assign each of the N judges 4 or fewer cases, such that each case is evaluated by no more or no fewer than 3 judges, and no judge sees the same case twice.
A : 1, 2, 19
B : 2, 3, 8, 22
...
Q : 1, 2, 12, 10
Any quick and easy way to do it in R?
Tried this so far:
df <- data.frame(ID=rep(M,3))
values <- N
df$values[sample(1:nrow(df), nrow(df), FALSE)] <- rep(values, 4)
Usually when I see "random assignment subject to constraints" questions, my mind goes to the following idea:
Select a random weight for assigning item i to category j (in this case assigning case i to judge j)
Use linear programming to identify the assignments that satisfy all constraints (<= 4 cases/judge and 3 reviews per case) with maximum weight.
This is pretty straightforward in R with a linear programming package like lpSolve, creating a binary variable x_ij that indicates whether we assign case i to judge j for every case/judge pair:
library(lpSolve)
set.seed(144)
# vars is a convenience matrix that tells us the i and j index of each variable in our model
vars <- expand.grid(i=M, j=N)
mod <- lp(direction = "max",
objective.in = rnorm(nrow(vars)),
const.mat = rbind(t(sapply(M, function(i) as.numeric(vars$i == i))),
t(sapply(N, function(j) as.numeric(vars$j == j)))),
const.dir = rep(c("=", "<="), c(length(M), length(N))),
const.rhs = rep(c(3, 4), c(length(M), length(N))),
all.bin = TRUE)
# Extract all cases assigned to each judge
sapply(N, function(j) vars$i[mod$solution > 0.999 & vars$j == j])
# $A
# [1] 2 10 15
#
# $B
# [1] 7 8 13 22
#
# $C
# [1] 2 3 7 9
# ...
By the way we've setup the weights and constraints, this can really be thought of as randomly selecting from all feasible assignments of cases to judges.
Here's what I would do:
set.seed(1)
rM = sample(M)
rN = sample(N)
tasks = rep(rM, each=3)
judges = rep(rN, length.out = length(tasks))
matches = data.frame(judges, tasks)
You can verify that your conditions hold true by tabulating:
tab = with(matches, table(judges, tasks))
max(tab) # 1
addmargins(tab)
tasks
judges 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 Sum
A 0 0 0 0 0 0 1 1 0 1 1 0 0 0 0 0 0 0 0 0 0 0 4
B 1 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0 0 1 0 4
C 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 4
D 0 0 0 0 0 0 0 0 1 0 0 1 0 0 0 0 0 0 1 1 0 0 4
E 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 1 4
F 0 0 0 0 0 0 1 1 0 0 1 0 0 0 0 0 1 0 0 0 0 0 4
G 0 0 1 1 1 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 0 0 4
H 1 0 0 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 4
I 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 0 0 1 0 0 1 0 4
J 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 1 1 0 0 4
K 1 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 4
L 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 4
M 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 3
N 0 1 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 3
O 0 0 0 0 0 0 0 1 0 1 1 0 0 0 0 0 0 0 1 0 0 0 4
P 0 0 1 1 0 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 4
Q 0 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 0 0 0 1 0 0 4
Sum 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 66
Note: Judges close together in rN will draw similar case loads.
GetJudgeCaseList <- function(CaseList, judgeList, casesAllowed, NumJudges) {
e <- new.env()
e$casesLeft <- data.frame(Judges = judgeList, itersLeft = casesAllowed)
e$judgeList = judgeList
doCase <- function(i) {
pickJudges <- function(NumJudges, judgeList) {
CurJudges <- sample(judgeList, NumJudges)
return(CurJudges)
}
case <- pickJudges(NumJudges, e$judgeList)
e$casesLeft[casesLeft$Judges%in%case, 2] <- e$casesLeft[casesLeft$Judges%in%case, 2] - 1
e$judgeList <- e$casesLeft$Judges[e$casesLeft$itersLeft!=0]
return(data.frame(Case = CaseList[i], judges = paste0(case, collapse = ", ")))
}
Cases <- do.call(rbind, lapply(1:length(CaseList), doCase))
return(Cases)
}
GetJudgeCaseList(CaseList = c(1:22), judgeList = N, casesAllowed = 4, NumJudges = 3)
Case judges
1 1 a, h, o
2 2 k, i, j
3 3 j, q, a
4 4 j, n, p
5 5 g, o, n
6 6 q, g, l
7 7 g, d, i
8 8 b, l, f
9 9 m, b, i
10 10 k, m, c
11 11 l, m, p
12 12 m, o, q
13 13 p, g, b
14 14 p, f, b
15 15 l, e, i
16 16 d, h, o
17 17 d, c, q
18 18 a, f, e
19 19 e, d, c
20 20 e, n, k
21 21 a, k, f
22 22 j, n, c

SICP stream exercise: create a stream with alternating values

I was reading SICP chapter 3 and thought of this (consider it a variation of the procedure integers that creates a stream of integers): how do you create a stream of two alternating values? For example you create this:
1 0 1 0 1 0 1 0 ...
and you can change the step to 2 (or more) and make it look like
1 1 0 0 1 1 0 0 1 1 ...
1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 ...
(define (make-alternating-values n)
(define (iter i)
(cons-stream
(if (> n 0)
1
0)
(if (= i (- 1 n))
(iter n)
(iter (- i 1)))))
(iter n))
(make-alternating-values 1)
; 1 0 1 0 1 0 1 0 ...
(make-alternating-values 2)
; 1 1 0 0 1 1 0 0 1 1 ...
(make-alternating-values 3)
; 1 1 1 0 0 0 1 1 1 0 0 0 1 1 1 ...

Using loop to make column selections using different vectors

Let's say I have 3 vectors (strings of 10):
X <- c(1,1,0,1,0, 1,1, 0, NA,NA)
H <- c(0,0,1,0,NA,1,NA,1, 1, 1 )
I <- c(0,0,0,0,0, 1,NA,NA,NA,1 )
Data.frame Y contains 10 columns and 6 rows:
1 2 3 4 5 6 7 8 9 10
0 1 0 0 1 1 1 0 1 0
1 1 1 0 1 0 1 0 0 0
0 0 0 0 1 0 0 1 0 1
1 0 1 1 0 1 1 1 0 0
0 0 0 0 0 0 1 0 0 0
1 1 0 1 0 0 0 0 1 1
I'd like to use vector X, H en I to make column selections in data.frame Y, using "1's" and "0's" in the vector as selection criterium .
So the results for vector X using the '1' as selection criterium should be:
X <- c(1,1,0,1,0, 1,1, 0, NA,NA)
1 2 4 6 7
0 1 0 1 1
1 1 0 0 1
0 0 0 0 0
1 0 1 1 1
0 0 0 0 1
1 1 1 0 0
For vector H using the '1' as selection criterium:
H <- c(0,0,1,0,NA,1,NA,1, 1, 1 )
3 6 8 9 10
0 1 0 1 0
1 0 0 0 0
0 0 1 0 1
1 1 1 0 0
0 0 0 0 0
0 0 0 1 1
For vector I using the '1' as selection criterium:
I <- c(0,0,0,0,0, 1,NA,NA,NA,1 )
6 10
1 0
0 0
0 1
1 0
0 0
0 1
For convenience and speed I'd like to use a loop. It might be something like this:
all.ones <- lapply[,function(x) x %in% 1]
In the outcome (all.ones), the result for each vector should stay separate. For example:
X 1,2,4,6,7
H 3,6,8,9,10
I 6,10
The standard way of doing this is using the %in% operator:
Y[, X %in% 1]
To do this for multiple vectors (assuming you want an AND operation):
mylist = list(X, H, I, D, E, K)
Y[, Reduce(`&`, lapply(mylist, function(x) x %in% 1))]
The problem is the NA, use which to get round it. Consider the following:
x <- c(1,0,1,NA)
x[x==1]
[1] 1 1 NA
x[which(x==1)]
[1] 1 1
How about this?
idx <- which(X==1)
Y[,idx]
EDIT: For six vectors, do
idx <- which(X==1 & H==1 & I==1 & D==1 & E==1 & K==1)
Y[,idx]
Replace & with | if you want all columns of Y where at least one of the lists has a 1.

Resources