Guest User

Untitled

a guest
Dec 9th, 2018
69
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 3.22 KB | None | 0 0
  1. (define (element-by-index index lis)
  2. (define (iter i rest-lis)
  3. (if (< i index)
  4. (iter (+ i 1) (cdr rest-lis))
  5. (car rest-lis)))
  6. (if (> index (length lis))
  7. (begin (print "error element-by-index")
  8. 0)
  9. (iter 1 lis)))
  10.  
  11. (define (replace-by-index el index lis)
  12. (define (iter i result rest-lis)
  13. (if (< i index)
  14. (iter (+ i 1)
  15. (append result (list (car rest-lis)))
  16. (cdr rest-lis))
  17. (append (append result (list el)) (cdr rest-lis))))
  18. (if (> index (length lis))
  19. (begin (print "error replace-by-index")
  20. 0)
  21. (iter 1 (list) lis)))
  22.  
  23.  
  24.  
  25. (define (queens board-size)
  26. (define empty-board (map (lambda (i) (map (lambda (j) (list j 0))
  27. (enumerate 1 board-size)))
  28. (enumerate 1 board-size)))
  29. (define empty-col (map (lambda (x) (list x 0)) (enumerate 1 board-size)))
  30.  
  31. (define (safe? k positions)
  32. (define (queen-row col)
  33. (fold-right
  34. (lambda (x y) (+ y (if (= 1 (cadr x))
  35. (car x)
  36. 0)))
  37. 0
  38. (element-by-index col positions)))
  39.  
  40. (define (safe-row?)
  41. (if (< 1 (fold-right
  42. (lambda (x y) (+ y (cadr x)))
  43. 0
  44. (element-by-index
  45. (queen-row k)
  46. (transpose positions))))
  47. #f
  48. #t))
  49.  
  50. (define (safe-diag-top?)
  51. (define (iter row col)
  52. (cond ((or (< row 1)
  53. (< col 1))
  54. #t)
  55. ((= 1 (cadr (element-by-index
  56. row
  57. (element-by-index
  58. col
  59. positions))))
  60. #f)
  61. ((or (<= col 1)
  62. (<= row 1))
  63. #t)
  64. (else (iter (- row 1) (- col 1)))))
  65. (iter (- (queen-row k) 1) (- k 1)))
  66.  
  67. (define (safe-diag-bot?)
  68. (define (iter row col)
  69. (cond ((or (> row board-size)
  70. (< col 1))
  71. #t)
  72. ((= 1 (cadr (element-by-index
  73. row
  74. (element-by-index
  75. col
  76. positions))))
  77. #f)
  78. ((or (<= col 1)
  79. (>= row board-size))
  80. #t)
  81. (else (iter (+ row 1) (- col 1)))))
  82. (iter (+ (queen-row k) 1) (- k 1)))
  83.  
  84. (and (safe-row?)
  85. (safe-diag-top?)
  86. (safe-diag-bot?)))
  87.  
  88. (define (adjoin-position nr c q)
  89. (replace-by-index
  90. (replace-by-index (list nr 1) nr empty-col)
  91. c
  92. q))
  93.  
  94. (define (queen-cols k)
  95. (if (= 0 k)
  96. (list empty-board)
  97. (filter (lambda (positions) (safe? k positions))
  98. (flatmap (lambda (rest-of-queens)
  99. (map (lambda (new-row)
  100. (adjoin-position new-row k rest-of-queens))
  101. (enumerate 1 board-size)))
  102. (queen-cols (- k 1))))))
  103. (queen-cols board-size))
  104.  
  105. (define (print-board b)
  106. (map (lambda (row) (print (map (lambda (col) (cadr col)) row)))
  107. (transpose b))
  108. (newline))
  109.  
  110. (time (map print-board (queens 8)))
Add Comment
Please, Sign In to add comment