(* ========================================================================== *)
(* FLYSPECK - BOOK FORMALIZATION                                              *)
(*                                                                            *)
(* Definition: cayleyR                                                        *)
(* Chapter: LEG                                                               *)
(* Author: Thomas C. Hales                                                    *)
(* Date: 2010-02-07                                                           *)
(* ========================================================================== *)




(*
This is the 5 vertex Cayley-Menger determinant
EDSFZOT
NUHSVLM
See http://www.math.pitt.edu/~thales/papers/Lemmas_Elementary_Geometry.pdf
Properties of cayleyR have been formalized by Nguyen Quang Truong
*)



module type Cayleyr_def_type = sig
  val cayleyR : thm
  val cayleyR_quadratic : thm
end;;


module Cayleyr : Cayleyr_def_type = struct


 
let cayleyR = 
new_definition `cayleyR x12 x13 x14 x15  x23 x24 x25  x34 x35 x45 = 
  -- (x14*x14*x23*x23) + &2 *x14*x15*x23*x23 - x15*x15*x23*x23 + &2 *x13*x14*x23*x24 - &2 *x13*x15*x23*x24 - &2 *x14*x15*x23*x24 + 
   &2 *x15*x15*x23*x24 - x13*x13*x24*x24 + &2 *x13*x15*x24*x24 - x15*x15*x24*x24 - &2 *x13*x14*x23*x25 + 
   &2 *x14*x14*x23*x25 + &2 *x13*x15*x23*x25 - &2 *x14*x15*x23*x25 + &2 *x13*x13*x24*x25 - &2 *x13*x14*x24*x25 - &2 *x13*x15*x24*x25 + 
   &2 *x14*x15*x24*x25 - x13*x13*x25*x25 + &2 *x13*x14*x25*x25 - x14*x14*x25*x25 + &2 *x12*x14*x23*x34 - &2 *x12*x15*x23*x34 - 
   &2 *x14*x15*x23*x34 + &2 *x15*x15*x23*x34 + &2 *x12*x13*x24*x34 - &2 *x12*x15*x24*x34 - &2 *x13*x15*x24*x34 + &2 *x15*x15*x24*x34 + 
   &4 *x15*x23*x24*x34 - &2 *x12*x13*x25*x34 - &2 *x12*x14*x25*x34 + &4 *x13*x14*x25*x34 + &4 *x12*x15*x25*x34 - &2 *x13*x15*x25*x34 - &2 *x14*x15*x25*x34 - 
   &2 *x14*x23*x25*x34 - &2 *x15*x23*x25*x34 - &2 *x13*x24*x25*x34 - &2 *x15*x24*x25*x34 + &2 *x13*x25*x25*x34 + &2 *x14*x25*x25*x34 - 
   x12*x12*x34*x34 + &2 *x12*x15*x34*x34 - x15*x15*x34*x34 + &2 *x12*x25*x34*x34 + &2 *x15*x25*x34*x34 - 
   x25*x25*x34*x34 - &2 *x12*x14*x23*x35 + &2 *x14*x14*x23*x35 + &2 *x12*x15*x23*x35 - &2 *x14*x15*x23*x35 - &2 *x12*x13*x24*x35 + 
   &4 *x12*x14*x24*x35 - &2 *x13*x14*x24*x35 - &2 *x12*x15*x24*x35 + &4 *x13*x15*x24*x35 - &2 *x14*x15*x24*x35 - &2 *x14*x23*x24*x35 - &2 *x15*x23*x24*x35 + 
   &2 *x13*x24*x24*x35 + &2 *x15*x24*x24*x35 + &2 *x12*x13*x25*x35 - &2 *x12*x14*x25*x35 - &2 *x13*x14*x25*x35 + &2 *x14*x14*x25*x35 + 
   &4 *x14*x23*x25*x35 - &2 *x13*x24*x25*x35 - &2 *x14*x24*x25*x35 + &2 *x12*x12*x34*x35 - &2 *x12*x14*x34*x35 - &2 *x12*x15*x34*x35 + 
   &2 *x14*x15*x34*x35 - &2 *x12*x24*x34*x35 - &2 *x15*x24*x34*x35 - &2 *x12*x25*x34*x35 - &2 *x14*x25*x34*x35 + &2 *x24*x25*x34*x35 - 
   x12*x12*x35*x35 + &2 *x12*x14*x35*x35 - x14*x14*x35*x35 + &2 *x12*x24*x35*x35 + &2 *x14*x24*x35*x35 - 
   x24*x24*x35*x35 + &4 *x12*x13*x23*x45 - &2 *x12*x14*x23*x45 - &2 *x13*x14*x23*x45 - &2 *x12*x15*x23*x45 - &2 *x13*x15*x23*x45 + 
   &4 *x14*x15*x23*x45 + &2 *x14*x23*x23*x45 + &2 *x15*x23*x23*x45 - &2 *x12*x13*x24*x45 + &2 *x13*x13*x24*x45 + &2 *x12*x15*x24*x45 - 
   &2 *x13*x15*x24*x45 - &2 *x13*x23*x24*x45 - &2 *x15*x23*x24*x45 - &2 *x12*x13*x25*x45 + &2 *x13*x13*x25*x45 + &2 *x12*x14*x25*x45 - 
   &2 *x13*x14*x25*x45 - &2 *x13*x23*x25*x45 - &2 *x14*x23*x25*x45 + &4 *x13*x24*x25*x45 + &2 *x12*x12*x34*x45 - &2 *x12*x13*x34*x45 - 
   &2 *x12*x15*x34*x45 + &2 *x13*x15*x34*x45 - &2 *x12*x23*x34*x45 - &2 *x15*x23*x34*x45 - &2 *x12*x25*x34*x45 - &2 *x13*x25*x34*x45 + &2 *x23*x25*x34*x45 + 
   &2 *x12*x12*x35*x45 - &2 *x12*x13*x35*x45 - &2 *x12*x14*x35*x45 + &2 *x13*x14*x35*x45 - &2 *x12*x23*x35*x45 - &2 *x14*x23*x35*x45 - 
   &2 *x12*x24*x35*x45 - &2 *x13*x24*x35*x45 + &2 *x23*x24*x35*x45 + &4 *x12*x34*x35*x45 - x12*x12*x45*x45 + &2 *x12*x13*x45*x45 - 
   x13*x13*x45*x45 + &2 *x12*x23*x45*x45 + &2 *x13*x23*x45*x45 - x23*x23*x45*x45` ;;
let cayleyR_quadratic = 
prove( `cayleyR x12 x13 x14 x15 x23 x24 x25 x34 x35 = \ x45 . ( let a = (((-- &1) * (x12 pow 2)) + (((-- &1) * ((x13 + ((-- &1) * x23)) pow 2)) + (&2 * (x12 * (x13 + x23))))) in let b = (&2 * (((x13 pow 2) * (x24 + x25)) + (((x12 pow 2) * (x34 + x35)) + ((x23 * ((x15 * (x23 + (((-- &1) * x24) + ((-- &1) * x34)))) + ((x25 * x34) + ((x14 * ((&2 * x15) + (x23 + (((-- &1) * x25) + ((-- &1) * x35))))) + (x24 * x35))))) + (((-- &1) * (x13 * ((x23 * x24) + ((x23 * x25) + (((-- &2) * (x24 * x25)) + ((x15 * (x23 + (x24 + ((-- &1) * x34)))) + ((x25 * x34) + ((x14 * (x23 + (x25 + ((-- &1) * x35)))) + (x24 * x35))))))))) + (x12 * ((&2 * (x13 * x23)) + (((-- &1) * (x14 * x23)) + (((-- &1) * (x15 * x23)) + (((-- &1) * (x13 * x24)) + ((x15 * x24) + (((-- &1) * (x13 * x25)) + ((x14 * x25) + (((-- &1) * (x13 * x34)) + (((-- &1) * (x15 * x34)) + (((-- &1) * (x23 * x34)) + (((-- &1) * (x25 * x34)) + (((-- &1) * (x13 * x35)) + (((-- &1) * (x14 * x35)) + (((-- &1) * (x23 * x35)) + (((-- &1) * (x24 * x35)) + (&2 * (x34 * x35))))))))))))))))))))))) in let c = (((-- &1) * ((x15 pow 2) * ((x23 pow 2) + (((x24 + ((-- &1) * x34)) pow 2) + ((-- &2) * (x23 * (x24 + x34))))))) + (((-- &1) * (((x13 * x24) + (((-- &1) * (x13 * x25)) + (((-- &1) * (x12 * x34)) + ((x25 * x34) + ((x12 * x35) + ((-- &1) * (x24 * x35))))))) pow 2)) + (((-- &1) * ((x14 pow 2) * ((x23 pow 2) + (((x25 + ((-- &1) * x35)) pow 2) + ((-- &2) * (x23 * (x25 + x35))))))) + (((-- &2) * (x15 * (((-- &2) * (x23 * (x24 * x34))) + ((x23 * (x25 * x34)) + ((x24 * (x25 * x34)) + (((-- &1) * (x25 * (x34 pow 2))) + ((x13 * (((-- &1) * (x24 pow 2)) + ((x23 * (x24 + ((-- &1) * x25))) + ((x25 * x34) + (x24 * (x25 + (x34 + ((-- &2) * x35)))))))) + ((x23 * (x24 * x35)) + (((-- &1) * ((x24 pow 2) * x35)) + ((x24 * (x34 * x35)) + (x12 * ((x23 * (x34 + ((-- &1) * x35))) + ((x34 * (((-- &2) * x25) + (((-- &1) * x34) + x35))) + (x24 * (x34 + x35))))))))))))))) + (&2 * (x14 * ((x12 * (x23 * x34)) + (((-- &1) * (x12 * (x25 * x34))) + (((-- &1) * (x23 * (x25 * x34))) + (((x25 pow 2) * x34) + (((-- &1) * (x12 * (x23 * x35))) + ((&2 * (x12 * (x24 * x35))) + (((-- &1) * (x23 * (x24 * x35))) + (((-- &1) * (x12 * (x25 * x35))) + ((&2 * (x23 * (x25 * x35))) + (((-- &1) * (x24 * (x25 * x35))) + (((-- &1) * (x12 * (x34 * x35))) + (((-- &1) * (x25 * (x34 * x35))) + ((x12 * (x35 pow 2)) + ((x24 * (x35 pow 2)) + ((x13 * ((x23 * (x24 + ((-- &1) * x25))) + ((x25 * (x25 + ((&2 * x34) + ((-- &1) * x35)))) + ((-- &1) * (x24 * (x25 + x35)))))) + (x15 * ((x23 pow 2) + (((x24 + ((-- &1) * x34)) * (x25 + ((-- &1) * x35))) + ((-- &1) * (x23 * (x24 + (x25 + (x34 + x35))))))))))))))))))))))))))))) in (a * x45 pow 2 + b * x45 + c))`,
(ONCE_REWRITE_TAC[FUN_EQ_THM]) THEN BETA_TAC THEN ( REWRITE_TAC[cayleyR]) THEN (REPEAT LET_TAC) THEN (EXPAND_TAC "a") THEN (EXPAND_TAC "b") THEN (EXPAND_TAC "c") THEN (ARITH_TAC));;
end;;