Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- ;by victor vasilevskiy
- (define ranks '(a k q j 10 9 8 7 6 5 4 3 2))
- (define suits '(s h d c))
- (define (numeric-rank rank)
- (cond ((equal? rank 'a) 14)
- ((equal? rank 'k) 13)
- ((equal? rank 'q) 12)
- ((equal? rank 'j) 11)
- (else rank)))
- (define (make-card suit rank)
- (word suit rank))
- (define (rank card) (bf card))
- (define (suit card) (first card))
- (define (sort hand)
- ((repeated sort-once (- (count hand) 1)) hand))
- (define (sort-once hand)
- (cond ((empty? hand) hand)
- ((= (count hand) 1) hand)
- ((> (numeric-rank (bf (first hand)))
- (numeric-rank (bf (first (bf hand)))))
- (se (first hand) (sort-once (bf hand))))
- (else (se (first (bf hand))
- (sort-once (se (first hand) (bf (bf hand))))))))
- (define (poker-value hand)
- (let ((sortedhand (sort hand)))
- (cond ((royal-flush? sortedhand) (se '(ROYAL FLUSH) '- (suitname hand)))
- ((straight-flush? sortedhand) (se '(STRAIGHT FLUSH) '- (rank (first (sort hand))) 'HIGH (suitname hand)))
- ((four-of-a-kind? sortedhand) (se '(FOUR OF A KIND) '- (numword (rank (first (bf (bf (sort hand))))))))
- ((full-house? sortedhand) (se '(FULL HOUSE) '- (numword (rank (last (sort hand)))) 'OVER (numword (rank (first (sort hand))))))
- ((flush? sortedhand) (se 'FLUSH '- (suitname hand)))
- ((straight? sortedhand) (se (word (numword (rank (first (sort hand)))) '-HIGH) 'STRAIGHT))
- ((three-of-a-kind? sortedhand) (se '(THREE OF A KIND) '- (numword (rank (first (bf (bf (sort hand))))))))
- ((two-pair? sortedhand) (se '(TWO PAIRS OF) (numword (rank (first (bf (sort hand))))) 'AND (numword (rank (last (bl (sort hand)))))))
- ((pair? sortedhand) (se '(There is a pair. I am sorry Ms. Hexsel but I have had no idea how to do this part of poker-value for pair. I tried doing a ton of
- different things but in the end nothing has worked)))
- (else '(none)))))
- ;my code starts here bruh
- (define (numword val) ;transforms numbers to words
- (cond ((equal? val 14) 'ACES)
- ((equal? val 13) 'KINGS)
- ((equal? val 12) 'QUEENS)
- ((equal? val 11) 'JACKS)
- ((equal? val 10) 'TENS)
- ((equal? val 9) 'NINES)
- ((equal? val 8) 'EIGHTS)
- ((equal? val 7) 'SEVENS)
- ((equal? val 6) 'SIXES)
- ((equal? val 5) 'FIVES)
- ((equal? val 4) 'FOURS)
- ((equal? val 3) 'THREES)
- ((equal? val 2) 'TWOS)
- ((equal? val 1) 'ONES)
- (else '(I have an intense hatred for joe))))
- (define (suitname hand) ;transforms the suit to a word
- (cond ((equal? (suit (first (sort hand))) 'd) 'DIAMONDS)
- ((equal? (suit (first (sort hand))) 'c) 'CLUBS)
- ((equal? (suit (first (sort hand))) 'h) 'HEARTS)
- ((equal? (suit (first (sort hand))) 's) 'SPADES)
- (else '(JOHN F KENNEDY))))
- (define (pair? hand) ;this checks for a pair
- (cond ((<= (count (sort hand)) 1) #f)
- ((not (equal? (bf (first (sort hand))) (bf (first (bf (sort hand)))))) (pair? (bf (sort hand))))
- ((equal? (bf (first (sort hand))) (bf (first (bf (sort hand))))) #t)
- (else #f)))
- (define (helper1 hand) ;helper for two pair where you need a sentence of 2 sortpairs but not the same so it can run it on both in 1
- (se (first (sort hand)) (first (bf (sort hand)))))
- (define (two-pair? hand) ;checks if there are 2 pairs
- (cond ((<= (count (sort hand)) 1) #f)
- ((pair? (helper1 (sort hand))) (pair? (bf (bf (sort hand)))))
- (else (two-pair? (bf (sort hand))))))
- (define (three-of-a-kind? hand) ;checks if there are 3 numbers that are the same
- (cond ((<= (count (sort hand)) 1) #f)
- ((and (equal? (numeric-rank (bf (first (sort hand)))) (numeric-rank (bf (first (bf (sort hand))))))
- (equal? (numeric-rank (bf (first (sort hand)))) (numeric-rank (bf (first (bf (bf (sort hand)))))))) #t)
- ((and (equal? (numeric-rank (bf (first (bf (sort hand))))) (numeric-rank (bf (first (bf (bf (sort hand)))))))
- (equal? (numeric-rank (bf (first (bf (sort hand))))) (numeric-rank (bf (first (bf (bf (bf (sort hand))))))))) #t)
- ((and (equal? (numeric-rank (bf (first (bf (bf (sort hand)))))) (numeric-rank (bf (first (bf (bf (bf (sort hand))))))))
- (equal? (numeric-rank (bf (first (bf (bf (sort hand)))))) (numeric-rank (bf (first (bf (bf (bf (bf (sort hand)))))))))) #t)
- (else #f)))
- (define (straight? hand) ;adds 1 to the rank of the next rank from the first so if it adds 1 its equal. if all 5 are +1 from each other it returns true
- (cond ((and (equal? (numeric-rank (bf (first (sort hand)))) (+ 1 (numeric-rank (bf (first (bf (sort hand)))))))
- (equal? (numeric-rank (bf (first (bf (sort hand))))) (+ 1 (numeric-rank (bf (first (bf (bf (sort hand))))))))
- (equal? (numeric-rank (bf (first (bf (bf (sort hand)))))) (+ 1 (numeric-rank (bf (first (bf (bf (bf (sort hand)))))))))
- (equal? (numeric-rank (bf (first (bf (bf (bf (sort hand))))))) (+ 1 (numeric-rank (bf (first (bf (bf (bf (bf (sort hand))))))))))) #t)
- (else #F)))
- (define (flush? hand) ;removes the numbers keeps only the suit, only 5 cards in a poker hand, if it continues until 1 then it is true
- (cond ((equal? (count (sort hand)) 1) #t)
- ((equal? (suit (first (sort hand))) (suit (first (bf (sort hand))))) (flush? (bf (sort hand))))
- (else #f)))
- (define (fhhelper num hand)
- (cond ((< (count hand) 2) #t)
- ((< num 2) #t)
- ((equal? (numeric-rank (bf (first hand))) (numeric-rank (bf (first (bf hand))))) (fhhelper (- num 1) (bf hand)))
- (else #f)))
- (define (full-house? hand)
- (or (and (fhhelper 3 hand) (fhhelper 2 (bf (bf (bf hand)))))
- (and (fhhelper 2 hand) (fhhelper 3 (bf (bf hand))))))
- (define (four-of-a-kind? hand) ;checks if there are 3 numbers that are the same
- (cond ((<= (count (sort hand)) 1) #f)
- ((and (equal? (numeric-rank (bf (first (sort hand)))) (numeric-rank (bf (first (bf (sort hand))))))
- (equal? (numeric-rank (bf (first (sort hand)))) (numeric-rank (bf (first (bf (bf (sort hand)))))))
- (equal? (numeric-rank (bf (first (sort hand)))) (numeric-rank (bf (first (bf (bf (bf (sort hand))))))))) #t)
- ((and (equal? (numeric-rank (bf (first (bf (sort hand))))) (numeric-rank (bf (first (bf (bf (sort hand)))))))
- (equal? (numeric-rank (bf (first (bf (sort hand))))) (numeric-rank (bf (first (bf (bf (bf (sort hand))))))))
- (equal? (numeric-rank (bf (first (bf (sort hand))))) (numeric-rank (bf (first (bf (bf (bf (bf (sort hand)))))))))) #t)
- (else #f)))
- (define (straight-flush? hand) ;checks for straight flush
- (cond ((empty? hand) #f)
- ((not (flush? hand)) #f)
- ((straight? (sort hand)) #t)
- (else #f)))
- (define (royal-flush? hand) ;checks if its a ROYAL FLUSH
- (cond ((empty? hand) #f)
- ((not (flush? hand)) #f)
- ((and (equal? (numeric-rank (bf (first (sort hand)))) 14)
- (equal? (numeric-rank (bf (first (bf (sort hand))))) 13)
- (equal? (numeric-rank (bf (first (bf (bf (sort hand)))))) 12)
- (equal? (numeric-rank (bf (first (bf (bf (bf (sort hand))))))) 11)
- (equal? (bf (first (bf (bf (bf (bf (sort hand))))))) 10)) #t)
- (else #f)))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement