API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Dec 17th, 2017
90
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 11.92 KB | None | 0 0
raw download clone embed print report
  1.  
  2. (define ranks '(a k q j 10 9 8 7 6 5 4 3 2))
  3.  
  4. (define suits '(s h d c))
  5.  
  6. (define (numeric-rank rank)
  7.  
  8. (cond ((equal? rank 'a) 14)
  9.  
  10. ((equal? rank 'k) 13)
  11.  
  12. ((equal? rank 'q) 12)
  13.  
  14. ((equal? rank 'j) 11)
  15.  
  16. (else rank)))
  17.  
  18. (define (make-card suit rank)
  19.  
  20. (word suit rank))
  21.  
  22. (define (rank card) (bf card))
  23.  
  24. (define (suit card) (first card))
  25.  
  26.  
  27.  
  28. (define (sorting hand)
  29.  
  30. ((repeated sort-once (- (count hand) 1)) hand))
  31.  
  32.  
  33.  
  34. (define (sort-once hand)
  35.  
  36. (cond ((empty? hand) hand)
  37.  
  38. ((= (count hand) 1) hand)
  39.  
  40. ((> (numeric-rank (bf (first hand)))
  41.  
  42. (numeric-rank (bf (first (bf hand)))))
  43.  
  44. (se (first hand) (sort-once (bf hand))))
  45.  
  46. (else (se (first (bf hand))
  47.  
  48. (sort-once (se (first hand) (bf (bf hand))))))))
  49.  
  50.  
  51.  
  52. (define (poker-value hand)
  53.  
  54. (let ((sortedhand (sorting hand)))
  55.  
  56. (cond ((royal-flush? sortedhand) ??)
  57.  
  58. ((straight-flush? sortedhand) ??)
  59.  
  60. ((four-of-a-kind? sortedhand) ??)
  61.  
  62. ((full-house? sortedhand) ??)
  63.  
  64. ((flush? sortedhand) ??)
  65.  
  66. ((straight? sortedhand) ??)
  67.  
  68. ((three-of-a-kind? sortedhand) ??)
  69.  
  70. ((two-pair? sortedhand) ??)
  71.  
  72. ((pair? sortedhand) ??)
  73.  
  74. (else ??))))
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81. (define (convert-to-suit x)
  82. (cond ((equal? x 'd) 'diamonds)
  83. ((equal? x 'h) 'hearts)
  84. ((equal? x 'c) 'clubs)
  85. ((equal? x 's) 'spades)
  86. (else 'rainbows)))
  87. (define (convert-to-num x)
  88. (cond ((equal? x 1) 'ones)
  89. ((equal? x 2) 'twos)
  90. ((equal? x 3) 'threes)
  91. ((equal? x 4) 'fours)
  92. ((equal? x 5) 'fives)
  93. ((equal? x 6) 'sixes)
  94. ((equal? x 7) 'sevens)
  95. ((equal? x 8) 'eights)
  96. ((equal? x 9) 'nines)
  97. ((equal? x 10) 'tens)
  98. ((equal? x 'j) 'jacks)
  99. ((equal? x 'q) 'queens)
  100. ((equal? x 'k) 'kings)
  101. ((equal? x 'a) 'aces)
  102. (else 'rainbows)))
  103.  
  104.  
  105. (define ranks '(a k q j 10 9 8 7 6 5 4 3 2))
  106.  
  107. (define suits '(s h d c))
  108.  
  109. (define (numeric-rank rank)
  110. (cond ((equal? rank 'a) 14)
  111. ((equal? rank 'k) 13)
  112. ((equal? rank 'q) 12)
  113. ((equal? rank 'j) 11)
  114. (else rank)))
  115.  
  116. (define (make-card suit rank)
  117. (word suit rank))
  118.  
  119. (define (rank card) (bf card))
  120.  
  121. (define (suit card) (first card))
  122.  
  123. ;sorts all the cards in the hand based on numeric value, high to low
  124. (define (sorting hand)
  125. ((repeated sort-once (- (count hand) 1)) hand))
  126.  
  127. ;sorts first two cards of hand based on numeric value, high to low
  128. (define (sort-once hand)
  129. (cond ((empty? hand) hand)
  130. ((= (count hand) 1) hand)
  131. ((> (numeric-rank (bf (first hand)))
  132. (numeric-rank (bf (first (bf hand)))))
  133. (se (first hand) (sort-once (bf hand))))
  134. (else (se (first (bf hand))
  135. (sort-once (se (first hand) (bf (bf hand))))))))
  136.  
  137. (define (royal-flush? hand)
  138. (let ((sortedhand (sorting hand)))
  139. (if (and (or (equal? (every first sortedhand) '(s s s s s)) (equal? (every first sortedhand) '(h h h h h)) (equal? (every first sortedhand) '(d d d d d)) (equal? (every first sortedhand) '(c c c c c)))
  140. (equal? (bf (first sortedhand)) 'a)
  141. (equal? (bf (first (bf sortedhand))) 'k)
  142. (equal? (bf (first (bf (bf sortedhand)))) 'q)
  143. (equal? (bf (first (bf (bf (bf sortedhand))))) 'j)
  144. (equal? (bf (first (bf (bf (bf (bf sortedhand)))))) '10)) #t #f)))
  145.  
  146. (define (straight-flush? hand)
  147. (let ((sortedhand (sorting hand)))
  148. (if (or (and (or (equal? (every first sortedhand) '(s s s s s)) (equal? (every first sortedhand) '(h h h h h)) (equal? (every first sortedhand) '(d d d d d)) (equal? (every first sortedhand) '(c c c c c)))
  149. (equal? (- (numeric-rank (bf (first sortedhand))) 1) (numeric-rank (bf (first (bf sortedhand)))))
  150. (equal? (- (numeric-rank (bf (first (bf sortedhand)))) 1) (numeric-rank (bf (first (bf (bf sortedhand))))))
  151. (equal? (- (numeric-rank (bf (first (bf (bf sortedhand))))) 1) (numeric-rank (bf (first (bf (bf (bf sortedhand)))))))
  152. (equal? (- (numeric-rank (bf (first (bf (bf (bf sortedhand)))))) 1) (numeric-rank (bf (first (bf (bf (bf (bf sortedhand)))))))))
  153. (and (or (equal? (every first sortedhand) '(s s s s s)) (equal? (every first sortedhand) '(h h h h h)) (equal? (every first sortedhand) '(d d d d d)) ((equal? (every first sortedhand) '(c c c c c))))
  154. (equal? (bf (first sortedhand)) 'a)
  155. (equal? (bf (first (bf sortedhand))) 5)
  156. (equal? (bf (first (bf (bf sortedhand)))) 4)
  157. (equal? (bf (first (bf (bf (bf sortedhand))))) 3)
  158. (equal? (bf (last sortedhand)) 2)))
  159. (if (royal-flush? hand) #f #t) #f)))
  160.  
  161. ;simplifying the code above by writing it recursively
  162. (define (straight-flush? hand)
  163. (let ((sortedhand (sorting hand)))
  164. (if (empty? hand)
  165. '#t
  166. (if (= (- (numeric-rank (bf (first sortedhand))) 1) (numeric-rank (bf (first (bf sortedhand))))) (straight-flush? (bf hand)) #f))))
  167.  
  168.  
  169. (define (ace? x)
  170. (if (equal? x 'a) #t #f))
  171. (define (2? x)
  172. (if (equal? x '2) #t #f))
  173. (define (3? x)
  174. (if (equal? x '3) #t #f))
  175. (define (4? x)
  176. (if (equal? x '4) #t #f))
  177. (define (5? x)
  178. (if (equal? x '5) #t #f))
  179. (define (6? x)
  180. (if (equal? x '6) #t #f))
  181. (define (7? x)
  182. (if (equal? x '7) #t #f))
  183. (define (8? x)
  184. (if (equal? x '8) #t #f))
  185. (define (9? x)
  186. (if (equal? x '9) #t #f))
  187. (define (10? x)
  188. (if (equal? x '10) #t #f))
  189. (define (jack? x)
  190. (if (equal? x 'j) #t #f))
  191. (define (queen? x)
  192. (if (equal? x 'q) #t #f))
  193. (define (king? x)
  194. (if (equal? x 'k) #t #f))
  195.  
  196. (define (four-of-a-kind? hand)
  197. (if (or (= (count (keep ace? (every bf hand))) 4)
  198. (= (count (keep 2? (every bf hand))) 4)
  199. (= (count (keep 3? (every bf hand))) 4)
  200. (= (count (keep 4? (every bf hand))) 4)
  201. (= (count (keep 5? (every bf hand))) 4)
  202. (= (count (keep 6? (every bf hand))) 4)
  203. (= (count (keep 7? (every bf hand))) 4)
  204. (= (count (keep 8? (every bf hand))) 4)
  205. (= (count (keep 9? (every bf hand))) 4)
  206. (= (count (keep 10? (every bf hand))) 4)
  207. (= (count (keep jack? (every bf hand))) 4)
  208. (= (count (keep queen? (every bf hand))) 4)
  209. (= (count (keep king? (every bf hand))) 4)) #t #f))
  210.  
  211. (define (full-house? hand)
  212. (if (and (or (= (count (keep ace? (every bf hand))) 3)
  213. (= (count (keep 2? (every bf hand))) 3)
  214. (= (count (keep 3? (every bf hand))) 3)
  215. (= (count (keep 4? (every bf hand))) 3)
  216. (= (count (keep 5? (every bf hand))) 3)
  217. (= (count (keep 6? (every bf hand))) 3)
  218. (= (count (keep 7? (every bf hand))) 3)
  219. (= (count (keep 8? (every bf hand))) 3)
  220. (= (count (keep 9? (every bf hand))) 3)
  221. (= (count (keep 10? (every bf hand))) 3)
  222. (= (count (keep jack? (every bf hand))) 3)
  223. (= (count (keep queen? (every bf hand))) 3)
  224. (= (count (keep king? (every bf hand))) 3))
  225. (or (= (count (keep ace? (every bf hand))) 2)
  226. (= (count (keep 2? (every bf hand))) 2)
  227. (= (count (keep 3? (every bf hand))) 2)
  228. (= (count (keep 4? (every bf hand))) 2)
  229. (= (count (keep 5? (every bf hand))) 2)
  230. (= (count (keep 6? (every bf hand))) 2)
  231. (= (count (keep 7? (every bf hand))) 2)
  232. (= (count (keep 8? (every bf hand))) 2)
  233. (= (count (keep 9? (every bf hand))) 2)
  234. (= (count (keep 10? (every bf hand))) 2)
  235. (= (count (keep jack? (every bf hand))) 2)
  236. (= (count (keep queen? (every bf hand))) 2)
  237. (= (count (keep king? (every bf hand))) 2))) #t #f))
  238.  
  239. (define (flush? hand)
  240. (if (or (equal? (every first hand) '(s s s s s)) (equal? (every first hand) '(h h h h h)) (equal? (every first hand) '(d d d d d)) (equal? (every first hand) '(c c c c c))) (if (or (royal-flush? hand) (straight-flush? hand)) #f #t) #f))
  241.  
  242. (define (straight? hand)
  243. (let ((sortedhand (sorting hand)))
  244. (if (or (and (not (or (equal? (every first sortedhand) '(s s s s s)) (equal? (every first sortedhand) '(h h h h h)) (equal? (every first sortedhand) '(d d d d d)) (equal? (every first sortedhand) '(c c c c c))))
  245. (equal? (- (numeric-rank (bf (first sortedhand))) 1) (numeric-rank (bf (first (bf sortedhand)))))
  246. (equal? (- (numeric-rank (bf (first (bf sortedhand)))) 1) (numeric-rank (bf (first (bf (bf sortedhand))))))
  247. (equal? (- (numeric-rank (bf (first (bf (bf sortedhand))))) 1) (numeric-rank (bf (first (bf (bf (bf sortedhand)))))))
  248. (equal? (- (numeric-rank (bf (first (bf (bf (bf sortedhand)))))) 1) (numeric-rank (bf (first (bf (bf (bf (bf sortedhand)))))))))
  249. (and (not (or (equal? (every first sortedhand) '(s s s s s)) (equal? (every first sortedhand) '(h h h h h)) (equal? (every first sortedhand) '(d d d d d)) (equal? (every first sortedhand) '(c c c c c))))
  250. (equal? (bf (first sortedhand)) 'a) (equal? (bf (first (bf sortedhand))) 5) (equal? (bf (first (bf (bf sortedhand)))) 4) (equal? (bf (first (bf (bf (bf sortedhand))))) 3) (equal? (bf (last sortedhand)) 2)))
  251. #t #f)))
  252.  
  253.  
  254. (define (three-of-a-kind? hand)
  255. (if (and (or (= (count (keep ace? (every bf hand))) 3)
  256. (= (count (keep 2? (every bf hand))) 3)
  257. (= (count (keep 3? (every bf hand))) 3)
  258. (= (count (keep 4? (every bf hand))) 3)
  259. (= (count (keep 5? (every bf hand))) 3)
  260. (= (count (keep 6? (every bf hand))) 3)
  261. (= (count (keep 7? (every bf hand))) 3)
  262. (= (count (keep 8? (every bf hand))) 3)
  263. (= (count (keep 9? (every bf hand))) 3)
  264. (= (count (keep 10? (every bf hand))) 3)
  265. (= (count (keep jack? (every bf hand))) 3)
  266. (= (count (keep queen? (every bf hand))) 3)
  267. (= (count (keep king? (every bf hand))) 3))
  268. (not (full-house? hand))) #t #f))
  269.  
  270.  
  271. (define (two-pair? hand))
  272. (if (and (or (= (count (keep ace? (every bf hand))) 2)
  273. (= (count (keep 2? (every bf hand))) 2)
  274. (= (count (keep 3? (every bf hand))) 2)
  275. (= (count (keep 4? (every bf hand))) 2)
  276. (= (count (keep 5? (every bf hand))) 2)
  277. (= (count (keep 6? (every bf hand))) 2)
  278. (= (count (keep 7? (every bf hand))) 2)
  279. (= (count (keep 8? (every bf hand))) 2)
  280. (= (count (keep 9? (every bf hand))) 2)
  281. (= (count (keep 10? (every bf hand))) 2)
  282. (= (count (keep jack? (every bf hand))) 2)
  283. (= (count (keep queen? (every bf hand))) 2)
  284. (= (count (keep king? (every bf hand))) 2))
  285. (not (or (full-house? hand) (two-pair? hand)))) #t #f))
  286.  
  287. (define (pair hand)
  288. (if (and (or (= (count (keep ace? (every bf hand))) 2)
  289. (= (count (keep 2? (every bf hand))) 2)
  290. (= (count (keep 3? (every bf hand))) 2)
  291. (= (count (keep 4? (every bf hand))) 2)
  292. (= (count (keep 5? (every bf hand))) 2)
  293. (= (count (keep 6? (every bf hand))) 2)
  294. (= (count (keep 7? (every bf hand))) 2)
  295. (= (count (keep 8? (every bf hand))) 2)
  296. (= (count (keep 9? (every bf hand))) 2)
  297. (= (count (keep 10? (every bf hand))) 2)
  298. (= (count (keep jack? (every bf hand))) 2)
  299. (= (count (keep queen? (every bf hand))) 2)
  300. (= (count (keep king? (every bf hand))) 2))
  301. (not (or (full-house? hand) (two-pair? hand)))) #t #f))
  302.  
  303. (define (poker-value hand)
  304. (let ((sortedhand (sorting hand))
  305. (cond ((royal-flush? sortedhand) (se '(royal flush) '(-) (convert-to-suit (first (first hand)))))
  306. ((straight-flush? sortedhand) (se '(straight flush) '(-) (convert-to-suit (first (first hand))))))
  307. ((four-of-a-kind? sortedhand) (se '(four) '(of) '(convert-to-num (bf (first hand))))
  308. ((full-house? sortedhand) (se '(full house) '(-) ')
  309. ((flush? sortedhand) "")
  310. ((straight? sortedhand) "")
  311. ((three-of-a-kind? sortedhand) "")
  312. ((two-pair? sortedhand) "")
  313. ((pair? sortedhand) "")
  314. (else "")))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!