| author | huffman | 
| Fri, 04 Jul 2008 16:33:08 +0200 | |
| changeset 27486 | c61507a98bff | 
| parent 27484 | dbb9981c3d18 | 
| child 27653 | 180e28bab764 | 
| permissions | -rw-r--r-- | 
| 16487 | 1  | 
(* Title: HOL/Matrix/SparseMatrix.thy  | 
2  | 
ID: $Id$  | 
|
3  | 
Author: Steven Obua  | 
|
4  | 
*)  | 
|
5  | 
||
| 27484 | 6  | 
theory SparseMatrix  | 
7  | 
imports Matrix  | 
|
8  | 
begin  | 
|
| 15009 | 9  | 
|
10  | 
types  | 
|
11  | 
'a spvec = "(nat * 'a) list"  | 
|
12  | 
  'a spmat = "('a spvec) spvec"
 | 
|
13  | 
||
| 27484 | 14  | 
definition sparse_row_vector :: "('a::lordered_ring) spvec \<Rightarrow> 'a matrix" where
 | 
15  | 
sparse_row_vector_def: "sparse_row_vector arr = foldl (% m x. m + (singleton_matrix 0 (fst x) (snd x))) 0 arr"  | 
|
| 15009 | 16  | 
|
| 27484 | 17  | 
definition sparse_row_matrix :: "('a::lordered_ring) spmat \<Rightarrow> 'a matrix" where
 | 
18  | 
sparse_row_matrix_def: "sparse_row_matrix arr = foldl (% m r. m + (move_matrix (sparse_row_vector (snd r)) (int (fst r)) 0)) 0 arr"  | 
|
| 15009 | 19  | 
|
| 27484 | 20  | 
code_datatype sparse_row_vector sparse_row_matrix  | 
21  | 
||
22  | 
lemma sparse_row_vector_empty [simp]: "sparse_row_vector [] = 0"  | 
|
| 15009 | 23  | 
by (simp add: sparse_row_vector_def)  | 
24  | 
||
| 27484 | 25  | 
lemma sparse_row_matrix_empty [simp]: "sparse_row_matrix [] = 0"  | 
| 15009 | 26  | 
by (simp add: sparse_row_matrix_def)  | 
27  | 
||
| 27484 | 28  | 
lemmas [code func] = sparse_row_vector_empty [symmetric]  | 
29  | 
||
| 15009 | 30  | 
lemma foldl_distrstart[rule_format]: "! a x y. (f (g x y) a = g x (f y a)) \<Longrightarrow> ! x y. (foldl f (g x y) l = g x (foldl f y l))"  | 
31  | 
by (induct l, auto)  | 
|
32  | 
||
33  | 
lemma sparse_row_vector_cons[simp]: "sparse_row_vector (a#arr) = (singleton_matrix 0 (fst a) (snd a)) + (sparse_row_vector arr)"  | 
|
34  | 
apply (induct arr)  | 
|
35  | 
apply (auto simp add: sparse_row_vector_def)  | 
|
36  | 
apply (simp add: foldl_distrstart[of "\<lambda>m x. m + singleton_matrix 0 (fst x) (snd x)" "\<lambda>x m. singleton_matrix 0 (fst x) (snd x) + m"])  | 
|
37  | 
done  | 
|
38  | 
||
39  | 
lemma sparse_row_vector_append[simp]: "sparse_row_vector (a @ b) = (sparse_row_vector a) + (sparse_row_vector b)"  | 
|
40  | 
by (induct a, auto)  | 
|
41  | 
||
42  | 
lemma nrows_spvec[simp]: "nrows (sparse_row_vector x) <= (Suc 0)"  | 
|
43  | 
apply (induct x)  | 
|
44  | 
apply (simp_all add: add_nrows)  | 
|
45  | 
done  | 
|
46  | 
||
47  | 
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"  | 
|
48  | 
apply (induct arr)  | 
|
49  | 
apply (auto simp add: sparse_row_matrix_def)  | 
|
50  | 
apply (simp add: foldl_distrstart[of "\<lambda>m x. m + (move_matrix (sparse_row_vector (snd x)) (int (fst x)) 0)"  | 
|
51  | 
"% a m. (move_matrix (sparse_row_vector (snd a)) (int (fst a)) 0) + m"])  | 
|
52  | 
done  | 
|
53  | 
||
54  | 
lemma sparse_row_matrix_append: "sparse_row_matrix (arr@brr) = (sparse_row_matrix arr) + (sparse_row_matrix brr)"  | 
|
55  | 
apply (induct arr)  | 
|
56  | 
apply (auto simp add: sparse_row_matrix_cons)  | 
|
57  | 
done  | 
|
58  | 
||
59  | 
consts  | 
|
60  | 
sorted_spvec :: "'a spvec \<Rightarrow> bool"  | 
|
61  | 
sorted_spmat :: "'a spmat \<Rightarrow> bool"  | 
|
62  | 
||
63  | 
primrec  | 
|
64  | 
"sorted_spmat [] = True"  | 
|
65  | 
"sorted_spmat (a#as) = ((sorted_spvec (snd a)) & (sorted_spmat as))"  | 
|
66  | 
||
67  | 
primrec  | 
|
68  | 
"sorted_spvec [] = True"  | 
|
69  | 
sorted_spvec_step: "sorted_spvec (a#as) = (case as of [] \<Rightarrow> True | b#bs \<Rightarrow> ((fst a < fst b) & (sorted_spvec as)))"  | 
|
70  | 
||
71  | 
declare sorted_spvec.simps [simp del]  | 
|
72  | 
||
73  | 
lemma sorted_spvec_empty[simp]: "sorted_spvec [] = True"  | 
|
74  | 
by (simp add: sorted_spvec.simps)  | 
|
75  | 
||
76  | 
lemma sorted_spvec_cons1: "sorted_spvec (a#as) \<Longrightarrow> sorted_spvec as"  | 
|
77  | 
apply (induct as)  | 
|
78  | 
apply (auto simp add: sorted_spvec.simps)  | 
|
79  | 
done  | 
|
80  | 
||
81  | 
lemma sorted_spvec_cons2: "sorted_spvec (a#b#t) \<Longrightarrow> sorted_spvec (a#t)"  | 
|
82  | 
apply (induct t)  | 
|
83  | 
apply (auto simp add: sorted_spvec.simps)  | 
|
84  | 
done  | 
|
85  | 
||
86  | 
lemma sorted_spvec_cons3: "sorted_spvec(a#b#t) \<Longrightarrow> fst a < fst b"  | 
|
87  | 
apply (auto simp add: sorted_spvec.simps)  | 
|
88  | 
done  | 
|
89  | 
||
90  | 
lemma sorted_sparse_row_vector_zero[rule_format]: "m <= n \<longrightarrow> sorted_spvec ((n,a)#arr) \<longrightarrow> Rep_matrix (sparse_row_vector arr) j m = 0"  | 
|
91  | 
apply (induct arr)  | 
|
92  | 
apply (auto)  | 
|
93  | 
apply (frule sorted_spvec_cons2,simp)+  | 
|
94  | 
apply (frule sorted_spvec_cons3, simp)  | 
|
95  | 
done  | 
|
96  | 
||
97  | 
lemma sorted_sparse_row_matrix_zero[rule_format]: "m <= n \<longrightarrow> sorted_spvec ((n,a)#arr) \<longrightarrow> Rep_matrix (sparse_row_matrix arr) m j = 0"  | 
|
98  | 
apply (induct arr)  | 
|
99  | 
apply (auto)  | 
|
100  | 
apply (frule sorted_spvec_cons2, simp)  | 
|
101  | 
apply (frule sorted_spvec_cons3, simp)  | 
|
102  | 
apply (simp add: sparse_row_matrix_cons neg_def)  | 
|
103  | 
done  | 
|
104  | 
||
105  | 
consts  | 
|
106  | 
  smult_spvec :: "('a::lordered_ring) \<Rightarrow> 'a spvec \<Rightarrow> 'a spvec" 
 | 
|
107  | 
||
| 27484 | 108  | 
primrec minus_spvec ::  "('a::lordered_ring) spvec \<Rightarrow> 'a spvec" where
 | 
| 15178 | 109  | 
"minus_spvec [] = []"  | 
| 27484 | 110  | 
| "minus_spvec (a#as) = (fst a, -(snd a))#(minus_spvec as)"  | 
| 15178 | 111  | 
|
| 27484 | 112  | 
primrec abs_spvec ::  "('a::lordered_ring) spvec \<Rightarrow> 'a spvec" where
 | 
| 15178 | 113  | 
"abs_spvec [] = []"  | 
| 27484 | 114  | 
| "abs_spvec (a#as) = (fst a, abs (snd a))#(abs_spvec as)"  | 
| 15178 | 115  | 
|
116  | 
lemma sparse_row_vector_minus:  | 
|
117  | 
"sparse_row_vector (minus_spvec v) = - (sparse_row_vector v)"  | 
|
118  | 
apply (induct v)  | 
|
119  | 
apply (simp_all add: sparse_row_vector_cons)  | 
|
120  | 
apply (simp add: Rep_matrix_inject[symmetric])  | 
|
121  | 
apply (rule ext)+  | 
|
122  | 
apply simp  | 
|
123  | 
done  | 
|
124  | 
||
125  | 
lemma sparse_row_vector_abs:  | 
|
126  | 
"sorted_spvec v \<Longrightarrow> sparse_row_vector (abs_spvec v) = abs (sparse_row_vector v)"  | 
|
127  | 
apply (induct v)  | 
|
128  | 
apply (simp_all add: sparse_row_vector_cons)  | 
|
129  | 
apply (frule_tac sorted_spvec_cons1, simp)  | 
|
130  | 
apply (simp only: Rep_matrix_inject[symmetric])  | 
|
131  | 
apply (rule ext)+  | 
|
132  | 
apply auto  | 
|
| 
15236
 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 
nipkow 
parents: 
15197 
diff
changeset
 | 
133  | 
apply (subgoal_tac "Rep_matrix (sparse_row_vector v) 0 a = 0")  | 
| 15178 | 134  | 
apply (simp)  | 
135  | 
apply (rule sorted_sparse_row_vector_zero)  | 
|
136  | 
apply auto  | 
|
137  | 
done  | 
|
138  | 
||
139  | 
lemma sorted_spvec_minus_spvec:  | 
|
140  | 
"sorted_spvec v \<Longrightarrow> sorted_spvec (minus_spvec v)"  | 
|
141  | 
apply (induct v)  | 
|
142  | 
apply (simp)  | 
|
143  | 
apply (frule sorted_spvec_cons1, simp)  | 
|
| 
15236
 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 
nipkow 
parents: 
15197 
diff
changeset
 | 
144  | 
apply (simp add: sorted_spvec.simps split:list.split_asm)  | 
| 15178 | 145  | 
done  | 
146  | 
||
147  | 
lemma sorted_spvec_abs_spvec:  | 
|
148  | 
"sorted_spvec v \<Longrightarrow> sorted_spvec (abs_spvec v)"  | 
|
149  | 
apply (induct v)  | 
|
150  | 
apply (simp)  | 
|
151  | 
apply (frule sorted_spvec_cons1, simp)  | 
|
| 
15236
 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 
nipkow 
parents: 
15197 
diff
changeset
 | 
152  | 
apply (simp add: sorted_spvec.simps split:list.split_asm)  | 
| 15178 | 153  | 
done  | 
154  | 
||
| 15009 | 155  | 
defs  | 
156  | 
smult_spvec_def: "smult_spvec y arr == map (% a. (fst a, y * snd a)) arr"  | 
|
157  | 
||
158  | 
lemma smult_spvec_empty[simp]: "smult_spvec y [] = []"  | 
|
159  | 
by (simp add: smult_spvec_def)  | 
|
160  | 
||
161  | 
lemma smult_spvec_cons: "smult_spvec y (a#arr) = (fst a, y * (snd a)) # (smult_spvec y arr)"  | 
|
162  | 
by (simp add: smult_spvec_def)  | 
|
163  | 
||
| 27484 | 164  | 
consts addmult_spvec :: "('a::lordered_ring) * 'a spvec * 'a spvec \<Rightarrow> 'a spvec"
 | 
| 15009 | 165  | 
recdef addmult_spvec "measure (% (y, a, b). length a + (length b))"  | 
166  | 
"addmult_spvec (y, arr, []) = arr"  | 
|
167  | 
"addmult_spvec (y, [], brr) = smult_spvec y brr"  | 
|
168  | 
"addmult_spvec (y, a#arr, b#brr) = (  | 
|
169  | 
if (fst a) < (fst b) then (a#(addmult_spvec (y, arr, b#brr)))  | 
|
170  | 
else (if (fst b < fst a) then ((fst b, y * (snd b))#(addmult_spvec (y, a#arr, brr)))  | 
|
171  | 
else ((fst a, (snd a)+ y*(snd b))#(addmult_spvec (y, arr,brr)))))"  | 
|
172  | 
||
173  | 
lemma addmult_spvec_empty1[simp]: "addmult_spvec (y, [], a) = smult_spvec y a"  | 
|
| 27484 | 174  | 
by (induct a) auto  | 
| 15009 | 175  | 
|
176  | 
lemma addmult_spvec_empty2[simp]: "addmult_spvec (y, a, []) = a"  | 
|
| 27484 | 177  | 
by (induct a) auto  | 
| 15009 | 178  | 
|
179  | 
lemma sparse_row_vector_map: "(! x y. f (x+y) = (f x) + (f y)) \<Longrightarrow> (f::'a\<Rightarrow>('a::lordered_ring)) 0 = 0 \<Longrightarrow> 
 | 
|
180  | 
sparse_row_vector (map (% x. (fst x, f (snd x))) a) = apply_matrix f (sparse_row_vector a)"  | 
|
181  | 
apply (induct a)  | 
|
182  | 
apply (simp_all add: apply_matrix_add)  | 
|
183  | 
done  | 
|
184  | 
||
185  | 
lemma sparse_row_vector_smult: "sparse_row_vector (smult_spvec y a) = scalar_mult y (sparse_row_vector a)"  | 
|
186  | 
apply (induct a)  | 
|
187  | 
apply (simp_all add: smult_spvec_cons scalar_mult_add)  | 
|
188  | 
done  | 
|
189  | 
||
190  | 
lemma sparse_row_vector_addmult_spvec: "sparse_row_vector (addmult_spvec (y::'a::lordered_ring, a, b)) =  | 
|
191  | 
(sparse_row_vector a) + (scalar_mult y (sparse_row_vector b))"  | 
|
192  | 
apply (rule addmult_spvec.induct[of _ y])  | 
|
193  | 
apply (simp add: scalar_mult_add smult_spvec_cons sparse_row_vector_smult singleton_matrix_add)+  | 
|
194  | 
done  | 
|
195  | 
||
196  | 
lemma sorted_smult_spvec[rule_format]: "sorted_spvec a \<Longrightarrow> sorted_spvec (smult_spvec y a)"  | 
|
197  | 
apply (auto simp add: smult_spvec_def)  | 
|
198  | 
apply (induct a)  | 
|
| 
15236
 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 
nipkow 
parents: 
15197 
diff
changeset
 | 
199  | 
apply (auto simp add: sorted_spvec.simps split:list.split_asm)  | 
| 15009 | 200  | 
done  | 
201  | 
||
202  | 
lemma sorted_spvec_addmult_spvec_helper: "\<lbrakk>sorted_spvec (addmult_spvec (y, (a, b) # arr, brr)); aa < a; sorted_spvec ((a, b) # arr);  | 
|
203  | 
sorted_spvec ((aa, ba) # brr)\<rbrakk> \<Longrightarrow> sorted_spvec ((aa, y * ba) # addmult_spvec (y, (a, b) # arr, brr))"  | 
|
204  | 
apply (induct brr)  | 
|
205  | 
apply (auto simp add: sorted_spvec.simps)  | 
|
206  | 
apply (simp split: list.split)  | 
|
207  | 
apply (auto)  | 
|
208  | 
apply (simp split: list.split)  | 
|
209  | 
apply (auto)  | 
|
210  | 
done  | 
|
211  | 
||
212  | 
lemma sorted_spvec_addmult_spvec_helper2:  | 
|
213  | 
"\<lbrakk>sorted_spvec (addmult_spvec (y, arr, (aa, ba) # brr)); a < aa; sorted_spvec ((a, b) # arr); sorted_spvec ((aa, ba) # brr)\<rbrakk>  | 
|
214  | 
\<Longrightarrow> sorted_spvec ((a, b) # addmult_spvec (y, arr, (aa, ba) # brr))"  | 
|
215  | 
apply (induct arr)  | 
|
216  | 
apply (auto simp add: smult_spvec_def sorted_spvec.simps)  | 
|
217  | 
apply (simp split: list.split)  | 
|
218  | 
apply (auto)  | 
|
219  | 
done  | 
|
220  | 
||
221  | 
lemma sorted_spvec_addmult_spvec_helper3[rule_format]:  | 
|
222  | 
"sorted_spvec (addmult_spvec (y, arr, brr)) \<longrightarrow> sorted_spvec ((aa, b) # arr) \<longrightarrow> sorted_spvec ((aa, ba) # brr)  | 
|
223  | 
\<longrightarrow> sorted_spvec ((aa, b + y * ba) # (addmult_spvec (y, arr, brr)))"  | 
|
224  | 
apply (rule addmult_spvec.induct[of _ y arr brr])  | 
|
225  | 
apply (simp_all add: sorted_spvec.simps smult_spvec_def)  | 
|
226  | 
done  | 
|
227  | 
||
228  | 
lemma sorted_addmult_spvec[rule_format]: "sorted_spvec a \<longrightarrow> sorted_spvec b \<longrightarrow> sorted_spvec (addmult_spvec (y, a, b))"  | 
|
229  | 
apply (rule addmult_spvec.induct[of _ y a b])  | 
|
230  | 
apply (simp_all add: sorted_smult_spvec)  | 
|
231  | 
apply (rule conjI, intro strip)  | 
|
232  | 
apply (case_tac "~(a < aa)")  | 
|
233  | 
apply (simp_all)  | 
|
234  | 
apply (frule_tac as=brr in sorted_spvec_cons1)  | 
|
235  | 
apply (simp add: sorted_spvec_addmult_spvec_helper)  | 
|
236  | 
apply (intro strip | rule conjI)+  | 
|
237  | 
apply (frule_tac as=arr in sorted_spvec_cons1)  | 
|
238  | 
apply (simp add: sorted_spvec_addmult_spvec_helper2)  | 
|
239  | 
apply (intro strip)  | 
|
240  | 
apply (frule_tac as=arr in sorted_spvec_cons1)  | 
|
241  | 
apply (frule_tac as=brr in sorted_spvec_cons1)  | 
|
242  | 
apply (simp)  | 
|
243  | 
apply (simp_all add: sorted_spvec_addmult_spvec_helper3)  | 
|
244  | 
done  | 
|
245  | 
||
246  | 
consts  | 
|
247  | 
  mult_spvec_spmat :: "('a::lordered_ring) spvec * 'a spvec * 'a spmat  \<Rightarrow> 'a spvec"
 | 
|
248  | 
recdef mult_spvec_spmat "measure (% (c, arr, brr). (length arr) + (length brr))"  | 
|
249  | 
"mult_spvec_spmat (c, [], brr) = c"  | 
|
250  | 
"mult_spvec_spmat (c, arr, []) = c"  | 
|
251  | 
"mult_spvec_spmat (c, a#arr, b#brr) = (  | 
|
252  | 
if ((fst a) < (fst b)) then (mult_spvec_spmat (c, arr, b#brr))  | 
|
253  | 
else (if ((fst b) < (fst a)) then (mult_spvec_spmat (c, a#arr, brr))  | 
|
254  | 
else (mult_spvec_spmat (addmult_spvec (snd a, c, snd b), arr, brr))))"  | 
|
255  | 
||
256  | 
lemma sparse_row_mult_spvec_spmat[rule_format]: "sorted_spvec (a::('a::lordered_ring) spvec) \<longrightarrow> sorted_spvec B \<longrightarrow> 
 | 
|
257  | 
sparse_row_vector (mult_spvec_spmat (c, a, B)) = (sparse_row_vector c) + (sparse_row_vector a) * (sparse_row_matrix B)"  | 
|
258  | 
proof -  | 
|
259  | 
have comp_1: "!! a b. a < b \<Longrightarrow> Suc 0 <= nat ((int b)-(int a))" by arith  | 
|
260  | 
have not_iff: "!! a b. a = b \<Longrightarrow> (~ a) = (~ b)" by simp  | 
|
261  | 
have max_helper: "!! a b. ~ (a <= max (Suc a) b) \<Longrightarrow> False"  | 
|
262  | 
by arith  | 
|
263  | 
  {
 | 
|
264  | 
fix a  | 
|
265  | 
fix v  | 
|
266  | 
assume a:"a < nrows(sparse_row_vector v)"  | 
|
267  | 
have b:"nrows(sparse_row_vector v) <= 1" by simp  | 
|
268  | 
note dummy = less_le_trans[of a "nrows (sparse_row_vector v)" 1, OF a b]  | 
|
269  | 
then have "a = 0" by simp  | 
|
270  | 
}  | 
|
271  | 
note nrows_helper = this  | 
|
272  | 
show ?thesis  | 
|
273  | 
apply (rule mult_spvec_spmat.induct)  | 
|
274  | 
apply simp+  | 
|
275  | 
apply (rule conjI)  | 
|
276  | 
apply (intro strip)  | 
|
277  | 
apply (frule_tac as=brr in sorted_spvec_cons1)  | 
|
| 
23477
 
f4b83f03cac9
tuned and renamed group_eq_simps and ring_eq_simps
 
nipkow 
parents: 
22452 
diff
changeset
 | 
278  | 
apply (simp add: ring_simps sparse_row_matrix_cons)  | 
| 15481 | 279  | 
apply (simplesubst Rep_matrix_zero_imp_mult_zero)  | 
| 15009 | 280  | 
apply (simp)  | 
281  | 
apply (intro strip)  | 
|
282  | 
apply (rule disjI2)  | 
|
283  | 
apply (intro strip)  | 
|
284  | 
apply (subst nrows)  | 
|
285  | 
apply (rule order_trans[of _ 1])  | 
|
286  | 
apply (simp add: comp_1)+  | 
|
287  | 
apply (subst Rep_matrix_zero_imp_mult_zero)  | 
|
288  | 
apply (intro strip)  | 
|
289  | 
apply (case_tac "k <= aa")  | 
|
290  | 
apply (rule_tac m1 = k and n1 = a and a1 = b in ssubst[OF sorted_sparse_row_vector_zero])  | 
|
291  | 
apply (simp_all)  | 
|
292  | 
apply (rule impI)  | 
|
293  | 
apply (rule disjI2)  | 
|
294  | 
apply (rule nrows)  | 
|
295  | 
apply (rule order_trans[of _ 1])  | 
|
296  | 
apply (simp_all add: comp_1)  | 
|
297  | 
||
298  | 
apply (intro strip | rule conjI)+  | 
|
299  | 
apply (frule_tac as=arr in sorted_spvec_cons1)  | 
|
| 
23477
 
f4b83f03cac9
tuned and renamed group_eq_simps and ring_eq_simps
 
nipkow 
parents: 
22452 
diff
changeset
 | 
300  | 
apply (simp add: ring_simps)  | 
| 15009 | 301  | 
apply (subst Rep_matrix_zero_imp_mult_zero)  | 
302  | 
apply (simp)  | 
|
303  | 
apply (rule disjI2)  | 
|
304  | 
apply (intro strip)  | 
|
305  | 
apply (simp add: sparse_row_matrix_cons neg_def)  | 
|
306  | 
apply (case_tac "a <= aa")  | 
|
307  | 
apply (erule sorted_sparse_row_matrix_zero)  | 
|
308  | 
apply (simp_all)  | 
|
309  | 
apply (intro strip)  | 
|
310  | 
apply (case_tac "a=aa")  | 
|
311  | 
apply (simp_all)  | 
|
312  | 
apply (frule_tac as=arr in sorted_spvec_cons1)  | 
|
313  | 
apply (frule_tac as=brr in sorted_spvec_cons1)  | 
|
| 
23477
 
f4b83f03cac9
tuned and renamed group_eq_simps and ring_eq_simps
 
nipkow 
parents: 
22452 
diff
changeset
 | 
314  | 
apply (simp add: sparse_row_matrix_cons ring_simps sparse_row_vector_addmult_spvec)  | 
| 15009 | 315  | 
apply (rule_tac B1 = "sparse_row_matrix brr" in ssubst[OF Rep_matrix_zero_imp_mult_zero])  | 
316  | 
apply (auto)  | 
|
317  | 
apply (rule sorted_sparse_row_matrix_zero)  | 
|
318  | 
apply (simp_all)  | 
|
319  | 
apply (rule_tac A1 = "sparse_row_vector arr" in ssubst[OF Rep_matrix_zero_imp_mult_zero])  | 
|
320  | 
apply (auto)  | 
|
321  | 
apply (rule_tac m=k and n = aa and a = b and arr=arr in sorted_sparse_row_vector_zero)  | 
|
322  | 
apply (simp_all)  | 
|
323  | 
apply (simp add: neg_def)  | 
|
324  | 
apply (drule nrows_notzero)  | 
|
325  | 
apply (drule nrows_helper)  | 
|
326  | 
apply (arith)  | 
|
327  | 
||
328  | 
apply (subst Rep_matrix_inject[symmetric])  | 
|
329  | 
apply (rule ext)+  | 
|
330  | 
apply (simp)  | 
|
331  | 
apply (subst Rep_matrix_mult)  | 
|
332  | 
apply (rule_tac j1=aa in ssubst[OF foldseq_almostzero])  | 
|
333  | 
apply (simp_all)  | 
|
| 
20432
 
07ec57376051
lin_arith_prover: splitting reverted because of performance loss
 
webertj 
parents: 
20283 
diff
changeset
 | 
334  | 
apply (intro strip, rule conjI)  | 
| 15009 | 335  | 
apply (intro strip)  | 
| 
20432
 
07ec57376051
lin_arith_prover: splitting reverted because of performance loss
 
webertj 
parents: 
20283 
diff
changeset
 | 
336  | 
apply (drule_tac max_helper)  | 
| 
 
07ec57376051
lin_arith_prover: splitting reverted because of performance loss
 
webertj 
parents: 
20283 
diff
changeset
 | 
337  | 
apply (simp)  | 
| 
 
07ec57376051
lin_arith_prover: splitting reverted because of performance loss
 
webertj 
parents: 
20283 
diff
changeset
 | 
338  | 
apply (auto)  | 
| 15009 | 339  | 
apply (rule zero_imp_mult_zero)  | 
340  | 
apply (rule disjI2)  | 
|
341  | 
apply (rule nrows)  | 
|
342  | 
apply (rule order_trans[of _ 1])  | 
|
| 
20432
 
07ec57376051
lin_arith_prover: splitting reverted because of performance loss
 
webertj 
parents: 
20283 
diff
changeset
 | 
343  | 
apply (simp)  | 
| 
 
07ec57376051
lin_arith_prover: splitting reverted because of performance loss
 
webertj 
parents: 
20283 
diff
changeset
 | 
344  | 
apply (simp)  | 
| 15009 | 345  | 
done  | 
346  | 
qed  | 
|
347  | 
||
348  | 
lemma sorted_mult_spvec_spmat[rule_format]:  | 
|
349  | 
  "sorted_spvec (c::('a::lordered_ring) spvec) \<longrightarrow> sorted_spmat B \<longrightarrow> sorted_spvec (mult_spvec_spmat (c, a, B))"
 | 
|
350  | 
apply (rule mult_spvec_spmat.induct[of _ c a B])  | 
|
351  | 
apply (simp_all add: sorted_addmult_spvec)  | 
|
352  | 
done  | 
|
353  | 
||
354  | 
consts  | 
|
355  | 
  mult_spmat :: "('a::lordered_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat"
 | 
|
356  | 
||
357  | 
primrec  | 
|
358  | 
"mult_spmat [] A = []"  | 
|
359  | 
"mult_spmat (a#as) A = (fst a, mult_spvec_spmat ([], snd a, A))#(mult_spmat as A)"  | 
|
360  | 
||
361  | 
lemma sparse_row_mult_spmat[rule_format]:  | 
|
362  | 
"sorted_spmat A \<longrightarrow> sorted_spvec B \<longrightarrow> sparse_row_matrix (mult_spmat A B) = (sparse_row_matrix A) * (sparse_row_matrix B)"  | 
|
363  | 
apply (induct A)  | 
|
| 
23477
 
f4b83f03cac9
tuned and renamed group_eq_simps and ring_eq_simps
 
nipkow 
parents: 
22452 
diff
changeset
 | 
364  | 
apply (auto simp add: sparse_row_matrix_cons sparse_row_mult_spvec_spmat ring_simps move_matrix_mult)  | 
| 15009 | 365  | 
done  | 
366  | 
||
367  | 
lemma sorted_spvec_mult_spmat[rule_format]:  | 
|
368  | 
  "sorted_spvec (A::('a::lordered_ring) spmat) \<longrightarrow> sorted_spvec (mult_spmat A B)"
 | 
|
369  | 
apply (induct A)  | 
|
370  | 
apply (auto)  | 
|
371  | 
apply (drule sorted_spvec_cons1, simp)  | 
|
| 
15236
 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 
nipkow 
parents: 
15197 
diff
changeset
 | 
372  | 
apply (case_tac A)  | 
| 15009 | 373  | 
apply (auto simp add: sorted_spvec.simps)  | 
374  | 
done  | 
|
375  | 
||
376  | 
lemma sorted_spmat_mult_spmat[rule_format]:  | 
|
377  | 
  "sorted_spmat (B::('a::lordered_ring) spmat) \<longrightarrow> sorted_spmat (mult_spmat A B)"
 | 
|
378  | 
apply (induct A)  | 
|
379  | 
apply (auto simp add: sorted_mult_spvec_spmat)  | 
|
380  | 
done  | 
|
381  | 
||
382  | 
consts  | 
|
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
383  | 
  add_spvec :: "('a::lordered_ab_group_add) spvec * 'a spvec \<Rightarrow> 'a spvec"
 | 
| 
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
384  | 
  add_spmat :: "('a::lordered_ab_group_add) spmat * 'a spmat \<Rightarrow> 'a spmat"
 | 
| 15009 | 385  | 
|
386  | 
recdef add_spvec "measure (% (a, b). length a + (length b))"  | 
|
387  | 
"add_spvec (arr, []) = arr"  | 
|
388  | 
"add_spvec ([], brr) = brr"  | 
|
389  | 
"add_spvec (a#arr, b#brr) = (  | 
|
390  | 
if (fst a) < (fst b) then (a#(add_spvec (arr, b#brr)))  | 
|
391  | 
else (if (fst b < fst a) then (b#(add_spvec (a#arr, brr)))  | 
|
392  | 
else ((fst a, (snd a)+(snd b))#(add_spvec (arr,brr)))))"  | 
|
393  | 
||
394  | 
lemma add_spvec_empty1[simp]: "add_spvec ([], a) = a"  | 
|
395  | 
by (induct a, auto)  | 
|
396  | 
||
397  | 
lemma add_spvec_empty2[simp]: "add_spvec (a, []) = a"  | 
|
398  | 
by (induct a, auto)  | 
|
399  | 
||
400  | 
lemma sparse_row_vector_add: "sparse_row_vector (add_spvec (a,b)) = (sparse_row_vector a) + (sparse_row_vector b)"  | 
|
401  | 
apply (rule add_spvec.induct[of _ a b])  | 
|
402  | 
apply (simp_all add: singleton_matrix_add)  | 
|
403  | 
done  | 
|
404  | 
||
405  | 
recdef add_spmat "measure (% (A,B). (length A)+(length B))"  | 
|
406  | 
"add_spmat ([], bs) = bs"  | 
|
407  | 
"add_spmat (as, []) = as"  | 
|
408  | 
"add_spmat (a#as, b#bs) = (  | 
|
409  | 
if fst a < fst b then  | 
|
410  | 
(a#(add_spmat (as, b#bs)))  | 
|
411  | 
else (if fst b < fst a then  | 
|
412  | 
(b#(add_spmat (a#as, bs)))  | 
|
413  | 
else  | 
|
414  | 
((fst a, add_spvec (snd a, snd b))#(add_spmat (as, bs)))))"  | 
|
415  | 
||
416  | 
lemma sparse_row_add_spmat: "sparse_row_matrix (add_spmat (A, B)) = (sparse_row_matrix A) + (sparse_row_matrix B)"  | 
|
417  | 
apply (rule add_spmat.induct)  | 
|
418  | 
apply (auto simp add: sparse_row_matrix_cons sparse_row_vector_add move_matrix_add)  | 
|
419  | 
done  | 
|
420  | 
||
| 27484 | 421  | 
lemmas [code func] = sparse_row_add_spmat [symmetric]  | 
422  | 
lemmas [code func] = sparse_row_vector_add [symmetric]  | 
|
423  | 
||
| 15009 | 424  | 
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)))"  | 
425  | 
proof -  | 
|
426  | 
have "(! x ab a. x = (a,b)#arr \<longrightarrow> add_spvec (x, brr) = (ab, bb) # list \<longrightarrow> (ab = a | (ab = fst (hd brr))))"  | 
|
427  | 
by (rule add_spvec.induct[of _ _ brr], auto)  | 
|
428  | 
then show ?thesis  | 
|
429  | 
by (case_tac brr, auto)  | 
|
430  | 
qed  | 
|
431  | 
||
432  | 
lemma sorted_add_spmat_helper1[rule_format]: "add_spmat ((a,b)#arr, brr) = (ab, bb) # list \<longrightarrow> (ab = a | (brr \<noteq> [] & ab = fst (hd brr)))"  | 
|
433  | 
proof -  | 
|
434  | 
have "(! x ab a. x = (a,b)#arr \<longrightarrow> add_spmat (x, brr) = (ab, bb) # list \<longrightarrow> (ab = a | (ab = fst (hd brr))))"  | 
|
435  | 
by (rule add_spmat.induct[of _ _ brr], auto)  | 
|
436  | 
then show ?thesis  | 
|
437  | 
by (case_tac brr, auto)  | 
|
438  | 
qed  | 
|
439  | 
||
440  | 
lemma sorted_add_spvec_helper[rule_format]: "add_spvec (arr, brr) = (ab, bb) # list \<longrightarrow> ((arr \<noteq> [] & ab = fst (hd arr)) | (brr \<noteq> [] & ab = fst (hd brr)))"  | 
|
441  | 
apply (rule add_spvec.induct[of _ arr brr])  | 
|
442  | 
apply (auto)  | 
|
443  | 
done  | 
|
444  | 
||
445  | 
lemma sorted_add_spmat_helper[rule_format]: "add_spmat (arr, brr) = (ab, bb) # list \<longrightarrow> ((arr \<noteq> [] & ab = fst (hd arr)) | (brr \<noteq> [] & ab = fst (hd brr)))"  | 
|
446  | 
apply (rule add_spmat.induct[of _ arr brr])  | 
|
447  | 
apply (auto)  | 
|
448  | 
done  | 
|
449  | 
||
450  | 
lemma add_spvec_commute: "add_spvec (a, b) = add_spvec (b, a)"  | 
|
451  | 
by (rule add_spvec.induct[of _ a b], auto)  | 
|
452  | 
||
453  | 
lemma add_spmat_commute: "add_spmat (a, b) = add_spmat (b, a)"  | 
|
454  | 
apply (rule add_spmat.induct[of _ a b])  | 
|
455  | 
apply (simp_all add: add_spvec_commute)  | 
|
456  | 
done  | 
|
457  | 
||
458  | 
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"  | 
|
459  | 
apply (drule sorted_add_spvec_helper1)  | 
|
460  | 
apply (auto)  | 
|
461  | 
apply (case_tac brr)  | 
|
462  | 
apply (simp_all)  | 
|
463  | 
apply (drule_tac sorted_spvec_cons3)  | 
|
464  | 
apply (simp)  | 
|
465  | 
done  | 
|
466  | 
||
467  | 
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"  | 
|
468  | 
apply (drule sorted_add_spmat_helper1)  | 
|
469  | 
apply (auto)  | 
|
470  | 
apply (case_tac brr)  | 
|
471  | 
apply (simp_all)  | 
|
472  | 
apply (drule_tac sorted_spvec_cons3)  | 
|
473  | 
apply (simp)  | 
|
474  | 
done  | 
|
475  | 
||
476  | 
lemma sorted_spvec_add_spvec[rule_format]: "sorted_spvec a \<longrightarrow> sorted_spvec b \<longrightarrow> sorted_spvec (add_spvec (a, b))"  | 
|
477  | 
apply (rule add_spvec.induct[of _ a b])  | 
|
478  | 
apply (simp_all)  | 
|
479  | 
apply (rule conjI)  | 
|
480  | 
apply (intro strip)  | 
|
481  | 
apply (simp)  | 
|
482  | 
apply (frule_tac as=brr in sorted_spvec_cons1)  | 
|
483  | 
apply (simp)  | 
|
484  | 
apply (subst sorted_spvec_step)  | 
|
485  | 
apply (simp split: list.split)  | 
|
486  | 
apply (clarify, simp)  | 
|
487  | 
apply (simp add: sorted_add_spvec_helper2)  | 
|
488  | 
apply (clarify)  | 
|
489  | 
apply (rule conjI)  | 
|
490  | 
apply (case_tac "a=aa")  | 
|
491  | 
apply (simp)  | 
|
492  | 
apply (clarify)  | 
|
493  | 
apply (frule_tac as=arr in sorted_spvec_cons1, simp)  | 
|
494  | 
apply (subst sorted_spvec_step)  | 
|
495  | 
apply (simp split: list.split)  | 
|
496  | 
apply (clarify, simp)  | 
|
497  | 
apply (simp add: sorted_add_spvec_helper2 add_spvec_commute)  | 
|
498  | 
apply (case_tac "a=aa")  | 
|
499  | 
apply (simp_all)  | 
|
500  | 
apply (clarify)  | 
|
501  | 
apply (frule_tac as=arr in sorted_spvec_cons1)  | 
|
502  | 
apply (frule_tac as=brr in sorted_spvec_cons1)  | 
|
503  | 
apply (simp)  | 
|
504  | 
apply (subst sorted_spvec_step)  | 
|
505  | 
apply (simp split: list.split)  | 
|
506  | 
apply (clarify, simp)  | 
|
507  | 
apply (drule_tac sorted_add_spvec_helper)  | 
|
508  | 
apply (auto)  | 
|
509  | 
apply (case_tac arr)  | 
|
510  | 
apply (simp_all)  | 
|
511  | 
apply (drule sorted_spvec_cons3)  | 
|
512  | 
apply (simp)  | 
|
513  | 
apply (case_tac brr)  | 
|
514  | 
apply (simp_all)  | 
|
515  | 
apply (drule sorted_spvec_cons3)  | 
|
516  | 
apply (simp)  | 
|
517  | 
done  | 
|
518  | 
||
519  | 
lemma sorted_spvec_add_spmat[rule_format]: "sorted_spvec A \<longrightarrow> sorted_spvec B \<longrightarrow> sorted_spvec (add_spmat (A, B))"  | 
|
520  | 
apply (rule add_spmat.induct[of _ A B])  | 
|
521  | 
apply (simp_all)  | 
|
522  | 
apply (rule conjI)  | 
|
523  | 
apply (intro strip)  | 
|
524  | 
apply (simp)  | 
|
525  | 
apply (frule_tac as=bs in sorted_spvec_cons1)  | 
|
526  | 
apply (simp)  | 
|
527  | 
apply (subst sorted_spvec_step)  | 
|
528  | 
apply (simp split: list.split)  | 
|
529  | 
apply (clarify, simp)  | 
|
530  | 
apply (simp add: sorted_add_spmat_helper2)  | 
|
531  | 
apply (clarify)  | 
|
532  | 
apply (rule conjI)  | 
|
533  | 
apply (case_tac "a=aa")  | 
|
534  | 
apply (simp)  | 
|
535  | 
apply (clarify)  | 
|
536  | 
apply (frule_tac as=as in sorted_spvec_cons1, simp)  | 
|
537  | 
apply (subst sorted_spvec_step)  | 
|
538  | 
apply (simp split: list.split)  | 
|
539  | 
apply (clarify, simp)  | 
|
540  | 
apply (simp add: sorted_add_spmat_helper2 add_spmat_commute)  | 
|
541  | 
apply (case_tac "a=aa")  | 
|
542  | 
apply (simp_all)  | 
|
543  | 
apply (clarify)  | 
|
544  | 
apply (frule_tac as=as in sorted_spvec_cons1)  | 
|
545  | 
apply (frule_tac as=bs in sorted_spvec_cons1)  | 
|
546  | 
apply (simp)  | 
|
547  | 
apply (subst sorted_spvec_step)  | 
|
548  | 
apply (simp split: list.split)  | 
|
549  | 
apply (clarify, simp)  | 
|
550  | 
apply (drule_tac sorted_add_spmat_helper)  | 
|
551  | 
apply (auto)  | 
|
552  | 
apply (case_tac as)  | 
|
553  | 
apply (simp_all)  | 
|
554  | 
apply (drule sorted_spvec_cons3)  | 
|
555  | 
apply (simp)  | 
|
556  | 
apply (case_tac bs)  | 
|
557  | 
apply (simp_all)  | 
|
558  | 
apply (drule sorted_spvec_cons3)  | 
|
559  | 
apply (simp)  | 
|
560  | 
done  | 
|
561  | 
||
562  | 
lemma sorted_spmat_add_spmat[rule_format]: "sorted_spmat A \<longrightarrow> sorted_spmat B \<longrightarrow> sorted_spmat (add_spmat (A, B))"  | 
|
563  | 
apply (rule add_spmat.induct[of _ A B])  | 
|
564  | 
apply (simp_all add: sorted_spvec_add_spvec)  | 
|
565  | 
done  | 
|
566  | 
||
567  | 
consts  | 
|
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
568  | 
  le_spvec :: "('a::lordered_ab_group_add) spvec * 'a spvec \<Rightarrow> bool" 
 | 
| 
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
569  | 
  le_spmat :: "('a::lordered_ab_group_add) spmat * 'a spmat \<Rightarrow> bool" 
 | 
| 15009 | 570  | 
|
571  | 
recdef le_spvec "measure (% (a,b). (length a) + (length b))"  | 
|
572  | 
"le_spvec ([], []) = True"  | 
|
573  | 
"le_spvec (a#as, []) = ((snd a <= 0) & (le_spvec (as, [])))"  | 
|
574  | 
"le_spvec ([], b#bs) = ((0 <= snd b) & (le_spvec ([], bs)))"  | 
|
575  | 
"le_spvec (a#as, b#bs) = (  | 
|
576  | 
if (fst a < fst b) then  | 
|
577  | 
((snd a <= 0) & (le_spvec (as, b#bs)))  | 
|
578  | 
else (if (fst b < fst a) then  | 
|
579  | 
((0 <= snd b) & (le_spvec (a#as, bs)))  | 
|
580  | 
else  | 
|
581  | 
((snd a <= snd b) & (le_spvec (as, bs)))))"  | 
|
582  | 
||
583  | 
recdef le_spmat "measure (% (a,b). (length a) + (length b))"  | 
|
584  | 
"le_spmat ([], []) = True"  | 
|
585  | 
"le_spmat (a#as, []) = (le_spvec (snd a, []) & (le_spmat (as, [])))"  | 
|
586  | 
"le_spmat ([], b#bs) = (le_spvec ([], snd b) & (le_spmat ([], bs)))"  | 
|
587  | 
"le_spmat (a#as, b#bs) = (  | 
|
588  | 
if fst a < fst b then  | 
|
589  | 
(le_spvec(snd a,[]) & le_spmat(as, b#bs))  | 
|
590  | 
else (if (fst b < fst a) then  | 
|
591  | 
(le_spvec([], snd b) & le_spmat(a#as, bs))  | 
|
592  | 
else  | 
|
593  | 
(le_spvec(snd a, snd b) & le_spmat (as, bs))))"  | 
|
594  | 
||
595  | 
constdefs  | 
|
596  | 
  disj_matrices :: "('a::zero) matrix \<Rightarrow> 'a matrix \<Rightarrow> bool"
 | 
|
597  | 
"disj_matrices A B == (! j i. (Rep_matrix A j i \<noteq> 0) \<longrightarrow> (Rep_matrix B j i = 0)) & (! j i. (Rep_matrix B j i \<noteq> 0) \<longrightarrow> (Rep_matrix A j i = 0))"  | 
|
598  | 
||
| 
24124
 
4399175e3014
turned simp_depth_limit into configuration option;
 
wenzelm 
parents: 
23477 
diff
changeset
 | 
599  | 
declare [[simp_depth_limit = 6]]  | 
| 15009 | 600  | 
|
| 15580 | 601  | 
lemma disj_matrices_contr1: "disj_matrices A B \<Longrightarrow> Rep_matrix A j i \<noteq> 0 \<Longrightarrow> Rep_matrix B j i = 0"  | 
602  | 
by (simp add: disj_matrices_def)  | 
|
603  | 
||
604  | 
lemma disj_matrices_contr2: "disj_matrices A B \<Longrightarrow> Rep_matrix B j i \<noteq> 0 \<Longrightarrow> Rep_matrix A j i = 0"  | 
|
605  | 
by (simp add: disj_matrices_def)  | 
|
606  | 
||
607  | 
||
| 15009 | 608  | 
lemma disj_matrices_add: "disj_matrices A B \<Longrightarrow> disj_matrices C D \<Longrightarrow> disj_matrices A D \<Longrightarrow> disj_matrices B C \<Longrightarrow>  | 
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
609  | 
  (A + B <= C + D) = (A <= C & B <= (D::('a::lordered_ab_group_add) matrix))"
 | 
| 15009 | 610  | 
apply (auto)  | 
611  | 
apply (simp (no_asm_use) only: le_matrix_def disj_matrices_def)  | 
|
612  | 
apply (intro strip)  | 
|
613  | 
apply (erule conjE)+  | 
|
614  | 
apply (drule_tac j=j and i=i in spec2)+  | 
|
615  | 
apply (case_tac "Rep_matrix B j i = 0")  | 
|
616  | 
apply (case_tac "Rep_matrix D j i = 0")  | 
|
617  | 
apply (simp_all)  | 
|
618  | 
apply (simp (no_asm_use) only: le_matrix_def disj_matrices_def)  | 
|
619  | 
apply (intro strip)  | 
|
620  | 
apply (erule conjE)+  | 
|
621  | 
apply (drule_tac j=j and i=i in spec2)+  | 
|
622  | 
apply (case_tac "Rep_matrix A j i = 0")  | 
|
623  | 
apply (case_tac "Rep_matrix C j i = 0")  | 
|
624  | 
apply (simp_all)  | 
|
625  | 
apply (erule add_mono)  | 
|
626  | 
apply (assumption)  | 
|
627  | 
done  | 
|
628  | 
||
629  | 
lemma disj_matrices_zero1[simp]: "disj_matrices 0 B"  | 
|
630  | 
by (simp add: disj_matrices_def)  | 
|
631  | 
||
632  | 
lemma disj_matrices_zero2[simp]: "disj_matrices A 0"  | 
|
633  | 
by (simp add: disj_matrices_def)  | 
|
634  | 
||
635  | 
lemma disj_matrices_commute: "disj_matrices A B = disj_matrices B A"  | 
|
636  | 
by (auto simp add: disj_matrices_def)  | 
|
637  | 
||
638  | 
lemma disj_matrices_add_le_zero: "disj_matrices A B \<Longrightarrow>  | 
|
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
639  | 
  (A + B <= 0) = (A <= 0 & (B::('a::lordered_ab_group_add) matrix) <= 0)"
 | 
| 15009 | 640  | 
by (rule disj_matrices_add[of A B 0 0, simplified])  | 
641  | 
||
642  | 
lemma disj_matrices_add_zero_le: "disj_matrices A B \<Longrightarrow>  | 
|
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
643  | 
  (0 <= A + B) = (0 <= A & 0 <= (B::('a::lordered_ab_group_add) matrix))"
 | 
| 15009 | 644  | 
by (rule disj_matrices_add[of 0 0 A B, simplified])  | 
645  | 
||
646  | 
lemma disj_matrices_add_x_le: "disj_matrices A B \<Longrightarrow> disj_matrices B C \<Longrightarrow>  | 
|
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
647  | 
  (A <= B + C) = (A <= C & 0 <= (B::('a::lordered_ab_group_add) matrix))"
 | 
| 15009 | 648  | 
by (auto simp add: disj_matrices_add[of 0 A B C, simplified])  | 
649  | 
||
650  | 
lemma disj_matrices_add_le_x: "disj_matrices A B \<Longrightarrow> disj_matrices B C \<Longrightarrow>  | 
|
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
651  | 
  (B + A <= C) = (A <= C &  (B::('a::lordered_ab_group_add) matrix) <= 0)"
 | 
| 15009 | 652  | 
by (auto simp add: disj_matrices_add[of B A 0 C,simplified] disj_matrices_commute)  | 
653  | 
||
654  | 
lemma disj_sparse_row_singleton: "i <= j \<Longrightarrow> sorted_spvec((j,y)#v) \<Longrightarrow> disj_matrices (sparse_row_vector v) (singleton_matrix 0 i x)"  | 
|
655  | 
apply (simp add: disj_matrices_def)  | 
|
656  | 
apply (rule conjI)  | 
|
657  | 
apply (rule neg_imp)  | 
|
658  | 
apply (simp)  | 
|
659  | 
apply (intro strip)  | 
|
660  | 
apply (rule sorted_sparse_row_vector_zero)  | 
|
661  | 
apply (simp_all)  | 
|
662  | 
apply (intro strip)  | 
|
663  | 
apply (rule sorted_sparse_row_vector_zero)  | 
|
664  | 
apply (simp_all)  | 
|
665  | 
done  | 
|
666  | 
||
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
667  | 
lemma disj_matrices_x_add: "disj_matrices A B \<Longrightarrow> disj_matrices A C \<Longrightarrow> disj_matrices (A::('a::lordered_ab_group_add) matrix) (B+C)"
 | 
| 15009 | 668  | 
apply (simp add: disj_matrices_def)  | 
669  | 
apply (auto)  | 
|
670  | 
apply (drule_tac j=j and i=i in spec2)+  | 
|
671  | 
apply (case_tac "Rep_matrix B j i = 0")  | 
|
672  | 
apply (case_tac "Rep_matrix C j i = 0")  | 
|
673  | 
apply (simp_all)  | 
|
674  | 
done  | 
|
675  | 
||
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
676  | 
lemma disj_matrices_add_x: "disj_matrices A B \<Longrightarrow> disj_matrices A C \<Longrightarrow> disj_matrices (B+C) (A::('a::lordered_ab_group_add) matrix)" 
 | 
| 15009 | 677  | 
by (simp add: disj_matrices_x_add disj_matrices_commute)  | 
678  | 
||
679  | 
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)"  | 
|
680  | 
by (auto simp add: disj_matrices_def)  | 
|
681  | 
||
682  | 
lemma disj_move_sparse_vec_mat[simplified disj_matrices_commute]:  | 
|
683  | 
"j <= a \<Longrightarrow> sorted_spvec((a,c)#as) \<Longrightarrow> disj_matrices (move_matrix (sparse_row_vector b) (int j) i) (sparse_row_matrix as)"  | 
|
684  | 
apply (auto simp add: neg_def disj_matrices_def)  | 
|
685  | 
apply (drule nrows_notzero)  | 
|
686  | 
apply (drule less_le_trans[OF _ nrows_spvec])  | 
|
687  | 
apply (subgoal_tac "ja = j")  | 
|
688  | 
apply (simp add: sorted_sparse_row_matrix_zero)  | 
|
689  | 
apply (arith)  | 
|
690  | 
apply (rule nrows)  | 
|
691  | 
apply (rule order_trans[of _ 1 _])  | 
|
692  | 
apply (simp)  | 
|
693  | 
apply (case_tac "nat (int ja - int j) = 0")  | 
|
694  | 
apply (case_tac "ja = j")  | 
|
695  | 
apply (simp add: sorted_sparse_row_matrix_zero)  | 
|
696  | 
apply arith+  | 
|
697  | 
done  | 
|
698  | 
||
699  | 
lemma disj_move_sparse_row_vector_twice:  | 
|
700  | 
"j \<noteq> u \<Longrightarrow> disj_matrices (move_matrix (sparse_row_vector a) j i) (move_matrix (sparse_row_vector b) u v)"  | 
|
701  | 
apply (auto simp add: neg_def disj_matrices_def)  | 
|
702  | 
apply (rule nrows, rule order_trans[of _ 1], simp, drule nrows_notzero, drule less_le_trans[OF _ nrows_spvec], arith)+  | 
|
703  | 
done  | 
|
704  | 
||
| 15178 | 705  | 
lemma le_spvec_iff_sparse_row_le[rule_format]: "(sorted_spvec a) \<longrightarrow> (sorted_spvec b) \<longrightarrow> (le_spvec (a,b)) = (sparse_row_vector a <= sparse_row_vector b)"  | 
706  | 
apply (rule le_spvec.induct)  | 
|
707  | 
apply (simp_all add: sorted_spvec_cons1 disj_matrices_add_le_zero disj_matrices_add_zero_le  | 
|
708  | 
disj_sparse_row_singleton[OF order_refl] disj_matrices_commute)  | 
|
709  | 
apply (rule conjI, intro strip)  | 
|
710  | 
apply (simp add: sorted_spvec_cons1)  | 
|
711  | 
apply (subst disj_matrices_add_x_le)  | 
|
712  | 
apply (simp add: disj_sparse_row_singleton[OF less_imp_le] disj_matrices_x_add disj_matrices_commute)  | 
|
713  | 
apply (simp add: disj_sparse_row_singleton[OF order_refl] disj_matrices_commute)  | 
|
714  | 
apply (simp, blast)  | 
|
715  | 
apply (intro strip, rule conjI, intro strip)  | 
|
716  | 
apply (simp add: sorted_spvec_cons1)  | 
|
717  | 
apply (subst disj_matrices_add_le_x)  | 
|
718  | 
apply (simp_all add: disj_sparse_row_singleton[OF order_refl] disj_sparse_row_singleton[OF less_imp_le] disj_matrices_commute disj_matrices_x_add)  | 
|
719  | 
apply (blast)  | 
|
720  | 
apply (intro strip)  | 
|
721  | 
apply (simp add: sorted_spvec_cons1)  | 
|
722  | 
apply (case_tac "a=aa", simp_all)  | 
|
723  | 
apply (subst disj_matrices_add)  | 
|
724  | 
apply (simp_all add: disj_sparse_row_singleton[OF order_refl] disj_matrices_commute)  | 
|
| 15009 | 725  | 
done  | 
726  | 
||
727  | 
lemma le_spvec_empty2_sparse_row[rule_format]: "(sorted_spvec b) \<longrightarrow> (le_spvec (b,[]) = (sparse_row_vector b <= 0))"  | 
|
728  | 
apply (induct b)  | 
|
729  | 
apply (simp_all add: sorted_spvec_cons1)  | 
|
730  | 
apply (intro strip)  | 
|
731  | 
apply (subst disj_matrices_add_le_zero)  | 
|
732  | 
apply (simp add: disj_matrices_commute disj_sparse_row_singleton sorted_spvec_cons1)  | 
|
733  | 
apply (rule_tac y = "snd a" in disj_sparse_row_singleton[OF order_refl])  | 
|
734  | 
apply (simp_all)  | 
|
735  | 
done  | 
|
736  | 
||
737  | 
lemma le_spvec_empty1_sparse_row[rule_format]: "(sorted_spvec b) \<longrightarrow> (le_spvec ([],b) = (0 <= sparse_row_vector b))"  | 
|
738  | 
apply (induct b)  | 
|
739  | 
apply (simp_all add: sorted_spvec_cons1)  | 
|
740  | 
apply (intro strip)  | 
|
741  | 
apply (subst disj_matrices_add_zero_le)  | 
|
742  | 
apply (simp add: disj_matrices_commute disj_sparse_row_singleton sorted_spvec_cons1)  | 
|
743  | 
apply (rule_tac y = "snd a" in disj_sparse_row_singleton[OF order_refl])  | 
|
744  | 
apply (simp_all)  | 
|
745  | 
done  | 
|
746  | 
||
747  | 
lemma le_spmat_iff_sparse_row_le[rule_format]: "(sorted_spvec A) \<longrightarrow> (sorted_spmat A) \<longrightarrow> (sorted_spvec B) \<longrightarrow> (sorted_spmat B) \<longrightarrow>  | 
|
748  | 
le_spmat(A, B) = (sparse_row_matrix A <= sparse_row_matrix B)"  | 
|
749  | 
apply (rule le_spmat.induct)  | 
|
750  | 
apply (simp add: sparse_row_matrix_cons disj_matrices_add_le_zero disj_matrices_add_zero_le disj_move_sparse_vec_mat[OF order_refl]  | 
|
751  | 
disj_matrices_commute sorted_spvec_cons1 le_spvec_empty2_sparse_row le_spvec_empty1_sparse_row)+  | 
|
752  | 
apply (rule conjI, intro strip)  | 
|
753  | 
apply (simp add: sorted_spvec_cons1)  | 
|
754  | 
apply (subst disj_matrices_add_x_le)  | 
|
755  | 
apply (rule disj_matrices_add_x)  | 
|
756  | 
apply (simp add: disj_move_sparse_row_vector_twice)  | 
|
757  | 
apply (simp add: disj_move_sparse_vec_mat[OF less_imp_le] disj_matrices_commute)  | 
|
758  | 
apply (simp add: disj_move_sparse_vec_mat[OF order_refl] disj_matrices_commute)  | 
|
759  | 
apply (simp, blast)  | 
|
760  | 
apply (intro strip, rule conjI, intro strip)  | 
|
761  | 
apply (simp add: sorted_spvec_cons1)  | 
|
762  | 
apply (subst disj_matrices_add_le_x)  | 
|
763  | 
apply (simp add: disj_move_sparse_vec_mat[OF order_refl])  | 
|
764  | 
apply (rule disj_matrices_x_add)  | 
|
765  | 
apply (simp add: disj_move_sparse_row_vector_twice)  | 
|
766  | 
apply (simp add: disj_move_sparse_vec_mat[OF less_imp_le] disj_matrices_commute)  | 
|
767  | 
apply (simp, blast)  | 
|
768  | 
apply (intro strip)  | 
|
769  | 
apply (case_tac "a=aa")  | 
|
770  | 
apply (simp_all)  | 
|
771  | 
apply (subst disj_matrices_add)  | 
|
772  | 
apply (simp_all add: disj_matrices_commute disj_move_sparse_vec_mat[OF order_refl])  | 
|
773  | 
apply (simp add: sorted_spvec_cons1 le_spvec_iff_sparse_row_le)  | 
|
774  | 
done  | 
|
775  | 
||
| 
24124
 
4399175e3014
turned simp_depth_limit into configuration option;
 
wenzelm 
parents: 
23477 
diff
changeset
 | 
776  | 
declare [[simp_depth_limit = 999]]  | 
| 15178 | 777  | 
|
778  | 
consts  | 
|
779  | 
   abs_spmat :: "('a::lordered_ring) spmat \<Rightarrow> 'a spmat"
 | 
|
780  | 
   minus_spmat :: "('a::lordered_ring) spmat \<Rightarrow> 'a spmat"
 | 
|
781  | 
||
782  | 
primrec  | 
|
783  | 
"abs_spmat [] = []"  | 
|
784  | 
"abs_spmat (a#as) = (fst a, abs_spvec (snd a))#(abs_spmat as)"  | 
|
785  | 
||
786  | 
primrec  | 
|
787  | 
"minus_spmat [] = []"  | 
|
788  | 
"minus_spmat (a#as) = (fst a, minus_spvec (snd a))#(minus_spmat as)"  | 
|
789  | 
||
790  | 
lemma sparse_row_matrix_minus:  | 
|
791  | 
"sparse_row_matrix (minus_spmat A) = - (sparse_row_matrix A)"  | 
|
792  | 
apply (induct A)  | 
|
793  | 
apply (simp_all add: sparse_row_vector_minus sparse_row_matrix_cons)  | 
|
794  | 
apply (subst Rep_matrix_inject[symmetric])  | 
|
795  | 
apply (rule ext)+  | 
|
796  | 
apply simp  | 
|
797  | 
done  | 
|
| 15009 | 798  | 
|
| 15178 | 799  | 
lemma Rep_sparse_row_vector_zero: "x \<noteq> 0 \<Longrightarrow> Rep_matrix (sparse_row_vector v) x y = 0"  | 
800  | 
proof -  | 
|
801  | 
assume x:"x \<noteq> 0"  | 
|
802  | 
have r:"nrows (sparse_row_vector v) <= Suc 0" by (rule nrows_spvec)  | 
|
803  | 
show ?thesis  | 
|
804  | 
apply (rule nrows)  | 
|
805  | 
apply (subgoal_tac "Suc 0 <= x")  | 
|
806  | 
apply (insert r)  | 
|
807  | 
apply (simp only:)  | 
|
808  | 
apply (insert x)  | 
|
809  | 
apply arith  | 
|
810  | 
done  | 
|
811  | 
qed  | 
|
812  | 
||
813  | 
lemma sparse_row_matrix_abs:  | 
|
814  | 
"sorted_spvec A \<Longrightarrow> sorted_spmat A \<Longrightarrow> sparse_row_matrix (abs_spmat A) = abs (sparse_row_matrix A)"  | 
|
815  | 
apply (induct A)  | 
|
816  | 
apply (simp_all add: sparse_row_vector_abs sparse_row_matrix_cons)  | 
|
817  | 
apply (frule_tac sorted_spvec_cons1, simp)  | 
|
| 15580 | 818  | 
apply (simplesubst Rep_matrix_inject[symmetric])  | 
| 15178 | 819  | 
apply (rule ext)+  | 
820  | 
apply auto  | 
|
821  | 
apply (case_tac "x=a")  | 
|
822  | 
apply (simp)  | 
|
| 15481 | 823  | 
apply (simplesubst sorted_sparse_row_matrix_zero)  | 
| 15178 | 824  | 
apply auto  | 
| 15481 | 825  | 
apply (simplesubst Rep_sparse_row_vector_zero)  | 
| 15178 | 826  | 
apply (simp_all add: neg_def)  | 
827  | 
done  | 
|
828  | 
||
829  | 
lemma sorted_spvec_minus_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec (minus_spmat A)"  | 
|
830  | 
apply (induct A)  | 
|
831  | 
apply (simp)  | 
|
832  | 
apply (frule sorted_spvec_cons1, simp)  | 
|
| 
15236
 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 
nipkow 
parents: 
15197 
diff
changeset
 | 
833  | 
apply (simp add: sorted_spvec.simps split:list.split_asm)  | 
| 15178 | 834  | 
done  | 
835  | 
||
836  | 
lemma sorted_spvec_abs_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec (abs_spmat A)"  | 
|
837  | 
apply (induct A)  | 
|
838  | 
apply (simp)  | 
|
839  | 
apply (frule sorted_spvec_cons1, simp)  | 
|
| 
15236
 
f289e8ba2bb3
Proofs needed to be updated because induction now preserves name of
 
nipkow 
parents: 
15197 
diff
changeset
 | 
840  | 
apply (simp add: sorted_spvec.simps split:list.split_asm)  | 
| 15178 | 841  | 
done  | 
842  | 
||
843  | 
lemma sorted_spmat_minus_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat (minus_spmat A)"  | 
|
844  | 
apply (induct A)  | 
|
845  | 
apply (simp_all add: sorted_spvec_minus_spvec)  | 
|
846  | 
done  | 
|
847  | 
||
848  | 
lemma sorted_spmat_abs_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat (abs_spmat A)"  | 
|
849  | 
apply (induct A)  | 
|
850  | 
apply (simp_all add: sorted_spvec_abs_spvec)  | 
|
851  | 
done  | 
|
| 15009 | 852  | 
|
| 15178 | 853  | 
constdefs  | 
854  | 
  diff_spmat :: "('a::lordered_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat"
 | 
|
855  | 
"diff_spmat A B == add_spmat (A, minus_spmat B)"  | 
|
856  | 
||
857  | 
lemma sorted_spmat_diff_spmat: "sorted_spmat A \<Longrightarrow> sorted_spmat B \<Longrightarrow> sorted_spmat (diff_spmat A B)"  | 
|
858  | 
by (simp add: diff_spmat_def sorted_spmat_minus_spmat sorted_spmat_add_spmat)  | 
|
859  | 
||
860  | 
lemma sorted_spvec_diff_spmat: "sorted_spvec A \<Longrightarrow> sorted_spvec B \<Longrightarrow> sorted_spvec (diff_spmat A B)"  | 
|
861  | 
by (simp add: diff_spmat_def sorted_spvec_minus_spmat sorted_spvec_add_spmat)  | 
|
862  | 
||
863  | 
lemma sparse_row_diff_spmat: "sparse_row_matrix (diff_spmat A B ) = (sparse_row_matrix A) - (sparse_row_matrix B)"  | 
|
864  | 
by (simp add: diff_spmat_def sparse_row_add_spmat sparse_row_matrix_minus)  | 
|
865  | 
||
866  | 
constdefs  | 
|
867  | 
sorted_sparse_matrix :: "'a spmat \<Rightarrow> bool"  | 
|
868  | 
"sorted_sparse_matrix A == (sorted_spvec A) & (sorted_spmat A)"  | 
|
869  | 
||
870  | 
lemma sorted_sparse_matrix_imp_spvec: "sorted_sparse_matrix A \<Longrightarrow> sorted_spvec A"  | 
|
871  | 
by (simp add: sorted_sparse_matrix_def)  | 
|
872  | 
||
873  | 
lemma sorted_sparse_matrix_imp_spmat: "sorted_sparse_matrix A \<Longrightarrow> sorted_spmat A"  | 
|
874  | 
by (simp add: sorted_sparse_matrix_def)  | 
|
875  | 
||
876  | 
lemmas sorted_sp_simps =  | 
|
877  | 
sorted_spvec.simps  | 
|
878  | 
sorted_spmat.simps  | 
|
879  | 
sorted_sparse_matrix_def  | 
|
880  | 
||
881  | 
lemma bool1: "(\<not> True) = False" by blast  | 
|
882  | 
lemma bool2: "(\<not> False) = True" by blast  | 
|
883  | 
lemma bool3: "((P\<Colon>bool) \<and> True) = P" by blast  | 
|
884  | 
lemma bool4: "(True \<and> (P\<Colon>bool)) = P" by blast  | 
|
885  | 
lemma bool5: "((P\<Colon>bool) \<and> False) = False" by blast  | 
|
886  | 
lemma bool6: "(False \<and> (P\<Colon>bool)) = False" by blast  | 
|
887  | 
lemma bool7: "((P\<Colon>bool) \<or> True) = True" by blast  | 
|
888  | 
lemma bool8: "(True \<or> (P\<Colon>bool)) = True" by blast  | 
|
889  | 
lemma bool9: "((P\<Colon>bool) \<or> False) = P" by blast  | 
|
890  | 
lemma bool10: "(False \<or> (P\<Colon>bool)) = P" by blast  | 
|
891  | 
lemmas boolarith = bool1 bool2 bool3 bool4 bool5 bool6 bool7 bool8 bool9 bool10  | 
|
892  | 
||
893  | 
lemma if_case_eq: "(if b then x else y) = (case b of True => x | False => y)" by simp  | 
|
894  | 
||
| 15580 | 895  | 
consts  | 
| 
25303
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
896  | 
  pprt_spvec :: "('a::{lordered_ab_group_add}) spvec \<Rightarrow> 'a spvec"
 | 
| 
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
897  | 
  nprt_spvec :: "('a::{lordered_ab_group_add}) spvec \<Rightarrow> 'a spvec"
 | 
| 
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
898  | 
  pprt_spmat :: "('a::{lordered_ab_group_add}) spmat \<Rightarrow> 'a spmat"
 | 
| 
 
0699e20feabd
renamed lordered_*_* to lordered_*_add_*; further localization
 
haftmann 
parents: 
24124 
diff
changeset
 | 
899  | 
  nprt_spmat :: "('a::{lordered_ab_group_add}) spmat \<Rightarrow> 'a spmat"
 | 
| 15580 | 900  | 
|
901  | 
primrec  | 
|
902  | 
"pprt_spvec [] = []"  | 
|
903  | 
"pprt_spvec (a#as) = (fst a, pprt (snd a)) # (pprt_spvec as)"  | 
|
904  | 
||
905  | 
primrec  | 
|
906  | 
"nprt_spvec [] = []"  | 
|
907  | 
"nprt_spvec (a#as) = (fst a, nprt (snd a)) # (nprt_spvec as)"  | 
|
908  | 
||
909  | 
primrec  | 
|
910  | 
"pprt_spmat [] = []"  | 
|
911  | 
"pprt_spmat (a#as) = (fst a, pprt_spvec (snd a))#(pprt_spmat as)"  | 
|
912  | 
(*case (pprt_spvec (snd a)) of [] \<Rightarrow> (pprt_spmat as) | y#ys \<Rightarrow> (fst a, y#ys)#(pprt_spmat as))"*)  | 
|
913  | 
||
914  | 
primrec  | 
|
915  | 
"nprt_spmat [] = []"  | 
|
916  | 
"nprt_spmat (a#as) = (fst a, nprt_spvec (snd a))#(nprt_spmat as)"  | 
|
917  | 
(*case (nprt_spvec (snd a)) of [] \<Rightarrow> (nprt_spmat as) | y#ys \<Rightarrow> (fst a, y#ys)#(nprt_spmat as))"*)  | 
|
918  | 
||
919  | 
||
920  | 
lemma pprt_add: "disj_matrices A (B::(_::lordered_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
 | 
921  | 
apply (simp add: pprt_def sup_matrix_def)  | 
| 15580 | 922  | 
apply (simp add: Rep_matrix_inject[symmetric])  | 
923  | 
apply (rule ext)+  | 
|
924  | 
apply simp  | 
|
925  | 
apply (case_tac "Rep_matrix A x xa \<noteq> 0")  | 
|
926  | 
apply (simp_all add: disj_matrices_contr1)  | 
|
927  | 
done  | 
|
928  | 
||
929  | 
lemma nprt_add: "disj_matrices A (B::(_::lordered_ring) matrix) \<Longrightarrow> nprt (A+B) = nprt A + nprt B"  | 
|
| 
22452
 
8a86fd2a1bf0
adjusted to new lattice theory developement in Lattices.thy / FixedPoint.thy
 
haftmann 
parents: 
20432 
diff
changeset
 | 
930  | 
apply (simp add: nprt_def inf_matrix_def)  | 
| 15580 | 931  | 
apply (simp add: Rep_matrix_inject[symmetric])  | 
932  | 
apply (rule ext)+  | 
|
933  | 
apply simp  | 
|
934  | 
apply (case_tac "Rep_matrix A x xa \<noteq> 0")  | 
|
935  | 
apply (simp_all add: disj_matrices_contr1)  | 
|
936  | 
done  | 
|
937  | 
||
938  | 
lemma pprt_singleton[simp]: "pprt (singleton_matrix j i (x::_::lordered_ring)) = singleton_matrix j i (pprt x)"  | 
|
| 
22452
 
8a86fd2a1bf0
adjusted to new lattice theory developement in Lattices.thy / FixedPoint.thy
 
haftmann 
parents: 
20432 
diff
changeset
 | 
939  | 
apply (simp add: pprt_def sup_matrix_def)  | 
| 15580 | 940  | 
apply (simp add: Rep_matrix_inject[symmetric])  | 
941  | 
apply (rule ext)+  | 
|
942  | 
apply simp  | 
|
943  | 
done  | 
|
944  | 
||
945  | 
lemma nprt_singleton[simp]: "nprt (singleton_matrix j i (x::_::lordered_ring)) = singleton_matrix j i (nprt x)"  | 
|
| 
22452
 
8a86fd2a1bf0
adjusted to new lattice theory developement in Lattices.thy / FixedPoint.thy
 
haftmann 
parents: 
20432 
diff
changeset
 | 
946  | 
apply (simp add: nprt_def inf_matrix_def)  | 
| 15580 | 947  | 
apply (simp add: Rep_matrix_inject[symmetric])  | 
948  | 
apply (rule ext)+  | 
|
949  | 
apply simp  | 
|
950  | 
done  | 
|
951  | 
||
952  | 
lemma less_imp_le: "a < b \<Longrightarrow> a <= (b::_::order)" by (simp add: less_def)  | 
|
953  | 
||
954  | 
lemma sparse_row_vector_pprt: "sorted_spvec v \<Longrightarrow> sparse_row_vector (pprt_spvec v) = pprt (sparse_row_vector v)"  | 
|
955  | 
apply (induct v)  | 
|
956  | 
apply (simp_all)  | 
|
957  | 
apply (frule sorted_spvec_cons1, auto)  | 
|
958  | 
apply (subst pprt_add)  | 
|
959  | 
apply (subst disj_matrices_commute)  | 
|
960  | 
apply (rule disj_sparse_row_singleton)  | 
|
961  | 
apply auto  | 
|
962  | 
done  | 
|
963  | 
||
964  | 
lemma sparse_row_vector_nprt: "sorted_spvec v \<Longrightarrow> sparse_row_vector (nprt_spvec v) = nprt (sparse_row_vector v)"  | 
|
965  | 
apply (induct v)  | 
|
966  | 
apply (simp_all)  | 
|
967  | 
apply (frule sorted_spvec_cons1, auto)  | 
|
968  | 
apply (subst nprt_add)  | 
|
969  | 
apply (subst disj_matrices_commute)  | 
|
970  | 
apply (rule disj_sparse_row_singleton)  | 
|
971  | 
apply auto  | 
|
972  | 
done  | 
|
973  | 
||
974  | 
||
975  | 
lemma pprt_move_matrix: "pprt (move_matrix (A::('a::lordered_ring) matrix) j i) = move_matrix (pprt A) j i"
 | 
|
976  | 
apply (simp add: pprt_def)  | 
|
| 
22452
 
8a86fd2a1bf0
adjusted to new lattice theory developement in Lattices.thy / FixedPoint.thy
 
haftmann 
parents: 
20432 
diff
changeset
 | 
977  | 
apply (simp add: sup_matrix_def)  | 
| 15580 | 978  | 
apply (simp add: Rep_matrix_inject[symmetric])  | 
979  | 
apply (rule ext)+  | 
|
980  | 
apply (simp)  | 
|
981  | 
done  | 
|
982  | 
||
983  | 
lemma nprt_move_matrix: "nprt (move_matrix (A::('a::lordered_ring) matrix) j i) = move_matrix (nprt A) j i"
 | 
|
984  | 
apply (simp add: nprt_def)  | 
|
| 
22452
 
8a86fd2a1bf0
adjusted to new lattice theory developement in Lattices.thy / FixedPoint.thy
 
haftmann 
parents: 
20432 
diff
changeset
 | 
985  | 
apply (simp add: inf_matrix_def)  | 
| 15580 | 986  | 
apply (simp add: Rep_matrix_inject[symmetric])  | 
987  | 
apply (rule ext)+  | 
|
988  | 
apply (simp)  | 
|
989  | 
done  | 
|
990  | 
||
991  | 
lemma sparse_row_matrix_pprt: "sorted_spvec m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sparse_row_matrix (pprt_spmat m) = pprt (sparse_row_matrix m)"  | 
|
992  | 
apply (induct m)  | 
|
993  | 
apply simp  | 
|
994  | 
apply simp  | 
|
995  | 
apply (frule sorted_spvec_cons1)  | 
|
996  | 
apply (simp add: sparse_row_matrix_cons sparse_row_vector_pprt)  | 
|
997  | 
apply (subst pprt_add)  | 
|
998  | 
apply (subst disj_matrices_commute)  | 
|
999  | 
apply (rule disj_move_sparse_vec_mat)  | 
|
1000  | 
apply auto  | 
|
1001  | 
apply (simp add: sorted_spvec.simps)  | 
|
1002  | 
apply (simp split: list.split)  | 
|
1003  | 
apply auto  | 
|
1004  | 
apply (simp add: pprt_move_matrix)  | 
|
1005  | 
done  | 
|
1006  | 
||
1007  | 
lemma sparse_row_matrix_nprt: "sorted_spvec m \<Longrightarrow> sorted_spmat m \<Longrightarrow> sparse_row_matrix (nprt_spmat m) = nprt (sparse_row_matrix m)"  | 
|
1008  | 
apply (induct m)  | 
|
1009  | 
apply simp  | 
|
1010  | 
apply simp  | 
|
1011  | 
apply (frule sorted_spvec_cons1)  | 
|
1012  | 
apply (simp add: sparse_row_matrix_cons sparse_row_vector_nprt)  | 
|
1013  | 
apply (subst nprt_add)  | 
|
1014  | 
apply (subst disj_matrices_commute)  | 
|
1015  | 
apply (rule disj_move_sparse_vec_mat)  | 
|
1016  | 
apply auto  | 
|
1017  | 
apply (simp add: sorted_spvec.simps)  | 
|
1018  | 
apply (simp split: list.split)  | 
|
1019  | 
apply auto  | 
|
1020  | 
apply (simp add: nprt_move_matrix)  | 
|
1021  | 
done  | 
|
1022  | 
||
1023  | 
lemma sorted_pprt_spvec: "sorted_spvec v \<Longrightarrow> sorted_spvec (pprt_spvec v)"  | 
|
1024  | 
apply (induct v)  | 
|
1025  | 
apply (simp)  | 
|
1026  | 
apply (frule sorted_spvec_cons1)  | 
|
1027  | 
apply simp  | 
|
1028  | 
apply (simp add: sorted_spvec.simps split:list.split_asm)  | 
|
1029  | 
done  | 
|
1030  | 
||
1031  | 
lemma sorted_nprt_spvec: "sorted_spvec v \<Longrightarrow> sorted_spvec (nprt_spvec v)"  | 
|
1032  | 
apply (induct v)  | 
|
1033  | 
apply (simp)  | 
|
1034  | 
apply (frule sorted_spvec_cons1)  | 
|
1035  | 
apply simp  | 
|
1036  | 
apply (simp add: sorted_spvec.simps split:list.split_asm)  | 
|
1037  | 
done  | 
|
1038  | 
||
1039  | 
lemma sorted_spvec_pprt_spmat: "sorted_spvec m \<Longrightarrow> sorted_spvec (pprt_spmat m)"  | 
|
1040  | 
apply (induct m)  | 
|
1041  | 
apply (simp)  | 
|
1042  | 
apply (frule sorted_spvec_cons1)  | 
|
1043  | 
apply simp  | 
|
1044  | 
apply (simp add: sorted_spvec.simps split:list.split_asm)  | 
|
1045  | 
done  | 
|
1046  | 
||
1047  | 
lemma sorted_spvec_nprt_spmat: "sorted_spvec m \<Longrightarrow> sorted_spvec (nprt_spmat m)"  | 
|
1048  | 
apply (induct m)  | 
|
1049  | 
apply (simp)  | 
|
1050  | 
apply (frule sorted_spvec_cons1)  | 
|
1051  | 
apply simp  | 
|
1052  | 
apply (simp add: sorted_spvec.simps split:list.split_asm)  | 
|
1053  | 
done  | 
|
1054  | 
||
1055  | 
lemma sorted_spmat_pprt_spmat: "sorted_spmat m \<Longrightarrow> sorted_spmat (pprt_spmat m)"  | 
|
1056  | 
apply (induct m)  | 
|
1057  | 
apply (simp_all add: sorted_pprt_spvec)  | 
|
1058  | 
done  | 
|
1059  | 
||
1060  | 
lemma sorted_spmat_nprt_spmat: "sorted_spmat m \<Longrightarrow> sorted_spmat (nprt_spmat m)"  | 
|
1061  | 
apply (induct m)  | 
|
1062  | 
apply (simp_all add: sorted_nprt_spvec)  | 
|
1063  | 
done  | 
|
1064  | 
||
1065  | 
constdefs  | 
|
1066  | 
  mult_est_spmat :: "('a::lordered_ring) spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat \<Rightarrow> 'a spmat"
 | 
|
1067  | 
"mult_est_spmat r1 r2 s1 s2 ==  | 
|
1068  | 
add_spmat (mult_spmat (pprt_spmat s2) (pprt_spmat r2), add_spmat (mult_spmat (pprt_spmat s1) (nprt_spmat r2),  | 
|
1069  | 
add_spmat (mult_spmat (nprt_spmat s2) (pprt_spmat r1), mult_spmat (nprt_spmat s1) (nprt_spmat r1))))"  | 
|
1070  | 
||
1071  | 
lemmas sparse_row_matrix_op_simps =  | 
|
1072  | 
sorted_sparse_matrix_imp_spmat sorted_sparse_matrix_imp_spvec  | 
|
1073  | 
sparse_row_add_spmat sorted_spvec_add_spmat sorted_spmat_add_spmat  | 
|
1074  | 
sparse_row_diff_spmat sorted_spvec_diff_spmat sorted_spmat_diff_spmat  | 
|
1075  | 
sparse_row_matrix_minus sorted_spvec_minus_spmat sorted_spmat_minus_spmat  | 
|
1076  | 
sparse_row_mult_spmat sorted_spvec_mult_spmat sorted_spmat_mult_spmat  | 
|
1077  | 
sparse_row_matrix_abs sorted_spvec_abs_spmat sorted_spmat_abs_spmat  | 
|
1078  | 
le_spmat_iff_sparse_row_le  | 
|
1079  | 
sparse_row_matrix_pprt sorted_spvec_pprt_spmat sorted_spmat_pprt_spmat  | 
|
1080  | 
sparse_row_matrix_nprt sorted_spvec_nprt_spmat sorted_spmat_nprt_spmat  | 
|
1081  | 
||
1082  | 
lemma zero_eq_Numeral0: "(0::_::number_ring) = Numeral0" by simp  | 
|
1083  | 
||
1084  | 
lemmas sparse_row_matrix_arith_simps[simplified zero_eq_Numeral0] =  | 
|
1085  | 
mult_spmat.simps mult_spvec_spmat.simps  | 
|
1086  | 
addmult_spvec.simps  | 
|
1087  | 
smult_spvec_empty smult_spvec_cons  | 
|
1088  | 
add_spmat.simps add_spvec.simps  | 
|
1089  | 
minus_spmat.simps minus_spvec.simps  | 
|
1090  | 
abs_spmat.simps abs_spvec.simps  | 
|
1091  | 
diff_spmat_def  | 
|
1092  | 
le_spmat.simps le_spvec.simps  | 
|
1093  | 
pprt_spmat.simps pprt_spvec.simps  | 
|
1094  | 
nprt_spmat.simps nprt_spvec.simps  | 
|
1095  | 
mult_est_spmat_def  | 
|
1096  | 
||
1097  | 
||
1098  | 
(*lemma spm_linprog_dual_estimate_1:  | 
|
| 15178 | 1099  | 
assumes  | 
1100  | 
"sorted_sparse_matrix A1"  | 
|
1101  | 
"sorted_sparse_matrix A2"  | 
|
1102  | 
"sorted_sparse_matrix c1"  | 
|
1103  | 
"sorted_sparse_matrix c2"  | 
|
1104  | 
"sorted_sparse_matrix y"  | 
|
1105  | 
"sorted_spvec b"  | 
|
1106  | 
"sorted_spvec r"  | 
|
1107  | 
"le_spmat ([], y)"  | 
|
1108  | 
  "A * x \<le> sparse_row_matrix (b::('a::lordered_ring) spmat)"
 | 
|
1109  | 
"sparse_row_matrix A1 <= A"  | 
|
1110  | 
"A <= sparse_row_matrix A2"  | 
|
1111  | 
"sparse_row_matrix c1 <= c"  | 
|
1112  | 
"c <= sparse_row_matrix c2"  | 
|
1113  | 
"abs x \<le> sparse_row_matrix r"  | 
|
1114  | 
shows  | 
|
1115  | 
"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),  | 
|
1116  | 
abs_spmat (diff_spmat (mult_spmat y A1) c1)), diff_spmat c2 c1)) r))"  | 
|
1117  | 
by (insert prems, simp add: sparse_row_matrix_op_simps linprog_dual_estimate_1[where A=A])  | 
|
| 15580 | 1118  | 
*)  | 
| 15009 | 1119  | 
|
1120  | 
end  |