Nonogram Solver in R

I hope to eventually build a nonogram solver in R.

An Example

Let’s represent the numbers for puzzle “1 - A” as lists of lists.

row_nums <- list(2, 2, 2, 2, 5)
col_nums <- list(5, 5, 1, 1, 1)

m <- length(row_nums)
n <- length(col_nums)

While I would like to use zeros to represent black and ones to represent white (“black is the absense of color”), the puzzle numbers refer to the black squares, so using ones as black will make the calculations much easier.

Line Search

Left-Right Solutions

A starting idea is to shove all of the black squares as far left as possible, as far right as possible, and then mark where there is black square overlap.

left_solution <- function(row_list, row_length){
  #start with first number
  this_solution <- rep(1, row_list[1])
  
  #placing white square gaps in between black blocks
  number_of_gaps <- length(row_list) - 1
  for(i in 1:number_of_gaps){
    append(this_solution, 0)
    append(this_solution, row_list[i + 1])
  }
  if(length(this_solution) < row_length){
    this_solution <- 
      append(this_solution, rep(0, row_length - (sum(row_list) + number_of_gaps)))
  }
  
  #return
  this_solution
}

right_solution <- function(row_list, row_length){
  #start with first number
  this_solution <- rep(1, row_list[1])
  
  #placing white square gaps in between black blocks
  number_of_gaps <- length(row_list) - 1
  for(i in 1:number_of_gaps){
    append(this_solution, 0)
    append(this_solution, row_list[i + 1])
  }
  if(length(this_solution) < row_length){
    this_solution <- 
      append(this_solution, 
           rep(0, row_length - (sum(row_list) + number_of_gaps)), 
           after = 0) #actually places white squares at beginning of line
  }
  
  #return
  this_solution
}

LR_search <- function(row_list, row_length){
  row_list <- unlist(row_list)
  
  left_solution(row_list, row_length) & right_solution(row_list, row_length)
}

Main Solver

canvas <- matrix( rep(NA, m*n), nrow = m, ncol = n)

for(i in 1:m){
  canvas[i,] <- canvas[i,] | LR_search(row_nums[i], n)
}

for(j in 1:n){
  canvas[,j] <- canvas[,j] | LR_search(col_nums[j], m)
}

Plotting Image

rasters?

library("raster")
plot(raster(canvas))

Puzzle 1-B

row_nums <- list(5, 2, 3, 2, 5)
col_nums <- list(5, 5, list(1,1,1), list(1,1), list(1,1))
m <- length(row_nums)
n <- length(col_nums)
canvas <- matrix( rep(NA, m*n), nrow = m, ncol = n)
for(i in 1:m){
  canvas[i,] <- canvas[i,] | LR_search(row_nums[i], n)
}
for(j in 1:n){
  canvas[,j] <- canvas[,j] | LR_search(col_nums[j], m)
}

## Warning in canvas[, j] | LR_search(col_nums[j], m): longer object length is
## not a multiple of shorter object length

## Warning in canvas[, j] | LR_search(col_nums[j], m): longer object length is
## not a multiple of shorter object length

plot(raster(canvas))

Puzzle 1-C

row_nums <- list(5, 1, 1, 1, 1)
col_nums <- list(1, 1, 5, 1, 1)
m <- length(row_nums)
n <- length(col_nums)
canvas <- matrix( rep(NA, m*n), nrow = m, ncol = n)
for(i in 1:m){
  canvas[i,] <- canvas[i,] | LR_search(row_nums[i], n)
}
for(j in 1:n){
  canvas[,j] <- canvas[,j] | LR_search(col_nums[j], m)
}
plot(raster(canvas))

Puzzle 1-D

row_nums <- list(4, 2, 5, 2, 4)
col_nums <- list(list(2,1), list(3,1), list(1,1,1), list(1,3), list(1,2))
m <- length(row_nums)
n <- length(col_nums)
canvas <- matrix( rep(NA, m*n), nrow = m, ncol = n)
for(i in 1:m){
  canvas[i,] <- canvas[i,] | LR_search(row_nums[i], n)
}
for(j in 1:n){
  canvas[,j] <- canvas[,j] | LR_search(col_nums[j], m)
}

## Warning in canvas[, j] | LR_search(col_nums[j], m): longer object length is
## not a multiple of shorter object length

## Warning in canvas[, j] | LR_search(col_nums[j], m): longer object length is
## not a multiple of shorter object length

## Warning in canvas[, j] | LR_search(col_nums[j], m): longer object length is
## not a multiple of shorter object length

plot(raster(canvas))