Fixpoint MapCollect1 (f:ad -> A -> Map B) (pf:ad -> ad) 
   (m:Map A) {struct m} : Map B :=
    match m with
    | M0 => M0 B
    | M1 a y => f (pf a) y
    | M2 m1 m2 =>
        MapMerge B (MapCollect1 f (fun a0:ad => pf (Ndouble a0)) m1)
          (MapCollect1 f (fun a0:ad => pf (Ndouble_plus_one a0)) m2)
    end.Definition MapCollect (f:ad -> A -> Map B) (m:Map A) :=
    MapCollect1 f (fun a:ad => a) m.Fixpoint MapFold1 (f:ad -> A -> M) (pf:ad -> ad) 
     (m:Map A) {struct m} : M :=
      match m with
      | M0 => neutral
      | M1 a y => f (pf a) y
      | M2 m1 m2 =>
          op (MapFold1 f (fun a0:ad => pf (Ndouble a0)) m1)
            (MapFold1 f (fun a0:ad => pf (Ndouble_plus_one a0)) m2)
      end.Definition MapFold (f:ad -> A -> M) (m:Map A) :=
      MapFold1 f (fun a:ad => a) m.

Lemma MapFold_M1 : forall (f:ad -> A -> M) (a:ad) (y:A), MapFold f (M1 A a y) = f a y.