(** A simple cancelation by powers of two *)

Fixpoint Pfactor_twos (p p':positive) {struct p} : (positive*positive) := 
 match p, p' with 
  | xO p, xO p' => Pfactor_twos p p'
  | _, _ => (p,p')
 end.Definition Qfactor_twos (q:Q) := 
 let (p,q) := q in 
 match p with 
   | Z0 => 0
   | Zpos p => let (p,q) := Pfactor_twos p q in (Zpos p)#q
   | Zneg p => let (p,q) := Pfactor_twos p q in (Zneg p)#q
 end.

(* Specifications: *)
Lemma Pfactor_twos_correct : forall p p', (p*(snd (Pfactor_twos p p')))%positive = (p'*(fst (Pfactor_twos p p')))%positive.
Lemma Qfactor_twos_correct : forall q, Qfactor_twos q == q.