src/HOL/Matrix_LP/SparseMatrix.thy
author haftmann
Thu, 26 Jun 2025 17:25:29 +0200
changeset 82774 2865a6618cba
parent 80756 4d592706086e
permissions -rw-r--r--
append (rather than prepend) code equations: the order within a theory is maintained in the resulting code
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
47455
26315a545e26 updated headers;
wenzelm
parents: 47108
diff changeset
     1
(*  Title:      HOL/Matrix_LP/SparseMatrix.thy
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
     2
    Author:     Steven Obua; updated to Isar by LCP
16487
2060ebae96f9 proper header;
wenzelm
parents: 16417
diff changeset
     3
*)
2060ebae96f9 proper header;
wenzelm
parents: 16417
diff changeset
     4
27484
dbb9981c3d18 added marginal setup for code generation
haftmann
parents: 26300
diff changeset
     5
theory SparseMatrix
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
     6
  imports Matrix 
27484
dbb9981c3d18 added marginal setup for code generation
haftmann
parents: 26300
diff changeset
     7
begin
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
     8
42463
f270e3e18be5 modernized specifications;
wenzelm
parents: 38273
diff changeset
     9
type_synonym 'a spvec = "(nat * 'a) list"
f270e3e18be5 modernized specifications;
wenzelm
parents: 38273
diff changeset
    10
type_synonym 'a spmat = "'a spvec spvec"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    11
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
    12
definition sparse_row_vector :: "('a::ab_group_add) spvec \<Rightarrow> 'a matrix"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
    13
  where "sparse_row_vector arr = foldl (% m x. m + (singleton_matrix 0 (fst x) (snd x))) 0 arr"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    14
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
    15
definition sparse_row_matrix :: "('a::ab_group_add) spmat \<Rightarrow> 'a matrix"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
    16
  where "sparse_row_matrix arr = foldl (% m r. m + (move_matrix (sparse_row_vector (snd r)) (int (fst r)) 0)) 0 arr"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    17
27484
dbb9981c3d18 added marginal setup for code generation
haftmann
parents: 26300
diff changeset
    18
code_datatype sparse_row_vector sparse_row_matrix
dbb9981c3d18 added marginal setup for code generation
haftmann
parents: 26300
diff changeset
    19
dbb9981c3d18 added marginal setup for code generation
haftmann
parents: 26300
diff changeset
    20
lemma sparse_row_vector_empty [simp]: "sparse_row_vector [] = 0"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    21
  by (simp add: sparse_row_vector_def)
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    22
27484
dbb9981c3d18 added marginal setup for code generation
haftmann
parents: 26300
diff changeset
    23
lemma sparse_row_matrix_empty [simp]: "sparse_row_matrix [] = 0"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    24
  by (simp add: sparse_row_matrix_def)
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    25
82774
2865a6618cba append (rather than prepend) code equations: the order within a theory is maintained in the resulting code
haftmann
parents: 80756
diff changeset
    26
lemma [code]:
2865a6618cba append (rather than prepend) code equations: the order within a theory is maintained in the resulting code
haftmann
parents: 80756
diff changeset
    27
  \<open>0 = sparse_row_vector []\<close>
2865a6618cba append (rather than prepend) code equations: the order within a theory is maintained in the resulting code
haftmann
parents: 80756
diff changeset
    28
  by simp
27484
dbb9981c3d18 added marginal setup for code generation
haftmann
parents: 26300
diff changeset
    29
67613
ce654b0e6d69 more symbols;
wenzelm
parents: 61945
diff changeset
    30
lemma foldl_distrstart: "\<forall>a x y. (f (g x y) a = g x (f y a)) \<Longrightarrow> (foldl f (g x y) l = g x (foldl f y l))"
31817
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
    31
  by (induct l arbitrary: x y, auto)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    32
27653
180e28bab764 more class instantiations
haftmann
parents: 27484
diff changeset
    33
lemma sparse_row_vector_cons[simp]:
180e28bab764 more class instantiations
haftmann
parents: 27484
diff changeset
    34
  "sparse_row_vector (a # arr) = (singleton_matrix 0 (fst a) (snd a)) + (sparse_row_vector arr)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    35
  by (induct arr) (auto simp: foldl_distrstart sparse_row_vector_def)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    36
27653
180e28bab764 more class instantiations
haftmann
parents: 27484
diff changeset
    37
lemma sparse_row_vector_append[simp]:
180e28bab764 more class instantiations
haftmann
parents: 27484
diff changeset
    38
  "sparse_row_vector (a @ b) = (sparse_row_vector a) + (sparse_row_vector b)"
180e28bab764 more class instantiations
haftmann
parents: 27484
diff changeset
    39
  by (induct a) auto
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    40
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    41
lemma nrows_spvec[simp]: "nrows (sparse_row_vector x) \<le> (Suc 0)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    42
  by (induct x) (auto simp: add_nrows)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    43
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    44
lemma sparse_row_matrix_cons: "sparse_row_matrix (a#arr) = ((move_matrix (sparse_row_vector (snd a)) (int (fst a)) 0)) + sparse_row_matrix arr"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    45
  by (induct arr) (auto simp: foldl_distrstart sparse_row_matrix_def)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    46
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    47
lemma sparse_row_matrix_append: "sparse_row_matrix (arr@brr) = (sparse_row_matrix arr) + (sparse_row_matrix brr)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    48
  by (induct arr) (auto simp: sparse_row_matrix_cons)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    49
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    50
fun sorted_spvec :: "'a spvec \<Rightarrow> bool"
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
    51
where
27653
180e28bab764 more class instantiations
haftmann
parents: 27484
diff changeset
    52
  "sorted_spvec [] = True"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    53
| sorted_spvec_step1: "sorted_spvec [a] = True" 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    54
| sorted_spvec_step: "sorted_spvec ((m,x)#(n,y)#bs) =  ((m < n) \<and> (sorted_spvec ((n,y)#bs)))" 
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    55
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
    56
primrec sorted_spmat :: "'a spmat \<Rightarrow> bool"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
    57
where
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    58
  "sorted_spmat [] = True"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    59
| "sorted_spmat (a#as) = ((sorted_spvec (snd a)) \<and> (sorted_spmat as))"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    60
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    61
declare sorted_spvec.simps [simp del]
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    62
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    63
lemma sorted_spvec_empty[simp]: "sorted_spvec [] = True"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    64
  by (simp add: sorted_spvec.simps)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    65
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    66
lemma sorted_spvec_cons1: "sorted_spvec (a#as) \<Longrightarrow> sorted_spvec as"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    67
  using sorted_spvec.elims(2) sorted_spvec_empty by blast
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    68
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    69
lemma sorted_spvec_cons2: "sorted_spvec (a#b#t) \<Longrightarrow> sorted_spvec (a#t)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    70
  by (smt (verit, del_insts) sorted_spvec_step order.strict_trans list.inject sorted_spvec.elims(3) surj_pair)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    71
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    72
lemma sorted_spvec_cons3: "sorted_spvec(a#b#t) \<Longrightarrow> fst a < fst b"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    73
  by (metis sorted_spvec_step prod.collapse)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    74
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    75
lemma sorted_sparse_row_vector_zero: 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    76
  assumes "m \<le> n"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    77
  shows "sorted_spvec ((n,a)#arr) \<Longrightarrow> Rep_matrix (sparse_row_vector arr) j m = 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    78
proof (induct arr)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    79
  case Nil
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    80
  then show ?case by auto
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    81
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    82
  case (Cons a arr)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    83
  with assms show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    84
    by (auto dest: sorted_spvec_cons2 sorted_spvec_cons3)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    85
qed
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    86
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    87
lemma sorted_sparse_row_matrix_zero[rule_format]: 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    88
  assumes "m \<le> n"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    89
  shows "sorted_spvec ((n,a)#arr) \<Longrightarrow> Rep_matrix (sparse_row_matrix arr) m j = 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    90
proof (induct arr)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    91
  case Nil
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    92
  then show ?case by auto
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    93
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    94
  case (Cons a arr)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    95
  with assms show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    96
    unfolding sparse_row_matrix_cons
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    97
    by (auto dest: sorted_spvec_cons2 sorted_spvec_cons3)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
    98
qed
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
    99
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   100
primrec minus_spvec :: "('a::ab_group_add) spvec \<Rightarrow> 'a spvec"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   101
where
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   102
  "minus_spvec [] = []"
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   103
| "minus_spvec (a#as) = (fst a, -(snd a))#(minus_spvec as)"
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   104
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   105
primrec abs_spvec :: "('a::lattice_ab_group_add_abs) spvec \<Rightarrow> 'a spvec"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   106
where
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   107
  "abs_spvec [] = []"
61945
1135b8de26c3 more symbols;
wenzelm
parents: 61169
diff changeset
   108
| "abs_spvec (a#as) = (fst a, \<bar>snd a\<bar>)#(abs_spvec as)"
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   109
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   110
lemma sparse_row_vector_minus: 
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   111
  "sparse_row_vector (minus_spvec v) = - (sparse_row_vector v)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   112
proof (induct v)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   113
  case Nil
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   114
  then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   115
    by auto
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   116
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   117
  case (Cons a v)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   118
  then have "singleton_matrix 0 (fst a) (- snd a) = - singleton_matrix 0 (fst a) (snd a)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   119
    by (simp add: Rep_matrix_inject minus_matrix_def)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   120
  then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   121
    by (simp add: local.Cons)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   122
qed
27653
180e28bab764 more class instantiations
haftmann
parents: 27484
diff changeset
   123
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   124
lemma sparse_row_vector_abs:
61945
1135b8de26c3 more symbols;
wenzelm
parents: 61169
diff changeset
   125
  "sorted_spvec (v :: 'a::lattice_ring spvec) \<Longrightarrow> sparse_row_vector (abs_spvec v) = \<bar>sparse_row_vector v\<bar>"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   126
proof (induct v)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   127
  case Nil
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   128
  then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   129
    by simp
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   130
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   131
  case (Cons ab v)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   132
  then have v: "sorted_spvec v"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   133
    using sorted_spvec_cons1 by blast
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   134
  show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   135
  proof (cases ab)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   136
    case (Pair a b)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   137
    then have 0: "Rep_matrix (sparse_row_vector v) 0 a = 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   138
      using Cons.prems sorted_sparse_row_vector_zero by blast
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   139
    with v Cons show ?thesis
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   140
      by (fastforce simp: Pair simp flip: Rep_matrix_inject)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   141
  qed
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   142
qed
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   143
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   144
lemma sorted_spvec_minus_spvec:
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   145
  "sorted_spvec v \<Longrightarrow> sorted_spvec (minus_spvec v)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   146
  by (induct v rule: sorted_spvec.induct) (auto simp: sorted_spvec_step1 sorted_spvec_step)
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   147
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   148
lemma sorted_spvec_abs_spvec:
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   149
  "sorted_spvec v \<Longrightarrow> sorted_spvec (abs_spvec v)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   150
  by (induct v rule: sorted_spvec.induct) (auto simp: sorted_spvec_step1 sorted_spvec_step)
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   151
  
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   152
definition "smult_spvec y = map (% a. (fst a, y * snd a))"  
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   153
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   154
lemma smult_spvec_empty[simp]: "smult_spvec y [] = []"
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   155
  by (simp add: smult_spvec_def)
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   156
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   157
lemma smult_spvec_cons: "smult_spvec y (a#arr) = (fst a, y * (snd a)) # (smult_spvec y arr)"
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   158
  by (simp add: smult_spvec_def)
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   159
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   160
fun addmult_spvec :: "('a::ring) \<Rightarrow> 'a spvec \<Rightarrow> 'a spvec \<Rightarrow> 'a spvec"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   161
where
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   162
  "addmult_spvec y arr [] = arr"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   163
| "addmult_spvec y [] brr = smult_spvec y brr"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   164
| "addmult_spvec y ((i,a)#arr) ((j,b)#brr) = (
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   165
    if i < j then ((i,a)#(addmult_spvec y arr ((j,b)#brr))) 
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   166
    else (if (j < i) then ((j, y * b)#(addmult_spvec y ((i,a)#arr) brr))
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   167
    else ((i, a + y*b)#(addmult_spvec y arr brr))))"
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   168
(* Steven used termination "measure (% (y, a, b). length a + (length b))" *)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   169
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   170
lemma addmult_spvec_empty1[simp]: "addmult_spvec y [] a = smult_spvec y a"
27484
dbb9981c3d18 added marginal setup for code generation
haftmann
parents: 26300
diff changeset
   171
  by (induct a) auto
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   172
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   173
lemma addmult_spvec_empty2[simp]: "addmult_spvec y a [] = a"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   174
  by simp
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   175
67613
ce654b0e6d69 more symbols;
wenzelm
parents: 61945
diff changeset
   176
lemma sparse_row_vector_map: "(\<forall>x y. f (x+y) = (f x) + (f y)) \<Longrightarrow> (f::'a\<Rightarrow>('a::lattice_ring)) 0 = 0 \<Longrightarrow> 
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   177
  sparse_row_vector (map (% x. (fst x, f (snd x))) a) = apply_matrix f (sparse_row_vector a)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   178
  by (induct a) (simp_all add: apply_matrix_add)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   179
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   180
lemma sparse_row_vector_smult: "sparse_row_vector (smult_spvec y a) = scalar_mult y (sparse_row_vector a)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   181
  by (induct a) (simp_all add: smult_spvec_cons scalar_mult_add)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   182
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 32491
diff changeset
   183
lemma sparse_row_vector_addmult_spvec: "sparse_row_vector (addmult_spvec (y::'a::lattice_ring) a b) = 
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   184
  (sparse_row_vector a) + (scalar_mult y (sparse_row_vector b))"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   185
  by (induct y a b rule: addmult_spvec.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   186
     (simp_all add: scalar_mult_add smult_spvec_cons sparse_row_vector_smult singleton_matrix_add)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   187
31817
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   188
lemma sorted_smult_spvec: "sorted_spvec a \<Longrightarrow> sorted_spvec (smult_spvec y a)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   189
  by (induct a rule: sorted_spvec.induct) (auto simp: smult_spvec_def sorted_spvec_step1 sorted_spvec_step)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   190
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   191
lemma sorted_spvec_addmult_spvec_helper: "\<lbrakk>sorted_spvec (addmult_spvec y ((a, b) # arr) brr); aa < a; sorted_spvec ((a, b) # arr); 
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   192
  sorted_spvec ((aa, ba) # brr)\<rbrakk> \<Longrightarrow> sorted_spvec ((aa, y * ba) # addmult_spvec y ((a, b) # arr) brr)"  
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   193
  by (induct brr) (auto simp: sorted_spvec.simps)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   194
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   195
lemma sorted_spvec_addmult_spvec_helper2: 
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   196
 "\<lbrakk>sorted_spvec (addmult_spvec y arr ((aa, ba) # brr)); a < aa; sorted_spvec ((a, b) # arr); sorted_spvec ((aa, ba) # brr)\<rbrakk>
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   197
       \<Longrightarrow> sorted_spvec ((a, b) # addmult_spvec y arr ((aa, ba) # brr))"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   198
  by (induct arr) (auto simp: smult_spvec_def sorted_spvec.simps)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   199
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   200
lemma sorted_spvec_addmult_spvec_helper3[rule_format]:
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   201
  "sorted_spvec (addmult_spvec y arr brr) \<Longrightarrow> 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   202
   sorted_spvec ((aa, b) # arr) \<Longrightarrow> 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   203
  sorted_spvec ((aa, ba) # brr) \<Longrightarrow>
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   204
   sorted_spvec ((aa, b + y * ba) # (addmult_spvec y arr brr))"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   205
  by (smt (verit, ccfv_threshold) sorted_spvec_step addmult_spvec.simps(1) list.distinct(1) list.sel(3) sorted_spvec.elims(1) sorted_spvec_addmult_spvec_helper2)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   206
31817
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   207
lemma sorted_addmult_spvec: "sorted_spvec a \<Longrightarrow> sorted_spvec b \<Longrightarrow> sorted_spvec (addmult_spvec y a b)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   208
proof (induct y a b rule: addmult_spvec.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   209
  case (1 y arr)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   210
  then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   211
    by simp
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   212
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   213
  case (2 y v va)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   214
  then show ?case 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   215
    by (simp add: sorted_smult_spvec)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   216
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   217
  case (3 y i a arr j b brr)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   218
  show ?case 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   219
  proof (cases i j rule: linorder_cases)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   220
    case less
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   221
    with 3 show ?thesis
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   222
      by (simp add: sorted_spvec_addmult_spvec_helper2 sorted_spvec_cons1)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   223
  next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   224
    case equal
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   225
    with 3 show ?thesis 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   226
      by (simp add: sorted_spvec_addmult_spvec_helper3 sorted_spvec_cons1)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   227
  next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   228
    case greater
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   229
    with 3 show ?thesis 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   230
      by (simp add: sorted_spvec_addmult_spvec_helper sorted_spvec_cons1)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   231
  qed
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   232
qed
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   233
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   234
fun mult_spvec_spmat :: "('a::lattice_ring) spvec \<Rightarrow> 'a spvec \<Rightarrow> 'a spmat  \<Rightarrow> 'a spvec"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   235
where
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   236
  "mult_spvec_spmat c [] brr = c"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   237
| "mult_spvec_spmat c arr [] = c"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   238
| "mult_spvec_spmat c ((i,a)#arr) ((j,b)#brr) = (
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   239
     if (i < j) then mult_spvec_spmat c arr ((j,b)#brr)
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   240
     else if (j < i) then mult_spvec_spmat c ((i,a)#arr) brr 
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   241
     else mult_spvec_spmat (addmult_spvec a c b) arr brr)"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   242
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   243
lemma sparse_row_mult_spvec_spmat: 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   244
  assumes "sorted_spvec (a::('a::lattice_ring) spvec)" "sorted_spvec B"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   245
  shows "sparse_row_vector (mult_spvec_spmat c a B) = (sparse_row_vector c) + (sparse_row_vector a) * (sparse_row_matrix B)"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   246
proof -
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   247
  have comp_1: "!! a b. a < b \<Longrightarrow> Suc 0 \<le> nat ((int b)-(int a))" by arith
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   248
  have not_iff: "!! a b. a = b \<Longrightarrow> (~ a) = (~ b)" by simp
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   249
  {
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   250
    fix a 
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   251
    fix v :: "(nat \<times> 'a) list"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   252
    assume a: "a < nrows(sparse_row_vector v)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   253
    have "nrows(sparse_row_vector v) \<le> 1" by simp
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   254
    then have "a = 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   255
      using a dual_order.strict_trans1 by blast
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   256
  }
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   257
  note nrows_helper = this
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   258
  show ?thesis
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   259
    using assms
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   260
  proof (induct c a B rule: mult_spvec_spmat.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   261
    case (1 c brr)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   262
    then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   263
      by simp
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   264
  next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   265
    case (2 c v va)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   266
    then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   267
      by simp
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   268
  next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   269
    case (3 c i a arr j b brr)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   270
    then have abrr: "sorted_spvec arr" "sorted_spvec brr"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   271
      using sorted_spvec_cons1 by blast+
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   272
    have "\<And>m n. \<lbrakk>a \<noteq> 0; 0 < m\<rbrakk>
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   273
           \<Longrightarrow> a * Rep_matrix (sparse_row_vector b) m n = 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   274
      by (metis mult_zero_right neq0_conv nrows_helper nrows_notzero)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   275
    then have \<dagger>: "scalar_mult a (sparse_row_vector b) =
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   276
            singleton_matrix 0 j a * move_matrix (sparse_row_vector b) (int j) 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   277
      apply (intro matrix_eqI)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   278
      apply (simp)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   279
      apply (subst Rep_matrix_mult)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   280
      apply (subst foldseq_almostzero, auto)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   281
      done
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   282
    show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   283
    proof (cases i j rule: linorder_cases)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   284
      case less
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   285
      with 3 abrr \<dagger> show ?thesis
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   286
        apply (simp add: algebra_simps sparse_row_matrix_cons Rep_matrix_zero_imp_mult_zero)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   287
        by (metis Rep_matrix_zero_imp_mult_zero Rep_singleton_matrix less_imp_le_nat sorted_sparse_row_matrix_zero)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   288
    next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   289
      case equal
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   290
      with 3 abrr \<dagger> show ?thesis
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   291
        apply (simp add: sparse_row_matrix_cons algebra_simps sparse_row_vector_addmult_spvec)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   292
        apply (subst Rep_matrix_zero_imp_mult_zero)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   293
        using sorted_sparse_row_matrix_zero apply fastforce
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   294
        apply (subst Rep_matrix_zero_imp_mult_zero)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   295
         apply (metis Rep_move_matrix comp_1 nrows_le nrows_spvec sorted_sparse_row_vector_zero verit_comp_simplify1(3))
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   296
        apply simp
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   297
        done
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   298
    next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   299
      case greater
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   300
      have "Rep_matrix (sparse_row_vector arr) j' k = 0 \<or>
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   301
           Rep_matrix (move_matrix (sparse_row_vector b) (int j) 0) k
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   302
            i' = 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   303
        if "sorted_spvec ((i, a) # arr)" for j' i' k
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   304
      proof (cases "k \<le> j")
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   305
        case True
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   306
        with greater that show ?thesis
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   307
          by (meson order.trans nat_less_le sorted_sparse_row_vector_zero)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   308
      qed (use nrows_helper nrows_notzero in force)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   309
      then have "sparse_row_vector arr * move_matrix (sparse_row_vector b) (int j) 0 = 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   310
        using greater 3 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   311
        by (simp add: Rep_matrix_zero_imp_mult_zero)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   312
      with greater 3 abrr show ?thesis
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   313
        apply (simp add: algebra_simps sparse_row_matrix_cons)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   314
        by (metis Rep_matrix_zero_imp_mult_zero Rep_move_matrix Rep_singleton_matrix comp_1 nrows_le nrows_spvec)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   315
    qed
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   316
  qed
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   317
qed
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   318
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   319
lemma sorted_mult_spvec_spmat: 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   320
  "sorted_spvec (c::('a::lattice_ring) spvec) \<Longrightarrow> sorted_spmat B \<Longrightarrow> sorted_spvec (mult_spvec_spmat c a B)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   321
  by (induct c a B rule: mult_spvec_spmat.induct) (simp_all add: sorted_addmult_spvec)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   322
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   323
primrec mult_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   324
where
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   325
  "mult_spmat [] A = []"
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   326
| "mult_spmat (a#as) A = (fst a, mult_spvec_spmat [] (snd a) A)#(mult_spmat as A)"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   327
31817
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   328
lemma sparse_row_mult_spmat: 
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   329
  "sorted_spmat A \<Longrightarrow> sorted_spvec B \<Longrightarrow>
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   330
   sparse_row_matrix (mult_spmat A B) = (sparse_row_matrix A) * (sparse_row_matrix B)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   331
  by (induct A) (auto simp: sparse_row_matrix_cons sparse_row_mult_spvec_spmat algebra_simps move_matrix_mult)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   332
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   333
lemma sorted_spvec_mult_spmat:
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   334
  fixes A :: "('a::lattice_ring) spmat"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   335
  shows "sorted_spvec A \<Longrightarrow> sorted_spvec (mult_spmat A B)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   336
by (induct A rule: sorted_spvec.induct) (auto simp: sorted_spvec.simps)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   337
31817
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   338
lemma sorted_spmat_mult_spmat:
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 32491
diff changeset
   339
  "sorted_spmat (B::('a::lattice_ring) spmat) \<Longrightarrow> sorted_spmat (mult_spmat A B)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   340
  by (induct A) (auto simp: sorted_mult_spvec_spmat) 
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   341
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   342
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   343
fun add_spvec :: "('a::lattice_ab_group_add) spvec \<Rightarrow> 'a spvec \<Rightarrow> 'a spvec"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   344
where
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   345
(* "measure (% (a, b). length a + (length b))" *)
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   346
  "add_spvec arr [] = arr"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   347
| "add_spvec [] brr = brr"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   348
| "add_spvec ((i,a)#arr) ((j,b)#brr) = (
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   349
     if i < j then (i,a)#(add_spvec arr ((j,b)#brr)) 
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   350
     else if (j < i) then (j,b) # add_spvec ((i,a)#arr) brr
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   351
     else (i, a+b) # add_spvec arr brr)"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   352
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   353
lemma add_spvec_empty1[simp]: "add_spvec [] a = a"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   354
  by (cases a, auto)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   355
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   356
lemma sparse_row_vector_add: "sparse_row_vector (add_spvec a b) = (sparse_row_vector a) + (sparse_row_vector b)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   357
  by (induct a b rule: add_spvec.induct) (simp_all add: singleton_matrix_add)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   358
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   359
fun add_spmat :: "('a::lattice_ab_group_add) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   360
where
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   361
(* "measure (% (A,B). (length A)+(length B))" *)
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   362
  "add_spmat [] bs = bs"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   363
| "add_spmat as [] = as"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   364
| "add_spmat ((i,a)#as) ((j,b)#bs) = (
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   365
    if i < j then 
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   366
      (i,a) # add_spmat as ((j,b)#bs)
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   367
    else if j < i then
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   368
      (j,b) # add_spmat ((i,a)#as) bs
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   369
    else
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   370
      (i, add_spvec a b) # add_spmat as bs)"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   371
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   372
lemma add_spmat_Nil2[simp]: "add_spmat as [] = as"
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   373
by(cases as) auto
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   374
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   375
lemma sparse_row_add_spmat: "sparse_row_matrix (add_spmat A B) = (sparse_row_matrix A) + (sparse_row_matrix B)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   376
  by (induct A B rule: add_spmat.induct) (auto simp: sparse_row_matrix_cons sparse_row_vector_add move_matrix_add)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   377
82774
2865a6618cba append (rather than prepend) code equations: the order within a theory is maintained in the resulting code
haftmann
parents: 80756
diff changeset
   378
lemma [code]:
2865a6618cba append (rather than prepend) code equations: the order within a theory is maintained in the resulting code
haftmann
parents: 80756
diff changeset
   379
  \<open>sparse_row_matrix A + sparse_row_matrix B = sparse_row_matrix (add_spmat A B)\<close>
2865a6618cba append (rather than prepend) code equations: the order within a theory is maintained in the resulting code
haftmann
parents: 80756
diff changeset
   380
  \<open>sparse_row_vector a + sparse_row_vector b = sparse_row_vector (add_spvec a b)\<close>
2865a6618cba append (rather than prepend) code equations: the order within a theory is maintained in the resulting code
haftmann
parents: 80756
diff changeset
   381
  by (simp_all add: sparse_row_add_spmat sparse_row_vector_add)
27484
dbb9981c3d18 added marginal setup for code generation
haftmann
parents: 26300
diff changeset
   382
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   383
lemma sorted_add_spvec_helper1[rule_format]: "add_spvec ((a,b)#arr) brr = (ab, bb) # list \<longrightarrow> (ab = a | (brr \<noteq> [] & ab = fst (hd brr)))"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   384
proof - 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   385
  have "(\<forall>x ab a. x = (a,b)#arr \<longrightarrow> add_spvec x brr = (ab, bb) # list \<longrightarrow> (ab = a | (ab = fst (hd brr))))"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   386
    by (induct brr rule: add_spvec.induct) (auto split:if_splits)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   387
  then show ?thesis
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   388
    by (case_tac brr, auto)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   389
qed
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   390
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   391
lemma sorted_add_spmat_helper1[rule_format]:
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   392
  "add_spmat ((a,b)#arr) brr = (ab, bb) # list \<Longrightarrow> (ab = a | (brr \<noteq> [] & ab = fst (hd brr)))"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   393
  by (smt (verit) add_spmat.elims fst_conv list.distinct(1) list.sel(1))
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   394
31817
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   395
lemma sorted_add_spvec_helper: "add_spvec arr brr = (ab, bb) # list \<Longrightarrow> ((arr \<noteq> [] & ab = fst (hd arr)) | (brr \<noteq> [] & ab = fst (hd brr)))"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   396
  by (induct arr brr rule: add_spvec.induct) (auto split:if_splits)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   397
31817
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   398
lemma sorted_add_spmat_helper: "add_spmat arr brr = (ab, bb) # list \<Longrightarrow> ((arr \<noteq> [] & ab = fst (hd arr)) | (brr \<noteq> [] & ab = fst (hd brr)))"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   399
  by (induct arr brr rule: add_spmat.induct) (auto split:if_splits)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   400
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   401
lemma add_spvec_commute: "add_spvec a b = add_spvec b a"
31817
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   402
by (induct a b rule: add_spvec.induct) auto
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   403
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   404
lemma add_spmat_commute: "add_spmat a b = add_spmat b a"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   405
  by (induct a b rule: add_spmat.induct) (simp_all add: add_spvec_commute)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   406
  
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   407
lemma sorted_add_spvec_helper2: "add_spvec ((a,b)#arr) brr = (ab, bb) # list \<Longrightarrow> aa < a \<Longrightarrow> sorted_spvec ((aa, ba) # brr) \<Longrightarrow> aa < ab"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   408
  by (smt (verit, best) add_spvec.elims fst_conv list.sel(1) sorted_spvec_cons3)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   409
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   410
lemma sorted_add_spmat_helper2: "add_spmat ((a,b)#arr) brr = (ab, bb) # list \<Longrightarrow> aa < a \<Longrightarrow> sorted_spvec ((aa, ba) # brr) \<Longrightarrow> aa < ab"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   411
  by (metis (no_types, opaque_lifting) add_spmat.simps(1) list.sel(1) neq_Nil_conv sorted_add_spmat_helper sorted_spvec_cons3)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   412
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   413
lemma sorted_spvec_add_spvec: "sorted_spvec a \<Longrightarrow> sorted_spvec b \<Longrightarrow> sorted_spvec (add_spvec a b)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   414
proof (induct a b rule: add_spvec.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   415
  case (3 i a arr j b brr)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   416
  then have "sorted_spvec arr" "sorted_spvec brr"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   417
    using sorted_spvec_cons1 by blast+
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   418
  with 3 show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   419
    apply simp
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   420
    by (smt (verit, ccfv_SIG) add_spvec.simps(2) list.sel(3) sorted_add_spvec_helper sorted_spvec.elims(1))
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   421
qed auto
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   422
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   423
lemma sorted_spvec_add_spmat:
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   424
  "sorted_spvec A \<Longrightarrow> sorted_spvec B \<Longrightarrow> sorted_spvec (add_spmat A B)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   425
proof (induct A B rule: add_spmat.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   426
  case (1 bs)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   427
  then show ?case by auto
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   428
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   429
  case (2 v va)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   430
  then show ?case by auto
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   431
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   432
  case (3 i a as j b bs)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   433
  then have "sorted_spvec as" "sorted_spvec bs"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   434
    using sorted_spvec_cons1 by blast+
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   435
  with 3 show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   436
    apply simp
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   437
    by (smt (verit) Pair_inject add_spmat.elims list.discI list.inject sorted_spvec.elims(1))
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   438
qed
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   439
31817
9b34b1449cb7 removed old primrecs
nipkow
parents: 31816
diff changeset
   440
lemma sorted_spmat_add_spmat[rule_format]: "sorted_spmat A \<Longrightarrow> sorted_spmat B \<Longrightarrow> sorted_spmat (add_spmat A B)"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   441
  by (induct A B rule: add_spmat.induct) (simp_all add: sorted_spvec_add_spvec)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   442
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   443
fun le_spvec :: "('a::lattice_ab_group_add) spvec \<Rightarrow> 'a spvec \<Rightarrow> bool"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   444
where
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   445
(* "measure (% (a,b). (length a) + (length b))" *)
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   446
  "le_spvec [] [] = True"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   447
| "le_spvec ((_,a)#as) [] = (a \<le> 0 & le_spvec as [])"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   448
| "le_spvec [] ((_,b)#bs) = (0 \<le> b & le_spvec [] bs)"
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   449
| "le_spvec ((i,a)#as) ((j,b)#bs) = (
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   450
    if (i < j) then a \<le> 0 & le_spvec as ((j,b)#bs)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   451
    else if (j < i) then 0 \<le> b & le_spvec ((i,a)#as) bs
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   452
    else a \<le> b & le_spvec as bs)"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   453
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   454
fun le_spmat :: "('a::lattice_ab_group_add) spmat \<Rightarrow> 'a spmat \<Rightarrow> bool"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   455
where
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   456
(* "measure (% (a,b). (length a) + (length b))" *)
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   457
  "le_spmat [] [] = True"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   458
| "le_spmat ((i,a)#as) [] = (le_spvec a [] & le_spmat as [])"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   459
| "le_spmat [] ((j,b)#bs) = (le_spvec [] b & le_spmat [] bs)"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   460
| "le_spmat ((i,a)#as) ((j,b)#bs) = (
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   461
    if i < j then (le_spvec a [] & le_spmat as ((j,b)#bs))
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   462
    else if j < i then (le_spvec [] b & le_spmat ((i,a)#as) bs)
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   463
    else (le_spvec a b & le_spmat as bs))"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   464
35416
d8d7d1b785af replaced a couple of constsdefs by definitions (also some old primrecs by modern ones)
haftmann
parents: 35028
diff changeset
   465
definition disj_matrices :: "('a::zero) matrix \<Rightarrow> 'a matrix \<Rightarrow> bool" where
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   466
  "disj_matrices A B \<longleftrightarrow>
67613
ce654b0e6d69 more symbols;
wenzelm
parents: 61945
diff changeset
   467
    (\<forall>j i. (Rep_matrix A j i \<noteq> 0) \<longrightarrow> (Rep_matrix B j i = 0)) & (\<forall>j i. (Rep_matrix B j i \<noteq> 0) \<longrightarrow> (Rep_matrix A j i = 0))"  
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   468
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   469
lemma disj_matrices_contr1: "disj_matrices A B \<Longrightarrow> Rep_matrix A j i \<noteq> 0 \<Longrightarrow> Rep_matrix B j i = 0"
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   470
   by (simp add: disj_matrices_def)
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   471
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   472
lemma disj_matrices_contr2: "disj_matrices A B \<Longrightarrow> Rep_matrix B j i \<noteq> 0 \<Longrightarrow> Rep_matrix A j i = 0"
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   473
   by (simp add: disj_matrices_def)
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   474
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   475
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   476
lemma disj_matrices_add:
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   477
  fixes A :: "('a::lattice_ab_group_add) matrix"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   478
  shows  "disj_matrices A B \<Longrightarrow> disj_matrices C D \<Longrightarrow> disj_matrices A D 
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   479
       \<Longrightarrow> disj_matrices B C \<Longrightarrow> (A + B \<le> C + D) = (A \<le> C \<and> B \<le> D)"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   480
  apply (intro iffI conjI)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   481
  unfolding le_matrix_def disj_matrices_def
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   482
  apply (metis Rep_matrix_add group_cancel.rule0 order_refl)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   483
  apply (metis (no_types, lifting) Rep_matrix_add add_cancel_right_left dual_order.refl)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   484
  by (meson add_mono le_matrix_def)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   485
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   486
lemma disj_matrices_zero1[simp]: "disj_matrices 0 B"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   487
  by (simp add: disj_matrices_def)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   488
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   489
lemma disj_matrices_zero2[simp]: "disj_matrices A 0"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   490
  by (simp add: disj_matrices_def)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   491
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   492
lemma disj_matrices_commute: "disj_matrices A B = disj_matrices B A"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   493
  by (auto simp: disj_matrices_def)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   494
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   495
lemma disj_matrices_add_le_zero: "disj_matrices A B \<Longrightarrow>
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   496
  (A + B \<le> 0) = (A \<le> 0 & (B::('a::lattice_ab_group_add) matrix) \<le> 0)"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   497
  by (rule disj_matrices_add[of A B 0 0, simplified])
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   498
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   499
lemma disj_matrices_add_zero_le: "disj_matrices A B \<Longrightarrow>
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   500
  (0 \<le> A + B) = (0 \<le> A & 0 \<le> (B::('a::lattice_ab_group_add) matrix))"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   501
  by (rule disj_matrices_add[of 0 0 A B, simplified])
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   502
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   503
lemma disj_matrices_add_x_le: "disj_matrices A B \<Longrightarrow> disj_matrices B C \<Longrightarrow> 
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   504
  (A \<le> B + C) = (A \<le> C & 0 \<le> (B::('a::lattice_ab_group_add) matrix))"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   505
  by (auto simp: disj_matrices_add[of 0 A B C, simplified])
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   506
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   507
lemma disj_matrices_add_le_x: "disj_matrices A B \<Longrightarrow> disj_matrices B C \<Longrightarrow> 
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   508
  (B + A \<le> C) = (A \<le> C &  (B::('a::lattice_ab_group_add) matrix) \<le> 0)"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   509
  by (auto simp: disj_matrices_add[of B A 0 C,simplified] disj_matrices_commute)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   510
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   511
lemma disj_sparse_row_singleton: "i \<le> j \<Longrightarrow> sorted_spvec((j,y)#v) \<Longrightarrow> disj_matrices (sparse_row_vector v) (singleton_matrix 0 i x)"
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   512
  apply (simp add: disj_matrices_def)
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   513
  using sorted_sparse_row_vector_zero by blast
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   514
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 32491
diff changeset
   515
lemma disj_matrices_x_add: "disj_matrices A B \<Longrightarrow> disj_matrices A C \<Longrightarrow> disj_matrices (A::('a::lattice_ab_group_add) matrix) (B+C)"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   516
  by (smt (verit, ccfv_SIG) Rep_matrix_add add_0 disj_matrices_def)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   517
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 32491
diff changeset
   518
lemma disj_matrices_add_x: "disj_matrices A B \<Longrightarrow> disj_matrices A C \<Longrightarrow> disj_matrices (B+C) (A::('a::lattice_ab_group_add) matrix)" 
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   519
  by (simp add: disj_matrices_x_add disj_matrices_commute)
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   520
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   521
lemma disj_singleton_matrices[simp]: "disj_matrices (singleton_matrix j i x) (singleton_matrix u v y) = (j \<noteq> u | i \<noteq> v | x = 0 | y = 0)" 
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   522
  by (auto simp: disj_matrices_def)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   523
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   524
lemma disj_move_sparse_vec_mat:
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   525
  assumes "j \<le> a" and "sorted_spvec ((a, c) # as)"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   526
  shows "disj_matrices (sparse_row_matrix as) (move_matrix (sparse_row_vector b) (int j) i)"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   527
proof -
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   528
  have "Rep_matrix (sparse_row_vector b) (n-j) (nat (int m - i)) = 0"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   529
    if "\<not> n<j" and nz: "Rep_matrix (sparse_row_matrix as) n m \<noteq> 0"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   530
    for n m
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   531
  proof -
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   532
    have "n \<noteq> j"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   533
      using assms sorted_sparse_row_matrix_zero nz by blast
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   534
    with that have "j < n"  by auto
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   535
    then show ?thesis
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   536
      by (metis One_nat_def Suc_diff_Suc nrows nrows_spvec plus_1_eq_Suc trans_le_add1)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   537
  qed
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   538
  then show ?thesis
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   539
    by (auto simp: disj_matrices_def nat_minus_as_int)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   540
qed
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   541
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   542
lemma disj_move_sparse_row_vector_twice:
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   543
  "j \<noteq> u \<Longrightarrow> disj_matrices (move_matrix (sparse_row_vector a) j i) (move_matrix (sparse_row_vector b) u v)"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   544
  unfolding disj_matrices_def
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   545
  by (smt (verit, ccfv_SIG) One_nat_def Rep_move_matrix of_nat_1 le_nat_iff nrows nrows_spvec of_nat_le_iff)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   546
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   547
lemma le_spvec_iff_sparse_row_le:
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   548
  "sorted_spvec a \<Longrightarrow> sorted_spvec b \<Longrightarrow> (le_spvec a b) \<longleftrightarrow> (sparse_row_vector a \<le> sparse_row_vector b)"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   549
proof (induct a b rule: le_spvec.induct)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   550
  case 1
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   551
  then show ?case
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   552
    by auto
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   553
next
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   554
  case (2 uu a as)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   555
  then have "sorted_spvec as"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   556
    by (metis sorted_spvec_cons1)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   557
  with 2 show ?case
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   558
    apply (simp add: add.commute)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   559
    by (metis disj_matrices_add_le_zero disj_sparse_row_singleton le_refl singleton_le_zero)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   560
next
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   561
  case (3 uv b bs)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   562
  then have "sorted_spvec bs"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   563
    by (metis sorted_spvec_cons1)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   564
  with 3 show ?case
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   565
    apply (simp add: add.commute)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   566
    by (metis disj_matrices_add_zero_le disj_sparse_row_singleton le_refl singleton_ge_zero)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   567
next
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   568
  case (4 i a as j b bs)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   569
  then obtain \<section>: "sorted_spvec as" "sorted_spvec bs"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   570
    by (metis sorted_spvec_cons1)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   571
  show ?case
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   572
  proof (cases i j rule: linorder_cases)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   573
    case less
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   574
    with 4 \<section> show ?thesis
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   575
      apply (simp add: )
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   576
      by (metis disj_matrices_add_le_x disj_matrices_add_x disj_matrices_commute disj_singleton_matrices disj_sparse_row_singleton less_imp_le_nat singleton_le_zero not_le)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   577
  next
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   578
    case equal
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   579
    with 4 \<section> show ?thesis
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   580
      apply (simp add: )
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   581
      by (metis disj_matrices_add disj_matrices_commute disj_sparse_row_singleton order_refl singleton_matrix_le)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   582
  next
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   583
    case greater
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   584
    with 4 \<section> show ?thesis
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   585
      apply (simp add: )
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   586
      by (metis disj_matrices_add_x disj_matrices_add_x_le disj_matrices_commute disj_singleton_matrices disj_sparse_row_singleton le_refl order_less_le singleton_ge_zero)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   587
  qed
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   588
qed
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   589
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   590
lemma le_spvec_empty2_sparse_row: 
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   591
  "sorted_spvec b \<Longrightarrow> le_spvec b [] = (sparse_row_vector b \<le> 0)"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   592
  by (simp add: le_spvec_iff_sparse_row_le)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   593
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   594
lemma le_spvec_empty1_sparse_row: 
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   595
  "(sorted_spvec b) \<Longrightarrow> (le_spvec [] b = (0 \<le> sparse_row_vector b))"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   596
  by (simp add: le_spvec_iff_sparse_row_le)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   597
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   598
lemma le_spmat_iff_sparse_row_le:
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   599
  "\<lbrakk>sorted_spvec A; sorted_spmat A; sorted_spvec B; sorted_spmat B\<rbrakk> \<Longrightarrow> 
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   600
  le_spmat A B = (sparse_row_matrix A \<le> sparse_row_matrix B)"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   601
proof (induct A B rule: le_spmat.induct)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   602
  case (4 i a as j b bs)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   603
  then obtain \<section>: "sorted_spvec as" "sorted_spvec bs"
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   604
    by (metis sorted_spvec_cons1)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   605
  show ?case
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   606
  proof (cases i j rule: linorder_cases)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   607
    case less
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   608
    with 4 \<section> show ?thesis
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   609
      apply (simp add: sparse_row_matrix_cons le_spvec_empty2_sparse_row)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   610
      by (metis disj_matrices_add_le_x disj_matrices_add_x disj_matrices_commute disj_move_sparse_row_vector_twice disj_move_sparse_vec_mat int_eq_iff less_not_refl move_matrix_le_zero order_le_less)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   611
  next
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   612
    case equal
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   613
    with 4 \<section> show ?thesis
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   614
      by (simp add: sparse_row_matrix_cons le_spvec_iff_sparse_row_le disj_matrices_commute disj_move_sparse_vec_mat[OF order_refl] disj_matrices_add)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   615
  next
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   616
    case greater
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   617
    with 4 \<section> show ?thesis
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   618
      apply (simp add: sparse_row_matrix_cons le_spvec_empty1_sparse_row)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   619
      by (metis disj_matrices_add_x disj_matrices_add_x_le disj_matrices_commute disj_move_sparse_row_vector_twice disj_move_sparse_vec_mat move_matrix_zero_le nat_int nat_less_le of_nat_0_le_iff order_refl)
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   620
  qed
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   621
qed (auto simp add: sparse_row_matrix_cons disj_matrices_add_le_zero disj_matrices_add_zero_le disj_move_sparse_vec_mat[OF order_refl] 
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   622
    disj_matrices_commute sorted_spvec_cons1 le_spvec_empty2_sparse_row le_spvec_empty1_sparse_row)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   623
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   624
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   625
primrec abs_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   626
where
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   627
  "abs_spmat [] = []"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   628
| "abs_spmat (a#as) = (fst a, abs_spvec (snd a))#(abs_spmat as)"
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   629
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   630
primrec minus_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   631
where
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   632
  "minus_spmat [] = []"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   633
| "minus_spmat (a#as) = (fst a, minus_spvec (snd a))#(minus_spmat as)"
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   634
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   635
lemma sparse_row_matrix_minus:
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   636
  "sparse_row_matrix (minus_spmat A) = - (sparse_row_matrix A)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   637
proof (induct A)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   638
  case Nil
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   639
  then show ?case by auto
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   640
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   641
  case (Cons a A)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   642
  then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   643
    by (simp add: sparse_row_vector_minus sparse_row_matrix_cons matrix_eqI)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   644
qed
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   645
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   646
lemma Rep_sparse_row_vector_zero:
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   647
  assumes "x \<noteq> 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   648
    shows "Rep_matrix (sparse_row_vector v) x y = 0"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   649
  by (metis Suc_leI assms le0 le_eq_less_or_eq nrows_le nrows_spvec)
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   650
    
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   651
lemma sparse_row_matrix_abs:
61945
1135b8de26c3 more symbols;
wenzelm
parents: 61169
diff changeset
   652
  "sorted_spvec A \<Longrightarrow> sorted_spmat A \<Longrightarrow> sparse_row_matrix (abs_spmat A) = \<bar>sparse_row_matrix A\<bar>"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   653
proof (induct A)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   654
  case Nil
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   655
  then show ?case by auto
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   656
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   657
  case (Cons ab A)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   658
  then have A: "sorted_spvec A"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   659
    using sorted_spvec_cons1 by blast
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   660
  show ?case 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   661
  proof (cases ab)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   662
    case (Pair a b)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   663
    show ?thesis
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   664
      unfolding Pair
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   665
    proof (intro matrix_eqI)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   666
      fix m n
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   667
      show "Rep_matrix (sparse_row_matrix (abs_spmat ((a,b) # A))) m n 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   668
          = Rep_matrix \<bar>sparse_row_matrix ((a,b) # A)\<bar> m n"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   669
        using Cons Pair A 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   670
        apply (simp add: sparse_row_vector_abs sparse_row_matrix_cons)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   671
        apply (cases "m=a")
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   672
        using sorted_sparse_row_matrix_zero apply fastforce
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   673
        by (simp add: Rep_sparse_row_vector_zero)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   674
    qed
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   675
  qed
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   676
qed
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   677
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   678
lemma sorted_spvec_minus_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec (minus_spmat A)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   679
by (induct A rule: sorted_spvec.induct) (auto simp: sorted_spvec.simps)
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   680
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   681
lemma sorted_spvec_abs_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec (abs_spmat A)" 
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   682
  by (induct A rule: sorted_spvec.induct) (auto simp: sorted_spvec.simps)
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   683
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   684
lemma sorted_spmat_minus_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat (minus_spmat A)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   685
  by (induct A) (simp_all add: sorted_spvec_minus_spvec)
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   686
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   687
lemma sorted_spmat_abs_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat (abs_spmat A)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   688
  by (induct A) (simp_all add: sorted_spvec_abs_spvec)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   689
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   690
definition diff_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   691
  where "diff_spmat A B = add_spmat A (minus_spmat B)"
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   692
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   693
lemma sorted_spmat_diff_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat B \<Longrightarrow> sorted_spmat (diff_spmat A B)"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   694
  by (simp add: diff_spmat_def sorted_spmat_minus_spmat sorted_spmat_add_spmat)
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   695
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   696
lemma sorted_spvec_diff_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec B \<Longrightarrow> sorted_spvec (diff_spmat A B)"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   697
  by (simp add: diff_spmat_def sorted_spvec_minus_spmat sorted_spvec_add_spmat)
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   698
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   699
lemma sparse_row_diff_spmat: "sparse_row_matrix (diff_spmat A B ) = (sparse_row_matrix A) - (sparse_row_matrix B)"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   700
  by (simp add: diff_spmat_def sparse_row_add_spmat sparse_row_matrix_minus)
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   701
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   702
definition sorted_sparse_matrix :: "'a spmat \<Rightarrow> bool"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   703
  where "sorted_sparse_matrix A \<longleftrightarrow> sorted_spvec A & sorted_spmat A"
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   704
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   705
lemma sorted_sparse_matrix_imp_spvec: "sorted_sparse_matrix A \<Longrightarrow> sorted_spvec A"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   706
  by (simp add: sorted_sparse_matrix_def)
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   707
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   708
lemma sorted_sparse_matrix_imp_spmat: "sorted_sparse_matrix A \<Longrightarrow> sorted_spmat A"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   709
  by (simp add: sorted_sparse_matrix_def)
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   710
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   711
lemmas sorted_sp_simps = 
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   712
  sorted_spvec.simps
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   713
  sorted_spmat.simps
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   714
  sorted_sparse_matrix_def
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   715
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   716
lemma bool1: "(\<not> True) = False"  by blast
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   717
lemma bool2: "(\<not> False) = True"  by blast
61076
bdc1e2f0a86a eliminated \<Colon>;
wenzelm
parents: 54892
diff changeset
   718
lemma bool3: "((P::bool) \<and> True) = P" by blast
bdc1e2f0a86a eliminated \<Colon>;
wenzelm
parents: 54892
diff changeset
   719
lemma bool4: "(True \<and> (P::bool)) = P" by blast
bdc1e2f0a86a eliminated \<Colon>;
wenzelm
parents: 54892
diff changeset
   720
lemma bool5: "((P::bool) \<and> False) = False" by blast
bdc1e2f0a86a eliminated \<Colon>;
wenzelm
parents: 54892
diff changeset
   721
lemma bool6: "(False \<and> (P::bool)) = False" by blast
bdc1e2f0a86a eliminated \<Colon>;
wenzelm
parents: 54892
diff changeset
   722
lemma bool7: "((P::bool) \<or> True) = True" by blast
bdc1e2f0a86a eliminated \<Colon>;
wenzelm
parents: 54892
diff changeset
   723
lemma bool8: "(True \<or> (P::bool)) = True" by blast
bdc1e2f0a86a eliminated \<Colon>;
wenzelm
parents: 54892
diff changeset
   724
lemma bool9: "((P::bool) \<or> False) = P" by blast
bdc1e2f0a86a eliminated \<Colon>;
wenzelm
parents: 54892
diff changeset
   725
lemma bool10: "(False \<or> (P::bool)) = P" by blast
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   726
lemmas boolarith = bool1 bool2 bool3 bool4 bool5 bool6 bool7 bool8 bool9 bool10
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   727
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   728
lemma if_case_eq: "(if b then x else y) = (case b of True => x | False => y)" by simp
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   729
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   730
primrec pprt_spvec :: "('a::{lattice_ab_group_add}) spvec \<Rightarrow> 'a spvec"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   731
where
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   732
  "pprt_spvec [] = []"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   733
| "pprt_spvec (a#as) = (fst a, pprt (snd a)) # (pprt_spvec as)"
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   734
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   735
primrec nprt_spvec :: "('a::{lattice_ab_group_add}) spvec \<Rightarrow> 'a spvec"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   736
where
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   737
  "nprt_spvec [] = []"
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   738
| "nprt_spvec (a#as) = (fst a, nprt (snd a)) # (nprt_spvec as)"
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   739
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   740
primrec pprt_spmat :: "('a::{lattice_ab_group_add}) spmat \<Rightarrow> 'a spmat"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   741
where
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   742
  "pprt_spmat [] = []"
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   743
| "pprt_spmat (a#as) = (fst a, pprt_spvec (snd a))#(pprt_spmat as)"
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   744
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   745
primrec nprt_spmat :: "('a::{lattice_ab_group_add}) spmat \<Rightarrow> 'a spmat"
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   746
where
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   747
  "nprt_spmat [] = []"
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   748
| "nprt_spmat (a#as) = (fst a, nprt_spvec (snd a))#(nprt_spmat as)"
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   749
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   750
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 32491
diff changeset
   751
lemma pprt_add: "disj_matrices A (B::(_::lattice_ring) matrix) \<Longrightarrow> pprt (A+B) = pprt A + pprt B"
22452
8a86fd2a1bf0 adjusted to new lattice theory developement in Lattices.thy / FixedPoint.thy
haftmann
parents: 20432
diff changeset
   752
  apply (simp add: pprt_def sup_matrix_def)
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   753
  apply (intro matrix_eqI)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   754
  by (smt (verit, del_insts) Rep_combine_matrix Rep_zero_matrix_def add.commute comm_monoid_add_class.add_0 disj_matrices_def plus_matrix_def sup.idem)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   755
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 32491
diff changeset
   756
lemma nprt_add: "disj_matrices A (B::(_::lattice_ring) matrix) \<Longrightarrow> nprt (A+B) = nprt A + nprt B"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   757
  unfolding nprt_def inf_matrix_def
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   758
  apply (intro matrix_eqI)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   759
  by (smt (verit, ccfv_threshold) Rep_combine_matrix Rep_matrix_add add.commute add_cancel_right_right add_eq_inf_sup disj_matrices_contr2 sup.idem)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   760
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   761
lemma pprt_singleton[simp]: 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   762
  fixes x:: "_::lattice_ring"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   763
  shows "pprt (singleton_matrix j i x) = singleton_matrix j i (pprt x)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   764
  unfolding pprt_def sup_matrix_def
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   765
  by (simp add: matrix_eqI)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   766
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   767
lemma nprt_singleton[simp]:
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   768
  fixes x:: "_::lattice_ring"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   769
  shows "nprt (singleton_matrix j i x) = singleton_matrix j i (nprt x)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   770
  by (metis add_left_imp_eq pprt_singleton prts singleton_matrix_add)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   771
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   772
lemma sparse_row_vector_pprt:
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   773
  fixes v:: "_::lattice_ring spvec"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   774
  shows "sorted_spvec v \<Longrightarrow> sparse_row_vector (pprt_spvec v) = pprt (sparse_row_vector v)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   775
proof (induct v rule: sorted_spvec.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   776
  case (3 m x n y bs)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   777
  then show ?case
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   778
    apply simp
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   779
    apply (subst pprt_add)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   780
     apply (metis disj_matrices_commute disj_sparse_row_singleton order.refl fst_conv prod.sel(2) sparse_row_vector_cons)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   781
    by (metis pprt_singleton sorted_spvec_cons1)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   782
qed auto
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   783
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   784
lemma sparse_row_vector_nprt:
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   785
  fixes v:: "_::lattice_ring spvec"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   786
  shows "sorted_spvec v \<Longrightarrow> sparse_row_vector (nprt_spvec v) = nprt (sparse_row_vector v)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   787
proof (induct v rule: sorted_spvec.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   788
  case (3 m x n y bs)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   789
  then show ?case
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   790
    apply simp
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   791
    apply (subst nprt_add)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   792
    apply (metis disj_matrices_commute disj_sparse_row_singleton dual_order.refl fst_conv prod.sel(2) sparse_row_vector_cons)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   793
    using sorted_spvec_cons1 by force
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   794
qed auto
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   795
  
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   796
  
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 32491
diff changeset
   797
lemma pprt_move_matrix: "pprt (move_matrix (A::('a::lattice_ring) matrix) j i) = move_matrix (pprt A) j i"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   798
  by (simp add: pprt_def sup_matrix_def matrix_eqI)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   799
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 32491
diff changeset
   800
lemma nprt_move_matrix: "nprt (move_matrix (A::('a::lattice_ring) matrix) j i) = move_matrix (nprt A) j i"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   801
  by (simp add: nprt_def inf_matrix_def matrix_eqI)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   802
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   803
lemma sparse_row_matrix_pprt: 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   804
  fixes m:: "'a::lattice_ring spmat"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   805
  shows "sorted_spvec m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sparse_row_matrix (pprt_spmat m) = pprt (sparse_row_matrix m)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   806
proof (induct m rule: sorted_spvec.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   807
  case (2 a)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   808
  then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   809
    by (simp add: pprt_move_matrix sparse_row_matrix_cons sparse_row_vector_pprt)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   810
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   811
  case (3 m x n y bs)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   812
  then show ?case 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   813
    apply (simp add: sparse_row_matrix_cons sparse_row_vector_pprt)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   814
    apply (subst pprt_add)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   815
     apply (subst disj_matrices_commute)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   816
     apply (metis disj_move_sparse_vec_mat eq_imp_le fst_conv prod.sel(2) sparse_row_matrix_cons)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   817
    apply (simp add: sorted_spvec.simps pprt_move_matrix)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   818
    done
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   819
qed auto
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   820
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   821
lemma sparse_row_matrix_nprt:
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   822
  fixes m:: "'a::lattice_ring spmat"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   823
  shows "sorted_spvec m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sparse_row_matrix (nprt_spmat m) = nprt (sparse_row_matrix m)"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   824
proof (induct m rule: sorted_spvec.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   825
  case (2 a)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   826
  then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   827
    by (simp add: nprt_move_matrix sparse_row_matrix_cons sparse_row_vector_nprt)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   828
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   829
  case (3 m x n y bs)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   830
  then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   831
    apply (simp add: sparse_row_matrix_cons sparse_row_vector_nprt)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   832
    apply (subst nprt_add)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   833
     apply (subst disj_matrices_commute)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   834
     apply (metis disj_move_sparse_vec_mat fst_conv nle_le prod.sel(2) sparse_row_matrix_cons)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   835
    apply (simp add: sorted_spvec.simps nprt_move_matrix)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   836
    done
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   837
qed auto
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   838
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   839
lemma sorted_pprt_spvec: "sorted_spvec v \<Longrightarrow> sorted_spvec (pprt_spvec v)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   840
proof (induct v rule: sorted_spvec.induct)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   841
  case 1
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   842
  then show ?case by auto
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   843
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   844
  case (2 a)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   845
  then show ?case 
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   846
    by (simp add: sorted_spvec_step1)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   847
next
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   848
  case (3 m x n y bs)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   849
  then show ?case
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   850
    by (simp add: sorted_spvec_step)
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   851
qed
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   852
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   853
lemma sorted_nprt_spvec: "sorted_spvec v \<Longrightarrow> sorted_spvec (nprt_spvec v)"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   854
  by (induct v rule: sorted_spvec.induct) (simp_all add: sorted_spvec.simps split:list.split_asm)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   855
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   856
lemma sorted_spvec_pprt_spmat: "sorted_spvec m \<Longrightarrow> sorted_spvec (pprt_spmat m)"
80756
4d592706086e Tidied some messy old proofs
paulson <lp15@cam.ac.uk>
parents: 80736
diff changeset
   857
  by (induct m rule: sorted_spvec.induct) (simp_all add: sorted_spvec.simps split:list.split_asm)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   858
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   859
lemma sorted_spvec_nprt_spmat: "sorted_spvec m \<Longrightarrow> sorted_spvec (nprt_spmat m)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   860
by (induct m rule: sorted_spvec.induct) (simp_all add: sorted_spvec.simps split:list.split_asm)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   861
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   862
lemma sorted_spmat_pprt_spmat: "sorted_spmat m \<Longrightarrow> sorted_spmat (pprt_spmat m)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   863
  by (induct m) (simp_all add: sorted_pprt_spvec)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   864
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   865
lemma sorted_spmat_nprt_spmat: "sorted_spmat m \<Longrightarrow> sorted_spmat (nprt_spmat m)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   866
  by (induct m) (simp_all add: sorted_nprt_spvec)
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   867
35416
d8d7d1b785af replaced a couple of constsdefs by definitions (also some old primrecs by modern ones)
haftmann
parents: 35028
diff changeset
   868
definition mult_est_spmat :: "('a::lattice_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat" where
38273
d31a34569542 modernized some specifications;
wenzelm
parents: 35416
diff changeset
   869
  "mult_est_spmat r1 r2 s1 s2 =
31816
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   870
  add_spmat (mult_spmat (pprt_spmat s2) (pprt_spmat r2)) (add_spmat (mult_spmat (pprt_spmat s1) (nprt_spmat r2)) 
ffaf6dd53045 replaced recdefs by funs
nipkow
parents: 29667
diff changeset
   871
  (add_spmat (mult_spmat (nprt_spmat s2) (pprt_spmat r1)) (mult_spmat (nprt_spmat s1) (nprt_spmat r1))))"  
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   872
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   873
lemmas sparse_row_matrix_op_simps =
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   874
  sorted_sparse_matrix_imp_spmat sorted_sparse_matrix_imp_spvec
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   875
  sparse_row_add_spmat sorted_spvec_add_spmat sorted_spmat_add_spmat
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   876
  sparse_row_diff_spmat sorted_spvec_diff_spmat sorted_spmat_diff_spmat
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   877
  sparse_row_matrix_minus sorted_spvec_minus_spmat sorted_spmat_minus_spmat
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   878
  sparse_row_mult_spmat sorted_spvec_mult_spmat sorted_spmat_mult_spmat
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   879
  sparse_row_matrix_abs sorted_spvec_abs_spmat sorted_spmat_abs_spmat
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   880
  le_spmat_iff_sparse_row_le
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   881
  sparse_row_matrix_pprt sorted_spvec_pprt_spmat sorted_spmat_pprt_spmat
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   882
  sparse_row_matrix_nprt sorted_spvec_nprt_spmat sorted_spmat_nprt_spmat
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   883
47108
2a1953f0d20d merged fork with new numeral representation (see NEWS)
huffman
parents: 46988
diff changeset
   884
lemmas sparse_row_matrix_arith_simps = 
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   885
  mult_spmat.simps mult_spvec_spmat.simps 
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   886
  addmult_spvec.simps 
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   887
  smult_spvec_empty smult_spvec_cons
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   888
  add_spmat.simps add_spvec.simps
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   889
  minus_spmat.simps minus_spvec.simps
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   890
  abs_spmat.simps abs_spvec.simps
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   891
  diff_spmat_def
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   892
  le_spmat.simps le_spvec.simps
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   893
  pprt_spmat.simps pprt_spvec.simps
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   894
  nprt_spmat.simps nprt_spvec.simps
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   895
  mult_est_spmat_def
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   896
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   897
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   898
(*lemma spm_linprog_dual_estimate_1:
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   899
  assumes  
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   900
  "sorted_sparse_matrix A1"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   901
  "sorted_sparse_matrix A2"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   902
  "sorted_sparse_matrix c1"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   903
  "sorted_sparse_matrix c2"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   904
  "sorted_sparse_matrix y"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   905
  "sorted_spvec b"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   906
  "sorted_spvec r"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   907
  "le_spmat ([], y)"
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 32491
diff changeset
   908
  "A * x \<le> sparse_row_matrix (b::('a::lattice_ring) spmat)"
80736
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   909
  "sparse_row_matrix A1 \<le> A"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   910
  "A \<le> sparse_row_matrix A2"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   911
  "sparse_row_matrix c1 \<le> c"
c8bcb14fcfa8 Partial tidying of old proofs
paulson <lp15@cam.ac.uk>
parents: 67613
diff changeset
   912
  "c \<le> sparse_row_matrix c2"
61945
1135b8de26c3 more symbols;
wenzelm
parents: 61169
diff changeset
   913
  "\<bar>x\<bar> \<le> sparse_row_matrix r"
15178
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   914
  shows
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   915
  "c * x \<le> sparse_row_matrix (add_spmat (mult_spmat y b, mult_spmat (add_spmat (add_spmat (mult_spmat y (diff_spmat A2 A1), 
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   916
  abs_spmat (diff_spmat (mult_spmat y A1) c1)), diff_spmat c2 c1)) r))"
5f621aa35c25 Matrix theory, linear programming
obua
parents: 15009
diff changeset
   917
  by (insert prems, simp add: sparse_row_matrix_op_simps linprog_dual_estimate_1[where A=A])
15580
900291ee0af8 Cleaning up HOL/Matrix
obua
parents: 15481
diff changeset
   918
*)
15009
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   919
8c89f588c7aa support for sparse matrices
obua
parents:
diff changeset
   920
end