src/HOL/Multivariate_Analysis/normarith.ML
changeset 60801 7664e0916eec
parent 60754 02924903a6fd
child 60949 ccbf9379e355
equal deleted inserted replaced
60799:57dd0b45fc21 60801:7664e0916eec
   152   else Thm.apply (Thm.apply @{cterm "op / :: real => _"}
   152   else Thm.apply (Thm.apply @{cterm "op / :: real => _"}
   153                    (Numeral.mk_cnumber @{ctyp "real"} a))
   153                    (Numeral.mk_cnumber @{ctyp "real"} a))
   154         (Numeral.mk_cnumber @{ctyp "real"} b)
   154         (Numeral.mk_cnumber @{ctyp "real"} b)
   155 end;
   155 end;
   156 
   156 
   157 fun norm_cmul_rule c th = instantiate' [] [SOME (cterm_of_rat c)] (th RS @{thm norm_cmul_rule_thm});
   157 fun norm_cmul_rule c th = Thm.instantiate' [] [SOME (cterm_of_rat c)] (th RS @{thm norm_cmul_rule_thm});
   158 
   158 
   159 fun norm_add_rule th1 th2 = [th1, th2] MRS @{thm norm_add_rule_thm};
   159 fun norm_add_rule th1 th2 = [th1, th2] MRS @{thm norm_add_rule_thm};
   160 
   160 
   161   (* I think here the static context should be sufficient!! *)
   161   (* I think here the static context should be sufficient!! *)
   162 fun inequality_canon_rule ctxt =
   162 fun inequality_canon_rule ctxt =
   340  let
   340  let
   341 (*   val _ = error "real_vector_ineq_prover: pause" *)
   341 (*   val _ = error "real_vector_ineq_prover: pause" *)
   342   val ntms = fold_rev find_normedterms (map (Thm.dest_arg o concl) (ges @ gts)) []
   342   val ntms = fold_rev find_normedterms (map (Thm.dest_arg o concl) (ges @ gts)) []
   343   val lctab = vector_lincombs (map snd (filter (not o fst) ntms))
   343   val lctab = vector_lincombs (map snd (filter (not o fst) ntms))
   344   val (fxns, ctxt') = Variable.variant_fixes (replicate (length lctab) "x") ctxt
   344   val (fxns, ctxt') = Variable.variant_fixes (replicate (length lctab) "x") ctxt
   345   fun instantiate_cterm' ty tms = Drule.cterm_rule (Drule.instantiate' ty tms)
   345   fun instantiate_cterm' ty tms = Drule.cterm_rule (Thm.instantiate' ty tms)
   346   fun mk_norm t = Thm.apply (instantiate_cterm' [SOME (Thm.ctyp_of_cterm t)] [] @{cpat "norm :: (?'a :: real_normed_vector) => real"}) t
   346   fun mk_norm t = Thm.apply (instantiate_cterm' [SOME (Thm.ctyp_of_cterm t)] [] @{cpat "norm :: (?'a :: real_normed_vector) => real"}) t
   347   fun mk_equals l r = Thm.apply (Thm.apply (instantiate_cterm' [SOME (Thm.ctyp_of_cterm l)] [] @{cpat "op == :: ?'a =>_"}) l) r
   347   fun mk_equals l r = Thm.apply (Thm.apply (instantiate_cterm' [SOME (Thm.ctyp_of_cterm l)] [] @{cpat "op == :: ?'a =>_"}) l) r
   348   val asl = map2 (fn (t,_) => fn n => Thm.assume (mk_equals (mk_norm t) (Thm.cterm_of ctxt' (Free(n,@{typ real}))))) lctab fxns
   348   val asl = map2 (fn (t,_) => fn n => Thm.assume (mk_equals (mk_norm t) (Thm.cterm_of ctxt' (Free(n,@{typ real}))))) lctab fxns
   349   val replace_conv = try_conv (rewrs_conv asl)
   349   val replace_conv = try_conv (rewrs_conv asl)
   350   val replace_rule = fconv_rule (funpow 2 arg_conv (replacenegnorms replace_conv))
   350   val replace_rule = fconv_rule (funpow 2 arg_conv (replacenegnorms replace_conv))