diff --git a/coq/README.org b/coq/README.org index 4ddeaad..2a43fc6 100644 --- a/coq/README.org +++ b/coq/README.org @@ -1,5 +1,7 @@ #+TITLE: Coq + - [[./union.v][union.v]]: Mimicking a set operation using lists + - [[./bv.v][bv.v]]: Demo of a few bitvector operations - [[./sumn.v][sumn.v]]: Sum of first n natural numbers, their squares and cubes. - [[./de-morgan.v][de-morgan.v]]: de-Morgan's laws - [[./eqns.v][eqns.v]]: A 'hello world' using the 'equations' plugin diff --git a/coq/bv.v b/coq/bv.v index f715931..c0287ee 100644 --- a/coq/bv.v +++ b/coq/bv.v @@ -3,14 +3,16 @@ Require Vector. Require List. (* Convert a nat list to a bitvector. Non-zero values are considered true *) -Fixpoint list2Bvec (l:list nat) : Bvector.Bvector (List.length l) := +Fixpoint list2Bvec_aux (l:list nat) : Bvector.Bvector (List.length l) := match l return Bvector.Bvector (List.length l) with | List.cons O xs => - Bvector.Bcons false _ (list2Bvec xs) + Bvector.Bcons false _ (list2Bvec_aux xs) | List.cons _ xs => - Bvector.Bcons true _ (list2Bvec xs) + Bvector.Bcons true _ (list2Bvec_aux xs) | List.nil => Bvector.Bnil end. +Definition list2Bvec (l:list nat) : Bvector.Bvector (List.length (List.rev l)) := + list2Bvec_aux (List.rev l). (* Convert a bitvector to nat. Little-endian representation assumed *) Fixpoint bvec2nat_aux {n:nat} (cur:nat) (bv:Bvector.Bvector n): nat := @@ -23,24 +25,52 @@ Fixpoint bvec2nat_aux {n:nat} (cur:nat) (bv:Bvector.Bvector n): nat := Definition bvec2nat {n:nat} (bv:Bvector.Bvector n): nat := bvec2nat_aux 0 bv. (* Find nth bit of a bitvector *) -Definition bvnth {z i:nat} (bv: Bvector.Bvector z) (pf:i + if x then List.cons (z-1) (find_set_bits xs) + else (find_set_bits xs) + | Vector.nil _ => List.nil + end. + + + Require Import List. Import ListNotations. Compute list2Bvec [0;0;1;0]. (* 0100₂ ie, 4₁₀ *) +Check Bvector.BshiftL _ (list2Bvec [0;0;1;0]) false. + +Check Vector.shiftrepeat (Vector.cons _ 0 _ (Vector.nil _)). + +Require Import Vector. + + +Import VectorNotations. +Compute Bvector.BshiftL 1 (list2Bvec [0;0;1;0]) false. (* = [false; false; true; false] : Bvector (length [0; 0; 1; 0]) *) Compute bvec2nat (list2Bvec [0;0;1;0]). +(* = 2 : nat *) +Compute bvec2nat (list2Bvec [0;1;0;0]). (* = 4 : nat *) -Compute bvnth (list2Bvec [0;0;1;0]) (_:2<_). +Compute Bnth (list2Bvec [0;0;1;0]) (_:2<_). (* = true : bool *) -Compute bvnth (list2Bvec [0;0;1;0]) (_:1<_). +Compute Bnth (list2Bvec [0;0;1;0]) (_:1<_). (* = false : bool *) + +Compute find_set_bits (list2Bvec [0;0;1;0]). (* [2] : list nat *) +Compute find_set_bits (list2Bvec [1;0;1;0]). (* [2; 0] : list nat *) + +Check Bvector.BshiftL . + Check Bcons. Check Nat.pow. diff --git a/coq/union.v b/coq/union.v new file mode 100644 index 0000000..dc8e45b --- /dev/null +++ b/coq/union.v @@ -0,0 +1,31 @@ +Require List. + +(* By the way, this function is a good example to illustrate + the difference between foldl and foldr... *) +Definition setify (l: list nat): list nat := + List.fold_left (fun acc x => + if (List.existsb (fun a => Nat.eqb x a) acc) then acc + else (List.cons x acc) + ) l List.nil. + + +(* Not caring about efficiency here... *) +Definition union (a b: list nat): list nat := + let aset := setify a in + List.fold_left (fun acc y => + if (List.existsb (fun x => Nat.eqb x y) acc) then acc + else (List.cons y acc) + ) b aset. + +(******************** Trying out... ********************) + +Require Import List. +Import ListNotations. +Compute setify [0;0;0]. +(* = [0] : list nat *) + +Compute setify [0;1;1;2;2;2;3;3;3;3]. +(* = [3; 2; 1; 0] : list nat *) + +Compute union [0;1;1;2;2;2;3;3;3;3] [1;1;4;4]. +(* = [4; 3; 2; 1; 0] : list nat *) diff --git a/haskell/99-problems/9-13.hs b/haskell/99-problems/9-13.hs new file mode 100644 index 0000000..27306ae --- /dev/null +++ b/haskell/99-problems/9-13.hs @@ -0,0 +1,87 @@ +stepAux :: Eq a => a -> [a] -> [a] +stepAux a (x:xs) + | a==x = a:stepAux a xs + | otherwise = [] +stepAux a [] = [] + + +-- returns: (result, remaining) +step :: Eq a => a -> [a] -> ([a], [a]) +step a l = + let rv = stepAux a l in + (a:rv, drop (length rv) l) + + +pack :: Eq a => [a] -> [[a]] +pack [] = [] +pack (x:xs) = + let (res, rem) = step x xs in + case rem of + [] -> [res] + _ -> res:pack rem + +-- Test case of 9: +-- λ> pack ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e', 'e'] +-- ["aaaa","b","cc","aa","d","eeee"] + +encode :: Eq a => [a] -> [(Int, a)] +encode l = map (\x -> (length x, head x)) $ pack l + +-- Test case of 10: +-- λ> encode "aaaabccaadeeee" +-- [(4,'a'),(1,'b'),(2,'c'),(2,'a'),(1,'d'),(4,'e')] + +encodeMod :: Eq a => [a] -> [(Int, a)] +encodeMod l = foldr f [] $ pack l where + f x acc = + if length x/=1 then (length x, head x):acc + else acc +-- Test case of 11 (v1): +-- λ> encodeMod "aaaabccaadeeee" +-- [(4,'a'),(2,'c'),(2,'a'),(4,'e')] + +data Multiplicity a + = Single a + | Multiple Int a + deriving Show + +encodeMod' :: Eq a => [a] -> [Multiplicity a] +encodeMod' l = foldr f [] $ pack l where + f x acc = + if length x/=1 then (Multiple (length x) (head x)):acc + else (Single (head x)):acc +-- Test case of 11 (v2): +-- λ> encodeMod' "aaaabccaadeeee" +-- [Multiple 4 'a',Single 'b',Multiple 2 'c',Multiple 2 'a',Single 'd',Multiple 4 'e'] + + +decode :: [Multiplicity a] -> [a] +decode l = foldr f [] l where + f (Single a) acc = a:acc + f (Multiple n a) acc = (replicate n a) ++ acc + +-- Test case of 12: +-- λ> decode (encodeMod' "aaaabccaadeeee") +-- "aaaabccaadeeee" +-- +-- λ> decode (encodeMod' "aaaabccaadeeee") == "aaaabccaadeeee" +-- True + + +encodeDirectAux :: Eq a => a -> [a] -> Int +encodeDirectAux a [] = 0 +encodeDirectAux a (x:xs) + | x==a = 1 + (encodeDirectAux a xs) + | otherwise = 0 + +encodeDirect :: Eq a => [a] -> [Multiplicity a] +encodeDirect [] = [] +encodeDirect (x:xs) = + let rv = encodeDirectAux x xs in + case rv of + 0 -> (Single x):encodeDirect xs + _ -> Multiple (rv+1) x : encodeDirect (drop rv xs) + +-- Test case of 13: +-- λ> encodeDirect "aaaabccaadeeee" +-- [Multiple 4 'a',Single 'b',Multiple 2 'c',Multiple 2 'a',Single 'd',Multiple 4 'e']