src/HOL/Matrix_LP/matrixlp.ML
author wenzelm
Tue May 14 20:32:10 2013 +0200 (2013-05-14)
changeset 51989 700693cb96f1
parent 47455 26315a545e26
child 53737 eab25a77af39
permissions -rw-r--r--
removed dead code;
wenzelm@47455
     1
(*  Title:      HOL/Matrix_LP/matrixlp.ML
wenzelm@20787
     2
    Author:     Steven Obua
wenzelm@20787
     3
*)
wenzelm@20787
     4
wenzelm@20787
     5
signature MATRIX_LP =
wenzelm@20787
     6
sig
wenzelm@20787
     7
  val matrix_compute : cterm -> thm
wenzelm@20787
     8
  val matrix_simplify : thm -> thm
wenzelm@20787
     9
end
wenzelm@20787
    10
wenzelm@20787
    11
structure MatrixLP : MATRIX_LP =
wenzelm@20787
    12
struct
wenzelm@20787
    13
haftmann@46540
    14
val compute_thms = ComputeHOL.prep_thms @{thms "ComputeHOL.compute_list_case" "ComputeHOL.compute_let"
haftmann@46540
    15
  "ComputeHOL.compute_if" "ComputeFloat.arith" "SparseMatrix.sparse_row_matrix_arith_simps"
haftmann@46540
    16
  "ComputeHOL.compute_bool" "ComputeHOL.compute_pair"
haftmann@46544
    17
  "SparseMatrix.sorted_sp_simps"
haftmann@46544
    18
  "ComputeNumeral.natnorm"}; (*"ComputeNumeral.number_norm"*)
obua@23665
    19
haftmann@46540
    20
val spm_mult_le_dual_prts_no_let_real = @{thm "spm_mult_le_dual_prts_no_let" [where ?'a = real]}
wenzelm@20787
    21
wenzelm@20787
    22
fun lp_dual_estimate_prt lptfile prec =
haftmann@46540
    23
  let
haftmann@46540
    24
    val cert = cterm_of @{theory}
haftmann@46540
    25
    fun var s x = (cert (Var ((s, 0), FloatSparseMatrixBuilder.spmatT)), x)
haftmann@46540
    26
    val l = Fspmlp.load lptfile prec false
haftmann@46540
    27
    val (y, (A1, A2), (c1, c2), b, (r1, r2)) =
haftmann@46540
    28
      let
haftmann@46540
    29
        open Fspmlp
haftmann@46540
    30
      in
haftmann@46540
    31
        (y l |> cert, A l |> pairself cert, c l |> pairself cert, b l |> cert, r12 l |> pairself cert)
haftmann@46540
    32
      end
haftmann@46540
    33
  in
haftmann@46540
    34
    Thm.instantiate ([],
haftmann@46540
    35
      [var "A1" A1, var "A2" A2, var "y" y, var "c1" c1, var "c2" c2, var "r1" r1, var "r2" r2, var "b" b])
haftmann@46540
    36
      spm_mult_le_dual_prts_no_let_real
haftmann@46540
    37
  end
wenzelm@20787
    38
haftmann@46540
    39
val computer = PCompute.make Compute.SML @{theory} compute_thms []
wenzelm@20787
    40
obua@23665
    41
fun matrix_compute c = hd (PCompute.rewrite computer [c])
wenzelm@20787
    42
wenzelm@20787
    43
fun matrix_simplify th =
haftmann@46540
    44
  let
haftmann@46540
    45
    val simp_th = matrix_compute (cprop_of th)
haftmann@46540
    46
    val th = Thm.strip_shyps (Thm.equal_elim simp_th th)
haftmann@46540
    47
    fun removeTrue th = removeTrue (Thm.implies_elim th TrueI) handle THM _ => th
haftmann@46540
    48
  in
haftmann@46540
    49
    removeTrue th
haftmann@46540
    50
  end
wenzelm@20787
    51
haftmann@46541
    52
val prove_bound = matrix_simplify oo lp_dual_estimate_prt;
wenzelm@20787
    53
wenzelm@20787
    54
end