Commit f1c63eac authored by Nicola Botta's avatar Nicola Botta
Browse files

Added components for the implementation of 'next'.

parent c615cf82
> module FastSimpleProb.BasicOperations
> import Data.List
> import Data.So
> import Syntax.PreorderReasoning
> import FastSimpleProb.SimpleProb
> import Double.Predicates
> import NonNegDouble.NonNegDouble
> import NonNegDouble.Constants
> import NonNegDouble.BasicOperations
> import NonNegDouble.Operations
> import NonNegDouble.Properties
> import NonNegDouble.Postulates
> import List.Operations
> import List.Properties
> import Fun.Operations
> import Pairs.Operations
> %default total
> %access public export
> %auto_implicits off
> using implementation NumNonNegDouble
> |||
> mkSimpleProb : {A : Type} ->
> (aps : List (A, NonNegDouble)) ->
> {auto prf : Positive (toDouble (sumMapSnd aps))} ->
> SimpleProb A
> mkSimpleProb aps {prf} = MkSimpleProb aps prf
> |||
> toList : {A : Type} -> SimpleProb A -> List (A, NonNegDouble)
> toList (MkSimpleProb aps _) = aps
> |||
> support : {A : Type} -> SimpleProb A -> List A
> support = (map fst) . toList
> using implementation NumNonNegDouble
> |||
> rescale : {A : Type} ->
> (p : NonNegDouble) -> Positive (toDouble p) -> SimpleProb A -> SimpleProb A
> rescale {A} p pp (MkSimpleProb aps psum) = MkSimpleProb aps' psum' where
> aps' : List (A, NonNegDouble)
> aps' = mapIdRightMult (aps, p)
> psum' : Positive (toDouble (sumMapSnd aps'))
> psum' = mapIdRightMultPreservesPositivity aps psum p pp
> using implementation NumNonNegDouble
> using implementation FractionalNonNegDouble
> |||
> normalize : {A : Type} ->
> SimpleProb A -> SimpleProb A
> normalize (MkSimpleProb aps psum) =
> let p : NonNegDouble
> = one / (sumMapSnd aps) in
> let pp : Positive (toDouble p)
> = divPreservesPositivity positiveOne psum in
> rescale p pp (MkSimpleProb aps psum)
> |||
> weights : {A : Type} -> SimpleProb A -> List NonNegDouble
> weights = (map snd) . toList
> using implementation NumNonNegDouble
> ||| 'weight sp a' is the weight of 'a' according to 'sp'
> weight : {A : Type} -> (Eq A) => SimpleProb A -> A -> NonNegDouble
> weight sp a = foldr f (fromInteger 0) (toList sp) where
> f : (A, NonNegDouble) -> NonNegDouble -> NonNegDouble
> f (a', w') w = if (a == a') then w + w' else w
> using implementation FractionalNonNegDouble
> ||| 'prob sp a' is the probability of 'a' according to 'sp'
> prob : {A : Type} -> (Eq A) => SimpleProb A -> A -> NonNegDouble
> prob sp a = (weight sp a) / (sum (weights sp))
> {-
> ||| 'prob sp a' is the probability of 'a' according to 'sp'
> prob : {A : Type} -> (Eq A) => SimpleProb A -> A -> Double
> prob sp a = fst pq / snd pq where
> f : (A, Double) -> (Double, Double) -> (Double, Double)
> f (a', p') (p, q) = if (a == a') then (p + p', q + p') else (p, q + p')
> pq : (Double, Double)
> pq = foldr f (0.0, 0.0) (toList sp)
> -}
> using implementation NumNonNegDouble
> ||| Make a SimpleProb in which all elements of a list have the same
> ||| probablility. If the list has no duplicates, this results in a
> ||| uniform probability distribution
> mkFlatSimpleProb : {A : Type} -> (as : List A) -> List.Operations.NonEmpty as -> SimpleProb A
> mkFlatSimpleProb Nil prf = absurd prf
> mkFlatSimpleProb {A} (a :: Nil) _ = MkSimpleProb [(a, one)] positiveOne
> mkFlatSimpleProb {A} (a :: (a' :: as)) _ = MkSimpleProb aps prf where
> ps' : SimpleProb A
> ps' = assert_total (mkFlatSimpleProb (a' :: as) ())
> aps : List (A, NonNegDouble)
> aps = (a, one) :: (toList ps')
> prf : Positive (toDouble (sumMapSnd aps))
> prf = sumMapSndConsLemma1 a 1.0 positiveOne (MkLTE Oh) (toList ps')
> using implementation NumNonNegDouble
> using implementation EqNonNegDouble
> |||
> trim : {A : Type} -> (Eq A) =>
> SimpleProb A -> SimpleProb A
> trim {A} (MkSimpleProb aps psum) = MkSimpleProb aps' psum' where
> aps' : List (A, NonNegDouble)
> aps' = discardBySndZeroEq aps
> psum' : Positive (toDouble (sumMapSnd aps'))
> psum' = replace {P = \ X => Positive (toDouble X)} (sym (discardBySndZeroLemmaEq aps)) psum
> using implementation ShowNonNegDouble
> |||
> showlong : {A : Type} -> Show A => SimpleProb A -> String
> showlong sp = showlong (toList sp)
> {-
> ---}
> module List.Properties
> import Data.List
> import Data.List.Quantifiers
> import Data.Fin
> import Control.Isomorphism
> import Syntax.PreorderReasoning
> import List.Predicates
> import List.Operations
> import Fun.Predicates
> import Fun.Operations
> import Fun.Properties
> import Unique.Predicates
> import Finite.Predicates
> import Finite.Operations
> import Sigma.Sigma
> import Pairs.Operations
> import Basic.Operations
> import Fin.Properties
> import Void.Properties
> import Unit.Properties
> import Num.Refinements
> import Pair.Properties
> import VeriFunctor.VeriFunctor
> import VeriMonad.VeriMonad
> %default total
> %auto_implicits off
> %access public export
* Basic properties:
> ||| `join` distributes over `++`
> joinDistributesOverAppend : {X : Type} ->
> (xss : List (List X)) -> (yss : List (List X)) ->
> join (xss ++ yss) = join xss ++ join yss
> joinDistributesOverAppend Nil yss = Refl
> joinDistributesOverAppend (xs :: xss) yss = ( join ((xs :: xss) ++ yss) )
> ={ Refl }=
> ( join (xs :: (xss ++ yss)) )
> ={ Refl }=
> ( xs ++ join (xss ++ yss) )
> ={ cong (joinDistributesOverAppend xss yss) }=
> ( xs ++ (join xss ++ join yss) )
> ={ appendAssociative xs (join xss) (join yss) }=
> ( (xs ++ join xss) ++ join yss )
> ={ Refl }=
> ( join (xs :: xss) ++ join yss )
> QED
> ||| `concatMap f` distributes over `++`
> concatMapDistributesOverAppend : {X, Y : Type} ->
> (xs : List X) -> (ys : List X) ->
> (f : X -> List Y) ->
> concatMap f (xs ++ ys) = concatMap f xs ++ concatMap f ys
> concatMapDistributesOverAppend Nil ys f = Refl
> concatMapDistributesOverAppend (x :: xs) ys f = ( concatMap f ((x :: xs) ++ ys) )
> ={ Refl }=
> ( concatMap f (x :: (xs ++ ys)) )
> ={ Refl }=
> ( f x ++ concatMap f (xs ++ ys) )
> ={ cong (concatMapDistributesOverAppend xs ys f) }=
> ( f x ++ (concatMap f xs ++ concatMap f ys) )
> ={ appendAssociative (f x) (concatMap f xs) (concatMap f ys) }=
> ( (f x ++ concatMap f xs) ++ concatMap f ys )
> ={ Refl }=
> ( concatMap f (x :: xs) ++ concatMap f ys )
> QED
* Functorial properties:
> implementation VeriFunctor List where
> -- mapPresId : {X : Type} -> ExtEq {A = List X} (map id) id
> mapPresId Nil = Refl
> mapPresId (x :: xs) = ( map id (x :: xs) )
> ={ cong (mapPresId xs) }=
> ( x :: xs )
> QED
> -- mapPresComp : {X, Y, Z : Type} -> (f : X -> Y) -> (g : Y -> Z) -> ExtEq {A = List X} (map (g . f)) (map g . map f)
> mapPresComp f g Nil = Refl
> mapPresComp f g (x :: xs) = ( map (g . f) (x :: xs) )
> ={ cong (mapPresComp f g xs) }=
> ( (map g . map f) (x :: xs) )
> QED
> -- mapPresExtEq : {A, B : Type} -> (f, g : A -> B) -> ExtEq f g -> ExtEq {A = List A} (map f) (map g)
> mapPresExtEq f g eeq Nil = Refl
> mapPresExtEq f g eeq (a :: as) = let ih = mapPresExtEq f g eeq as in
> ( map f (a :: as) )
> ={ cong {f = \ α => α :: map f as} (eeq a) }=
> ( g a :: map f as )
> ={ cong ih }=
> ( map g (a :: as) )
> QED
* Monadic properties:
> implementation VeriMonad List where
> -- bindJoinMapSpec : {X, Y : Type} -> (f : X -> List Y) -> ExtEq {A = List X} (\ xs => xs >>= f) (join . map f)
> bindJoinMapSpec f Nil = Refl
> bindJoinMapSpec f (x :: xs) = ( (x :: xs) >>= f )
> ={ Refl }=
> ( f x ++ (xs >>= f) )
> ={ cong (bindJoinMapSpec f xs) }=
> ( f x ++ join (map f xs) )
> ={ Refl }=
> ( join (map f (x :: xs)) )
> QED
> -- pureNatTrans : {X, Y : Type} -> (f : X -> Y) -> ExtEq {B = List Y} (map f . pure) (pure . f)
> pureNatTrans f x = Refl
> -- joinNatTrans : {X, Y : Type} -> (f : X -> Y) -> ExtEq {A = List (List X)} (map f . join) (join . map (map f))
> joinNatTrans f Nil = ( map f (join Nil) )
> ={ Refl }=
> ( join (map (map f) Nil) )
> QED
> joinNatTrans f (xs :: xss) = ( map f (join (xs :: xss)) )
> ={ Refl }=
> ( map f (xs ++ (join xss)) )
> ={ mapAppendDistributive f xs (join xss) }=
> ( map f xs ++ map f (join xss) )
> ={ cong (joinNatTrans f xss) }=
> ( map f xs ++ join (map (map f) xss) )
> ={ Refl }=
> ( join (map (map f) (xs :: xss)) )
> QED
> -- triangleLeft : {X : Type} -> ExtEq {A = List X} (join . pure) id
> triangleLeft Nil = Refl
> triangleLeft (x :: xs) = ( join (pure (x :: xs)) )
> ={ Refl }=
> ( (pure (x :: xs)) >>= id )
> ={ Refl }=
> ( ((x :: xs) :: Nil) >>= id )
> ={ Refl }=
> ( concatMap id ((x :: xs) :: Nil) )
> ={ Refl }=
> ( foldr ((<+>) . id) neutral ((x :: xs) :: Nil) )
> ={ Refl }=
> ( ((<+>) . id) (x :: xs) (foldr ((<+>) . id) neutral Nil) )
> ={ Refl }=
> ( (x :: xs) ++ (foldr ((<+>) . id) neutral Nil) )
> ={ Refl }=
> ( (x :: xs) ++ Nil )
> ={ Refl }=
> ( x :: (xs ++ Nil) )
> ={ cong (appendNilRightNeutral xs) }=
> ( x :: xs )
> QED
> -- triangleRight : {X : Type} -> ExtEq {A = List X} (join . map pure) id
> triangleRight Nil = Refl
> triangleRight (x :: xs) = ( join (map pure (x :: xs)) )
> ={ Refl }=
> ( pure x ++ (join (map pure xs)) )
> ={ Refl }=
> ( x :: (join (map pure xs)) )
> ={ cong (triangleRight xs) }=
> ( x :: xs )
> QED
> -- square : {X : Type} -> ExtEq {A = List (List (List X))} (join . map join) (join . join)
> square Nil = Refl
> square (xss :: xsss) = ( join (map join (xss :: xsss)) )
> ={ Refl }=
> ( join xss ++ (join (map join xsss)) )
> ={ cong (square xsss) }=
> ( join xss ++ (join (join xsss)) )
> ={ sym (joinDistributesOverAppend xss (join xsss)) }=
> ( join (xss ++ join xsss) )
> ={ Refl }=
> ( join (join (xss :: xsss)) )
> QED
* Old stuff:
> -- monadSpec1 : (fmap f) . ret = ret . f
> -- monadSpec21 : bind (ret a) f = f a
> -- monadSpec22 : bind ma ret = ma
> -- monadSpec23 : {A, B, C : Type} -> {f : A -> M B} -> {g : B -> M C} ->
> -- bind (bind ma f) g = bind ma (\ a => bind (f a) g)
* |List| is a container monad:
> |||
> elemNonEmptySpec0 : {A : Type} ->
> (a : A) -> (as : List A) ->
> a `Elem` as -> List.Operations.NonEmpty as
> elemNonEmptySpec0 _ Nil p = absurd p
> elemNonEmptySpec0 _ (a :: as) _ = ()
> |||
> elemNonEmptySpec1 : {A : Type} ->
> (as : List A) ->
> List.Operations.NonEmpty as -> Sigma A (\ a => a `Elem` as)
> elemNonEmptySpec1 Nil c = void c
> elemNonEmptySpec1 (a :: as) _ = MkSigma a Here
> |||
> containerMonadSpec1 : {A : Type} -> {a : A} -> a `Elem` (ret a)
> containerMonadSpec1 {A} {a} = Here
> -- containerMonadSpec2 : {A : Type} -> (a : A) -> (ma : M A) -> (mma : M (M A)) ->
> -- a `Elem` ma -> ma `Elem` mma -> a `Elem` (join mma)
> containerMonadSpec3 : {A : Type} -> {P : A -> Type} -> (a : A) -> (as : List A) ->
> All P as -> a `Elem` as -> P a
> containerMonadSpec3 a' Nil _ eprf = absurd eprf
> containerMonadSpec3 a' (a :: as) Nil _ impossible
> containerMonadSpec3 a (a :: as) (pa :: pas) Here = pa
> containerMonadSpec3 a' (a :: as) (pa :: pas) (There eprf) = containerMonadSpec3 a' as pas eprf
> -- containerMonadSpec4 : {A : Type} -> (ma : M A) -> fmap outl (tagElem ma) = ma
> -- containerMonadSpec5 : {A : Type} -> {P : A -> Type} ->
> -- (as : List A) -> ((a : A) -> a `Elem` as -> P a) -> All P as
* Specific container monad properties
> |||
> uniqueAllLemma : {A : Type} -> {P : A -> Type} ->
> Unique1 P -> (as : List A) -> Unique (All P as)
> uniqueAllLemma u1P Nil Nil Nil = Refl
> uniqueAllLemma u1P (a :: as) (pa :: pas) (pa' :: pas') =
> ( pa :: pas )
> ={ replace {P = \ ZUZU => pa :: pas = ZUZU :: pas} (u1P a pa pa') Refl }=
> ( pa' :: pas )
> ={ replace {P = \ ZUZU => pa' :: pas = pa' :: ZUZU} (uniqueAllLemma u1P as pas pas') Refl }=
> ( pa' :: pas' )
> QED
> |||
> finiteAllLemma0 : {A : Type} -> {P : A -> Type} ->
> Finite1 P -> Iso (All P Nil) Unit
> finiteAllLemma0 f1P = MkIso to from toFrom fromTo where
> to : All P Nil -> Unit
> to Nil = ()
> from : Unit -> All P Nil
> from () = Nil
> toFrom : (k : Unit) -> to (from k) = k
> toFrom () = Refl
> fromTo : (nil : All P Nil) -> from (to nil) = nil
> fromTo Nil = Refl
> |||
> finiteAllLemma1 : {A : Type} -> {P : A -> Type} ->
> Finite1 P -> (a : A) -> (as : List A) ->
> Iso (All P (a :: as)) (P a, All P as)
> finiteAllLemma1 {P} f1P a as = MkIso to from toFrom fromTo where
> to : All P (a :: as) -> (P a, All P as)
> to (pa :: pas) = (pa, pas)
> from : (P a, All P as) -> All P (a :: as)
> from (pa, pas) = pa :: pas
> toFrom : (papas : (P a, All P as)) -> to (from papas) = papas
> toFrom (pa, pas) = Refl
> fromTo : (papas : All P (a :: as)) -> from (to papas) = papas
> fromTo (pa :: pas) = Refl
> |||
> finiteAllLemma : {A : Type} -> {P : A -> Type} ->
> Finite1 P -> (as : List A) -> Finite (All P as)
> finiteAllLemma {P} f1P Nil = MkSigma (S Z) iso where
> iso : Iso (All P Nil) (Fin (S Z))
> iso = isoTrans (finiteAllLemma0 f1P) (isoSym isoFin1Unit)
> finiteAllLemma {P} f1P (a :: as) = MkSigma n iso where
> fH : Finite (P a)
> fH = f1P a
> mH : Nat
> mH = getWitness fH
> isoH : Iso (P a) (Fin mH)
> isoH = getProof fH
> fT : Finite (All P as)
> fT = finiteAllLemma f1P as
> mT : Nat
> mT = getWitness fT
> isoT : Iso (All P as) (Fin mT)
> isoT = getProof fT
> n : Nat
> n = mH * mT
> iso1 : Iso (All P (a :: as)) (P a, All P as)
> iso1 = finiteAllLemma1 f1P a as
> iso2 : Iso (P a, All P as) (Fin mH, Fin mT)
> iso2 = pairCong isoH isoT
> iso3 : Iso (Fin mH, Fin mT) (Fin (mH * mT))
> iso3 = finPairTimes
> iso : Iso (All P (a :: as)) (Fin n)
> iso = isoTrans iso1 (isoTrans iso2 iso3)
> |||
> finiteAll : {A : Type} -> {P : A -> Type} ->
> Finite1 P -> (as : List A) -> Finite (All P as)
> finiteAll = finiteAllLemma
> ||| All is decidable
> decidableAll : {A : Type} -> {P : A -> Type} ->
> (dec : (a : A) -> Dec (P a)) -> (as : List A) -> Dec (All P as)
> decidableAll = all
> ||| NotEmpty is finite
> finiteNonEmpty : {A : Type} -> (as : List A) -> Finite (List.Operations.NonEmpty as)
> finiteNonEmpty Nil = finiteVoid
> finiteNonEmpty (a :: as) = finiteUnit
> ||| NonEmpty is decidable
> decidableNonEmpty : {A : Type} -> (as : List A) -> Dec (List.Operations.NonEmpty as)
> decidableNonEmpty {A} Nil = No absurd
> decidableNonEmpty {A} (a :: as) = Yes ()
> ||| tagElem preserves length
> tagElemPreservesLength : {A : Type} -> (as : List A) -> length (tagElem as) = length as
> tagElemPreservesLength Nil = Refl
> tagElemPreservesLength (a :: as) = ( length (tagElem (a :: as)) )
> ={ Refl }=
> ( length ((MkSigma a Here) :: (map (idThere a as) (tagElem as))) )
> ={ Refl }=
> ( S (length (map (idThere a as) (tagElem as))) )
> ={ cong (mapPreservesLength (idThere a as) (tagElem as)) }=
> ( S (length (tagElem as)) )
> ={ cong (tagElemPreservesLength as) }=
> ( S (length as) )
> ={ Refl }=
> ( length (a :: as) )
> QED
* |nub| preserves non-emptiness:
> nubPreservesNonEmpty : {A : Type} -> (Eq A) =>
> (as : List A) ->
> List.Operations.NonEmpty as ->
> List.Operations.NonEmpty (nub as)
> nubPreservesNonEmpty Nil ne = absurd ne
> nubPreservesNonEmpty (a :: as) ne = ()
* |fmap| preserves shape:
> mapPreservesNonEmpty : {A, B : Type} ->
> (f : A -> B) -> (as : List A) ->
> List.Operations.NonEmpty as ->
> List.Operations.NonEmpty (map f as)
> mapPreservesNonEmpty f Nil ne = absurd ne
> mapPreservesNonEmpty f (a :: as) ne = ()
* Fusion-related properties:
> |||
> mapSndMapCrossAnyIdLemma : {A, B, C : Type} ->
> (f : A -> C) ->
> (abs : List (A, B)) ->
> map snd (map (cross f id) abs) = map snd abs
> mapSndMapCrossAnyIdLemma _ Nil = Refl
> mapSndMapCrossAnyIdLemma f ((a, b) :: abs) =
> ( map snd (map (cross f id) ((a, b) :: abs)) )
> ={ Refl }=
> ( map snd ((f a, b) :: map (cross f id) abs) )
> ={ Refl }=
> ( b :: map snd (map (cross f id) abs) )
> ={ cong (mapSndMapCrossAnyIdLemma f abs) }=
> ( b :: map snd abs )
> ={ Refl }=
> ( map snd ((a, b) :: abs) )
> QED
* Properties of |length|:
> |||
> lengthLemma : {A, B, C : Type} ->
> (as : List A) -> (f : A -> B) -> (g : A -> C) ->
> length (map f as) = length (map g as)
> lengthLemma Nil f g = Refl
> lengthLemma (a :: as) f g = ( length (map f (a :: as)) )
> ={ Refl }=
> ( length (f a :: map f as) )
> ={ Refl }=
> ( S (length (map f as)) )
> ={ cong (lengthLemma as f g) }=
> ( S (length (map g as)) )
> ={ Refl }=
> ( length (g a :: map g as) )
> ={ Refl }=
> ( length (map g (a :: as)) )
> QED
> |||
> lengthConsLemma : {A, B : Type} ->
> (a : A) -> (b : B) -> (as : List A) -> (bs : List B) ->
> length (a :: as) = length (b :: bs) -> length as = length bs
> lengthConsLemma a b as bs prf = succInjective (length as) (length bs) s2 where
> s1 : length (a :: as) = length (b :: bs)
> s1 = prf
> s2 : S (length as) = S (length bs)
> s2 = replace2 {P = \ X => \ Y => X = Y} Refl Refl s1
> |||
> lengthReplicateLemma : {A : Type} ->
> (n : Nat) -> (a : A) ->
> length (replicate n a) = n
> lengthReplicateLemma Z _ = Refl
> lengthReplicateLemma (S m) a = ( length (replicate (S m) a) )
> ={ Refl }=
> ( length (a :: replicate m a) )
> ={ Refl }=
> ( S (length (replicate m a)) )
> ={ cong (lengthReplicateLemma m a) }=
> ( S m )
> QED
* Properties of |zip| and |unzip|:
> |||
> unzipConsLemma : {A, B : Type} ->
> (ab : (A, B)) -> (abs : List (A, B)) ->
> unzip (ab :: abs) = (fst ab :: fst (unzip abs), snd ab :: snd (unzip abs))
> unzipConsLemma (a, b) abs with (unzip abs)
> | (_, _) = Refl
> |||
> fstUnzipConsLemma : {A, B : Type} ->
> (ab : (A, B)) -> (abs : List (A, B)) ->
> fst (unzip (ab :: abs)) = fst ab :: fst (unzip abs)
> fstUnzipConsLemma ab abs = cong {f = fst} (unzipConsLemma ab abs)
> |||
> sndUnzipConsLemma : {A, B : Type} ->
> (ab : (A, B)) -> (abs : List (A, B)) ->
> snd (unzip (ab :: abs)) = snd ab :: snd (unzip abs)
> sndUnzipConsLemma ab abs = cong {f = snd} (unzipConsLemma ab abs)
> |||
> unzipZipLemma : {A, B : Type} ->
> (as : List A) -> (bs : List B) -> length as = length bs ->
> unzip (zip as bs) = (as, bs)
> unzipZipLemma Nil Nil _ = Refl
> unzipZipLemma Nil (b :: bs) prf = absurd prf
> unzipZipLemma (a :: as) Nil prf = absurd (sym prf)
> unzipZipLemma (a :: as) (b :: bs) prf with (unzip (zip as bs)) proof p
> | (left, right) = s4 where
> s1 : length as = length bs
> s1 = lengthConsLemma a b as bs prf
> s2 : unzip (zip as bs) = (as, bs)
> s2 = unzipZipLemma as bs s1
> s3 : (left, right) = (as, bs)
> s3 = trans p s2
> s4 : (a :: left, b :: right) = (a :: as, b :: bs)
> s4 = replace2 {P = \ X => \ Y => (a :: left, b :: right) = (a :: X, b :: Y)}
> (cong {f = fst} s3) (cong {f = snd} s3) Refl
> |||
> sumMapSndUnzipLemma : {A, B : Type} -> (Num B) =>
> (abs : List (A, B)) -> sumMapSnd abs = sum (snd (unzip abs))
> sumMapSndUnzipLemma Nil = Refl
> sumMapSndUnzipLemma (ab :: abs) =
> ( sumMapSnd (ab :: abs) )
> ={ Refl }=
> ( sum (map snd (ab :: abs)) )
> ={ Refl }=
> ( sum (snd ab :: map snd abs) )
> ={ Refl }=
> ( snd ab + sum (map snd abs) )
> ={ Refl }=
> ( snd ab + sumMapSnd abs )
> ={ cong (sumMapSndUnzipLemma abs) }=
> ( snd ab + sum (snd (unzip abs)) )
> ={ Refl }=
> ( sum (snd ab :: snd (unzip abs)) )
> ={ cong (sym (sndUnzipConsLemma ab abs)) }=
> ( sum (snd (unzip (ab :: abs))) )
> QED
* Properties of |fold|:
> foldrListLemma : {A, B : Type} ->
> (f : A -> B -> B) -> (e : B) ->
> (a : A) -> (as : List A) ->
> foldr f e (a :: as) = f a (foldr f e as)
> foldrListLemma f e a as = Refl
* Properties of |sum| (for lists of types which are refinements of |Num|):
> |||
> sumSingletonLemma : {A : Type} -> (NumPlusZeroNeutral A) => (x : A) -> sum [x] = x
> sumSingletonLemma x = ( x + 0 )
> ={ plusZeroRightNeutral x }=
> ( x )
> QED
> |||