함지웅
가입: 2014년 9월 4일
올린 글: 7
|
 올려짐: 2014년11월9일 22:02 주제: HW#5 테스트셋입니다. |
 |
|
| 코드: |
#lang racket
(require racket/match)
(require "common-grade.rkt")
(require "hw5-1.rkt")
(printf "1. Internal Representations\n")
; In this homework, we strictly guide the internal structure of tiles.
; This auto-grader should results in "O" (rather than "X") for the
; following test cases.
;
;
(printf "1) Basic Representations\n")
; First of all, black tile should be 'B.
(output (lambda () (equal? 'B black)))
; Likewise, white tile should be 'W.
(output (lambda () (equal? 'W white)))
; Note that these two basic tile should be both array and tree:
(output (lambda () (equal? #t (is-tree? black))))
(output (lambda () (equal? #t (is-tree? white))))
(output (lambda () (equal? #t (is-array? black))))
(output (lambda () (equal? #t (is-array? white))))
;
;
; These are for ease of reading this grader.
(define B black)
(define W white)
;
;
; Tiles are of two kinds: arrays and trees.
; These are constructed by: glue-*-from-*.
;
(printf "2) Array Representations\n")
; Array tile should look like:
(define basic-array (glue-array-from-array B B B W))
(output (lambda () (equal? '(array (B B) (W B))
basic-array)))
(output (lambda () (equal? '(array (B B) (W B))
(glue-array-from-tree B B B W))))
;
(printf "3) Tree Representations\n")
; Tree tile should look like:
(define basic-tree (glue-tree-from-tree B B B W))
(output (lambda () (equal? '(tree B B B W)
basic-tree)))
(output (lambda () (equal? '(tree B B B W)
(glue-tree-from-array B B B W))))
;
(printf "4) Bigger Examples\n")
; Try bigger ones.
(define (turn-array pattern i)
(if (<= i 0)
pattern
(turn-array (rotate-array pattern) (- i 1))))
(define (turn-tree pattern i)
(if (<= i 0)
pattern
(turn-tree (rotate-tree pattern) (- i 1))))
(define compound1-array
(glue-array-from-array
basic-array
(turn-array basic-array 1)
(turn-array basic-array 2)
(turn-array basic-array 3)))
(define compound2-array
(rotate-array
(glue-array-from-array
basic-array
basic-array
(rotate-array basic-array)
(rotate-array basic-array))))
(output (lambda () (equal? '(array (B B W B) (W B B B) (B B B W) (B W B B))
compound1-array)))
(output (lambda () (equal? '(array (B W W B) (B B B B) (B W W B) (B B B B))
compound2-array)))
(define compound1-tree
(glue-tree-from-tree
basic-tree
(turn-tree basic-tree 1)
(turn-tree basic-tree 2)
(turn-tree basic-tree 3)))
(define compound2-tree
(rotate-tree
(glue-tree-from-tree
basic-tree
basic-tree
(rotate-tree basic-tree)
(rotate-tree basic-tree))))
(output (lambda () (equal? '(tree (B B B W) (W B B B) (B W B B) (B B W B))
compound1-tree)))
(output (lambda () (equal? '(tree (B W B B) (W B B B) (W B B B) (B W B B))
compound2-tree)))
(define cp-array-1
'(array (B B W B W W B B) (W B W W B B B W) (B B W W W W W B) (B W W B W B W W) (W W W B B W B W) (W B W B W W B B) (W W B W B W W B) (W B B B W B W W)))
(define cp-array-2
'(array (W B W W B W B W) (B W W B W W B W) (B W W W B W B W) (W B W B W W W W) (B B B B B W B W) (W B B W W B W B) (W W B W B W W W) (W B W W W W B W)))
(define cp-array-3
'(array (B W W W W W B B) (W B B W W B B W) (W B W W B B B W) (B W W B W W W W) (B W B B B W B B) (B B B W W B W W) (B W W W B W B W) (W W W W B W W W)))
(define cp-array-4
'(array (W W B W B W W W) (B W B W W W B W) (B W W W W B W B) (W B W B W B W W) (W B B B B B W W) (B W B W W W W W) (B W B W B W B W) (B B B W W W W W)))
;(output (lambda () (equal? '(array (B B W B W W B W) (W B B B B W W W) (W W W W W B B B) (B W W B B B W W) (W W W W B W B W) (B W B W W W B B) (B B W W B W W B) (B W B B W B W W))
; (glue-array-from-tree (rotate (append '(tree) (list-ref (array-to-tree cp-array-1) 1)))
; (rotate (rotate (append '(tree) (list-ref (array-to-tree cp-array-1) 2))))
; (append '(tree) (list-ref (array-to-tree cp-array-1) 3))
; (rotate (append '(tree) (list-ref (array-to-tree cp-array-1) 4)))))))
;(output (lambda () (equal? '(tree ((W B W B) (W B W W) (B B W B) (W W B W)) ((W W B W) (W B W W) (B W B W) (W B W B)) ((W W B W) (W W B W) (W W B W) (W B B W)) ((W B W B) (B B W B) (B W W B) (B W B B)))
; (glue-tree-from-tree (rotate (append '(tree) (list-ref (array-to-tree cp-array-1) 3)))
; (rotate (rotate (rotate (append '(tree) (list-ref (array-to-tree cp-array-3) 1)))))
; (rotate (rotate (append '(tree) (list-ref (array-to-tree cp-array-2) 2))))
; (append '(tree) (list-ref (array-to-tree cp-array-4) 4))))))
(output (lambda () (equal? '(tree
(((W W W B) (W W W B) (W W B B) (B B W B)) ((B B B W) (W B B B) (W W B W) (W W W B)) ((W W W B) (B W W B) (B B B W) (W W B W)) ((W B W B) (W B W W) (B B W B) (W W B W)))
(((W W B W) (W B B W) (B W B W) (W W B B)) ((W W W W) (W W B W) (B B B W) (W B B B)) ((B W W W) (W B W B) (B W B W) (W B W W)) ((W W B W) (W W B B) (B W W W) (W B B B)))
(((W W B B) (W W W B) (W W W B) (W W W B)) ((W B W B) (W W B W) (W W W B) (W B W B)) ((B W B B) (W W W B) (W B W W) (B B W B)) ((W B W W) (W B W W) (W B W B) (B W B W)))
(((W W W B) (B W W B) (W W B W) (B W B W)) ((B W W W) (W W W B) (W B W W) (W B B W)) ((B B W W) (W W W W) (B W W W) (B W W W)) ((W B W B) (B B W B) (B W W B) (B W B B))))
(glue-tree-from-array (rotate cp-array-1) (rotate (rotate cp-array-3)) (rotate (rotate (rotate cp-array-2))) cp-array-4))))
(output (lambda () (equal? '(array (W B B B B W W B W W W W W B B B) (W W B W W B B W W B W B W B W B) (W W B B W W B W W W W W W B W B) (W W W B B W W W W W B B B B B W)
(B B W B W B W W W W B W B W B W) (W W B W W B B W B W B W W W W B) (W B W B W B B B W B W W W B W B) (W W W B W W W B W W W B W B W W)
(W W B W B B B W W B W W W W B W) (B W W B W B W W W W W B W B W W) (B B W W B W B W B W B W W B B W) (W B W B B W W W W B W B B B B B)
(W W B W B W W B W W W W B W B W) (B W W W W W B B W B W B W W W B) (W B B B W W B W W B W W B W W B) (B B W W B W B B W B W B W W B W))
(glue-array-from-tree (array-to-tree (rotate cp-array-3)) (array-to-tree (rotate (rotate cp-array-4))) (rotate (array-to-tree (rotate cp-array-2))) (rotate (rotate (array-to-tree cp-array-1)))))))
(printf "2. Interface Operability\n")
(printf "1) pprint\n")
; pprint (and pprint-*) should results in string as follows.
; Black (white) tile should be represented as "B" ("W").
; Each row are separated by new line character "\n".
; The last line also should contains "\n" after it.
(output (lambda () (equal? "BBWB\nWBBB\nBBBW\nBWBB\n"
(pprint-array compound1-array))))
(output (lambda () (equal? "BWWB\nBBBB\nBWWB\nBBBB\n"
(pprint-array compound2-array))))
(output (lambda () (equal? "BBWB\nWBBB\nBBBW\nBWBB\n"
(pprint-tree compound1-tree))))
(output (lambda () (equal? "BWWB\nBBBB\nBWWB\nBBBB\n"
(pprint-tree compound2-tree))))
(output (lambda () (equal? "BBWBWWBB\nWBWWBBBW\nBBWWWWWB\nBWWBWBWW\nWWWBBWBW\nWBWBWWBB\nWWBWBWWB\nWBBBWBWW\n"
(pprint-array cp-array-1))))
(output (lambda () (equal? "BWWWWWBB\nWBBWWBBW\nWBWWBBBW\nBWWBWWWW\nBWBBBWBB\nBBBWWBWW\nBWWWBWBW\nWWWWBWWW\n"
(pprint-array cp-array-3))))
(output (lambda () (equal? "WBWWBWBW\nBWWBWWBW\nBWWWBWBW\nWBWBWWWW\nBBBBBWBW\nWBBWWBWB\nWWBWBWWW\nWBWWWWBW\n"
(pprint-tree (array-to-tree cp-array-2)))))
(output (lambda () (equal? "WWBWBWWW\nBWBWWWBW\nBWWWWBWB\nWBWBWBWW\nWBBBBBWW\nBWBWWWWW\nBWBWBWBW\nBBBWWWWW\n"
(pprint-tree (array-to-tree cp-array-4)))))
(printf "2) neighbor\n")
(output (lambda () (equal? 2 (neighbor-array (list 0 0) compound1-array))))
(output (lambda () (equal? 6 (neighbor-array (list 2 0) compound1-array))))
(output (lambda () (equal? 2 (neighbor-array (list 3 3) compound1-array))))
(output (lambda () (equal? 3 (neighbor-array (list 0 3) compound2-array))))
(output (lambda () (equal? 4 (neighbor-array (list 1 3) compound2-array))))
(output (lambda () (equal? 2 (neighbor-array (list 2 2) compound2-array))))
(output (lambda () (equal? 2 (neighbor-tree (list 0 0) compound1-tree))))
(output (lambda () (equal? 6 (neighbor-tree (list 2 0) compound1-tree))))
(output (lambda () (equal? 2 (neighbor-tree (list 3 3) compound1-tree))))
(output (lambda () (equal? 3 (neighbor-tree (list 0 3) compound2-tree))))
(output (lambda () (equal? 4 (neighbor-tree (list 1 3) compound2-tree))))
(output (lambda () (equal? 2 (neighbor-tree (list 2 2) compound2-tree))))
(output (lambda () (equal? 2 (neighbor-array (list 0 1 2) cp-array-1))))
(output (lambda () (equal? 3 (neighbor-array (list 2 1 0) cp-array-1))))
(output (lambda () (equal? 5 (neighbor-array (list 3 2 1) cp-array-1))))
(output (lambda () (equal? 3 (neighbor-array (list 2 1 3) cp-array-2))))
(output (lambda () (equal? 3 (neighbor-array (list 0 2 1) cp-array-2))))
(output (lambda () (equal? 3 (neighbor-array (list 1 1 2) cp-array-2))))
(output (lambda () (equal? 3 (neighbor-tree (list 0 0 1) (array-to-tree cp-array-3)))))
(output (lambda () (equal? 3 (neighbor-tree (list 1 0 3) (array-to-tree cp-array-3)))))
(output (lambda () (equal? 2 (neighbor-tree (list 2 1 0) (array-to-tree cp-array-3)))))
(output (lambda () (equal? 1 (neighbor-tree (list 0 0 0) (array-to-tree cp-array-3)))))
(output (lambda () (equal? 1 (neighbor-tree (list 2 2 2) (array-to-tree cp-array-4)))))
(output (lambda () (equal? 2 (neighbor-tree (list 3 3 3) (array-to-tree cp-array-4)))))
(printf "3) translation\n")
(output (lambda () (equal? compound1-tree (array-to-tree compound1-array))))
(output (lambda () (equal? compound2-tree (array-to-tree compound2-array))))
(output (lambda () (equal? compound1-array (tree-to-array compound1-tree))))
(output (lambda () (equal? compound2-array (tree-to-array compound2-tree))))
(printf "3. Casual Examples\n")
(define basic (glue B B B W))
(define (turn pattern i)
(if (<= i 0)
pattern
(turn (rotate pattern) (- i 1))))
(define compound1
(glue basic (turn basic 1) (turn basic 2) (turn basic 3)))
(define compound2
(rotate (glue basic basic (rotate basic) (rotate basic))))
(output (lambda () (equal? "BBWB\nWBBB\nBBBW\nBWBB\n"
(pprint compound1))))
(output (lambda () (equal? "BWWB\nBBBB\nBWWB\nBBBB\n"
(pprint compound2))))
(output (lambda () (equal? 2 (neighbor (list 0 0) compound1))))
(output (lambda () (equal? 6 (neighbor (list 2 0) compound1))))
(output (lambda () (equal? 2 (neighbor (list 3 3) compound1))))
(output (lambda () (equal? 3 (neighbor (list 0 3) compound2))))
(output (lambda () (equal? 4 (neighbor (list 1 3) compound2))))
(output (lambda () (equal? 2 (neighbor (list 2 2) compound2))))
(output (lambda () (equal? 5 (neighbor (list 2 2 0 1) (glue-array-from-array cp-array-1 (rotate cp-array-3) (rotate (rotate cp-array-4)) cp-array-2)))))
(output (lambda () (equal? 2 (neighbor (list 2 1 0 3) (glue-array-from-tree (array-to-tree cp-array-3) (array-to-tree (rotate cp-array-2)) (array-to-tree cp-array-1) (rotate (array-to-tree (rotate (rotate cp-array-4)))))))))
(output (lambda () (equal? 2 (neighbor (list 0 0 1 3) (glue-tree-from-array cp-array-2 (rotate cp-array-3) (rotate (rotate (rotate cp-array-4))) cp-array-1)))))
(output (lambda () (equal? 4 (neighbor (list 2 1 3 3) (glue-tree-from-tree (array-to-tree cp-array-4) (rotate (array-to-tree cp-array-3)) (array-to-tree (rotate (rotate cp-array-2))) (rotate (rotate (array-to-tree (rotate cp-array-1)))))))))
|
| 코드: |
#lang racket
(require racket/match)
(require "common-grade.rkt")
(require "hw5-1.rkt")
(require "hw5-2.rkt")
(define B black)
(define W white)
(define basic (glue B B B W))
(define (turn pattern i)
(if (<= i 0)
pattern
(turn (rotate pattern) (- i 1))))
(define compound1
(glue basic (turn basic 1) (turn basic 2) (turn basic 3)))
(define compound2
(rotate (glue basic basic (rotate basic) (rotate basic))))
(define compound3
(glue compound1 compound2 (turn compound1 2) (turn compound2 2)))
(define cp-array-1
'(array (B B W B W W B B) (W B W W B B B W) (B B W W W W W B) (B W W B W B W W) (W W W B B W B W) (W B W B W W B B) (W W B W B W W B) (W B B B W B W W)))
(define cp-array-2
'(array (W B W W B W B W) (B W W B W W B W) (B W W W B W B W) (W B W B W W W W) (B B B B B W B W) (W B B W W B W B) (W W B W B W W W) (W B W W W W B W)))
(define cp-array-3
'(array (B W W W W W B B) (W B B W W B B W) (W B W W B B B W) (B W W B W W W W) (B W B B B W B B) (B B B W W B W W) (B W W W B W B W) (W W W W B W W W)))
(define cp-array-4
'(array (W W B W B W W W) (B W B W W W B W) (B W W W W B W B) (W B W B W B W W) (W B B B B B W W) (B W B W W W W W) (B W B W B W B W) (B B B W W W W W)))
(define cp-array-5
(glue-array-from-tree (rotate (append '(tree) (list-ref (array-to-tree cp-array-1) 1)))
(rotate (rotate (append '(tree) (list-ref (array-to-tree cp-array-1) 2))))
(append '(tree) (list-ref (array-to-tree cp-array-1) 3))
(rotate (append '(tree) (list-ref (array-to-tree cp-array-1) 4)))))
(define cp-array-6
(glue-tree-from-tree (rotate (append '(tree) (list-ref (array-to-tree cp-array-1) 3)))
(rotate (rotate (rotate (append '(tree) (list-ref (array-to-tree cp-array-3) 1)))))
(rotate (rotate (append '(tree) (list-ref (array-to-tree cp-array-2) 2))))
(append '(tree) (list-ref (array-to-tree cp-array-4) 4))))
(define cp-array-7
(glue-tree-from-array (rotate cp-array-1) (rotate (rotate cp-array-3)) (rotate (rotate (rotate cp-array-2))) cp-array-4))
(define cp-array-8
(glue-array-from-tree (array-to-tree (rotate cp-array-3)) (array-to-tree (rotate (rotate cp-array-4))) (rotate (array-to-tree (rotate cp-array-2))) (rotate (rotate (array-to-tree cp-array-1)))))
;;; beautiful test
(output (lambda () (equal? 0 (size B))))
(output (lambda () (equal? 0 (size W))))
(output (lambda () (equal? 1 (size basic))))
(output (lambda () (equal? 2 (size compound1))))
(output (lambda () (equal? 2 (size compound2))))
(output (lambda () (equal? 3 (size compound3))))
(output (lambda () (equal? 3 (size cp-array-1))))
(output (lambda () (equal? 3 (size (array-to-tree cp-array-4)))))
(output (lambda () (equal? 3 (size cp-array-6))))
(output (lambda () (equal? 4 (size (array-to-tree cp-array-8)))))
(output (lambda () (equal? #t (beautiful compound1))))
(output (lambda () (equal? #f (beautiful compound2))))
(output (lambda () (equal? #t (beautiful compound3))))
(output (lambda () (equal? #f (beautiful cp-array-3))))
(output (lambda () (equal? #f (beautiful (array-to-tree cp-array-5)))))
(output (lambda () (equal? #f (beautiful (tree-to-array cp-array-7)))))
(output (lambda () (equal? #f (beautiful cp-array-8))))
|
| 코드: |
#lang racket
(require "common-grade.rkt")
(require "hw5-3.rkt")
;;; Tape
(printf "Tape\n")
(define tape1 (init-tape (list "a" "b")))
(define tape2 (move-tape-left tape1))
(define tape3 (move-tape-left tape2))
(define tape4 (move-tape-right tape3))
(define tape5 (move-tape-right tape4))
(define tape6 (move-tape-right tape5))
(define tape7 (write-tape tape6 "c"))
(define tape8 (move-tape-right tape7))
(define tape9 (move-tape-right tape8))
(define tape10 (move-tape-right tape9))
(define tape11 (write-tape tape10 "_"))
(define tape12 (move-tape-left tape11))
(define tape13 (move-tape-left tape12))
(define tape14 (write-tape tape13 "d"))
(define tape15 (move-tape-left tape14))
(output (lambda () (equal? "-.-.a.b.-" (print-tape tape1 2))))
(output (lambda () (equal? "-.a.b.-.-" (print-tape tape2 2))))
(output (lambda () (equal? "a.b.-.-.-" (print-tape tape3 2))))
(output (lambda () (equal? "-.a.b.-.-" (print-tape tape4 2))))
(output (lambda () (equal? "-.-.a.b.-" (print-tape tape5 2))))
(output (lambda () (equal? "-.-.-.a.b" (print-tape tape6 2))))
(output (lambda () (equal? "-.-.c.a.b" (print-tape tape7 2))))
(output (lambda () (equal? "-.-.-.-.-.-.-.-.c.a.b.-.-.-.-" (print-tape tape8 7))))
(output (lambda () (equal? "-.-.-.-.-.-.-.-.-.c.a.b.-.-.-" (print-tape tape9 7))))
(output (lambda () (equal? "-.-.-.-.-.-.-.-.-.-.c.a.b.-.-" (print-tape tape10 7))))
(output (lambda () (equal? "-.-.-.-.-.-.-._.-.-.c.a.b.-.-" (print-tape tape11 7))))
(output (lambda () (equal? "-.-.-.-.-.-._.-.-.c.a.b.-.-.-" (print-tape tape12 7))))
(output (lambda () (equal? "-.-.-.-.-._.-.-.c.a.b.-.-.-.-" (print-tape tape13 7))))
(output (lambda () (equal? "-.-.-.-.-._.-.d.c.a.b.-.-.-.-" (print-tape tape14 7))))
(output (lambda () (equal? "-.-.-.-._.-.d.c.a.b.-.-.-.-.-" (print-tape tape15 7))))
(output (lambda () (equal? "-.-.-.-.-.-.-.a.b.c.d.e.-.-.-" (print-tape (init-tape '("a" "b" "c" "d" "e")) 7))))
(output (lambda () (equal? "-.-.-.-.-.-.-.-.-.-.-.-.-.-.-" (print-tape (init-tape '()) 7))))
(output (lambda () (equal? "a" (read-tape tape1))))
(output (lambda () (equal? "b" (read-tape tape2))))
(output (lambda () (equal? "c" (read-tape tape7))))
(output (lambda () (equal? "_" (read-tape tape11))))
(output (lambda () (equal? "-" (read-tape tape12))))
(output (lambda () (equal? "c" (read-tape tape15))))
(output (lambda () (equal? "-" (read-tape (init-tape '())))))
(output (lambda () (equal? "a" (read-tape (init-tape '("a" "b" "c" "d" "e"))))))
;;; Rule table
(printf "Rule table\n")
(define table1 empty-ruletable)
(define table2 (add-rule (make-rule "1" "a" "d" 'right "2") table1))
(define table3 (add-rule (make-rule "2" "b" "e" 'right "3") table2))
(define table4 (add-rule (make-rule "3" "-" "b" 'left "4") table3))
(define table5 (add-rule (make-rule "4" "e" "a" 'left "5") table4))
(define table6 (add-rule (make-rule "5" "d" "c" 'left "6") table5))
(define table7 (add-rule (make-rule "6" "-" "c" 'stay "7") table6))
(define table8 (add-rule (make-rule "1" "c" "d" 'left "4") table7))
(define table9 (add-rule (make-rule "3" "a" "c" 'stay "1") table8))
(define table10 (add-rule (make-rule "6" "a" "-" 'right "3") table9))
(define table11 (add-rule (make-rule "2" "c" "a" 'stay "2") table10))
(define table12 (add-rule (make-rule "2" "d" "b" 'right "3") table11))
(define table13 (add-rule (make-rule "2" "a" "c" 'left "1") table12))
(define table14 (add-rule (make-rule "3" "b" "a" 'right "4") table13))
(define table15 (add-rule (make-rule "3" "c" "b" 'left "2") table14))
(define table16 (add-rule (make-rule "3" "d" "a" 'stay "7") table15))
(define table17 (add-rule (make-rule "7" "a" "b" 'left "4") table16))
(define table18 (add-rule (make-rule "7" "b" "-" 'right "2") table17))
(define table19 (add-rule (make-rule "7" "c" "a" 'stay "3") table18))
(define table20 (add-rule (make-rule "4" "a" "d" 'left "2") table19))
(define table21 (add-rule (make-rule "4" "c" "e" 'left "1") table20))
(define table22 (add-rule (make-rule "4" "b" "-" 'stay "3") table21))
(define table23 (add-rule (make-rule "5" "a" "b" 'right "2") table22))
(define table24 (add-rule (make-rule "5" "b" "a" 'left "3") table23))
(define table25 (add-rule (make-rule "5" "-" "c" 'stay "4") table24))
(define table26 (add-rule (make-rule "2" "-" "a" 'right "3") table25))
(define table27 (add-rule (make-rule "4" "d" "c" 'right "2") table26))
(define table28 (add-rule (make-rule "4" "-" "b" 'left "2") table27))
(output (lambda () (equal? (cons "d" (cons 'right "2")) (match-rule "1" "a" table28))))
(output (lambda () (equal? (cons "e" (cons 'right "3")) (match-rule "2" "b" table28))))
(output (lambda () (equal? (cons "b" (cons 'left "4")) (match-rule "3" "-" table28))))
(output (lambda () (equal? (cons "a" (cons 'left "5")) (match-rule "4" "e" table28))))
(output (lambda () (equal? (cons "c" (cons 'left "6")) (match-rule "5" "d" table28))))
(output (lambda () (equal? (cons "c" (cons 'stay "7")) (match-rule "6" "-" table28))))
(output (lambda () (equal? (cons "c" (cons 'stay "1")) (match-rule "3" "a" table28))))
(output (lambda () (equal? (cons "a" (cons 'stay "2")) (match-rule "2" "c" table28))))
(output (lambda () (equal? (cons "c" (cons 'left "1")) (match-rule "2" "a" table28))))
(output (lambda () (equal? (cons "c" (cons 'stay "4")) (match-rule "5" "-" table28))))
(output (lambda () (equal? (cons "e" (cons 'left "1")) (match-rule "4" "c" table28))))
(output (lambda () (equal? (cons "b" (cons 'left "4")) (match-rule "7" "a" table28))))
;;; Turaing machine
(printf "Turing machine\n")
(define tm1 (make-tm (list "a" "b") "1" table28))
(define tm2 (step-tm tm1))
(define tm3 (step-tm tm2))
(define tm4 (step-tm tm3))
(define tm5 (step-tm tm4))
(define tm6 (step-tm tm5))
(define tm7 (step-tm tm6))
(define tm8 (step-tm tm7))
(define tm9 (step-tm tm8))
(define tm10 (step-tm tm9))
(define tm11 (step-tm tm10))
(define tm12 (step-tm tm11))
(define tm13 (step-tm tm12))
(define tm14 (step-tm tm13))
(define tm15 (step-tm tm14))
(define tm_run (run-tm tm1))
(define tm_run1 (run-tm tm_run))
(define tm_run2 (run-tm tm_run1))
(define tm_run3 (run-tm tm_run2))
(output (lambda () (equal? "-.-.a.b.-" (print-tm tm1 2))))
(output (lambda () (equal? "-.d.b.-.-" (print-tm tm2 2))))
(output (lambda () (equal? "d.e.-.-.-" (print-tm tm3 2))))
(output (lambda () (equal? "-.d.e.b.-" (print-tm tm4 2))))
(output (lambda () (equal? "-.-.d.a.b" (print-tm tm5 2))))
(output (lambda () (equal? "-.-.-.c.a" (print-tm tm6 2))))
(output (lambda () (equal? "-.-.c.c.a" (print-tm tm7 2))))
(output (lambda () (equal? "-.-.-.-.-.-.-.a.c.a.b.-.-.-.-" (print-tm tm8 7))))
(output (lambda () (equal? "-.-.-.-.-.-.-.c.c.a.b.-.-.-.-" (print-tm tm9 7))))
(output (lambda () (equal? "-.-.-.-.-.-.-.-.d.c.a.b.-.-.-" (print-tm tm10 7))))
(output (lambda () (equal? "-.-.-.-.-.-.-.-.-.-.-.c.d.d.c.a.b.-.-.-.-" (print-tm tm_run 10))))
; If no rule is applicable, just do nothing.
(output (lambda () (equal? "-.-.-.-.-.-.-.-.-.-.-.c.d.d.c.a.b.-.-.-.-" (print-tm tm_run1 10))))
(output (lambda () (equal? "-.-.-.-.-.-.-.-.-.-.-.c.d.d.c.a.b.-.-.-.-" (print-tm tm_run2 10))))
(output (lambda () (equal? "-.-.-.-.-.-.-.-.-.-.-.c.d.d.c.a.b.-.-.-.-" (print-tm tm_run3 10))))
|
| 코드: |
#lang racket
(require "common-grade.rkt")
(require "hw5-4.rkt")
(define (item-match? l r)
(and (equal? (car l) (car r))
(or
(and (< (cdr l) 0.001) (< (cdr r) 0.001))
(let ([ratio (/ (cdr l) (cdr r))])
(and (< 0.99 ratio) (< ratio 1.01))))))
(define (list-match? pred l r)
(cond [(equal? l '()) (equal? r '())]
[(equal? r '()) #f]
[else (and (pred (car l) (car r)) (list-match? pred (cdr l) (cdr r)))]))
(define (item-nonzero? sv)
(>= (cdr sv) 0.001))
(define (symbol<? l r)
(string<? (symbol->string l) (symbol->string r)))
(define (match? l r)
(let* ([ll (filter item-nonzero? l)]
[lll (sort ll (lambda (l r) (symbol<? (car l) (car r))))]
[rr (filter item-nonzero? r)]
[rrr (sort rr (lambda (l r) (symbol<? (car l) (car r))))])
(list-match? item-match? lll rrr)))
(output
(lambda ()
(let* ([input '((A B 1.0) (B C 0.3) (B D 0.7) (C A 0.6) (C D 0.4) (D D 1.0))]
[model-output (list (cons 'A 15.0) (cons 'B 25.0) (cons 'C 7.5) (cons 'D 52.5))]
[output (catchYou input 1)])
(printf "~s~n" model-output)
(printf "~s~n" output)
(match? model-output output))))
(output
(lambda ()
(let* ([input '((A B 1.0) (B C 0.3) (B D 0.7) (C A 0.6) (C D 0.4) (D D 1.0))]
[model-output (list (cons 'A 4.5) (cons 'B 15.0) (cons 'C 7.5) (cons 'D 73.0))]
[output (catchYou input 2)])
(printf "~s~n" model-output)
(printf "~s~n" output)
(match? model-output output))))
(output
(lambda ()
(let* ([input '((A B 1.0) (B C 0.3) (B D 0.7) (C A 0.6) (C D 0.4) (D C 0.3) (D D 0.7))]
[model-output '((A . 12.162162161758499) (B . 12.162162161758502) (C . 20.2702702695975) (D . 55.4054054035665))]
[output (catchYou input 100000000000000)])
(printf "~s~n" model-output)
(printf "~s~n" output)
(match? model-output output))))
(output
(lambda ()
(let* ([input '((A B 1.0) (B A 1.0) (C A 0.3) (C C 0.7))]
[model-output '((A . 47.05882352941176) (B . 52.94117647058823) (C . 0.00000000000001))]
[output (catchYou input 100000000000000)])
(printf "~s~n" model-output)
(printf "~s~n" output)
(match? model-output output))))
(output
(lambda ()
(let* ([input '((A B 1.0) (B C 0.3) (B D 0.7) (C A 0.6) (C D 0.4) (D A 0.2) (D D 0.8) (E B 0.4) (E E 0.6))]
[model-output '((A . 15.702111674569753) (B . 15.702111674569753) (C . 4.7106335023709285) (D . 64.37865786573602) (E . 0.00000000000001))]
[output (catchYou input 100000000000000)])
(printf "~s~n" model-output)
(printf "~s~n" output)
(match? model-output output))))
(output
(lambda ()
(let* ([input '((A B 1.0) (B C 0.3) (B D 0.7) (C A 0.6) (C D 0.4) (D C 0.3) (D D 0.7))]
[model-output '((A . 12.103341361604489) (B . 12.103341361604489) (C . 20.17223560267416) (D . 55.1374439806426))]
[output (catchYou input 100000000000000)])
(printf "~s~n" model-output)
(printf "~s~n" output)
(match? model-output output))))
(output
(lambda ()
(let* ([input '((A B 0.34) (A C 0.66) (B C 0.3) (B E 0.7) (C A 0.23) (C D 0.4) (C E 0.37) (D A 0.2) (D C 0.5) (D D 0.3) (E B 0.4) (E E 0.6))]
[model-output '((A . 4.695349496397151) (B . 22.141527763508222) (C . 13.637944595344415) (D . 7.793111197339664) (E . 51.362772336832954))]
[output (catchYou input 100000000000000)])
(printf "~s~n" model-output)
(printf "~s~n" output)
(match? model-output output))))
|
|
|
FAQ
검색
멤버리스트
사용자 그룹
사용자 등록하기
개인 정보
비공개 메시지를 확인하려면 로그인하십시오
로그인
