I'm arduously struggling my way through the N-queens problem in SICP (the book; I spent a few days on it -- last question here: Solving Eight-queens in scheme). Here is what I have for the helper functions:
#lang sicp
; the SICP language in Racket already defines this:
; (define nil '()
; boilerplate: filter function and range functions
(define (filter func lst)
(cond
((null? lst)
nil)
(else
(if (func (car lst))
(cons (car lst) (filter func (cdr lst)))
(filter func (cdr lst))))))
(define (range a b)
(if (> a b)
nil
(cons a (range (+ 1 a) b))))
; Selectors/handlers to avoid confusion on the (col, row) notation:
; representing it a position as (col, row), using 1-based indexing
(define (make-position col row) (cons col (list row)))
(define (col p) (car p))
(define (row p) (cadr p))
; adding a new position to a board
(define (add-new-position existing-positions p)
(append existing-positions
(list (make-position (col p) (row p)))))
; The 'safe' function
(define (any? l proc)
(cond ((null? l) #f)
((proc (car l)) #t)
(else (any? (cdr l) proc))))
(define (none? l proc) (not (any? l proc)))
(define (safe? existing-positions p)
(let ((bool (lambda (x) x)) (r (row p)) (c (col p)))
(and
; is the row safe? i.e., no other queen occupies that row?
(none? (map (lambda (p) (= (row p) r)) existing-positions)
bool)
; safe from the diagonal going up
(none? (map (lambda (p) (= r (+ (row p) (- c (col p)))))
existing-positions)
bool)
; safe from the diagonal going down
(none? (map (lambda (p) (= r (- (row p) (- c (col p)))))
existing-positions)
bool))))
And now, with that boilerplate, the actual/monstrous first working version I have of the queens problem:
(define (positions-for-col col size)
(map (lambda (ri) (make-position col ri))
(range 1 size)))
(define (queens board-size)
(define possible-positions '())
(define safe-positions '())
(define all-new-position-lists '())
(define all-positions-list '())
; existing-positions is a LIST of pairs
(define (queen-cols col existing-positions)
(if (> col board-size)
(begin
(set! all-positions-list
(append all-positions-list (list existing-positions))))
(begin
; for the column, generate all possible positions,
; for example (3 1) (3 2) (3 3) ...
(set! possible-positions (positions-for-col col board-size))
; (display "Possible positions: ") (display possible-positions) (newline)
; filter out the positions that are not safe from existing queens
(set! safe-positions
(filter (lambda (pos) (safe? existing-positions pos))
possible-positions))
; (display "Safe positions: ") (display safe-positions) (newline)
(if (null? safe-positions)
; bail if we don't have any safe positions
'()
; otherwise, build a list of positions for each safe possibility
; and recursively call the function for the next column
(begin
(set! all-new-position-lists
(map (lambda (pos)
(add-new-position existing-positions pos))
safe-positions))
; (display "All positions lists: ") (display all-new-position-lists) (newline)
; call itself for the next column
(map (lambda (positions-list) (queen-cols (+ 1 col)
positions-list))
all-new-position-lists))))))
(queen-cols 1 '())
all-positions-list)
(queens 5)
(((1 1) (2 3) (3 5) (4 2) (5 4))
((1 1) (2 4) (3 2) (4 5) (5 3))
((1 2) (2 4) (3 1) (4 3) (5 5))
((1 2) (2 5) (3 3) (4 1) (5 4))
((1 3) (2 1) (3 4) (4 2) (5 5))
To be honest, I think I did all the set!s so that I could more easily debug things (is that common?) How could I remove the various set!s to make this a proper functional-procedure?
As an update, the most 'terse' I was able to get it is as follows, though it still appends to a list to build the positions:
(define (queens board-size)
(define all-positions-list '())
(define (queen-cols col existing-positions)
(if (> col board-size)
(begin
(set! all-positions-list
(append all-positions-list
(list existing-positions))))
(map (lambda (positions-list)
(queen-cols (+ 1 col) positions-list))
(map (lambda (pos)
(add-new-position existing-positions pos))
(filter (lambda (pos)
(safe? existing-positions pos))
(positions-for-col col board-size))))))
(queen-cols 1 nil)
all-positions-list)
Finally, I think here is the best I can do, making utilization of a 'flatmap' function that helps deal with nested lists:
; flatmap to help with reduction
(define (reduce function sequence initializer)
(let ((elem (if (null? sequence) nil (car sequence)))
(rest (if (null? sequence) nil (cdr sequence))))
(if (null? sequence)
initializer
(function elem
(reduce function rest initializer)))))
(define (flatmap proc seq)
(reduce append (map proc seq) nil))
; actual
(define (queens board-size)
(define (queen-cols col existing-positions)
(if (> col board-size)
(list existing-positions)
(flatmap
(lambda (positions-list)
(queen-cols (+ 1 col) positions-list))
(map
(lambda (pos)
(add-new-position existing-positions
pos))
(filter
(lambda (pos)
(safe? existing-positions pos))
(positions-for-col col board-size))))))
(queen-cols 1 nil))
Are there any advantages of this function over the one using set! or is it more a matter of preference (I find the set! one easier to read and debug).
When you are doing the SICP problems, it would be most beneficial if you strive to adhere to the spirit of the question. You can determine the spirit from the context: the topics covered till the point you are in the book, any helper code given, the terminology used etc. Specifically, avoid using parts of the scheme language that have not yet been introduced; the focus is not on whether you can solve the problem, it is on how you solve it. If you have been provided helper code, try to use it to the extent you can.
SICP has a way of building complexity; it does not introduce a concept unless it has presented enough motivation and justification for it. The underlying theme of the book is simplification through abstraction, and in this particular section you are introduced to various higher order procedures -- abstractions like accumulate, map, filter, flatmap which operate on sequences/lists, to make your code more structured, compact and ultimately easier to reason about.
As illustrated in the opening of this section, you could very well avoid the use of such higher programming constructs and still have programs that run fine, but their (liberal) use results in more structured, readable, top-down style code. It draws parallels from the design of signal processing systems, and shows how we can take inspiration from it to add structure to our code: using procedures like map, filter etc. compartmentalize our code's logic, not only making it look more hygienic but also more comprehensible.
If you prematurely use techniques which don't come until later in the book, you will be missing out on many key learnings which the authors intend for you from the present section. You need to shed the urge to think in an imperative way. Using set! is not a good way to do things in scheme, until it is. SICP forces you down a 'difficult' path by making you think in a functional manner for a reason -- it is for making your thinking (and code) elegant and 'clean'.
Just imagine how much more difficult it would be to reason about code which generates a tree recursive process, wherein each (child) function call is mutating the parameters of the function. Also, as I mentioned in the comments, assignment places additional burden upon the programmers (and on those who read their code) by making the order of the expressions have a bearing on the results of the computation, so it is harder to verify that the code does what is intended.
Edit: I just wanted to add a couple of points which I feel would add a bit more insight:
Your code using set! is not wrong (or even very inelegant), it is just that in doing so, you are being very explicit in telling what you are doing. Iteration also reduces the elegance a bit in addition to being bottom up -- it is generally harder to think bottom up.
I feel that teaching to do things recursively where possible is one of the aims of the book. You will find that recursion is a crucial technique, the use of which is inevitable throughout the book. For instance, in chapter 4, you will be writing evaluators (interpreters) where the authors evaluate the expressions recursively. Even much earlier, in section 2.3, there is the symbolic differentiation problem which is also an exercise in recursive evaluation of expressions. So even though you solved the problem imperatively (using set!, begin) and bottom-up iteration the first time, it is not the right way, as far as the problem statement is concerned.
Having said all this, here is my code for this problem (for all the structure and readability imparted by FP, comments are still indispensable):
; the board is a list of lists - a physical n x n board, where
; empty positions are 0 and filled positions are 1
(define (queens board-size)
(let ((empty-board (empty-board-gen board-size))) ; minor modification - making empty-board available to queen-cols
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter (lambda (positions) (safe? k positions))
; the flatmap below generates a list of new positions
; by 'adjoining position'- adding 'board-size' number
; of new positions for each of the positions obtained
; recursively from (queen-cols (- k 1)), which have
; been found to be safe till column k-1. This new
; set (list) of positions is then filtered using the
; safe? function to filter out unsafe positions
(flatmap
(lambda (rest-of-queens)
; the map below adds 'board-size' number of new
; positions to 'rest-of-queens', which is an
; element of (queen-cols (- k 1))
(map (lambda (new-row)
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size)) ; end of let block
)
; add a column having a queen placed at position (new-row, col).
(define (adjoin-position new-row col rest-queens)
(let ((board-dim (length rest-queens))) ;length of board
; first create a zero 'vector', put a queen in it at position
; 'new-row', then put (replace) this new vector/column at the
; 'col' position in rest-queens
(replace-elem (replace-elem 1 new-row (gen-zero-vector board-dim)) col rest-queens)))
(define (safe? k positions) ; the safe function
(let ((row-pos-k (non-zero-index (item-at-index k positions)))) ; get the row of the queen in column k
(define (iter-check col rem) ;iteratively check if column 'col' of the board is safe wrt the kth column
(let ((rw-col (non-zero-index (car rem)))) ; get the row of 'col' in which a queen is placed
(cond ((= k 1) #t); 1x1 board is always safe
((= col k) #t); if we reached the kth column, we are done
; some simple coordinate geometry
; checks if the row of the queen in col and kth
; column is same, and also checks if the 'slope' of
; the line connecting the queens of the two columns
; is 1 (i.e. if it's a diagonal), if either is true,
; the kth queen is not safe
((or (= row-pos-k rw-col) (= (- k col) (abs (- row-pos-k rw-col)))) #f)
(else (iter-check (+ col 1) (cdr rem)))))) ; check the next column
(iter-check 1 positions))) ; start checking from the first column
; helper functions follow
(define (item-at-index n items) ; given a list, return the nth element
(define (iter idx rem)
(if (= idx n)
(car rem)
(iter (+ idx 1) (cdr rem))))
(iter 1 items))
(define (non-zero-index items)
; gives the first non-zero element from items - used for
; determining the row at which a queen is placed
(define (iter a rem)
(if (> (car rem) 0)
a
(iter (+ a 1) (cdr rem))))
(iter 1 items))
(define (empty-board-gen n) ; the empty board is n lists, each list with n zeros
(map (lambda (x) (map (lambda (y) 0) (enumerate-interval 1 n))) (enumerate-interval 1 n)))
(define (replace-elem new-elem pos items) ; replace item at position pos in items by new-elem, ultimately used for replacing an empty column with a column which has a queen
(define (iter i res rem)
(if (= i pos)
(append res (list new-elem) (cdr rem))
(iter (+ i 1) (append res (list(car rem))) (cdr rem)))) (iter 1 '() items))
(define (gen-zero-vector n) ; generate a list of length n with only zeros as elements
(define (iter a res)
(if (> a n)
res
(iter (+ a 1) (append res (list 0))))) (iter 1 '()))
(define (flatmap proc seq)
(accumulate append '() (map proc seq)))
(define (length items) ; not particularly efficient way for length of a list
(accumulate + 0 (map (lambda (x) 1) items)))
(define (accumulate op null-value seq)
(if (null? seq)
null-value
(op (car seq) (accumulate op null-value (cdr seq)))))
(define (enumerate-interval low high) ; a list of integers from low to hi
(define (iter a b res)
(if (> a b)
res
(iter (+ a 1) b (append res (cons a '())))))
(iter low high '()))
There are many ways to tackle this problem. I'll attempt to write a short and concise solution using Racket-specific procedures, explaining each step of the way. A solution using only the Scheme procedures explained in SICP is also possible, but it'll be more verbose and I'd argue, more difficult to understand.
My aim is to write a functional-programming style solution reusing as many built-in procedures as possible, and avoiding mutation at all costs - this is the style that SICP encourages you to learn. I'll deviate from the template solution in SICP if I think we can get a clearer solution by reusing existing Racket procedures (it follows then, that this code must be executed using the #lang racket language), but I've provided another answer that fits exactly exercise 2.42 in the book, implemented in standard Scheme and compatible with #lang sicp.
First things first. Let's agree on how are we going to represent the board - this is a key point, the way we represent our data will have a big influence on how easy (or hard) is to implement our solution. I'll use a simple representation, with only the minimum necessary information.
Let's say a "board" is a list of row indexes. My origin of coordinates is the position (0, 0), on the top-left corner of the board. For the purpose of this exercise we only need to keep track of the row a queen is in, the column is implicitly represented by its index in the list and there can only be one queen per column. Using my representation, the list '(2 0 3 1) encodes the following board, notice how the queens' position is uniquely represented by its row number and its index:
0 1 2 3
0 . Q . .
1 . . . Q
2 Q . . .
3 . . Q .
Next, let's see how are we going to check if a new queen added at the end of the board is "safe" with respect to the previously existing queens. For this, we need to check if there are any other queens in the same row, or if there are queens in the diagonal lines starting from the new queen's position. We don't need to check for queens in the same column, we're trying to set a single new queen and there aren't any others in this row. Let's split this task in multiple procedures.
; main procedure for checking if a queen in the given
; column is "safe" in the board; there are no more
; queens to the "right" or in the same column
(define (safe? col board)
; we're only interested in the queen's row for the given column
(let ([row (list-ref board (sub1 col))])
; the queen must be safe on the row and on the diagonals
(and (safe-row? row board)
(safe-diagonals? row board))))
; check if there are any other queens in the same row,
; do this by counting how many times `row` appears in `board`
(define (safe-row? row board)
; only the queen we want to add can be in this row
; `curry` is a shorthand for writing a lambda that
; compares `row` to each element in `board`
(= (count (curry equal? row) board) 1))
; check if there are any other queens in either the "upper"
; or the "lower" diagonals starting from the current queen's
; position and going to the "left" of it
(define (safe-diagonals? row board)
; we want to traverse the row list from right-to-left so we
; reverse it, and remove the current queen from it; upper and
; lower positions are calculated starting from the current queen
(let loop ([lst (rest (reverse board))]
[upper (sub1 row)]
[lower (add1 row)])
; the queen is safe after checking all the list
(or (null? lst)
; the queen is not safe if we find another queen in
; the same row, either on the upper or lower diagonal
(and (not (= (first lst) upper))
(not (= (first lst) lower))
; check the next position, updating upper and lower
(loop (rest lst) (sub1 upper) (add1 lower))))))
Some optimizations could be done, for example stopping early if there's more than one queen in the same row or stopping when the diagonals' rows fall outside of the board, but they'll make the code harder to understand and I'll leave them as an exercise for the reader.
In the book they suggest we use an adjoin-position procedure that receives both row and column parameters; with my representation we only need the row so I'm renaming it to add-queen, it simply adds a new queen at the end of a board:
; add a new queen's row to the end of the board
(define (add-queen queen-row board)
(append board (list queen-row)))
Now for the fun part. With all of the above procedures in place, we need to try out different combinations of queens and filter out those that are not safe. We'll use higher-order procedures and recursion for implementing this backtracking solution, there's no need to use set! at all as long as we're in the right mindset.
This will be easier to understand if you read if from the "inside out", try to grok what the inner parts do before going to the outer parts, and always remember that we're unwinding our way in a recursive process: the first case that will get executed is when we have an empty board, the next case is when we have a board with only one queen in position and so on, until we finally have a full board.
; main procedure: returns a list of all safe boards of the given
; size using our previously defined board representation
(define (queens board-size)
; we need two values to perform our computation:
; `queen-col`: current row of the queen we're attempting to set
; `board-size`: the full size of the board we're trying to fill
; I implemented this with a named let instead of the book's
; `queen-cols` nested procedure
(let loop ([queen-col board-size])
; if there are no more columns to try exit the recursion
(if (zero? queen-col)
; base case: return a list with an empty list as its only
; element; remember that the output is a list of lists
; the book's `empty-board` is just the empty list '()
(list '())
; we'll generate queen combinations below, but only the
; safe ones will survive for the next recursive call
(filter (λ (board) (safe? queen-col board))
; append-map will flatten the results as we go, we want
; a list of lists, not a list of lists of lists of...
; this is equivalent to the book's flatmap implementation
(append-map
(λ (previous-boards)
(map (λ (new-queen-row)
; add a new queen row to each one of
; the previous valid boards we found
(add-queen new-queen-row previous-boards))
; generate all possible queen row values for this
; board size, this is similar to the book's
; `enumerate-interval` but starting from zero
(range board-size)))
; advance the recursion, try a smaller column
; position, as the recursion unwinds this will
; return only previous valid boards
(loop (sub1 queen-col)))))))
And that's all there is to it! I'll provide a couple of printing procedures (useful for testing) which should be self-explanatory; they take my compact board representation and print it in a more readable way. Queens are represented by 'o and empty spaces by 'x:
(define (print-board board)
(for-each (λ (row) (printf "~a~n" row))
(map (λ (row)
(map (λ (col) (if (= row col) 'o 'x))
board))
(range (length board)))))
(define (print-all-boards boards)
(for-each (λ (board) (print-board board) (newline))
boards))
We can verify that things work and that the number of solutions for the 8-queens problem is as expected:
(length (queens 8))
=> 92
(print-all-boards (queens 4))
(x x o x)
(o x x x)
(x x x o)
(x o x x)
(x o x x)
(x x x o)
(o x x x)
(x x o x)
As a bonus, here's another solution that works with the exact definition of queens as provided in the SICP book. I won't go into details because it uses the same board representation (except that here the indexes start in 1 not in 0) and safe? implementation of my previous answer, and the explanation for the queens procedure is essentially the same. I did some minor changes to favor standard Scheme procedures, so hopefully it'll be more portable.
#lang racket
; redefine procedures already explained in the book with
; Racket equivalents, delete them and use your own
; implementation to be able to run this under #lang sicp
(define flatmap append-map)
(define (enumerate-interval start end)
(range start (+ end 1)))
; new definitions required for this exercise
(define empty-board '())
(define (adjoin-position row col board)
; `col` is unused
(append board (list row)))
; same `safe?` implementation as before
(define (safe? col board)
(let ((row (list-ref board (- col 1))))
(and (safe-row? row board)
(safe-diagonals? row board))))
(define (safe-row? row board)
; reimplemented to use standard Scheme procedures
(= (length (filter (lambda (r) (equal? r row)) board)) 1))
(define (safe-diagonals? row board)
(let loop ((lst (cdr (reverse board)))
(upper (- row 1))
(lower (+ row 1)))
(or (null? lst)
(and (not (= (car lst) upper))
(not (= (car lst) lower))
(loop (cdr lst) (- upper 1) (+ lower 1))))))
; exact same implementation of `queens` as in the book
(define (queens board-size)
(define (queen-cols k)
(if (= k 0)
(list empty-board)
(filter
(lambda (positions) (safe? k positions))
(flatmap
(lambda (rest-of-queens)
(map (lambda (new-row)
(adjoin-position new-row k rest-of-queens))
(enumerate-interval 1 board-size)))
(queen-cols (- k 1))))))
(queen-cols board-size))
; debugging
(define (print-board board)
(for-each (lambda (row) (display row) (newline))
(map (lambda (row)
(map (lambda (col) (if (= row col) 'o 'x))
board))
(enumerate-interval 1 (length board)))))
(define (print-all-boards boards)
(for-each (lambda (board) (print-board board) (newline))
boards))
The above code is more in spirit with the original exercise, which asked you to implement just three definitions: empty-board, adjoin-position and safe?, thus this was more of a question about data representation. Unsurprisingly, the results are the same:
(length (queens 8))
=> 92
(print-all-boards (queens 4))
(x x o x)
(o x x x)
(x x x o)
(x o x x)
(x o x x)
(x x x o)
(o x x x)
(x x o x)
I am trying to create Pascal's Triangle using recursion. My code is:
(define (pascal n)
(cond
( (= n 1)
list '(1))
(else (append (list (pascal (- n 1))) (list(add '1 (coresublist (last (pascal (- n 1))))))
)))) ;appends the list from pascal n-1 to the new generated list
(define (add s lst) ;adds 1 to the beginning and end of the list
(append (list s) lst (list s))
)
(define (coresublist lst) ;adds the subsequent numbers, takes in n-1 list
(cond ((= (length lst) 1) empty)
(else
(cons (+ (first lst) (second lst)) (coresublist (cdr lst)))
)))
When I try to run it with:
(display(pascal 3))
I am getting an error that says:
length: contract violation
expected: list?
given: 1
I am looking for someone to help me fix this code (not write me entirely new code that does Pascal's Triangle). Thanks in advance! The output for pascal 3 should be:
(1) (1 1) (1 2 1)
We should start with the recursive definition for a value inside Pascals' triangle, which is usually expressed in terms of two parameters (row and column):
(define (pascal x y)
(if (or (zero? y) (= x y))
1
(+ (pascal (sub1 x) y)
(pascal (sub1 x) (sub1 y)))))
There are more efficient ways to implement it (see Wikipedia), but it will work fine for small values. After that, we just have to build the sublists. In Racket, this is straightforward using iterations, but feel free to implement it with explicit recursion if you wish:
(define (pascal-triangle n)
(for/list ([x (in-range 0 n)])
(for/list ([y (in-range 0 (add1 x))])
(pascal x y))))
It'll work as expected:
(pascal-triangle 3)
=> '((1) (1 1) (1 2 1))
I have a homework problem which is really messing with me right now, and I could use some help in how to implement it in DrRacket. I do not wish for code, just guidance, as I am very new to DrRacket.
The assignment is to implement this phrase:
"If n = 0, return the empty tiling (list of tile structs). Otherwise, place a tromino (L-shaped domino) in the center of the chessboard so that it covers the three quadrants of the chessboard that have no missing tile in them, and tile each of the quadrants."
as recursive code using the two .rkt files given. We are permitted to use any of the functions found within tromino.rkt.
We are also told that the following functions will be necessary to write our code, and so I have included a description of what each does:
(center-tile n row column)
This function produces a single tile structure that represents a properly oriented tromino placed at the center of a 2n × 2n chessboard when the chessboard has its missing tile in the specified row and column. Remember that rows and columns are numbered starting at zero. This function does quite a bit of work for you: It figures out which quadrant the missing cell is in, determines the proper orientation of the tromino to be placed at the center of the board so that that quadrant is not covered, and returns a tile structure that represents that tromino in the proper position on the board.
(missing-cell-within-quadrant n row column quadrant-row quadrant-column)
The 2n × 2n chessboard is divided into four quadrants that are indexed just as the rows and columns are. Specifically, the upper-left quadrant corresponds to
(quadrant-row, quadrant-column) set to (0, 0). The other quadrants are (0, 1) for upper right, (1, 0) for lower-left, and (1, 1) for lower-right. The function missing-cell-within-quadrant answers the following question:
What are the (row, column) coordinates within quadrant (quadrant-row, quadrant-column) of the missing or covered cell within that quadrant, after the tile produced by center-tile has been placed?
The answer is in the form of a list with two coordinates, expressed in the frame of reference of each quadrant. For instance if the missing cell in a 23 × 23 board is at row 2, column 5, then after placement of the center tile the four calls
(missing-cell-within-quadrant 3 2 5 0 0)
(missing-cell-within-quadrant 3 2 5 0 1)
(missing-cell-within-quadrant 3 2 5 1 0)
(missing-cell-within-quadrant 3 2 5 1 1)
return the following four lists, respectively:
'(3 3)
'(2 1)
'(0 3)
'(0 0)
(upgrade-tiling tiling m quadrant-row quadrant-column)
Given a tiling — that is, a list of tromino tiles — of one of the four 2m × 2m quadrants of a 2n × 2n chessboard, where m = n−1, this function transforms all the tiles in the tiling so that their coordinates refer to the full chessboard.
You are given a file, tromino.rkt, which is as follows
#lang racket
(require racket/draw)
(define thickness 6)
(define offset (floor (/ thickness 2)))
(define one 100)
(define two (* 2 one))
(define a 0)
(define b one)
(define c (- two thickness))
(define (mirror coordinates)
(map (lambda (z) (- one z thickness)) coordinates))
(define x-00 (list c c a a b b))
(define y-00 (list a c c b b a))
(define x-01 (mirror x-00))
(define y-01 y-00)
(define x-10 x-00)
(define y-10 (mirror y-00))
(define x-11 x-01)
(define y-11 y-10)
(define (make-tromino-path x y)
(let ((p (new dc-path%)))
(send p move-to (first x) (first y))
(send p line-to (second x) (second y))
(send p line-to (third x) (third y))
(send p line-to (fourth x) (fourth y))
(send p line-to (fifth x) (fifth y))
(send p line-to (sixth x) (sixth y))
(send p close)
p))
(define tromino-path-00 (make-tromino-path x-00 y-00))
(define tromino-path-01 (make-tromino-path x-01 y-01))
(define tromino-path-10 (make-tromino-path x-10 y-10))
(define tromino-path-11 (make-tromino-path x-11 y-11))
(define (tromino-path missing-row missing-column)
(cond ((and (= missing-row 0) (= missing-column 0)) tromino-path-00)
((and (= missing-row 0) (= missing-column 1)) tromino-path-01)
((and (= missing-row 1) (= missing-column 0)) tromino-path-10)
((and (= missing-row 1) (= missing-column 1)) tromino-path-11)
(else (error 'tromino-path "Called with arguments ~a, ~a (must each be either 0 or 1)"
missing-row missing-column))))
(define (draw-board n dc)
(cond ((= n 1)
(begin
(send dc set-smoothing 'unsmoothed)
(send dc set-pen "white" 0 'solid)
(send dc set-brush "white" 'solid)
(send dc draw-rectangle 0 0 two two)
(send dc set-pen "black" 0 'solid)
(send dc set-brush "black" 'solid)
(send dc draw-rectangle 0 0 one one)
(send dc draw-rectangle one one one one)))
(else
(begin
(draw-board (- n 1) dc)
(let ((side (* one (expt 2 (- n 1)))))
(send dc copy 0 0 side side side 0)
(send dc copy 0 0 (* 2 side) side 0 side))))))
(struct tile (row column missing-cell-row missing-cell-column))
(define (show-tile t)
(printf "(row ~a column ~a missing-cell-row ~a missing-cell-column ~a)\n"
(tile-row t) (tile-column t)
(tile-missing-cell-row t) (tile-missing-cell-column t)))
(define (quadrant n row column)
(let ((half (lambda (n coordinate)
(cond ((bitwise-bit-set? coordinate (- n 1)) 1)
(else 0)))))
(list (half n row) (half n column))))
(define (center-tile n row column)
(let ((q (quadrant n row column))
(base (- (expt 2 (- n 1)) 1)))
(tile (+ base (first q)) (+ base (second q)) (first q) (second q))))
(define (missing-cell-within-quadrant n row column quadrant-row quadrant-column)
(let ((q (quadrant n row column))
(base (- (expt 2 (- n 1)) 1))
(sub-coordinate (lambda (coord quad)
(cond ((= quad 1) (- coord (expt 2 (- n 1))))
(else coord)))))
(cond ((and (= (first q) quadrant-row) (= (second q) quadrant-column))
(list (sub-coordinate row (first q))
(sub-coordinate column (second q))))
(else (list (cond ((= 0 quadrant-row) base)
(else 0))
(cond ((= 0 quadrant-column) base)
(else 0)))))))
(define (upgrade-tiling tiling m quadrant-row quadrant-column)
(let* ((shift (expt 2 m))
(row-shift (* quadrant-row shift))
(column-shift (* quadrant-column shift)))
(map (lambda (t)
(tile (+ (tile-row t) row-shift)
(+ (tile-column t) column-shift)
(tile-missing-cell-row t)
(tile-missing-cell-column t)))
tiling)))
(define (make-tiling-png n tiles basename)
(cond ((or (<= n 0) (empty? tiles))
(printf "Warning: make-tiling-png called with n too small or an empty tiling. No picture produced\n"))
(else
(begin
(define side (* (expt 2 n) one))
(define bmap (make-bitmap side side))
(define dc (new bitmap-dc% (bitmap bmap)))
(draw-board n dc)
(send dc set-pen "black" 1 'solid)
(send dc set-brush "white" 'transparent)
(send dc draw-rectangle 0 0 side side)
(send dc set-pen (new pen% (color "red") (width thickness)
(style 'solid) (cap 'projecting) (join 'miter)))
(send dc set-brush "gray" 'solid)
(send dc set-smoothing 'unsmoothed)
(map (lambda (t) (send dc draw-path (tromino-path (tile-missing-cell-row t)
(tile-missing-cell-column t))
(+ offset (* one (tile-column t)))
(+ offset (* one (tile-row t)))))
tiles)
(send bmap save-file (string-append basename ".png") 'png)))))
(provide tile
tile-row
tile-column
tile-missing-cell-row
tile-missing-cell-column
show-tile
quadrant
center-tile
missing-cell-within-quadrant
upgrade-tiling
make-tiling-png)
You are also given a file, template.rkt, which is as follows:
#lang racket
(require "./tromino.rkt")
(define test-tiling (list (tile 2 5 0 1)))
(make-tiling-png 3 test-tiling "test-tiling")
**; Your code replaces the null in the following definition**
(define (tile-board n row column)
null)
(define (make-and-show-tiling n row column)
(make-tiling-png n
(tile-board n row column)
(format "tiling-~a-~a-~a" n row column)))
; Initially, these calls will produce no picture
; because tile-board returns an empty tiling
(make-and-show-tiling 1 1 1)
(make-and-show-tiling 2 0 0)
(make-and-show-tiling 3 5 2)
(make-and-show-tiling 3 6 2)
(make-and-show-tiling 4 5 10)
(make-and-show-tiling 5 24 21)
I have a very good idea of the concept behind how this works, whereby you split the 2n × 2n chessboard into 4 separate quadrants, and then place a tromino at the center of the chessboard such that every quadrant now has either one missing cell or one cell that is covered by part of the tromino. Then, call the recursive function to tile each quadrant. The end goal is to have the code run such that each call of (make-and-show-tiling) function at the end of my template.rkt file will produce a picture of the chessboard produced.
I think I am just getting super confused because I have only learnt Java and Python before this, and the format/syntax of DrRacket is so far removed from those languages. I am completely stuck so any help other than actually writing the code for me would be incredibly welcome and gratefully accepted.
Thank you in advance!!
I'm trying to solve the n-queens problem in scheme. I was told by my professor to use a single vector as the chess board where the ith element of the vector represents the ith column of the board. The value of that element is the row on which sits a queen, or -1 if the column is empty. So, [0 1 2 -1 -1] has two columns with no queen and three queens placed illegally.
When I run this code: (place-n-queens 0 4 #(-1 -1 -1 -1)) I get #(0 1 2 3) which obviously has all four queens placed illegally. I think the issue is that I don't check enough things in the cond in place-queen-on-n but I'm not sure what to add to solve the issue of getting queens on the same diagonal.
(define (return-row vector queen)
(vector-ref vector (return-col vector queen)))
(define (return-col vector queen)
(remainder queen (vector-length vector)))
(define (checkrow vector nq oq)
(cond
((= (vector-ref vector nq) -1) #f)
((= (vector-ref vector oq) -1) #f)
(else (= (return-row vector nq) (return-row vector oq)))))
(define (checkcol vector nq oq)
(= (return-col vector nq) (return-col vector oq)))
(define (checkdiagonal vector nq oq)
(cond
((= (vector-ref vector nq) -1) #f)
((= (vector-ref vector oq) -1) #f)
(else (= (abs (- (return-row vector nq) (return-row vector oq)))
(abs (- (return-col vector nq) (return-col vector oq)))))))
(define (checkdiagonalagain vector r c oq)
(= (abs (- r (return-row vector oq)))
(abs (- c (return-col vector oq)))) )
(define (checkrowagain vector r oq)
(= r (return-row vector oq)))
(define (checkinterference vector nq oq)
(or (checkrow vector nq oq) (checkcol vector nq oq) (checkdiagonal vector nq oq)))
(define (place-queen-on-n vector r c)
(local ((define (foo x)
(cond
((checkrowagain vector r x) -1)
((= c x) r)
((checkinterference vector c x) -1)
((map (lambda (y) (eq? (vector-ref vector x) y))
(build-list (vector-length vector) values)) (vector-ref vector x))
((eq? (vector-ref vector x) -1) -1)
(else -1))))
(build-vector (vector-length vector) foo)))
(define (place-a-queen vector)
(local ((define (place-queen collist rowlist)
(cond
((empty? collist) '())
((empty? rowlist) '())
(else (append (map (lambda (x) (place-queen-on-n vector x (car collist))) rowlist)
(try vector (cdr collist) rowlist)))
)))
(place-queen (get-possible-col vector) (get-possible-row (vector->list vector) vector))))
(define (try vector collist rowlist)
(cond
((empty? collist) '())
((empty? rowlist) '())
(else (append (map (lambda (x) (place-queen-on-n vector x (car collist))) rowlist)
(try vector (cdr collist) rowlist)))))
(define (get-possible-col vector)
(local ((define (get-ava index)
(cond
((= index (vector-length vector)) '())
((eq? (vector-ref vector index) -1)
(cons index (get-ava (add1 index))))
(else (get-ava (add1 index))))))
(get-ava 0)))
;list is just vector turned into a list
(define (get-possible-row list vector)
(filter positive? list)
(define (thislist) (build-list (vector-length vector) values))
(remove* list (build-list (vector-length vector) values))
)
(define (place-n-queens origination destination vector)
(cond
((= origination destination) vector)
(else (local ((define possible-steps
(place-n-queens/list (add1 origination)
destination
(place-a-queen vector))))
(cond
((boolean? possible-steps) #f)
(else possible-steps))))))
(define (place-n-queens/list origination destination boards)
(cond
((empty? boards) #f)
(else (local ((define possible-steps
(place-n-queens origination destination (car boards))))
(cond
((boolean? possible-steps) (place-n-queens/list origination destination (cdr boards)))
(else possible-steps))
))))
Any help is appreciated to get this working!!
That's hard to follow. Generally n-queens is done with some sort of backtracking and I'm not seeing where you backtrack. The hard part is managing the side effects when using a vector. You have to set the board the the previous state before going back.
(define (n-queens size)
(let ((board (make-vector size -1)))
(let loop ((col 0) (row 0))
(cond ((= col size) board)
((= row size) ;;dead end
(if (= col 0) ;;if first collumn
#f ;;then no solutions
(begin (vector-set! board (- col 1) -1))
#f)))
;;else undo changes made by previous level and signal the error
((safe? col row board)
(vector-set! board col row)
(or (loop (+ col 1) 0)
;;only precede to next column if a safe position is found
(loop col (+ row 1))))
;; keep going if hit a dead end.
(else (loop col (+ row 1)))))))
Writing safe? is up to you though.
Also not sure why you are moving from vector to list. It's just really clogging up the logic so I'm having trouble following. Plus you should be comfortable moving through vectors on their own. In place-queen-on-n you use build-list on a vector just so you can map over it.
Whereas a vector-fold of some sort may be more appropriate. Additionally that map will always return a list which is always not false, meaning any code after that in the cond will never get hit. Is that your problem, I don't know but it is a problem.
I want to find the price of a new-item based on the average prices of similar items.
The function get-k-similar uses k-Nearest Neighbors but returns me this output
((list rating age price) proximity).
For example, 2-similar would be:
(((5.557799748150248 3 117.94262493533647) . 3.6956648993026904)
((3.0921378389849963 7 75.61492560596851) . 5.117886776721699))
I need to find the average PRICE of the similar items. i.e Average of 117 and 75.
Is there a better way to iterate? My function looks too ugly.
(define (get-prices new-item)
(define (average-prices a-list)
(/ (cdr
(foldl (λ(x y) (cons (list 0 0 0)
(+ (third (car x)) (third (car y)))))
(cons (list 0 0 0) 0)
a-list))
(length a-list)))
(let ((similar-items (get-k-similar new-item)))
(average-prices similar-items)))
Common Lisp
(/ (reduce '+ a-list :key 'caddar) (length a-list))
or
(loop for ((nil nil e) . nil) in a-list
count e into length
sum e into sum
finally (return (/ sum length)))
You can do the simple thing and just pull out every third value:
(define (average-prices a-list)
(/ (apply + (map fourth a-list)) (length a-list)))
This is a little inefficient since it builds an intermediate list, and my guess is that this is why you tried foldl. Here's the right way to do that:
(define (average-prices a-list)
(/ (foldl (lambda (x acc) (+ (third x) acc)) 0 l)
(length a-list)))
There is still a minor inefficiency -- length is doing a second scan -- but that's something that you shouldn't bother about since you'd need some really long lists to get any visible slowdown.