Answered step by step
Verified Expert Solution
Link Copied!

Question

1 Approved Answer

I writting a scheme/lisp code for a puzzle game. I'm stuck on trying to write a A* search function (so that the help me button

I writting a scheme/lisp code for a puzzle game. I'm stuck on trying to write a A* search function (so that the "help me" button to work). I already started working on it but I don't think its right. scroll down till you see the "This is where I help help". or if anything, you can delete that code and just write your own A* function to work with that "Help me" button when you run the program.

(define N 9) ; size of the board--must be a square

(define SQLEN 100) ; the length of the side of a square in N-puzzle

(define WIDTH (* (sqrt N) SQLEN))

(define HEIGHT (* (sqrt N) SQLEN))

(define e-scene (empty-scene WIDTH (+ HEIGHT SQLEN)))

(define INITMOVES 3) ; number of moves to create an initial board

; DATA DEFINITION FOR A BOARD ; A board is a (listof natnum)

; A world is a board

; F-ON-BOARD TEMPLATE ; (define (f-on-board/world a-board) ; (cond [(empty? a-board) ...] ; [else ...(car a-board)...(f-on-board/world (rest a-board))])) ;

(define WIN (build-list N (lambda (n) (cond [(< n (- N 1)) (+ n 1)] [else 0]))))

(define (top-l-corner? p) (= p 0))

(define (top-r-corner? p) (= p (- (sqrt N) 1)))

(define (bottom-l-corner? p) (= p (- N (sqrt N))))

(define (bottom-r-corner? p) (= p (- N 1)))

(define (in-top-row? p) (< p (sqrt N)))

(define (in-bottom-row? p) (>= p (- N (sqrt N))))

(define (in-left-col? p) (= (remainder p (sqrt N)) 0))

(define (in-right-col? p) (= (remainder p (sqrt N)) (- (sqrt N) 1)))

(define (get-blank-sq-num l) (cond [(empty? l) (error 'get-blank-sq-num "Blank not found")] [(= (car l) 0) 0] [else (add1 (get-blank-sq-num (cdr l)))]))

; make-init-world: natnum world --> world ; Purpose: To create the initial world by making the given number of moves in the given world (define (make-init-world nummoves w) (cond [(= nummoves 0) w] [else (make-init-world (sub1 nummoves) (make-move w))]))

; make-move: world --> world ; Purpose: To make a random move in the given world (define (make-move w) (local [(define blank-index (get-blank-sq-num w)) (define bneighs (blank-neighs blank-index)) (define move-index (list-ref bneighs (random (length bneighs)))) ] (swap-tiles w move-index blank-index)))

; swap-tiles: world natnum natnum --> world ; Purpose: To swap the given tiles in the given world (define (swap-tiles w i j) (build-list N (lambda (n) (cond [(= n i) (list-ref w j)] [(= n j) (list-ref w i)] [else (list-ref w n)]))))

; blank-neighs: number --> (listof number) ; Purpose: To return a list of the tile numbers that neigbor the given blank tile number (define (blank-neighs p) (cond [(top-l-corner? p) (list (+ p 1) (+ p (sqrt N)))] [(top-r-corner? p) (list (- p 1) (+ p (sqrt N)))] [(bottom-l-corner? p) (list (- p (sqrt N)) (+ p 1))] [(bottom-r-corner? p) (list (- p (sqrt N)) (- p 1))] [(in-top-row? p) (list (- p 1) (+ p 1) (+ p (sqrt N)))] [(in-bottom-row? p) (list (- p (sqrt N)) (- p 1) (+ p 1))] [(in-left-col? p) (list (- p (sqrt N)) (+ p 1) (+ p (sqrt N)))] [(in-right-col? p) (list (- p (sqrt N)) (- p 1) (+ p (sqrt N)))] [else (list (- p (sqrt N)) (- p 1) (+ p 1) (+ p (sqrt N)))]))

(define INIT-WORLD (make-init-world INITMOVES WIN))

;; centers of the squares in the N-puzzle

(define (compute-centers i) (cond [(= i 0) '()] [else (cons (make-posn (+ (* (remainder (- i 1) (sqrt N)) SQLEN) 50) (+ (* (quotient (- i 1) (sqrt N)) SQLEN) 50)) (compute-centers (- i 1)))]))

(define CENTERS (reverse (compute-centers N))) ; the centers of the squares

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; make-square: number --> image ; Purpose: To create a square with the given number in it (define (make-square n) (cond [(= n 0) (square SQLEN "solid" "green")] [else (overlay/align "middle" "middle" (text (number->string n) 32 "black") (rectangle SQLEN SQLEN "solid" "green"))]))

(define (add-help-button scn) (local [(define help-button (overlay/align "middle" "middle" (text "HELP ME!" 20 "black") (overlay/align "middle" "middle" (rectangle (- (* SQLEN (sqrt N)) (/ SQLEN 2)) (/ SQLEN 1.5) "solid" "yellow") (rectangle (* SQLEN (sqrt N)) SQLEN "solid" "red"))))] (place-image help-button (/ WIDTH 2) (+ HEIGHT (/ SQLEN 2)) scn)))

; draw-world: world --> scene ; Purpose: To draw the given world in the empty-scene (define (draw-world a-world) (local ((define (helper i w ctrs) (cond [(empty? w) e-scene] [else (place-image (make-square (car w)) (posn-x (car ctrs)) (posn-y (car ctrs)) (helper (+ i 1) (rest w) (rest ctrs)))])) (define (add-h-lines scn i) (cond [(= i (sqrt N)) scn] [else (add-h-lines (add-line scn 0 (* i SQLEN) (* (sqrt N) SQLEN) (* i SQLEN) "red") (+ i 1))])) (define (add-v-lines scn i) (cond [(= i (sqrt N)) scn] [else (add-v-lines (add-line scn (* i SQLEN) 0 (* i SQLEN) (* (sqrt N) SQLEN) "red") (+ i 1))]))) (add-help-button (add-v-lines (add-h-lines (helper 0 a-world CENTERS) 1) 1))))

;;; mouse clicking processing

; differences: board board --> (listof number) ; Purpose: To list the positions that have different tiles in two given boards (define (differences b1 b2) (local [(define (helper i) (cond [(= i 0) empty] [(= (list-ref b1 (sub1 i)) (list-ref b2 (sub1 i))) (helper (sub1 i))] [else (cons (sub1 i) (helper (sub1 i)))]))] (helper N)))

; mouse-over-help?: number number --> boolean ; Purpose: To determine if the given coordinates are over the help button (define (mouse-over-help? x y) (> y HEIGHT))

; generate-children: board --> non-empty-list-of-boards ; Purpose: To generate a list of the children of the given board (define (generate-children b) (local [(define blank-pos (get-blank-sq-num b))] (map (lambda (p) (swap-tiles b blank-pos p)) (blank-neighs blank-pos))))

; manhattan-distance: board number ; Purpose: To compute the Manhattan distance of the given board (define (manhattan-distance b) (local [; distance: number number --> number ; Purpose: To compute the distance between the two tile positions (define (distance curr corr) (+ (abs (- (quotient curr (sqrt N)) (quotient corr (sqrt N)))) (abs (- (remainder curr (sqrt N)) (remainder corr (sqrt N)))))) ; correct-pos: number --> number ; Purpose: To determine the correct position of the given tile (define (correct-pos n) (cond [(= n 0) (sub1 N)] [else (sub1 n)])) ; adder: number --> number ; Purpose: To add all the distances of each tile (define (adder pos) (cond [(= pos 0) 0] [else (+ (distance (sub1 pos) (correct-pos (list-ref b (sub1 pos)))) (adder (sub1 pos)))]))] (adder N)))

; best-child: non-empty-list-of-boards --> board ; Purpose: To find the board with the board with the smallest ; Manhattan distance in the given non-empty list of boards (define (best-child blob lob) (cond [(empty? (rest lob)) blob] [else (local [(define best-of-rest (best-child blob (rest lob)))] (cond [(< (manhattan-distance (first lob)) (manhattan-distance best-of-rest)) ((best-of-rest))] [else best-of-rest]))]))

; find-solution: board --> (listof boards) ; Purpose: To find a solution to the given board using DFS ;(define (find-solution-dfs b) ; (cond [(equal? b WIN) (list b)] ; [else ; (local [(define children (generate-children b))] ; (cons b (find-solution-dfs (best-child children))))]))

; find-solution-bfs: board --> seq ; Purpose: To find a solution to the given board (define (find-solution-bfs b) (local [; search-paths: lseq --> seq ; Purpose: To find a solution to b by searching all possible paths ; ACCUMULATOR INVARIANT: ; paths is all paths starting at b generated so far from shortest to longest (define (search-paths paths) (cond [(equal? (first (first paths)) WIN) (first paths)] [else (local [(define children (generate-children (first (first paths)))) (define new-paths (map (lambda (c) (cons c (first paths))) children))] (search-paths (append (rest paths) new-paths)))]))] (reverse (search-paths (list (list b))))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;This is where i need Help. (define (rem-path somethign visited) (append something visited))

(define (find-solution-a-star b) (local [(define childrenstuff (cond [(equal? b WIN) (list b)] [else (local [(define children (generate-children b))] (cons b (childrenstuff (best-child children))))])) (define visited (define pathstuff (local [(define bestseq (best-child paths)) ; search-paths: lseq --> seq ; Purpose: To find a solution to b by searching all possible paths ; ACCUMULATOR INVARIANT: ; paths is all paths starting at b generated so far from shortest to longest (define (search-paths paths visited) (cond [(equal? (first best-path) WIN) (first paths)] [else (local [(define children (filter (lambda (c) (not(member c visited))) (generate-children (first bestseq)))) (define new-paths (map (lambda (c) (cons c bestseq)) children)) (search-paths (cons (first bestseq) visited) (append new-paths (rem-path bestseq paths)) (reverse (search-paths (list (list b)))))])

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

; process-mouse-event: world integer integer string --> world (define (process-mouse-event w x y me) (cond [(string=? me "button-down") (cond [(mouse-over-help? x y) (local [(define solution (find-solution-bfs w)) (define diffs (cond [(empty? solution) empty] [else (differences w (first (rest solution)))]))] (cond [(empty? diffs) w] [else (swap-tiles w (first diffs) (first (rest diffs)))]))] [else (move-blank w (make-posn x y))])] [else w]))

; move-blank: world posn --> world (define (move-blank w mpos) (local [(define blnk-index (get-blank-sq-num w)) (define mouse-index (get-mouse-sq-num CENTERS mpos))] (cond [(not (neighs? blnk-index mouse-index)) w] [else (swap-blank-and-mouse w mouse-index)])))

; swap-blank-and-mouse: world number number --> world ; Purpose: To swap the mouse and blank squares in the world (define (swap-blank-and-mouse w mouse-index) (local [(define mouse-val (list-ref w mouse-index))] (map (lambda (n) (cond [(= n 0) mouse-val] [(= n mouse-val) 0] [else n])) w)))

; mouse-in-square?: posn posn --> boolean ; Purpose: To determine if the first posn is in the square that has the 2nd posn as its center (define (mouse-in-square? mposn scenter) (and (< (abs (- (posn-x mposn) (posn-x scenter))) (/ SQLEN 2)) (< (abs (- (posn-y mposn) (posn-y scenter))) (/ SQLEN 2))))

; get-mouse-sq-num: world posn --> number ; Purpose: Return the position in the given world of the square the mouse is over or ; -1 if the mouse is not over a square (define (get-mouse-sq-num centers mposn) (local [(define (helper centers i) (cond [(empty? centers) -1] [(mouse-in-square? mposn (first centers)) i] [else (helper (rest centers) (add1 i))]))] (helper centers 0)))

; neighs?: number number --> boolean ; Purpose: To determine if the given mouse index and blank indes are neighbors (define (neighs? bindex mindex) (cond [(= mindex -1) false] [(top-l-corner? bindex) (or (= mindex (+ bindex 1)) (= mindex (+ bindex (sqrt N))))] [(top-r-corner? bindex) (or (= mindex (- bindex 1)) (= mindex (+ bindex (sqrt N))))] [(bottom-l-corner? bindex) (or (= mindex (- bindex (sqrt N))) (= mindex (+ bindex 1)))] [(bottom-r-corner? bindex) (or (= mindex (- bindex (sqrt N))) (= mindex (- bindex 1)))] [(in-top-row? bindex) (or (= mindex (- bindex 1)) (= mindex (+ bindex 1)) (= mindex (+ bindex (sqrt N))))] [(in-bottom-row? bindex) (or (= mindex (- bindex (sqrt N))) (= mindex (- bindex 1)) (= mindex (+ bindex 1)))] [(in-left-col? bindex) (or (= mindex (- bindex (sqrt N))) (= mindex (+ bindex 1)) (= mindex (+ bindex (sqrt N))))] [(in-right-col? bindex) (or (= mindex (- bindex (sqrt N))) (= mindex (- bindex 1)) (= mindex (+ bindex (sqrt N))))] [else (or (= mindex (- bindex (sqrt N))) (= mindex (- bindex 1)) (= mindex (+ bindex 1)) (= mindex (+ bindex (sqrt N))))]))

; mouse-on-neigh-of-blank?: (listof posn) posn --> boolean (define (mouse-on-neigh-of-blank? bneighs-posns mposn) (cond [(empty? bneighs-posns) false] [(mouse-in-square? mposn (car bneighs-posns)) true] [else (mouse-on-neigh-of-blank? (rest bneighs-posns) mposn)]))

; win?: world --> boolean ; Purpose: To determine if the given world is WIN (define (win? w) (equal? w WIN))

(define (make-win-scene w) (place-image (text "You win!!!" 32 "OrangeRed") (/ WIDTH 2) (/ HEIGHT 2) (draw-world w)))

; DATA DEFINITION ; ; A sequence is either ; 1. (list world) ; 2. (cons w s), where w is a world and s is a sequence. ; ; A list of sequence (lseq) is either ; 1. empty ; 2. (cons s l), where s is a sequence and l is a lseq ;

(big-bang (make-init-world INITMOVES WIN) (on-draw draw-world) (on-mouse process-mouse-event) (stop-when win? make-win-scene) )

Step by Step Solution

There are 3 Steps involved in it

Step: 1

blur-text-image

Get Instant Access to Expert-Tailored Solutions

See step-by-step solutions with expert insights and AI powered tools for academic success

Step: 2

blur-text-image

Step: 3

blur-text-image

Ace Your Homework with AI

Get the answers you need in no time with our AI-driven, step-by-step assistance

Get Started

Recommended Textbook for

Database Support For Data Mining Applications Discovering Knowledge With Inductive Queries Lnai 2682

Authors: Rosa Meo ,Pier L. Lanzi ,Mika Klemettinen

2004th Edition

3540224793, 978-3540224792

More Books

Students also viewed these Databases questions

Question

How does an import quota restrict trade?

Answered: 1 week ago

Question

What is conservative approach ?

Answered: 1 week ago

Question

What are the basic financial decisions ?

Answered: 1 week ago