first attempt to model lemma-1
authorHelmut Grohne <helmut@subdivi.de>
Thu, 19 Jan 2012 10:33:17 +0000 (11:33 +0100)
committerHelmut Grohne <helmut@subdivi.de>
Thu, 19 Jan 2012 10:33:17 +0000 (11:33 +0100)
Without using the stdlib basic data structures are defined (with the
stdlib names in mind). The IntMap given in the paper is translated to a
NatMap. There are definitions for checkInsert and assoc resulting in a
formalization of lemma-1.

Bidir.agda [new file with mode: 0644]

diff --git a/Bidir.agda b/Bidir.agda
new file mode 100644 (file)
index 0000000..e2706a0
--- /dev/null
@@ -0,0 +1,108 @@
+module Bidir where
+
+data Bool : Set where
+  true : Bool
+  false : Bool
+
+not : Bool â†’ Bool
+not true = false
+not false = true
+
+data â„• : Set where
+  zero : â„•
+  suc : â„• â†’ â„•
+
+equal? : â„• -> â„• -> Bool
+equal? zero    zero    = true
+equal? (suc n) (suc m) = equal? n m
+equal? _       _       = false
+
+data Maybe (A : Set) : Set where
+  nothing : Maybe A
+  just : A â†’ Maybe A
+
+maybeToBool : {A : Set} â†’ Maybe A â†’ Bool
+maybeToBool nothing  = false
+maybeToBool (just _) = true
+
+maybe′ : {A B : Set} â†’ (A â†’ Maybe B) â†’ Maybe B â†’ Maybe A â†’ Maybe B
+maybe′ y _ (just a) = y a
+maybe′ _ n nothing  = n
+
+data _×_ (A B : Set) : Set where
+  _,_ : A â†’ B â†’ A Ã— B
+
+data List (A : Set) : Set where
+  [] : List A
+  _∷_ : A â†’ List A â†’ List A
+
+_++_ : {A : Set} â†’ List A â†’ List A â†’ List A
+_++_ []        ys = ys
+_++_ (x âˆ· xs) ys = x âˆ· (xs ++ ys)
+
+map : {A B : Set} â†’ (A â†’ B) â†’ List A â†’ List B
+map f []        = []
+map f (x âˆ· xs) = f x âˆ· map f xs
+
+zip : {A B : Set} â†’ List A â†’ List B â†’ List (A Ã— B)
+zip (a âˆ· as) (b âˆ· bs) = (a , b) âˆ· zip as bs
+zip _         _         = []
+
+data _==_ {A : Set}(x : A) : A â†’ Set where
+  refl : x == x
+
+module NatMap where
+
+  NatMap : Set â†’ Set
+  NatMap A = List (â„• Ã— A)
+
+  lookup : {A : Set} â†’ â„• â†’ NatMap A â†’ Maybe A
+  lookup n []       = nothing
+  lookup n ((m , a) âˆ· xs) with equal? n m
+  lookup n ((m , a) âˆ· xs) | true = just a
+  lookup n ((m , a) âˆ· xs) | false        = lookup n xs
+
+  notMember : {A : Set} â†’ â„• â†’ NatMap A â†’ Bool
+  notMember n m = not (maybeToBool (lookup n m))
+
+  -- For now we simply prepend the element. This may lead to duplicates.
+  insert : {A : Set} â†’ â„• â†’ A â†’ NatMap A â†’ NatMap A
+  insert n a m = (n , a) âˆ· m
+
+  fromAscList : {A : Set} â†’ List (â„• Ã— A) â†’ NatMap A
+  fromAscList []       = []
+  fromAscList ((n , a) âˆ· xs) = insert n a (fromAscList xs)
+
+  empty : {A : Set} â†’ NatMap A
+  empty = []
+
+  union : {A : Set} â†’ NatMap A â†’ NatMap A â†’ NatMap A
+  union []       m = m
+  union ((n , a) âˆ· xs) m = insert n a (union xs m)
+
+open NatMap
+
+checkInsert : {A : Set} â†’ (A â†’ A â†’ Bool) â†’ â„• â†’ A â†’ NatMap A â†’ Maybe (NatMap A)
+checkInsert eq i b m with lookup i m
+checkInsert eq i b m | just c with eq b c
+checkInsert eq i b m | just c | true = just m
+checkInsert eq i b m | just c | false = nothing
+checkInsert eq i b m | nothing = just (insert i b m)
+
+assoc : {A : Set} â†’ (A â†’ A â†’ Bool) â†’ List â„• â†’ List A â†’ Maybe (NatMap A)
+assoc _  []       []       = just empty
+assoc eq (i âˆ· is) (b âˆ· bs) = maybe′ (checkInsert eq i b) nothing (assoc eq is bs)
+assoc _  _        _        = nothing
+
+--data Equal? where
+--  same ...
+--  different ...
+
+generate : {A : Set} â†’ (â„• â†’ A) â†’ List â„• â†’ NatMap A
+generate f []       = empty
+generate f (n âˆ· ns) = insert n (f n) (generate f ns)
+
+-- this lemma is probably wrong, because two different NatMaps may represent the same semantic value.
+lemma-1 : {Ï„ : Set} â†’ (eq : Ï„ â†’ Ï„ â†’ Bool) â†’ (f : â„• â†’ Ï„) â†’ (is : List â„•) â†’ assoc eq is (map f is) == just (generate f is)
+lemma-1 eq f []        = refl
+lemma-1 eq f (i âˆ· is′) = {!!}