www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

basics.mlish (10248B)

      1 #lang s-exp "../../../mlish.rkt"
      2 (require "../../rackunit-typechecking.rkt")
      3 (require "basics-general.mlish")
      4 (require-typed map append fst snd member foldl foldr filter sum reverse
      5                #:from "basics-general.mlish")
      6 
      7 ;; =============================================================================
      8 ;; http://www.cs.cornell.edu/courses/cs3110/2011fa/hw/ps1/ps1.html
      9 
     10 (define (fn-list [f* : (List (→ A A))] [a : A] → A)
     11   (match f* with
     12    [Nil -> a]
     13    [Cons f f* -> (fn-list f* (f a))]))
     14 
     15 (check-type
     16   (fn-list (Cons (λ ([x : Int]) (+ x 1)) (Cons (λ ([x : Int]) (* x 2)) Nil)) 4)
     17   : Int
     18   ⇒ 10)
     19 
     20 ;; -----------------------------------------------------------------------------
     21 
     22 (define (count-letters/one [s : String] [c : Char] → Int)
     23   (for/sum ([i (in-range (string-length s))])
     24     (if (equal? (string-ref s i) c)
     25       1
     26       0)))
     27 
     28 (define (count-letters [s* : (List String)] [c : Char] → Int)
     29   (match s* with
     30    [Nil -> 0]
     31    [Cons s s* -> (+ (count-letters/one s c)
     32                     (count-letters s* c))]))
     33 
     34 (check-type
     35   (count-letters (Cons "OCaml" (Cons "Is" (Cons "Alot" (Cons "Better" (Cons "Than" (Cons "Java" Nil)))))) (string-ref "a" 0))
     36   : Int
     37   ⇒ 4)
     38 
     39 ;; -----------------------------------------------------------------------------
     40 
     41 (define (flatten [x** : (List (List A))] → (List A))
     42   (match x** with
     43    [Nil -> Nil]
     44    [Cons x* x** -> (append x* (flatten x**))]))
     45 
     46 (define (insert [x : A] → (→ (List A) (List (List A))))
     47   (λ ([x* : (List A)])
     48     (Cons (Cons x x*)
     49       (match x* with
     50        [Nil -> Nil]
     51        [Cons y y* -> (map (λ ([z* : (List A)]) (Cons y z*))
     52                           ((insert x) y*))]))))
     53 
     54 (define (permutations [x* : (List A)] → (List (List A)))
     55   (match x* with
     56    [Nil -> (Cons Nil Nil)]
     57    [Cons x x* -> (flatten (map (insert x) (permutations x*)))]))
     58 
     59 (check-type
     60   (permutations Nil)
     61   : (List (List Int))
     62   ⇒ (Cons Nil Nil))
     63 
     64 (check-type
     65   (permutations (Cons 1 Nil))
     66   : (List (List Int))
     67   ⇒ (Cons (Cons 1 Nil) Nil))
     68 
     69 (check-type
     70   (permutations (Cons 1 (Cons 2 Nil)))
     71   : (List (List Int))
     72   ⇒ (Cons (Cons 1 (Cons 2 Nil)) (Cons (Cons 2 (Cons 1 Nil)) Nil)))
     73 
     74 (check-type
     75   (permutations (Cons 1 (Cons 2 (Cons 3 Nil))))
     76   : (List (List Int))
     77   ⇒ (Cons (Cons 1 (Cons 2 (Cons 3 Nil)))
     78     (Cons (Cons 2 (Cons 1 (Cons 3 Nil)))
     79     (Cons (Cons 2 (Cons 3 (Cons 1 Nil)))
     80     (Cons (Cons 1 (Cons 3 (Cons 2 Nil)))
     81     (Cons (Cons 3 (Cons 1 (Cons 2 Nil)))
     82     (Cons (Cons 3 (Cons 2 (Cons 1 Nil)))
     83     Nil)))))))
     84 
     85 ;; =============================================================================
     86 ;; http://www.cs.cornell.edu/courses/cs3110/2011sp/hw/ps1/ps1.htm
     87 
     88 (define (split [ab* : (List (** A B))] → (** (List A) (List B)))
     89   (match ab* with
     90    [Nil -> (Pair Nil Nil)]
     91    [Cons ab ab* ->
     92     (match ab with
     93      [Pair a b ->
     94       (match (split ab*) with
     95        [Pair a* b* ->
     96         (Pair (Cons a a*)
     97               (Cons b b*))])])]))
     98 
     99 (check-type
    100   (split Nil)
    101   : (** (List Int) (List Int))
    102   ⇒ (Pair Nil Nil))
    103 
    104 (check-type
    105   (split (Cons (Pair 1 2) (Cons (Pair 3 4) Nil)))
    106   : (** (List Int) (List Int))
    107   ⇒ (Pair (Cons 1 (Cons 3 Nil))
    108           (Cons 2 (Cons 4 Nil))))
    109 
    110 (check-type
    111   (split (Cons (Pair 1 "one") (Cons (Pair 2 "two") (Cons (Pair 3 "three") Nil))))
    112   : (** (List Int) (List String))
    113   ⇒ (Pair (Cons 1 (Cons 2 (Cons 3 Nil)))
    114           (Cons "one" (Cons "two" (Cons "three" Nil)))))
    115 
    116 ;; -----------------------------------------------------------------------------
    117 
    118 (define (combine [a*b* : (** (List A) (List B))] → (List (** A B)))
    119   (match a*b* with
    120    [Pair a* b* ->
    121     (match a* with
    122      [Nil ->
    123       (match b* with
    124        [Nil ->
    125         Nil]
    126        [Cons b b* ->
    127         Nil])] ;; Error
    128      [Cons a a* ->
    129       (match b* with
    130        [Nil ->
    131         Nil] ;; Error
    132        [Cons b b* ->
    133         (Cons (Pair a b) (combine (Pair a* b*)))])])]))
    134 
    135 (check-type
    136   (combine (Pair Nil Nil))
    137   : (List (** Int Int))
    138   ⇒ Nil)
    139 
    140 (check-type
    141   (combine (Pair (Cons 1 (Cons 2 Nil)) (Cons 3 (Cons 4 Nil))))
    142   : (List (** Int Int))
    143   ⇒ (Cons (Pair 1 3) (Cons (Pair 2 4) Nil)))
    144 
    145 (check-type
    146   (combine (split (Cons (Pair 1 "one") (Cons (Pair 2 "two") (Cons (Pair 3 "three") Nil)))))
    147   : (List (** Int String))
    148   ⇒ (Cons (Pair 1 "one") (Cons (Pair 2 "two") (Cons (Pair 3 "three") Nil))))
    149 
    150 ;; -----------------------------------------------------------------------------
    151 
    152 (define (convolve [x* : (List Float)] [y* : (List Float)] → Float)
    153   (sum
    154     (map (λ ([xy : (** Float Float)]) (fl* (fst xy) (snd xy)))
    155       (combine (Pair x* (reverse y*))))))
    156 
    157 (check-type
    158   (convolve (Cons 1.0 (Cons 2.0 (Cons 3.0 Nil))) (Cons 1.0 (Cons 2.0 (Cons 3.0 Nil))))
    159   : Float
    160   ⇒ (fl+ (fl+ (fl* 1.0 3.0) (fl* 2.0 2.0)) (fl* 3.0 1.0)))
    161 
    162 ;; -----------------------------------------------------------------------------
    163 
    164 (define (mc [n : Int] [f : (→ A A)] [x : A] → A)
    165   (for/fold ([x x])
    166             ([_i (in-range n)])
    167     (f x)))
    168 
    169 (check-type
    170   (mc 3000 (λ ([n : Int]) (+ n 1)) 3110)
    171   : Int
    172   ⇒ 6110)
    173 
    174 (define (square [n : Int] → Int)
    175   (* n n))
    176 
    177 (check-type
    178   (mc 0 square 2)
    179   : Int
    180   ⇒ 2)
    181 
    182 (check-type
    183   (mc 2 square 2)
    184   : Int
    185   ⇒ 16)
    186 
    187 (check-type
    188   (mc 3 square 2)
    189   : Int
    190   ⇒ 256)
    191 
    192 ;; -----------------------------------------------------------------------------
    193 
    194 (define (successor [mcn : (→ (→ A A) A A)] → (→ (→ A A) A A))
    195   (λ ([f : (→ A A)] [x : A])
    196     (f (mcn f x))))
    197 
    198 (check-type
    199   ((successor (λ ([f : (→ Int Int)] [x : Int]) (mc 0 f x))) square 2)
    200   : Int
    201   ⇒ 4)
    202 
    203 (check-type
    204   ((successor (successor (λ ([f : (→ Int Int)] [x : Int]) (mc 0 f x)))) square 2)
    205   : Int
    206   ⇒ 16)
    207 
    208 (check-type
    209   ((successor (successor (successor (λ ([f : (→ Int Int)] [x : Int]) (mc 0 f x))))) square 2)
    210   : Int
    211   ⇒ 256)
    212 
    213 ;; # (mc 3 successor) (mc 0) square 2;;
    214 
    215 ;; =============================================================================
    216 ;; === sorting
    217 
    218 ;; -----------------------------------------------------------------------------
    219 ;; --- mergesort
    220 
    221 (define (split2 [x* : (List A)] → (** (List A) (List A)))
    222   (match x* with
    223    [Nil -> (Pair Nil Nil)]
    224    [Cons h t ->
    225     (match t with
    226      [Nil -> (Pair (Cons h Nil) Nil)]
    227      [Cons h2 x* ->
    228       (match (split2 x*) with
    229        [Pair x* y* ->
    230         (Pair (Cons h x*) (Cons h2 y*))])])]))
    231 
    232 (define (merge [x*+y* : (** (List Int) (List Int))] → (List Int))
    233   (match x*+y* with
    234    [Pair xx* yy* ->
    235     (match xx* with
    236      [Nil -> yy*]
    237      [Cons x x* ->
    238       (match yy* with
    239        [Nil -> xx*]
    240        [Cons y y* ->
    241         (if (<= x y)
    242          (Cons x (merge (Pair x* yy*)))
    243          (Cons y (merge (Pair xx* y*))))])])]))
    244 
    245 (define (mergesort [x* : (List Int)] → (List Int))
    246   (match x* with
    247    [Nil -> Nil]
    248    [Cons h t ->
    249     (match t with
    250      [Nil -> (Cons h Nil)]
    251      [Cons h2 t2 ->
    252       (match (split2 x*) with
    253        [Pair x* y* ->
    254         (merge (Pair (mergesort x*) (mergesort y*)))])])]))
    255 
    256 (check-type (mergesort Nil) : (List Int) ⇒ Nil)
    257 
    258 (check-type
    259   (mergesort (Cons 1 (Cons 2 (Cons 3 (Cons 4 Nil)))))
    260   : (List Int)
    261   ⇒ (Cons 1 (Cons 2 (Cons 3 (Cons 4 Nil)))))
    262 
    263 (check-type
    264   (mergesort (Cons 3 (Cons 7 (Cons 93 (Cons 0 (Cons 2 Nil))))))
    265   : (List Int)
    266   ⇒ (Cons 0 (Cons 2 (Cons 3 (Cons 7 (Cons 93 Nil))))))
    267 
    268 ;; -----------------------------------------------------------------------------
    269 ;; --- quicksort
    270 
    271 (define (quicksort [x* : (List Int)] → (List Int))
    272   (match x* with
    273    [Nil -> x*]
    274    [Cons h t ->
    275     (match t with
    276      [Nil -> x*]
    277      [Cons h2 t2 ->
    278       (append
    279         (quicksort (filter (λ ([y : Int]) (if (<= y h) True False)) t))
    280         (append
    281           (Cons h Nil)
    282           (quicksort (filter (λ ([y : Int]) (if (> y h) True False)) t))))])]))
    283 
    284 (check-type (quicksort Nil) : (List Int) ⇒ Nil)
    285 
    286 (check-type
    287   (quicksort (Cons 1 (Cons 2 (Cons 3 (Cons 4 Nil)))))
    288   : (List Int)
    289   ⇒ (Cons 1 (Cons 2 (Cons 3 (Cons 4 Nil)))))
    290 
    291 (check-type
    292   (quicksort (Cons 3 (Cons 7 (Cons 93 (Cons 0 (Cons 2 Nil))))))
    293   : (List Int)
    294   ⇒ (Cons 0 (Cons 2 (Cons 3 (Cons 7 (Cons 93 Nil))))))
    295 
    296 ;; =============================================================================
    297 ;; === CPS
    298 
    299 ;; -----------------------------------------------------------------------------
    300 ;; --- factorial
    301 
    302 (define (fact [n : Int] → Int)
    303   (if (< n 2)
    304     1
    305     (* n (fact (- n 1)))))
    306 
    307 (define (range-aux [n : Int] → (List Int))
    308   (if (= 0 n)
    309     (Cons n Nil)
    310     (Cons n (range-aux (- n 1)))))
    311 
    312 (define (range [n : Int] → (List Int))
    313   (if (<= n 0)
    314     Nil
    315     (reverse (range-aux (- n 1)))))
    316 
    317 (define (fact-acc [n : Int] → Int)
    318   (foldl (λ ([acc : Int] [n : Int]) (* n acc)) 1 (map (λ ([n : Int]) (+ n 1)) (range n))))
    319 
    320 (define (fact-cps-aux [n : Int] [k : (→ Int Int)] → Int)
    321   (if (< n 2)
    322     (k 1)
    323     (fact-cps-aux (- n 1) (λ ([m : Int]) (k (* n m))))))
    324 
    325 (define (fact-cps [n : Int] → Int)
    326   (fact-cps-aux n (λ ([x : Int]) x)))
    327 
    328 (check-type (fact 0) : Int ⇒ 1)
    329 (check-type (fact 1) : Int ⇒ 1)
    330 (check-type (fact 2) : Int ⇒ 2)
    331 (check-type (fact 3) : Int ⇒ 6)
    332 (check-type (fact 4) : Int ⇒ 24)
    333 (check-type (fact 5) : Int ⇒ 120)
    334 
    335 (check-type (fact-acc 0) : Int ⇒ 1)
    336 (check-type (fact-acc 1) : Int ⇒ 1)
    337 (check-type (fact-acc 2) : Int ⇒ 2)
    338 (check-type (fact-acc 3) : Int ⇒ 6)
    339 (check-type (fact-acc 4) : Int ⇒ 24)
    340 (check-type (fact-acc 5) : Int ⇒ 120)
    341 
    342 (check-type (fact-cps 0) : Int ⇒ 1)
    343 (check-type (fact-cps 1) : Int ⇒ 1)
    344 (check-type (fact-cps 2) : Int ⇒ 2)
    345 (check-type (fact-cps 3) : Int ⇒ 6)
    346 (check-type (fact-cps 4) : Int ⇒ 24)
    347 (check-type (fact-cps 5) : Int ⇒ 120)
    348 
    349 ;; -----------------------------------------------------------------------------
    350 ;; --- map
    351 
    352 (define (map-cps-aux [f : (→ A B)] [x* : (List A)] [k : (→ (List B) (List B))] → (List B))
    353   (match x* with
    354    [Nil -> (k Nil)]
    355    [Cons x x* ->
    356     (map-cps-aux f x* (λ ([b* : (List B)]) (k (Cons (f x) b*))))]))
    357 
    358 (define (map-cps [f : (→ A B)] [x* : (List A)] → (List B))
    359   (map-cps-aux f x* (λ ([x : (List B)]) x)))
    360 
    361 (check-type
    362   (map-cps (λ ([x : Int]) (+ x 2)) (Cons 2 (Cons 4 (Cons 8 Nil))))
    363   : (List Int)
    364   ⇒ (Cons 4 (Cons 6 (Cons 10 Nil))))
    365 
    366 (check-type
    367   (map-cps exact->inexact (Cons 2 (Cons 4 (Cons 8 Nil))))
    368   : (List Float)
    369   ⇒ (Cons 2.0 (Cons 4.0 (Cons 8.0 Nil))))
    370