src/HOL/Set_Interval.thy
changeset 66936 cf8d8fc23891
parent 66836 4eb431c3f974
child 67091 1393c2340eec
equal deleted inserted replaced
66935:d0f12783cd80 66936:cf8d8fc23891
   215 breaks many proofs. Since it only helps blast, it is better to leave them
   215 breaks many proofs. Since it only helps blast, it is better to leave them
   216 alone.\<close>
   216 alone.\<close>
   217 
   217 
   218 lemma greaterThanLessThan_eq: "{ a <..< b} = { a <..} \<inter> {..< b }"
   218 lemma greaterThanLessThan_eq: "{ a <..< b} = { a <..} \<inter> {..< b }"
   219   by auto
   219   by auto
       
   220 
       
   221 lemma (in order) atLeast_lessThan_eq_atLeast_atMost_diff:
       
   222   "{a..<b} = {a..b} - {b}"
       
   223   by (auto simp add: atLeastLessThan_def atLeastAtMost_def)
   220 
   224 
   221 end
   225 end
   222 
   226 
   223 subsubsection\<open>Emptyness, singletons, subset\<close>
   227 subsubsection\<open>Emptyness, singletons, subset\<close>
   224 
   228 
   840 lemma atLeastLessThan_add_Un: "i \<le> j \<Longrightarrow> {i..<j+k} = {i..<j} \<union> {j..<j+k::nat}"
   844 lemma atLeastLessThan_add_Un: "i \<le> j \<Longrightarrow> {i..<j+k} = {i..<j} \<union> {j..<j+k::nat}"
   841   apply (induct k)
   845   apply (induct k)
   842   apply (simp_all add: atLeastLessThanSuc)
   846   apply (simp_all add: atLeastLessThanSuc)
   843   done
   847   done
   844 
   848 
       
   849 
   845 subsubsection \<open>Intervals and numerals\<close>
   850 subsubsection \<open>Intervals and numerals\<close>
   846 
   851 
   847 lemma lessThan_nat_numeral:  \<comment>\<open>Evaluation for specific numerals\<close>
   852 lemma lessThan_nat_numeral:  \<comment>\<open>Evaluation for specific numerals\<close>
   848   "lessThan (numeral k :: nat) = insert (pred_numeral k) (lessThan (pred_numeral k))"
   853   "lessThan (numeral k :: nat) = insert (pred_numeral k) (lessThan (pred_numeral k))"
   849   by (simp add: numeral_eq_Suc lessThan_Suc)
   854   by (simp add: numeral_eq_Suc lessThan_Suc)
   856   "atLeastLessThan m (numeral k :: nat) =
   861   "atLeastLessThan m (numeral k :: nat) =
   857      (if m \<le> (pred_numeral k) then insert (pred_numeral k) (atLeastLessThan m (pred_numeral k))
   862      (if m \<le> (pred_numeral k) then insert (pred_numeral k) (atLeastLessThan m (pred_numeral k))
   858                  else {})"
   863                  else {})"
   859   by (simp add: numeral_eq_Suc atLeastLessThanSuc)
   864   by (simp add: numeral_eq_Suc atLeastLessThanSuc)
   860 
   865 
       
   866 
   861 subsubsection \<open>Image\<close>
   867 subsubsection \<open>Image\<close>
   862 
   868 
   863 lemma image_add_atLeastAtMost [simp]:
   869 context linordered_semidom
   864   fixes k ::"'a::linordered_semidom"
   870 begin
   865   shows "(\<lambda>n. n+k) ` {i..j} = {i+k..j+k}" (is "?A = ?B")
   871 
       
   872 lemma image_add_atLeast_atMost [simp]:
       
   873   "plus k ` {i..j} = {i + k..j + k}" (is "?A = ?B")
   866 proof
   874 proof
   867   show "?A \<subseteq> ?B" by auto
   875   show "?A \<subseteq> ?B"
       
   876     by (auto simp add: ac_simps)
   868 next
   877 next
   869   show "?B \<subseteq> ?A"
   878   show "?B \<subseteq> ?A"
   870   proof
   879   proof
   871     fix n assume a: "n : ?B"
   880     fix n
   872     hence "n - k : {i..j}"
   881     assume "n \<in> ?B"
       
   882     then have "i \<le> n - k"
       
   883       by (simp add: add_le_imp_le_diff)
       
   884     have "n = n - k + k"
       
   885     proof -
       
   886       from \<open>n \<in> ?B\<close> have "n = n - (i + k) + (i + k)"
       
   887         by simp
       
   888       also have "\<dots> = n - k - i + i + k"
       
   889         by (simp add: algebra_simps)
       
   890       also have "\<dots> = n - k + k"
       
   891         using \<open>i \<le> n - k\<close> by simp
       
   892       finally show ?thesis .
       
   893     qed
       
   894     moreover have "n - k \<in> {i..j}"
       
   895       using \<open>n \<in> ?B\<close>
   873       by (auto simp: add_le_imp_le_diff add_le_add_imp_diff_le)
   896       by (auto simp: add_le_imp_le_diff add_le_add_imp_diff_le)
   874     moreover have "n = (n - k) + k" using a
   897     ultimately show "n \<in> ?A"
   875     proof -
   898       by (simp add: ac_simps) 
   876       have "k + i \<le> n"
       
   877         by (metis a add.commute atLeastAtMost_iff)
       
   878       hence "k + (n - k) = n"
       
   879         by (metis (no_types) ab_semigroup_add_class.add_ac(1) add_diff_cancel_left' le_add_diff_inverse)
       
   880       thus ?thesis
       
   881         by (simp add: add.commute)
       
   882     qed
       
   883     ultimately show "n : ?A" by blast
       
   884   qed
   899   qed
   885 qed
   900 qed
   886 
   901 
       
   902 lemma image_add_atLeast_atMost' [simp]:
       
   903   "(\<lambda>n. n + k) ` {i..j} = {i + k..j + k}"
       
   904   by (simp add: add.commute [of _ k])
       
   905 
       
   906 lemma image_add_atLeast_lessThan [simp]:
       
   907   "plus k ` {i..<j} = {i + k..<j + k}"
       
   908   by (simp add: image_set_diff atLeast_lessThan_eq_atLeast_atMost_diff ac_simps)
       
   909 
       
   910 lemma image_add_atLeast_lessThan' [simp]:
       
   911   "(\<lambda>n. n + k) ` {i..<j} = {i + k..<j + k}"
       
   912   by (simp add: add.commute [of _ k])
       
   913 
       
   914 end
       
   915 
       
   916 lemma image_Suc_atLeast_atMost [simp]:
       
   917   "Suc ` {i..j} = {Suc i..Suc j}"
       
   918   using image_add_atLeast_atMost [of 1 i j]
       
   919     by (simp only: plus_1_eq_Suc) simp
       
   920 
       
   921 lemma image_Suc_atLeast_lessThan [simp]:
       
   922   "Suc ` {i..<j} = {Suc i..<Suc j}"
       
   923   using image_add_atLeast_lessThan [of 1 i j]
       
   924     by (simp only: plus_1_eq_Suc) simp
       
   925 
       
   926 corollary image_Suc_atMost:
       
   927   "Suc ` {..n} = {1..Suc n}"
       
   928   by (simp add: atMost_atLeast0 atLeastLessThanSuc_atLeastAtMost)
       
   929 
       
   930 corollary image_Suc_lessThan:
       
   931   "Suc ` {..<n} = {1..n}"
       
   932   by (simp add: lessThan_atLeast0 atLeastLessThanSuc_atLeastAtMost)
       
   933   
   887 lemma image_diff_atLeastAtMost [simp]:
   934 lemma image_diff_atLeastAtMost [simp]:
   888   fixes d::"'a::linordered_idom" shows "(op - d ` {a..b}) = {d-b..d-a}"
   935   fixes d::"'a::linordered_idom" shows "(op - d ` {a..b}) = {d-b..d-a}"
   889   apply auto
   936   apply auto
   890   apply (rule_tac x="d-x" in rev_image_eqI, auto)
   937   apply (rule_tac x="d-x" in rev_image_eqI, auto)
   891   done
   938   done
   927   shows "((\<lambda>x. x/m - c) ` {a..b}) = (if {a..b}={} then {}
   974   shows "((\<lambda>x. x/m - c) ` {a..b}) = (if {a..b}={} then {}
   928             else if 0 \<le> m then {a/m - c .. b/m - c}
   975             else if 0 \<le> m then {a/m - c .. b/m - c}
   929             else {b/m - c .. a/m - c})"
   976             else {b/m - c .. a/m - c})"
   930   using image_affinity_atLeastAtMost_diff [of "inverse m" c a b]
   977   using image_affinity_atLeastAtMost_diff [of "inverse m" c a b]
   931   by (simp add: field_class.field_divide_inverse algebra_simps)
   978   by (simp add: field_class.field_divide_inverse algebra_simps)
   932 
       
   933 lemma image_add_atLeastLessThan:
       
   934   "(%n::nat. n+k) ` {i..<j} = {i+k..<j+k}" (is "?A = ?B")
       
   935 proof
       
   936   show "?A \<subseteq> ?B" by auto
       
   937 next
       
   938   show "?B \<subseteq> ?A"
       
   939   proof
       
   940     fix n assume a: "n : ?B"
       
   941     hence "n - k : {i..<j}" by auto
       
   942     moreover have "n = (n - k) + k" using a by auto
       
   943     ultimately show "n : ?A" by blast
       
   944   qed
       
   945 qed
       
   946 
       
   947 corollary image_Suc_lessThan:
       
   948   "Suc ` {..<n} = {1..n}"
       
   949   using image_add_atLeastLessThan [of 1 0 n]
       
   950   by (auto simp add: lessThan_Suc_atMost atLeast0LessThan)
       
   951 
       
   952 corollary image_Suc_atMost:
       
   953   "Suc ` {..n} = {1..Suc n}"
       
   954   using image_add_atLeastLessThan [of 1 0 "Suc n"]
       
   955   by (auto simp add: lessThan_Suc_atMost atLeast0LessThan)
       
   956 
       
   957 corollary image_Suc_atLeastAtMost[simp]:
       
   958   "Suc ` {i..j} = {Suc i..Suc j}"
       
   959 using image_add_atLeastAtMost[where k="Suc 0"] by simp
       
   960 
       
   961 corollary image_Suc_atLeastLessThan[simp]:
       
   962   "Suc ` {i..<j} = {Suc i..<Suc j}"
       
   963 using image_add_atLeastLessThan[where k="Suc 0"] by simp
       
   964 
   979 
   965 lemma atLeast1_lessThan_eq_remove0:
   980 lemma atLeast1_lessThan_eq_remove0:
   966   "{Suc 0..<n} = {..<n} - {0}"
   981   "{Suc 0..<n} = {..<n} - {0}"
   967   by auto
   982   by auto
   968 
   983 
   992     assume "\<not> c < y" with a show ?thesis
  1007     assume "\<not> c < y" with a show ?thesis
   993       by (auto intro!: image_eqI[of _ _ x] split: if_split_asm)
  1008       by (auto intro!: image_eqI[of _ _ x] split: if_split_asm)
   994   qed
  1009   qed
   995 qed auto
  1010 qed auto
   996 
  1011 
   997 lemma image_int_atLeastLessThan: "int ` {a..<b} = {int a..<int b}"
  1012 lemma image_int_atLeast_lessThan:
       
  1013   "int ` {a..<b} = {int a..<int b}"
       
  1014   by (auto intro!: image_eqI [where x = "nat x" for x])
       
  1015 
       
  1016 lemma image_int_atLeast_atMost:
       
  1017   "int ` {a..b} = {int a..int b}"
   998   by (auto intro!: image_eqI [where x = "nat x" for x])
  1018   by (auto intro!: image_eqI [where x = "nat x" for x])
   999 
  1019 
  1000 context ordered_ab_group_add
  1020 context ordered_ab_group_add
  1001 begin
  1021 begin
  1002 
  1022 
  1530 done
  1550 done
  1531 
  1551 
  1532 
  1552 
  1533 subsection \<open>Generic big monoid operation over intervals\<close>
  1553 subsection \<open>Generic big monoid operation over intervals\<close>
  1534 
  1554 
  1535 lemma inj_on_add_nat' [simp]:
  1555 context semiring_char_0
  1536   "inj_on (plus k) N" for k :: nat
  1556 begin
       
  1557 
       
  1558 lemma inj_on_of_nat [simp]:
       
  1559   "inj_on of_nat N"
  1537   by rule simp
  1560   by rule simp
       
  1561 
       
  1562 lemma bij_betw_of_nat [simp]:
       
  1563   "bij_betw of_nat N A \<longleftrightarrow> of_nat ` N = A"
       
  1564   by (simp add: bij_betw_def)
       
  1565 
       
  1566 end
  1538 
  1567 
  1539 context comm_monoid_set
  1568 context comm_monoid_set
  1540 begin
  1569 begin
  1541 
  1570 
       
  1571 lemma atLeast_lessThan_reindex:
       
  1572   "F g {h m..<h n} = F (g \<circ> h) {m..<n}"
       
  1573   if "bij_betw h {m..<n} {h m..<h n}" for m n ::nat
       
  1574 proof -
       
  1575   from that have "inj_on h {m..<n}" and "h ` {m..<n} = {h m..<h n}"
       
  1576     by (simp_all add: bij_betw_def)
       
  1577   then show ?thesis
       
  1578     using reindex [of h "{m..<n}" g] by simp
       
  1579 qed
       
  1580 
       
  1581 lemma atLeast_atMost_reindex:
       
  1582   "F g {h m..h n} = F (g \<circ> h) {m..n}"
       
  1583   if "bij_betw h {m..n} {h m..h n}" for m n ::nat
       
  1584 proof -
       
  1585   from that have "inj_on h {m..n}" and "h ` {m..n} = {h m..h n}"
       
  1586     by (simp_all add: bij_betw_def)
       
  1587   then show ?thesis
       
  1588     using reindex [of h "{m..n}" g] by simp
       
  1589 qed
       
  1590 
  1542 lemma atLeast_lessThan_shift_bounds:
  1591 lemma atLeast_lessThan_shift_bounds:
  1543   fixes m n k :: nat
  1592   "F g {m + k..<n + k} = F (g \<circ> plus k) {m..<n}"
  1544   shows "F g {m + k..<n + k} = F (g \<circ> plus k) {m..<n}"
  1593   for m n k :: nat
  1545 proof -
  1594   using atLeast_lessThan_reindex [of "plus k" m n g]
  1546   have "{m + k..<n + k} = plus k ` {m..<n}"
  1595   by (simp add: ac_simps)
  1547     by (auto simp add: image_add_atLeastLessThan [symmetric])
       
  1548   also have "F g (plus k ` {m..<n}) = F (g \<circ> plus k) {m..<n}"
       
  1549     by (rule reindex) simp
       
  1550   finally show ?thesis .
       
  1551 qed
       
  1552 
  1596 
  1553 lemma atLeast_atMost_shift_bounds:
  1597 lemma atLeast_atMost_shift_bounds:
  1554   fixes m n k :: nat
  1598   "F g {m + k..n + k} = F (g \<circ> plus k) {m..n}"
  1555   shows "F g {m + k..n + k} = F (g \<circ> plus k) {m..n}"
  1599   for m n k :: nat
  1556 proof -
  1600   using atLeast_atMost_reindex [of "plus k" m n g]
  1557   have "{m + k..n + k} = plus k ` {m..n}"
  1601   by (simp add: ac_simps)
  1558     by (auto simp del: image_add_atLeastAtMost simp add: image_add_atLeastAtMost [symmetric])
       
  1559   also have "F g (plus k ` {m..n}) = F (g \<circ> plus k) {m..n}"
       
  1560     by (rule reindex) simp
       
  1561   finally show ?thesis .
       
  1562 qed
       
  1563 
  1602 
  1564 lemma atLeast_Suc_lessThan_Suc_shift:
  1603 lemma atLeast_Suc_lessThan_Suc_shift:
  1565   "F g {Suc m..<Suc n} = F (g \<circ> Suc) {m..<n}"
  1604   "F g {Suc m..<Suc n} = F (g \<circ> Suc) {m..<n}"
  1566   using atLeast_lessThan_shift_bounds [of _ _ 1] by simp
  1605   using atLeast_lessThan_shift_bounds [of _ _ 1]
       
  1606   by (simp add: plus_1_eq_Suc)
  1567 
  1607 
  1568 lemma atLeast_Suc_atMost_Suc_shift:
  1608 lemma atLeast_Suc_atMost_Suc_shift:
  1569   "F g {Suc m..Suc n} = F (g \<circ> Suc) {m..n}"
  1609   "F g {Suc m..Suc n} = F (g \<circ> Suc) {m..n}"
  1570   using atLeast_atMost_shift_bounds [of _ _ 1] by simp
  1610   using atLeast_atMost_shift_bounds [of _ _ 1]
       
  1611   by (simp add: plus_1_eq_Suc)
       
  1612 
       
  1613 lemma atLeast_int_lessThan_int_shift:
       
  1614   "F g {int m..<int n} = F (g \<circ> int) {m..<n}"
       
  1615   by (rule atLeast_lessThan_reindex)
       
  1616     (simp add: image_int_atLeast_lessThan)
       
  1617 
       
  1618 lemma atLeast_int_atMost_int_shift:
       
  1619   "F g {int m..int n} = F (g \<circ> int) {m..n}"
       
  1620   by (rule atLeast_atMost_reindex)
       
  1621     (simp add: image_int_atLeast_atMost)
  1571 
  1622 
  1572 lemma atLeast0_lessThan_Suc:
  1623 lemma atLeast0_lessThan_Suc:
  1573   "F g {0..<Suc n} = F g {0..<n} \<^bold>* g n"
  1624   "F g {0..<Suc n} = F g {0..<n} \<^bold>* g n"
  1574   by (simp add: atLeast0_lessThan_Suc ac_simps)
  1625   by (simp add: atLeast0_lessThan_Suc ac_simps)
  1575 
  1626 
  1778 by (simp only: Nat.less_Suc_eq_le lessThan_Suc_atMost)
  1829 by (simp only: Nat.less_Suc_eq_le lessThan_Suc_atMost)
  1779 
  1830 
  1780 lemma nat_diff_sum_reindex: "(\<Sum>i<n. f (n - Suc i)) = (\<Sum>i<n. f i)"
  1831 lemma nat_diff_sum_reindex: "(\<Sum>i<n. f (n - Suc i)) = (\<Sum>i<n. f i)"
  1781   by (rule sum.reindex_bij_witness[where i="\<lambda>i. n - Suc i" and j="\<lambda>i. n - Suc i"]) auto
  1832   by (rule sum.reindex_bij_witness[where i="\<lambda>i. n - Suc i" and j="\<lambda>i. n - Suc i"]) auto
  1782 
  1833 
       
  1834 lemma sum_diff_distrib: "\<forall>x. Q x \<le> P x  \<Longrightarrow> (\<Sum>x<n. P x) - (\<Sum>x<n. Q x) = (\<Sum>x<n. P x - Q x :: nat)"
       
  1835   by (subst sum_subtractf_nat) auto
       
  1836 
  1783 
  1837 
  1784 subsubsection \<open>Shifting bounds\<close>
  1838 subsubsection \<open>Shifting bounds\<close>
  1785 
  1839 
  1786 lemma sum_shift_bounds_nat_ivl:
  1840 lemma sum_shift_bounds_nat_ivl:
  1787   "sum f {m+k..<n+k} = sum (%i. f(i + k)){m..<n::nat}"
  1841   "sum f {m+k..<n+k} = sum (%i. f(i + k)){m..<n::nat}"
  1797 
  1851 
  1798 corollary sum_shift_bounds_Suc_ivl:
  1852 corollary sum_shift_bounds_Suc_ivl:
  1799   "sum f {Suc m..<Suc n} = sum (%i. f(Suc i)){m..<n}"
  1853   "sum f {Suc m..<Suc n} = sum (%i. f(Suc i)){m..<n}"
  1800 by (simp add:sum_shift_bounds_nat_ivl[where k="Suc 0", simplified])
  1854 by (simp add:sum_shift_bounds_nat_ivl[where k="Suc 0", simplified])
  1801 
  1855 
       
  1856 context comm_monoid_add
       
  1857 begin
       
  1858 
       
  1859 context
       
  1860   fixes f :: "nat \<Rightarrow> 'a"
       
  1861   assumes "f 0 = 0"
       
  1862 begin
       
  1863 
       
  1864 lemma sum_shift_lb_Suc0_0_upt:
       
  1865   "sum f {Suc 0..<k} = sum f {0..<k}"
       
  1866 proof (cases k)
       
  1867   case 0
       
  1868   then show ?thesis
       
  1869     by simp
       
  1870 next
       
  1871   case (Suc k)
       
  1872   moreover have "{0..<Suc k} = insert 0 {Suc 0..<Suc k}"
       
  1873     by auto
       
  1874   ultimately show ?thesis
       
  1875     using \<open>f 0 = 0\<close> by simp
       
  1876 qed
       
  1877 
  1802 lemma sum_shift_lb_Suc0_0:
  1878 lemma sum_shift_lb_Suc0_0:
  1803   "f(0::nat) = (0::nat) \<Longrightarrow> sum f {Suc 0..k} = sum f {0..k}"
  1879   "sum f {Suc 0..k} = sum f {0..k}"
  1804 by(simp add:sum_head_Suc)
  1880 proof (cases k)
  1805 
  1881   case 0
  1806 lemma sum_shift_lb_Suc0_0_upt:
  1882   with \<open>f 0 = 0\<close> show ?thesis
  1807   "f(0::nat) = 0 \<Longrightarrow> sum f {Suc 0..<k} = sum f {0..<k}"
  1883     by simp
  1808 apply(cases k)apply simp
  1884 next
  1809 apply(simp add:sum_head_upt_Suc)
  1885   case (Suc k)
  1810 done
  1886   moreover have "{0..Suc k} = insert 0 {Suc 0..Suc k}"
       
  1887     by auto
       
  1888   ultimately show ?thesis
       
  1889     using \<open>f 0 = 0\<close> by simp
       
  1890 qed
       
  1891 
       
  1892 end
       
  1893 
       
  1894 end
  1811 
  1895 
  1812 lemma sum_atMost_Suc_shift:
  1896 lemma sum_atMost_Suc_shift:
  1813   fixes f :: "nat \<Rightarrow> 'a::comm_monoid_add"
  1897   fixes f :: "nat \<Rightarrow> 'a::comm_monoid_add"
  1814   shows "(\<Sum>i\<le>Suc n. f i) = f 0 + (\<Sum>i\<le>n. f (Suc i))"
  1898   shows "(\<Sum>i\<le>Suc n. f i) = f 0 + (\<Sum>i\<le>n. f (Suc i))"
  1815 proof (induct n)
  1899 proof (induct n)
  1890 lemma sum_lessThan_telescope':
  1974 lemma sum_lessThan_telescope':
  1891   "(\<Sum>n<m. f n - f (Suc n) :: 'a :: ab_group_add) = f 0 - f m"
  1975   "(\<Sum>n<m. f n - f (Suc n) :: 'a :: ab_group_add) = f 0 - f m"
  1892   by (induction m) (simp_all add: algebra_simps)
  1976   by (induction m) (simp_all add: algebra_simps)
  1893 
  1977 
  1894 
  1978 
  1895 subsection \<open>The formula for geometric sums\<close>
  1979 subsubsection \<open>The formula for geometric sums\<close>
  1896 
  1980 
  1897 lemma sum_power2: "(\<Sum>i=0..<k. (2::nat)^i) = 2^k-1"
  1981 lemma sum_power2: "(\<Sum>i=0..<k. (2::nat)^i) = 2^k-1"
  1898 by (induction k) (auto simp: mult_2)
  1982 by (induction k) (auto simp: mult_2)
  1899 
  1983 
  1900 lemma geometric_sum:
  1984 lemma geometric_sum:
  1989                 else if x = 1 then of_nat((n + 1) - m)
  2073                 else if x = 1 then of_nat((n + 1) - m)
  1990                 else (x^m - x^Suc n) / (1 - x))"
  2074                 else (x^m - x^Suc n) / (1 - x))"
  1991 using sum_gp_multiplied [of m n x] apply auto
  2075 using sum_gp_multiplied [of m n x] apply auto
  1992 by (metis eq_iff_diff_eq_0 mult.commute nonzero_divide_eq_eq)
  2076 by (metis eq_iff_diff_eq_0 mult.commute nonzero_divide_eq_eq)
  1993 
  2077 
  1994 subsection\<open>Geometric progressions\<close>
  2078 
       
  2079 subsubsection\<open>Geometric progressions\<close>
  1995 
  2080 
  1996 lemma sum_gp0:
  2081 lemma sum_gp0:
  1997   fixes x :: "'a::{comm_ring,division_ring}"
  2082   fixes x :: "'a::{comm_ring,division_ring}"
  1998   shows   "(\<Sum>i\<le>n. x^i) = (if x = 1 then of_nat(n + 1) else (1 - x^Suc n) / (1 - x))"
  2083   shows   "(\<Sum>i\<le>n. x^i) = (if x = 1 then of_nat(n + 1) else (1 - x^Suc n) / (1 - x))"
  1999   using sum_gp_basic[of x n]
  2084   using sum_gp_basic[of x n]
  2014 lemma sum_gp_strict:
  2099 lemma sum_gp_strict:
  2015   fixes x :: "'a::{comm_ring,division_ring}"
  2100   fixes x :: "'a::{comm_ring,division_ring}"
  2016   shows "(\<Sum>i<n. x^i) = (if x = 1 then of_nat n else (1 - x^n) / (1 - x))"
  2101   shows "(\<Sum>i<n. x^i) = (if x = 1 then of_nat n else (1 - x^n) / (1 - x))"
  2017   by (induct n) (auto simp: algebra_simps divide_simps)
  2102   by (induct n) (auto simp: algebra_simps divide_simps)
  2018 
  2103 
  2019 subsubsection \<open>The formula for arithmetic sums\<close>
  2104 
       
  2105 subsubsection \<open>The formulae for arithmetic sums\<close>
       
  2106 
       
  2107 context comm_semiring_1
       
  2108 begin
       
  2109 
       
  2110 lemma double_gauss_sum:
       
  2111   "2 * (\<Sum>i = 0..n. of_nat i) = of_nat n * (of_nat n + 1)"
       
  2112   by (induct n) (simp_all add: sum.atLeast0_atMost_Suc algebra_simps left_add_twice)
       
  2113 
       
  2114 lemma double_gauss_sum_from_Suc_0:
       
  2115   "2 * (\<Sum>i = Suc 0..n. of_nat i) = of_nat n * (of_nat n + 1)"
       
  2116 proof -
       
  2117   have "sum of_nat {Suc 0..n} = sum of_nat (insert 0 {Suc 0..n})"
       
  2118     by simp
       
  2119   also have "\<dots> = sum of_nat {0..n}"
       
  2120     by (cases n) (simp_all add: atLeast0_atMost_Suc_eq_insert_0)
       
  2121   finally show ?thesis
       
  2122     by (simp add: double_gauss_sum)
       
  2123 qed
       
  2124 
       
  2125 lemma double_arith_series:
       
  2126   "2 * (\<Sum>i = 0..n. a + of_nat i * d) = (of_nat n + 1) * (2 * a + of_nat n * d)"
       
  2127 proof -
       
  2128   have "(\<Sum>i = 0..n. a + of_nat i * d) = ((\<Sum>i = 0..n. a) + (\<Sum>i = 0..n. of_nat i * d))"
       
  2129     by (rule sum.distrib)
       
  2130   also have "\<dots> = (of_nat (Suc n) * a + d * (\<Sum>i = 0..n. of_nat i))"
       
  2131     by (simp add: sum_distrib_left algebra_simps)
       
  2132   finally show ?thesis
       
  2133     by (simp add: algebra_simps double_gauss_sum left_add_twice)
       
  2134 qed
       
  2135 
       
  2136 end
       
  2137 
       
  2138 context semiring_parity
       
  2139 begin
  2020 
  2140 
  2021 lemma gauss_sum:
  2141 lemma gauss_sum:
  2022   "(2::'a::comm_semiring_1)*(\<Sum>i\<in>{1..n}. of_nat i) = of_nat n*((of_nat n)+1)"
  2142   "(\<Sum>i = 0..n. of_nat i) = of_nat n * (of_nat n + 1) div 2"
  2023 proof (induct n)
  2143   using double_gauss_sum [of n, symmetric] by simp
       
  2144 
       
  2145 lemma gauss_sum_from_Suc_0:
       
  2146   "(\<Sum>i = Suc 0..n. of_nat i) = of_nat n * (of_nat n + 1) div 2"
       
  2147   using double_gauss_sum_from_Suc_0 [of n, symmetric] by simp
       
  2148 
       
  2149 lemma arith_series:
       
  2150   "(\<Sum>i = 0..n. a + of_nat i * d) = (of_nat n + 1) * (2 * a + of_nat n * d) div 2"
       
  2151   using double_arith_series [of a d n, symmetric] by simp
       
  2152 
       
  2153 end
       
  2154 
       
  2155 lemma gauss_sum_nat:
       
  2156   "\<Sum>{0..n} = (n * Suc n) div 2"
       
  2157   using gauss_sum [of n, where ?'a = nat] by simp
       
  2158 
       
  2159 lemma arith_series_nat:
       
  2160   "(\<Sum>i = 0..n. a + i * d) = Suc n * (2 * a + n * d) div 2"
       
  2161   using arith_series [of a d n] by simp
       
  2162 
       
  2163 lemma Sum_Icc_int:
       
  2164   "\<Sum>{m..n} = (n * (n + 1) - m * (m - 1)) div 2"
       
  2165   if "m \<le> n" for m n :: int
       
  2166 using that proof (induct i \<equiv> "nat (n - m)" arbitrary: m n)
  2024   case 0
  2167   case 0
  2025   show ?case by simp
  2168   then have "m = n"
       
  2169     by arith
       
  2170   then show ?case
       
  2171     by (simp add: algebra_simps mult_2 [symmetric])
  2026 next
  2172 next
  2027   case (Suc n)
  2173   case (Suc i)
  2028   then show ?case
  2174   have 0: "i = nat((n-1) - m)" "m \<le> n-1" using Suc(2,3) by arith+
  2029     by (simp add: algebra_simps add: one_add_one [symmetric] del: one_add_one)
  2175   have "\<Sum> {m..n} = \<Sum> {m..1+(n-1)}" by simp
  2030       (* FIXME: make numeral cancellation simprocs work for semirings *)
  2176   also have "\<dots> = \<Sum> {m..n-1} + n" using \<open>m \<le> n\<close>
  2031 qed
  2177     by(subst atLeastAtMostPlus1_int_conv) simp_all
  2032 
  2178   also have "\<dots> = ((n-1)*(n-1+1) - m*(m-1)) div 2 + n"
  2033 theorem arith_series_general:
  2179     by(simp add: Suc(1)[OF 0])
  2034   "(2::'a::comm_semiring_1) * (\<Sum>i\<in>{..<n}. a + of_nat i * d) =
  2180   also have "\<dots> = ((n-1)*(n-1+1) - m*(m-1) + 2*n) div 2" by simp
  2035   of_nat n * (a + (a + of_nat(n - 1)*d))"
  2181   also have "\<dots> = (n*(n+1) - m*(m-1)) div 2"
  2036 proof cases
  2182     by (simp add: algebra_simps mult_2_right)
  2037   assume ngt1: "n > 1"
  2183   finally show ?case .
  2038   let ?I = "\<lambda>i. of_nat i" and ?n = "of_nat n"
  2184 qed
  2039   have
  2185 
  2040     "(\<Sum>i\<in>{..<n}. a+?I i*d) =
  2186 lemma Sum_Icc_nat:
  2041      ((\<Sum>i\<in>{..<n}. a) + (\<Sum>i\<in>{..<n}. ?I i*d))"
  2187   "\<Sum>{m..n} = (n * (n + 1) - m * (m - 1)) div 2"
  2042     by (rule sum.distrib)
  2188   if "m \<le> n" for m n :: nat
  2043   also from ngt1 have "\<dots> = ?n*a + (\<Sum>i\<in>{..<n}. ?I i*d)" by simp
  2189 proof -
  2044   also from ngt1 have "\<dots> = (?n*a + d*(\<Sum>i\<in>{1..<n}. ?I i))"
  2190   have *: "m * (m - 1) \<le> n * (n + 1)"
  2045     unfolding One_nat_def
  2191     using that by (meson diff_le_self order_trans le_add1 mult_le_mono)
  2046     by (simp add: sum_distrib_left atLeast0LessThan[symmetric] sum_shift_lb_Suc0_0_upt ac_simps)
  2192   have "int (\<Sum>{m..n}) = (\<Sum>{int m..int n})"
  2047   also have "2*\<dots> = 2*?n*a + d*2*(\<Sum>i\<in>{1..<n}. ?I i)"
  2193     by (simp add: sum.atLeast_int_atMost_int_shift)
  2048     by (simp add: algebra_simps)
  2194   also have "\<dots> = (int n * (int n + 1) - int m * (int m - 1)) div 2"
  2049   also from ngt1 have "{1..<n} = {1..n - 1}"
  2195     using that by (simp add: Sum_Icc_int)
  2050     by (cases n) (auto simp: atLeastLessThanSuc_atLeastAtMost)
  2196   also have "\<dots> = int ((n * (n + 1) - m * (m - 1)) div 2)"
  2051   also from ngt1
  2197     using le_square * by (simp add: algebra_simps of_nat_div of_nat_diff)
  2052   have "2*?n*a + d*2*(\<Sum>i\<in>{1..n - 1}. ?I i) = (2*?n*a + d*?I (n - 1)*?I n)"
       
  2053     by (simp only: mult.assoc gauss_sum [of "n - 1"], unfold One_nat_def)
       
  2054       (simp add:  mult.commute trans [OF add.commute of_nat_Suc [symmetric]])
       
  2055   finally show ?thesis
  2198   finally show ?thesis
  2056     unfolding mult_2 by (simp add: algebra_simps)
  2199     by (simp only: of_nat_eq_iff)
  2057 next
  2200 qed
  2058   assume "\<not>(n > 1)"
  2201 
  2059   hence "n = 1 \<or> n = 0" by auto
  2202 lemma Sum_Ico_nat: 
  2060   thus ?thesis by (auto simp: mult_2)
  2203   "\<Sum>{m..<n} = (n * (n - 1) - m * (m - 1)) div 2"
  2061 qed
  2204   if "m \<le> n" for m n :: nat
  2062 
       
  2063 lemma arith_series_nat:
       
  2064   "(2::nat) * (\<Sum>i\<in>{..<n}. a+i*d) = n * (a + (a+(n - 1)*d))"
       
  2065 proof -
  2205 proof -
  2066   have
  2206   from that consider "m < n" | "m = n"
  2067     "2 * (\<Sum>i\<in>{..<n::nat}. a + of_nat(i)*d) =
  2207     by (auto simp add: less_le)
  2068     of_nat(n) * (a + (a + of_nat(n - 1)*d))"
  2208   then show ?thesis proof cases
  2069     by (rule arith_series_general)
  2209     case 1
  2070   thus ?thesis
  2210     then have "{m..<n} = {m..n - 1}"
  2071     unfolding One_nat_def by auto
  2211       by auto
  2072 qed
  2212     then have "\<Sum>{m..<n} = \<Sum>{m..n - 1}"
  2073 
  2213       by simp
  2074 lemma arith_series_int:
  2214     also have "\<dots> = (n * (n - 1) - m * (m - 1)) div 2"
  2075   "2 * (\<Sum>i\<in>{..<n}. a + int i * d) = int n * (a + (a + int(n - 1)*d))"
  2215       using \<open>m < n\<close> by (simp add: Sum_Icc_nat mult.commute)
  2076   by (fact arith_series_general) (* FIXME: duplicate *)
  2216     finally show ?thesis .
  2077 
  2217   next
  2078 lemma sum_diff_distrib: "\<forall>x. Q x \<le> P x  \<Longrightarrow> (\<Sum>x<n. P x) - (\<Sum>x<n. Q x) = (\<Sum>x<n. P x - Q x :: nat)"
  2218     case 2
  2079   by (subst sum_subtractf_nat) auto
  2219     then show ?thesis
       
  2220       by simp
       
  2221   qed
       
  2222 qed
  2080 
  2223 
  2081 
  2224 
  2082 subsubsection \<open>Division remainder\<close>
  2225 subsubsection \<open>Division remainder\<close>
  2083 
  2226 
  2084 lemma range_mod:
  2227 lemma range_mod: