Nonoblock: Difference between revisions

This implementation does not "error" on the impossible case.

Knowing that there are no solutions (empty result list) is good enough.

Also, the blocks are not identified. I suppose they could be easily enough, but in the nonogram task, these patterns are converted to bit-fields shortly after the nonoblock generation, and bits have no names (sad, but true).

<lang racket>#lang racket

(require racket/trace)

(define add1-to-car (match-lambda [(cons (app add1 p1) t) (cons p1 t)]))

;; inputs:

;; cells -- available cells

;; blocks -- list of block widths

;; output:

;; gap-block+gaps

;; where gap-block+gaps is:

;; (list gap) -- a single gap

;; (list gap block-width gap-block+gaps) -- padding to left, a block, right hand side

(define (nonoblock cells blocks)

(match* ((- cells (apply + (length blocks) -1 blocks)) #| padding available on both sides |# blocks)

[(_ (list)) (list (list cells))] ; generates an empty list of padding

[((? negative?) _) null] ; impossible to satisfy

[((and avp

;; use add1 with in-range because we actually want from 0 to available-padding

;; without add1, in-range iterates from 0 to (available-padding - 1)

(app add1 avp+1))

(list block))

(for/list ((l-pad (in-range 0 avp+1)))

(define r-pad (- avp l-pad)) ; what remains goes to right

(list l-pad block r-pad))]

[((app add1 avp+1) (list block more-blocks ...))

(for*/list ((l-pad (in-range 0 avp+1))

(cells-- (in-value (- cells block l-pad 1)))

(r-blocks (in-value (nonoblock cells-- more-blocks)))

(r-block (in-list r-blocks)))

(list* l-pad block (add1-to-car r-block)))])) ; put a single space pad on left of r-block

(define (neat rslt)

(define dots (curryr make-string #\.))

(define Xes (curryr make-string #\X))

(define inr

(match-lambda

[(list 0 (app Xes b) t ...)

(string-append b (inr t))]

[(list (app dots p) (app Xes b) t ...)

(string-append p b (inr t))]

[(list (app dots p)) p]))

(define (neat-row r)

(string-append "|" (inr r) "|"))

(string-join (map neat-row rslt) "\n"))

(define (tst c b)

(define rslt (nonoblock c b))

(define rslt-l (length rslt))

(printf "~a cells, ~a blocks => ~a~%~a~%" c b

(match rslt-l

[0 "impossible"]

[1 "1 solution"]

[(app (curry format "~a solutions") r) r])

(neat rslt)))

(module+ test

(tst 5 '[2 1])

(tst 5 '[])

(tst 10 '[8])

(tst 15 '[2 3 2 3])

(tst 5 '[2 3]))</lang>

{{out}}

<pre>5 cells, (2 1) blocks => 3 solutions

|XX.X.|

|XX..X|

|.XX.X|

5 cells, () blocks => 1 solution

|.....|

10 cells, (8) blocks => 3 solutions

|XXXXXXXX..|

|.XXXXXXXX.|

|..XXXXXXXX|

15 cells, (2 3 2 3) blocks => 15 solutions

|XX.XXX.XX.XXX..|

|XX.XXX.XX..XXX.|

|XX.XXX.XX...XXX|

|XX.XXX..XX.XXX.|

|XX.XXX..XX..XXX|

|XX.XXX...XX.XXX|

|XX..XXX.XX.XXX.|

|XX..XXX.XX..XXX|

|XX..XXX..XX.XXX|

|XX...XXX.XX.XXX|

|.XX.XXX.XX.XXX.|

|.XX.XXX.XX..XXX|

|.XX.XXX..XX.XXX|

|.XX..XXX.XX.XXX|

|..XX.XXX.XX.XXX|

5 cells, (2 3) blocks => impossible

</pre>