[coq] bitvectors and 'sets'

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

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<z): bool :=
+Definition Bnth {z i:nat} (bv: Bvector.Bvector z) (pf:i<z): bool :=
   Vector.nth_order bv pf.
 
+(* Find list of set bits in a bitvector *)
+Fixpoint find_set_bits {z:nat} (bv: Bvector.Bvector z) : list nat :=
+  match bv with
+  | Vector.cons _ x _ xs =>
+      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.

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 *)

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']