www

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

basics2.mlish (4838B)

      1 #lang s-exp "../../../mlish.rkt"
      2 (require "../../rackunit-typechecking.rkt")
      3 (require "basics-general.mlish")
      4 (require-typed append filter foldr foldl reverse snd member 
      5                #:from "basics-general.mlish")
      6 
      7 
      8 ;; =============================================================================
      9 ;; http://www.cs.cornell.edu/courses/cs3110/2011fa/hw/ps1/ps1.html
     10 ;; continued
     11 
     12 ;; -----------------------------------------------------------------------------
     13 
     14 (define (map-index [is* : (List (** Int (List String)))] → (List (** String Int)))
     15   (match is* with
     16    [Nil -> Nil]
     17    [Cons hd tl ->
     18     (match hd with
     19      [Pair i s* ->
     20       (append (foldr (λ ([s : String] [acc : (List (** String Int))]) (Cons (Pair s i) acc))
     21                      s*
     22                      Nil)
     23               (map-index tl))])]))
     24 
     25 (check-type
     26   (map-index Nil)
     27   : (List (** String Int))
     28   ⇒ Nil)
     29 
     30 (check-type
     31   (map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil)))) Nil))
     32   : (List (** String Int))
     33   ⇒ (Cons (Pair "a" 0) (Cons (Pair "b" 0) (Cons (Pair "c" 0) Nil))))
     34 
     35 (check-type
     36   (map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
     37              (Cons (Pair 1 (Cons "d" (Cons "e" Nil)))
     38              Nil)))
     39   : (List (** String Int))
     40   ⇒ (Cons (Pair "a" 0) (Cons (Pair "b" 0) (Cons (Pair "c" 0) (Cons (Pair "d" 1) (Cons (Pair "e" 1) Nil))))))
     41 
     42 (define (reduce-index [si* : (List (** String Int))] → (List (** String (List Int))))
     43   (snd (foldr
     44     (λ ([si : (** String Int)] [acc : (** (List String) (List (** String (List Int))))])
     45       (match si with
     46        [Pair s i ->
     47         (match acc with
     48          [Pair seen out ->
     49           (match (member seen s) with
     50            [True ->
     51             (Pair
     52               seen
     53               (foldr
     54                 (λ ([si* : (** String (List Int))] [acc : (List (** String (List Int)))])
     55                   (match si* with
     56                    [Pair s2 i* ->
     57                     (if (equal? s s2)
     58                       (match (member i* i) with
     59                        [True -> (Cons si* acc)]
     60                        [False -> (Cons (Pair s2 (Cons i i*)) acc)])
     61                       (Cons si* acc))]))
     62                 out
     63                 Nil))]
     64            [False ->
     65             (Pair
     66               (Cons s seen)
     67               (Cons (Pair s (Cons i Nil)) out))])])]))
     68     si*
     69     (Pair Nil Nil))))
     70 
     71 
     72 (check-type
     73   (reduce-index Nil)
     74   : (List (** String (List Int)))
     75   ⇒ Nil)
     76 
     77 (check-type
     78   (reduce-index
     79     (map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
     80                (Cons (Pair 1 (Cons "d" (Cons "e" Nil)))
     81                Nil))))
     82   : (List (** String (List Int)))
     83   ⇒ (Cons (Pair "a" (Cons 0 Nil))
     84     (Cons (Pair "b" (Cons 0 Nil))
     85     (Cons (Pair "c" (Cons 0 Nil))
     86     (Cons (Pair "d" (Cons 1 Nil))
     87     (Cons (Pair "e" (Cons 1 Nil))
     88     Nil))))))
     89 
     90 (check-type
     91   (reduce-index
     92     (map-index (Cons (Pair 0 (Cons "a" (Cons "b" (Cons "c" Nil))))
     93                (Cons (Pair 1 (Cons "a" (Cons "b" Nil)))
     94                Nil))))
     95   : (List (** String (List Int)))
     96   ⇒ (Cons (Pair "c" (Cons 0 Nil))
     97     (Cons (Pair "a" (Cons 0 (Cons 1 Nil)))
     98     (Cons (Pair "b" (Cons 0 (Cons 1 Nil)))
     99     Nil))))
    100 
    101 ;; For every string, get all integers that refer to the string
    102 (define (make-index [is* : (List (** Int (List String)))] 
    103           → (List (** String (List Int))))
    104   (reduce-index (map-index is*)))
    105 
    106 (check-type
    107   (make-index Nil)
    108   : (List (** String (List Int)))
    109   ⇒ Nil)
    110 
    111 (check-type
    112   (make-index (Cons (Pair 1 (Cons "ocaml" (Cons "is" (Cons "fun" (Cons "because" (Cons "fun" (Cons "is" (Cons "a" (Cons "keyword" Nil)))))))))
    113               (Cons (Pair 2 (Cons "page" (Cons "2" (Cons "intentionally" (Cons "left" (Cons "blank" Nil))))))
    114               (Cons (Pair 3 (Cons "the" (Cons "quick" (Cons "brown" (Cons "fox" (Cons "jumped" (Cons "over" (Cons "the" (Cons "lazy" (Cons "dog" Nil))))))))))
    115               (Cons (Pair 4 (Cons "is" (Cons "this" (Cons "the" (Cons "end" Nil))))) Nil)))))
    116   : (List (** String (List Int)))
    117   ⇒ (Cons (Pair "ocaml" (Cons 1 Nil))
    118     (Cons (Pair "because" (Cons 1 Nil))
    119     (Cons (Pair "fun" (Cons 1 Nil))
    120     (Cons (Pair "a" (Cons 1 Nil))
    121     (Cons (Pair "keyword" (Cons 1 Nil))
    122     (Cons (Pair "page" (Cons 2 Nil))
    123     (Cons (Pair "2" (Cons 2 Nil))
    124     (Cons (Pair "intentionally" (Cons 2 Nil))
    125     (Cons (Pair "left" (Cons 2 Nil))
    126     (Cons (Pair "blank" (Cons 2 Nil))
    127     (Cons (Pair "quick" (Cons 3 Nil))
    128     (Cons (Pair "brown" (Cons 3 Nil))
    129     (Cons (Pair "fox" (Cons 3 Nil))
    130     (Cons (Pair "jumped" (Cons 3 Nil))
    131     (Cons (Pair "over" (Cons 3 Nil))
    132     (Cons (Pair "lazy" (Cons 3 Nil))
    133     (Cons (Pair "dog" (Cons 3 Nil))
    134     (Cons (Pair "is" (Cons 1 (Cons 4 Nil)))
    135     (Cons (Pair "this" (Cons 4 Nil))
    136     (Cons (Pair "the" (Cons 3 (Cons 4 Nil)))
    137     (Cons (Pair "end" (Cons 4 Nil)) Nil))))))))))))))))))))))
    138