최민아
가입: 2009년 9월 28일
올린 글: 236
|
 올려짐: 2012년11월5일 15:27 주제: 실습 7 모범답안 |
 |
|
실습 7 모범답안입니다.
| 코드: | ;;applicative
(define empty-stack-applicative ())
(define (push-stack-applicative s x) (cons x s))
(define (is-empty?-stack-applicative s) (null? s))
(define (pop-stack-applicative s)
(if (is-empty?-stack-applicative s)
(error "stack is empty")
(cons (car s) (cdr s))))
(define (reverse-stack-applicative s)
(reverse s))
(define (elm-of elm-stack) (car elm-stack))
(define (stack-of elm-stack) (cdr elm-stack))
;;imperative
(define (empty-stack-imperative) (cons 0 0))
(define (push-stack-imperative s x)
(let ((cell (cons x ())))
(begin (set-cdr! cell (cdr s)) (set-cdr! s cell))
))
(define (is-empty?-stack-imperative s) (equal? 0 (cdr s)))
(define (pop-stack-imperative s)
(if (is-empty?-stack-imperative s) (error "stack is empty")
(let ((top (cadr s)))
(begin (set-cdr! s (cddr s)) top)
)))
;;test case
(define empty-stk-app empty-stack-applicative)
(define stk-app (push-stack-applicative empty-stk-app 5))
(is-empty?-stack-applicative stk-app)
#f
(define pair (pop-stack-applicative stk-app))
(define elmt (car pair))
elmt
5
(is-empty?-stack-applicative (cdr pair))
#t
(newline)
(define stk-imp (empty-stack-imperative))
(push-stack-imperative stk-imp 5)
(is-empty?-stack-imperative stk-app)
#f
(define elmt (pop-stack-imperative stk-imp))
elmt
5
(is-empty?-stack-imperative stk-imp)
#t
(newline)
;;queue
(define empty-queue
(cons empty-stack-applicative
empty-stack-applicative))
(define (insert-queue q x)
(define stack1 (car q))
(define stack2 (cdr q))
(cons
(push-stack-applicative stack1 x)
stack2))
(define (is-empty?-queue q)
(define stack1 (car q))
(define stack2 (cdr q))
(and
(list? q)
(is-empty?-stack-applicative stack1)
(is-empty?-stack-applicative stack2)))
(define (delete-queue q)
(define stack1 (car q))
(define stack2 (cdr q))
(cond ((is-empty?-queue q) (error "queue is empty"))
((is-empty?-stack-applicative stack2)
(letrec ((new-stack2 (reverse stack1))
(elm-stack (pop-stack-applicative new-stack2))
(elm (elm-of elm-stack))
(popped-new-stack2 (stack-of elm-stack)))
(cons elm (cons () popped-new-stack2))))
(else
(letrec ((elm-stack (pop-stack-applicative stack2))
(elm (elm-of elm-stack))
(popped-stack (stack-of elm-stack)))
(cons elm (cons stack1 popped-stack))))))
;;test case
(define queue (insert-queue (insert-queue empty-queue 5) 7))
(define elm-queue (delete-queue queue))
(car elm-queue)
5
(define queue2 (cdr elm-queue))
(define elm-queue2 (delete-queue queue2))
(car elm-queue2)
7
(is-empty?-queue (cdr elm-queue2))
#t
;;n queen problem
(define (queens bs)
(define (queen-cols k)
(if (= k 0)
(list empty-b)
(filter
(lambda (p) (safe? p))
(accumulate append
null
(map
(lambda (a)
(map (lambda (n)
(adjoin-position n k a))
(enumerate-interval 1 bs)))
(queen-cols (- k 1)))))))
(queen-cols (- bs 1))) |
|
|
FAQ
검색
멤버리스트
사용자 그룹
사용자 등록하기
개인 정보
비공개 메시지를 확인하려면 로그인하십시오
로그인
