remembered to update
This commit is contained in:
		
							parent
							
								
									2b9b002e1c
								
							
						
					
					
						commit
						aac01b3ce3
					
				
							
								
								
									
										258
									
								
								201/week1/poker.hoon
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										258
									
								
								201/week1/poker.hoon
									
									
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -0,0 +1,258 @@
 | 
			
		|||
:: Hoon 201 - Week 1
 | 
			
		||||
:: ~bannum-magtus || s@p7.co.nz
 | 
			
		||||
::
 | 
			
		||||
:: im very sorry i messed up all my faces and i also dont know
 | 
			
		||||
:: how to make gates that make gates so this is messy code :(
 | 
			
		||||
:: dont leave your assignments until the last minute kids.
 | 
			
		||||
::
 | 
			
		||||
/+  playing-cards
 | 
			
		||||
:-  %say
 | 
			
		||||
|=  [[* eny=@uv *] *]
 | 
			
		||||
:-  %noun
 | 
			
		||||
=<
 | 
			
		||||
%-  rank-hands
 | 
			
		||||
%-  score-hands
 | 
			
		||||
%-  sort-hands
 | 
			
		||||
%-  draw-hands
 | 
			
		||||
[%pregame 4]
 | 
			
		||||
!:
 | 
			
		||||
|%
 | 
			
		||||
+$  title
 | 
			
		||||
  $%  %royal-flush
 | 
			
		||||
      %straight-flush
 | 
			
		||||
      %four-of-a-kind
 | 
			
		||||
      %full-house
 | 
			
		||||
      %flush
 | 
			
		||||
      %straight
 | 
			
		||||
      %three-of-a-kind
 | 
			
		||||
      %two-pair
 | 
			
		||||
      %pair
 | 
			
		||||
      %high-card
 | 
			
		||||
  ==
 | 
			
		||||
+$  card  darc:playing-cards
 | 
			
		||||
+$  suit  suit:playing-cards
 | 
			
		||||
+$  deck  deck:playing-cards
 | 
			
		||||
+$  grouped  (list (list card))
 | 
			
		||||
+$  unsorted  (list card)
 | 
			
		||||
+$  sorted  (list card)
 | 
			
		||||
+$  hands  [g=grouped s=sorted u=unsorted]
 | 
			
		||||
+$  tiebreaker  (list [v=@ s=@])
 | 
			
		||||
+$  draw-phase-state  [h=(list unsorted) d=deck]
 | 
			
		||||
+$  sort-phase-state  [h=(list hands) d=deck]
 | 
			
		||||
+$  score-phase-state  [s=(list [r=@ t=title h=hands b=tiebreaker]) d=deck]
 | 
			
		||||
+$  rank-phase-state  (list [r=@ t=title h=unsorted])
 | 
			
		||||
++  rank-hands
 | 
			
		||||
  |=  [%score st=score-phase-state]
 | 
			
		||||
  ^-  [%ranking rank-phase-state]
 | 
			
		||||
  =.  s.st  (sort s.st rank-sort)
 | 
			
		||||
  [%ranking (flop (rank-display s.st))]
 | 
			
		||||
++  rank-display
 | 
			
		||||
  |=  i=(list [* t=title h=hands *])
 | 
			
		||||
  ^-  (list [r=@ t=title h=unsorted])
 | 
			
		||||
  =/  c=@  1
 | 
			
		||||
  =|  l=(list [r=@ t=title h=unsorted])
 | 
			
		||||
  |-
 | 
			
		||||
  ?~  i  l
 | 
			
		||||
  =/  s  [c t.i.i u.h.i.i]
 | 
			
		||||
  %=  $
 | 
			
		||||
    c  .+(c)
 | 
			
		||||
    l  :-(s l)
 | 
			
		||||
    i  t.i
 | 
			
		||||
  ==
 | 
			
		||||
++  rank-sort
 | 
			
		||||
  |=  [a=[r=@ * * b=tiebreaker] b=[r=@ * * b=tiebreaker]]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  ?.  =(r.a r.b)
 | 
			
		||||
    (gth r.a r.b)
 | 
			
		||||
  (tb-comp b.a b.b)
 | 
			
		||||
++  tb-comp
 | 
			
		||||
  |=  [a=tiebreaker b=tiebreaker]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  ?.  =((lent a) (lent b))
 | 
			
		||||
    !!
 | 
			
		||||
  |-
 | 
			
		||||
  ?~  a  %.y
 | 
			
		||||
  ?~  b  %.n
 | 
			
		||||
  ?.  =(v.i.a v.i.b)
 | 
			
		||||
    (gth v.i.a v.i.b)
 | 
			
		||||
  $(a t.a, b t.b)
 | 
			
		||||
++  draw-hands
 | 
			
		||||
  |=  [%pregame n=@]
 | 
			
		||||
  =/  d=deck  init-deck
 | 
			
		||||
  =|  h=(list unsorted)
 | 
			
		||||
  ^-  [%draw draw-phase-state]
 | 
			
		||||
  |-
 | 
			
		||||
  ?~  n  [%draw [h d]]
 | 
			
		||||
  =/  i  (draw:playing-cards 5 d)
 | 
			
		||||
  $(h :-(hand.i h), d rest.i, n (dec n))
 | 
			
		||||
++  sort-hands
 | 
			
		||||
  |=  [%draw st=draw-phase-state]
 | 
			
		||||
  ^-  [%sort sort-phase-state]
 | 
			
		||||
  [%sort [(turn h.st zip-sorted) d.st]]
 | 
			
		||||
++  card-sort
 | 
			
		||||
  |=  [a=card b=card]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  (gth val.a val.b)
 | 
			
		||||
++  sort-hand
 | 
			
		||||
  |=  u=unsorted
 | 
			
		||||
  ^-  sorted
 | 
			
		||||
  (sort u card-sort)
 | 
			
		||||
++  tuples
 | 
			
		||||
  |=  h=sorted
 | 
			
		||||
  ^-  grouped
 | 
			
		||||
  =|  c=(list card)
 | 
			
		||||
  =|  l=(list (list card))
 | 
			
		||||
  |-
 | 
			
		||||
  ?~  h  :-(c l)
 | 
			
		||||
  ?~  c
 | 
			
		||||
    %=  $
 | 
			
		||||
        c  [i.h ~]
 | 
			
		||||
        h  t.h
 | 
			
		||||
    ==
 | 
			
		||||
  ?:  =(val.i.c val.i.h)
 | 
			
		||||
    %=  $
 | 
			
		||||
        c  :-(i.h c)
 | 
			
		||||
        h  t.h
 | 
			
		||||
    ==
 | 
			
		||||
  %=  $
 | 
			
		||||
      c  ~
 | 
			
		||||
      l  :-(c l)
 | 
			
		||||
  ==
 | 
			
		||||
++  zip-sorted
 | 
			
		||||
  |=  u=unsorted
 | 
			
		||||
  ^-  hands
 | 
			
		||||
  =/  sh  (sort-hand u)
 | 
			
		||||
  =/  gh  (tuples sh)
 | 
			
		||||
  [gh sh u]
 | 
			
		||||
++  score-hands
 | 
			
		||||
  |=  [%sort st=sort-phase-state]
 | 
			
		||||
  ^-  [%score score-phase-state]
 | 
			
		||||
  [%score (turn h.st con-tb) d.st]
 | 
			
		||||
++  init-deck
 | 
			
		||||
  (shuffle-deck:playing-cards make-deck:playing-cards eny)
 | 
			
		||||
++  suit-to-num
 | 
			
		||||
  |=  c=darc:playing-cards
 | 
			
		||||
  ^-  @
 | 
			
		||||
  ?-  sut.c
 | 
			
		||||
    %spades  4
 | 
			
		||||
    %hearts  3
 | 
			
		||||
    %diamonds  2
 | 
			
		||||
    %clubs  1
 | 
			
		||||
  ==
 | 
			
		||||
++  get-title
 | 
			
		||||
  |=  h=hands
 | 
			
		||||
  ^-  [t=title r=@]
 | 
			
		||||
    ?:  (is-royal-flush h)      [%royal-flush 9]
 | 
			
		||||
    ?:  (is-straight-flush h)   [%straight-flush 8]
 | 
			
		||||
    ?:  (is-four-of-a-kind h)   [%four-of-a-kind 7]
 | 
			
		||||
    ?:  (is-full-house h)       [%full-house 6]
 | 
			
		||||
    ?:  (is-flush h)            [%flush 5]
 | 
			
		||||
    ?:  (is-straight h)         [%straight 4]
 | 
			
		||||
    ?:  (is-three-of-a-kind h)  [%three-of-a-kind 3]
 | 
			
		||||
    ?:  (is-two-pair h)         [%two-pair 2]
 | 
			
		||||
    ?:  (is-pair h)             [%pair 1]
 | 
			
		||||
                                [%high-card 0]
 | 
			
		||||
++  is-flush
 | 
			
		||||
  |=  [* h=sorted *]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  =|  s=?(~ suit)
 | 
			
		||||
  |-
 | 
			
		||||
  ?~  h  %.y
 | 
			
		||||
  ?~  s
 | 
			
		||||
    $(h t.h, s sut.i.h)
 | 
			
		||||
  ?.  =(s sut.i.h)
 | 
			
		||||
    %.n
 | 
			
		||||
  $(h t.h)
 | 
			
		||||
++  is-straight
 | 
			
		||||
  |=  [* h=sorted *]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  =|  l=?(~ @)
 | 
			
		||||
  |-
 | 
			
		||||
  ?~  h  %.y
 | 
			
		||||
  ?~  l
 | 
			
		||||
    $(h t.h, l val.i.h)
 | 
			
		||||
  ?.  =(.+(l) val.i.h)
 | 
			
		||||
    %.n
 | 
			
		||||
  $(l val.i.h, h t.h)
 | 
			
		||||
++  high-card
 | 
			
		||||
  |=  [* h=sorted *]
 | 
			
		||||
  ^-  card
 | 
			
		||||
  ?~  h  !!
 | 
			
		||||
  i.h
 | 
			
		||||
++  is-royal-flush
 | 
			
		||||
  |=  i=[* h=sorted *]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  ?&  (is-straight-flush i)
 | 
			
		||||
      =(13 val:(high-card i))
 | 
			
		||||
  ==
 | 
			
		||||
++  is-straight-flush
 | 
			
		||||
  |=  i=[* h=sorted *]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  ?&  (is-straight i)
 | 
			
		||||
      (is-flush i)
 | 
			
		||||
  ==
 | 
			
		||||
++  one-of
 | 
			
		||||
  |=  [n=@ [g=grouped * *]]
 | 
			
		||||
  ^-  @
 | 
			
		||||
  =|  t=@
 | 
			
		||||
  |-
 | 
			
		||||
  ?~  g  t
 | 
			
		||||
  ?:  =(n (lent i.g))
 | 
			
		||||
    $(g t.g, t .+(t))
 | 
			
		||||
  $(g t.g)
 | 
			
		||||
++  is-four-of-a-kind
 | 
			
		||||
  |=  i=[g=grouped * *]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  =(1 (one-of 4 i))
 | 
			
		||||
++  is-full-house
 | 
			
		||||
  |=  i=[g=grouped * *]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  ?&  =(1 (one-of 3 i))
 | 
			
		||||
      =(1 (one-of 2 i))
 | 
			
		||||
  ==
 | 
			
		||||
++  is-three-of-a-kind
 | 
			
		||||
  |=  i=[g=grouped * *]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  =(1 (one-of 3 i))
 | 
			
		||||
++  is-two-pair
 | 
			
		||||
  |=  i=[g=grouped * *]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  =(2 (one-of 2 i))
 | 
			
		||||
++  is-pair
 | 
			
		||||
  |=  i=[g=grouped * *]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  =(1 (one-of 2 i))
 | 
			
		||||
++  con-tb
 | 
			
		||||
  |=  fh=hands
 | 
			
		||||
  =/  o=[t=title r=@]  (get-title fh)
 | 
			
		||||
  [r.o t.o fh (get-tiebreaker fh)]
 | 
			
		||||
++  get-tiebreaker
 | 
			
		||||
  |=  [g=grouped * *]
 | 
			
		||||
  ^-  tiebreaker
 | 
			
		||||
  =.  g  (sort g tuple-sort)
 | 
			
		||||
  (turn g tuple-tb)
 | 
			
		||||
++  tuple-tb
 | 
			
		||||
  |=  l=(list card)
 | 
			
		||||
  ^-  [v=@ s=@]
 | 
			
		||||
  =|  sv=@
 | 
			
		||||
  =|  vv=@
 | 
			
		||||
  |-
 | 
			
		||||
  ?~  l  [vv sv]
 | 
			
		||||
  =.  vv  val.i.l
 | 
			
		||||
  ?.  (gth (suit-to-num i.l) sv)
 | 
			
		||||
    $(l t.l)
 | 
			
		||||
  $(l t.l, sv (suit-to-num i.l))
 | 
			
		||||
++  tuple-sort
 | 
			
		||||
  |=  [a=(list card) b=(list card)]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  =/  la  (lent a)
 | 
			
		||||
  =/  lb  (lent b)
 | 
			
		||||
  ?.  =(la lb)
 | 
			
		||||
    (gth la lb)
 | 
			
		||||
  ?~  a  !!
 | 
			
		||||
  ?~  b  !!
 | 
			
		||||
  ?:  =(val.i.a val.i.b)
 | 
			
		||||
    (gth (suit-to-num i.a) (suit-to-num i.b))
 | 
			
		||||
  (gth val.i.a val.i.b)
 | 
			
		||||
--
 | 
			
		||||
 | 
			
		||||
							
								
								
									
										42
									
								
								201/week2/dfs.hoon
									
									
									
									
									
										Normal file
									
								
							
							
						
						
									
										42
									
								
								201/week2/dfs.hoon
									
									
									
									
									
										Normal file
									
								
							| 
						 | 
				
			
			@ -0,0 +1,42 @@
 | 
			
		|||
:: Hoon 201 - Week 2
 | 
			
		||||
:: ~bannum-magtus || s@p7.co.nz
 | 
			
		||||
::
 | 
			
		||||
:: i could not figure out how to
 | 
			
		||||
:: cast the output of a wet gate
 | 
			
		||||
:: to a list of the same type :(
 | 
			
		||||
::
 | 
			
		||||
:-  %say
 | 
			
		||||
|=  [* [t=(tree @) x=@ ~] *]
 | 
			
		||||
:-  %noun
 | 
			
		||||
^-  [? (list @)]
 | 
			
		||||
=<  
 | 
			
		||||
:-  (dfs-search t x)  (dfs t)
 | 
			
		||||
|%
 | 
			
		||||
++  dfs
 | 
			
		||||
  |=  t=(tree @)
 | 
			
		||||
  ^-  (list @)
 | 
			
		||||
  ?~  t
 | 
			
		||||
    ~
 | 
			
		||||
  %+  weld
 | 
			
		||||
    (dfs l.t)
 | 
			
		||||
  %+  weld
 | 
			
		||||
    (dfs r.t)
 | 
			
		||||
  [n.t ~]
 | 
			
		||||
++  dfs-search
 | 
			
		||||
  |=  [t=(tree @) x=@]
 | 
			
		||||
  ^-  ?
 | 
			
		||||
  ?~  t
 | 
			
		||||
    %.n
 | 
			
		||||
  ?|  (dfs-search l.t x)
 | 
			
		||||
      (dfs-search r.t x)
 | 
			
		||||
      =(n.t x)
 | 
			
		||||
  ==
 | 
			
		||||
  :: i assume ?| will stop as
 | 
			
		||||
  :: soon as it sees a true,
 | 
			
		||||
  :: otherwise below is better
 | 
			
		||||
  ::
 | 
			
		||||
  ::?:  (dfs-search l.t x)  %.y
 | 
			
		||||
  ::?:  (dfs-search r.t x)  %.y
 | 
			
		||||
  ::=(x n.t)
 | 
			
		||||
--
 | 
			
		||||
 | 
			
		||||
		Loading…
	
		Reference in a new issue