网络书屋(Web Reading Room)

A blogging framework for hackers.

Shuffle Cards

这个程序是参考洗牌而来,主要定位于scheme的算法运用实现。

源代码如下:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
#lang racket
;四种花色分别为黑桃(spade)、红心(heart)、梅花(club)、方块(diamond)

(define suits '("王" "黑桃" "红桃" "梅花" "方块"))
(define faces '("B" "L" "A" "2" "3" "4" "5" "6" "7" "8" "9" "10" "J" "Q" "K"))

;生成一张牌
(define (creat-card suit face)
    (cons suit face)
)
;生成n副牌
(define (creat-cards n mysuits myfaces)
        (define (afaces suit myfaces)
                (if (null? myfaces)
                    myfaces
                    (append (list (creat-card suit (car myfaces)))
                             (afaces suit (cdr myfaces))

                    )
                )
        )
        (define (asuits suits myfaces)
                (if (null? suits)
                    suits
                    (append  (afaces (car suits) myfaces)
                             (asuits (cdr suits) myfaces)
                    )

                )

        )

        ;(make-list n (asuits mysuits myfaces))
        (define (n-cards n alist return)
                (if (= n 0)
                    return
                    (n-cards (- n 1) alist (append return alist))
                )
        )
        ;(n-cards 4 '(a b c d e) '())
        (n-cards n (asuits mysuits myfaces) '())
)
;显示牌 
(define (print-cards alist . number)
        (define (iter alist n num)
                (if (= 0 (remainder n num))
                    (newline)
                    'ok
                )
                (if (null? alist)
                    (newline)
                    (begin (display (car alist))
                           (display "  ")
                           (iter (cdr alist) (+ n 1) num)
                    )
                )
        )
        (if (null? number)
            (iter alist 0 5)
            (iter alist 0 (car number))
        )
)
;获取牌的花色
(define (get-suit card)
    ((lambda (x) (cond ((equal? x "黑桃") 4)
                       ((equal? x "红桃") 3)
                       ((equal? x "梅花") 2)
                       ((equal? x "方块") 1)
                       ((equal? x "王")   0)
                 )
     )

     (car card)
    )
)

;获取牌的数值
(define (get-face card)
    ((lambda (x) (cond ((equal? x "A") 1)
                       ((equal? x "2") 2)
                       ((equal? x "3") 3)
                       ((equal? x "4") 4)
                       ((equal? x "5") 5)
                       ((equal? x "6") 6)
                       ((equal? x "7") 7)
                       ((equal? x "8") 8)
                       ((equal? x "9") 9)
                       ((equal? x "10") 10)
                       ((equal? x "J") 11)
                       ((equal? x "Q") 12)
                       ((equal? x "K") 13)
                       ((equal? x "B") 30)
                       ((equal? x "L") 20)
                 )
     )

     (cdr card)
    )
)
;洗牌
(define (shuffle-card cards)
        (define (append-amb x y return)
                (cond ((and (null? x) (null? y)) return)
                      ((null? x) (append return y))
                      ((null? y) (append return x))
                      (else      (append-amb (cdr y)
                                             (cdr x)
                                             (append return (append (list (car x)) (list (car y))))
                                 )
                      )

                )

        )
        ;--
        (define (shuffle scards)
                ((lambda (x)
                        (append-amb (list-tail scards x) (list-head scards x) '()))
                 (random (length scards))

                )
        )
        ;--
        (define (iter cards n)
                (if (= n 0)
                    cards
                    (iter (shuffle cards) (- n 1))
                )
        )
        ;--
        (iter cards (length cards))
        ;(shuffle cards)
)
;分牌(deal-card '(1 2 3 4 5 6 7 8) 4) => return ((1 5) (2 6) (3 7) (4 8))
;;还没完成
(define (deal-card alist n)
        (define (iter alist n return)
            (if (null? alist)
                return
                ;(append )
                'ok
            )
        )
        (iter alist n '())

)
;--------------------------------
;返回list中k以前的sublist
(define (list-head lst k)
    (if (zero? k)
        '()
        (append (list (car lst)) (list-head (cdr lst) (- k 1)) )

    )
)
;-------------test---------------
(define x (creat-card "梅花" "8"))
(define k (creat-cards 1 (cdr suits) (cdr (cdr faces))))
(define n '(1 2 3 4 5 6 7 8 9 10))
(print-cards k)
(print-cards (list-head k 9))
(print-cards (list-tail k 9) 13)
;(print-cards (shuffle-card k))
;------------------
;(display (shuffle-card n))

运行结果

(黑桃 . A)  (黑桃 . 2)  (黑桃 . 3)  (黑桃 . 4)  (黑桃 . 5)  
(黑桃 . 6)  (黑桃 . 7)  (黑桃 . 8)  (黑桃 . 9)  (黑桃 . 10)  
(黑桃 . J)  (黑桃 . Q)  (黑桃 . K)  (红桃 . A)  (红桃 . 2)  
(红桃 . 3)  (红桃 . 4)  (红桃 . 5)  (红桃 . 6)  (红桃 . 7)  
(红桃 . 8)  (红桃 . 9)  (红桃 . 10)  (红桃 . J)  (红桃 . Q)  
(红桃 . K)  (梅花 . A)  (梅花 . 2)  (梅花 . 3)  (梅花 . 4)  
(梅花 . 5)  (梅花 . 6)  (梅花 . 7)  (梅花 . 8)  (梅花 . 9)  
(梅花 . 10)  (梅花 . J)  (梅花 . Q)  (梅花 . K)  (方块 . A)  
(方块 . 2)  (方块 . 3)  (方块 . 4)  (方块 . 5)  (方块 . 6)  
(方块 . 7)  (方块 . 8)  (方块 . 9)  (方块 . 10)  (方块 . J)  
(方块 . Q)  (方块 . K)  

(黑桃 . A)  (黑桃 . 2)  (黑桃 . 3)  (黑桃 . 4)  (黑桃 . 5)  
(黑桃 . 6)  (黑桃 . 7)  (黑桃 . 8)  (黑桃 . 9)  

(黑桃 . 10)  (黑桃 . J)  (黑桃 . Q)  (黑桃 . K)  (红桃 . A)  (红桃 . 2)  (红桃 . 3)  (红桃 . 4)  (红桃 . 5)  (红桃 . 6)  (红桃 . 7)  (红桃 . 8)  (红桃 . 9)  
(红桃 . 10)  (红桃 . J)  (红桃 . Q)  (红桃 . K)  (梅花 . A)  (梅花 . 2)  (梅花 . 3)  (梅花 . 4)  (梅花 . 5)  (梅花 . 6)  (梅花 . 7)  (梅花 . 8)  (梅花 . 9)  
(梅花 . 10)  (梅花 . J)  (梅花 . Q)  (梅花 . K)  (方块 . A)  (方块 . 2)  (方块 . 3)  (方块 . 4)  (方块 . 5)  (方块 . 6)  (方块 . 7)  (方块 . 8)  (方块 . 9)  
(方块 . 10)  (方块 . J)  (方块 . Q)  (方块 . K)