139 qed |
164 qed |
140 |
165 |
141 lemma app_firstn_restn: |
166 lemma app_firstn_restn: |
142 fixes s1 s2 |
167 fixes s1 s2 |
143 shows "s1 = firstn (length s1) (s1 @ s2) \<and> s2 = restn (length s1) (s1 @ s2)" |
168 shows "s1 = firstn (length s1) (s1 @ s2) \<and> s2 = restn (length s1) (s1 @ s2)" |
144 by (metis append_eq_conv_conj firstn_ge firstn_le firstn_restn_s le_refl) |
169 proof(rule length_eq_elim_l) |
|
170 have "length s1 \<le> length (s1 @ s2)" by simp |
|
171 from length_firstn_le [OF this] |
|
172 show "length s1 = length (firstn (length s1) (s1 @ s2))" by simp |
|
173 next |
|
174 from firstn_restn_s |
|
175 show "s1 @ s2 = firstn (length s1) (s1 @ s2) @ restn (length s1) (s1 @ s2)" |
|
176 by metis |
|
177 qed |
|
178 |
|
179 |
145 lemma length_moment_le: |
180 lemma length_moment_le: |
146 fixes k s |
181 fixes k s |
147 assumes le_k: "k \<le> length s" |
182 assumes le_k: "k \<le> length s" |
148 shows "length (moment k s) = k" |
183 shows "length (moment k s) = k" |
149 by (metis assms length_firstn_le length_rev moment_def) |
184 proof - |
|
185 have "length (rev (firstn k (rev s))) = k" |
|
186 proof - |
|
187 have "length (rev (firstn k (rev s))) = length (firstn k (rev s))" by simp |
|
188 also have "\<dots> = k" |
|
189 proof(rule length_firstn_le) |
|
190 from le_k show "k \<le> length (rev s)" by simp |
|
191 qed |
|
192 finally show ?thesis . |
|
193 qed |
|
194 thus ?thesis by (simp add:moment_def) |
|
195 qed |
150 |
196 |
151 lemma app_moment_restm: |
197 lemma app_moment_restm: |
152 fixes s1 s2 |
198 fixes s1 s2 |
153 shows "s1 = restm (length s2) (s1 @ s2) \<and> s2 = moment (length s2) (s1 @ s2)" |
199 shows "s1 = restm (length s2) (s1 @ s2) \<and> s2 = moment (length s2) (s1 @ s2)" |
154 by (metis app_firstn_restn length_rev moment_def restm_def rev_append rev_rev_ident) |
200 proof(rule length_eq_elim_r) |
|
201 have "length s2 \<le> length (s1 @ s2)" by simp |
|
202 from length_moment_le [OF this] |
|
203 show "length s2 = length (moment (length s2) (s1 @ s2))" by simp |
|
204 next |
|
205 from moment_restm_s |
|
206 show "s1 @ s2 = restm (length s2) (s1 @ s2) @ moment (length s2) (s1 @ s2)" |
|
207 by metis |
|
208 qed |
155 |
209 |
156 lemma length_moment_ge: |
210 lemma length_moment_ge: |
157 fixes k s |
211 fixes k s |
158 assumes le_k: "length s \<le> k" |
212 assumes le_k: "length s \<le> k" |
159 shows "length (moment k s) = (length s)" |
213 shows "length (moment k s) = (length s)" |
160 by (metis assms firstn_ge length_rev moment_def) |
214 proof - |
|
215 have "length (rev (firstn k (rev s))) = length s" |
|
216 proof - |
|
217 have "length (rev (firstn k (rev s))) = length (firstn k (rev s))" by simp |
|
218 also have "\<dots> = length s" |
|
219 proof - |
|
220 have "\<dots> = length (rev s)" |
|
221 proof(rule length_firstn_ge) |
|
222 from le_k show "length (rev s) \<le> k" by simp |
|
223 qed |
|
224 also have "\<dots> = length s" by simp |
|
225 finally show ?thesis . |
|
226 qed |
|
227 finally show ?thesis . |
|
228 qed |
|
229 thus ?thesis by (simp add:moment_def) |
|
230 qed |
161 |
231 |
162 lemma length_firstn: "(length (firstn n s) = length s) \<or> (length (firstn n s) = n)" |
232 lemma length_firstn: "(length (firstn n s) = length s) \<or> (length (firstn n s) = n)" |
163 by (metis length_firstn_ge length_firstn_le nat_le_linear) |
233 proof(cases "n \<le> length s") |
|
234 case True |
|
235 from length_firstn_le [OF True] show ?thesis by auto |
|
236 next |
|
237 case False |
|
238 from False have "length s \<le> n" by simp |
|
239 from firstn_ge [OF this] show ?thesis by auto |
|
240 qed |
164 |
241 |
165 lemma firstn_conc: |
242 lemma firstn_conc: |
166 fixes m n |
243 fixes m n |
167 assumes le_mn: "m \<le> n" |
244 assumes le_mn: "m \<le> n" |
168 shows "firstn m s = firstn m (firstn n s)" |
245 shows "firstn m s = firstn m (firstn n s)" |
191 |
268 |
192 lemma restn_conc: |
269 lemma restn_conc: |
193 fixes i j k s |
270 fixes i j k s |
194 assumes eq_k: "j + i = k" |
271 assumes eq_k: "j + i = k" |
195 shows "restn k s = restn j (restn i s)" |
272 shows "restn k s = restn j (restn i s)" |
196 by (metis app_moment_restm append_take_drop_id assms drop_drop length_drop moment_def restn.simps) |
273 proof - |
|
274 have "(firstn (length s - k) (rev s)) = |
|
275 (firstn (length (rev (firstn (length s - i) (rev s))) - j) |
|
276 (rev (rev (firstn (length s - i) (rev s)))))" |
|
277 proof - |
|
278 have "(firstn (length s - k) (rev s)) = |
|
279 (firstn (length (rev (firstn (length s - i) (rev s))) - j) |
|
280 (firstn (length s - i) (rev s)))" |
|
281 proof - |
|
282 have " (length (rev (firstn (length s - i) (rev s))) - j) = length s - k" |
|
283 proof - |
|
284 have "(length (rev (firstn (length s - i) (rev s))) - j) = (length s - i) - j" |
|
285 proof - |
|
286 have "(length (rev (firstn (length s - i) (rev s))) - j) = |
|
287 length ((firstn (length s - i) (rev s))) - j" |
|
288 by simp |
|
289 also have "\<dots> = length ((firstn (length (rev s) - i) (rev s))) - j" by simp |
|
290 also have "\<dots> = (length (rev s) - i) - j" |
|
291 proof - |
|
292 have "length ((firstn (length (rev s) - i) (rev s))) = (length (rev s) - i)" |
|
293 by (rule length_firstn_le, simp) |
|
294 thus ?thesis by simp |
|
295 qed |
|
296 also have "\<dots> = (length s - i) - j" by simp |
|
297 finally show ?thesis . |
|
298 qed |
|
299 with eq_k show ?thesis by auto |
|
300 qed |
|
301 moreover have "(firstn (length s - k) (rev s)) = |
|
302 (firstn (length s - k) (firstn (length s - i) (rev s)))" |
|
303 proof(rule firstn_conc) |
|
304 from eq_k show "length s - k \<le> length s - i" by simp |
|
305 qed |
|
306 ultimately show ?thesis by simp |
|
307 qed |
|
308 thus ?thesis by simp |
|
309 qed |
|
310 thus ?thesis by (simp only:restn.simps) |
|
311 qed |
197 |
312 |
198 (* |
313 (* |
199 value "down_to 2 0 [5, 4, 3, 2, 1, 0]" |
314 value "down_to 2 0 [5, 4, 3, 2, 1, 0]" |
200 value "moment 2 [5, 4, 3, 2, 1, 0]" |
315 value "moment 2 [5, 4, 3, 2, 1, 0]" |
201 *) |
316 *) |
202 |
317 |
203 lemma from_to_firstn: "from_to 0 k s = firstn k s" |
318 lemma from_to_firstn: "from_to 0 k s = firstn k s" |
204 by (simp add:from_to_def restn.simps) |
319 by (simp add:from_to_def restn.simps) |
205 |
320 |
206 lemma moment_app [simp]: |
321 lemma moment_app [simp]: |
207 assumes ile: "i \<le> length s" |
322 assumes |
|
323 ile: "i \<le> length s" |
208 shows "moment i (s'@s) = moment i s" |
324 shows "moment i (s'@s) = moment i s" |
209 by (metis assms firstn_le length_rev moment_def rev_append) |
325 proof - |
|
326 have "moment i (s'@s) = rev (firstn i (rev (s'@s)))" by (simp add:moment_def) |
|
327 moreover have "firstn i (rev (s'@s)) = firstn i (rev s @ rev s')" by simp |
|
328 moreover have "\<dots> = firstn i (rev s)" |
|
329 proof(rule firstn_le) |
|
330 have "length (rev s) = length s" by simp |
|
331 with ile show "i \<le> length (rev s)" by simp |
|
332 qed |
|
333 ultimately show ?thesis by (simp add:moment_def) |
|
334 qed |
210 |
335 |
211 lemma moment_eq [simp]: "moment (length s) (s'@s) = s" |
336 lemma moment_eq [simp]: "moment (length s) (s'@s) = s" |
212 by (metis app_moment_restm) |
337 proof - |
|
338 have "length s \<le> length s" by simp |
|
339 from moment_app [OF this, of s'] |
|
340 have " moment (length s) (s' @ s) = moment (length s) s" . |
|
341 moreover have "\<dots> = s" by (simp add:moment_def) |
|
342 ultimately show ?thesis by simp |
|
343 qed |
213 |
344 |
214 lemma moment_ge [simp]: "length s \<le> n \<Longrightarrow> moment n s = s" |
345 lemma moment_ge [simp]: "length s \<le> n \<Longrightarrow> moment n s = s" |
215 by (unfold moment_def, simp) |
346 by (unfold moment_def, simp) |
216 |
347 |
217 lemma moment_zero [simp]: "moment 0 s = []" |
348 lemma moment_zero [simp]: "moment 0 s = []" |
401 lemma down_to_conc: |
532 lemma down_to_conc: |
402 fixes i j k s |
533 fixes i j k s |
403 assumes le_ij: "i \<le> j" |
534 assumes le_ij: "i \<le> j" |
404 and le_jk: "j \<le> k" |
535 and le_jk: "j \<le> k" |
405 shows "down_to k j s @ down_to j i s = down_to k i s" |
536 shows "down_to k j s @ down_to j i s = down_to k i s" |
406 by (metis down_to_def from_to_conc le_ij le_jk rev_append) |
537 proof - |
|
538 have "rev (from_to j k (rev s)) @ rev (from_to i j (rev s)) = rev (from_to i k (rev s))" |
|
539 (is "?L = ?R") |
|
540 proof - |
|
541 have "?L = rev (from_to i j (rev s) @ from_to j k (rev s))" by simp |
|
542 also have "\<dots> = ?R" (is "rev ?x = rev ?y") |
|
543 proof - |
|
544 have "?x = ?y" by (rule from_to_conc[OF le_ij le_jk]) |
|
545 thus ?thesis by simp |
|
546 qed |
|
547 finally show ?thesis . |
|
548 qed |
|
549 thus ?thesis by (simp add:down_to_def) |
|
550 qed |
407 |
551 |
408 lemma restn_ge: |
552 lemma restn_ge: |
409 fixes s k |
553 fixes s k |
410 assumes le_k: "length s \<le> k" |
554 assumes le_k: "length s \<le> k" |
411 shows "restn k s = []" |
555 shows "restn k s = []" |
412 by (metis assms diff_is_0_eq moment_def moment_zero restn.simps) |
556 proof - |
|
557 from firstn_restn_s [of k s, symmetric] have "s = (firstn k s) @ (restn k s)" . |
|
558 hence "length s = length \<dots>" by simp |
|
559 also have "\<dots> = length (firstn k s) + length (restn k s)" by simp |
|
560 finally have "length s = ..." by simp |
|
561 moreover from length_firstn_ge and le_k |
|
562 have "length (firstn k s) = length s" by simp |
|
563 ultimately have "length (restn k s) = 0" by auto |
|
564 thus ?thesis by auto |
|
565 qed |
413 |
566 |
414 lemma from_to_ge: "length s \<le> k \<Longrightarrow> from_to k j s = []" |
567 lemma from_to_ge: "length s \<le> k \<Longrightarrow> from_to k j s = []" |
415 by (metis firstn_nil from_to_def restn_ge) |
568 proof(simp only:from_to_def) |
|
569 assume "length s \<le> k" |
|
570 from restn_ge [OF this] |
|
571 show "firstn (j - k) (restn k s) = []" by simp |
|
572 qed |
416 |
573 |
417 (* |
574 (* |
418 value "from_to 2 5 [0, 1, 2, 3, 4]" |
575 value "from_to 2 5 [0, 1, 2, 3, 4]" |
419 value "restn 2 [0, 1, 2, 3, 4]" |
576 value "restn 2 [0, 1, 2, 3, 4]" |
420 *) |
577 *) |
421 |
578 |
422 lemma from_to_restn: |
579 lemma from_to_restn: |
423 fixes k j s |
580 fixes k j s |
424 assumes le_j: "length s \<le> j" |
581 assumes le_j: "length s \<le> j" |
425 shows "from_to k j s = restn k s" |
582 shows "from_to k j s = restn k s" |
426 by (metis app_moment_restm append_Nil2 append_take_drop_id assms diff_is_0_eq' drop_take firstn_restn_s from_to_def length_drop moment_def moment_zero restn.simps) |
583 proof - |
|
584 have "from_to 0 k s @ from_to k j s = from_to 0 j s" |
|
585 proof(cases "k \<le> j") |
|
586 case True |
|
587 from from_to_conc True show ?thesis by auto |
|
588 next |
|
589 case False |
|
590 from False le_j have lek: "length s \<le> k" by auto |
|
591 from from_to_ge [OF this] have "from_to k j s = []" . |
|
592 hence "from_to 0 k s @ from_to k j s = from_to 0 k s" by simp |
|
593 also have "\<dots> = s" |
|
594 proof - |
|
595 from from_to_firstn [of k s] |
|
596 have "\<dots> = firstn k s" . |
|
597 also have "\<dots> = s" by (rule firstn_ge [OF lek]) |
|
598 finally show ?thesis . |
|
599 qed |
|
600 finally have "from_to 0 k s @ from_to k j s = s" . |
|
601 moreover have "from_to 0 j s = s" |
|
602 proof - |
|
603 have "from_to 0 j s = firstn j s" by (simp add:from_to_firstn) |
|
604 also have "\<dots> = s" |
|
605 proof(rule firstn_ge) |
|
606 from le_j show "length s \<le> j " by simp |
|
607 qed |
|
608 finally show ?thesis . |
|
609 qed |
|
610 ultimately show ?thesis by auto |
|
611 qed |
|
612 also have "\<dots> = s" |
|
613 proof - |
|
614 from from_to_firstn have "\<dots> = firstn j s" . |
|
615 also have "\<dots> = s" |
|
616 proof(rule firstn_ge) |
|
617 from le_j show "length s \<le> j" by simp |
|
618 qed |
|
619 finally show ?thesis . |
|
620 qed |
|
621 finally have "from_to 0 k s @ from_to k j s = s" . |
|
622 moreover have "from_to 0 k s @ restn k s = s" |
|
623 proof - |
|
624 from from_to_firstn [of k s] |
|
625 have "from_to 0 k s = firstn k s" . |
|
626 thus ?thesis by (simp add:firstn_restn_s) |
|
627 qed |
|
628 ultimately have "from_to 0 k s @ from_to k j s = |
|
629 from_to 0 k s @ restn k s" by simp |
|
630 thus ?thesis by auto |
|
631 qed |
427 |
632 |
428 lemma down_to_moment: "down_to k 0 s = moment k s" |
633 lemma down_to_moment: "down_to k 0 s = moment k s" |
429 by (metis down_to_def from_to_firstn moment_def) |
634 proof - |
|
635 have "rev (from_to 0 k (rev s)) = rev (firstn k (rev s))" |
|
636 using from_to_firstn by metis |
|
637 thus ?thesis by (simp add:down_to_def moment_def) |
|
638 qed |
430 |
639 |
431 lemma down_to_restm: |
640 lemma down_to_restm: |
432 assumes le_s: "length s \<le> j" |
641 assumes le_s: "length s \<le> j" |
433 shows "down_to j k s = restm k s" |
642 shows "down_to j k s = restm k s" |
434 by (metis assms down_to_def from_to_restn length_rev restm_def) |
643 proof - |
|
644 have "rev (from_to k j (rev s)) = rev (restn k (rev s))" (is "?L = ?R") |
|
645 proof - |
|
646 from le_s have "length (rev s) \<le> j" by simp |
|
647 from from_to_restn [OF this, of k] show ?thesis by simp |
|
648 qed |
|
649 thus ?thesis by (simp add:down_to_def restm_def) |
|
650 qed |
435 |
651 |
436 lemma moment_split: "moment (m+i) s = down_to (m+i) i s @down_to i 0 s" |
652 lemma moment_split: "moment (m+i) s = down_to (m+i) i s @down_to i 0 s" |
437 by (metis down_to_conc down_to_moment le0 le_add1 nat_add_commute) |
653 proof - |
|
654 have "moment (m + i) s = down_to (m+i) 0 s" using down_to_moment by metis |
|
655 also have "\<dots> = (down_to (m+i) i s) @ (down_to i 0 s)" |
|
656 by(rule down_to_conc[symmetric], auto) |
|
657 finally show ?thesis . |
|
658 qed |
438 |
659 |
439 lemma length_restn: "length (restn i s) = length s - i" |
660 lemma length_restn: "length (restn i s) = length s - i" |
440 by (metis diff_le_self length_firstn_le length_rev restn.simps) |
661 proof(cases "i \<le> length s") |
|
662 case True |
|
663 from length_firstn_le [OF this] have "length (firstn i s) = i" . |
|
664 moreover have "length s = length (firstn i s) + length (restn i s)" |
|
665 proof - |
|
666 have "s = firstn i s @ restn i s" using firstn_restn_s by metis |
|
667 hence "length s = length \<dots>" by simp |
|
668 thus ?thesis by simp |
|
669 qed |
|
670 ultimately show ?thesis by simp |
|
671 next |
|
672 case False |
|
673 hence "length s \<le> i" by simp |
|
674 from restn_ge [OF this] have "restn i s = []" . |
|
675 with False show ?thesis by simp |
|
676 qed |
441 |
677 |
442 lemma length_from_to_in: |
678 lemma length_from_to_in: |
443 fixes i j s |
679 fixes i j s |
444 assumes le_ij: "i \<le> j" |
680 assumes le_ij: "i \<le> j" |
445 and le_j: "j \<le> length s" |
681 and le_j: "j \<le> length s" |
446 shows "length (from_to i j s) = j - i" |
682 shows "length (from_to i j s) = j - i" |
447 by (metis diff_le_mono from_to_def le_j length_firstn_le length_restn) |
683 proof - |
|
684 have "from_to 0 j s = from_to 0 i s @ from_to i j s" |
|
685 by (rule from_to_conc[symmetric, OF _ le_ij], simp) |
|
686 moreover have "length (from_to 0 j s) = j" |
|
687 proof - |
|
688 have "from_to 0 j s = firstn j s" using from_to_firstn by metis |
|
689 moreover have "length \<dots> = j" by (rule length_firstn_le [OF le_j]) |
|
690 ultimately show ?thesis by simp |
|
691 qed |
|
692 moreover have "length (from_to 0 i s) = i" |
|
693 proof - |
|
694 have "from_to 0 i s = firstn i s" using from_to_firstn by metis |
|
695 moreover have "length \<dots> = i" |
|
696 proof (rule length_firstn_le) |
|
697 from le_ij le_j show "i \<le> length s" by simp |
|
698 qed |
|
699 ultimately show ?thesis by simp |
|
700 qed |
|
701 ultimately show ?thesis by auto |
|
702 qed |
448 |
703 |
449 lemma firstn_restn_from_to: "from_to i (m + i) s = firstn m (restn i s)" |
704 lemma firstn_restn_from_to: "from_to i (m + i) s = firstn m (restn i s)" |
450 by (metis diff_add_inverse2 from_to_def) |
705 proof(cases "m+i \<le> length s") |
|
706 case True |
|
707 have "restn i s = from_to i (m+i) s @ from_to (m+i) (length s) s" |
|
708 proof - |
|
709 have "restn i s = from_to i (length s) s" |
|
710 by(rule from_to_restn[symmetric], simp) |
|
711 also have "\<dots> = from_to i (m+i) s @ from_to (m+i) (length s) s" |
|
712 by(rule from_to_conc[symmetric, OF _ True], simp) |
|
713 finally show ?thesis . |
|
714 qed |
|
715 hence "firstn m (restn i s) = firstn m \<dots>" by simp |
|
716 moreover have "\<dots> = firstn (length (from_to i (m+i) s)) |
|
717 (from_to i (m+i) s @ from_to (m+i) (length s) s)" |
|
718 proof - |
|
719 have "length (from_to i (m+i) s) = m" |
|
720 proof - |
|
721 have "length (from_to i (m+i) s) = (m+i) - i" |
|
722 by(rule length_from_to_in [OF _ True], simp) |
|
723 thus ?thesis by simp |
|
724 qed |
|
725 thus ?thesis by simp |
|
726 qed |
|
727 ultimately show ?thesis using app_firstn_restn by metis |
|
728 next |
|
729 case False |
|
730 hence "length s \<le> m + i" by simp |
|
731 from from_to_restn [OF this] |
|
732 have "from_to i (m + i) s = restn i s" . |
|
733 moreover have "firstn m (restn i s) = restn i s" |
|
734 proof(rule firstn_ge) |
|
735 show "length (restn i s) \<le> m" |
|
736 proof - |
|
737 have "length (restn i s) = length s - i" using length_restn by metis |
|
738 with False show ?thesis by simp |
|
739 qed |
|
740 qed |
|
741 ultimately show ?thesis by simp |
|
742 qed |
451 |
743 |
452 lemma down_to_moment_restm: |
744 lemma down_to_moment_restm: |
453 fixes m i s |
745 fixes m i s |
454 shows "down_to (m + i) i s = moment m (restm i s)" |
746 shows "down_to (m + i) i s = moment m (restm i s)" |
455 by (simp add:firstn_restn_from_to down_to_def moment_def restm_def) |
747 by (simp add:firstn_restn_from_to down_to_def moment_def restm_def) |
456 |
748 |
457 lemma moment_plus_split: |
749 lemma moment_plus_split: |
458 fixes m i s |
750 fixes m i s |
459 shows "moment (m + i) s = moment m (restm i s) @ moment i s" |
751 shows "moment (m + i) s = moment m (restm i s) @ moment i s" |
460 by (metis down_to_moment down_to_moment_restm moment_split) |
752 proof - |
|
753 from moment_split [of m i s] |
|
754 have "moment (m + i) s = down_to (m + i) i s @ down_to i 0 s" . |
|
755 also have "\<dots> = down_to (m+i) i s @ moment i s" using down_to_moment by simp |
|
756 also from down_to_moment_restm have "\<dots> = moment m (restm i s) @ moment i s" |
|
757 by simp |
|
758 finally show ?thesis . |
|
759 qed |
461 |
760 |
462 lemma length_restm: "length (restm i s) = length s - i" |
761 lemma length_restm: "length (restm i s) = length s - i" |
463 by (metis length_restn length_rev restm_def) |
762 proof - |
|
763 have "length (rev (restn i (rev s))) = length s - i" (is "?L = ?R") |
|
764 proof - |
|
765 have "?L = length (restn i (rev s))" by simp |
|
766 also have "\<dots> = length (rev s) - i" using length_restn by metis |
|
767 also have "\<dots> = ?R" by simp |
|
768 finally show ?thesis . |
|
769 qed |
|
770 thus ?thesis by (simp add:restm_def) |
|
771 qed |
464 |
772 |
465 end |
773 end |