1(* ------------------------------------------------------------------------- *) 2(* Leibniz Harmonic Triangle *) 3(* ------------------------------------------------------------------------- *) 4 5(*===========================================================================*) 6 7(* add all dependent libraries for script *) 8open HolKernel boolLib bossLib Parse; 9 10(* declare new theory at start *) 11val _ = new_theory "triangle"; 12 13(* ------------------------------------------------------------------------- *) 14 15 16(* val _ = load "jcLib"; *) 17open jcLib; 18 19(* val _ = load "SatisfySimps"; (* for SatisfySimps.SATISFY_ss *) *) 20 21(* Get dependent theories local *) 22 23(* Get dependent theories local *) 24 25(* Get dependent theories in lib *) 26(* val _ = load "EulerTheory"; *) 27open EulerTheory; (* for upto_by_count *) 28(* (* val _ = load "helperFunctionTheory"; -- in EulerTheory *) *) 29(* (* val _ = load "helperNumTheory"; -- in helperFunctionTheory *) *) 30(* (* val _ = load "helperSetTheory"; -- in helperFunctionTheory *) *) 31open helperNumTheory helperSetTheory helperFunctionTheory; 32 33(* val _ = load "helperListTheory"; *) 34open helperListTheory; 35 36(* open dependent theories *) 37open arithmeticTheory; 38open pred_setTheory; 39open listTheory; 40 41(* open dependent theories *) 42(* (* val _ = load "dividesTheory"; -- in helperNumTheory *) *) 43(* (* val _ = load "gcdTheory"; -- in helperNumTheory *) *) 44open dividesTheory gcdTheory; 45 46(* val _ = load "binomialTheory"; *) 47open binomialTheory; 48 49(* use listRange: [1 .. 3] = [1; 2; 3], [1 ..< 3] = [1; 2] *) 50(* val _ = load "listRangeTheory"; *) 51open listRangeTheory; 52open rich_listTheory; (* for EVERY_REVERSE *) 53open relationTheory; (* for RTC *) 54 55 56(* ------------------------------------------------------------------------- *) 57(* Leibniz Harmonic Triangle Documentation *) 58(* ------------------------------------------------------------------------- *) 59(* Type: (# are temp) 60 triple = <| a: num; b: num; c: num |> 61# path = :num list 62 Overloading: 63 leibniz_vertical n = [1 .. (n+1)] 64 leibniz_up n = REVERSE (leibniz_vertical n) 65 leibniz_horizontal n = GENLIST (leibniz n) (n + 1) 66 binomial_horizontal n = GENLIST (binomial n) (n + 1) 67# ta = (triplet n k).a 68# tb = (triplet n k).b 69# tc = (triplet n k).c 70 p1 zigzag p2 = leibniz_zigzag p1 p2 71 p1 wriggle p2 = RTC leibniz_zigzag p1 p2 72 leibniz_col_arm a b n = MAP (\x. leibniz (a - x) b) [0 ..< n] 73 leibniz_seg_arm a b n = MAP (\x. leibniz a (b + x)) [0 ..< n] 74 75 leibniz_seg n k h = IMAGE (\j. leibniz n (k + j)) (count h) 76 leibniz_row n h = IMAGE (leibniz n) (count h) 77 leibniz_col h = IMAGE (\i. leibniz i 0) (count h) 78 lcm_run n = list_lcm [1 .. n] 79# beta n k = k * binomial n k 80# beta_horizontal n = GENLIST (beta n o SUC) n 81*) 82(* Definitions and Theorems (# are exported): 83 84 Helper Theorems: 85 RTC_TRANS |- R^* x y /\ R^* y z ==> R^* x z 86 87 Leibniz Triangle (Denominator form): 88# leibniz_def |- !n k. leibniz n k = (n + 1) * binomial n k 89 leibniz_0_n |- !n. leibniz 0 n = if n = 0 then 1 else 0 90 leibniz_n_0 |- !n. leibniz n 0 = n + 1 91 leibniz_n_n |- !n. leibniz n n = n + 1 92 leibniz_less_0 |- !n k. n < k ==> (leibniz n k = 0) 93 leibniz_sym |- !n k. k <= n ==> (leibniz n k = leibniz n (n - k)) 94 leibniz_monotone |- !n k. k < HALF n ==> leibniz n k < leibniz n (k + 1) 95 leibniz_pos |- !n k. k <= n ==> 0 < leibniz n k 96 leibniz_eq_0 |- !n k. (leibniz n k = 0) <=> n < k 97 leibniz_alt |- !n. leibniz n = (\j. (n + 1) * j) o binomial n 98 leibniz_def_alt |- !n k. leibniz n k = (\j. (n + 1) * j) (binomial n k) 99 leibniz_up_eqn |- !n. 0 < n ==> !k. (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k 100 leibniz_up |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1) 101 leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k 102 leibniz_right_eqn |- !n. 0 < n ==> !k. (k + 1) * leibniz n (k + 1) = (n - k) * leibniz n k 103 leibniz_right |- !n. 0 < n ==> !k. leibniz n (k + 1) = (n - k) * leibniz n k DIV (k + 1) 104 leibniz_property |- !n. 0 < n ==> !k. leibniz n k * leibniz (n - 1) k = 105 leibniz n (k + 1) * (leibniz n k - leibniz (n - 1) k) 106 leibniz_formula |- !n k. k <= n ==> (leibniz n k = (n + 1) * FACT n DIV (FACT k * FACT (n - k))) 107 leibniz_recurrence |- !n. 0 < n ==> !k. k < n ==> (leibniz n (k + 1) = leibniz n k * 108 leibniz (n - 1) k DIV (leibniz n k - leibniz (n - 1) k)) 109 leibniz_n_k |- !n k. 0 < k /\ k <= n ==> (leibniz n k = 110 leibniz n (k - 1) * leibniz (n - 1) (k - 1) 111 DIV (leibniz n (k - 1) - leibniz (n - 1) (k - 1))) 112 leibniz_lcm_exchange |- !n. 0 < n ==> !k. lcm (leibniz n k) (leibniz (n - 1) k) = 113 lcm (leibniz n k) (leibniz n (k + 1)) 114 leibniz_middle_lower |- !n. 4 ** n <= leibniz (TWICE n) n 115 116 LCM of a list of numbers: 117# list_lcm_def |- (list_lcm [] = 1) /\ !h t. list_lcm (h::t) = lcm h (list_lcm t) 118 list_lcm_nil |- list_lcm [] = 1 119 list_lcm_cons |- !h t. list_lcm (h::t) = lcm h (list_lcm t) 120 list_lcm_sing |- !x. list_lcm [x] = x 121 list_lcm_snoc |- !x l. list_lcm (SNOC x l) = lcm x (list_lcm l) 122 list_lcm_map_times |- !n l. list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l 123 list_lcm_pos |- !l. EVERY_POSITIVE l ==> 0 < list_lcm l 124 list_lcm_pos_alt |- !l. POSITIVE l ==> 0 < list_lcm l 125 list_lcm_lower_bound |- !l. EVERY_POSITIVE l ==> SUM l <= LENGTH l * list_lcm l 126 list_lcm_lower_bound_alt |- !l. POSITIVE l ==> SUM l <= LENGTH l * list_lcm l 127 list_lcm_is_common_multiple |- !x l. MEM x l ==> x divides (list_lcm l) 128 list_lcm_is_least_common_multiple |- !l m. (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m 129 list_lcm_append |- !l1 l2. list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2) 130 list_lcm_append_3 |- !l1 l2 l3. list_lcm (l1 ++ l2 ++ l3) = list_lcm [list_lcm l1; list_lcm l2; list_lcm l3] 131 list_lcm_reverse |- !l. list_lcm (REVERSE l) = list_lcm l 132 list_lcm_suc |- !n. list_lcm [1 .. n + 1] = lcm (n + 1) (list_lcm [1 .. n]) 133 list_lcm_nonempty_lower |- !l. l <> [] /\ EVERY_POSITIVE l ==> SUM l DIV LENGTH l <= list_lcm l 134 list_lcm_nonempty_lower_alt |- !l. l <> [] /\ POSITIVE l ==> SUM l DIV LENGTH l <= list_lcm l 135 list_lcm_divisor_lcm_pair |- !l x y. MEM x l /\ MEM y l ==> lcm x y divides list_lcm l 136 list_lcm_lower_by_lcm_pair |- !l x y. POSITIVE l /\ MEM x l /\ MEM y l ==> lcm x y <= list_lcm l 137 list_lcm_upper_by_common_multiple 138 |- !l m. 0 < m /\ (!x. MEM x l ==> x divides m) ==> list_lcm l <= m 139 list_lcm_by_FOLDR |- !ls. list_lcm ls = FOLDR lcm 1 ls 140 list_lcm_by_FOLDL |- !ls. list_lcm ls = FOLDL lcm 1 ls 141 142 Lists in Leibniz Triangle: 143 144 Veritcal Lists in Leibniz Triangle 145 leibniz_vertical_alt |- !n. leibniz_vertical n = GENLIST (\i. 1 + i) (n + 1) 146 leibniz_vertical_0 |- leibniz_vertical 0 = [1] 147 leibniz_vertical_len |- !n. LENGTH (leibniz_vertical n) = n + 1 148 leibniz_vertical_not_nil |- !n. leibniz_vertical n <> [] 149 leibniz_vertical_pos |- !n. EVERY_POSITIVE (leibniz_vertical n) 150 leibniz_vertical_pos_alt |- !n. POSITIVE (leibniz_vertical n) 151 leibniz_vertical_mem |- !n x. 0 < x /\ x <= n + 1 <=> MEM x (leibniz_vertical n) 152 leibniz_vertical_snoc |- !n. leibniz_vertical (n + 1) = SNOC (n + 2) (leibniz_vertical n) 153 154 leibniz_up_0 |- leibniz_up 0 = [1] 155 leibniz_up_len |- !n. LENGTH (leibniz_up n) = n + 1 156 leibniz_up_pos |- !n. EVERY_POSITIVE (leibniz_up n) 157 leibniz_up_mem |- !n x. 0 < x /\ x <= n + 1 <=> MEM x (leibniz_up n) 158 leibniz_up_cons |- !n. leibniz_up (n + 1) = n + 2::leibniz_up n 159 160 leibniz_horizontal_0 |- leibniz_horizontal 0 = [1] 161 leibniz_horizontal_len |- !n. LENGTH (leibniz_horizontal n) = n + 1 162 leibniz_horizontal_el |- !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k) 163 leibniz_horizontal_mem |- !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n) 164 leibniz_horizontal_mem_iff |- !n k. MEM (leibniz n k) (leibniz_horizontal n) <=> k <= n 165 leibniz_horizontal_member |- !n x. MEM x (leibniz_horizontal n) <=> ?k. k <= n /\ (x = leibniz n k) 166 leibniz_horizontal_element |- !n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k) 167 leibniz_horizontal_head |- !n. TAKE 1 (leibniz_horizontal (n + 1)) = [n + 2] 168 leibniz_horizontal_divisor|- !n k. k <= n ==> leibniz n k divides list_lcm (leibniz_horizontal n) 169 leibniz_horizontal_pos |- !n. EVERY_POSITIVE (leibniz_horizontal n) 170 leibniz_horizontal_pos_alt|- !n. POSITIVE (leibniz_horizontal n) 171 leibniz_horizontal_alt |- !n. leibniz_horizontal n = MAP (\j. (n + 1) * j) (binomial_horizontal n) 172 leibniz_horizontal_lcm_alt|- !n. list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n) 173 leibniz_horizontal_sum |- !n. SUM (leibniz_horizontal n) = (n + 1) * SUM (binomial_horizontal n) 174 leibniz_horizontal_sum_eqn |- !n. SUM (leibniz_horizontal n) = (n + 1) * 2 ** n: 175 leibniz_horizontal_average |- !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 176 SUM (binomial_horizontal n) 177 leibniz_horizontal_average_eqn |- !n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 2 ** n 178 179 Using Triplet and Paths: 180 triplet_def |- !n k. triplet n k = 181 <|a := leibniz n k; 182 b := leibniz (n + 1) k; 183 c := leibniz (n + 1) (k + 1) 184 |> 185 leibniz_triplet_member |- !n k. (ta = leibniz n k) /\ 186 (tb = leibniz (n + 1) k) /\ (tc = leibniz (n + 1) (k + 1)) 187 leibniz_right_entry |- !n k. (k + 1) * tc = (n + 1 - k) * tb 188 leibniz_up_entry |- !n k. (n + 2) * ta = (n + 1 - k) * tb 189 leibniz_triplet_property |- !n k. ta * tb = tc * (tb - ta) 190 leibniz_triplet_lcm |- !n k. lcm tb ta = lcm tb tc 191 192 Zigzag Path in Leibniz Triangle: 193 leibniz_zigzag_def |- !p1 p2. p1 zigzag p2 <=> 194 ?n k x y. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y) 195 list_lcm_zigzag |- !p1 p2. p1 zigzag p2 ==> (list_lcm p1 = list_lcm p2) 196 leibniz_zigzag_tail |- !p1 p2. p1 zigzag p2 ==> !x. [x] ++ p1 zigzag [x] ++ p2 197 leibniz_horizontal_zigzag |- !n k. k <= n ==> 198 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) zigzag 199 TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n) 200 leibniz_triplet_0 |- leibniz_up 1 zigzag leibniz_horizontal 1 201 202 Wriggle Paths in Leibniz Triangle: 203 list_lcm_wriggle |- !p1 p2. p1 wriggle p2 ==> (list_lcm p1 = list_lcm p2) 204 leibniz_zigzag_wriggle |- !p1 p2. p1 zigzag p2 ==> p1 wriggle p2 205 leibniz_wriggle_tail |- !p1 p2. p1 wriggle p2 ==> !x. [x] ++ p1 wriggle [x] ++ p2 206 leibniz_wriggle_refl |- !p1. p1 wriggle p1 207 leibniz_wriggle_trans |- !p1 p2 p3. p1 wriggle p2 /\ p2 wriggle p3 ==> p1 wriggle p3 208 leibniz_horizontal_wriggle_step |- !n k. k <= n + 1 ==> 209 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle leibniz_horizontal (n + 1) 210 leibniz_horizontal_wriggle |- !n. [leibniz (n + 1) 0] ++ leibniz_horizontal n wriggle leibniz_horizontal (n + 1) 211 212 Path Transform keeping LCM: 213 leibniz_up_wriggle_horizontal |- !n. leibniz_up n wriggle leibniz_horizontal n 214 leibniz_lcm_property |- !n. list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n) 215 leibniz_vertical_divisor |- !n k. k <= n ==> leibniz n k divides list_lcm (leibniz_vertical n) 216 217 Lower Bound of Leibniz LCM: 218 leibniz_horizontal_lcm_lower |- !n. 2 ** n <= list_lcm (leibniz_horizontal n) 219 leibniz_vertical_lcm_lower |- !n. 2 ** n <= list_lcm (leibniz_vertical n) 220 lcm_lower_bound |- !n. 2 ** n <= list_lcm [1 .. (n + 1)] 221 222 Leibniz LCM Invariance: 223 leibniz_col_arm_0 |- !a b. leibniz_col_arm a b 0 = [] 224 leibniz_seg_arm_0 |- !a b. leibniz_seg_arm a b 0 = [] 225 leibniz_col_arm_1 |- !a b. leibniz_col_arm a b 1 = [leibniz a b] 226 leibniz_seg_arm_1 |- !a b. leibniz_seg_arm a b 1 = [leibniz a b] 227 leibniz_col_arm_len |- !a b n. LENGTH (leibniz_col_arm a b n) = n 228 leibniz_seg_arm_len |- !a b n. LENGTH (leibniz_seg_arm a b n) = n 229 leibniz_col_arm_el |- !n k. k < n ==> !a b. EL k (leibniz_col_arm a b n) = leibniz (a - k) b 230 leibniz_seg_arm_el |- !n k. k < n ==> !a b. EL k (leibniz_seg_arm a b n) = leibniz a (b + k) 231 leibniz_seg_arm_head |- !a b n. TAKE 1 (leibniz_seg_arm a b (n + 1)) = [leibniz a b] 232 leibniz_col_arm_cons |- !a b n. leibniz_col_arm (a + 1) b (n + 1) = leibniz (a + 1) b::leibniz_col_arm a b n 233 234 leibniz_seg_arm_zigzag_step |- !n k. k < n ==> !a b. 235 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) zigzag 236 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n) 237 leibniz_seg_arm_wriggle_step |- !n k. k < n + 1 ==> !a b. 238 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle 239 leibniz_seg_arm (a + 1) b (n + 1) 240 leibniz_seg_arm_wriggle_row_arm |- !a b n. [leibniz (a + 1) b] ++ leibniz_seg_arm a b n wriggle 241 leibniz_seg_arm (a + 1) b (n + 1) 242 leibniz_col_arm_wriggle_row_arm |- !a b n. b <= a /\ n <= a + 1 - b ==> 243 leibniz_col_arm a b n wriggle leibniz_seg_arm a b n 244 leibniz_lcm_invariance |- !a b n. b <= a /\ n <= a + 1 - b ==> 245 (list_lcm (leibniz_col_arm a b n) = list_lcm (leibniz_seg_arm a b n)) 246 leibniz_col_arm_n_0 |- !n. leibniz_col_arm n 0 (n + 1) = leibniz_up n 247 leibniz_seg_arm_n_0 |- !n. leibniz_seg_arm n 0 (n + 1) = leibniz_horizontal n 248 leibniz_up_wriggle_horizontal_alt |- !n. leibniz_up n wriggle leibniz_horizontal n 249 leibniz_up_lcm_eq_horizontal_lcm |- !n. list_lcm (leibniz_up n) = list_lcm (leibniz_horizontal n) 250 251 Set GCD as Big Operator: 252 big_gcd_def |- !s. big_gcd s = ITSET gcd s 0 253 big_gcd_empty |- big_gcd {} = 0 254 big_gcd_sing |- !x. big_gcd {x} = x 255 big_gcd_reduction |- !s x. FINITE s /\ x NOTIN s ==> (big_gcd (x INSERT s) = gcd x (big_gcd s)) 256 big_gcd_is_common_divisor |- !s. FINITE s ==> !x. x IN s ==> big_gcd s divides x 257 big_gcd_is_greatest_common_divisor 258 |- !s. FINITE s ==> !m. (!x. x IN s ==> m divides x) ==> m divides big_gcd s 259 big_gcd_insert |- !s. FINITE s ==> !x. big_gcd (x INSERT s) = gcd x (big_gcd s) 260 big_gcd_two |- !x y. big_gcd {x; y} = gcd x y 261 big_gcd_positive |- !s. FINITE s /\ s <> {} /\ (!x. x IN s ==> 0 < x) ==> 0 < big_gcd s 262 big_gcd_map_times |- !s. FINITE s /\ s <> {} ==> !k. big_gcd (IMAGE ($* k) s) = k * big_gcd s 263 264 Set LCM as Big Operator: 265 big_lcm_def |- !s. big_lcm s = ITSET lcm s 1 266 big_lcm_empty |- big_lcm {} = 1 267 big_lcm_sing |- !x. big_lcm {x} = x 268 big_lcm_reduction |- !s x. FINITE s /\ x NOTIN s ==> (big_lcm (x INSERT s) = lcm x (big_lcm s)) 269 big_lcm_is_common_multiple |- !s. FINITE s ==> !x. x IN s ==> x divides big_lcm s 270 big_lcm_is_least_common_multiple 271 |- !s. FINITE s ==> !m. (!x. x IN s ==> x divides m) ==> big_lcm s divides m 272 big_lcm_insert |- !s. FINITE s ==> !x. big_lcm (x INSERT s) = lcm x (big_lcm s) 273 big_lcm_two |- !x y. big_lcm {x; y} = lcm x y 274 big_lcm_positive |- !s. FINITE s ==> (!x. x IN s ==> 0 < x) ==> 0 < big_lcm s 275 big_lcm_map_times |- !s. FINITE s /\ s <> {} ==> !k. big_lcm (IMAGE ($* k) s) = k * big_lcm s 276 277 LCM Lower bound using big LCM: 278 leibniz_seg_def |- !n k h. leibniz_seg n k h = {leibniz n (k + j) | j IN count h} 279 leibniz_row_def |- !n h. leibniz_row n h = {leibniz n j | j IN count h} 280 leibniz_col_def |- !h. leibniz_col h = {leibniz j 0 | j IN count h} 281 leibniz_col_eq_natural |- !n. leibniz_col n = natural n 282 big_lcm_seg_transform |- !n k h. lcm (leibniz (n + 1) k) (big_lcm (leibniz_seg n k h)) = 283 big_lcm (leibniz_seg (n + 1) k (h + 1)) 284 big_lcm_row_transform |- !n h. lcm (leibniz (n + 1) 0) (big_lcm (leibniz_row n h)) = 285 big_lcm (leibniz_row (n + 1) (h + 1)) 286 big_lcm_corner_transform |- !n. big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1)) 287 big_lcm_count_lower_bound |- !f n. (!x. x IN count (n + 1) ==> 0 < f x) ==> 288 SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1))) 289 big_lcm_natural_eqn |- !n. big_lcm (natural (n + 1)) = 290 (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) 291 big_lcm_lower_bound |- !n. 2 ** n <= big_lcm (natural (n + 1)) 292 big_lcm_eq_list_lcm |- !l. big_lcm (set l) = list_lcm l 293 294 List LCM depends only on its set of elements: 295 list_lcm_absorption |- !x l. MEM x l ==> (list_lcm (x::l) = list_lcm l) 296 list_lcm_nub |- !l. list_lcm (nub l) = list_lcm l 297 list_lcm_nub_eq_if_set_eq |- !l1 l2. (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2)) 298 list_lcm_eq_if_set_eq |- !l1 l2. (set l1 = set l2) ==> (list_lcm l1 = list_lcm l2) 299 300 Set LCM by List LCM: 301 set_lcm_def |- !s. set_lcm s = list_lcm (SET_TO_LIST s) 302 set_lcm_empty |- set_lcm {} = 1 303 set_lcm_nonempty |- !s. FINITE s /\ s <> {} ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s))) 304 set_lcm_sing |- !x. set_lcm {x} = x 305 set_lcm_eq_list_lcm |- !l. set_lcm (set l) = list_lcm l 306 set_lcm_eq_big_lcm |- !s. FINITE s ==> (set_lcm s = big_lcm s) 307 set_lcm_insert |- !s. FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm s) 308 set_lcm_is_common_multiple |- !x s. FINITE s /\ x IN s ==> x divides set_lcm s 309 set_lcm_is_least_common_multiple |- !s m. FINITE s /\ (!x. x IN s ==> x divides m) ==> set_lcm s divides m 310 pairwise_coprime_prod_set_eq_set_lcm 311 |- !s. FINITE s /\ PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s) 312 pairwise_coprime_prod_set_divides 313 |- !s m. FINITE s /\ PAIRWISE_COPRIME s /\ 314 (!x. x IN s ==> x divides m) ==> PROD_SET s divides m 315 316 Nair's Trick (direct): 317 lcm_run_by_FOLDL |- !n. lcm_run n = FOLDL lcm 1 [1 .. n] 318 lcm_run_by_FOLDR |- !n. lcm_run n = FOLDR lcm 1 [1 .. n] 319 lcm_run_0 |- lcm_run 0 = 1 320 lcm_run_1 |- lcm_run 1 = 1 321 lcm_run_suc |- !n. lcm_run (n + 1) = lcm (n + 1) (lcm_run n) 322 lcm_run_pos |- !n. 0 < lcm_run n 323 lcm_run_small |- (lcm_run 2 = 2) /\ (lcm_run 3 = 6) /\ (lcm_run 4 = 12) /\ 324 (lcm_run 5 = 60) /\ (lcm_run 6 = 60) /\ (lcm_run 7 = 420) /\ 325 (lcm_run 8 = 840) /\ (lcm_run 9 = 2520) 326 lcm_run_divisors |- !n. n + 1 divides lcm_run (n + 1) /\ lcm_run n divides lcm_run (n + 1) 327 lcm_run_monotone |- !n. lcm_run n <= lcm_run (n + 1) 328 lcm_run_lower |- !n. 2 ** n <= lcm_run (n + 1) 329 lcm_run_leibniz_divisor |- !n k. k <= n ==> leibniz n k divides lcm_run (n + 1) 330 lcm_run_lower_odd |- !n. n * 4 ** n <= lcm_run (TWICE n + 1) 331 lcm_run_lower_even |- !n. n * 4 ** n <= lcm_run (TWICE (n + 1)) 332 lcm_run_lower_better |- !n. 7 <= n ==> 2 ** n <= lcm_run n 333 334 lcm_run_odd_lower |- !n. ODD n ==> HALF n * HALF (2 ** n) <= lcm_run n 335 lcm_run_even_lower |- !n. EVEN n ==> HALF (n - 2) * HALF (HALF (2 ** n)) <= lcm_run n 336 lcm_run_odd_lower_alt |- !n. ODD n /\ 5 <= n ==> 2 ** n <= lcm_run n 337 lcm_run_even_lower_alt |- !n. EVEN n /\ 8 <= n ==> 2 ** n <= lcm_run n 338 lcm_run_lower_better |- !n. 7 <= n ==> 2 ** n <= lcm_run n 339 340 Nair's Trick (rework): 341 lcm_run_odd_factor |- !n. 0 < n ==> n * leibniz (TWICE n) n divides lcm_run (TWICE n + 1) 342 lcm_run_lower_odd |- !n. n * 4 ** n <= lcm_run (TWICE n + 1) 343 lcm_run_lower_odd_iff |- !n. ODD n ==> (2 ** n <= lcm_run n <=> 5 <= n) 344 lcm_run_lower_even_iff |- !n. EVEN n ==> (2 ** n <= lcm_run n <=> (n = 0) \/ 8 <= n) 345 lcm_run_lower_better_iff |- !n. 2 ** n <= lcm_run n <=> (n = 0) \/ (n = 5) \/ 7 <= n 346 347 Nair's Trick (consecutive): 348 lcm_upto_def |- (lcm_upto 0 = 1) /\ !n. lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n) 349 lcm_upto_0 |- lcm_upto 0 = 1 350 lcm_upto_SUC |- !n. lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n) 351 lcm_upto_alt |- (lcm_upto 0 = 1) /\ !n. lcm_upto (n + 1) = lcm (n + 1) (lcm_upto n) 352 lcm_upto_1 |- lcm_upto 1 = 1 353 lcm_upto_small |- (lcm_upto 2 = 2) /\ (lcm_upto 3 = 6) /\ (lcm_upto 4 = 12) /\ 354 (lcm_upto 5 = 60) /\ (lcm_upto 6 = 60) /\ (lcm_upto 7 = 420) /\ 355 (lcm_upto 8 = 840) /\ (lcm_upto 9 = 2520) /\ (lcm_upto 10 = 2520) 356 lcm_upto_eq_list_lcm |- !n. lcm_upto n = list_lcm [1 .. n] 357 lcm_upto_lower |- !n. 2 ** n <= lcm_upto (n + 1) 358 lcm_upto_divisors |- !n. n + 1 divides lcm_upto (n + 1) /\ lcm_upto n divides lcm_upto (n + 1) 359 lcm_upto_monotone |- !n. lcm_upto n <= lcm_upto (n + 1) 360 lcm_upto_leibniz_divisor |- !n k. k <= n ==> leibniz n k divides lcm_upto (n + 1) 361 lcm_upto_lower_odd |- !n. n * 4 ** n <= lcm_upto (TWICE n + 1) 362 lcm_upto_lower_even |- !n. n * 4 ** n <= lcm_upto (TWICE (n + 1)) 363 lcm_upto_lower_better |- !n. 7 <= n ==> 2 ** n <= lcm_upto n 364 365 Simple LCM lower bounds: 366 lcm_run_lower_simple |- !n. HALF (n + 1) <= lcm_run n 367 lcm_run_alt |- !n. lcm_run n = lcm_run (n - 1 + 1) 368 lcm_run_lower_good |- !n. 2 ** (n - 1) <= lcm_run n 369 370 Upper Bound by Leibniz Triangle: 371 leibniz_eqn |- !n k. leibniz n k = (n + 1 - k) * binomial (n + 1) k 372 leibniz_right_alt |- !n k. leibniz n (k + 1) = (n - k) * binomial (n + 1) (k + 1) 373 leibniz_binomial_identity |- !m n k. k <= m /\ m <= n ==> 374 (leibniz n k * binomial (n - k) (m - k) = leibniz m k * binomial (n + 1) (m + 1)) 375 leibniz_divides_leibniz_factor |- !m n k. k <= m /\ m <= n ==> 376 leibniz n k divides leibniz m k * binomial (n + 1) (m + 1) 377 leibniz_horizontal_member_divides |- !m n x. n <= TWICE m + 1 /\ m <= n /\ 378 MEM x (leibniz_horizontal n) ==> 379 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) 380 lcm_run_divides_property |- !m n. n <= TWICE m /\ m <= n ==> 381 lcm_run n divides lcm_run m * binomial n m 382 lcm_run_bound_recurrence |- !m n. n <= TWICE m /\ m <= n ==> lcm_run n <= lcm_run m * binomial n m 383 lcm_run_upper_bound |- !n. lcm_run n <= 4 ** n 384 385 Beta Triangle: 386 beta_0_n |- !n. beta 0 n = 0 387 beta_n_0 |- !n. beta n 0 = 0 388 beta_less_0 |- !n k. n < k ==> (beta n k = 0) 389 beta_eqn |- !n k. beta (n + 1) (k + 1) = leibniz n k 390 beta_alt |- !n k. 0 < n /\ 0 < k ==> (beta n k = leibniz (n - 1) (k - 1)) 391 beta_pos |- !n k. 0 < k /\ k <= n ==> 0 < beta n k 392 beta_eq_0 |- !n k. (beta n k = 0) <=> (k = 0) \/ n < k 393 beta_sym |- !n k. k <= n ==> (beta n k = beta n (n - k + 1)) 394 395 Beta Horizontal List: 396 beta_horizontal_0 |- beta_horizontal 0 = [] 397 beta_horizontal_len |- !n. LENGTH (beta_horizontal n) = n 398 beta_horizontal_eqn |- !n. beta_horizontal (n + 1) = leibniz_horizontal n 399 beta_horizontal_alt |- !n. 0 < n ==> (beta_horizontal n = leibniz_horizontal (n - 1)) 400 beta_horizontal_mem |- !n k. 0 < k /\ k <= n ==> MEM (beta n k) (beta_horizontal n) 401 beta_horizontal_mem_iff |- !n k. MEM (beta n k) (beta_horizontal n) <=> 0 < k /\ k <= n 402 beta_horizontal_member |- !n x. MEM x (beta_horizontal n) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k) 403 beta_horizontal_element |- !n k. k < n ==> (EL k (beta_horizontal n) = beta n (k + 1)) 404 lcm_run_by_beta_horizontal |- !n. 0 < n ==> (lcm_run n = list_lcm (beta_horizontal n)) 405 lcm_run_beta_divisor |- !n k. 0 < k /\ k <= n ==> beta n k divides lcm_run n 406 beta_divides_beta_factor |- !m n k. k <= m /\ m <= n ==> beta n k divides beta m k * binomial n m 407 lcm_run_divides_property_alt |- !m n. n <= TWICE m /\ m <= n ==> lcm_run n divides binomial n m * lcm_run m 408 lcm_run_upper_bound |- !n. lcm_run n <= 4 ** n 409 410 LCM Lower Bound using Maximum: 411 list_lcm_ge_max |- !l. POSITIVE l ==> MAX_LIST l <= list_lcm l 412 lcm_lower_bound_by_list_lcm |- !n. (n + 1) * binomial n (HALF n) <= list_lcm [1 .. (n + 1)] 413 big_lcm_ge_max |- !s. FINITE s /\ (!x. x IN s ==> 0 < x) ==> MAX_SET s <= big_lcm s 414 lcm_lower_bound_by_big_lcm |- !n. (n + 1) * binomial n (HALF n) <= big_lcm (natural (n + 1)) 415 416 Consecutive LCM function: 417 lcm_lower_bound_by_list_lcm_stirling |- Stirling /\ (!n c. n DIV SQRT (c * (n - 1)) = SQRT (n DIV c)) ==> 418 !n. ODD n ==> SQRT (n DIV (2 * pi)) * 2 ** n <= list_lcm [1 .. n] 419 big_lcm_non_decreasing |- !n. big_lcm (natural n) <= big_lcm (natural (n + 1)) 420 lcm_lower_bound_by_big_lcm_stirling |- Stirling /\ (!n c. n DIV SQRT (c * (n - 1)) = SQRT (n DIV c)) ==> 421 !n. ODD n ==> SQRT (n DIV (2 * pi)) * 2 ** n <= big_lcm (natural n) 422 423 Extra Theorems: 424 gcd_prime_product_property |- !p m n. prime p /\ m divides n /\ ~(p * m divides n) ==> (gcd (p * m) n = m) 425 lcm_prime_product_property |- !p m n. prime p /\ m divides n /\ ~(p * m divides n) ==> (lcm (p * m) n = p * n) 426 list_lcm_prime_factor |- !p l. prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l) 427 list_lcm_prime_factor_member |- !p l. prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x 428 429*) 430 431(* ------------------------------------------------------------------------- *) 432(* Leibniz Harmonic Triangle *) 433(* ------------------------------------------------------------------------- *) 434 435(* 436 437Leibniz Harmonic Triangle (fraction form) 438 439 c <= r 440r = 1 1 441r = 2 1/2 1/2 442r = 3 1/3 1/6 1/3 443r = 4 1/4 1/12 1/12 1/4 444r = 5 1/5 1/10 1/20 1/10 1/5 445 446In general, L(r,1) = 1/r, L(r,c) = |L(r-1,c-1) - L(r,c-1)| 447 448Solving, L(r,c) = 1/(r C(r-1,c-1)) = 1/(c C(r,c)) 449where C(n,m) is the binomial coefficient of Pascal Triangle. 450 451c = 1 are the 1/(1 * natural numbers 452c = 2 are the 1/(2 * triangular numbers) 453c = 3 are the 1/(3 * tetrahedral numbers) 454 455Sum of denominators of n-th row = n 2**(n-1). 456 457Note that L(r,c) = Integral(0,1) x ** (c-1) * (1-x) ** (r-c) dx 458 459Another form: L(n,1) = 1/n, L(n,k) = L(n-1,k-1) - L(n,k-1) 460Solving, L(n,k) = 1/ k C(n,k) = 1/ n C(n-1,k-1) 461 462Still another notation H(n,r) = 1/ (n+1)C(n,r) = (n-r)!r!/(n+1)! for 0 <= r <= n 463 464Harmonic Denominator Number Triangle (integer form) 465g(d,n) = 1/H(d,n) where H(d,h) is the Leibniz Harmonic Triangle 466g(d,n) = (n+d)C(d,n) where C(d,h) is the Pascal's Triangle. 467g(d,n) = n(n+1)...(n+d)/d! 468 469(k+1)-th row of Pascal's triangle: x^4 + 4x^3 + 6x^2 + 4x + 1 470Perform differentiation, d/dx -> 4x^3 + 12x^2 + 12x + 4 471which is k-th row of Harmonic Denominator Number Triangle. 472 473(k+1)-th row of Pascal's triangle: (x+1)^(k+1) 474k-th row of Harmonic Denominator Number Triangle: d/dx[(x+1)^(k+1)] 475 476 d/dx[(x+1)^(k+1)] 477= d/dx[SUM C(k+1,j) x^j] j = 0...(k+1) 478= SUM C(k+1,j) d/dx[x^j] 479= SUM C(k+1,j) j x^(j-1) j = 1...(k+1) 480= SUM C(k+1,j+1) (j+1) x^j j = 0...k 481= SUM D(k,j) x^j with D(k,j) = (j+1) C(k+1,j+1) ??? 482 483*) 484 485(* Another presentation of triangles: 486 487The harmonic triangle of Leibniz 488 1/1 1/2 1/3 1/4 1/5 .... harmonic fractions 489 1/2 1/6 1/12 1/20 .... successive difference 490 1/3 1/12 1/30 ... 491 1/4 1/20 ... ... 492 1/5 ... ... ... 493 494Pascal's triangle 495 1 1 1 1 1 1 1 .... units 496 1 2 3 4 5 6 .... sum left and above 497 1 3 6 10 15 21 498 1 4 10 20 35 499 1 5 15 35 500 1 6 21 501 502 503*) 504 505(* LCM Lemma 506 507(n+1) lcm (C(n,0) to C(n,n)) = lcm (1 to (n+1)) 508 509m-th number in the n-th row of Leibniz triangle is: 1/ (n+1)C(n,m) 510 511LHS = (n+1) LCM (C(n,0), C(n,1), ..., C(n,n)) = lcd of fractions in n-th row of Leibniz triangle. 512 513Any such number is an integer linear combination of fractions on triangle���s sides 5141/1, 1/2, 1/3, ... 1/n, and vice versa. 515 516So LHS = lcd (1/1, 1/2, 1/3, ..., 1/n) = RHS = lcm (1,2,3, ..., (n+1)). 517 5180-th row: 1 5191-st row: 1/2 1/2 5202-nd row: 1/3 1/6 1/3 5213-rd row: 1/4 1/12 1/12 1/4 5224-th row: 1/5 1/20 1/30 1/20 1/5 523 5244-th row: 1/5 C(4,m), C(4,m) = 1 4 6 4 1, hence 1/5 1/20 1/30 1/20 1/5 525 lcd (1/5 1/20 1/30 1/20 1/5) 526= lcm (5, 20, 30, 20, 5) 527= lcm (5 C(4,0), 5 C(4,1), 5 C(4,2), 5 C(4,3), 5 C(4,4)) 528= 5 lcm (C(4,0), C(4,1), C(4,2), C(4,3), C(4,4)) 529 530But 1/5 = harmonic 531 1/20 = 1/4 - 1/5 = combination of harmonic 532 1/30 = 1/12 - 1/20 = (1/3 - 1/4) - (1/4 - 1/5) = combination of harmonic 533 534 lcd (1/5 1/20 1/30 1/20 1/5) 535= lcd (combination of harmonic from 1/1 to 1/5) 536= lcd (1/1 to 1/5) 537= lcm (1 to 5) 538 539Theorem: lcd (1/x 1/y 1/z) = lcm (x y z) 540Theorem: lcm (kx ky kz) = k lcm (x y z) 541Theorem: lcd (combination of harmonic from 1/1 to 1/n) = lcd (1/1 to 1/n) 542Then apply first theorem, lcd (1/1 to 1/n) = lcm (1 to n) 543*) 544 545(* LCM Bound 546 0 < n ==> 2^(n-1) < lcm (1 to n) 547 548 lcm (1 to n) 549= n lcm (C(n-1,0) to C(n-1,n-1)) by LCM Lemma 550>= n max (0 <= j <= n-1) C(n-1,j) 551>= SUM (0 <= j <= n-1) C(n-1,j) 552= 2^(n-1) 553 554 lcm (1 to 5) 555= 5 lcm (C(4,0), C(4,1), C(4,2), C(4,3), C(4,4)) 556 557 558>= C(4,0) + C(4,1) + C(4,2) + C(4,3) + C(4,4) 559= (1 + 1)^4 560= 2^4 561 562 lcm (1 to 5) = 1x2x3x4x5/2 = 60 563= 5 lcm (1 4 6 4 1) = 5 x 12 564= lcm (1 4 6 4 1) --> unfold 5x to add 5 times 565 + lcm (1 4 6 4 1) 566 + lcm (1 4 6 4 1) 567 + lcm (1 4 6 4 1) 568 + lcm (1 4 6 4 1) 569>= 1 + 4 + 6 + 4 + 1 --> pick one of each 5 C(n,m), i.e. diagonal 570= (1 + 1)^4 --> fold back binomial 571= 2^4 = 16 572 573Actually, can take 5 lcm (1 4 6 4 1) >= 5 x 6 = 30, 574but this will need estimation of C(n, n/2), or C(2n,n), involving Stirling's formula. 575 576Theorem: lcm (x y z) >= x or lcm (x y z) >= y or lcm (x y z) >= z 577 578*) 579 580(* 581 582More generally, there is an identity for 0 <= k <= n: 583 584(n+1) lcm (C(n,0), C(n,1), ..., C(n,k)) = lcm (n+1, n, n-1, ..., n+1-k) 585 586This is simply that fact that any integer linear combination of 587f(x), delta f(x), delta^2 f(x), ..., delta^k f(x) 588is an integer linear combination of f(x), f(x-1), f(x-2), ..., f(x-k) 589where delta is the difference operator, f(x) = 1/x, and x = n+1. 590 591BTW, Leibnitz harmonic triangle too gives this identity. 592 593That's correct, but the use of absolute values in the Leibniz triangle and 594its specialized definition somewhat obscures the generic, linear nature of the identity. 595 596 f(x) = f(n+1) = 1/(n+1) 597f(x-1) = f(n) = 1/n 598f(x-2) = f(n-1) = 1/(n-1) 599f(x-k) = f(n+1-k) = 1/(n+1-k) 600 601 f(x) = f(n+1) = 1/(n+1) = 1/(n+1)C(n,0) 602 delta f(x) = f(x-1) - f(x) = 1/n - 1/(n+1) = 1/n(n+1) = 1/(n+1)C(n,1) 603 = C(1,0) f(x-1) - C(1,1) f(x) 604delta^2 f(x) = delta f(x-1) - delta f(x) = 1/(n-1)n - 1/n(n+1) 605 = (n(n+1) - n(n-1))/(n)(n+1)(n)(n-1) 606 = 2n/n(n+1)n(n-1) = 1/(n+1)(n(n-1)/2) = 1/(n+1)C(n,2) 607delta^2 f(x) = delta f(x-1) - delta f(x) 608 = (f(x-2) - f(x-1)) - (f(x-1) - f(x)) 609 = f(x-2) - 2 f(x-1) + f(x) 610 = C(2,0) f(x-2) - C(2,1) f(x-1) + C(2,2) f(x) 611delta^3 f(x) = delta^2 f(x-1) - delta^2 f(x) 612 = (f(x-3) - 2 f(x-2) + f(x-1)) - (f(x-2) - 2 f(x-1) + f(x)) 613 = f(x-3) - 3 f(x-2) + 3 f(x-1) - f(x) 614 = C(3,0) f(x-3) - C(3,1) f(x-2) + C(3,2) f(x-2) - C(3,3) f(x) 615 616delta^k f(x) = C(k,0) f(x-k) - C(k,1) f(x-k+1) + ... + (-1)^k C(k,k) f(x) 617 = SUM(0 <= j <= k) (-1)^k C(k,j) f(x-k+j) 618Also, 619 f(x) = 1/(n+1)C(n,0) 620 delta f(x) = 1/(n+1)C(n,1) 621delta^2 f(x) = 1/(n+1)C(n,2) 622delta^k f(x) = 1/(n+1)C(n,k) 623 624so lcd (f(x), df(x), d^2f(x), ..., d^kf(x)) 625 = lcm ((n+1)C(n,0),(n+1)C(n,1),...,(n+1)C(n,k)) by lcd-to-lcm 626 = lcd (f(x), f(x-1), f(x-2), ..., f(x-k)) by linear combination 627 = lcm ((n+1), n, (n-1), ..., (n+1-k)) by lcd-to-lcm 628 629How to formalize: 630lcd (f(x), df(x), d^2f(x), ..., d^kf(x)) = lcd (f(x), f(x-1), f(x-2), ..., f(x-k)) 631 632Simple case: lcd (f(x), df(x)) = lcd (f(x), f(x-1)) 633 634 lcd (f(x), df(x)) 635= lcd (f(x), f(x-1) - f(x)) 636= lcd (f(x), f(x-1)) 637 638Can we have 639 LCD {f(x), df(x)} 640= LCD {f(x), f(x-1) - f(x)} = LCD {1/x, 1/(x-1) - 1/x} 641= LCD {f(x), f(x-1), f(x)} = lcm {x, x(x-1)} 642= LCD {f(x), f(x-1)} = x(x-1) = lcm {x, x-1} = LCD {1/x, 1/(x-1)} 643 644*) 645 646(* Step 1: From Pascal's Triangle to Leibniz's Triangle 647 648Pascal's Triangle: 649 650row 0 1 651row 1 1 1 652row 2 1 2 1 653row 3 1 3 3 1 654row 4 1 4 6 4 1 655row 5 1 5 10 10 5 1 656 657The rule is: boundary = 1, entry = up + left-up 658 or: C(n,0) = 1, C(n,k) = C(n-1,k) + C(n-1,k-1) 659 660Multiple each row by successor of its index, i.e. row n -> (n + 1) (row n): 661Multiples Triangle (or Modified Triangle): 662 6631 * row 0 1 6642 * row 1 2 2 6653 * row 2 3 6 3 6664 * row 3 4 12 12 4 6675 * row 4 5 20 30 20 5 6686 * row 5 6 30 60 60 30 6 669 670The rule is: boundary = n, entry = left * left-up / (left - left-up) 671 or: L(n,0) = n, L(n,k) = L(n,k-1) * L(n-1,k-1) / (L(n,k-1) - L(n-1,k-1)) 672 673Then lcm(1, 2) 674 = lcm(2) 675 = lcm(2, 2) 676 677 lcm(1, 2, 3) 678 = lcm(lcm(1,2), 3) using lcm(1,2,...,n,n+1) = lcm(lcm(1,2,...,n), n+1) 679 = lcm(2, 3) using lcm(1,2) 680 = lcm(2*3/1, 3) using lcm(L(n,k-1), L(n-1,k-1)) = lcm(L(n,k-1), L(n-1,k-1)/(L(n,k-1), L(n-1,k-1)), L(n-1,k-1)) 681 = lcm(6, 3) 682 = lcm(3, 6, 3) 683 684 lcm(1, 2, 3, 4) 685 = lcm(lcm(1,2,3), 4) 686 = lcm(lcm(6,3), 4) 687 = lcm(6, 3, 4) 688 = lcm(6, 3*4/1, 4) 689 = lcm(6, 12, 4) 690 = lcm(6*12/6, 12, 4) 691 = lcm(12, 12, 4) 692 = lcm(4, 12, 12, 4) 693 694 lcm(1, 2, 3, 4, 5) 695 = lcm(lcm(2,3,4), 5) 696 = lcm(lcm(12,4), 5) 697 = lcm(12, 4, 5) 698 = lcm(12, 4*5/1, 5) 699 = lcm(12, 20, 5) 700 = lcm(12*20/8, 20, 5) 701 = lcm(30, 20, 5) 702 = lcm(5, 20, 30, 20, 5) 703 704 lcm(1, 2, 3, 4, 5, 6) 705 = lcm(lcm(1, 2, 3, 4, 5), 6) 706 = lcm(lcm(30,20,5), 6) 707 = lcm(30, 20, 5, 6) 708 = lcm(30, 20, 5*6/1, 6) 709 = lcm(30, 20, 30, 6) 710 = lcm(30, 20*30/10, 30, 6) 711 = lcm(20, 60, 30, 6) 712 = lcm(20*60/40, 60, 30, 6) 713 = lcm(30, 60, 30, 6) 714 = lcm(6, 30, 60, 30, 6) 715 716Invert each entry of Multiples Triangle into a unit fraction: 717Leibniz's Triangle: 718 7191/(1 * row 0) 1/1 7201/(2 * row 1) 1/2 1/2 7211/(3 * row 2) 1/3 1/6 1/3 7221/(4 * row 3) 1/4 1/12 1/12 1/4 7231/(5 * row 4) 1/5 1/20 1/30 1/20 1/5 7241/(6 * row 5) 1/6 1/30 1/60 1/60 1/30 1/6 725 726Theorem: In the Multiples Triangle, the vertical-lcm = horizontal-lcm. 727i.e. lcm (1, 2, 3) = lcm (3, 6, 3) = 6 728 lcm (1, 2, 3, 4) = lcm (4, 12, 12, 4) = 12 729 lcm (1, 2, 3, 4, 5) = lcm (5, 20, 30, 20, 5) = 60 730 lcm (1, 2, 3, 4, 5, 6) = lcm (6, 30, 60, 60, 30, 6) = 60 731Proof: With reference to Leibniz's Triangle, note: term = left-up - left 732 lcm (5, 20, 30, 20, 5) 733= lcm (5, 20, 30) by reduce repetition 734= lcm (5, d(1/20), d(1/30)) by denominator of fraction 735= lcm (5, d(1/4 - 1/5), d(1/30)) by term = left-up - left 736= lcm (5, lcm(4, 5), d(1/12 - 1/20)) by denominator of fraction subtraction 737= lcm (5, 4, lcm(12, 20)) by lcm (a, lcm (a, b)) = lcm (a, b) 738= lcm (5, 4, lcm(d(1/12), d(1/20))) to fraction again 739= lcm (5, 4, lcm(d(1/3 - 1/4), d(1/4 - 1/5))) by Leibniz's Triangle 740= lcm (5, 4, lcm(lcm(3,4), lcm(4,5))) by fraction subtraction denominator 741= lcm (5, 4, lcm(3, 4, 5)) by lcm merge 742= lcm (5, 4, 3) merge again 743= lcm (5, 4, 3, 2) by lcm include factor (!!!) 744= lcm (5, 4, 3, 2, 1) by lcm include 1 745 746Note: to make 30, need 12, 20 747 to make 12, need 3, 4; to make 20, need 4, 5 748 lcm (1, 2, 3, 4, 5) 749= lcm (1, 2, lcm(3,4), lcm(4,5), 5) 750= lcm (1, 2, d(1/3 - 1/4), d(1/4 - 1/5), 5) 751= lcm (1, 2, d(1/12), d(1/20), 5) 752= lcm (1, 2, 12, 20, 5) 753= lcm (1, 2, lcm(12, 20), 20, 5) 754= lcm (1, 2, d(1/12 - 1/20), 20, 5) 755= lcm (1, 2, d(1/30), 20, 5) 756= lcm (1, 2, 30, 20, 5) 757= lcm (1, 30, 20, 5) can drop factor !! 758= lcm (30, 20, 5) can drop 1 759= lcm (5, 20, 30, 20, 5) 760 761 lcm (1, 2, 3, 4, 5, 6) 762= lcm (lcm (1, 2, 3, 4, 5), lcm(5,6), 6) 763= lcm (lcm (5, 20, 30, 20, 5), d(1/5 - 1/6), 6) 764= lcm (lcm (5, 20, 30, 20, 5), d(1/30), 6) 765= lcm (lcm (5, 20, 30, 20, 5), 30, 6) 766= lcm (lcm (5, 20, 30, 20, 5), 30, 6) 767= lcm (5, 30, 20, 6) 768= lcm (30, 20, 6) can drop factor !! 769= lcm (lcm(20, 30), 30, 6) 770= lcm (d(1/20 - 1/30), 30, 6) 771= lcm (d(1/60), 30, 6) 772= lcm (60, 30, 6) 773= lcm (6, 30, 60, 30, 6) 774 775 lcm (1, 2) 776= lcm (lcm(1,2), 2) 777= lcm (2, 2) 778 779 lcm (1, 2, 3) 780= lcm (lcm(1, 2), 3) 781= lcm (2, 3) --> lcm (2x3/(3-2), 3) = lcm (6, 3) 782= lcm (lcm(2, 3), 3) --> lcm (6, 3) = lcm (3, 6, 3) 783= lcm (d(1/2 - 1/3), 3) 784= lcm (d(1/6), 3) 785= lcm (6, 3) = lcm (3, 6, 3) 786 787 lcm (1, 2, 3, 4) 788= lcm (lcm(1, 2, 3), 4) 789= lcm (lcm(6, 3), 4) 790= lcm (6, 3, 4) 791= lcm (6, lcm(3, 4), 4) --> lcm (6, 12, 4) = lcm (6x12/(12-6), 12, 4) 792= lcm (6, d(1/3 - 1/4), 4) = lcm (12, 12, 4) = lcm (4, 12, 12, 4) 793= lcm (6, d(1/12), 4) 794= lcm (6, 12, 4) 795= lcm (lcm(6, 12), 4) 796= lcm (d(1/6 - 1/12), 4) 797= lcm (d(1/12), 4) 798= lcm (12, 4) = lcm (4, 12, 12, 4) 799 800 lcm (1, 2, 3, 4, 5) 801= lcm (lcm(1, 2, 3, 4), 5) 802= lcm (lcm(12, 4), 5) 803= lcm (12, 4, 5) 804= lcm (12, lcm(4,5), 5) --> lcm (12, 20, 5) = lcm (12x20/(20-12), 20, 5) 805= lcm (12, d(1/4 - 1/5), 5) = lcm (240/8, 20, 5) but lcm(12,20) != 30 806= lcm (12, d(1/20), 5) = lcm (30, 20, 5) use lcm(a,b,c) = lcm(ab/(b-a), b, c) 807= lcm (12, 20, 5) 808= lcm (lcm(12,20), 20, 5) 809= lcm (d(1/12 - 1/20), 20, 5) 810= lcm (d(1/30), 20, 5) 811= lcm (30, 20, 5) = lcm (5, 20, 30, 20, 5) 812 813 lcm (1, 2, 3, 4, 5, 6) 814= lcm (lcm(1, 2, 3, 4, 5), 6) 815= lcm (lcm(30, 20, 5), 6) 816= lcm (30, 20, 5, 6) 817= lcm (30, 20, lcm(5,6), 6) --> lcm (30, 20, 30, 6) = lcm (30, 20x30/(30-20), 30, 6) 818= lcm (30, 20, d(1/5 - 1/6), 6) = lcm (30, 60, 30, 6) 819= lcm (30, 20, d(1/30), 6) = lcm (30x60/(60-30), 60, 30, 6) 820= lcm (30, 20, 30, 6) = lcm (60, 60, 30, 6) 821= lcm (30, lcm(20,30), 30, 6) 822= lcm (30, d(1/20 - 1/30), 30, 6) 823= lcm (30, d(1/60), 30, 6) 824= lcm (30, 60, 30, 6) 825= lcm (lcm(30, 60), 60, 30, 6) 826= lcm (d(1/30 - 1/60), 60, 30, 6) 827= lcm (d(1/60), 60, 30, 6) 828= lcm (60, 60, 30, 6) 829= lcm (60, 30, 6) = lcm (6, 30, 60, 60, 30, 6) 830 831*) 832 833(* ------------------------------------------------------------------------- *) 834(* Helper Theorems *) 835(* ------------------------------------------------------------------------- *) 836 837(* Theorem: R^* x y /\ R^* y z ==> R^* x z *) 838(* Proof: by RTC_TRANSITIVE, transitive_def *) 839val RTC_TRANS = store_thm( 840 "RTC_TRANS", 841 ``R^* x y /\ R^* y z ==> R^* x z``, 842 metis_tac[RTC_TRANSITIVE, transitive_def]); 843 844(* ------------------------------------------------------------------------- *) 845(* Leibniz Triangle (Denominator form) *) 846(* ------------------------------------------------------------------------- *) 847 848(* Define Leibniz Triangle *) 849val leibniz_def = Define` 850 leibniz n k = (n + 1) * binomial n k 851`; 852 853(* export simple definition *) 854val _ = export_rewrites["leibniz_def"]; 855 856(* Theorem: leibniz 0 n = if n = 0 then 1 else 0 *) 857(* Proof: 858 leibniz 0 n 859 = (0 + 1) * binomial 0 n by leibniz_def 860 = if n = 0 then 1 else 0 by binomial_n_0 861*) 862val leibniz_0_n = store_thm( 863 "leibniz_0_n", 864 ``!n. leibniz 0 n = if n = 0 then 1 else 0``, 865 rw[binomial_0_n]); 866 867(* Theorem: leibniz n 0 = n + 1 *) 868(* Proof: 869 leibniz n 0 870 = (n + 1) * binomial n 0 by leibniz_def 871 = (n + 1) * 1 by binomial_n_0 872 = n + 1 873*) 874val leibniz_n_0 = store_thm( 875 "leibniz_n_0", 876 ``!n. leibniz n 0 = n + 1``, 877 rw[binomial_n_0]); 878 879(* Theorem: leibniz n n = n + 1 *) 880(* Proof: 881 leibniz n n 882 = (n + 1) * binomial n n by leibniz_def 883 = (n + 1) * 1 by binomial_n_n 884 = n + 1 885*) 886val leibniz_n_n = store_thm( 887 "leibniz_n_n", 888 ``!n. leibniz n n = n + 1``, 889 rw[binomial_n_n]); 890 891(* Theorem: n < k ==> leibniz n k = 0 *) 892(* Proof: 893 leibniz n k 894 = (n + 1) * binomial n k by leibniz_def 895 = (n + 1) * 0 by binomial_less_0 896 = 0 897*) 898val leibniz_less_0 = store_thm( 899 "leibniz_less_0", 900 ``!n k. n < k ==> (leibniz n k = 0)``, 901 rw[binomial_less_0]); 902 903(* Theorem: k <= n ==> (leibniz n k = leibniz n (n-k)) *) 904(* Proof: 905 leibniz n k 906 = (n + 1) * binomial n k by leibniz_def 907 = (n + 1) * binomial n (n-k) by binomial_sym 908 = leibniz n (n-k) by leibniz_def 909*) 910val leibniz_sym = store_thm( 911 "leibniz_sym", 912 ``!n k. k <= n ==> (leibniz n k = leibniz n (n-k))``, 913 rw[leibniz_def, GSYM binomial_sym]); 914 915(* Theorem: k < HALF n ==> leibniz n k < leibniz n (k + 1) *) 916(* Proof: 917 Assume k < HALF n, and note that 0 < (n + 1). 918 leibniz n k < leibniz n (k + 1) 919 <=> (n + 1) * binomial n k < (n + 1) * binomial n (k + 1) by leibniz_def 920 <=> binomial n k < binomial n (k + 1) by LT_MULT_LCANCEL 921 <=> T by binomial_monotone 922*) 923val leibniz_monotone = store_thm( 924 "leibniz_monotone", 925 ``!n k. k < HALF n ==> leibniz n k < leibniz n (k + 1)``, 926 rw[leibniz_def, binomial_monotone]); 927 928(* Theorem: k <= n ==> 0 < leibniz n k *) 929(* Proof: 930 Since leibniz n k = (n + 1) * binomial n k by leibniz_def 931 and 0 < n + 1, 0 < binomial n k by binomial_pos 932 Hence 0 < leibniz n k by ZERO_LESS_MULT 933*) 934val leibniz_pos = store_thm( 935 "leibniz_pos", 936 ``!n k. k <= n ==> 0 < leibniz n k``, 937 rw[leibniz_def, binomial_pos, ZERO_LESS_MULT, DECIDE``!n. 0 < n + 1``]); 938 939(* Theorem: (leibniz n k = 0) <=> n < k *) 940(* Proof: 941 leibniz n k = 0 942 <=> (n + 1) * (binomial n k = 0) by leibniz_def 943 <=> binomial n k = 0 by MULT_EQ_0, n + 1 <> 0 944 <=> n < k by binomial_eq_0 945*) 946val leibniz_eq_0 = store_thm( 947 "leibniz_eq_0", 948 ``!n k. (leibniz n k = 0) <=> n < k``, 949 rw[leibniz_def, binomial_eq_0]); 950 951(* Theorem: leibniz n = (\j. (n + 1) * j) o (binomial n) *) 952(* Proof: by leibniz_def and function equality. *) 953val leibniz_alt = store_thm( 954 "leibniz_alt", 955 ``!n. leibniz n = (\j. (n + 1) * j) o (binomial n)``, 956 rw[leibniz_def, FUN_EQ_THM]); 957 958(* Theorem: leibniz n k = (\j. (n + 1) * j) (binomial n k) *) 959(* Proof: by leibniz_def *) 960val leibniz_def_alt = store_thm( 961 "leibniz_def_alt", 962 ``!n k. leibniz n k = (\j. (n + 1) * j) (binomial n k)``, 963 rw_tac std_ss[leibniz_def]); 964 965(* 966Picture of Leibniz Triangle L-corner: 967 b = L (n-1) k 968 a = L n k c = L n (k+1) 969 970a = L n k = (n+1) * (n, k, n-k) = (n+1, k, n-k) = (n+1)! / k! (n-k)! 971b = L (n-1) k = n * (n-1, k, n-1-k) = (n , k, n-k-1) = n! / k! (n-k-1)! = a * (n-k)/(n+1) 972c = L n (k+1) = (n+1) * (n, k+1, n-(k+1)) = (n+1, k+1, n-k-1) = (n+1)! / (k+1)! (n-k-1)! = a * (n-k)/(k+1) 973 974a * b = a * a * (n-k)/(n+1) 975a - b = a - a * (n-k)/(n+1) = a * (1 - (n-k)/(n+1)) = a * (n+1 - n+k)/(n+1) = a * (k+1)/(n+1) 976Hence 977 a * b /(a - b) 978= [a * a * (n-k)/(n+1)] / [a * (k+1)/(n+1)] 979= a * (n-k)/(k+1) 980= c 981or a * b = c * (a - b) 982*) 983 984(* Theorem: 0 < n ==> !k. (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k *) 985(* Proof: 986 (n + 1) * leibniz (n - 1) k 987 = (n + 1) * ((n-1 + 1) * binomial (n-1) k) by leibniz_def 988 = (n + 1) * (n * binomial (n-1) k) by SUB_ADD, 1 <= n. 989 = (n + 1) * ((n - k) * (binomial n k)) by binomial_up_eqn 990 = ((n + 1) * (n - k)) * binomial n k by MULT_ASSOC 991 = ((n - k) * (n + 1)) * binomial n k by MULT_COMM 992 = (n - k) * ((n + 1) * binomial n k) by MULT_ASSOC 993 = (n - k) * leibniz n k by leibniz_def 994*) 995val leibniz_up_eqn = store_thm( 996 "leibniz_up_eqn", 997 ``!n. 0 < n ==> !k. (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k``, 998 rw[leibniz_def] >> 999 `1 <= n` by decide_tac >> 1000 metis_tac[SUB_ADD, binomial_up_eqn, MULT_ASSOC, MULT_COMM]); 1001 1002(* Theorem: 0 < n ==> !k. leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1) *) 1003(* Proof: 1004 Since (n + 1) * leibniz (n - 1) k = (n - k) * leibniz n k by leibniz_up_eqn 1005 leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1) by DIV_SOLVE, 0 < n+1. 1006*) 1007val leibniz_up = store_thm( 1008 "leibniz_up", 1009 ``!n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * leibniz n k DIV (n + 1)``, 1010 rw[leibniz_up_eqn, DIV_SOLVE]); 1011 1012(* Theorem: 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k *) 1013(* Proof: 1014 leibniz (n - 1) k 1015 = (n - k) * leibniz n k DIV (n + 1) by leibniz_up, 0 < n 1016 = (n - k) * ((n + 1) * binomial n k) DIV (n + 1) by leibniz_def 1017 = (n + 1) * ((n - k) * binomial n k) DIV (n + 1) by MULT_ASSOC, MULT_COMM 1018 = (n - k) * binomial n k by MULT_DIV, 0 < n + 1 1019*) 1020val leibniz_up_alt = store_thm( 1021 "leibniz_up_alt", 1022 ``!n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k``, 1023 metis_tac[leibniz_up, leibniz_def, MULT_DIV, MULT_ASSOC, MULT_COMM, DECIDE``0 < x + 1``]); 1024 1025(* Theorem: 0 < n ==> !k. (k + 1) * leibniz n (k+1) = (n - k) * leibniz n k *) 1026(* Proof: 1027 (k + 1) * leibniz n (k+1) 1028 = (k + 1) * ((n + 1) * binomial n (k+1)) by leibniz_def 1029 = (k + 1) * (n + 1) * binomial n (k+1) by MULT_ASSOC 1030 = (n + 1) * (k + 1) * binomial n (k+1) by MULT_COMM 1031 = (n + 1) * ((k + 1) * binomial n (k+1)) by MULT_ASSOC 1032 = (n + 1) * ((n - k) * (binomial n k)) by binomial_right_eqn 1033 = ((n + 1) * (n - k)) * binomial n k by MULT_ASSOC 1034 = ((n - k) * (n + 1)) * binomial n k by MULT_COMM 1035 = (n - k) * ((n + 1) * binomial n k) by MULT_ASSOC 1036 = (n - k) * leibniz n k by leibniz_def 1037*) 1038val leibniz_right_eqn = store_thm( 1039 "leibniz_right_eqn", 1040 ``!n. 0 < n ==> !k. (k + 1) * leibniz n (k+1) = (n - k) * leibniz n k``, 1041 metis_tac[leibniz_def, MULT_COMM, MULT_ASSOC, binomial_right_eqn]); 1042 1043(* Theorem: 0 < n ==> !k. leibniz n (k+1) = (n - k) * (leibniz n k) DIV (k + 1) *) 1044(* Proof: 1045 Since (k + 1) * leibniz n (k+1) = (n - k) * leibniz n k by leibniz_right_eqn 1046 leibniz n (k+1) = (n - k) * (leibniz n k) DIV (k+1) by DIV_SOLVE, 0 < k+1. 1047*) 1048val leibniz_right = store_thm( 1049 "leibniz_right", 1050 ``!n. 0 < n ==> !k. leibniz n (k+1) = (n - k) * (leibniz n k) DIV (k+1)``, 1051 rw[leibniz_right_eqn, DIV_SOLVE]); 1052 1053(* Note: Following is the property from Leibniz Harmonic Triangle: 1054 1 / leibniz n (k+1) = 1 / leibniz (n-1) k - 1 / leibniz n k 1055 = (leibniz n k - leibniz (n-1) k) / leibniz n k * leibniz (n-1) k 1056*) 1057 1058(* The Idea: 1059 b 1060Actually, lcm a b = lcm b c = lcm c a for a c in Leibniz Triangle. 1061The only relationship is: c = ab/(a - b), or ab = c(a - b). 1062 1063Is this a theorem: ab = c(a - b) ==> lcm a b = lcm b c = lcm c a 1064Or in fractions, 1/c = 1/b - 1/a ==> lcm a b = lcm b c = lcm c a ? 1065 1066lcm a b 1067= a b / (gcd a b) 1068= c(a - b) / (gcd a (a - b)) 1069= ac(a - b) / gcd a (a-b) / a 1070= lcm (a (a-b)) c / a 1071= lcm (ca c(a-b)) / a 1072= lcm (ca ab) / a 1073= lcm (b c) 1074 1075lcm a b = a b / gcd a b = a b / gcd a (a-b) = a b c / gcd ca c(a-b) 1076= c (a-b) c / gcd ca c(a-b) = lcm ca c(a-b) / a = lcm ca ab / a = lcm b c 1077 1078 lcm b c 1079= b c / gcd b c 1080= a b c / gcd a*b a*c 1081= a b c / gcd c*(a-b) c*a 1082= a b / gcd (a-b) a 1083= a b / gcd b a 1084= lcm (a b) 1085= lcm a b 1086 1087 lcm a c 1088= a c / gcd a c 1089= a b c / gcd b*a b*c 1090= a b c / gcd c*(a-b) b*c 1091= a b / gcd (a-b) b 1092= a b / gcd a b 1093= lcm a b 1094 1095Yes! 1096 1097This is now in LCM_EXCHANGE: 1098val it = |- !a b c. (a * b = c * (a - b)) ==> (lcm a b = lcm a c): thm 1099*) 1100 1101(* Theorem: 0 < n ==> 1102 !k. leibniz n k * leibniz (n-1) k = leibniz n (k+1) * (leibniz n k - leibniz (n-1) k) *) 1103(* Proof: 1104 If n <= k, 1105 then n-1 < k, and n < k+1. 1106 so leibniz (n-1) k = 0 by leibniz_less_0, n-1 < k. 1107 and leibniz n (k+1) = 0 by leibniz_less_0, n < k+1. 1108 Hence true by MULT_EQ_0 1109 Otherwise, k < n, or k <= n. 1110 then (n+1) - (n-k) = k+1. 1111 1112 (k + 1) * (c * (a - b)) 1113 = (k + 1) * c * (a - b) by MULT_ASSOC 1114 = ((n+1) - (n-k)) * c * (a - b) by above 1115 = (n - k) * a * (a - b) by leibniz_right_eqn 1116 = (n - k) * a * a - (n - k) * a * b by LEFT_SUB_DISTRIB 1117 = (n + 1) * b * a - (n - k) * a * b by leibniz_up_eqn 1118 = (n + 1) * (a * b) - (n - k) * (a * b) by MULT_ASSOC, MULT_COMM 1119 = ((n+1) - (n-k)) * (a * b) by RIGHT_SUB_DISTRIB 1120 = (k + 1) * (a * b) by above 1121 1122 Since (k+1) <> 0, the result follows by MULT_LEFT_CANCEL 1123*) 1124val leibniz_property = store_thm( 1125 "leibniz_property", 1126 ``!n. 0 < n ==> 1127 !k. leibniz n k * leibniz (n-1) k = leibniz n (k+1) * (leibniz n k - leibniz (n-1) k)``, 1128 rpt strip_tac >> 1129 Cases_on `n <= k` >- 1130 rw[leibniz_less_0] >> 1131 `(n+1) - (n-k) = k+1` by decide_tac >> 1132 `(k+1) <> 0` by decide_tac >> 1133 qabbrev_tac `a = leibniz n k` >> 1134 qabbrev_tac `b = leibniz (n - 1) k` >> 1135 qabbrev_tac `c = leibniz n (k + 1)` >> 1136 `(k + 1) * (c * (a - b)) = ((n+1) - (n-k)) * c * (a - b)` by rw_tac std_ss[MULT_ASSOC] >> 1137 `_ = (n - k) * a * (a - b)` by rw_tac std_ss[leibniz_right_eqn, Abbr`c`, Abbr`a`] >> 1138 `_ = (n - k) * a * a - (n - k) * a * b` by rw_tac std_ss[LEFT_SUB_DISTRIB] >> 1139 `_ = (n + 1) * b * a - (n - k) * a * b` by rw_tac std_ss[leibniz_up_eqn, Abbr`b`, Abbr`a`] >> 1140 `_ = (n + 1) * (a * b) - (n - k) * (a * b)` by metis_tac[MULT_ASSOC, MULT_COMM] >> 1141 `_ = ((n+1) - (n-k)) * (a * b)` by rw_tac std_ss[RIGHT_SUB_DISTRIB] >> 1142 `_ = (k + 1) * (a * b)` by rw_tac std_ss[] >> 1143 metis_tac[MULT_LEFT_CANCEL]); 1144 1145(* Theorem: k <= n ==> (leibniz n k = (n + 1) * FACT n DIV (FACT k * FACT (n - k))) *) 1146(* Proof: 1147 Note (FACT k * FACT (n - k)) divides (FACT n) by binomial_is_integer 1148 and 0 < FACT k * FACT (n - k) by FACT_LESS, ZERO_LESS_MULT 1149 leibniz n k 1150 = (n + 1) * binomial n k by leibniz_def 1151 = (n + 1) * (FACT n DIV (FACT k * FACT (n - k))) by binomial_formula3 1152 = (n + 1) * FACT n DIV (FACT k * FACT (n - k)) by MULTIPLY_DIV 1153*) 1154val leibniz_formula = store_thm( 1155 "leibniz_formula", 1156 ``!n k. k <= n ==> (leibniz n k = (n + 1) * FACT n DIV (FACT k * FACT (n - k)))``, 1157 metis_tac[leibniz_def, binomial_formula3, binomial_is_integer, FACT_LESS, MULTIPLY_DIV, ZERO_LESS_MULT]); 1158 1159(* Theorem: 0 < n ==> 1160 !k. k < n ==> leibniz n (k+1) = leibniz n k * leibniz (n-1) k DIV (leibniz n k - leibniz (n-1) k) *) 1161(* Proof: 1162 By leibniz_property, 1163 leibniz n (k+1) * (leibniz n k - leibniz (n-1) k) = leibniz n k * leibniz (n-1) k 1164 Since 0 < leibniz n k and 0 < leibniz (n-1) k by leibniz_pos 1165 so 0 < (leibniz n k - leibniz (n-1) k) by MULT_EQ_0 1166 Hence by MULT_COMM, DIV_SOLVE, 0 < (leibniz n k - leibniz (n-1) k), 1167 leibniz n (k+1) = leibniz n k * leibniz (n-1) k DIV (leibniz n k - leibniz (n-1) k) 1168*) 1169val leibniz_recurrence = store_thm( 1170 "leibniz_recurrence", 1171 ``!n. 0 < n ==> 1172 !k. k < n ==> (leibniz n (k+1) = leibniz n k * leibniz (n-1) k DIV (leibniz n k - leibniz (n-1) k))``, 1173 rpt strip_tac >> 1174 `k <= n /\ k <= (n-1)` by decide_tac >> 1175 `leibniz n (k+1) * (leibniz n k - leibniz (n-1) k) = leibniz n k * leibniz (n-1) k` by rw[leibniz_property] >> 1176 `0 < leibniz n k /\ 0 < leibniz (n-1) k` by rw[leibniz_pos] >> 1177 `0 < (leibniz n k - leibniz (n-1) k)` by metis_tac[MULT_EQ_0, NOT_ZERO_LT_ZERO] >> 1178 rw_tac std_ss[DIV_SOLVE, MULT_COMM]); 1179 1180(* Theorem: 0 < k /\ k <= n ==> 1181 (leibniz n k = leibniz n (k-1) * leibniz (n-1) (k-1) DIV (leibniz n (k-1) - leibniz (n-1) (k-1))) *) 1182(* Proof: 1183 Since 0 < k, k = SUC h for some h 1184 or k = h + 1 by ADD1 1185 and h = k - 1 by arithmetic 1186 Since 0 < k and k <= n, 1187 0 < n and h < n. 1188 Hence true by leibniz_recurrence. 1189*) 1190val leibniz_n_k = store_thm( 1191 "leibniz_n_k", 1192 ``!n k. 0 < k /\ k <= n ==> 1193 (leibniz n k = leibniz n (k-1) * leibniz (n-1) (k-1) DIV (leibniz n (k-1) - leibniz (n-1) (k-1)))``, 1194 rpt strip_tac >> 1195 `?h. k = h + 1` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO, ADD1] >> 1196 `(h = k - 1) /\ h < n /\ 0 < n` by decide_tac >> 1197 metis_tac[leibniz_recurrence]); 1198 1199(* Theorem: 0 < n ==> 1200 !k. lcm (leibniz n k) (leibniz (n-1) k) = lcm (leibniz n k) (leibniz n (k+1)) *) 1201(* Proof: 1202 By leibniz_property, 1203 leibniz n k * leibniz (n - 1) k = leibniz n (k + 1) * (leibniz n k - leibniz (n - 1) k) 1204 Hence true by LCM_EXCHANGE. 1205*) 1206val leibniz_lcm_exchange = store_thm( 1207 "leibniz_lcm_exchange", 1208 ``!n. 0 < n ==> !k. lcm (leibniz n k) (leibniz (n-1) k) = lcm (leibniz n k) (leibniz n (k+1))``, 1209 rw[leibniz_property, LCM_EXCHANGE]); 1210 1211(* Theorem: 4 ** n <= leibniz (2 * n) n *) 1212(* Proof: 1213 Let m = 2 * n. 1214 Then n = HALF m by HALF_TWICE 1215 Let l1 = GENLIST (K (binomial m n)) (m + 1) 1216 and l2 = GENLIST (binomial m) (m + 1) 1217 Note LENGTH l1 = LENGTH l2 = m + 1 by LENGTH_GENLIST 1218 1219 Claim: !k. k < m + 1 ==> EL k l2 <= EL k l1 1220 Proof: Note EL k l1 = binomial m n by EL_GENLIST 1221 and EL k l2 = binomial m k by EL_GENLIST 1222 Apply binomial m k <= binomial m n by binomial_max 1223 The result follows 1224 1225 leibniz m n 1226 = (m + 1) * binomial m n by leibniz_def 1227 = SUM (GENLIST (K (binomial m n)) (m + 1)) by SUM_GENLIST_K 1228 >= SUM (GENLIST (\k. binomial m k) (m + 1)) by SUM_LE, above 1229 = SUM (GENLIST (binomial m) (SUC m)) by ADD1 1230 = 2 ** m by binomial_sum 1231 = 2 ** (2 * n) by notation 1232 = (2 ** 2) ** n by EXP_EXP_MULT 1233 = 4 ** n by arithmetic 1234*) 1235val leibniz_middle_lower = store_thm( 1236 "leibniz_middle_lower", 1237 ``!n. 4 ** n <= leibniz (2 * n) n``, 1238 rpt strip_tac >> 1239 qabbrev_tac `m = 2 * n` >> 1240 `n = HALF m` by rw[HALF_TWICE, Abbr`m`] >> 1241 qabbrev_tac `l1 = GENLIST (K (binomial m n)) (m + 1)` >> 1242 qabbrev_tac `l2 = GENLIST (binomial m) (m + 1)` >> 1243 `!k. k < m + 1 ==> EL k l2 <= EL k l1` by rw[binomial_max, EL_GENLIST, Abbr`l1`, Abbr`l2`] >> 1244 `leibniz m n = (m + 1) * binomial m n` by rw[leibniz_def] >> 1245 `_ = SUM l1` by rw[SUM_GENLIST_K, Abbr`l1`] >> 1246 `SUM l2 = SUM (GENLIST (binomial m) (SUC m))` by rw[ADD1, Abbr`l2`] >> 1247 `_ = 2 ** m` by rw[binomial_sum] >> 1248 `_ = 4 ** n` by rw[EXP_EXP_MULT, Abbr`m`] >> 1249 metis_tac[SUM_LE, LENGTH_GENLIST]); 1250 1251(* ------------------------------------------------------------------------- *) 1252(* Property of Leibniz Triangle *) 1253(* ------------------------------------------------------------------------- *) 1254 1255(* 1256binomial_recurrence |- !n k. binomial (SUC n) (SUC k) = binomial n k + binomial n (SUC k) 1257This means: 1258 B n k + B n k* 1259 v 1260 B n* k* 1261However, for the Leibniz Triangle, the recurrence is: 1262 L n k 1263 L n* k -> L n* k* = (L n* k)(L n k) / (L n* k - L n k) 1264That is, it takes a different style, and has the property: 1265 1 / L n* k* = 1 / L n k - 1 / L n* k 1266Why? 1267First, some verification. 1268Pascal: [1] 3 3 1269 [4] 6 = 3 + 3 = 6 1270Leibniz: 12 12 1271 [20] 30 = 20 * 12 / (20 - 12) = 20 * 12 / 8 = 30 1272Now, the 20 comes from 4 = 3 + 1. 1273Originally, 30 = 5 * 6 by definition based on multiple 1274 = 5 * (3 + 3) by Pascal 1275 = 4 * (3 + 3) + (3 + 3) 1276 = 12 + 12 + 6 1277In terms of factorials, 30 = 5 * 6 = 5 * B(4,2) = 5 * 4!/2!2! 1278 20 = 5 * 4 = 5 * B(4,1) = 5 * 4!/1!3! 1279 12 = 4 * 3 = 4 * B(3,1) = 4 * 3!/1!2! 1280So 1/30 = (2!2!)/(5 4!) 1 / n** B n* k* = k*! (n* - k* )! / n** n*! = (n - k)! k*! / n**! 1281 1/20 = (1!3!)/(5 4!) 1 / n** B n* k 1282 1/12 = (1!2!)/(4 3!) 1 / n* B n k 1283 1/12 - 1/20 1284 = (1!2!)/(4 3!) - (1!3!)/(5 4!) 1285 = (1!2!)/4! - (1!3!)/5! 1286 = 5(1!2!)/5! - (1!3!)/5! 1287 = (5(1!2!) - (1!3!))/5! 1288 = (5 1! - 3 1!) 2!/5! 1289 = (5 - 3)1! 2!/5! 1290 = 2! 2! / 5! 1291 1292 1 / n B n k - 1 / n** B n* k 1293 = k! (n-k)! / n* n! - k! (n* - k)! / n** n*! 1294 = k! (n-k)! / n*! - k!(n* - k)! / n** n*! 1295 = (n** (n-k)! - (n* - k)!) k! / n** n*! 1296 = (n** - (n* - k)) (n - k)! k! / n** n*! 1297 = (k+1) (n - k)! k! / n** n*! 1298 = (n* - k* )! k*! / n** n*! 1299 = 1 / n** B n* k* 1300 1301Direct without using unit fractions, 1302 1303L n k = n* B n k = n* n! / k! (n-k)! = n*! / k! (n-k)! 1304L n* k = n** B n* k = n** n*! / k! (n* - k)! = n**! / k! (n* - k)! 1305L n* k* = n** B n* k* = n** n*! / k*! (n* - k* )! = n**! / k*! (n-k)! 1306 1307(L n* k) * (L n k) = n**! n*! / k! (n* - k)! k! (n-k)! 1308(L n* k) - (L n k) = n**! / k! (n* - k)! - n*! / k! (n-k)! 1309 = n**! / k! (n-k)!( 1/(n* - k) - 1/ n** ) 1310 = n**! / k! (n-k)! (n** - n* + k)/(n* - k)(n** ) 1311 = n**! / k! (n-k)! k* / (n* - k) n** 1312 = n*! k* / k! (n* - k)! 1313(L n* k) * (L n k) / (L n* k) - (L n k) 1314= n**! /k! (n-k)! k* 1315= n**! /k*! (n-k)! 1316= L n* k* 1317So: L n k 1318 L n* k --> L n* k* 1319 1320Can the LCM be shown directly? 1321lcm (L n* k, L n k) = lcm (L n* k, L n* k* ) 1322To prove this, need to show: 1323both have the same common multiples, and least is the same -- probably yes due to common L n* k. 1324 1325In general, what is the condition for lcm a b = lcm a c ? 1326Well, lcm a b = a b / gcd a b, lcm a c = a c / gcd a c 1327So it must be a b gcd a c = a c gcd a b, or b * gcd a c = c * gcd a b. 1328 1329It this true for Leibniz triangle? 1330Let a = 5, b = 4, c = 20. b * gcd a c = 4 * gcd 5 20 = 4 * 5 = 20 1331 c * gcd a b = 20 * gcd 5 4 = 20 1332Verify lcm a b = lcm 5 4 = 20 = 5 * 4 / gcd 5 4 1333 lcm a c = lcm 5 20 = 20 = 5 * 20 / gcd 5 20 1334 5 * 4 / gcd 5 4 = 5 * 20 / gcd 5 20 1335or 4 * gcd 5 20 = 20 * gcd 5 4 1336 1337(L n k) * gcd (L n* k, L n* k* ) = (L n* k* ) * gcd (L n* k, L n k) 1338 1339or n* B n k * gcd (n** B n* k, n** B n* k* ) = (n** B n* k* ) * gcd (n** B n* k, n* B n k) 1340By GCD_COMMON_FACTOR, !m n k. gcd (k * m) (k * n) = k * gcd m n 1341 n** n* B n k gcd (B n* k, B n* k* ) = (n** B n* k* ) * gcd (n** B n* k, n* B n k) 1342*) 1343 1344(* Special Property of Leibniz Triangle 1345For: L n k 1346 L n+ k --> L n+ k+ 1347 1348L n k = n+! / k! (n-k)! 1349L n+ k = n++! / k! (n+ - k)! = n++ n+! / k! (n+ - k) k! = (n++ / n+ - k) L n k 1350L n+ k+ = n++! / k+! (n-k)! = (L n+ k) * (L n k) / (L n+ k - L n k) = (n++ / k+) L n k 1351Let g = gcd (L n+ k) (L n k), then L n+ k+ = lcm (L n+ k) (L n k) / (co n+ k - co n k) 1352where co n+ k = L n+ k / g, co n k = L n k / g. 1353 1354 L n+ k = (n++ / n+ - k) L n k, 1355and L n+ k+ = (n++ / k+) L n k 1356e.g. L 3 1 = 12 1357 L 4 1 = 20, or (3++ / 3+ - 1) L 3 1 = (5/3) 12 = 20. 1358 L 4 2 = 30, or (3++ / 1+) L 3 1 = (5/2) 12 = 30. 1359so lcm (L 4 1) (L 3 1) = lcm (5/3)*12 12 = 12 * 5 = 60 since 3 must divide 12. 1360 lcm (L 4 1) (L 4 2) = lcm (5/3)*12 (5/2)*12 = 12 * 5 = 60 since 3, 2 must divide 12. 1361 1362By LCM_COMMON_FACTOR |- !m n k. lcm (k * m) (k * n) = k * lcm m n 1363lcm a (a * b DIV c) = a * b 1364 1365So the picture is: (L n k) 1366 (L n k) * (n+2)/(n-k+1) (L n k) * (n+2)/(k+1) 1367 1368A better picture: 1369Pascal: (B n-1 k) = (n-1, k, n-k-1) 1370 (B n k) = (n, k, n-k) (B n k+1) = (n, k+1, n-k-1) 1371Leibniz: (L n-1 k) = (n, k, n-k-1) = (L n k) / (n+1) * (n-k-1) 1372 (L n k) = (n+1, k, n-k) (L n k+1) = (n+1, k+1, n-k-1) = (L n k) / (n-k-1) * (k+1) 1373And we want: 1374 LCM (L, (n-k-1) * L DIV (n+1)) = LCM (L, (k+1) * L DIV (n-k-1)). 1375 1376Theorem: lcm a ((a * b) DIV c) = (a * b) DIV (gcd b c) 1377Assume this theorem, 1378LHS = L * (n-k-1) DIV gcd (n-k-1, n+1) 1379RHS = L * (k+1) DIV gcd (k+1, n-k-1) 1380Still no hope to show LHS = RHS ! 1381 1382LCM of fractions: 1383lcm (a/c, b/c) = lcm(a, b)/c 1384lcm (a/c, b/d) = ... = lcm(a, b)/gcd(c, d) 1385Hence lcm (a, a*b/c) = lcm(a*b/b, a*b/c) = a * b / gcd (b, c) 1386*) 1387 1388(* Special Property of Leibniz Triangle -- another go 1389Leibniz: L(5,1) = 30 = b 1390 L(6,1) = 42 = a L(6,2) = 105 = c, c = ab/(a - b), or ab = c(a - b) 1391Why is LCM 42 30 = LCM 42 105 = 210 = 2x3x5x7? 1392First, b = L(5,1) = 30 = (6,1,4) = 6!/1!4! = 7!/1!5! * (5/7) = a * (5/7) = 2x3x5 1393 a = L(6,1) = 42 = (7,1,5) = 7!/1!5! = 2x3x7 = b * (7/5) = c * (2/5) 1394 c = L(6,2) = 105 = (7,2,4) = 7!/2!4! = 7!/1!5! * (5/2) = a * (5/2) = 3x5x7 1395Any common multiple of a, b must have 5, 7 as factor, also with factor 2 (by common k = 1) 1396Any common multiple of a, c must have 5, 2 as factor, also with factor 7 (by common n = 6) 1397Also n = 5 implies a factor 6, k = 2 imples a factor 2. 1398LCM a b = a b / GCD a b 1399 = c (a - b) / GCD a b 1400 = (m c') (m a' - (m-1)b') / GCD (m a') (m-1 b') 1401LCM a c = a c / GCD a c 1402 = (m a') (m c') / GCD (m a') (m c') where c' = a' + b' from Pascal triangle 1403 = m a' (a' + b') / GCD a' (a' + b') 1404 = m a' (a' + b') / GCD a' b' 1405 = a' c / GCD a' b' 1406Can we prove: c(a - b) / GCD a b = c a' / GCD a' b' 1407or (a - b) GCD a' b' = a' GCD a b ? 1408or a GCD a' b' = a' GCD a b + b GCD a' b' ? 1409or ab GCD a' b' = c a' GCD a b? 1410or m (b GCD a' b') = c GCD a b? 1411or b GCD a' b' = c' GCD a b? 1412b = (a DIV 7) * 5 1413c = (a DIV 2) * 5 1414lcm (a, b) = lcm (a, (a DIV 7) * 5) = lcm (a, 5) 1415lcm (a, c) = lcm (a, (a DIV 2) * 5) = lcm (a, 5) 1416Is this a theorem: lcm (a, (a DIV p) * b) = lcm (a, b) if p | a ? 1417Let c = lcm (a, b). Then a | c, b | c. 1418Since a = (a DIV p) * p, (a DIV p) * p | c. 1419Hence ((a DIV p) * b) * p | b * c. 1420How to conclude ((a DIV p) * b) | c? 1421 1422A counter-example: 1423lcm (42, 9) = 126 = 2x3x3x7. 1424lcm (42, (42 DIV 3) * 9) = 126 = 2x3x3x7. 1425lcm (42, (42 DIV 6) * 9) = 126 = 2x3x3x7. 1426lcm (42, (42 DIV 2) * 9) = 378 = 2x3x3x3x7. 1427lcm (42, (42 DIV 7) * 9) = 378 = 2x3x3x3x7. 1428 1429LCM a c 1430= LCM a (ab/(a-b)) let g = GCD(a,b), a = gA, b=gB, coprime A,B. 1431= LCM gA gAB/(A-B) 1432= g LCM A AB/(A-B) 1433= (ab/LCM a b) LCM A AB/(A-B) 1434*) 1435 1436(* ------------------------------------------------------------------------- *) 1437(* LCM of a list of numbers *) 1438(* ------------------------------------------------------------------------- *) 1439 1440(* Define LCM of a list of numbers *) 1441val list_lcm_def = Define` 1442 (list_lcm [] = 1) /\ 1443 (list_lcm (h::t) = lcm h (list_lcm t)) 1444`; 1445 1446(* export simple definition *) 1447val _ = export_rewrites["list_lcm_def"]; 1448 1449(* Theorem: list_lcm [] = 1 *) 1450(* Proof: by list_lcm_def. *) 1451val list_lcm_nil = store_thm( 1452 "list_lcm_nil", 1453 ``list_lcm [] = 1``, 1454 rw[]); 1455 1456(* Theorem: list_lcm (h::t) = lcm h (list_lcm t) *) 1457(* Proof: by list_lcm_def. *) 1458val list_lcm_cons = store_thm( 1459 "list_lcm_cons", 1460 ``!h t. list_lcm (h::t) = lcm h (list_lcm t)``, 1461 rw[]); 1462 1463(* Theorem: list_lcm [x] = x *) 1464(* Proof: 1465 list_lcm [x] 1466 = lcm x (list_lcm []) by list_lcm_cons 1467 = lcm x 1 by list_lcm_nil 1468 = x by LCM_1 1469*) 1470val list_lcm_sing = store_thm( 1471 "list_lcm_sing", 1472 ``!x. list_lcm [x] = x``, 1473 rw[]); 1474 1475(* Theorem: list_lcm (SNOC x l) = list_lcm (x::l) *) 1476(* Proof: 1477 By induction on l. 1478 Base case: list_lcm (SNOC x []) = lcm x (list_lcm []) 1479 list_lcm (SNOC x []) 1480 = list_lcm [x] by SNOC 1481 = lcm x (list_lcm []) by list_lcm_def 1482 Step case: list_lcm (SNOC x l) = lcm x (list_lcm l) ==> 1483 !h. list_lcm (SNOC x (h::l)) = lcm x (list_lcm (h::l)) 1484 list_lcm (SNOC x (h::l)) 1485 = list_lcm (h::SNOC x l) by SNOC 1486 = lcm h (list_lcm (SNOC x l)) by list_lcm_def 1487 = lcm h (lcm x (list_lcm l)) by induction hypothesis 1488 = lcm x (lcm h (list_lcm l)) by LCM_ASSOC_COMM 1489 = lcm x (list_lcm h::l) by list_lcm_def 1490*) 1491val list_lcm_snoc = store_thm( 1492 "list_lcm_snoc", 1493 ``!x l. list_lcm (SNOC x l) = lcm x (list_lcm l)``, 1494 strip_tac >> 1495 Induct >- 1496 rw[] >> 1497 rw[LCM_ASSOC_COMM]); 1498 1499(* Theorem: list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l *) 1500(* Proof: 1501 By induction on l. 1502 Base case: !n. list_lcm (MAP (\k. n * k) []) = if [] = [] then 1 else n * list_lcm [] 1503 list_lcm (MAP (\k. n * k) []) 1504 = list_lcm [] by MAP 1505 = 1 by list_lcm_nil 1506 Step case: !n. list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l ==> 1507 !h n. list_lcm (MAP (\k. n * k) (h::l)) = if h::l = [] then 1 else n * list_lcm (h::l) 1508 Note h::l <> [] by NOT_NIL_CONS 1509 If l = [], h::l = [h] 1510 list_lcm (MAP (\k. n * k) [h]) 1511 = list_lcm [n * h] by MAP 1512 = n * h by list_lcm_sing 1513 = n * list_lcm [h] by list_lcm_sing 1514 If l <> [], 1515 list_lcm (MAP (\k. n * k) (h::l)) 1516 = list_lcm ((n * h) :: MAP (\k. n * k) l) by MAP 1517 = lcm (n * h) (list_lcm (MAP (\k. n * k) l)) by list_lcm_cons 1518 = lcm (n * h) (n * list_lcm l) by induction hypothesis 1519 = n * (lcm h (list_lcm l)) by LCM_COMMON_FACTOR 1520 = n * list_lcm (h::l) by list_lcm_cons 1521*) 1522val list_lcm_map_times = store_thm( 1523 "list_lcm_map_times", 1524 ``!n l. list_lcm (MAP (\k. n * k) l) = if l = [] then 1 else n * list_lcm l``, 1525 Induct_on `l` >- 1526 rw[] >> 1527 rpt strip_tac >> 1528 Cases_on `l = []` >- 1529 rw[] >> 1530 rw_tac std_ss[LCM_COMMON_FACTOR, MAP, list_lcm_cons]); 1531 1532(* Theorem: EVERY_POSITIVE l ==> 0 < list_lcm l *) 1533(* Proof: 1534 By induction on l. 1535 Base case: EVERY_POSITIVE [] ==> 0 < list_lcm [] 1536 Note EVERY_POSITIVE [] = T by EVERY_DEF 1537 Since list_lcm [] = 1 by list_lcm_nil 1538 Hence true since 0 < 1 by SUC_POS, ONE. 1539 Step case: EVERY_POSITIVE l ==> 0 < list_lcm l ==> 1540 !h. EVERY_POSITIVE (h::l) ==> 0 < list_lcm (h::l) 1541 Note EVERY_POSITIVE (h::l) 1542 ==> 0 < h and EVERY_POSITIVE l by EVERY_DEF 1543 Since list_lcm (h::l) = lcm h (list_lcm l) by list_lcm_cons 1544 and 0 < list_lcm l by induction hypothesis 1545 so h <= lcm h (list_lcm l) by LCM_LE, 0 < h. 1546 Hence 0 < list_lcm (h::l) by LESS_LESS_EQ_TRANS 1547*) 1548val list_lcm_pos = store_thm( 1549 "list_lcm_pos", 1550 ``!l. EVERY_POSITIVE l ==> 0 < list_lcm l``, 1551 Induct >- 1552 rw[] >> 1553 metis_tac[EVERY_DEF, list_lcm_cons, LCM_LE, LESS_LESS_EQ_TRANS]); 1554 1555(* Theorem: POSITIVE l ==> 0 < list_lcm l *) 1556(* Proof: by list_lcm_pos, EVERY_MEM *) 1557val list_lcm_pos_alt = store_thm( 1558 "list_lcm_pos_alt", 1559 ``!l. POSITIVE l ==> 0 < list_lcm l``, 1560 rw[list_lcm_pos, EVERY_MEM]); 1561 1562(* Theorem: EVERY_POSITIVE l ==> SUM l <= (LENGTH l) * list_lcm l *) 1563(* Proof: 1564 By induction on l. 1565 Base case: EVERY_POSITIVE [] ==> SUM [] <= LENGTH [] * list_lcm [] 1566 Note EVERY_POSITIVE [] = T by EVERY_DEF 1567 Since SUM [] = 0 by SUM 1568 and LENGTH [] = 0 by LENGTH_NIL 1569 Hence true by MULT, as 0 <= 0 by LESS_EQ_REFL 1570 Step case: EVERY_POSITIVE l ==> SUM l <= LENGTH l * list_lcm l ==> 1571 !h. EVERY_POSITIVE (h::l) ==> SUM (h::l) <= LENGTH (h::l) * list_lcm (h::l) 1572 Note EVERY_POSITIVE (h::l) 1573 ==> 0 < h and EVERY_POSITIVE l by EVERY_DEF 1574 ==> 0 < h and 0 < list_lcm l by list_lcm_pos 1575 If l = [], LENGTH l = 0. 1576 SUM (h::[]) = SUM [h] = h by SUM 1577 LENGTH (h::[]) * list_lcm (h::[]) 1578 = 1 * list_lcm [h] by ONE 1579 = 1 * h by list_lcm_sing 1580 = h by MULT_LEFT_1 1581 If l <> [], LENGTH l <> 0 by LENGTH_NIL ... [1] 1582 SUM (h::l) 1583 = h + SUM l by SUM 1584 <= h + LENGTH l * list_lcm l by induction hypothesis 1585 <= lcm h (list_lcm l) + LENGTH l * list_lcm l by LCM_LE, 0 < h 1586 <= lcm h (list_lcm l) + LENGTH l * (lcm h (list_lcm l)) by LCM_LE, 0 < list_lcm l, [1] 1587 = (1 + LENGTH l) * (lcm h (list_lcm l)) by RIGHT_ADD_DISTRIB 1588 = SUC (LENGTH l) * (lcm h (list_lcm l)) by SUC_ONE_ADD 1589 = LENGTH (h::l) * (lcm h (list_lcm l)) by LENGTH 1590 = LENGTH (h::l) * list_lcm (h::l) by list_lcm_cons 1591*) 1592val list_lcm_lower_bound = store_thm( 1593 "list_lcm_lower_bound", 1594 ``!l. EVERY_POSITIVE l ==> SUM l <= (LENGTH l) * list_lcm l``, 1595 Induct >> 1596 rw[] >> 1597 Cases_on `l = []` >- 1598 rw[] >> 1599 `lcm h (list_lcm l) + LENGTH l * (lcm h (list_lcm l)) = SUC (LENGTH l) * (lcm h (list_lcm l))` by rw[RIGHT_ADD_DISTRIB, SUC_ONE_ADD] >> 1600 `LENGTH l <> 0` by metis_tac[LENGTH_NIL] >> 1601 `0 < list_lcm l` by rw[list_lcm_pos] >> 1602 `h <= lcm h (list_lcm l) /\ list_lcm l <= lcm h (list_lcm l)` by rw[LCM_LE] >> 1603 `LENGTH l * list_lcm l <= LENGTH l * (lcm h (list_lcm l))` by rw[LE_MULT_LCANCEL] >> 1604 `h + SUM l <= h + LENGTH l * list_lcm l` by rw[] >> 1605 decide_tac); 1606 1607(* Another version to eliminate EVERY by MEM. *) 1608val list_lcm_lower_bound_alt = save_thm("list_lcm_lower_bound_alt", 1609 list_lcm_lower_bound |> SIMP_RULE (srw_ss()) [EVERY_MEM]); 1610(* > list_lcm_lower_bound_alt; 1611val it = |- !l. POSITIVE l ==> SUM l <= LENGTH l * list_lcm l: thm 1612*) 1613 1614(* Theorem: list_lcm l is a common multiple of its members. 1615 MEM x l ==> x divides (list_lcm l) *) 1616(* Proof: 1617 By induction on l. 1618 Base case: !x. MEM x [] ==> x divides (list_lcm []) 1619 True since MEM x [] = F by MEM 1620 Step case: !x. MEM x l ==> x divides (list_lcm l) ==> 1621 !h x. MEM x (h::l) ==> x divides (list_lcm (h::l)) 1622 Note MEM x (h::l) <=> x = h, or MEM x l by MEM 1623 and list_lcm (h::l) = lcm h (list_lcm l) by list_lcm_cons 1624 If x = h, 1625 divides h (lcm h (list_lcm l)) is true by LCM_IS_LEAST_COMMON_MULTIPLE 1626 If MEM x l, 1627 x divides (list_lcm l) by induction hypothesis 1628 (list_lcm l) divides (lcm h (list_lcm l)) by LCM_IS_LEAST_COMMON_MULTIPLE 1629 Hence x divides (lcm h (list_lcm l)) by DIVIDES_TRANS 1630*) 1631val list_lcm_is_common_multiple = store_thm( 1632 "list_lcm_is_common_multiple", 1633 ``!x l. MEM x l ==> x divides (list_lcm l)``, 1634 Induct_on `l` >> 1635 rw[] >> 1636 metis_tac[LCM_IS_LEAST_COMMON_MULTIPLE, DIVIDES_TRANS]); 1637 1638(* Theorem: If m is a common multiple of members of l, (list_lcm l) divides m. 1639 (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m *) 1640(* Proof: 1641 By induction on l. 1642 Base case: !m. (!x. MEM x [] ==> x divides m) ==> divides (list_lcm []) m 1643 Since list_lcm [] = 1 by list_lcm_nil 1644 and divides 1 m is true by ONE_DIVIDES_ALL 1645 Step case: !m. (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m ==> 1646 !h m. (!x. MEM x (h::l) ==> x divides m) ==> divides (list_lcm (h::l)) m 1647 Note MEM x (h::l) <=> x = h, or MEM x l by MEM 1648 and list_lcm (h::l) = lcm h (list_lcm l) by list_lcm_cons 1649 Put x = h, divides h m by MEM h (h::l) = T 1650 Put MEM x l, x divides m by MEM x (h::l) = T 1651 giving (list_lcm l) divides m by induction hypothesis 1652 Hence divides (lcm h (list_lcm l)) m by LCM_IS_LEAST_COMMON_MULTIPLE 1653*) 1654val list_lcm_is_least_common_multiple = store_thm( 1655 "list_lcm_is_least_common_multiple", 1656 ``!l m. (!x. MEM x l ==> x divides m) ==> (list_lcm l) divides m``, 1657 Induct >- 1658 rw[] >> 1659 rw[LCM_IS_LEAST_COMMON_MULTIPLE]); 1660 1661(* 1662> EVAL ``list_lcm []``; 1663val it = |- list_lcm [] = 1: thm 1664> EVAL ``list_lcm [1; 2; 3]``; 1665val it = |- list_lcm [1; 2; 3] = 6: thm 1666> EVAL ``list_lcm [1; 2; 3; 4; 5]``; 1667val it = |- list_lcm [1; 2; 3; 4; 5] = 60: thm 1668> EVAL ``list_lcm (GENLIST SUC 5)``; 1669val it = |- list_lcm (GENLIST SUC 5) = 60: thm 1670> EVAL ``list_lcm (GENLIST SUC 4)``; 1671val it = |- list_lcm (GENLIST SUC 4) = 12: thm 1672> EVAL ``lcm 5 (list_lcm (GENLIST SUC 4))``; 1673val it = |- lcm 5 (list_lcm (GENLIST SUC 4)) = 60: thm 1674> EVAL ``SNOC 5 (GENLIST SUC 4)``; 1675val it = |- SNOC 5 (GENLIST SUC 4) = [1; 2; 3; 4; 5]: thm 1676> EVAL ``list_lcm (SNOC 5 (GENLIST SUC 4))``; 1677val it = |- list_lcm (SNOC 5 (GENLIST SUC 4)) = 60: thm 1678> EVAL ``GENLIST (\k. leibniz 5 k) (SUC 5)``; 1679val it = |- GENLIST (\k. leibniz 5 k) (SUC 5) = [6; 30; 60; 60; 30; 6]: thm 1680> EVAL ``list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5))``; 1681val it = |- list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5)) = 60: thm 1682> EVAL ``list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5))``; 1683val it = |- (list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (\k. leibniz 5 k) (SUC 5))) <=> T: thm 1684> EVAL ``list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (leibniz 5) (SUC 5))``; 1685val it = |- (list_lcm (GENLIST SUC 5) = list_lcm (GENLIST (leibniz 5) (SUC 5))) <=> T: thm 1686*) 1687 1688(* Theorem: list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2) *) 1689(* Proof: 1690 By induction on l1. 1691 Base: !l2. list_lcm ([] ++ l2) = lcm (list_lcm []) (list_lcm l2) 1692 LHS = list_lcm ([] ++ l2) 1693 = list_lcm l2 by APPEND 1694 = lcm 1 (list_lcm l2) by LCM_1 1695 = lcm (list_lcm []) (list_lcm l2) by list_lcm_nil 1696 = RHS 1697 Step: !l2. list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2) ==> 1698 !h l2. list_lcm (h::l1 ++ l2) = lcm (list_lcm (h::l1)) (list_lcm l2) 1699 list_lcm (h::l1 ++ l2) 1700 = list_lcm (h::(l1 ++ l2)) by APPEND 1701 = lcm h (list_lcm (l1 ++ l2)) by list_lcm_cons 1702 = lcm h (lcm (list_lcm l1) (list_lcm l2)) by induction hypothesis 1703 = lcm (lcm h (list_lcm l1)) (list_lcm l2) by LCM_ASSOC 1704 = lcm (list_lcm (h::l1)) (list_lcm l2) by list_lcm_cons 1705*) 1706val list_lcm_append = store_thm( 1707 "list_lcm_append", 1708 ``!l1 l2. list_lcm (l1 ++ l2) = lcm (list_lcm l1) (list_lcm l2)``, 1709 Induct >- 1710 rw[] >> 1711 rw[LCM_ASSOC]); 1712 1713(* Theorem: list_lcm (l1 ++ l2 ++ l3) = list_lcm [(list_lcm l1); (list_lcm l2); (list_lcm l3)] *) 1714(* Proof: 1715 list_lcm (l1 ++ l2 ++ l3) 1716 = lcm (list_lcm (l1 ++ l2)) (list_lcm l3) by list_lcm_append 1717 = lcm (lcm (list_lcm l1) (list_lcm l2)) (list_lcm l3) by list_lcm_append 1718 = lcm (list_lcm l1) (lcm (list_lcm l2) (list_lcm l3)) by LCM_ASSOC 1719 = lcm (list_lcm l1) (list_lcm [(list_lcm l2); list_lcm l3]) by list_lcm_cons 1720 = list_lcm [list_lcm l1; list_lcm l2; list_lcm l3] by list_lcm_cons 1721*) 1722val list_lcm_append_3 = store_thm( 1723 "list_lcm_append_3", 1724 ``!l1 l2 l3. list_lcm (l1 ++ l2 ++ l3) = list_lcm [(list_lcm l1); (list_lcm l2); (list_lcm l3)]``, 1725 rw[list_lcm_append, LCM_ASSOC, list_lcm_cons]); 1726 1727(* Theorem: list_lcm (REVERSE l) = list_lcm l *) 1728(* Proof: 1729 By induction on l. 1730 Base: list_lcm (REVERSE []) = list_lcm [] 1731 True since REVERSE [] = [] by REVERSE_DEF 1732 Step: list_lcm (REVERSE l) = list_lcm l ==> 1733 !h. list_lcm (REVERSE (h::l)) = list_lcm (h::l) 1734 list_lcm (REVERSE (h::l)) 1735 = list_lcm (REVERSE l ++ [h]) by REVERSE_DEF 1736 = lcm (list_lcm (REVERSE l)) (list_lcm [h]) by list_lcm_append 1737 = lcm (list_lcm l) (list_lcm [h]) by induction hypothesis 1738 = lcm (list_lcm [h]) (list_lcm l) by LCM_COMM 1739 = list_lcm ([h] ++ l) by list_lcm_append 1740 = list_lcm (h::l) by CONS_APPEND 1741*) 1742val list_lcm_reverse = store_thm( 1743 "list_lcm_reverse", 1744 ``!l. list_lcm (REVERSE l) = list_lcm l``, 1745 Induct >- 1746 rw[] >> 1747 rpt strip_tac >> 1748 `list_lcm (REVERSE (h::l)) = list_lcm (REVERSE l ++ [h])` by rw[] >> 1749 `_ = lcm (list_lcm (REVERSE l)) (list_lcm [h])` by rw[list_lcm_append] >> 1750 `_ = lcm (list_lcm l) (list_lcm [h])` by rw[] >> 1751 `_ = lcm (list_lcm [h]) (list_lcm l)` by rw[LCM_COMM] >> 1752 `_ = list_lcm ([h] ++ l)` by rw[list_lcm_append] >> 1753 `_ = list_lcm (h::l)` by rw[] >> 1754 decide_tac); 1755 1756(* Theorem: list_lcm [1 .. (n + 1)] = lcm (n + 1) (list_lcm [1 .. n])) *) 1757(* Proof: 1758 list_lcm [1 .. (n + 1)] 1759 = list_lcm (SONC (n + 1) [1 .. n]) by listRangeINC_SNOC, 1 <= n + 1 1760 = lcm (n + 1) (list_lcm [1 .. n]) by list_lcm_snoc 1761*) 1762val list_lcm_suc = store_thm( 1763 "list_lcm_suc", 1764 ``!n. list_lcm [1 .. (n + 1)] = lcm (n + 1) (list_lcm [1 .. n])``, 1765 rw[listRangeINC_SNOC, list_lcm_snoc]); 1766 1767(* Theorem: l <> [] /\ EVERY_POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l *) 1768(* Proof: 1769 Note LENGTH l <> 0 by LENGTH_NIL 1770 and SUM l <= LENGTH l * list_lcm l by list_lcm_lower_bound 1771 so (SUM l) DIV (LENGTH l) <= list_lcm l by DIV_LE 1772*) 1773val list_lcm_nonempty_lower = store_thm( 1774 "list_lcm_nonempty_lower", 1775 ``!l. l <> [] /\ EVERY_POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l``, 1776 metis_tac[list_lcm_lower_bound, DIV_LE, LENGTH_NIL, NOT_ZERO_LT_ZERO]); 1777 1778(* Theorem: l <> [] /\ POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l *) 1779(* Proof: 1780 Note LENGTH l <> 0 by LENGTH_NIL 1781 and SUM l <= LENGTH l * list_lcm l by list_lcm_lower_bound_alt 1782 so (SUM l) DIV (LENGTH l) <= list_lcm l by DIV_LE 1783*) 1784val list_lcm_nonempty_lower_alt = store_thm( 1785 "list_lcm_nonempty_lower_alt", 1786 ``!l. l <> [] /\ POSITIVE l ==> (SUM l) DIV (LENGTH l) <= list_lcm l``, 1787 metis_tac[list_lcm_lower_bound_alt, DIV_LE, LENGTH_NIL, NOT_ZERO_LT_ZERO]); 1788 1789(* Theorem: MEM x l /\ MEM y l ==> (lcm x y) <= list_lcm l *) 1790(* Proof: 1791 Note x divides (list_lcm l) by list_lcm_is_common_multiple 1792 and y divides (list_lcm l) by list_lcm_is_common_multiple 1793 ==> (lcm x y) divides (list_lcm l) by LCM_IS_LEAST_COMMON_MULTIPLE 1794*) 1795val list_lcm_divisor_lcm_pair = store_thm( 1796 "list_lcm_divisor_lcm_pair", 1797 ``!l x y. MEM x l /\ MEM y l ==> (lcm x y) divides list_lcm l``, 1798 rw[list_lcm_is_common_multiple, LCM_IS_LEAST_COMMON_MULTIPLE]); 1799 1800(* Theorem: POSITIVE l /\ MEM x l /\ MEM y l ==> (lcm x y) <= list_lcm l *) 1801(* Proof: 1802 Note (lcm x y) divides (list_lcm l) by list_lcm_divisor_lcm_pair 1803 Now 0 < list_lcm l by list_lcm_pos_alt 1804 Thus (lcm x y) <= list_lcm l by DIVIDES_LE 1805*) 1806val list_lcm_lower_by_lcm_pair = store_thm( 1807 "list_lcm_lower_by_lcm_pair", 1808 ``!l x y. POSITIVE l /\ MEM x l /\ MEM y l ==> (lcm x y) <= list_lcm l``, 1809 rw[list_lcm_divisor_lcm_pair, list_lcm_pos_alt, DIVIDES_LE]); 1810 1811(* Theorem: 0 < m /\ (!x. MEM x l ==> x divides m) ==> list_lcm l <= m *) 1812(* Proof: 1813 Note list_lcm l divides m by list_lcm_is_least_common_multiple 1814 Thus list_lcm l <= m by DIVIDES_LE, 0 < m 1815*) 1816val list_lcm_upper_by_common_multiple = store_thm( 1817 "list_lcm_upper_by_common_multiple", 1818 ``!l m. 0 < m /\ (!x. MEM x l ==> x divides m) ==> list_lcm l <= m``, 1819 rw[list_lcm_is_least_common_multiple, DIVIDES_LE]); 1820 1821(* Theorem: list_lcm ls = FOLDR lcm 1 ls *) 1822(* Proof: 1823 By induction on ls. 1824 Base: list_lcm [] = FOLDR lcm 1 [] 1825 list_lcm [] 1826 = 1 by list_lcm_nil 1827 = FOLDR lcm 1 [] by FOLDR 1828 Step: list_lcm ls = FOLDR lcm 1 ls ==> 1829 !h. list_lcm (h::ls) = FOLDR lcm 1 (h::ls) 1830 list_lcm (h::ls) 1831 = lcm h (list_lcm ls) by list_lcm_def 1832 = lcm h (FOLDR lcm 1 ls) by induction hypothesis 1833 = FOLDR lcm 1 (h::ls) by FOLDR 1834*) 1835val list_lcm_by_FOLDR = store_thm( 1836 "list_lcm_by_FOLDR", 1837 ``!ls. list_lcm ls = FOLDR lcm 1 ls``, 1838 Induct >> rw[]); 1839 1840(* Theorem: list_lcm ls = FOLDL lcm 1 ls *) 1841(* Proof: 1842 Note COMM lcm since !x y. lcm x y = lcm y x by LCM_COMM 1843 and ASSOC lcm since !x y z. lcm x (lcm y z) = lcm (lcm x y) z by LCM_ASSOC 1844 Now list_lcm ls 1845 = FOLDR lcm 1 ls by list_lcm_by FOLDR 1846 = FOLDL lcm 1 ls by FOLDL_EQ_FOLDR, COMM lcm, ASSOC lcm 1847*) 1848val list_lcm_by_FOLDL = store_thm( 1849 "list_lcm_by_FOLDL", 1850 ``!ls. list_lcm ls = FOLDL lcm 1 ls``, 1851 simp[list_lcm_by_FOLDR] >> 1852 irule (GSYM FOLDL_EQ_FOLDR) >> 1853 rpt strip_tac >- 1854 rw[LCM_ASSOC, combinTheory.ASSOC_DEF] >> 1855 rw[LCM_COMM, combinTheory.COMM_DEF]); 1856 1857(* ------------------------------------------------------------------------- *) 1858(* Lists in Leibniz Triangle *) 1859(* ------------------------------------------------------------------------- *) 1860 1861(* ------------------------------------------------------------------------- *) 1862(* Veritcal Lists in Leibniz Triangle *) 1863(* ------------------------------------------------------------------------- *) 1864 1865(* Define Vertical List in Leibniz Triangle *) 1866(* 1867val leibniz_vertical_def = Define ` 1868 leibniz_vertical n = GENLIST SUC (SUC n) 1869`; 1870 1871(* Use overloading for leibniz_vertical n. *) 1872val _ = overload_on("leibniz_vertical", ``\n. GENLIST ((+) 1) (n + 1)``); 1873*) 1874 1875(* Define Vertical (downward list) in Leibniz Triangle *) 1876 1877(* Use overloading for leibniz_vertical n. *) 1878val _ = overload_on("leibniz_vertical", ``\n. [1 .. (n+1)]``); 1879 1880(* Theorem: leibniz_vertical n = GENLIST (\i. 1 + i) (n + 1) *) 1881(* Proof: 1882 leibniz_vertical n 1883 = [1 .. (n+1)] by notation 1884 = GENLIST (\i. 1 + i) (n+1 + 1 - 1) by listRangeINC_def 1885 = GENLIST (\i. 1 + i) (n + 1) by arithmetic 1886*) 1887val leibniz_vertical_alt = store_thm( 1888 "leibniz_vertical_alt", 1889 ``!n. leibniz_vertical n = GENLIST (\i. 1 + i) (n + 1)``, 1890 rw[listRangeINC_def]); 1891 1892(* Theorem: leibniz_vertical 0 = [1] *) 1893(* Proof: 1894 leibniz_vertical 0 1895 = [1 .. (0+1)] by notation 1896 = [1 .. 1] by arithmetic 1897 = [1] by listRangeINC_SING 1898*) 1899val leibniz_vertical_0 = store_thm( 1900 "leibniz_vertical_0", 1901 ``leibniz_vertical 0 = [1]``, 1902 rw[]); 1903 1904(* Theorem: LENGTH (leibniz_vertical n) = n + 1 *) 1905(* Proof: 1906 LENGTH (leibniz_vertical n) 1907 = LENGTH [1 .. (n+1)] by notation 1908 = n + 1 + 1 - 1 by listRangeINC_LEN 1909 = n + 1 by arithmetic 1910*) 1911val leibniz_vertical_len = store_thm( 1912 "leibniz_vertical_len", 1913 ``!n. LENGTH (leibniz_vertical n) = n + 1``, 1914 rw[listRangeINC_LEN]); 1915 1916(* Theorem: leibniz_vertical n <> [] *) 1917(* Proof: 1918 LENGTH (leibniz_vertical n) 1919 = n + 1 by leibniz_vertical_len 1920 <> 0 by ADD1, SUC_NOT_ZERO 1921 Thus leibniz_vertical n <> [] by LENGTH_EQ_0 1922*) 1923val leibniz_vertical_not_nil = store_thm( 1924 "leibniz_vertical_not_nil", 1925 ``!n. leibniz_vertical n <> []``, 1926 metis_tac[leibniz_vertical_len, LENGTH_EQ_0, DECIDE``!n. n + 1 <> 0``]); 1927 1928(* Theorem: EVERY_POSITIVE (leibniz_vertical n) *) 1929(* Proof: 1930 EVERY_POSITIVE (leibniz_vertical n) 1931 <=> EVERY_POSITIVE GENLIST (\i. 1 + i) (n+1) by leibniz_vertical_alt 1932 <=> !i. i < n + 1 ==> 0 < 1 + i by EVERY_GENLIST 1933 <=> !i. i < n + 1 ==> T by arithmetic 1934 <=> T 1935*) 1936val leibniz_vertical_pos = store_thm( 1937 "leibniz_vertical_pos", 1938 ``!n. EVERY_POSITIVE (leibniz_vertical n)``, 1939 rw[leibniz_vertical_alt, EVERY_GENLIST]); 1940 1941(* Theorem: POSITIVE (leibniz_vertical n) *) 1942(* Proof: by leibniz_vertical_pos, EVERY_MEM *) 1943val leibniz_vertical_pos_alt = store_thm( 1944 "leibniz_vertical_pos_alt", 1945 ``!n. POSITIVE (leibniz_vertical n)``, 1946 rw[leibniz_vertical_pos, EVERY_MEM]); 1947 1948(* Theorem: 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_vertical n) *) 1949(* Proof: 1950 Note: (leibniz_vertical n) has 1 to (n+1), inclusive: 1951 MEM x (leibniz_vertical n) 1952 <=> MEM x [1 .. (n+1)] by notation 1953 <=> 1 <= x /\ x <= n + 1 by listRangeINC_MEM 1954 <=> 0 < x /\ x <= n + 1 by num_CASES, LESS_EQ_MONO 1955*) 1956val leibniz_vertical_mem = store_thm( 1957 "leibniz_vertical_mem", 1958 ``!n x. 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_vertical n)``, 1959 rw[]); 1960 1961(* Theorem: leibniz_vertical (n + 1) = SNOC (n + 2) (leibniz_vertical n) *) 1962(* Proof: 1963 leibniz_vertical (n + 1) 1964 = [1 .. (n+1 +1)] by notation 1965 = SNOC (n+1 + 1) [1 .. (n+1)] by listRangeINC_SNOC 1966 = SNOC (n + 2) (leibniz_vertical n) by notation 1967*) 1968val leibniz_vertical_snoc = store_thm( 1969 "leibniz_vertical_snoc", 1970 ``!n. leibniz_vertical (n + 1) = SNOC (n + 2) (leibniz_vertical n)``, 1971 rw[listRangeINC_SNOC]);; 1972 1973(* Use overloading for leibniz_up n. *) 1974val _ = overload_on("leibniz_up", ``\n. REVERSE (leibniz_vertical n)``); 1975 1976(* Theorem: leibniz_up 0 = [1] *) 1977(* Proof: 1978 leibniz_up 0 1979 = REVERSE (leibniz_vertical 0) by notation 1980 = REVERSE [1] by leibniz_vertical_0 1981 = [1] by REVERSE_SING 1982*) 1983val leibniz_up_0 = store_thm( 1984 "leibniz_up_0", 1985 ``leibniz_up 0 = [1]``, 1986 rw[]); 1987 1988(* Theorem: LENGTH (leibniz_up n) = n + 1 *) 1989(* Proof: 1990 LENGTH (leibniz_up n) 1991 = LENGTH (REVERSE (leibniz_vertical n)) by notation 1992 = LENGTH (leibniz_vertical n) by LENGTH_REVERSE 1993 = n + 1 by leibniz_vertical_len 1994*) 1995val leibniz_up_len = store_thm( 1996 "leibniz_up_len", 1997 ``!n. LENGTH (leibniz_up n) = n + 1``, 1998 rw[leibniz_vertical_len]); 1999 2000(* Theorem: EVERY_POSITIVE (leibniz_up n) *) 2001(* Proof: 2002 EVERY_POSITIVE (leibniz_up n) 2003 <=> EVERY_POSITIVE (REVERSE (leibniz_vertical n)) by notation 2004 <=> EVERY_POSITIVE (leibniz_vertical n) by EVERY_REVERSE 2005 <=> T by leibniz_vertical_pos 2006*) 2007val leibniz_up_pos = store_thm( 2008 "leibniz_up_pos", 2009 ``!n. EVERY_POSITIVE (leibniz_up n)``, 2010 rw[leibniz_vertical_pos, EVERY_REVERSE]); 2011 2012(* Theorem: 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_up n) *) 2013(* Proof: 2014 Note: (leibniz_up n) has (n+1) downto 1, inclusive: 2015 MEM x (leibniz_up n) 2016 <=> MEM x (REVERSE (leibniz_vertical n)) by notation 2017 <=> MEM x (leibniz_vertical n) by MEM_REVERSE 2018 <=> T by leibniz_vertical_mem 2019*) 2020val leibniz_up_mem = store_thm( 2021 "leibniz_up_mem", 2022 ``!n x. 0 < x /\ x <= (n + 1) <=> MEM x (leibniz_up n)``, 2023 rw[]); 2024 2025(* Theorem: leibniz_up (n + 1) = (n + 2) :: (leibniz_up n) *) 2026(* Proof: 2027 leibniz_up (n + 1) 2028 = REVERSE (leibniz_vertical (n + 1)) by notation 2029 = REVERSE (SNOC (n + 2) (leibniz_vertical n)) by leibniz_vertical_snoc 2030 = (n + 2) :: (leibniz_up n) by REVERSE_SNOC 2031*) 2032val leibniz_up_cons = store_thm( 2033 "leibniz_up_cons", 2034 ``!n. leibniz_up (n + 1) = (n + 2) :: (leibniz_up n)``, 2035 rw[leibniz_vertical_snoc, REVERSE_SNOC]); 2036 2037(* ------------------------------------------------------------------------- *) 2038(* Horizontal List in Leibniz Triangle *) 2039(* ------------------------------------------------------------------------- *) 2040 2041(* Define row (horizontal list) in Leibniz Triangle *) 2042(* 2043val leibniz_horizontal_def = Define ` 2044 leibniz_horizontal n = GENLIST (leibniz n) (SUC n) 2045`; 2046 2047(* Use overloading for leibniz_horizontal n. *) 2048val _ = overload_on("leibniz_horizontal", ``\n. GENLIST (leibniz n) (n + 1)``); 2049*) 2050 2051(* Use overloading for leibniz_horizontal n. *) 2052val _ = overload_on("leibniz_horizontal", ``\n. GENLIST (leibniz n) (n + 1)``); 2053 2054(* 2055> EVAL ``leibniz_horizontal 0``; 2056val it = |- leibniz_horizontal 0 = [1]: thm 2057> EVAL ``leibniz_horizontal 1``; 2058val it = |- leibniz_horizontal 1 = [2; 2]: thm 2059> EVAL ``leibniz_horizontal 2``; 2060val it = |- leibniz_horizontal 2 = [3; 6; 3]: thm 2061> EVAL ``leibniz_horizontal 3``; 2062val it = |- leibniz_horizontal 3 = [4; 12; 12; 4]: thm 2063> EVAL ``leibniz_horizontal 4``; 2064val it = |- leibniz_horizontal 4 = [5; 20; 30; 20; 5]: thm 2065> EVAL ``leibniz_horizontal 5``; 2066val it = |- leibniz_horizontal 5 = [6; 30; 60; 60; 30; 6]: thm 2067> EVAL ``leibniz_horizontal 6``; 2068val it = |- leibniz_horizontal 6 = [7; 42; 105; 140; 105; 42; 7]: thm 2069> EVAL ``leibniz_horizontal 7``; 2070val it = |- leibniz_horizontal 7 = [8; 56; 168; 280; 280; 168; 56; 8]: thm 2071> EVAL ``leibniz_horizontal 8``; 2072val it = |- leibniz_horizontal 8 = [9; 72; 252; 504; 630; 504; 252; 72; 9]: thm 2073*) 2074 2075(* Theorem: leibniz_horizontal 0 = [1] *) 2076(* Proof: 2077 leibniz_horizontal 0 2078 = GENLIST (leibniz 0) (0 + 1) by notation 2079 = GENLIST (leibniz 0) 1 by arithmetic 2080 = [leibniz 0 0] by GENLIST 2081 = [1] by leibniz_n_0 2082*) 2083val leibniz_horizontal_0 = store_thm( 2084 "leibniz_horizontal_0", 2085 ``leibniz_horizontal 0 = [1]``, 2086 rw_tac std_ss[GENLIST_1, leibniz_n_0]); 2087 2088(* Theorem: LENGTH (leibniz_horizontal n) = n + 1 *) 2089(* Proof: 2090 LENGTH (leibniz_horizontal n) 2091 = LENGTH (GENLIST (leibniz n) (n + 1)) by notation 2092 = n + 1 by LENGTH_GENLIST 2093*) 2094val leibniz_horizontal_len = store_thm( 2095 "leibniz_horizontal_len", 2096 ``!n. LENGTH (leibniz_horizontal n) = n + 1``, 2097 rw[]); 2098 2099(* Theorem: k <= n ==> EL k (leibniz_horizontal n) = leibniz n k *) 2100(* Proof: 2101 Note k <= n means k < SUC n. 2102 EL k (leibniz_horizontal n) 2103 = EL k (GENLIST (leibniz n) (n + 1)) by notation 2104 = EL k (GENLIST (leibniz n) (SUC n)) by ADD1 2105 = leibniz n k by EL_GENLIST, k < SUC n. 2106*) 2107val leibniz_horizontal_el = store_thm( 2108 "leibniz_horizontal_el", 2109 ``!n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)``, 2110 rw[LESS_EQ_IMP_LESS_SUC]); 2111 2112(* Theorem: k <= n ==> MEM (leibniz n k) (leibniz_horizontal n) *) 2113(* Proof: 2114 Note k <= n ==> k < (n + 1) 2115 Thus MEM (leibniz n k) (GENLIST (leibniz n) (n + 1)) by MEM_GENLIST 2116 or MEM (leibniz n k) (leibniz_horizontal n) by notation 2117*) 2118val leibniz_horizontal_mem = store_thm( 2119 "leibniz_horizontal_mem", 2120 ``!n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n)``, 2121 metis_tac[MEM_GENLIST, DECIDE``k <= n ==> k < n + 1``]); 2122 2123(* Theorem: MEM (leibniz n k) (leibniz_horizontal n) <=> k <= n *) 2124(* Proof: 2125 If part: (leibniz n k) (leibniz_horizontal n) ==> k <= n 2126 By contradiction, suppose n < k. 2127 Then leibniz n k = 0 by binomial_less_0, ~(k <= n) 2128 But ?m. m < n + 1 ==> 0 = leibniz n m by MEM_GENLIST 2129 or m <= n ==> leibniz n m = 0 by m < n + 1 2130 Yet leibniz n m <> 0 by leibniz_eq_0 2131 This is a contradiction. 2132 Only-if part: k <= n ==> (leibniz n k) (leibniz_horizontal n) 2133 By MEM_GENLIST, this is to show: 2134 ?m. m < n + 1 /\ (leibniz n k = leibniz n m) 2135 Note k <= n ==> k < n + 1, 2136 Take m = k, the result follows. 2137*) 2138val leibniz_horizontal_mem_iff = store_thm( 2139 "leibniz_horizontal_mem_iff", 2140 ``!n k. MEM (leibniz n k) (leibniz_horizontal n) <=> k <= n``, 2141 rw_tac bool_ss[EQ_IMP_THM] >| [ 2142 spose_not_then strip_assume_tac >> 2143 `leibniz n k = 0` by rw[leibniz_less_0] >> 2144 fs[MEM_GENLIST] >> 2145 `m <= n` by decide_tac >> 2146 fs[binomial_eq_0], 2147 rw[MEM_GENLIST] >> 2148 `k < n + 1` by decide_tac >> 2149 metis_tac[] 2150 ]); 2151 2152(* Theorem: MEM x (leibniz_horizontal n) <=> ?k. k <= n /\ (x = leibniz n k) *) 2153(* Proof: 2154 By MEM_GENLIST, this is to show: 2155 (?m. m < n + 1 /\ (x = (n + 1) * binomial n m)) <=> ?k. k <= n /\ (x = (n + 1) * binomial n k) 2156 Since m < n + 1 <=> m <= n by LE_LT1 2157 This is trivially true. 2158*) 2159val leibniz_horizontal_member = store_thm( 2160 "leibniz_horizontal_member", 2161 ``!n x. MEM x (leibniz_horizontal n) <=> ?k. k <= n /\ (x = leibniz n k)``, 2162 metis_tac[MEM_GENLIST, LE_LT1]); 2163 2164(* Theorem: k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k) *) 2165(* Proof: by EL_GENLIST *) 2166val leibniz_horizontal_element = store_thm( 2167 "leibniz_horizontal_element", 2168 ``!n k. k <= n ==> (EL k (leibniz_horizontal n) = leibniz n k)``, 2169 rw[EL_GENLIST]); 2170 2171(* Theorem: TAKE 1 (leibniz_horizontal (n + 1)) = [n + 2] *) 2172(* Proof: 2173 TAKE 1 (leibniz_horizontal (n + 1)) 2174 = TAKE 1 (GENLIST (leibniz (n + 1)) (n + 1 + 1)) by notation 2175 = TAKE 1 (GENLIST (leibniz (SUC n)) (SUC (SUC n))) by ADD1 2176 = TAKE 1 ((leibniz (SUC n) 0) :: GENLIST ((leibniz (SUC n)) o SUC) n) by GENLIST_CONS 2177 = (leibniz (SUC n) 0):: TAKE 0 (GENLIST ((leibniz (SUC n)) o SUC) n) by TAKE_def 2178 = [leibniz (SUC n) 0]:: [] by TAKE_0 2179 = [SUC n + 1] by leibniz_n_0 2180 = [n + 2] by ADD1 2181*) 2182val leibniz_horizontal_head = store_thm( 2183 "leibniz_horizontal_head", 2184 ``!n. TAKE 1 (leibniz_horizontal (n + 1)) = [n + 2]``, 2185 rpt strip_tac >> 2186 `(!n. n + 1 = SUC n) /\ (!n. n + 2 = SUC (SUC n))` by decide_tac >> 2187 rw[GENLIST_CONS, leibniz_n_0]); 2188 2189(* Theorem: k <= n ==> (leibniz n k) divides list_lcm (leibniz_horizontal n) *) 2190(* Proof: 2191 Note MEM (leibniz n k) (leibniz_horizontal n) by leibniz_horizontal_mem 2192 so (leibniz n k) divides list_lcm (leibniz_horizontal n) by list_lcm_is_common_multiple 2193*) 2194val leibniz_horizontal_divisor = store_thm( 2195 "leibniz_horizontal_divisor", 2196 ``!n k. k <= n ==> (leibniz n k) divides list_lcm (leibniz_horizontal n)``, 2197 rw[leibniz_horizontal_mem, list_lcm_is_common_multiple]); 2198 2199(* Theorem: EVERY_POSITIVE (leibniz_horizontal n) *) 2200(* Proof: 2201 Let l = leibniz_horizontal n 2202 Then LENGTH l = n + 1 by leibniz_horizontal_len 2203 EVERY_POSITIVE l 2204 <=> !k. k < LENGTH l ==> 0 < (EL k l) by EVERY_EL 2205 <=> !k. k < n + 1 ==> 0 < (EL k l) by above 2206 <=> !k. k <= n ==> 0 < EL k l by arithmetic 2207 <=> !k. k <= n ==> 0 < leibniz n k by leibniz_horizontal_el 2208 <=> T by leibniz_pos 2209*) 2210Theorem leibniz_horizontal_pos: 2211 !n. EVERY_POSITIVE (leibniz_horizontal n) 2212Proof 2213 simp[EVERY_EL, binomial_pos] 2214QED 2215 2216(* Theorem: POSITIVE (leibniz_horizontal n) *) 2217(* Proof: by leibniz_horizontal_pos, EVERY_MEM *) 2218val leibniz_horizontal_pos_alt = store_thm( 2219 "leibniz_horizontal_pos_alt", 2220 ``!n. POSITIVE (leibniz_horizontal n)``, 2221 metis_tac[leibniz_horizontal_pos, EVERY_MEM]); 2222 2223(* Theorem: leibniz_horizontal n = MAP (\j. (n+1) * j) (binomial_horizontal n) *) 2224(* Proof: 2225 leibniz_horizontal n 2226 = GENLIST (leibniz n) (n + 1) by notation 2227 = GENLIST ((\j. (n + 1) * j) o (binomial n)) (n + 1) by leibniz_alt 2228 = MAP (\j. (n + 1) * j) (GENLIST (binomial n) (n + 1)) by MAP_GENLIST 2229 = MAP (\j. (n + 1) * j) (binomial_horizontal n) by notation 2230*) 2231val leibniz_horizontal_alt = store_thm( 2232 "leibniz_horizontal_alt", 2233 ``!n. leibniz_horizontal n = MAP (\j. (n+1) * j) (binomial_horizontal n)``, 2234 rw_tac std_ss[leibniz_alt, MAP_GENLIST]); 2235 2236(* Theorem: list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n) *) 2237(* Proof: 2238 Since LENGTH (binomial_horizontal n) = n + 1 by binomial_horizontal_len 2239 binomial_horizontal n <> [] by LENGTH_NIL ... [1] 2240 list_lcm (leibniz_horizontal n) 2241 = list_lcm (MAP (\j (n+1) * j) (binomial_horizontal n)) by leibniz_horizontal_alt 2242 = (n + 1) * list_lcm (binomial_horizontal n) by list_lcm_map_times, [1] 2243*) 2244val leibniz_horizontal_lcm_alt = store_thm( 2245 "leibniz_horizontal_lcm_alt", 2246 ``!n. list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n)``, 2247 rpt strip_tac >> 2248 `LENGTH (binomial_horizontal n) = n + 1` by rw[binomial_horizontal_len] >> 2249 `n + 1 <> 0` by decide_tac >> 2250 `binomial_horizontal n <> []` by metis_tac[LENGTH_NIL] >> 2251 rw_tac std_ss[leibniz_horizontal_alt, list_lcm_map_times]); 2252 2253(* Theorem: SUM (leibniz_horizontal n) = (n + 1) * SUM (binomial_horizontal n) *) 2254(* Proof: 2255 SUM (leibniz_horizontal n) 2256 = SUM (MAP (\j. (n + 1) * j) (binomial_horizontal n)) by leibniz_horizontal_alt 2257 = (n + 1) * SUM (binomial_horizontal n) by SUM_MULT 2258*) 2259val leibniz_horizontal_sum = store_thm( 2260 "leibniz_horizontal_sum", 2261 ``!n. SUM (leibniz_horizontal n) = (n + 1) * SUM (binomial_horizontal n)``, 2262 rw[leibniz_horizontal_alt, SUM_MULT] >> 2263 `(\j. j * (n + 1)) = $* (n + 1)` by rw[FUN_EQ_THM] >> 2264 rw[]); 2265 2266(* Theorem: SUM (leibniz_horizontal n) = (n + 1) * 2 ** n *) 2267(* Proof: 2268 SUM (leibniz_horizontal n) 2269 = (n + 1) * SUM (binomial_horizontal n) by leibniz_horizontal_sum 2270 = (n + 1) * 2 ** n by binomial_horizontal_sum 2271*) 2272val leibniz_horizontal_sum_eqn = store_thm( 2273 "leibniz_horizontal_sum_eqn", 2274 ``!n. SUM (leibniz_horizontal n) = (n + 1) * 2 ** n``, 2275 rw[leibniz_horizontal_sum, binomial_horizontal_sum]); 2276 2277(* Theorem: SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = SUM (binomial_horizontal n) *) 2278(* Proof: 2279 Note LENGTH (leibniz_horizontal n) = n + 1 by leibniz_horizontal_len 2280 so 0 < LENGTH (leibniz_horizontal n) by 0 < n + 1 2281 2282 SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) 2283 = ((n + 1) * SUM (binomial_horizontal n)) DIV (n + 1) by leibniz_horizontal_sum 2284 = SUM (binomial_horizontal n) by MULT_TO_DIV, 0 < n + 1 2285*) 2286val leibniz_horizontal_average = store_thm( 2287 "leibniz_horizontal_average", 2288 ``!n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = SUM (binomial_horizontal n)``, 2289 metis_tac[leibniz_horizontal_sum, leibniz_horizontal_len, MULT_TO_DIV, DECIDE``0 < n + 1``]); 2290 2291(* Theorem: SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 2 ** n *) 2292(* Proof: 2293 SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) 2294 = SUM (binomial_horizontal n) by leibniz_horizontal_average 2295 = 2 ** n by binomial_horizontal_sum 2296*) 2297val leibniz_horizontal_average_eqn = store_thm( 2298 "leibniz_horizontal_average_eqn", 2299 ``!n. SUM (leibniz_horizontal n) DIV LENGTH (leibniz_horizontal n) = 2 ** n``, 2300 rw[leibniz_horizontal_average, binomial_horizontal_sum]); 2301 2302(* ------------------------------------------------------------------------- *) 2303(* Transform from Vertical LCM to Horizontal LCM. *) 2304(* ------------------------------------------------------------------------- *) 2305 2306(* ------------------------------------------------------------------------- *) 2307(* Using Triplet and Paths *) 2308(* ------------------------------------------------------------------------- *) 2309 2310(* Define a triple type *) 2311val _ = Hol_datatype` 2312 triple = <| a: num; 2313 b: num; 2314 c: num 2315 |> 2316`; 2317 2318(* A triplet is a triple composed of Leibniz node and children. *) 2319val triplet_def = Define` 2320 (triplet n k):triple = 2321 <| a := leibniz n k; 2322 b := leibniz (n + 1) k; 2323 c := leibniz (n + 1) (k + 1) 2324 |> 2325`; 2326 2327(* can even do this after definition of triple type: 2328 2329val triple_def = Define` 2330 triple n k = 2331 <| a := leibniz n k; 2332 b := leibniz (n + 1) k; 2333 c := leibniz (n + 1) (k + 1) 2334 |> 2335`; 2336*) 2337 2338(* Overload elements of a triplet *) 2339(* 2340val _ = overload_on("tri_a", ``leibniz n k``); 2341val _ = overload_on("tri_b", ``leibniz (SUC n) k``); 2342val _ = overload_on("tri_c", ``leibniz (SUC n) (SUC k)``); 2343 2344val _ = overload_on("tri_a", ``(triple n k).a``); 2345val _ = overload_on("tri_b", ``(triple n k).b``); 2346val _ = overload_on("tri_c", ``(triple n k).c``); 2347*) 2348val _ = temp_overload_on("ta", ``(triplet n k).a``); 2349val _ = temp_overload_on("tb", ``(triplet n k).b``); 2350val _ = temp_overload_on("tc", ``(triplet n k).c``); 2351 2352(* Theorem: (ta = leibniz n k) /\ (tb = leibniz (n + 1) k) /\ (tc = leibniz (n + 1) (k + 1)) *) 2353(* Proof: by triplet_def *) 2354val leibniz_triplet_member = store_thm( 2355 "leibniz_triplet_member", 2356 ``!n k. (ta = leibniz n k) /\ (tb = leibniz (n + 1) k) /\ (tc = leibniz (n + 1) (k + 1))``, 2357 rw[triplet_def]); 2358 2359(* Theorem: (k + 1) * tc = (n + 1 - k) * tb *) 2360(* Proof: 2361 Apply: > leibniz_right_eqn |> SPEC ``n+1``; 2362 val it = |- 0 < n + 1 ==> !k. (k + 1) * leibniz (n + 1) (k + 1) = (n + 1 - k) * leibniz (n + 1) k: thm 2363*) 2364val leibniz_right_entry = store_thm( 2365 "leibniz_right_entry", 2366 ``!(n k):num. (k + 1) * tc = (n + 1 - k) * tb``, 2367 rw_tac arith_ss[triplet_def, leibniz_right_eqn]); 2368 2369(* Theorem: (n + 2) * ta = (n + 1 - k) * tb *) 2370(* Proof: 2371 Apply: > leibniz_up_eqn |> SPEC ``n+1``; 2372 val it = |- 0 < n + 1 ==> !k. (n + 1 + 1) * leibniz (n + 1 - 1) k = (n + 1 - k) * leibniz (n + 1) k: thm 2373*) 2374val leibniz_up_entry = store_thm( 2375 "leibniz_up_entry", 2376 ``!(n k):num. (n + 2) * ta = (n + 1 - k) * tb``, 2377 rw_tac std_ss[triplet_def, leibniz_up_eqn |> SPEC ``n+1`` |> SIMP_RULE arith_ss[]]); 2378 2379(* Theorem: ta * tb = tc * (tb - ta) *) 2380(* Proof: 2381 Apply > leibniz_property |> SPEC ``n+1``; 2382 val it = |- 0 < n + 1 ==> !k. !k. leibniz (n + 1) k * leibniz (n + 1 - 1) k = 2383 leibniz (n + 1) (k + 1) * (leibniz (n + 1) k - leibniz (n + 1 - 1) k): thm 2384*) 2385val leibniz_triplet_property = store_thm( 2386 "leibniz_triplet_property", 2387 ``!(n k):num. ta * tb = tc * (tb - ta)``, 2388 rw_tac std_ss[triplet_def, MULT_COMM, leibniz_property |> SPEC ``n+1`` |> SIMP_RULE arith_ss[]]); 2389 2390(* Direct proof of same result, for the paper. *) 2391 2392(* Theorem: ta * tb = tc * (tb - ta) *) 2393(* Proof: 2394 If n < k, 2395 Note n < k ==> ta = 0 by triplet_def, leibniz_less_0 2396 also n + 1 < k + 1 ==> tc = 0 by triplet_def, leibniz_less_0 2397 Thus ta * tb = 0 = tc * (tb - ta) by MULT_EQ_0 2398 If ~(n < k), 2399 Then (n + 2) - (n + 1 - k) = k + 1 by arithmetic, k <= n. 2400 2401 (k + 1) * ta * tb 2402 = (n + 2 - (n + 1 - k)) * ta * tb 2403 = (n + 2) * ta * tb - (n + 1 - k) * ta * tb by RIGHT_SUB_DISTRIB 2404 = (n + 1 - k) * tb * tb - (n + 1 - k) * ta * tb by leibniz_up_entry 2405 = (n + 1 - k) * tb * tb - (n + 1 - k) * tb * ta by MULT_ASSOC, MULT_COMM 2406 = (n + 1 - k) * tb * (tb - ta) by LEFT_SUB_DISTRIB 2407 = (k + 1) * tc * (tb - ta) by leibniz_right_entry 2408 2409 Since k + 1 <> 0, the result follows by MULT_LEFT_CANCEL 2410*) 2411val leibniz_triplet_property = store_thm( 2412 "leibniz_triplet_property", 2413 ``!(n k):num. ta * tb = tc * (tb - ta)``, 2414 rpt strip_tac >> 2415 Cases_on `n < k` >- 2416 rw[triplet_def, leibniz_less_0] >> 2417 `(n + 2) - (n + 1 - k) = k + 1` by decide_tac >> 2418 `(k + 1) * ta * tb = (n + 2 - (n + 1 - k)) * ta * tb` by rw[] >> 2419 `_ = (n + 2) * ta * tb - (n + 1 - k) * ta * tb` by rw_tac std_ss[RIGHT_SUB_DISTRIB] >> 2420 `_ = (n + 1 - k) * tb * tb - (n + 1 - k) * ta * tb` by rw_tac std_ss[leibniz_up_entry] >> 2421 `_ = (n + 1 - k) * tb * tb - (n + 1 - k) * tb * ta` by metis_tac[MULT_ASSOC, MULT_COMM] >> 2422 `_ = (n + 1 - k) * tb * (tb - ta)` by rw_tac std_ss[LEFT_SUB_DISTRIB] >> 2423 `_ = (k + 1) * tc * (tb - ta)` by rw_tac std_ss[leibniz_right_entry] >> 2424 `k + 1 <> 0` by decide_tac >> 2425 metis_tac[MULT_LEFT_CANCEL, MULT_ASSOC]); 2426 2427(* Theorem: lcm tb ta = lcm tb tc *) 2428(* Proof: 2429 Apply: > leibniz_lcm_exchange |> SPEC ``n+1``; 2430 val it = |- 0 < n + 1 ==> 2431 !k. lcm (leibniz (n + 1) k) (leibniz (n + 1 - 1) k) = 2432 lcm (leibniz (n + 1) k) (leibniz (n + 1) (k + 1)): thm 2433*) 2434val leibniz_triplet_lcm = store_thm( 2435 "leibniz_triplet_lcm", 2436 ``!(n k):num. lcm tb ta = lcm tb tc``, 2437 rw_tac std_ss[triplet_def, leibniz_lcm_exchange |> SPEC ``n+1`` |> SIMP_RULE arith_ss[]]); 2438 2439(* ------------------------------------------------------------------------- *) 2440(* Zigzag Path in Leibniz Triangle *) 2441(* ------------------------------------------------------------------------- *) 2442 2443(* Define a path type *) 2444val _ = temp_type_abbrev("path", Type `:num list`); 2445 2446(* Define paths reachable by one zigzag *) 2447val leibniz_zigzag_def = Define` 2448 leibniz_zigzag (p1: path) (p2: path) <=> 2449 ?(n k):num (x y):path. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y) 2450`; 2451val _ = overload_on("zigzag", ``leibniz_zigzag``); 2452val _ = set_fixity "zigzag" (Infix(NONASSOC, 450)); (* same as relation *) 2453 2454(* Theorem: p1 zigzag p2 ==> (list_lcm p1 = list_lcm p2) *) 2455(* Proof: 2456 Given p1 zigzag p2, 2457 ==> ?n k x y. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y) by leibniz_zigzag_def 2458 2459 list_lcm p1 2460 = list_lcm (x ++ [tb; ta] ++ y) by above 2461 = lcm (list_lcm (x ++ [tb; ta])) (list_lcm y) by list_lcm_append 2462 = lcm (list_lcm (x ++ ([tb; ta]))) (list_lcm y) by APPEND_ASSOC 2463 = lcm (lcm (list_lcm x) (list_lcm ([tb; ta]))) (list_lcm y) by list_lcm_append 2464 = lcm (lcm (list_lcm x) (lcm tb ta)) (list_lcm y) by list_lcm_append, list_lcm_sing 2465 = lcm (lcm (list_lcm x) (lcm tb tc)) (list_lcm y) by leibniz_triplet_lcm 2466 = lcm (lcm (list_lcm x) (list_lcm ([tb; tc]))) (list_lcm y) by list_lcm_append, list_lcm_sing 2467 = lcm (list_lcm (x ++ ([tb; tc]))) (list_lcm y) by list_lcm_append 2468 = lcm (list_lcm (x ++ [tb; tc])) (list_lcm y) by APPEND_ASSOC 2469 = list_lcm (x ++ [tb; tc] ++ y) by list_lcm_append 2470 = list_lcm p2 by above 2471*) 2472val list_lcm_zigzag = store_thm( 2473 "list_lcm_zigzag", 2474 ``!p1 p2. p1 zigzag p2 ==> (list_lcm p1 = list_lcm p2)``, 2475 rw_tac std_ss[leibniz_zigzag_def] >> 2476 `list_lcm (x ++ [tb; ta] ++ y) = lcm (list_lcm (x ++ [tb; ta])) (list_lcm y)` by rw[list_lcm_append] >> 2477 `_ = lcm (list_lcm (x ++ ([tb; ta]))) (list_lcm y)` by rw[] >> 2478 `_ = lcm (lcm (list_lcm x) (lcm tb ta)) (list_lcm y)` by rw[list_lcm_append] >> 2479 `_ = lcm (lcm (list_lcm x) (lcm tb tc)) (list_lcm y)` by rw[leibniz_triplet_lcm] >> 2480 `_ = lcm (list_lcm (x ++ ([tb; tc]))) (list_lcm y)` by rw[list_lcm_append] >> 2481 `_ = lcm (list_lcm (x ++ [tb; tc])) (list_lcm y)` by rw[] >> 2482 `_ = list_lcm (x ++ [tb; tc] ++ y)` by rw[list_lcm_append] >> 2483 rw[]); 2484 2485(* Theorem: p1 zigzag p2 ==> !x. ([x] ++ p1) zigzag ([x] ++ p2) *) 2486(* Proof: 2487 Since p1 zigzag p2 2488 ==> ?n k x y. (p1 = x ++ [tb; ta] ++ y) /\ (p2 = x ++ [tb; tc] ++ y) by leibniz_zigzag_def 2489 2490 [x] ++ p1 2491 = [x] ++ (x ++ [tb; ta] ++ y) by above 2492 = [x] ++ x ++ [tb; ta] ++ y by APPEND 2493 [x] ++ p2 2494 = [x] ++ (x ++ [tb; tc] ++ y) by above 2495 = [x] ++ x ++ [tb; tc] ++ y by APPEND 2496 Take new x = [x] ++ x, new y = y. 2497 Then ([x] ++ p1) zigzag ([x] ++ p2) by leibniz_zigzag_def 2498*) 2499val leibniz_zigzag_tail = store_thm( 2500 "leibniz_zigzag_tail", 2501 ``!p1 p2. p1 zigzag p2 ==> !x. ([x] ++ p1) zigzag ([x] ++ p2)``, 2502 metis_tac[leibniz_zigzag_def, APPEND]); 2503 2504(* Theorem: k <= n ==> 2505 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) zigzag 2506 TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n) *) 2507(* Proof: 2508 Since k <= n, k < n + 1, and k + 1 < n + 2. 2509 Hence k < LENGTH (leibniz_horizontal (n + 1)), 2510 2511 Let x = TAKE k (leibniz_horizontal (n + 1)) 2512 and y = DROP (k + 1) (leibniz_horizontal n) 2513 TAKE (k + 1) (leibniz_horizontal (n + 1)) 2514 = TAKE (SUC k) (leibniz_horizontal (SUC n)) by ADD1 2515 = SNOC tb x by TAKE_SUC_BY_TAKE, k < LENGTH (leibniz_horizontal (n + 1)) 2516 = x ++ [tb] by SNOC_APPEND 2517 TAKE (k + 2) (leibniz_horizontal (n + 1)) 2518 = TAKE (SUC (SUC k)) (leibniz_horizontal (SUC n)) by ADD1 2519 = SNOC tc (SNOC tb x) by TAKE_SUC_BY_TAKE, k + 1 < LENGTH (leibniz_horizontal (n + 1)) 2520 = x ++ [tb; tc] by SNOC_APPEND 2521 DROP k (leibniz_horizontal n) 2522 = ta :: y by DROP_BY_DROP_SUC, k < LENGTH (leibniz_horizontal n) 2523 = [ta] ++ y by CONS_APPEND 2524 Hence 2525 Let p1 = TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) 2526 = x ++ [tb] ++ [ta] ++ y 2527 = x ++ [tb; ta] ++ y by APPEND 2528 Let p2 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n) 2529 = x ++ [tb; tc] ++ y 2530 Therefore p1 zigzag p2 by leibniz_zigzag_def 2531*) 2532val leibniz_horizontal_zigzag = store_thm( 2533 "leibniz_horizontal_zigzag", 2534 ``!n k. k <= n ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) zigzag 2535 TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)``, 2536 rpt strip_tac >> 2537 qabbrev_tac `x = TAKE k (leibniz_horizontal (n + 1))` >> 2538 qabbrev_tac `y = DROP (k + 1) (leibniz_horizontal n)` >> 2539 `k <= n + 1` by decide_tac >> 2540 `EL k (leibniz_horizontal n) = ta` by rw_tac std_ss[triplet_def, leibniz_horizontal_el] >> 2541 `EL k (leibniz_horizontal (n + 1)) = tb` by rw_tac std_ss[triplet_def, leibniz_horizontal_el] >> 2542 `EL (k + 1) (leibniz_horizontal (n + 1)) = tc` by rw_tac std_ss[triplet_def, leibniz_horizontal_el] >> 2543 `k < n + 1` by decide_tac >> 2544 `k < LENGTH (leibniz_horizontal (n + 1))` by rw[leibniz_horizontal_len] >> 2545 `TAKE (k + 1) (leibniz_horizontal (n + 1)) = TAKE (SUC k) (leibniz_horizontal (n + 1))` by rw[ADD1] >> 2546 `_ = SNOC tb x` by rw[TAKE_SUC_BY_TAKE, Abbr`x`] >> 2547 `_ = x ++ [tb]` by rw[] >> 2548 `SUC k < n + 2` by decide_tac >> 2549 `SUC k < LENGTH (leibniz_horizontal (n + 1))` by rw[leibniz_horizontal_len] >> 2550 `TAKE (k + 2) (leibniz_horizontal (n + 1)) = TAKE (SUC (SUC k)) (leibniz_horizontal (n + 1))` by rw[ADD1] >> 2551 `_ = SNOC tc (SNOC tb x)` by rw_tac std_ss[TAKE_SUC_BY_TAKE, ADD1, Abbr`x`] >> 2552 `_ = x ++ [tb; tc]` by rw[] >> 2553 `DROP k (leibniz_horizontal n) = [ta] ++ y` by rw[DROP_BY_DROP_SUC, ADD1, Abbr`y`] >> 2554 qabbrev_tac `p1 = TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n)` >> 2555 qabbrev_tac `p2 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ y` >> 2556 `p1 = x ++ [tb; ta] ++ y` by rw[Abbr`p1`, Abbr`x`, Abbr`y`] >> 2557 `p2 = x ++ [tb; tc] ++ y` by rw[Abbr`p2`, Abbr`x`] >> 2558 metis_tac[leibniz_zigzag_def]); 2559 2560(* Theorem: (leibniz_up 1) zigzag (leibniz_horizontal 1) *) 2561(* Proof: 2562 Since leibniz_up 1 2563 = [2; 1] by EVAL_TAC 2564 = [] ++ [2; 1] ++ [] by EVAL_TAC 2565 and leibniz_horizontal 1 2566 = [2; 2] by EVAL_TAC 2567 = [] ++ [2; 2] ++ [] by EVAL_TAC 2568 Now the first Leibniz triplet is: 2569 (triplet 0 0).a = 1 by EVAL_TAC 2570 (triplet 0 0).b = 2 by EVAL_TAC 2571 (triplet 0 0).c = 2 by EVAL_TAC 2572 Hence (leibniz_up 1) zigzag (leibniz_horizontal 1) by leibniz_zigzag_def 2573*) 2574val leibniz_triplet_0 = store_thm( 2575 "leibniz_triplet_0", 2576 ``(leibniz_up 1) zigzag (leibniz_horizontal 1)``, 2577 `leibniz_up 1 = [] ++ [2; 1] ++ []` by EVAL_TAC >> 2578 `leibniz_horizontal 1 = [] ++ [2; 2] ++ []` by EVAL_TAC >> 2579 `((triplet 0 0).a = 1) /\ ((triplet 0 0).b = 2) /\ ((triplet 0 0).c = 2)` by EVAL_TAC >> 2580 metis_tac[leibniz_zigzag_def]); 2581 2582(* ------------------------------------------------------------------------- *) 2583(* Wriggle Paths in Leibniz Triangle *) 2584(* ------------------------------------------------------------------------- *) 2585 2586(* Define paths reachable by many zigzags *) 2587(* 2588val leibniz_wriggle_def = Define` 2589 leibniz_wriggle (p1: path) (p2: path) <=> 2590 ?(m:num) (f:num -> path). 2591 (p1 = f 0) /\ 2592 (p2 = f m) /\ 2593 (!k. k < m ==> (f k) zigzag (f (SUC k))) 2594`; 2595*) 2596 2597(* Define paths reachable by many zigzags by closure *) 2598val _ = overload_on("wriggle", ``RTC leibniz_zigzag``); (* RTC = reflexive transitive closure *) 2599val _ = set_fixity "wriggle" (Infix(NONASSOC, 450)); (* same as relation *) 2600 2601(* Theorem: p1 wriggle p2 ==> (list_lcm p1 = list_lcm p2) *) 2602(* Proof: 2603 By RTC_STRONG_INDUCT. 2604 Base: list_lcm p1 = list_lcm p1, trivially true. 2605 Step: p1 zigzag p1' /\ p1' wriggle p2 /\ list_lcm p1' = list_lcm p2 ==> list_lcm p1 = list_lcm p2 2606 list_lcm p1 2607 = list_lcm p1' by list_lcm_zigzag 2608 = list_lcm p2 by induction hypothesis 2609*) 2610val list_lcm_wriggle = store_thm( 2611 "list_lcm_wriggle", 2612 ``!p1 p2. p1 wriggle p2 ==> (list_lcm p1 = list_lcm p2)``, 2613 ho_match_mp_tac RTC_STRONG_INDUCT >> 2614 rpt strip_tac >- 2615 rw[] >> 2616 metis_tac[list_lcm_zigzag]); 2617 2618(* Theorem: p1 zigzag p2 ==> p1 wriggle p2 *) 2619(* Proof: 2620 p1 wriggle p2 2621 = p1 (RTC zigzag) p2 by notation 2622 = p1 zigzag p2 by RTC_SINGLE 2623*) 2624val leibniz_zigzag_wriggle = store_thm( 2625 "leibniz_zigzag_wriggle", 2626 ``!p1 p2. p1 zigzag p2 ==> p1 wriggle p2``, 2627 rw[]); 2628 2629(* Theorem: p1 wriggle p2 ==> !x. ([x] ++ p1) wriggle ([x] ++ p2) *) 2630(* Proof: 2631 By RTC_STRONG_INDUCT. 2632 Base: [x] ++ p1 wriggle [x] ++ p1 2633 True by RTC_REFL. 2634 Step: p1 zigzag p1' /\ p1' wriggle p2 /\ !x. [x] ++ p1' wriggle [x] ++ p2 ==> 2635 [x] ++ p1 wriggle [x] ++ p2 2636 Since p1 zigzag p1', 2637 so [x] ++ p1 zigzag [x] ++ p1' by leibniz_zigzag_tail 2638 or [x] ++ p1 wriggle [x] ++ p1' by leibniz_zigzag_wriggle 2639 With [x] ++ p1' wriggle [x] ++ p2 by induction hypothesis 2640 Hence [x] ++ p1 wriggle [x] ++ p2 by RTC_TRANS 2641*) 2642val leibniz_wriggle_tail = store_thm( 2643 "leibniz_wriggle_tail", 2644 ``!p1 p2. p1 wriggle p2 ==> !x. ([x] ++ p1) wriggle ([x] ++ p2)``, 2645 ho_match_mp_tac RTC_STRONG_INDUCT >> 2646 rpt strip_tac >- 2647 rw[] >> 2648 metis_tac[leibniz_zigzag_tail, leibniz_zigzag_wriggle, RTC_TRANS]); 2649 2650(* Theorem: p1 wriggle p1 *) 2651(* Proof: by RTC_REFL *) 2652val leibniz_wriggle_refl = store_thm( 2653 "leibniz_wriggle_refl", 2654 ``!p1. p1 wriggle p1``, 2655 metis_tac[RTC_REFL]); 2656 2657(* Theorem: p1 wriggle p2 /\ p2 wriggle p3 ==> p1 wriggle p3 *) 2658(* Proof: by RTC_TRANS *) 2659val leibniz_wriggle_trans = store_thm( 2660 "leibniz_wriggle_trans", 2661 ``!p1 p2 p3. p1 wriggle p2 /\ p2 wriggle p3 ==> p1 wriggle p3``, 2662 metis_tac[RTC_TRANS]); 2663 2664(* Theorem: k <= n + 1 ==> 2665 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle 2666 leibniz_horizontal (n + 1) *) 2667(* Proof: 2668 By induction on the difference: n + 1 - k. 2669 Base: k = n + 1 ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle 2670 leibniz_horizontal (n + 1) 2671 TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) 2672 = TAKE (n + 2) (leibniz_horizontal (n + 1)) ++ DROP (n + 1) (leibniz_horizontal n) by k = n + 1 2673 = leibniz_horizontal (n + 1) ++ [] by TAKE_LENGTH_ID, DROP_LENGTH_NIL 2674 = leibniz_horizontal (n + 1) by APPEND_NIL 2675 Hence they wriggle to each other by RTC_REFL 2676 Step: k <= n + 1 ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle 2677 leibniz_horizontal (n + 1) 2678 Let p1 = leibniz_horizontal (n + 1) 2679 p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_horizontal n) 2680 p3 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n) 2681 Then p2 zigzag p3 by leibniz_horizontal_zigzag 2682 and p3 wriggle p1 by induction hypothesis 2683 Hence p2 wriggle p1 by RTC_RULES 2684*) 2685val leibniz_horizontal_wriggle_step = store_thm( 2686 "leibniz_horizontal_wriggle_step", 2687 ``!n k. k <= n + 1 ==> TAKE (k + 1) (leibniz_horizontal (n + 1)) ++ DROP k (leibniz_horizontal n) wriggle 2688 leibniz_horizontal (n + 1)``, 2689 Induct_on `n + 1 - k` >| [ 2690 rpt strip_tac >> 2691 rw_tac arith_ss[] >> 2692 `n + 1 = k` by decide_tac >> 2693 rw[TAKE_LENGTH_ID_rwt, DROP_LENGTH_NIL_rwt], 2694 rpt strip_tac >> 2695 `v = n - k` by decide_tac >> 2696 `v = (n + 1) - (k + 1)` by decide_tac >> 2697 `k <= n` by decide_tac >> 2698 `k + 1 <= n + 1` by decide_tac >> 2699 `k + 1 + 1 = k + 2` by decide_tac >> 2700 qabbrev_tac `p1 = leibniz_horizontal (n + 1)` >> 2701 qabbrev_tac `p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_horizontal n)` >> 2702 qabbrev_tac `p3 = TAKE (k + 2) (leibniz_horizontal (n + 1)) ++ DROP (k + 1) (leibniz_horizontal n)` >> 2703 `p2 zigzag p3` by rw[leibniz_horizontal_zigzag, Abbr`p1`, Abbr`p2`, Abbr`p3`] >> 2704 metis_tac[RTC_RULES] 2705 ]); 2706 2707(* Theorem: ([leibniz (n + 1) 0] ++ leibniz_horizontal n) wriggle leibniz_horizontal (n + 1) *) 2708(* Proof: 2709 Apply > leibniz_horizontal_wriggle_step |> SPEC ``n:num`` |> SPEC ``0`` |> SIMP_RULE std_ss[DROP_0]; 2710 val it = |- TAKE 1 (leibniz_horizontal (n + 1)) ++ leibniz_horizontal n wriggle leibniz_horizontal (n + 1): thm 2711*) 2712val leibniz_horizontal_wriggle = store_thm( 2713 "leibniz_horizontal_wriggle", 2714 ``!n. ([leibniz (n + 1) 0] ++ leibniz_horizontal n) wriggle leibniz_horizontal (n + 1)``, 2715 rpt strip_tac >> 2716 `TAKE 1 (leibniz_horizontal (n + 1)) = [leibniz (n + 1) 0]` by rw[leibniz_horizontal_head, binomial_n_0] >> 2717 metis_tac[leibniz_horizontal_wriggle_step |> SPEC ``n:num`` |> SPEC ``0`` |> SIMP_RULE std_ss[DROP_0]]); 2718 2719(* ------------------------------------------------------------------------- *) 2720(* Path Transform keeping LCM *) 2721(* ------------------------------------------------------------------------- *) 2722 2723(* Theorem: (leibniz_up n) wriggle (leibniz_horizontal n) *) 2724(* Proof: 2725 By induction on n. 2726 Base: leibniz_up 0 wriggle leibniz_horizontal 0 2727 Since leibniz_up 0 = [1] by leibniz_up_0 2728 and leibniz_horizontal 0 = [1] by leibniz_horizontal_0 2729 Hence leibniz_up 0 wriggle leibniz_horizontal 0 by leibniz_wriggle_refl 2730 Step: leibniz_up n wriggle leibniz_horizontal n ==> 2731 leibniz_up (SUC n) wriggle leibniz_horizontal (SUC n) 2732 Let x = leibniz (n + 1) 0. 2733 Then x = n + 2 by leibniz_n_0 2734 Now leibniz_up (n + 1) = [x] ++ (leibniz_up n) by leibniz_up_cons 2735 Since leibniz_up n wriggle leibniz_horizontal n by induction hypothesis 2736 so ([x] ++ (leibniz_up n)) wriggle 2737 ([x] ++ (leibniz_horizontal n)) by leibniz_wriggle_tail 2738 and ([x] ++ (leibniz_horizontal n)) wriggle 2739 (leibniz_horizontal (n + 1)) by leibniz_horizontal_wriggle 2740 Hence leibniz_up (SUC n) wriggle 2741 leibniz_horizontal (SUC n) by leibniz_wriggle_trans, ADD1 2742*) 2743val leibniz_up_wriggle_horizontal = store_thm( 2744 "leibniz_up_wriggle_horizontal", 2745 ``!n. (leibniz_up n) wriggle (leibniz_horizontal n)``, 2746 Induct >- 2747 rw[leibniz_up_0, leibniz_horizontal_0] >> 2748 qabbrev_tac `x = leibniz (n + 1) 0` >> 2749 `x = n + 2` by rw[leibniz_n_0, Abbr`x`] >> 2750 `leibniz_up (n + 1) = [x] ++ (leibniz_up n)` by rw[leibniz_up_cons, Abbr`x`] >> 2751 `([x] ++ (leibniz_up n)) wriggle ([x] ++ (leibniz_horizontal n))` by rw[leibniz_wriggle_tail] >> 2752 `([x] ++ (leibniz_horizontal n)) wriggle (leibniz_horizontal (n + 1))` by rw[leibniz_horizontal_wriggle, Abbr`x`] >> 2753 metis_tac[leibniz_wriggle_trans, ADD1]); 2754 2755(* Theorem: list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n) *) 2756(* Proof: 2757 Since leibniz_up n = REVERSE (leibniz_vertical n) by notation 2758 and leibniz_up n wriggle leibniz_horizontal n by leibniz_up_wriggle_horizontal 2759 list_lcm (leibniz_vertical n) 2760 = list_lcm (leibniz_up n) by list_lcm_reverse 2761 = list_lcm (leibniz_horizontal n) by list_lcm_wriggle 2762*) 2763val leibniz_lcm_property = store_thm( 2764 "leibniz_lcm_property", 2765 ``!n. list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n)``, 2766 metis_tac[leibniz_up_wriggle_horizontal, list_lcm_wriggle, list_lcm_reverse]); 2767 2768(* This is a milestone theorem. *) 2769 2770(* Theorem: k <= n ==> (leibniz n k) divides list_lcm (leibniz_vertical n) *) 2771(* Proof: 2772 Note (leibniz n k) divides list_lcm (leibniz_horizontal n) by leibniz_horizontal_divisor 2773 ==> (leibniz n k) divides list_lcm (leibniz_vertical n) by leibniz_lcm_property 2774*) 2775val leibniz_vertical_divisor = store_thm( 2776 "leibniz_vertical_divisor", 2777 ``!n k. k <= n ==> (leibniz n k) divides list_lcm (leibniz_vertical n)``, 2778 metis_tac[leibniz_horizontal_divisor, leibniz_lcm_property]); 2779 2780(* ------------------------------------------------------------------------- *) 2781(* Lower Bound of Leibniz LCM *) 2782(* ------------------------------------------------------------------------- *) 2783 2784(* Theorem: 2 ** n <= list_lcm (leibniz_horizontal n) *) 2785(* Proof: 2786 Note LENGTH (binomail_horizontal n) = n + 1 by binomial_horizontal_len 2787 and EVERY_POSITIVE (binomial_horizontal n) by binomial_horizontal_pos .. [1] 2788 list_lcm (leibniz_horizontal n) 2789 = (n + 1) * list_lcm (binomial_horizontal n) by leibniz_horizontal_lcm_alt 2790 >= SUM (binomial_horizontal n) by list_lcm_lower_bound, [1] 2791 = 2 ** n by binomial_horizontal_sum 2792*) 2793val leibniz_horizontal_lcm_lower = store_thm( 2794 "leibniz_horizontal_lcm_lower", 2795 ``!n. 2 ** n <= list_lcm (leibniz_horizontal n)``, 2796 rpt strip_tac >> 2797 `LENGTH (binomial_horizontal n) = n + 1` by rw[binomial_horizontal_len] >> 2798 `EVERY_POSITIVE (binomial_horizontal n)` by rw[binomial_horizontal_pos] >> 2799 `list_lcm (leibniz_horizontal n) = (n + 1) * list_lcm (binomial_horizontal n)` by rw[leibniz_horizontal_lcm_alt] >> 2800 `SUM (binomial_horizontal n) = 2 ** n` by rw[binomial_horizontal_sum] >> 2801 metis_tac[list_lcm_lower_bound]); 2802 2803(* Theorem: 2 ** n <= list_lcm (leibniz_vertical n) *) 2804(* Proof: 2805 list_lcm (leibniz_vertical n) 2806 = list_lcm (leibniz_horizontal n) by leibniz_lcm_property 2807 >= 2 ** n by leibniz_horizontal_lcm_lower 2808*) 2809val leibniz_vertical_lcm_lower = store_thm( 2810 "leibniz_vertical_lcm_lower", 2811 ``!n. 2 ** n <= list_lcm (leibniz_vertical n)``, 2812 rw_tac std_ss[leibniz_horizontal_lcm_lower, leibniz_lcm_property]); 2813 2814(* Theorem: 2 ** n <= list_lcm [1 .. (n + 1)] *) 2815(* Proof: by leibniz_vertical_lcm_lower. *) 2816val lcm_lower_bound = store_thm( 2817 "lcm_lower_bound", 2818 ``!n. 2 ** n <= list_lcm [1 .. (n + 1)]``, 2819 rw[leibniz_vertical_lcm_lower]); 2820 2821(* ------------------------------------------------------------------------- *) 2822(* Leibniz LCM Invariance *) 2823(* ------------------------------------------------------------------------- *) 2824 2825(* Use overloading for leibniz_col_arm rooted at leibniz a b, of length n. *) 2826val _ = overload_on("leibniz_col_arm", ``\a b n. MAP (\x. leibniz (a - x) b) [0 ..< n]``); 2827 2828(* Use overloading for leibniz_seg_arm rooted at leibniz a b, of length n. *) 2829val _ = overload_on("leibniz_seg_arm", ``\a b n. MAP (\x. leibniz a (b + x)) [0 ..< n]``); 2830 2831(* 2832> EVAL ``leibniz_col_arm 5 1 4``; 2833val it = |- leibniz_col_arm 5 1 4 = [30; 20; 12; 6]: thm 2834> EVAL ``leibniz_seg_arm 5 1 4``; 2835val it = |- leibniz_seg_arm 5 1 4 = [30; 60; 60; 30]: thm 2836> EVAL ``list_lcm (leibniz_col_arm 5 1 4)``; 2837val it = |- list_lcm (leibniz_col_arm 5 1 4) = 60: thm 2838> EVAL ``list_lcm (leibniz_seg_arm 5 1 4)``; 2839val it = |- list_lcm (leibniz_seg_arm 5 1 4) = 60: thm 2840*) 2841 2842(* Theorem: leibniz_col_arm a b 0 = [] *) 2843(* Proof: 2844 leibniz_col_arm a b 0 2845 = MAP (\x. leibniz (a - x) b) [0 ..< 0] by notation 2846 = MAP (\x. leibniz (a - x) b) [] by listRangeLHI_def 2847 = [] by MAP 2848*) 2849val leibniz_col_arm_0 = store_thm( 2850 "leibniz_col_arm_0", 2851 ``!a b. leibniz_col_arm a b 0 = []``, 2852 rw[]); 2853 2854(* Theorem: leibniz_seg_arm a b 0 = [] *) 2855(* Proof: 2856 leibniz_seg_arm a b 0 2857 = MAP (\x. leibniz a (b + x)) [0 ..< 0] by notation 2858 = MAP (\x. leibniz a (b + x)) [] by listRangeLHI_def 2859 = [] by MAP 2860*) 2861val leibniz_seg_arm_0 = store_thm( 2862 "leibniz_seg_arm_0", 2863 ``!a b. leibniz_seg_arm a b 0 = []``, 2864 rw[]); 2865 2866(* Theorem: leibniz_col_arm a b 1 = [leibniz a b] *) 2867(* Proof: 2868 leibniz_col_arm a b 1 2869 = MAP (\x. leibniz (a - x) b) [0 ..< 1] by notation 2870 = MAP (\x. leibniz (a - x) b) [0] by listRangeLHI_def 2871 = (\x. leibniz (a - x) b) 0 ::[] by MAP 2872 = [leibniz a b] by function application 2873*) 2874val leibniz_col_arm_1 = store_thm( 2875 "leibniz_col_arm_1", 2876 ``!a b. leibniz_col_arm a b 1 = [leibniz a b]``, 2877 rw[listRangeLHI_def]); 2878 2879(* Theorem: leibniz_seg_arm a b 1 = [leibniz a b] *) 2880(* Proof: 2881 leibniz_seg_arm a b 1 2882 = MAP (\x. leibniz a (b + x)) [0 ..< 1] by notation 2883 = MAP (\x. leibniz a (b + x)) [0] by listRangeLHI_def 2884 = (\x. leibniz a (b + x)) 0 :: [] by MAP 2885 = [leibniz a b] by function application 2886*) 2887val leibniz_seg_arm_1 = store_thm( 2888 "leibniz_seg_arm_1", 2889 ``!a b. leibniz_seg_arm a b 1 = [leibniz a b]``, 2890 rw[listRangeLHI_def]); 2891 2892(* Theorem: LENGTH (leibniz_col_arm a b n) = n *) 2893(* Proof: 2894 LENGTH (leibniz_col_arm a b n) 2895 = LENGTH (MAP (\x. leibniz (a - x) b) [0 ..< n]) by notation 2896 = LENGTH [0 ..< n] by LENGTH_MAP 2897 = LENGTH (GENLIST (\i. i) n) by listRangeLHI_def 2898 = m by LENGTH_GENLIST 2899*) 2900val leibniz_col_arm_len = store_thm( 2901 "leibniz_col_arm_len", 2902 ``!a b n. LENGTH (leibniz_col_arm a b n) = n``, 2903 rw[]); 2904 2905(* Theorem: LENGTH (leibniz_seg_arm a b n) = n *) 2906(* Proof: 2907 LENGTH (leibniz_seg_arm a b n) 2908 = LENGTH (MAP (\x. leibniz a (b + x)) [0 ..< n]) by notation 2909 = LENGTH [0 ..< n] by LENGTH_MAP 2910 = LENGTH (GENLIST (\i. i) n) by listRangeLHI_def 2911 = m by LENGTH_GENLIST 2912*) 2913val leibniz_seg_arm_len = store_thm( 2914 "leibniz_seg_arm_len", 2915 ``!a b n. LENGTH (leibniz_seg_arm a b n) = n``, 2916 rw[]); 2917 2918(* Theorem: k < n ==> !a b. EL k (leibniz_col_arm a b n) = leibniz (a - k) b *) 2919(* Proof: 2920 Note LENGTH [0 ..< n] = n by LENGTH_listRangeLHI 2921 EL k (leibniz_col_arm a b n) 2922 = EL k (MAP (\x. leibniz (a - x) b) [0 ..< n]) by notation 2923 = (\x. leibniz (a - x) b) (EL k [0 ..< n]) by EL_MAP 2924 = (\x. leibniz (a - x) b) k by EL_listRangeLHI 2925 = leibniz (a - k) b 2926*) 2927val leibniz_col_arm_el = store_thm( 2928 "leibniz_col_arm_el", 2929 ``!n k. k < n ==> !a b. EL k (leibniz_col_arm a b n) = leibniz (a - k) b``, 2930 rw[EL_MAP, EL_listRangeLHI]); 2931 2932(* Theorem: k < n ==> !a b. EL k (leibniz_seg_arm a b n) = leibniz a (b + k) *) 2933(* Proof: 2934 Note LENGTH [0 ..< n] = n by LENGTH_listRangeLHI 2935 EL k (leibniz_seg_arm a b n) 2936 = EL k (MAP (\x. leibniz a (b + x)) [0 ..< n]) by notation 2937 = (\x. leibniz a (b + x)) (EL k [0 ..< n]) by EL_MAP 2938 = (\x. leibniz a (b + x)) k by EL_listRangeLHI 2939 = leibniz a (b + k) 2940*) 2941val leibniz_seg_arm_el = store_thm( 2942 "leibniz_seg_arm_el", 2943 ``!n k. k < n ==> !a b. EL k (leibniz_seg_arm a b n) = leibniz a (b + k)``, 2944 rw[EL_MAP, EL_listRangeLHI]); 2945 2946(* Theorem: TAKE 1 (leibniz_seg_arm a b (n + 1)) = [leibniz a b] *) 2947(* Proof: 2948 Note LENGTH (leibniz_seg_arm a b (n + 1)) = n + 1 by leibniz_seg_arm_len 2949 and 0 < n + 1 by ADD1, SUC_POS 2950 TAKE 1 (leibniz_seg_arm a b (n + 1)) 2951 = TAKE (SUC 0) (leibniz_seg_arm a b (n + 1)) by ONE 2952 = SNOC (EL 0 (leibniz_seg_arm a b (n + 1))) [] by TAKE_SUC_BY_TAKE, TAKE_0 2953 = [EL 0 (leibniz_seg_arm a b (n + 1))] by SNOC_NIL 2954 = leibniz a b by leibniz_seg_arm_el 2955*) 2956val leibniz_seg_arm_head = store_thm( 2957 "leibniz_seg_arm_head", 2958 ``!a b n. TAKE 1 (leibniz_seg_arm a b (n + 1)) = [leibniz a b]``, 2959 metis_tac[leibniz_seg_arm_len, leibniz_seg_arm_el, 2960 ONE, TAKE_SUC_BY_TAKE, TAKE_0, SNOC_NIL, DECIDE``!n. 0 < n + 1 /\ (n + 0 = n)``]); 2961 2962(* Theorem: leibniz_col_arm (a + 1) b (n + 1) = leibniz (a + 1) b :: leibniz_col_arm a b n *) 2963(* Proof: 2964 Note (\x. leibniz (a + 1 - x) b) o SUC 2965 = (\x. leibniz (a + 1 - (x + 1)) b) by FUN_EQ_THM 2966 = (\x. leibniz (a - x) b) by arithmetic 2967 2968 leibniz_col_arm (a + 1) b (n + 1) 2969 = MAP (\x. leibniz (a + 1 - x) b) [0 ..< (n + 1)] by notation 2970 = MAP (\x. leibniz (a + 1 - x) b) (0::[1 ..< (n+1)]) by listRangeLHI_CONS, 0 < n + 1 2971 = (\x. leibniz (a + 1 - x) b) 0 :: MAP (\x. leibniz (a + 1 - x) b) [1 ..< (n+1)] by MAP 2972 = leibniz (a + 1) b :: MAP (\x. leibniz (a + 1 - x) b) [1 ..< (n+1)] by function application 2973 = leibniz (a + 1) b :: MAP ((\x. leibniz (a + 1 - x) b) o SUC) [0 ..< n] by listRangeLHI_MAP_SUC 2974 = leibniz (a + 1) b :: MAP (\x. leibniz (a - x) b) [0 ..< n] by above 2975 = leibniz (a + 1) b :: leibniz_col_arm a b n by notation 2976*) 2977val leibniz_col_arm_cons = store_thm( 2978 "leibniz_col_arm_cons", 2979 ``!a b n. leibniz_col_arm (a + 1) b (n + 1) = leibniz (a + 1) b :: leibniz_col_arm a b n``, 2980 rpt strip_tac >> 2981 `!a x. a + 1 - SUC x + 1 = a - x + 1` by decide_tac >> 2982 `!a x. a + 1 - SUC x = a - x` by decide_tac >> 2983 `(\x. leibniz (a + 1 - x) b) o SUC = (\x. leibniz (a + 1 - (x + 1)) b)` by rw[FUN_EQ_THM] >> 2984 `0 < n + 1` by decide_tac >> 2985 `leibniz_col_arm (a + 1) b (n + 1) = MAP (\x. leibniz (a + 1 - x) b) (0::[1 ..< (n+1)])` by rw[listRangeLHI_CONS] >> 2986 `_ = leibniz (a + 1) b :: MAP (\x. leibniz (a + 1 - x) b) [0+1 ..< (n+1)]` by rw[] >> 2987 `_ = leibniz (a + 1) b :: MAP ((\x. leibniz (a + 1 - x) b) o SUC) [0 ..< n]` by rw[listRangeLHI_MAP_SUC] >> 2988 `_ = leibniz (a + 1) b :: leibniz_col_arm a b n` by rw[] >> 2989 rw[]); 2990 2991(* Theorem: k < n ==> !a b. 2992 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) zigzag 2993 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n) *) 2994(* Proof: 2995 Since k <= n, k < n + 1, and k + 1 < n + 2. 2996 Hence k < LENGTH (leibniz_seg_arm a b (n + 1)), 2997 2998 Let x = TAKE k (leibniz_seg_arm a b (n + 1)) 2999 and y = DROP (k + 1) (leibniz_seg_arm a b n) 3000 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) 3001 = TAKE (SUC k) (leibniz_seg_arm (a + 1) b (n + 1)) by ADD1 3002 = SNOC t.b x by TAKE_SUC_BY_TAKE, k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1)) 3003 = x ++ [t.b] by SNOC_APPEND 3004 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) 3005 = TAKE (SUC (SUC k)) (leibniz_seg_arm (a + 1) b (SUC n)) by ADD1 3006 = SNOC t.c (SNOC t.b x) by TAKE_SUC_BY_TAKE, SUC k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1)) 3007 = x ++ [t.b; t.c] by SNOC_APPEND 3008 DROP k (leibniz_seg_arm a b n) 3009 = t.a :: y by DROP_BY_DROP_SUC, k < LENGTH (leibniz_seg_arm a b n) 3010 = [t.a] ++ y by CONS_APPEND 3011 Hence 3012 Let p1 = TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) 3013 = x ++ [t.b] ++ [t.a] ++ y 3014 = x ++ [t.b; t.a] ++ y by APPEND 3015 Let p2 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n) 3016 = x ++ [t.b; t.c] ++ y 3017 Therefore p1 zigzag p2 by leibniz_zigzag_def 3018*) 3019val leibniz_seg_arm_zigzag_step = store_thm( 3020 "leibniz_seg_arm_zigzag_step", 3021 ``!n k. k < n ==> !a b. 3022 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) zigzag 3023 TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)``, 3024 rpt strip_tac >> 3025 qabbrev_tac `x = TAKE k (leibniz_seg_arm (a + 1) b (n + 1))` >> 3026 qabbrev_tac `y = DROP (k + 1) (leibniz_seg_arm a b n)` >> 3027 qabbrev_tac `t = triplet a (b + k)` >> 3028 `k < n + 1 /\ k + 1 < n + 1` by decide_tac >> 3029 `EL k (leibniz_seg_arm a b n) = t.a` by rw[triplet_def, leibniz_seg_arm_el, Abbr`t`] >> 3030 `EL k (leibniz_seg_arm (a + 1) b (n + 1)) = t.b` by rw[triplet_def, leibniz_seg_arm_el, Abbr`t`] >> 3031 `EL (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) = t.c` by rw[triplet_def, leibniz_seg_arm_el, Abbr`t`] >> 3032 `k < LENGTH (leibniz_seg_arm a b (n + 1))` by rw[leibniz_seg_arm_len] >> 3033 `TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) = TAKE (SUC k) (leibniz_seg_arm (a + 1) b (n + 1))` by rw[ADD1] >> 3034 `_ = SNOC t.b x` by rw[TAKE_SUC_BY_TAKE, Abbr`x`] >> 3035 `_ = x ++ [t.b]` by rw[] >> 3036 `SUC k < n + 1` by decide_tac >> 3037 `SUC k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))` by rw[leibniz_seg_arm_len] >> 3038 `k < LENGTH (leibniz_seg_arm (a + 1) b (n + 1))` by decide_tac >> 3039 `TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) = TAKE (SUC (SUC k)) (leibniz_seg_arm (a + 1) b (n + 1))` by rw[ADD1] >> 3040 `_ = SNOC t.c (SNOC t.b x)` by metis_tac[TAKE_SUC_BY_TAKE, ADD1] >> 3041 `_ = x ++ [t.b; t.c]` by rw[] >> 3042 `DROP k (leibniz_seg_arm a b n) = [t.a] ++ y` by rw[DROP_BY_DROP_SUC, ADD1, Abbr`y`] >> 3043 qabbrev_tac `p1 = TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n)` >> 3044 qabbrev_tac `p2 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ y` >> 3045 `p1 = x ++ [t.b; t.a] ++ y` by rw[Abbr`p1`, Abbr`x`, Abbr`y`] >> 3046 `p2 = x ++ [t.b; t.c] ++ y` by rw[Abbr`p2`, Abbr`x`] >> 3047 metis_tac[leibniz_zigzag_def]); 3048 3049(* Theorem: k < n + 1 ==> !a b. 3050 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle 3051 leibniz_seg_arm (a + 1) b (n + 1) *) 3052(* Proof: 3053 By induction on the difference: n - k. 3054 Base: k = n ==> TAKE (k + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle 3055 leibniz_seg_arm a b (n + 1) 3056 Note LENGTH (leibniz_seg_arm (a + 1) b (n + 1)) = n + 1 by leibniz_seg_arm_len 3057 and LENGTH (leibniz_seg_arm a b n) = n by leibniz_seg_arm_len 3058 TAKE (k + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) 3059 = TAKE (n + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP n (leibniz_seg_arm a b n) by k = n 3060 = leibniz_seg_arm a b n ++ [] by TAKE_LENGTH_ID, DROP_LENGTH_NIL 3061 = leibniz_seg_arm a b n by APPEND_NIL 3062 Hence they wriggle to each other by RTC_REFL 3063 Step: k < n + 1 ==> TAKE (k + 1) (leibniz_seg_arm a b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle 3064 leibniz_seg_arm a b (n + 1) 3065 Let p1 = leibniz_seg_arm (a + 1) b (n + 1) 3066 p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_seg_arm a b n) 3067 p3 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n) 3068 Then p2 zigzag p3 by leibniz_seg_arm_zigzag_step 3069 and p3 wriggle p1 by induction hypothesis 3070 Hence p2 wriggle p1 by RTC_RULES 3071*) 3072val leibniz_seg_arm_wriggle_step = store_thm( 3073 "leibniz_seg_arm_wriggle_step", 3074 ``!n k. k < n + 1 ==> !a b. 3075 TAKE (k + 1) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP k (leibniz_seg_arm a b n) wriggle 3076 leibniz_seg_arm (a + 1) b (n + 1)``, 3077 Induct_on `n - k` >| [ 3078 rpt strip_tac >> 3079 `k = n` by decide_tac >> 3080 metis_tac[leibniz_seg_arm_len, TAKE_LENGTH_ID, DROP_LENGTH_NIL, APPEND_NIL, RTC_REFL], 3081 rpt strip_tac >> 3082 qabbrev_tac `p1 = leibniz_seg_arm (a + 1) b (n + 1)` >> 3083 qabbrev_tac `p2 = TAKE (k + 1) p1 ++ DROP k (leibniz_seg_arm a b n)` >> 3084 qabbrev_tac `p3 = TAKE (k + 2) (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP (k + 1) (leibniz_seg_arm a b n)` >> 3085 `p2 zigzag p3` by rw[leibniz_seg_arm_zigzag_step, Abbr`p1`, Abbr`p2`, Abbr`p3`] >> 3086 `v = n - (k + 1)` by decide_tac >> 3087 `k + 1 < n + 1` by decide_tac >> 3088 `k + 1 + 1 = k + 2` by decide_tac >> 3089 metis_tac[RTC_RULES] 3090 ]); 3091 3092(* Theorem: ([leibniz (a + 1) b] ++ leibniz_seg_arm a b n) wriggle leibniz_seg_arm (a + 1) b (n + 1) *) 3093(* Proof: 3094 Apply > leibniz_seg_arm_wriggle_step |> SPEC ``n:num`` |> SPEC ``0`` |> SIMP_RULE std_ss[DROP_0]; 3095 val it = 3096 |- 0 < n + 1 ==> !a b. 3097 TAKE 1 (leibniz_seg_arm (a + 1) b (n + 1)) ++ leibniz_seg_arm a b n wriggle 3098 leibniz_seg_arm (a + 1) b (n + 1): 3099 thm 3100 3101 Note 0 < n + 1 by ADD1, SUC_POS 3102 [leibniz (a + 1) b] ++ leibniz_seg_arm a b n 3103 = TAKE 1 (leibniz_seg_arm (a + 1) b (n + 1)) ++ leibniz_seg_arm a b n by leibniz_seg_arm_head 3104 = TAKE 1 (leibniz_seg_arm (a + 1) b (n + 1)) ++ DROP 0 (leibniz_seg_arm a b n) by DROP_0 3105 wriggle leibniz_seg_arm (a + 1) b (n + 1) by leibniz_seg_arm_wriggle_step, put k = 0 3106*) 3107val leibniz_seg_arm_wriggle_row_arm = store_thm( 3108 "leibniz_seg_arm_wriggle_row_arm", 3109 ``!a b n. ([leibniz (a + 1) b] ++ leibniz_seg_arm a b n) wriggle leibniz_seg_arm (a + 1) b (n + 1)``, 3110 rpt strip_tac >> 3111 `0 < n + 1 /\ (0 + 1 = 1)` by decide_tac >> 3112 metis_tac[leibniz_seg_arm_head, leibniz_seg_arm_wriggle_step, DROP_0]); 3113 3114(* Theorem: b <= a /\ n <= a + 1 - b ==> (leibniz_col_arm a b n) wriggle (leibniz_seg_arm a b n) *) 3115(* Proof: 3116 By induction on n. 3117 Base: leibniz_col_arm a b 0 wriggle leibniz_seg_arm a b 0 3118 Since leibniz_col_arm a b 0 = [] by leibniz_col_arm_0 3119 and leibniz_seg_arm a b 0 = [] by leibniz_seg_arm_0 3120 Hence leibniz_col_arm a b 0 wriggle leibniz_seg_arm a b 0 by leibniz_wriggle_refl 3121 Step: !a b. leibniz_col_arm a b n wriggle leibniz_seg_arm a b n ==> 3122 leibniz_col_arm a b (SUC n) wriggle leibniz_seg_arm a b (SUC n) 3123 Induct_on a. 3124 Base: b <= 0 /\ SUC n <= 0 + 1 - b ==> leibniz_col_arm 0 b (SUC n) wriggle leibniz_seg_arm 0 b (SUC n) 3125 Note SUC n <= 1 - b ==> n = 0, since 0 <= b. 3126 leibniz_col_arm 0 b (SUC 0) 3127 = leibniz_col_arm 0 b 1 by ONE 3128 = [leibniz 0 b] by leibniz_col_arm_1 3129 leibniz_seg_arm 0 b (SUC 0) 3130 = leibniz_seg_arm 0 b 1 by ONE 3131 = [leibniz 0 b] by leibniz_seg_arm_1 3132 Hence leibniz_col_arm 0 b 1 wriggle 3133 leibniz_seg_arm 0 b 1 by leibniz_wriggle_refl 3134 Step: b <= SUC a /\ SUC n <= SUC a + 1 - b ==> leibniz_col_arm (SUC a) b (SUC n) wriggle leibniz_seg_arm (SUC a) b (SUC n) 3135 Note n <= a + 1 - b 3136 If a + 1 = b, 3137 Then n = 0, 3138 leibniz_col_arm (SUC a) b (SUC 0) 3139 = leibniz_col_arm (SUC a) b 1 by ONE 3140 = [leibniz (SUC a) b] by leibniz_col_arm_1 3141 = leibniz_seg_arm (SUC a) b 1 by leibniz_seg_arm_1 3142 = leibniz_seg_arm (SUC a) b (SUC 0) by ONE 3143 Hence leibniz_col_arm (SUC a) b 1 wriggle 3144 leibniz_seg_arm (SUC a) b 1 by leibniz_wriggle_refl 3145 If a + 1 <> b, 3146 Then b <= a, and induction hypothesis applies. 3147 Let x = leibniz (a + 1) b. 3148 Then leibniz_col_arm (a + 1) b (n + 1) 3149 = [x] ++ (leibniz_col_arm a b n) by leibniz_col_arm_cons 3150 Since leibniz_col_arm a b n 3151 wriggle leibniz_seg_arm a b n by induction hypothesis 3152 so ([x] ++ (leibniz_col_arm a b n)) wriggle 3153 ([x] ++ (leibniz_seg_arm a b n)) by leibniz_wriggle_tail 3154 and ([x] ++ (leibniz_seg_arm a b n)) wriggle 3155 (leibniz_seg_arm (a + 1) b (n + 1)) by leibniz_seg_arm_wriggle_row_arm 3156 Hence leibniz_col_arm a b (SUC n) wriggle 3157 leibniz_seg_arm a b (SUC n) by leibniz_wriggle_trans, ADD1 3158*) 3159val leibniz_col_arm_wriggle_row_arm = store_thm( 3160 "leibniz_col_arm_wriggle_row_arm", 3161 ``!a b n. b <= a /\ n <= a + 1 - b ==> (leibniz_col_arm a b n) wriggle (leibniz_seg_arm a b n)``, 3162 Induct_on `n` >- 3163 rw[leibniz_col_arm_0, leibniz_seg_arm_0] >> 3164 rpt strip_tac >> 3165 Induct_on `a` >| [ 3166 rpt strip_tac >> 3167 `n = 0` by decide_tac >> 3168 metis_tac[leibniz_col_arm_1, leibniz_seg_arm_1, ONE, leibniz_wriggle_refl], 3169 rpt strip_tac >> 3170 `n <= a + 1 - b` by decide_tac >> 3171 Cases_on `a + 1 = b` >| [ 3172 `n = 0` by decide_tac >> 3173 metis_tac[leibniz_col_arm_1, leibniz_seg_arm_1, ONE, leibniz_wriggle_refl], 3174 `b <= a` by decide_tac >> 3175 qabbrev_tac `x = leibniz (a + 1) b` >> 3176 `leibniz_col_arm (a + 1) b (n + 1) = [x] ++ (leibniz_col_arm a b n)` by rw[leibniz_col_arm_cons, Abbr`x`] >> 3177 `([x] ++ (leibniz_col_arm a b n)) wriggle ([x] ++ (leibniz_seg_arm a b n))` by rw[leibniz_wriggle_tail] >> 3178 `([x] ++ (leibniz_seg_arm a b n)) wriggle (leibniz_seg_arm (a + 1) b (n + 1))` by rw[leibniz_seg_arm_wriggle_row_arm, Abbr`x`] >> 3179 metis_tac[leibniz_wriggle_trans, ADD1] 3180 ] 3181 ]); 3182 3183(* Theorem: b <= a /\ n <= a + 1 - b ==> (list_lcm (leibniz_col_arm a b n) = list_lcm (leibniz_seg_arm a b n)) *) 3184(* Proof: 3185 Since (leibniz_col_arm a b n) wriggle (leibniz_seg_arm a b n) by leibniz_col_arm_wriggle_row_arm 3186 the result follows by list_lcm_wriggle 3187*) 3188val leibniz_lcm_invariance = store_thm( 3189 "leibniz_lcm_invariance", 3190 ``!a b n. b <= a /\ n <= a + 1 - b ==> (list_lcm (leibniz_col_arm a b n) = list_lcm (leibniz_seg_arm a b n))``, 3191 rw[leibniz_col_arm_wriggle_row_arm, list_lcm_wriggle]); 3192 3193(* This is a milestone theorem. *) 3194 3195(* This is used to give another proof of leibniz_up_wriggle_horizontal *) 3196 3197(* Theorem: leibniz_col_arm n 0 (n + 1) = leibniz_up n *) 3198(* Proof: 3199 leibniz_col_arm n 0 (n + 1) 3200 = MAP (\x. leibniz (n - x) 0) [0 ..< (n + 1)] by notation 3201 = MAP (\x. leibniz (n - x) 0) [0 .. n] by listRangeLHI_to_listRangeINC 3202 = MAP ((\x. leibniz x 0) o (\x. n - x)) [0 .. n] by function composition 3203 = REVERSE (MAP (\x. leibniz x 0) [0 .. n]) by listRangeINC_REVERSE_MAP 3204 = REVERSE (MAP (\x. x + 1) [0 .. n]) by leibniz_n_0 3205 = REVERSE (MAP SUC [0 .. n]) by ADD1 3206 = REVERSE (MAP (I o SUC) [0 .. n]) by I_THM 3207 = REVERSE [1 .. (n+1)] by listRangeINC_MAP_SUC 3208 = REVERSE (leibniz_vertical n) by notation 3209 = leibniz_up n by notation 3210*) 3211val leibniz_col_arm_n_0 = store_thm( 3212 "leibniz_col_arm_n_0", 3213 ``!n. leibniz_col_arm n 0 (n + 1) = leibniz_up n``, 3214 rpt strip_tac >> 3215 `(\x. x + 1) = SUC` by rw[FUN_EQ_THM] >> 3216 `(\x. leibniz x 0) o (\x. n - x + 0) = (\x. leibniz (n - x) 0)` by rw[FUN_EQ_THM] >> 3217 `leibniz_col_arm n 0 (n + 1) = MAP (\x. leibniz (n - x) 0) [0 .. n]` by rw[listRangeLHI_to_listRangeINC] >> 3218 `_ = MAP ((\x. leibniz x 0) o (\x. n - x + 0)) [0 .. n]` by rw[] >> 3219 `_ = REVERSE (MAP (\x. leibniz x 0) [0 .. n])` by rw[listRangeINC_REVERSE_MAP] >> 3220 `_ = REVERSE (MAP (\x. x + 1) [0 .. n])` by rw[leibniz_n_0] >> 3221 `_ = REVERSE (MAP SUC [0 .. n])` by rw[ADD1] >> 3222 `_ = REVERSE (MAP (I o SUC) [0 .. n])` by rw[] >> 3223 `_ = REVERSE [1 .. (n+1)]` by rw[GSYM listRangeINC_MAP_SUC] >> 3224 rw[]); 3225 3226(* Theorem: leibniz_seg_arm n 0 (n + 1) = leibniz_horizontal n *) 3227(* Proof: 3228 leibniz_seg_arm n 0 (n + 1) 3229 = MAP (\x. leibniz n x) [0 ..< (n + 1)] by notation 3230 = MAP (\x. leibniz n x) [0 .. n] by listRangeLHI_to_listRangeINC 3231 = MAP (leibniz n) [0 .. n] by FUN_EQ_THM 3232 = MAP (leibniz n) (GENLIST (\i. i) (n + 1)) by listRangeINC_def 3233 = GENLIST ((leibniz n) o I) (n + 1) by MAP_GENLIST 3234 = GENLIST (leibniz n) (n + 1) by I_THM 3235 = leibniz_horizontal n by notation 3236*) 3237val leibniz_seg_arm_n_0 = store_thm( 3238 "leibniz_seg_arm_n_0", 3239 ``!n. leibniz_seg_arm n 0 (n + 1) = leibniz_horizontal n``, 3240 rpt strip_tac >> 3241 `(\x. x) = I` by rw[FUN_EQ_THM] >> 3242 `(\x. leibniz n x) = leibniz n` by rw[FUN_EQ_THM] >> 3243 `leibniz_seg_arm n 0 (n + 1) = MAP (leibniz n) [0 .. n]` by rw_tac std_ss[listRangeLHI_to_listRangeINC] >> 3244 `_ = MAP (leibniz n) (GENLIST (\i. i) (n + 1))` by rw[listRangeINC_def] >> 3245 `_ = MAP (leibniz n) (GENLIST I (n + 1))` by metis_tac[] >> 3246 `_ = GENLIST ((leibniz n) o I) (n + 1)` by rw[MAP_GENLIST] >> 3247 `_ = GENLIST (leibniz n) (n + 1)` by rw[] >> 3248 rw[]); 3249 3250(* Theorem: (leibniz_up n) wriggle (leibniz_horizontal n) *) 3251(* Proof: 3252 Note 0 <= n /\ n + 1 <= n + 1 - 0, so leibniz_col_arm_wriggle_row_arm applies. 3253 leibniz_up n 3254 = leibniz_col_arm n 0 (n + 1) by leibniz_col_arm_n_0 3255 wriggle leibniz_seg_arm n 0 (n + 1) by leibniz_col_arm_wriggle_row_arm 3256 = leibniz_horizontal n by leibniz_seg_arm_n_0 3257*) 3258val leibniz_up_wriggle_horizontal_alt = store_thm( 3259 "leibniz_up_wriggle_horizontal_alt", 3260 ``!n. (leibniz_up n) wriggle (leibniz_horizontal n)``, 3261 rpt strip_tac >> 3262 `0 <= n /\ n + 1 <= n + 1 - 0` by decide_tac >> 3263 metis_tac[leibniz_col_arm_wriggle_row_arm, leibniz_col_arm_n_0, leibniz_seg_arm_n_0]); 3264 3265(* Theorem: list_lcm (leibniz_up n) = list_lcm (leibniz_horizontal n) *) 3266(* Proof: by leibniz_up_wriggle_horizontal_alt, list_lcm_wriggle *) 3267val leibniz_up_lcm_eq_horizontal_lcm = store_thm( 3268 "leibniz_up_lcm_eq_horizontal_lcm", 3269 ``!n. list_lcm (leibniz_up n) = list_lcm (leibniz_horizontal n)``, 3270 rw[leibniz_up_wriggle_horizontal_alt, list_lcm_wriggle]); 3271 3272(* This is another proof of the milestone theorem. *) 3273 3274(* ------------------------------------------------------------------------- *) 3275(* Set GCD as Big Operator *) 3276(* ------------------------------------------------------------------------- *) 3277 3278(* Big Operators: 3279SUM_IMAGE_DEF |- !f s. SIGMA f s = ITSET (\e acc. f e + acc) s 0: thm 3280PROD_IMAGE_DEF |- !f s. PI f s = ITSET (\e acc. f e * acc) s 1: thm 3281*) 3282 3283(* Define big_gcd for a set *) 3284val big_gcd_def = Define` 3285 big_gcd s = ITSET gcd s 0 3286`; 3287 3288(* Theorem: big_gcd {} = 0 *) 3289(* Proof: 3290 big_gcd {} 3291 = ITSET gcd {} 0 by big_gcd_def 3292 = 0 by ITSET_EMPTY 3293*) 3294val big_gcd_empty = store_thm( 3295 "big_gcd_empty", 3296 ``big_gcd {} = 0``, 3297 rw[big_gcd_def, ITSET_EMPTY]); 3298 3299(* Theorem: big_gcd {x} = x *) 3300(* Proof: 3301 big_gcd {x} 3302 = ITSET gcd {x} 0 by big_gcd_def 3303 = gcd x 0 by ITSET_SING 3304 = x by GCD_0R 3305*) 3306val big_gcd_sing = store_thm( 3307 "big_gcd_sing", 3308 ``!x. big_gcd {x} = x``, 3309 rw[big_gcd_def, ITSET_SING]); 3310 3311(* Theorem: FINITE s /\ x NOTIN s ==> (big_gcd (x INSERT s) = gcd x (big_gcd s)) *) 3312(* Proof: 3313 Note big_gcd s = ITSET gcd s 0 by big_lcm_def 3314 Since !x y z. gcd x (gcd y z) = gcd y (gcd x z) by GCD_ASSOC_COMM 3315 The result follows by ITSET_REDUCTION 3316*) 3317val big_gcd_reduction = store_thm( 3318 "big_gcd_reduction", 3319 ``!s x. FINITE s /\ x NOTIN s ==> (big_gcd (x INSERT s) = gcd x (big_gcd s))``, 3320 rw[big_gcd_def, ITSET_REDUCTION, GCD_ASSOC_COMM]); 3321 3322(* Theorem: FINITE s ==> !x. x IN s ==> (big_gcd s) divides x *) 3323(* Proof: 3324 By finite induction on s. 3325 Base: x IN {} ==> big_gcd {} divides x 3326 True since x IN {} = F by MEMBER_NOT_EMPTY 3327 Step: !x. x IN s ==> big_gcd s divides x ==> 3328 e NOTIN s /\ x IN (e INSERT s) ==> big_gcd (e INSERT s) divides x 3329 Since e NOTIN s, 3330 so big_gcd (e INSERT s) = gcd e (big_gcd s) by big_gcd_reduction 3331 By IN_INSERT, 3332 If x = e, 3333 to show: gcd e (big_gcd s) divides e, true by GCD_IS_GREATEST_COMMON_DIVISOR 3334 If x <> e, x IN s, 3335 to show gcd e (big_gcd s) divides x, 3336 Since (big_gcd s) divides x by induction hypothesis, x IN s 3337 and (big_gcd s) divides gcd e (big_gcd s) by GCD_IS_GREATEST_COMMON_DIVISOR 3338 so gcd e (big_gcd s) divides x by DIVIDES_TRANS 3339*) 3340val big_gcd_is_common_divisor = store_thm( 3341 "big_gcd_is_common_divisor", 3342 ``!s. FINITE s ==> !x. x IN s ==> (big_gcd s) divides x``, 3343 Induct_on `FINITE` >> 3344 rpt strip_tac >- 3345 metis_tac[MEMBER_NOT_EMPTY] >> 3346 metis_tac[big_gcd_reduction, IN_INSERT, GCD_IS_GREATEST_COMMON_DIVISOR, DIVIDES_TRANS]); 3347 3348(* Theorem: FINITE s ==> !m. (!x. x IN s ==> m divides x) ==> m divides (big_gcd s) *) 3349(* Proof: 3350 By finite induction on s. 3351 Base: m divides big_gcd {} 3352 Since big_gcd {} = 0 by big_gcd_empty 3353 Hence true by ALL_DIVIDES_0 3354 Step: !m. (!x. x IN s ==> m divides x) ==> m divides big_gcd s ==> 3355 e NOTIN s /\ !x. x IN e INSERT s ==> m divides x ==> m divides big_gcd (e INSERT s) 3356 Note x IN e INSERT s ==> x = e \/ x IN s by IN_INSERT 3357 Put x = e, then m divides e by x divides m, x = e 3358 Put x IN s, then m divides big_gcd s by induction hypothesis 3359 Therefore, m divides gcd e (big_gcd s) by GCD_IS_GREATEST_COMMON_DIVISOR 3360 or m divides big_gcd (e INSERT s) by big_gcd_reduction, e NOTIN s 3361*) 3362val big_gcd_is_greatest_common_divisor = store_thm( 3363 "big_gcd_is_greatest_common_divisor", 3364 ``!s. FINITE s ==> !m. (!x. x IN s ==> m divides x) ==> m divides (big_gcd s)``, 3365 Induct_on `FINITE` >> 3366 rpt strip_tac >- 3367 rw[big_gcd_empty] >> 3368 metis_tac[big_gcd_reduction, GCD_IS_GREATEST_COMMON_DIVISOR, IN_INSERT]); 3369 3370(* Theorem: FINITE s ==> !x. big_gcd (x INSERT s) = gcd x (big_gcd s) *) 3371(* Proof: 3372 If x IN s, 3373 Then (big_gcd s) divides x by big_gcd_is_common_divisor 3374 gcd x (big_gcd s) 3375 = gcd (big_gcd s) x by GCD_SYM 3376 = big_gcd s by divides_iff_gcd_fix 3377 = big_gcd (x INSERT s) by ABSORPTION 3378 If x NOTIN s, result is true by big_gcd_reduction 3379*) 3380val big_gcd_insert = store_thm( 3381 "big_gcd_insert", 3382 ``!s. FINITE s ==> !x. big_gcd (x INSERT s) = gcd x (big_gcd s)``, 3383 rpt strip_tac >> 3384 Cases_on `x IN s` >- 3385 metis_tac[big_gcd_is_common_divisor, divides_iff_gcd_fix, ABSORPTION, GCD_SYM] >> 3386 rw[big_gcd_reduction]); 3387 3388(* Theorem: big_gcd {x; y} = gcd x y *) 3389(* Proof: 3390 big_gcd {x; y} 3391 = big_gcd (x INSERT y) by notation 3392 = gcd x (big_gcd {y}) by big_gcd_insert 3393 = gcd x (big_gcd {y INSERT {}}) by notation 3394 = gcd x (gcd y (big_gcd {})) by big_gcd_insert 3395 = gcd x (gcd y 0) by big_gcd_empty 3396 = gcd x y by gcd_0R 3397*) 3398val big_gcd_two = store_thm( 3399 "big_gcd_two", 3400 ``!x y. big_gcd {x; y} = gcd x y``, 3401 rw[big_gcd_insert, big_gcd_empty]); 3402 3403(* Theorem: FINITE s ==> (!x. x IN s ==> 0 < x) ==> 0 < big_gcd s *) 3404(* Proof: 3405 By finite induction on s. 3406 Base: {} <> {} /\ !x. x IN {} ==> 0 < x ==> 0 < big_gcd {} 3407 True since {} <> {} = F 3408 Step: s <> {} /\ (!x. x IN s ==> 0 < x) ==> 0 < big_gcd s ==> 3409 e NOTIN s /\ e INSERT s <> {} /\ !x. x IN e INSERT s ==> 0 < x ==> 0 < big_gcd (e INSERT s) 3410 Note 0 < e /\ !x. x IN s ==> 0 < x by IN_INSERT 3411 If s = {}, 3412 big_gcd (e INSERT {}) 3413 = big_gcd {e} by IN_INSERT 3414 = e > 0 by big_gcd_sing 3415 If s <> {}, 3416 so 0 < big_gcd s by induction hypothesis 3417 ==> 0 < gcd e (big_gcd s) by GCD_EQ_0 3418 or 0 < big_gcd (e INSERT s) by big_gcd_insert 3419*) 3420val big_gcd_positive = store_thm( 3421 "big_gcd_positive", 3422 ``!s. FINITE s /\ s <> {} /\ (!x. x IN s ==> 0 < x) ==> 0 < big_gcd s``, 3423 `!s. FINITE s ==> s <> {} /\ (!x. x IN s ==> 0 < x) ==> 0 < big_gcd s` suffices_by rw[] >> 3424 Induct_on `FINITE` >> 3425 rpt strip_tac >- 3426 rw[] >> 3427 `0 < e /\ (!x. x IN s ==> 0 < x)` by rw[] >> 3428 Cases_on `s = {}` >- 3429 rw[big_gcd_sing] >> 3430 metis_tac[big_gcd_insert, GCD_EQ_0, NOT_ZERO_LT_ZERO]); 3431 3432(* Theorem: FINITE s /\ s <> {} ==> !k. big_gcd (IMAGE ($* k) s) = k * big_gcd s *) 3433(* Proof: 3434 By finite induction on s. 3435 Base: {} <> {} ==> ..., must be true. 3436 Step: s <> {} ==> !!k. big_gcd (IMAGE ($* k) s) = k * big_gcd s ==> 3437 e NOTIN s ==> big_gcd (IMAGE ($* k) (e INSERT s)) = k * big_gcd (e INSERT s) 3438 If s = {}, 3439 big_gcd (IMAGE ($* k) (e INSERT {})) 3440 = big_gcd (IMAGE ($* k) {e}) by IN_INSERT, s = {} 3441 = big_gcd {k * e} by IMAGE_SING 3442 = k * e by big_gcd_sing 3443 = k * big_gcd {e} by big_gcd_sing 3444 = k * big_gcd (e INSERT {}) by IN_INSERT, s = {} 3445 If s <> {}, 3446 big_gcd (IMAGE ($* k) (e INSERT s)) 3447 = big_gcd ((k * e) INSERT (IMAGE ($* k) s)) by IMAGE_INSERT 3448 = gcd (k * e) (big_gcd (IMAGE ($* k) s)) by big_gcd_insert 3449 = gcd (k * e) (k * big_gcd s) by induction hypothesis 3450 = k * gcd e (big_gcd s) by GCD_COMMON_FACTOR 3451 = k * big_gcd (e INSERT s) by big_gcd_insert 3452*) 3453val big_gcd_map_times = store_thm( 3454 "big_gcd_map_times", 3455 ``!s. FINITE s /\ s <> {} ==> !k. big_gcd (IMAGE ($* k) s) = k * big_gcd s``, 3456 `!s. FINITE s ==> s <> {} ==> !k. big_gcd (IMAGE ($* k) s) = k * big_gcd s` suffices_by rw[] >> 3457 Induct_on `FINITE` >> 3458 rpt strip_tac >- 3459 rw[] >> 3460 Cases_on `s = {}` >- 3461 rw[big_gcd_sing] >> 3462 `big_gcd (IMAGE ($* k) (e INSERT s)) = gcd (k * e) (k * big_gcd s)` by rw[big_gcd_insert] >> 3463 `_ = k * gcd e (big_gcd s)` by rw[GCD_COMMON_FACTOR] >> 3464 `_ = k * big_gcd (e INSERT s)` by rw[big_gcd_insert] >> 3465 rw[]); 3466 3467(* ------------------------------------------------------------------------- *) 3468(* Set LCM as Big Operator *) 3469(* ------------------------------------------------------------------------- *) 3470 3471(* big_lcm s = ITSET (\e x. lcm e x) s 1 = ITSET lcm s 1, of course! *) 3472val big_lcm_def = Define` 3473 big_lcm s = ITSET lcm s 1 3474`; 3475 3476(* Theorem: big_lcm {} = 1 *) 3477(* Proof: 3478 big_lcm {} 3479 = ITSET lcm {} 1 by big_lcm_def 3480 = 1 by ITSET_EMPTY 3481*) 3482val big_lcm_empty = store_thm( 3483 "big_lcm_empty", 3484 ``big_lcm {} = 1``, 3485 rw[big_lcm_def, ITSET_EMPTY]); 3486 3487(* Theorem: big_lcm {x} = x *) 3488(* Proof: 3489 big_lcm {x} 3490 = ITSET lcm {x} 1 by big_lcm_def 3491 = lcm x 1 by ITSET_SING 3492 = x by LCM_1 3493*) 3494val big_lcm_sing = store_thm( 3495 "big_lcm_sing", 3496 ``!x. big_lcm {x} = x``, 3497 rw[big_lcm_def, ITSET_SING]); 3498 3499(* Theorem: FINITE s /\ x NOTIN s ==> (big_lcm (x INSERT s) = lcm x (big_lcm s)) *) 3500(* Proof: 3501 Note big_lcm s = ITSET lcm s 1 by big_lcm_def 3502 Since !x y z. lcm x (lcm y z) = lcm y (lcm x z) by LCM_ASSOC_COMM 3503 The result follows by ITSET_REDUCTION 3504*) 3505val big_lcm_reduction = store_thm( 3506 "big_lcm_reduction", 3507 ``!s x. FINITE s /\ x NOTIN s ==> (big_lcm (x INSERT s) = lcm x (big_lcm s))``, 3508 rw[big_lcm_def, ITSET_REDUCTION, LCM_ASSOC_COMM]); 3509 3510(* Theorem: FINITE s ==> !x. x IN s ==> x divides (big_lcm s) *) 3511(* Proof: 3512 By finite induction on s. 3513 Base: x IN {} ==> x divides big_lcm {} 3514 True since x IN {} = F by MEMBER_NOT_EMPTY 3515 Step: !x. x IN s ==> x divides big_lcm s ==> 3516 e NOTIN s /\ x IN (e INSERT s) ==> x divides big_lcm (e INSERT s) 3517 Since e NOTIN s, 3518 so big_lcm (e INSERT s) = lcm e (big_lcm s) by big_lcm_reduction 3519 By IN_INSERT, 3520 If x = e, 3521 to show: e divides lcm e (big_lcm s), true by LCM_DIVISORS 3522 If x <> e, x IN s, 3523 to show x divides lcm e (big_lcm s), 3524 Since x divides (big_lcm s) by induction hypothesis, x IN s 3525 and (big_lcm s) divides lcm e (big_lcm s) by LCM_DIVISORS 3526 so x divides lcm e (big_lcm s) by DIVIDES_TRANS 3527*) 3528val big_lcm_is_common_multiple = store_thm( 3529 "big_lcm_is_common_multiple", 3530 ``!s. FINITE s ==> !x. x IN s ==> x divides (big_lcm s)``, 3531 Induct_on `FINITE` >> 3532 rpt strip_tac >- 3533 metis_tac[MEMBER_NOT_EMPTY] >> 3534 metis_tac[big_lcm_reduction, IN_INSERT, LCM_DIVISORS, DIVIDES_TRANS]); 3535 3536(* Theorem: FINITE s ==> !m. (!x. x IN s ==> x divides m) ==> (big_lcm s) divides m *) 3537(* Proof: 3538 By finite induction on s. 3539 Base: big_lcm {} divides m 3540 Since big_lcm {} = 1 by big_lcm_empty 3541 Hence true by ONE_DIVIDES_ALL 3542 Step: !m. (!x. x IN s ==> x divides m) ==> big_lcm s divides m ==> 3543 e NOTIN s /\ !x. x IN e INSERT s ==> x divides m ==> big_lcm (e INSERT s) divides m 3544 Note x IN e INSERT s ==> x = e \/ x IN s by IN_INSERT 3545 Put x = e, then e divides m by x divides m, x = e 3546 Put x IN s, then big_lcm s divides m by induction hypothesis 3547 Therefore, lcm e (big_lcm s) divides m by LCM_IS_LEAST_COMMON_MULTIPLE 3548 or big_lcm (e INSERT s) divides m by big_lcm_reduction, e NOTIN s 3549*) 3550val big_lcm_is_least_common_multiple = store_thm( 3551 "big_lcm_is_least_common_multiple", 3552 ``!s. FINITE s ==> !m. (!x. x IN s ==> x divides m) ==> (big_lcm s) divides m``, 3553 Induct_on `FINITE` >> 3554 rpt strip_tac >- 3555 rw[big_lcm_empty] >> 3556 metis_tac[big_lcm_reduction, LCM_IS_LEAST_COMMON_MULTIPLE, IN_INSERT]); 3557 3558(* Theorem: FINITE s ==> !x. big_lcm (x INSERT s) = lcm x (big_lcm s) *) 3559(* Proof: 3560 If x IN s, 3561 Then x divides (big_lcm s) by big_lcm_is_common_multiple 3562 lcm x (big_lcm s) 3563 = big_lcm s by divides_iff_lcm_fix 3564 = big_lcm (x INSERT s) by ABSORPTION 3565 If x NOTIN s, result is true by big_lcm_reduction 3566*) 3567val big_lcm_insert = store_thm( 3568 "big_lcm_insert", 3569 ``!s. FINITE s ==> !x. big_lcm (x INSERT s) = lcm x (big_lcm s)``, 3570 rpt strip_tac >> 3571 Cases_on `x IN s` >- 3572 metis_tac[big_lcm_is_common_multiple, divides_iff_lcm_fix, ABSORPTION] >> 3573 rw[big_lcm_reduction]); 3574 3575(* Theorem: big_lcm {x; y} = lcm x y *) 3576(* Proof: 3577 big_lcm {x; y} 3578 = big_lcm (x INSERT y) by notation 3579 = lcm x (big_lcm {y}) by big_lcm_insert 3580 = lcm x (big_lcm {y INSERT {}}) by notation 3581 = lcm x (lcm y (big_lcm {})) by big_lcm_insert 3582 = lcm x (lcm y 1) by big_lcm_empty 3583 = lcm x y by LCM_1 3584*) 3585val big_lcm_two = store_thm( 3586 "big_lcm_two", 3587 ``!x y. big_lcm {x; y} = lcm x y``, 3588 rw[big_lcm_insert, big_lcm_empty]); 3589 3590(* Theorem: FINITE s ==> (!x. x IN s ==> 0 < x) ==> 0 < big_lcm s *) 3591(* Proof: 3592 By finite induction on s. 3593 Base: !x. x IN {} ==> 0 < x ==> 0 < big_lcm {} 3594 big_lcm {} = 1 > 0 by big_lcm_empty 3595 Step: (!x. x IN s ==> 0 < x) ==> 0 < big_lcm s ==> 3596 e NOTIN s /\ !x. x IN e INSERT s ==> 0 < x ==> 0 < big_lcm (e INSERT s) 3597 Note 0 < e /\ !x. x IN s ==> 0 < x by IN_INSERT 3598 so 0 < big_lcm s by induction hypothesis 3599 ==> 0 < lcm e (big_lcm s) by LCM_EQ_0 3600 or 0 < big_lcm (e INSERT s) by big_lcm_insert 3601*) 3602val big_lcm_positive = store_thm( 3603 "big_lcm_positive", 3604 ``!s. FINITE s ==> (!x. x IN s ==> 0 < x) ==> 0 < big_lcm s``, 3605 Induct_on `FINITE` >> 3606 rpt strip_tac >- 3607 rw[big_lcm_empty] >> 3608 `0 < e /\ (!x. x IN s ==> 0 < x)` by rw[] >> 3609 metis_tac[big_lcm_insert, LCM_EQ_0, NOT_ZERO_LT_ZERO]); 3610 3611(* Theorem: FINITE s /\ s <> {} ==> !k. big_lcm (IMAGE ($* k) s) = k * big_lcm s *) 3612(* Proof: 3613 By finite induction on s. 3614 Base: {} <> {} ==> ..., must be true. 3615 Step: s <> {} ==> !!k. big_lcm (IMAGE ($* k) s) = k * big_lcm s ==> 3616 e NOTIN s ==> big_lcm (IMAGE ($* k) (e INSERT s)) = k * big_lcm (e INSERT s) 3617 If s = {}, 3618 big_lcm (IMAGE ($* k) (e INSERT {})) 3619 = big_lcm (IMAGE ($* k) {e}) by IN_INSERT, s = {} 3620 = big_lcm {k * e} by IMAGE_SING 3621 = k * e by big_lcm_sing 3622 = k * big_lcm {e} by big_lcm_sing 3623 = k * big_lcm (e INSERT {}) by IN_INSERT, s = {} 3624 If s <> {}, 3625 big_lcm (IMAGE ($* k) (e INSERT s)) 3626 = big_lcm ((k * e) INSERT (IMAGE ($* k) s)) by IMAGE_INSERT 3627 = lcm (k * e) (big_lcm (IMAGE ($* k) s)) by big_lcm_insert 3628 = lcm (k * e) (k * big_lcm s) by induction hypothesis 3629 = k * lcm e (big_lcm s) by LCM_COMMON_FACTOR 3630 = k * big_lcm (e INSERT s) by big_lcm_insert 3631*) 3632val big_lcm_map_times = store_thm( 3633 "big_lcm_map_times", 3634 ``!s. FINITE s /\ s <> {} ==> !k. big_lcm (IMAGE ($* k) s) = k * big_lcm s``, 3635 `!s. FINITE s ==> s <> {} ==> !k. big_lcm (IMAGE ($* k) s) = k * big_lcm s` suffices_by rw[] >> 3636 Induct_on `FINITE` >> 3637 rpt strip_tac >- 3638 rw[] >> 3639 Cases_on `s = {}` >- 3640 rw[big_lcm_sing] >> 3641 `big_lcm (IMAGE ($* k) (e INSERT s)) = lcm (k * e) (k * big_lcm s)` by rw[big_lcm_insert] >> 3642 `_ = k * lcm e (big_lcm s)` by rw[LCM_COMMON_FACTOR] >> 3643 `_ = k * big_lcm (e INSERT s)` by rw[big_lcm_insert] >> 3644 rw[]); 3645 3646(* ------------------------------------------------------------------------- *) 3647(* LCM Lower bound using big LCM *) 3648(* ------------------------------------------------------------------------- *) 3649 3650(* Laurent's leib.v and leib.html 3651 3652Lemma leibn_lcm_swap m n : 3653 lcmn 'L(m.+1, n) 'L(m, n) = lcmn 'L(m.+1, n) 'L(m.+1, n.+1). 3654Proof. 3655rewrite ![lcmn 'L(m.+1, n) _]lcmnC. 3656by apply/lcmn_swap/leibnS. 3657Qed. 3658 3659Notation "\lcm_ ( i < n ) F" := 3660 (\big[lcmn/1%N]_(i < n ) F%N) 3661 (at level 41, F at level 41, i, n at level 50, 3662 format "'[' \lcm_ ( i < n ) '/ ' F ']'") : nat_scope. 3663 3664Canonical Structure lcmn_moid : Monoid.law 1 := 3665 Monoid.Law lcmnA lcm1n lcmn1. 3666Canonical lcmn_comoid := Monoid.ComLaw lcmnC. 3667 3668Lemma lieb_line n i k : lcmn 'L(n.+1, i) (\lcm_(j < k) 'L(n, i + j)) = 3669 \lcm_(j < k.+1) 'L(n.+1, i + j). 3670Proof. 3671elim: k i => [i|k1 IH i]. 3672 by rewrite big_ord_recr !big_ord0 /= lcmn1 lcm1n addn0. 3673rewrite big_ord_recl /= addn0. 3674rewrite lcmnA leibn_lcm_swap. 3675rewrite (eq_bigr (fun j : 'I_k1 => 'L(n, i.+1 + j))). 3676rewrite -lcmnA. 3677rewrite IH. 3678rewrite [RHS]big_ord_recl. 3679rewrite addn0; congr (lcmn _ _). 3680by apply: eq_bigr => j _; rewrite addnS. 3681move=> j _. 3682by rewrite addnS. 3683Qed. 3684 3685Lemma leib_corner n : \lcm_(i < n.+1) 'L(i, 0) = \lcm_(i < n.+1) 'L(n, i). 3686Proof. 3687elim: n => [|n IH]; first by rewrite !big_ord_recr !big_ord0 /=. 3688rewrite big_ord_recr /= IH lcmnC. 3689rewrite (eq_bigr (fun i : 'I_n.+1 => 'L(n, 0 + i))) //. 3690by rewrite lieb_line. 3691Qed. 3692 3693Lemma main_result n : 2^n.-1 <= \lcm_(i < n) i.+1. 3694Proof. 3695case: n => [|n /=]; first by rewrite big_ord0. 3696have <-: \lcm_(i < n.+1) 'L(i, 0) = \lcm_(i < n.+1) i.+1. 3697 by apply: eq_bigr => i _; rewrite leibn0. 3698rewrite leib_corner. 3699have -> : forall j, \lcm_(i < j.+1) 'L(n, i) = n.+1 * \lcm_(i < j.+1) 'C(n, i). 3700 elim=> [|j IH]; first by rewrite !big_ord_recr !big_ord0 /= !lcm1n. 3701 by rewrite big_ord_recr [in RHS]big_ord_recr /= IH muln_lcmr. 3702rewrite (expnDn 1 1) /= (eq_bigr (fun i : 'I_n.+1 => 'C(n, i))) => 3703 [|i _]; last by rewrite !exp1n !muln1. 3704have <- : forall n m, \sum_(i < n) m = n * m. 3705 by move=> m1 n1; rewrite sum_nat_const card_ord. 3706apply: leq_sum => i _. 3707apply: dvdn_leq; last by rewrite (bigD1 i) //= dvdn_lcml. 3708apply big_ind => // [x y Hx Hy|x H]; first by rewrite lcmn_gt0 Hx. 3709by rewrite bin_gt0 -ltnS. 3710Qed. 3711 3712*) 3713 3714(* 3715Lemma lieb_line n i k : lcmn 'L(n.+1, i) (\lcm_(j < k) 'L(n, i + j)) = \lcm_(j < k.+1) 'L(n.+1, i + j). 3716 3717translates to: 3718 !n i k. lcm (leibniz (n + 1) i) (big_lcm {leibniz n (i + j) | j | j < k}) = 3719 big_lcm {leibniz (n+1) (i + j) | j | j < k + 1}`; 3720 3721The picture is: 3722 3723 n-th row: L n i L n (i+1) .... L n (i + (k-1)) 3724(n+1)-th row: L (n+1) i 3725 3726(n+1)-th row: L (n+1) i L (n+1) (i+1) .... L (n+1) (i + (k-1)) L (n+1) (i + k) 3727 3728If k = 1, this is: L n i transform to: 3729 L (n+1) i L (n+1) i L (n+1) (i+1) 3730which is Leibniz triplet. 3731 3732In general, if true for k, then for the next (k+1) 3733 3734 n-th row: L n i L n (i+1) .... L n (i + (k-1)) L n (i + k) 3735(n+1)-th row: L (n+1) i 3736= L n (i + k) 3737(n+1)-th row: L (n+1) i L (n+1) (i+1) .... L (n+1) (i + (k-1)) L (n+1) (i + k) 3738by induction hypothesis 3739= 3740(n+1)-th row: L (n+1) i L (n+1) (i+1) .... L (n+1) (i + (k-1)) L (n+1) (i + k) L (n+1) (i + (k+1)) 3741by Leibniz triplet. 3742 3743*) 3744 3745(* Introduce a segment, a partial horizontal row, in Leibniz Denominator Triangle *) 3746val _ = overload_on("leibniz_seg", ``\n k h. IMAGE (\j. leibniz n (k + j)) (count h)``); 3747(* This is a segment starting at leibniz n k, of length h *) 3748 3749(* Introduce a horizontal row in Leibniz Denominator Triangle *) 3750val _ = overload_on("leibniz_row", ``\n h. IMAGE (leibniz n) (count h)``); 3751(* This is a row starting at leibniz n 0, of length h *) 3752 3753(* Introduce a vertical column in Leibniz Denominator Triangle *) 3754val _ = overload_on("leibniz_col", ``\h. IMAGE (\i. leibniz i 0) (count h)``); 3755(* This is a column starting at leibniz 0 0, descending for a length h *) 3756 3757(* Representations of paths based on indexed sets *) 3758 3759(* Theorem: leibniz_seg n k h = {leibniz n (k + j) | j | j IN (count h)} *) 3760(* Proof: by notation *) 3761val leibniz_seg_def = store_thm( 3762 "leibniz_seg_def", 3763 ``!n k h. leibniz_seg n k h = {leibniz n (k + j) | j | j IN (count h)}``, 3764 rw[EXTENSION]); 3765 3766(* Theorem: leibniz_row n h = {leibniz n j | j | j IN (count h)} *) 3767(* Proof: by notation *) 3768val leibniz_row_def = store_thm( 3769 "leibniz_row_def", 3770 ``!n h. leibniz_row n h = {leibniz n j | j | j IN (count h)}``, 3771 rw[EXTENSION]); 3772 3773(* Theorem: leibniz_col h = {leibniz j 0 | j | j IN (count h)} *) 3774(* Proof: by notation *) 3775val leibniz_col_def = store_thm( 3776 "leibniz_col_def", 3777 ``!h. leibniz_col h = {leibniz j 0 | j | j IN (count h)}``, 3778 rw[EXTENSION]); 3779 3780(* Theorem: leibniz_col n = natural n *) 3781(* Proof: 3782 leibniz_col n 3783 = IMAGE (\i. leibniz i 0) (count n) by notation 3784 = IMAGE (\i. i + 1) (count n) by leibniz_n_0 3785 = IMAGE (\i. SUC i) (count n) by ADD1 3786 = IMAGE SUC (count n) by FUN_EQ_THM 3787 = natural n by notation 3788*) 3789val leibniz_col_eq_natural = store_thm( 3790 "leibniz_col_eq_natural", 3791 ``!n. leibniz_col n = natural n``, 3792 rw[leibniz_n_0, ADD1, FUN_EQ_THM]); 3793 3794(* The following can be taken as a generalisation of the Leibniz Triplet LCM exchange. *) 3795(* When length h = 1, the top row is a singleton, and the next row is a duplet, altogether a triplet. *) 3796 3797(* Theorem: lcm (leibniz (n + 1) k) (big_lcm (leibniz_seg n k h)) = big_lcm (leibniz_seg (n + 1) k (h + 1)) *) 3798(* Proof: 3799 Let p = (\j. leibniz n (k + j)), q = (\j. leibniz (n + 1) (k + j)). 3800 Note q 0 = (leibniz (n + 1) k) by function application [1] 3801 The goal is: lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count h))) = big_lcm (IMAGE q (count (h + 1))) 3802 3803 By induction on h, length of the row. 3804 Base case: lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count 0))) = big_lcm (IMAGE q (count (0 + 1))) 3805 lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count 0))) 3806 = lcm (q 0) (big_lcm (IMAGE p (count 0))) by [1] 3807 = lcm (q 0) (big_lcm (IMAGE p {})) by COUNT_ZERO 3808 = lcm (q 0) (big_lcm {}) by IMAGE_EMPTY 3809 = lcm (q 0) 1 by big_lcm_empty 3810 = q 0 by LCM_1 3811 = big_lcm {q 0} by big_lcm_sing 3812 = big_lcm (IMAEG q {0}) by IMAGE_SING 3813 = big_lcm (IMAGE q (count 1)) by count_def, EXTENSION 3814 3815 Step case: lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (count h))) = big_lcm (IMAGE q (count (h + 1))) ==> 3816 lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (upto h))) = big_lcm (IMAGE q (count (SUC h + 1))) 3817 Note !n. FINITE (count n) by FINITE_COUNT 3818 and !s. FINITE s ==> FINITE (IMAGE f s) by IMAGE_FINITE 3819 Also p h = (triplet n (k + h)).a by leibniz_triplet_member 3820 q h = (triplet n (k + h)).b by leibniz_triplet_member 3821 q (h + 1) = (triplet n (k + h)).c by leibniz_triplet_member 3822 Thus lcm (q h) (p h) = lcm (q h) (q (h + 1)) by leibniz_triplet_lcm 3823 3824 lcm (leibniz (n + 1) k) (big_lcm (IMAGE p (upto h))) 3825 = lcm (q 0) (big_lcm (IMAGE p (count (SUC h)))) by [1], notation 3826 = lcm (q 0) (big_lcm (IMAGE p (h INSERT count h))) by upto_by_count 3827 = lcm (q 0) (big_lcm ((p h) INSERT (IMAGE p (count h)))) by IMAGE_INSERT 3828 = lcm (q 0) (lcm (p h) (big_lcm (IMAGE p (count h)))) by big_lcm_insert 3829 = lcm (p h) (lcm (q 0) (big_lcm (IMAGE p (count h)))) by LCM_ASSOC_COMM 3830 = lcm (p h) (big_lcm (IMAGE q (count (h + 1)))) by induction hypothesis 3831 = lcm (p h) (big_lcm (IMAGE q (count (SUC h)))) by ADD1 3832 = lcm (p h) (big_lcm (IMAGE q (h INSERT (count h))) by upto_by_count 3833 = lcm (p h) (big_lcm ((q h) INSERT IMAGE q (count h))) by IMAGE_INSERT 3834 = lcm (p h) (lcm (q h) (big_lcm (IMAGE q (count h)))) by big_lcm_insert 3835 = lcm (lcm (p h) (q h)) (big_lcm (IMAGE q (count h))) by LCM_ASSOC 3836 = lcm (lcm (q h) (p h)) (big_lcm (IMAGE q (count h))) by LCM_COM 3837 = lcm (lcm (q h) (q (h + 1))) (big_lcm (IMAGE q (count h))) by leibniz_triplet_lcm 3838 = lcm (q (h + 1)) (lcm (q h) (big_lcm (IMAGE q (count h)))) by LCM_ASSOC, LCM_COMM 3839 = lcm (q (h + 1)) (big_lcm ((q h) INSERT IMAGE q (count h))) by big_lcm_insert 3840 = lcm (q (h + 1)) (big_lcm (IMAGE q (h INSERT count h)) by IMAGE_INSERT 3841 = lcm (q (h + 1)) (big_lcm (IMAGE q (count (h + 1)))) by upto_by_count, ADD1 3842 = big_lcm ((q (h + 1)) INSERT (IMAGE q (count (h + 1)))) by big_lcm_insert 3843 = big_lcm IMAGE q ((h + 1) INSERT (count (h + 1))) by IMAGE_INSERT 3844 = big_lcm (IMAGE q (count (SUC (h + 1)))) by upto_by_count 3845 = big_lcm (IMAGE q (count (SUC h + 1))) by ADD 3846*) 3847val big_lcm_seg_transform = store_thm( 3848 "big_lcm_seg_transform", 3849 ``!n k h. lcm (leibniz (n + 1) k) (big_lcm (leibniz_seg n k h)) = 3850 big_lcm (leibniz_seg (n + 1) k (h + 1))``, 3851 rpt strip_tac >> 3852 qabbrev_tac `p = (\j. leibniz n (k + j))` >> 3853 qabbrev_tac `q = (\j. leibniz (n + 1) (k + j))` >> 3854 Induct_on `h` >| [ 3855 `count 0 = {}` by rw[] >> 3856 `count 1 = {0}` by rw[COUNT_1] >> 3857 rw_tac std_ss[IMAGE_EMPTY, big_lcm_empty, IMAGE_SING, LCM_1, big_lcm_sing, Abbr`p`, Abbr`q`], 3858 `leibniz (n + 1) k = q 0` by rw[Abbr`q`] >> 3859 simp[] >> 3860 `lcm (q h) (p h) = lcm (q h) (q (h + 1))` by 3861 (`p h = (triplet n (k + h)).a` by rw[leibniz_triplet_member, Abbr`p`] >> 3862 `q h = (triplet n (k + h)).b` by rw[leibniz_triplet_member, Abbr`q`] >> 3863 `q (h + 1) = (triplet n (k + h)).c` by rw[leibniz_triplet_member, Abbr`q`] >> 3864 rw[leibniz_triplet_lcm]) >> 3865 `lcm (q 0) (big_lcm (IMAGE p (count (SUC h)))) = lcm (q 0) (lcm (p h) (big_lcm (IMAGE p (count h))))` by rw[upto_by_count, big_lcm_insert] >> 3866 `_ = lcm (p h) (lcm (q 0) (big_lcm (IMAGE p (count h))))` by rw[LCM_ASSOC_COMM] >> 3867 `_ = lcm (p h) (big_lcm (IMAGE q (count (SUC h))))` by metis_tac[ADD1] >> 3868 `_ = lcm (p h) (lcm (q h) (big_lcm (IMAGE q (count h))))` by rw[upto_by_count, big_lcm_insert] >> 3869 `_ = lcm (q (h + 1)) (lcm (q h) (big_lcm (IMAGE q (count h))))` by metis_tac[LCM_ASSOC, LCM_COMM] >> 3870 `_ = lcm (q (h + 1)) (big_lcm (IMAGE q (count (SUC h))))` by rw[upto_by_count, big_lcm_insert] >> 3871 `_ = lcm (q (h + 1)) (big_lcm (IMAGE q (count (h + 1))))` by rw[ADD1] >> 3872 `_ = big_lcm (IMAGE q (count (SUC (h + 1))))` by rw[upto_by_count, big_lcm_insert] >> 3873 metis_tac[ADD] 3874 ]); 3875 3876(* Theorem: lcm (leibniz (n + 1) 0) (big_lcm (leibniz_row n h)) = big_lcm (leibniz_row (n + 1) (h + 1)) *) 3877(* Proof: 3878 Note !n h. leibniz_row n h = leibniz_seg n 0 h by FUN_EQ_THM 3879 Take k = 0 in big_lcm_seg_transform, the result follows. 3880*) 3881val big_lcm_row_transform = store_thm( 3882 "big_lcm_row_transform", 3883 ``!n h. lcm (leibniz (n + 1) 0) (big_lcm (leibniz_row n h)) = big_lcm (leibniz_row (n + 1) (h + 1))``, 3884 rpt strip_tac >> 3885 `!n h. leibniz_row n h = leibniz_seg n 0 h` by rw[FUN_EQ_THM] >> 3886 metis_tac[big_lcm_seg_transform]); 3887 3888(* Theorem: big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1)) *) 3889(* Proof: 3890 Let f = \i. leibniz i 0, then f 0 = leibniz 0 0. 3891 By induction on n. 3892 Base: big_lcm (leibniz_col (0 + 1)) = big_lcm (leibniz_row 0 (0 + 1)) 3893 big_lcm (leibniz_col (0 + 1)) 3894 = big_lcm (IMAGE f (count 1)) by notation 3895 = big_lcm (IMAGE f) {0}) by COUNT_1 3896 = big_lcm {f 0} by IMAGE_SING 3897 = big_lcm {leibniz 0 0} by f 0 3898 = big_lcm (IMAGE (leibniz 0) {0}) by IMAGE_SING 3899 = big_lcm (IMAGE (leibniz 0) (count 1)) by COUNT_1 3900 3901 Step: big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1)) ==> 3902 big_lcm (leibniz_col (SUC n + 1)) = big_lcm (leibniz_row (SUC n) (SUC n + 1)) 3903 big_lcm (leibniz_col (SUC n + 1)) 3904 = big_lcm (IMAGE f (count (SUC n + 1))) by notation 3905 = big_lcm (IMAGE f (count (SUC (n + 1)))) by ADD 3906 = big_lcm (IMAGE f ((n + 1) INSERT (count (n + 1)))) by upto_by_count 3907 = big_lcm ((f (n + 1)) INSERT (IMAGE f (count (n + 1)))) by IMAGE_INSERT 3908 = lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by big_lcm_insert 3909 = lcm (f (n + 1)) (big_lcm (IMAGE (leibniz n) (count (n + 1)))) by induction hypothesis 3910 = lcm (leibniz (n + 1) 0) (big_lcm (IMAGE (leibniz n) (count (n + 1)))) by f (n + 1) 3911 = big_lcm (IMAGE (leibniz (n + 1)) (count (n + 1 + 1))) by big_lcm_line_transform 3912 = big_lcm (IMAGE (leibniz (SUC n)) (count (SUC n + 1))) by ADD1 3913*) 3914val big_lcm_corner_transform = store_thm( 3915 "big_lcm_corner_transform", 3916 ``!n. big_lcm (leibniz_col (n + 1)) = big_lcm (leibniz_row n (n + 1))``, 3917 Induct >- 3918 rw[COUNT_1, IMAGE_SING] >> 3919 qabbrev_tac `f = \i. leibniz i 0` >> 3920 `big_lcm (IMAGE f (count (SUC n + 1))) = big_lcm (IMAGE f (count (SUC (n + 1))))` by rw[ADD] >> 3921 `_ = lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[upto_by_count, big_lcm_insert] >> 3922 `_ = lcm (leibniz (n + 1) 0) (big_lcm (IMAGE (leibniz n) (count (n + 1))))` by rw[Abbr`f`] >> 3923 `_ = big_lcm (IMAGE (leibniz (n + 1)) (count (n + 1 + 1)))` by rw[big_lcm_row_transform] >> 3924 `_ = big_lcm (IMAGE (leibniz (SUC n)) (count (SUC n + 1)))` by rw[ADD1] >> 3925 rw[]); 3926 3927(* Theorem: (!x. x IN (count (n + 1)) ==> 0 < f x) ==> 3928 SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1))) *) 3929(* Proof: 3930 By induction on n. 3931 Base: SUM (GENLIST f (0 + 1)) <= (0 + 1) * big_lcm (IMAGE f (count (0 + 1))) 3932 LHS = SUM (GENLIST f 1) 3933 = SUM [f 0] by GENLIST_1 3934 = f 0 by SUM 3935 RHS = 1 * big_lcm (IMAGE f (count 1)) 3936 = big_lcm (IMAGE f {0}) by COUNT_1 3937 = big_lcm (f 0) by IMAGE_SING 3938 = f 0 by big_lcm_sing 3939 Thus LHS <= RHS by arithmetic 3940 Step: SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1))) ==> 3941 SUM (GENLIST f (SUC n + 1)) <= (SUC n + 1) * big_lcm (IMAGE f (count (SUC n + 1))) 3942 Note 0 < f (n + 1) by (n + 1) IN count (SUC n + 1) 3943 and !y. y IN count (n + 1) ==> y IN count (SUC n + 1) by IN_COUNT 3944 and !x. x IN IMAGE f (count (n + 1)) ==> 0 < x by IN_IMAGE, above 3945 so 0 < big_lcm (IMAGE f (count (n + 1))) by big_lcm_positive 3946 and 0 < SUC n by SUC_POS 3947 Thus f (n + 1) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by LCM_LE 3948 and big_lcm (IMAGE f (count (n + 1))) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by LCM_LE 3949 3950 LHS = SUM (GENLIST f (SUC n + 1)) 3951 = SUM (GENLIST f (SUC (n + 1))) by ADD 3952 = SUM (SNOC (f (n + 1)) (GENLIST f (n + 1))) by GENLIST 3953 = SUM (GENLIST f (n + 1)) + f (n + 1) by SUM_SNOC 3954 RHS = (SUC n + 1) * big_lcm (IMAGE f (count (SUC n + 1))) 3955 = (SUC n + 1) * big_lcm (IMAGE f (count (SUC (n + 1)))) by ADD 3956 = (SUC n + 1) * big_lcm (IMAGE f ((n + 1) INSERT (count (n + 1)))) by upto_by_count 3957 = (SUC n + 1) * big_lcm ((f (n + 1)) INSERT (IMAGE f (count (n + 1)))) by IMAGE_INSERT 3958 = (SUC n + 1) * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by big_lcm_insert 3959 = SUC n * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) 3960 + 1 * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1)))) by RIGHT_ADD_DISTRIB 3961 >= SUC n * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) by LCM_LE 3962 = (n + 1) * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) by ADD1 3963 >= SUM (GENLIST f (n + 1)) + f (n + 1) by induction hypothesis 3964 = LHS by above 3965*) 3966val big_lcm_count_lower_bound = store_thm( 3967 "big_lcm_count_lower_bound", 3968 ``!f n. (!x. x IN (count (n + 1)) ==> 0 < f x) ==> 3969 SUM (GENLIST f (n + 1)) <= (n + 1) * big_lcm (IMAGE f (count (n + 1)))``, 3970 rpt strip_tac >> 3971 Induct_on `n` >| [ 3972 rpt strip_tac >> 3973 `SUM (GENLIST f 1) = f 0` by rw[] >> 3974 `1 * big_lcm (IMAGE f (count 1)) = f 0` by rw[COUNT_1, big_lcm_sing] >> 3975 rw[], 3976 rpt strip_tac >> 3977 `big_lcm (IMAGE f (count (SUC n + 1))) = big_lcm (IMAGE f (count (SUC (n + 1))))` by rw[ADD] >> 3978 `_ = lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[upto_by_count, big_lcm_insert] >> 3979 `!x. (SUC n + 1) * x = SUC n * x + x` by rw[] >> 3980 `0 < f (n + 1)` by rw[] >> 3981 `!y. y IN count (n + 1) ==> y IN count (SUC n + 1)` by rw[] >> 3982 `!x. x IN IMAGE f (count (n + 1)) ==> 0 < x` by metis_tac[IN_IMAGE] >> 3983 `0 < big_lcm (IMAGE f (count (n + 1)))` by rw[big_lcm_positive] >> 3984 `0 < SUC n` by rw[] >> 3985 `f (n + 1) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[LCM_LE] >> 3986 `big_lcm (IMAGE f (count (n + 1))) <= lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by rw[LCM_LE] >> 3987 `!a b c x. 0 < a /\ 0 < b /\ 0 < c /\ a <= x /\ b <= x ==> c * a + b <= c * x + x` by 3988 (rpt strip_tac >> 3989 `c * a <= c * x` by rw[] >> 3990 decide_tac) >> 3991 `SUC n * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) <= (SUC n + 1) * lcm (f (n + 1)) (big_lcm (IMAGE f (count (n + 1))))` by metis_tac[] >> 3992 `SUC n * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1) = (n + 1) * (big_lcm (IMAGE f (count (n + 1)))) + f (n + 1)` by rw[ADD1] >> 3993 `SUM (GENLIST f (SUC n + 1)) = SUM (GENLIST f (SUC (n + 1)))` by rw[ADD] >> 3994 `_ = SUM (GENLIST f (n + 1)) + f (n + 1)` by rw[GENLIST, SUM_SNOC] >> 3995 metis_tac[LESS_EQ_TRANS, DECIDE``!a x y. 0 < a /\ x <= y ==> x + a <= y + a``] 3996 ]); 3997 3998(* Theorem: big_lcm (natural (n + 1)) = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) *) 3999(* Proof: 4000 Note SUC = \i. i + 1 by ADD1, FUN_EQ_THM 4001 = \i. leibniz i 0 by leibniz_n_0 4002 and leibniz n = \j. (n + 1) * binomial n j by leibniz_def, FUN_EQ_THM 4003 so !s. IMAGE SUC s = IMAGE (\i. leibniz i 0) s by IMAGE_CONG 4004 and !s. IMAGE (leibniz n) s = IMAGE (\j. (n + 1) * binomial n j) s by IMAGE_CONG 4005 also !s. IMAGE (binomial n) s = IMAGE (\j. binomial n j) s by FUN_EQ_THM, IMAGE_CONG 4006 and count (n + 1) <> {} by COUNT_EQ_EMPTY, n + 1 <> 0 [1] 4007 4008 big_lcm (IMAGE SUC (count (n + 1))) 4009 = big_lcm (IMAGE (\i. leibniz i 0) (count (n + 1))) by above 4010 = big_lcm (IMAGE (leibniz n) (count (n + 1))) by big_lcm_corner_transform 4011 = big_lcm (IMAGE (\j. (n + 1) * binomial n j) (count (n + 1))) by leibniz_def 4012 = big_lcm (IMAGE ($* (n + 1)) (IMAGE (binomial n) (count (n + 1)))) by IMAGE_COMPOSE, o_DEF 4013 = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) by big_lcm_map_times, FINITE_COUNT, [1] 4014*) 4015val big_lcm_natural_eqn = store_thm( 4016 "big_lcm_natural_eqn", 4017 ``!n. big_lcm (natural (n + 1)) = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))``, 4018 rpt strip_tac >> 4019 `SUC = \i. leibniz i 0` by rw[leibniz_n_0, FUN_EQ_THM] >> 4020 `leibniz n = \j. (n + 1) * binomial n j` by rw[leibniz_def, FUN_EQ_THM] >> 4021 `!s. IMAGE SUC s = IMAGE (\i. leibniz i 0) s` by rw[IMAGE_CONG] >> 4022 `!s. IMAGE (leibniz n) s = IMAGE (\j. (n + 1) * binomial n j) s` by rw[IMAGE_CONG] >> 4023 `!s. IMAGE (binomial n) s = IMAGE (\j. binomial n j) s` by rw[FUN_EQ_THM, IMAGE_CONG] >> 4024 `count (n + 1) <> {}` by rw[COUNT_EQ_EMPTY] >> 4025 `big_lcm (IMAGE SUC (count (n + 1))) = big_lcm (IMAGE (leibniz n) (count (n + 1)))` by rw[GSYM big_lcm_corner_transform] >> 4026 `_ = big_lcm (IMAGE (\j. (n + 1) * binomial n j) (count (n + 1)))` by rw[] >> 4027 `_ = big_lcm (IMAGE ($* (n + 1)) (IMAGE (binomial n) (count (n + 1))))` by rw[GSYM IMAGE_COMPOSE, combinTheory.o_DEF] >> 4028 `_ = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))` by rw[big_lcm_map_times] >> 4029 rw[]); 4030 4031(* Theorem: 2 ** n <= big_lcm (natural (n + 1)) *) 4032(* Proof: 4033 Note !x. x IN (count (n + 1)) ==> 0 < (binomial n) x by binomial_pos, IN_COUNT [1] 4034 big_lcm (natural (n + 1)) 4035 = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) by big_lcm_natural_eqn 4036 >= SUM (GENLIST (binomial n) (n + 1)) by big_lcm_count_lower_bound, [1] 4037 = SUM (GENLIST (binomial n) (SUC n)) by ADD1 4038 = 2 ** n by binomial_sum 4039*) 4040val big_lcm_lower_bound = store_thm( 4041 "big_lcm_lower_bound", 4042 ``!n. 2 ** n <= big_lcm (natural (n + 1))``, 4043 rpt strip_tac >> 4044 `!x. x IN (count (n + 1)) ==> 0 < (binomial n) x` by rw[binomial_pos] >> 4045 `big_lcm (IMAGE SUC (count (n + 1))) = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1)))` by rw[big_lcm_natural_eqn] >> 4046 `SUM (GENLIST (binomial n) (n + 1)) = 2 ** n` by rw[GSYM binomial_sum, ADD1] >> 4047 metis_tac[big_lcm_count_lower_bound]); 4048 4049(* Another proof of the milestone theorem. *) 4050 4051(* Theorem: big_lcm (set l) = list_lcm l *) 4052(* Proof: 4053 By induction on l. 4054 Base: big_lcm (set []) = list_lcm [] 4055 big_lcm (set []) 4056 = big_lcm {} by LIST_TO_SET 4057 = 1 by big_lcm_empty 4058 = list_lcm [] by list_lcm_nil 4059 Step: big_lcm (set l) = list_lcm l ==> !h. big_lcm (set (h::l)) = list_lcm (h::l) 4060 Note FINITE (set l) by FINITE_LIST_TO_SET 4061 big_lcm (set (h::l)) 4062 = big_lcm (h INSERT set l) by LIST_TO_SET 4063 = lcm h (big_lcm (set l)) by big_lcm_insert, FINITE (set t) 4064 = lcm h (list_lcm l) by induction hypothesis 4065 = list_lcm (h::l) by list_lcm_cons 4066*) 4067val big_lcm_eq_list_lcm = store_thm( 4068 "big_lcm_eq_list_lcm", 4069 ``!l. big_lcm (set l) = list_lcm l``, 4070 Induct >- 4071 rw[big_lcm_empty] >> 4072 rw[big_lcm_insert]); 4073 4074(* ------------------------------------------------------------------------- *) 4075(* List LCM depends only on its set of elements *) 4076(* ------------------------------------------------------------------------- *) 4077 4078(* Theorem: MEM x l ==> (list_lcm (x::l) = list_lcm l) *) 4079(* Proof: 4080 By induction on l. 4081 Base: MEM x [] ==> (list_lcm [x] = list_lcm []) 4082 True by MEM x [] = F by MEM 4083 Step: MEM x l ==> (list_lcm (x::l) = list_lcm l) ==> 4084 !h. MEM x (h::l) ==> (list_lcm (x::h::l) = list_lcm (h::l)) 4085 Note MEM x (h::l) ==> (x = h) \/ (MEM x l) by MEM 4086 If x = h, 4087 list_lcm (h::h::l) 4088 = lcm h (lcm h (list_lcm l)) by list_lcm_cons 4089 = lcm (lcm h h) (list_lcm l) by LCM_ASSOC 4090 = lcm h (list_lcm l) by LCM_REF 4091 = list_lcm (h::l) by list_lcm_cons 4092 If x <> h, MEM x l 4093 list_lcm (x::h::l) 4094 = lcm x (lcm h (list_lcm l)) by list_lcm_cons 4095 = lcm h (lcm x (list_lcm l)) by LCM_ASSOC_COMM 4096 = lcm h (list_lcm (x::l)) by list_lcm_cons 4097 = lcm h (list_lcm l) by induction hypothesis, MEM x l 4098 = list_lcm (h::l) by list_lcm_cons 4099*) 4100val list_lcm_absorption = store_thm( 4101 "list_lcm_absorption", 4102 ``!x l. MEM x l ==> (list_lcm (x::l) = list_lcm l)``, 4103 rpt strip_tac >> 4104 Induct_on `l` >- 4105 metis_tac[MEM] >> 4106 rw[MEM] >| [ 4107 `lcm h (lcm h (list_lcm l)) = lcm (lcm h h) (list_lcm l)` by rw[LCM_ASSOC] >> 4108 rw[LCM_REF], 4109 `lcm x (lcm h (list_lcm l)) = lcm h (lcm x (list_lcm l))` by rw[LCM_ASSOC_COMM] >> 4110 `_ = lcm h (list_lcm (x::l))` by metis_tac[list_lcm_cons] >> 4111 rw[] 4112 ]); 4113 4114(* Theorem: list_lcm (nub l) = list_lcm l *) 4115(* Proof: 4116 By induction on l. 4117 Base: list_lcm (nub []) = list_lcm [] 4118 True since nub [] = [] by nub_nil 4119 Step: list_lcm (nub l) = list_lcm l ==> !h. list_lcm (nub (h::l)) = list_lcm (h::l) 4120 If MEM h l, 4121 list_lcm (nub (h::l)) 4122 = list_lcm (nub l) by nub_cons, MEM h l 4123 = list_lcm l by induction hypothesis 4124 = list_lcm (h::l) by list_lcm_absorption, MEM h l 4125 If ~(MEM h l), 4126 list_lcm (nub (h::l)) 4127 = list_lcm (h::nub l) by nub_cons, ~(MEM h l) 4128 = lcm h (list_lcm (nub l)) by list_lcm_cons 4129 = lcm h (list_lcm l) by induction hypothesis 4130 = list_lcm (h::l) by list_lcm_cons 4131*) 4132val list_lcm_nub = store_thm( 4133 "list_lcm_nub", 4134 ``!l. list_lcm (nub l) = list_lcm l``, 4135 Induct >- 4136 rw[nub_nil] >> 4137 metis_tac[nub_cons, list_lcm_cons, list_lcm_absorption]); 4138 4139(* Theorem: (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2)) *) 4140(* Proof: 4141 By induction on l1. 4142 Base: !l2. (set [] = set l2) ==> (list_lcm (nub []) = list_lcm (nub l2)) 4143 Note set [] = set l2 ==> l2 = [] by LIST_TO_SET_EQ_EMPTY 4144 Hence true. 4145 Step: !l2. (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2)) ==> 4146 !h l2. (set (h::l1) = set l2) ==> (list_lcm (nub (h::l1)) = list_lcm (nub l2)) 4147 If MEM h l1, 4148 Then h IN (set l1) by notation 4149 set (h::l1) 4150 = h INSERT set l1 by LIST_TO_SET 4151 = set l1 by ABSORPTION_RWT 4152 Thus set l1 = set l2, 4153 so list_lcm (nub (h::l1)) 4154 = list_lcm (nub l1) by nub_cons, MEM h l1 4155 = list_lcm (nub l2) by induction hypothesis, set l1 = set l2 4156 4157 If ~(MEM h l1), 4158 Then set (h::l1) = set l2 4159 ==> ?p1 p2. nub l2 = p1 ++ [h] ++ p2 4160 and set l1 = set (p1 ++ p2) by LIST_TO_SET_REDUCTION 4161 4162 list_lcm (nub (h::l1)) 4163 = list_lcm (h::nub l1) by nub_cons, ~(MEM h l1) 4164 = lcm h (list_lcm (nub l1)) by list_lcm_cons 4165 = lcm h (list_lcm (nub (p1 ++ p2))) by induction hypothesis 4166 = lcm h (list_lcm (p1 ++ p2)) by list_lcm_nub 4167 = lcm h (lcm (list_lcm p1) (list_lcm p2)) by list_lcm_append 4168 = lcm (list_lcm p1) (lcm h (list_lcm p2)) by LCM_ASSOC_COMM 4169 = lcm (list_lcm p1) (list_lcm (h::p2)) by list_lcm_append 4170 = lcm (list_lcm p1) (list_lcm ([h] ++ p2)) by CONS_APPEND 4171 = list_lcm (p1 ++ ([h] ++ p2)) by list_lcm_append 4172 = list_lcm (p1 ++ [h] ++ p2) by APPEND_ASSOC 4173 = list_lcm (nub l2) by above 4174*) 4175val list_lcm_nub_eq_if_set_eq = store_thm( 4176 "list_lcm_nub_eq_if_set_eq", 4177 ``!l1 l2. (set l1 = set l2) ==> (list_lcm (nub l1) = list_lcm (nub l2))``, 4178 Induct >- 4179 rw[LIST_TO_SET_EQ_EMPTY] >> 4180 rpt strip_tac >> 4181 Cases_on `MEM h l1` >- 4182 metis_tac[LIST_TO_SET, ABSORPTION_RWT, nub_cons] >> 4183 `?p1 p2. (nub l2 = p1 ++ [h] ++ p2) /\ (set l1 = set (p1 ++ p2))` by metis_tac[LIST_TO_SET_REDUCTION] >> 4184 `list_lcm (nub (h::l1)) = list_lcm (h::nub l1)` by rw[nub_cons] >> 4185 `_ = lcm h (list_lcm (nub l1))` by rw[list_lcm_cons] >> 4186 `_ = lcm h (list_lcm (nub (p1 ++ p2)))` by metis_tac[] >> 4187 `_ = lcm h (list_lcm (p1 ++ p2))` by rw[list_lcm_nub] >> 4188 `_ = lcm h (lcm (list_lcm p1) (list_lcm p2))` by rw[list_lcm_append] >> 4189 `_ = lcm (list_lcm p1) (lcm h (list_lcm p2))` by rw[LCM_ASSOC_COMM] >> 4190 `_ = lcm (list_lcm p1) (list_lcm ([h] ++ p2))` by rw[list_lcm_cons] >> 4191 metis_tac[list_lcm_append, APPEND_ASSOC]); 4192 4193(* Theorem: (set l1 = set l2) ==> (list_lcm l1 = list_lcm l2) *) 4194(* Proof: 4195 set l1 = set l2 4196 ==> list_lcm (nub l1) = list_lcm (nub l2) by list_lcm_nub_eq_if_set_eq 4197 ==> list_lcm l1 = list_lcm l2 by list_lcm_nub 4198*) 4199val list_lcm_eq_if_set_eq = store_thm( 4200 "list_lcm_eq_if_set_eq", 4201 ``!l1 l2. (set l1 = set l2) ==> (list_lcm l1 = list_lcm l2)``, 4202 metis_tac[list_lcm_nub_eq_if_set_eq, list_lcm_nub]); 4203 4204(* ------------------------------------------------------------------------- *) 4205(* Set LCM by List LCM *) 4206(* ------------------------------------------------------------------------- *) 4207 4208(* Define LCM of a set *) 4209(* none works! 4210val set_lcm_def = Define` 4211 (set_lcm {} = 1) /\ 4212 !s. FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm (s DELETE x)) 4213`; 4214val set_lcm_def = Define` 4215 (set_lcm {} = 1) /\ 4216 (!s. FINITE s ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s)))) 4217`; 4218val set_lcm_def = Define` 4219 set_lcm s = if s = {} then 1 else lcm (CHOICE s) (set_lcm (REST s)) 4220`; 4221*) 4222val set_lcm_def = Define` 4223 set_lcm s = list_lcm (SET_TO_LIST s) 4224`; 4225 4226(* Theorem: set_lcm {} = 1 *) 4227(* Proof: 4228 set_lcm {} 4229 = lcm_list (SET_TO_LIST {}) by set_lcm_def 4230 = lcm_list [] by SET_TO_LIST_EMPTY 4231 = 1 by list_lcm_nil 4232*) 4233val set_lcm_empty = store_thm( 4234 "set_lcm_empty", 4235 ``set_lcm {} = 1``, 4236 rw[set_lcm_def]); 4237 4238(* Theorem: FINITE s /\ s <> {} ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s))) *) 4239(* Proof: 4240 set_lcm s 4241 = list_lcm (SET_TO_LIST s) by set_lcm_def 4242 = list_lcm (CHOICE s::SET_TO_LIST (REST s)) by SET_TO_LIST_THM 4243 = lcm (CHOICE s) (list_lcm (SET_TO_LIST (REST s))) by list_lcm_cons 4244 = lcm (CHOICE s) (set_lcm (REST s)) by set_lcm_def 4245*) 4246val set_lcm_nonempty = store_thm( 4247 "set_lcm_nonempty", 4248 ``!s. FINITE s /\ s <> {} ==> (set_lcm s = lcm (CHOICE s) (set_lcm (REST s)))``, 4249 rw[set_lcm_def, SET_TO_LIST_THM, list_lcm_cons]); 4250 4251(* Theorem: set_lcm {x} = x *) 4252(* Proof: 4253 set_lcm {x} 4254 = list_lcm (SET_TO_LIST {x}) by set_lcm_def 4255 = list_lcm [x] by SET_TO_LIST_SING 4256 = x by list_lcm_sing 4257*) 4258val set_lcm_sing = store_thm( 4259 "set_lcm_sing", 4260 ``!x. set_lcm {x} = x``, 4261 rw_tac std_ss[set_lcm_def, SET_TO_LIST_SING, list_lcm_sing]); 4262 4263(* Theorem: set_lcm (set l) = list_lcm l *) 4264(* Proof: 4265 Let t = SET_TO_LIST (set l) 4266 Note FINITE (set l) by FINITE_LIST_TO_SET 4267 Then set t 4268 = set (SET_TO_LIST (set l)) by notation 4269 = set l by SET_TO_LIST_INV, FINITE (set l) 4270 4271 set_lcm (set l) 4272 = list_lcm (SET_TO_LIST (set l)) by set_lcm_def 4273 = list_lcm t by notation 4274 = list_lcm l by list_lcm_eq_if_set_eq, set t = set l 4275*) 4276val set_lcm_eq_list_lcm = store_thm( 4277 "set_lcm_eq_list_lcm", 4278 ``!l. set_lcm (set l) = list_lcm l``, 4279 rw[FINITE_LIST_TO_SET, SET_TO_LIST_INV, set_lcm_def, list_lcm_eq_if_set_eq]); 4280 4281(* Theorem: FINITE s ==> (set_lcm s = big_lcm s) *) 4282(* Proof: 4283 set_lcm s 4284 = list_lcm (SET_TO_LIST s) by set_lcm_def 4285 = big_lcm (set (SET_TO_LIST s)) by big_lcm_eq_list_lcm 4286 = big_lcm s by SET_TO_LIST_INV, FINITE s 4287*) 4288val set_lcm_eq_big_lcm = store_thm( 4289 "set_lcm_eq_big_lcm", 4290 ``!s. FINITE s ==> (big_lcm s = set_lcm s)``, 4291 metis_tac[set_lcm_def, big_lcm_eq_list_lcm, SET_TO_LIST_INV]); 4292 4293(* Theorem: FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm s) *) 4294(* Proof: by big_lcm_insert, set_lcm_eq_big_lcm *) 4295val set_lcm_insert = store_thm( 4296 "set_lcm_insert", 4297 ``!s. FINITE s ==> !x. set_lcm (x INSERT s) = lcm x (set_lcm s)``, 4298 rw[big_lcm_insert, GSYM set_lcm_eq_big_lcm]); 4299 4300(* Theorem: FINITE s /\ x IN s ==> x divides (set_lcm s) *) 4301(* Proof: 4302 Note FINITE s /\ x IN s 4303 ==> MEM x (SET_TO_LIST s) by MEM_SET_TO_LIST 4304 ==> x divides list_lcm (SET_TO_LIST s) by list_lcm_is_common_multiple 4305 or x divides (set_lcm s) by set_lcm_def 4306*) 4307val set_lcm_is_common_multiple = store_thm( 4308 "set_lcm_is_common_multiple", 4309 ``!x s. FINITE s /\ x IN s ==> x divides (set_lcm s)``, 4310 rw[set_lcm_def] >> 4311 `MEM x (SET_TO_LIST s)` by rw[MEM_SET_TO_LIST] >> 4312 rw[list_lcm_is_common_multiple]); 4313 4314(* Theorem: FINITE s /\ (!x. x IN s ==> x divides m) ==> set_lcm s divides m *) 4315(* Proof: 4316 Note FINITE s 4317 ==> !x. x IN s <=> MEM x (SET_TO_LIST s) by MEM_SET_TO_LIST 4318 Thus list_lcm (SET_TO_LIST s) divides m by list_lcm_is_least_common_multiple 4319 or set_lcm s divides m by set_lcm_def 4320*) 4321val set_lcm_is_least_common_multiple = store_thm( 4322 "set_lcm_is_least_common_multiple", 4323 ``!s m. FINITE s /\ (!x. x IN s ==> x divides m) ==> set_lcm s divides m``, 4324 metis_tac[set_lcm_def, MEM_SET_TO_LIST, list_lcm_is_least_common_multiple]); 4325 4326(* Theorem: FINITE s /\ PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s) *) 4327(* Proof: 4328 By finite induction on s. 4329 Base: set_lcm {} = PROD_SET {} 4330 set_lcm {} 4331 = 1 by set_lcm_empty 4332 = PROD_SET {} by PROD_SET_EMPTY 4333 Step: PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s) ==> 4334 e NOTIN s /\ PAIRWISE_COPRIME (e INSERT s) ==> set_lcm (e INSERT s) = PROD_SET (e INSERT s) 4335 Note !z. z IN s ==> coprime e z by IN_INSERT 4336 Thus coprime e (PROD_SET s) by every_coprime_prod_set_coprime 4337 set_lcm (e INSERT s) 4338 = lcm e (set_lcm s) by set_lcm_insert 4339 = lcm e (PROD_SET s) by induction hypothesis 4340 = e * (PROD_SET s) by LCM_COPRIME 4341 = PROD_SET (e INSERT s) by PROD_SET_INSERT, e NOTIN s 4342*) 4343val pairwise_coprime_prod_set_eq_set_lcm = store_thm( 4344 "pairwise_coprime_prod_set_eq_set_lcm", 4345 ``!s. FINITE s /\ PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s)``, 4346 `!s. FINITE s ==> PAIRWISE_COPRIME s ==> (set_lcm s = PROD_SET s)` suffices_by rw[] >> 4347 Induct_on `FINITE` >> 4348 rpt strip_tac >- 4349 rw[set_lcm_empty, PROD_SET_EMPTY] >> 4350 fs[] >> 4351 `!z. z IN s ==> coprime e z` by metis_tac[] >> 4352 `coprime e (PROD_SET s)` by rw[every_coprime_prod_set_coprime] >> 4353 `set_lcm (e INSERT s) = lcm e (set_lcm s)` by rw[set_lcm_insert] >> 4354 `_ = lcm e (PROD_SET s)` by rw[] >> 4355 `_ = e * (PROD_SET s)` by rw[LCM_COPRIME] >> 4356 `_ = PROD_SET (e INSERT s)` by rw[PROD_SET_INSERT] >> 4357 rw[]); 4358 4359(* This is a generalisation of LCM_COPRIME |- !m n. coprime m n ==> (lcm m n = m * n) *) 4360 4361(* Theorem: FINITE s /\ PAIRWISE_COPRIME s /\ (!x. x IN s ==> x divides m) ==> (PROD_SET s) divides m *) 4362(* Proof: 4363 Note PROD_SET s = set_lcm s by pairwise_coprime_prod_set_eq_set_lcm 4364 and set_lcm s divides m by set_lcm_is_least_common_multiple 4365 ==> (PROD_SET s) divides m 4366*) 4367val pairwise_coprime_prod_set_divides = store_thm( 4368 "pairwise_coprime_prod_set_divides", 4369 ``!s m. FINITE s /\ PAIRWISE_COPRIME s /\ (!x. x IN s ==> x divides m) ==> (PROD_SET s) divides m``, 4370 rw[set_lcm_is_least_common_multiple, GSYM pairwise_coprime_prod_set_eq_set_lcm]); 4371 4372(* ------------------------------------------------------------------------- *) 4373(* Nair's Trick - using List LCM directly *) 4374(* ------------------------------------------------------------------------- *) 4375 4376(* Overload on consecutive LCM *) 4377val _ = overload_on("lcm_run", ``\n. list_lcm [1 .. n]``); 4378 4379(* Theorem: lcm_run n = FOLDL lcm 1 [1 .. n] *) 4380(* Proof: 4381 lcm_run n 4382 = list_lcm [1 .. n] by notation 4383 = FOLDL lcm 1 [1 .. n] by list_lcm_by_FOLDL 4384*) 4385val lcm_run_by_FOLDL = store_thm( 4386 "lcm_run_by_FOLDL", 4387 ``!n. lcm_run n = FOLDL lcm 1 [1 .. n]``, 4388 rw[list_lcm_by_FOLDL]); 4389 4390(* Theorem: lcm_run n = FOLDL lcm 1 [1 .. n] *) 4391(* Proof: 4392 lcm_run n 4393 = list_lcm [1 .. n] by notation 4394 = FOLDR lcm 1 [1 .. n] by list_lcm_by_FOLDR 4395*) 4396val lcm_run_by_FOLDR = store_thm( 4397 "lcm_run_by_FOLDR", 4398 ``!n. lcm_run n = FOLDR lcm 1 [1 .. n]``, 4399 rw[list_lcm_by_FOLDR]); 4400 4401(* Theorem: lcm_run 0 = 1 *) 4402(* Proof: 4403 lcm_run 0 4404 = list_lcm [1 .. 0] by notation 4405 = list_lcm [] by listRangeINC_EMPTY, 0 < 1 4406 = 1 by list_lcm_nil 4407*) 4408val lcm_run_0 = store_thm( 4409 "lcm_run_0", 4410 ``lcm_run 0 = 1``, 4411 rw[listRangeINC_EMPTY]); 4412 4413(* Theorem: lcm_run 1 = 1 *) 4414(* Proof: 4415 lcm_run 1 4416 = list_lcm [1 .. 1] by notation 4417 = list_lcm [1] by leibniz_vertical_0 4418 = 1 by list_lcm_sing 4419*) 4420val lcm_run_1 = store_thm( 4421 "lcm_run_1", 4422 ``lcm_run 1 = 1``, 4423 rw[leibniz_vertical_0, list_lcm_sing]); 4424 4425(* Theorem alias *) 4426val lcm_run_suc = save_thm("lcm_run_suc", list_lcm_suc); 4427(* val lcm_run_suc = |- !n. lcm_run (n + 1) = lcm (n + 1) (lcm_run n): thm *) 4428 4429(* Theorem: 0 < lcm_run n *) 4430(* Proof: 4431 Note EVERY_POSITIVE [1 .. n] by listRangeINC_EVERY 4432 so lcm_run n 4433 = list_lcm [1 .. n] by notation 4434 > 0 by list_lcm_pos 4435*) 4436val lcm_run_pos = store_thm( 4437 "lcm_run_pos", 4438 ``!n. 0 < lcm_run n``, 4439 rw[list_lcm_pos, listRangeINC_EVERY]); 4440 4441(* Theorem: (lcm_run 2 = 2) /\ (lcm_run 3 = 6) /\ (lcm_run 4 = 12) /\ (lcm_run 5 = 60) /\ ... *) 4442(* Proof: by evaluation *) 4443val lcm_run_small = store_thm( 4444 "lcm_run_small", 4445 ``(lcm_run 2 = 2) /\ (lcm_run 3 = 6) /\ (lcm_run 4 = 12) /\ (lcm_run 5 = 60) /\ 4446 (lcm_run 6 = 60) /\ (lcm_run 7 = 420) /\ (lcm_run 8 = 840) /\ (lcm_run 9 = 2520)``, 4447 EVAL_TAC); 4448 4449(* Theorem: (n + 1) divides lcm_run (n + 1) /\ (lcm_run n) divides lcm_run (n + 1) *) 4450(* Proof: 4451 If n = 0, 4452 Then 0 + 1 = 1 by arithmetic 4453 and lcm_run 0 = 1 by lcm_run_0 4454 Hence true by ONE_DIVIDES_ALL 4455 If n <> 0, 4456 Then n - 1 + 1 = n by arithmetic, 0 < n 4457 lcm_run (n + 1) 4458 = list_lcm [1 .. (n + 1)] by notation 4459 = list_lcm (SNOC (n + 1) [1 .. n]) by leibniz_vertical_snoc 4460 = lcm (n + 1) (list_lcm [1 .. n]) by list_lcm_snoc] 4461 = lcm (n + 1) (lcm_run n) by notation 4462 Hence true by LCM_DIVISORS 4463*) 4464val lcm_run_divisors = store_thm( 4465 "lcm_run_divisors", 4466 ``!n. (n + 1) divides lcm_run (n + 1) /\ (lcm_run n) divides lcm_run (n + 1)``, 4467 strip_tac >> 4468 Cases_on `n = 0` >- 4469 rw[lcm_run_0] >> 4470 `(n - 1 + 1 = n) /\ (n - 1 + 2 = n + 1)` by decide_tac >> 4471 `lcm_run (n + 1) = list_lcm (SNOC (n + 1) [1 .. n])` by metis_tac[leibniz_vertical_snoc] >> 4472 `_ = lcm (n + 1) (lcm_run n)` by rw[list_lcm_snoc] >> 4473 rw[LCM_DIVISORS]); 4474 4475(* Theorem: lcm_run n <= lcm_run (n + 1) *) 4476(* Proof: 4477 Note 0 < lcm_run n by lcm_run_pos 4478 lcm_run (n + 1) 4479 = list_lcm [1 .. (n + 1)] by notation 4480 = list_lcm (SNOC (n + 1) [1 .. n]) by listRangeINC_SNOC, 1 <= n + 1 4481 = lcm (n + 1) (lcm_run n) by list_lcm_snoc 4482 >= lcm_run n by LCM_LE, 0 < n + 1 4483*) 4484val lcm_run_monotone = store_thm( 4485 "lcm_run_monotone", 4486 ``!n. lcm_run n <= lcm_run (n + 1)``, 4487 rw[lcm_run_pos, listRangeINC_SNOC, list_lcm_snoc, LCM_LE]); 4488 4489(* Another proof of same theorem *) 4490 4491(* Theorem: lcm_run n <= lcm_run (n + 1) *) 4492(* Proof: 4493 Note lcm_run n divides lcm_run (n + 1) by lcm_run_divisors 4494 and 0 < lcm_run (n + 1) ] by lcm_run_pos 4495 so lcm_run n <= lcm_run (n + 1) by DIVIDES_LE 4496*) 4497val lcm_run_monotone = store_thm( 4498 "lcm_run_monotone", 4499 ``!n. lcm_run n <= lcm_run (n + 1)``, 4500 rw[lcm_run_divisors, lcm_run_pos, DIVIDES_LE]); 4501 4502(* Theorem: 2 ** n <= lcm_run (n + 1) *) 4503(* Proof: 4504 lcm_run (n + 1) 4505 = list_lcm [1 .. (n + 1)] by notation 4506 >= 2 ** n by lcm_lower_bound 4507*) 4508val lcm_run_lower = save_thm("lcm_run_lower", lcm_lower_bound); 4509(* 4510val lcm_run_lower = |- !n. 2 ** n <= lcm_run (n + 1): thm 4511*) 4512 4513(* Theorem: !n k. k <= n ==> leibniz n k divides lcm_run (n + 1) *) 4514(* Proof: by notation, leibniz_vertical_divisor *) 4515val lcm_run_leibniz_divisor = save_thm("lcm_run_leibniz_divisor", leibniz_vertical_divisor); 4516(* 4517val lcm_run_leibniz_divisor = |- !n k. k <= n ==> leibniz n k divides lcm_run (n + 1): thm 4518*) 4519 4520(* Theorem: n * 4 ** n <= lcm_run (2 * n + 1) *) 4521(* Proof: 4522 If n = 0, LHS = 0, trivially true. 4523 If n <> 0, 0 < n. 4524 Let m = 2 * n. 4525 4526 Claim: (m + 1) * binomial m n divides lcm_run (m + 1) [1] 4527 Proof: Note n <= m by LESS_MONO_MULT, 1 <= 2 4528 ==> (leibniz m n) divides lcm_run (m + 1) by lcm_run_leibniz_divisor, n <= m 4529 or (m + 1) * binomial m n divides lcm_run (m + 1) by leibniz_def 4530 4531 Claim: n * binomial m n divides lcm_run (m + 1) [2] 4532 Proof: Note 0 < m /\ n <= m - 1 by 0 < n 4533 and m - 1 + 1 = m by 0 < m 4534 Thus (leibniz (m - 1) n) divides lcm_run m by lcm_run_leibniz_divisor, n <= m - 1 4535 Note (lcm_run m) divides lcm_run (m + 1) by lcm_run_divisors 4536 so (leibniz (m - 1) n) divides lcm_run (m + 1) by DIVIDES_TRANS 4537 and leibniz (m - 1) n 4538 = (m - n) * binomial m n by leibniz_up_alt 4539 = n * binomial m n by m - n = n 4540 4541 Note coprime n (m + 1) by GCD_EUCLID, GCD_1, 1 < n 4542 Thus lcm (n * binomial m n) ((m + 1) * binomial m n) 4543 = n * (m + 1) * binomial m n by LCM_COMMON_COPRIME 4544 = n * ((m + 1) * binomial m n) by MULT_ASSOC 4545 = n * leibniz m n by leibniz_def 4546 ==> n * leibniz m n divides lcm_run (m + 1) by LCM_DIVIDES, [1], [2] 4547 Note 0 < lcm_run (m + 1) by lcm_run_pos 4548 or n * leibniz m n <= lcm_run (m + 1) by DIVIDES_LE, 0 < lcm_run (m + 1) 4549 Now 4 ** n <= leibniz m n by leibniz_middle_lower 4550 so n * 4 ** n <= n * leibniz m n by LESS_MONO_MULT, MULT_COMM 4551 or n * 4 ** n <= lcm_run (m + 1) by LESS_EQ_TRANS 4552*) 4553val lcm_run_lower_odd = store_thm( 4554 "lcm_run_lower_odd", 4555 ``!n. n * 4 ** n <= lcm_run (2 * n + 1)``, 4556 rpt strip_tac >> 4557 Cases_on `n = 0` >- 4558 rw[] >> 4559 `0 < n` by decide_tac >> 4560 qabbrev_tac `m = 2 * n` >> 4561 `(m + 1) * binomial m n divides lcm_run (m + 1)` by 4562 (`n <= m` by rw[Abbr`m`] >> 4563 metis_tac[lcm_run_leibniz_divisor, leibniz_def]) >> 4564 `n * binomial m n divides lcm_run (m + 1)` by 4565 (`0 < m /\ n <= m - 1` by rw[Abbr`m`] >> 4566 `m - 1 + 1 = m` by decide_tac >> 4567 `(leibniz (m - 1) n) divides lcm_run m` by metis_tac[lcm_run_leibniz_divisor] >> 4568 `(lcm_run m) divides lcm_run (m + 1)` by rw[lcm_run_divisors] >> 4569 `leibniz (m - 1) n = (m - n) * binomial m n` by rw[leibniz_up_alt] >> 4570 `_ = n * binomial m n` by rw[Abbr`m`] >> 4571 metis_tac[DIVIDES_TRANS]) >> 4572 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >> 4573 `lcm (n * binomial m n) ((m + 1) * binomial m n) = n * (m + 1) * binomial m n` by rw[LCM_COMMON_COPRIME] >> 4574 `_ = n * leibniz m n` by rw[leibniz_def, MULT_ASSOC] >> 4575 `n * leibniz m n divides lcm_run (m + 1)` by metis_tac[LCM_DIVIDES] >> 4576 `n * leibniz m n <= lcm_run (m + 1)` by rw[DIVIDES_LE, lcm_run_pos] >> 4577 `4 ** n <= leibniz m n` by rw[leibniz_middle_lower, Abbr`m`] >> 4578 metis_tac[LESS_MONO_MULT, MULT_COMM, LESS_EQ_TRANS]); 4579 4580(* Theorem: n * 4 ** n <= lcm_run (2 * (n + 1)) *) 4581(* Proof: 4582 lcm_run (2 * (n + 1)) 4583 = lcm_run (2 * n + 2) by arithmetic 4584 >= lcm_run (2 * n + 1) by lcm_run_monotone 4585 >= n * 4 ** n by lcm_run_lower_odd 4586*) 4587val lcm_run_lower_even = store_thm( 4588 "lcm_run_lower_even", 4589 ``!n. n * 4 ** n <= lcm_run (2 * (n + 1))``, 4590 rpt strip_tac >> 4591 `2 * (n + 1) = 2 * n + 1 + 1` by decide_tac >> 4592 metis_tac[lcm_run_monotone, lcm_run_lower_odd, LESS_EQ_TRANS]); 4593 4594(* Theorem: 7 <= n ==> 2 ** n <= lcm_run n *) 4595(* Proof: 4596 If ODD n, ?k. n = SUC (2 * k) by ODD_EXISTS, 4597 When 5 <= 7 <= n = 2 * k + 1 by ADD1 4598 2 <= k by arithmetic 4599 and lcm_run n 4600 = lcm_run (2 * k + 1) by notation 4601 >= k * 4 ** k by lcm_run_lower_odd 4602 >= 2 * 4 ** k by k >= 2, LESS_MONO_MULT 4603 = 2 * 2 ** (2 * k) by EXP_EXP_MULT 4604 = 2 ** SUC (2 * k) by EXP 4605 = 2 ** n by n = SUC (2 * k) 4606 If EVEN n, ?m. n = 2 * m by EVEN_EXISTS 4607 Note ODD 7 /\ ODD 9 by arithmetic 4608 If n = 8, 4609 LHS = 2 ** 8 = 256, 4610 RHS = lcm_run 8 = 840 by lcm_run_small 4611 Hence true. 4612 Otherwise, 10 <= n by 7 <= n, n <> 7, n <> 8, n <> 9 4613 Since 0 < n, 0 < m by MULT_EQ_0 4614 so ?k. m = SUC k by num_CASES 4615 When 10 <= n = 2 * (k + 1) by ADD1 4616 4 <= k by arithmetic 4617 and lcm_run n 4618 = lcm_run (2 * (k + 1)) by notation 4619 >= k * 4 ** k by lcm_run_lower_even 4620 >= 4 * 4 ** k by k >= 4, LESS_MONO_MULT 4621 = 4 ** SUC k by EXP 4622 = 4 ** m by notation 4623 = 2 ** (2 * m) by EXP_EXP_MULT 4624 = 2 ** n by n = 2 * m 4625*) 4626val lcm_run_lower_better = store_thm( 4627 "lcm_run_lower_better", 4628 ``!n. 7 <= n ==> 2 ** n <= lcm_run n``, 4629 rpt strip_tac >> 4630 Cases_on `ODD n` >| [ 4631 `?k. n = SUC (2 * k)` by rw[GSYM ODD_EXISTS] >> 4632 `2 <= k` by decide_tac >> 4633 `2 * 4 ** k <= k * 4 ** k` by rw[LESS_MONO_MULT] >> 4634 `lcm_run n = lcm_run (2 * k + 1)` by rw[ADD1] >> 4635 `2 ** n = 2 * 2 ** (2 * k)` by rw[EXP] >> 4636 `_ = 2 * 4 ** k` by rw[EXP_EXP_MULT] >> 4637 metis_tac[lcm_run_lower_odd, LESS_EQ_TRANS], 4638 `ODD 7 /\ ODD 9` by rw[] >> 4639 `EVEN n /\ n <> 7 /\ n <> 9` by metis_tac[ODD_EVEN] >> 4640 `?m. n = 2 * m` by rw[GSYM EVEN_EXISTS] >> 4641 `m <> 0` by decide_tac >> 4642 `?k. m = SUC k` by metis_tac[num_CASES] >> 4643 Cases_on `n = 8` >- 4644 rw[lcm_run_small] >> 4645 `4 <= k` by decide_tac >> 4646 `4 * 4 ** k <= k * 4 ** k` by rw[LESS_MONO_MULT] >> 4647 `lcm_run n = lcm_run (2 * (k + 1))` by rw[ADD1] >> 4648 `2 ** n = 4 ** m` by rw[EXP_EXP_MULT] >> 4649 `_ = 4 * 4 ** k` by rw[EXP] >> 4650 metis_tac[lcm_run_lower_even, LESS_EQ_TRANS] 4651 ]); 4652 4653(* A very good result, another major theorem. *) 4654 4655(* Theorem: ODD n ==> (HALF n) * HALF (2 ** n) <= lcm_run n *) 4656(* Proof: 4657 Let k = HALF n. 4658 Then n = 2 * k + 1 by ODD_HALF 4659 and HALF (2 ** n) 4660 = HALF (2 ** (2 * k + 1)) by above 4661 = HALF (2 ** (SUC (2 * k))) by ADD1 4662 = HALF (2 * 2 ** (2 * k)) by EXP 4663 = 2 ** (2 * k) by HALF_TWICE 4664 = 4 ** k by EXP_EXP_MULT 4665 Since k * 4 ** k <= lcm_run (2 * k + 1) by lcm_run_lower_odd 4666 The result follows. 4667*) 4668val lcm_run_odd_lower = store_thm( 4669 "lcm_run_odd_lower", 4670 ``!n. ODD n ==> (HALF n) * HALF (2 ** n) <= lcm_run n``, 4671 rpt strip_tac >> 4672 qabbrev_tac `k = HALF n` >> 4673 `n = 2 * k + 1` by rw[ODD_HALF, Abbr`k`] >> 4674 `HALF (2 ** n) = HALF (2 ** (SUC (2 * k)))` by rw[ADD1] >> 4675 `_ = HALF (2 * 2 ** (2 * k))` by rw[EXP] >> 4676 `_ = 2 ** (2 * k)` by rw[HALF_TWICE] >> 4677 `_ = 4 ** k` by rw[EXP_EXP_MULT] >> 4678 metis_tac[lcm_run_lower_odd]); 4679 4680(* Theorem: EVEN n ==> HALF (n - 2) * HALF (HALF (2 ** n)) <= lcm_run n *) 4681(* Proof: 4682 If n = 0, HALF (n - 2) = 0, so trivially true. 4683 If n <> 0, 4684 Let h = HALF n. 4685 Then n = 2 * h by EVEN_HALF 4686 Note h <> 0 by n <> 0 4687 so ?k. h = k + 1 by num_CASES, ADD1 4688 or n = 2 * k + 2 by n = 2 * (k + 1) 4689 and HALF (HALF (2 ** n)) 4690 = HALF (HALF (2 ** (2 * k + 2))) by above 4691 = HALF (HALF (2 ** SUC (SUC (2 * k)))) by ADD1 4692 = HALF (HALF (2 * (2 * 2 ** (2 * k)))) by EXP 4693 = 2 ** (2 * k) by HALF_TWICE 4694 = 4 ** k by EXP_EXP_MULT 4695 Also n - 2 = 2 * k by 0 < n, n = 2 * k + 2 4696 so HALF (n - 2) = k by HALF_TWICE 4697 Since k * 4 ** k <= lcm_run (2 * (k + 1)) by lcm_run_lower_even 4698 The result follows. 4699*) 4700Theorem lcm_run_even_lower: 4701 !n. EVEN n ==> HALF (n - 2) * HALF (HALF (2 ** n)) <= lcm_run n 4702Proof 4703 rpt strip_tac >> 4704 Cases_on `n = 0` >- rw[] >> 4705 qabbrev_tac `h = HALF n` >> 4706 `n = 2 * h` by rw[EVEN_HALF, Abbr`h`] >> 4707 `h <> 0` by rw[Abbr`h`] >> 4708 `?k. h = k + 1` by metis_tac[num_CASES, ADD1] >> 4709 `HALF (HALF (2 ** n)) = HALF (HALF (2 ** SUC (SUC (2 * k))))` by simp[ADD1] >> 4710 `_ = HALF (HALF (2 * (2 * 2 ** (2 * k))))` by rw[EXP] >> 4711 `_ = 2 ** (2 * k)` by rw[HALF_TWICE] >> 4712 `_ = 4 ** k` by rw[EXP_EXP_MULT] >> 4713 `n - 2 = 2 * k` by decide_tac >> 4714 `HALF (n - 2) = k` by rw[HALF_TWICE] >> 4715 metis_tac[lcm_run_lower_even] 4716QED 4717 4718(* Theorem: ODD n /\ 5 <= n ==> 2 ** n <= lcm_run n *) 4719(* Proof: 4720 This follows by lcm_run_odd_lower 4721 if we can show: 2 ** n <= HALF n * HALF (2 ** n) 4722 4723 Note HALF 5 = 2 by arithmetic 4724 and HALF 5 <= HALF n by DIV_LE_MONOTONE, 0 < 2 4725 Also n <> 0 by 5 <= n 4726 so ?m. n = SUC m by num_CASES 4727 HALF n * HALF (2 ** n) 4728 = HALF n * HALF (2 * 2 ** m) by EXP 4729 = HALF n * 2 ** m by HALF_TWICE 4730 >= 2 * 2 ** m by LESS_MONO_MULT 4731 = 2 ** (SUC m) by EXP 4732 = 2 ** n by n = SUC m 4733*) 4734val lcm_run_odd_lower_alt = store_thm( 4735 "lcm_run_odd_lower_alt", 4736 ``!n. ODD n /\ 5 <= n ==> 2 ** n <= lcm_run n``, 4737 rpt strip_tac >> 4738 `2 ** n <= HALF n * HALF (2 ** n)` by 4739 (`HALF 5 = 2` by EVAL_TAC >> 4740 `HALF 5 <= HALF n` by rw[DIV_LE_MONOTONE] >> 4741 `n <> 0` by decide_tac >> 4742 `?m. n = SUC m` by metis_tac[num_CASES] >> 4743 `HALF n * HALF (2 ** n) = HALF n * HALF (2 * 2 ** m)` by rw[EXP] >> 4744 `_ = HALF n * 2 ** m` by rw[HALF_TWICE] >> 4745 `2 * 2 ** m <= HALF n * 2 ** m` by rw[LESS_MONO_MULT] >> 4746 rw[EXP]) >> 4747 metis_tac[lcm_run_odd_lower, LESS_EQ_TRANS]); 4748 4749(* Theorem: EVEN n /\ 8 <= n ==> 2 ** n <= lcm_run n *) 4750(* Proof: 4751 If n = 8, 4752 Then 2 ** 8 = 256 by arithmetic 4753 and lcm_run 8 = 840 by lcm_run_small 4754 Thus true. 4755 If n <> 8, 4756 Note ODD 9 by arithmetic 4757 so n <> 9 by ODD_EVEN 4758 or 10 <= n by 8 <= n, n <> 9 4759 This follows by lcm_run_even_lower 4760 if we can show: 2 ** n <= HALF (n - 2) * HALF (HALF (2 ** n)) 4761 4762 Let m = n - 2. 4763 Then 8 <= m by arithmetic 4764 or HALF 8 <= HALF m by DIV_LE_MONOTONE, 0 < 2 4765 and HALF 8 = 4 = 2 * 2 by arithmetic 4766 Now n = SUC (SUC m) by arithmetic 4767 HALF m * HALF (HALF (2 ** n)) 4768 = HALF m * HALF (HALF (2 ** (SUC (SUC m)))) by above 4769 = HALF m * HALF (HALF (2 * (2 * 2 ** m))) by EXP 4770 = HALF m * 2 ** m by HALF_TWICE 4771 >= 4 * 2 ** m by LESS_MONO_MULT 4772 = 2 * (2 * 2 ** m) by MULT_ASSOC 4773 = 2 ** (SUC (SUC m)) by EXP 4774 = 2 ** n by n = SUC (SUC m) 4775*) 4776val lcm_run_even_lower_alt = store_thm( 4777 "lcm_run_even_lower_alt", 4778 ``!n. EVEN n /\ 8 <= n ==> 2 ** n <= lcm_run n``, 4779 rpt strip_tac >> 4780 Cases_on `n = 8` >- 4781 rw[lcm_run_small] >> 4782 `2 ** n <= HALF (n - 2) * HALF (HALF (2 ** n))` by 4783 (`ODD 9` by rw[] >> 4784 `n <> 9` by metis_tac[ODD_EVEN] >> 4785 `8 <= n - 2` by decide_tac >> 4786 qabbrev_tac `m = n - 2` >> 4787 `n = SUC (SUC m)` by rw[Abbr`m`] >> 4788 `HALF m * HALF (HALF (2 ** n)) = HALF m * HALF (HALF (2 * (2 * 2 ** m)))` by rw[EXP] >> 4789 `_ = HALF m * 2 ** m` by rw[HALF_TWICE] >> 4790 `HALF 8 <= HALF m` by rw[DIV_LE_MONOTONE] >> 4791 `HALF 8 = 4` by EVAL_TAC >> 4792 `2 * (2 * 2 ** m) <= HALF m * 2 ** m` by rw[LESS_MONO_MULT] >> 4793 rw[EXP]) >> 4794 metis_tac[lcm_run_even_lower, LESS_EQ_TRANS]); 4795 4796(* Theorem: 7 <= n ==> 2 ** n <= lcm_run n *) 4797(* Proof: 4798 If EVEN n, 4799 Node ODD 7 by arithmetic 4800 so n <> 7 by EVEN_ODD 4801 or 8 <= n by arithmetic 4802 Hence true by lcm_run_even_lower_alt 4803 If ~EVEN n, then ODD n by EVEN_ODD 4804 Note 7 <= n ==> 5 <= n by arithmetic 4805 Hence true by lcm_run_odd_lower_alt 4806*) 4807val lcm_run_lower_better = store_thm( 4808 "lcm_run_lower_better", 4809 ``!n. 7 <= n ==> 2 ** n <= lcm_run n``, 4810 rpt strip_tac >> 4811 `EVEN n \/ ODD n` by rw[EVEN_OR_ODD] >| [ 4812 `ODD 7` by rw[] >> 4813 `n <> 7` by metis_tac[ODD_EVEN] >> 4814 rw[lcm_run_even_lower_alt], 4815 rw[lcm_run_odd_lower_alt] 4816 ]); 4817 4818(* Another way to prove this result of Nair. *) 4819 4820(* ------------------------------------------------------------------------- *) 4821(* Nair's Trick -- rework *) 4822(* ------------------------------------------------------------------------- *) 4823 4824(* 4825Picture: 4826leibniz_lcm_property |- !n. lcm_run (n + 1) = list_lcm (leibniz_horizontal n) 4827leibniz_horizontal_mem |- !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n) 4828so: 4829lcm_run (2*n + 1) = list_lcm (leibniz_horizontal (2*n)) 4830and leibniz_horizontal (2*n) has members: 0, 1, 2, ...., n, (n + 1), ....., (2*n) 4831note: n <= 2*n, always, (n+1) <= 2*n = (n+n) when 1 <= n. 4832thus: 4833Both B = (leibniz 2*n n) and C = (leibniz 2*n n+1) divides lcm_run (2*n + 1), 4834 or (lcm B C) divides lcm_run (2*n + 1). 4835But (lcm B C) = (lcm B A) where A = (leibniz 2*n-1 n). 4836By leibniz_def |- !n k. leibniz n k = (n + 1) * binomial n k 4837By leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k 4838 so B = (2*n + 1) * binomial 2*n n 4839and A = (2*n - n) * binomial 2*n n = n * binomial 2*n n 4840and lcm B A = lcm ((2*n + 1) * binomial 2*n n) (n * binomial 2*n n) 4841 = (lcm (2*n + 1) n) * binomial 2*n n by LCM_COMMON_FACTOR 4842 = n * (2*n + 1) * binomial 2*n n by coprime (2*n+1) n 4843 = n * (leibniz 2*n n) by leibniz_def 4844*) 4845 4846(* Theorem: 0 < n ==> n * (leibniz (2 * n) n) divides lcm_run (2 * n + 1) *) 4847(* Proof: 4848 Note 1 <= n by 0 < n 4849 Let m = 2 * n, 4850 Then n <= 2 * n = m, and 4851 n + 1 <= n + n = m by arithmetic 4852 Also coprime n (m + 1) by GCD_EUCLID 4853 4854 Identify a triplet: 4855 Let t = triplet (m - 1) n 4856 Then t.a = leibniz (m - 1) n by triplet_def 4857 t.b = leibniz m n by triplet_def 4858 t.c = leibniz m (n + 1) by triplet_def 4859 4860 Note MEM t.b (leibniz_horizontal m) by leibniz_horizontal_mem, n <= m 4861 and MEM t.c (leibniz_horizontal m) by leibniz_horizontal_mem, n + 1 <= m 4862 ==> lcm t.b t.c divides list_lcm (leibniz_horizontal m) by list_lcm_divisor_lcm_pair 4863 = lcm_run (m + 1) by leibniz_lcm_property 4864 4865 Let k = binomial m n. 4866 lcm t.b t.c 4867 = lcm t.b t.a by leibniz_triplet_lcm 4868 = lcm ((m + 1) * k) t.a by leibniz_def 4869 = lcm ((m + 1) * k) ((m - n) * k) by leibniz_up_alt 4870 = lcm ((m + 1) * k) (n * k) by m = 2 * n 4871 = n * (m + 1) * k by LCM_COMMON_COPRIME, LCM_SYM, coprime n (m + 1) 4872 = n * leibniz m n by leibniz_def 4873 Thus (n * leibniz m n) divides lcm_run (m + 1) 4874*) 4875val lcm_run_odd_factor = store_thm( 4876 "lcm_run_odd_factor", 4877 ``!n. 0 < n ==> n * (leibniz (2 * n) n) divides lcm_run (2 * n + 1)``, 4878 rpt strip_tac >> 4879 qabbrev_tac `m = 2 * n` >> 4880 `n <= m /\ n + 1 <= m` by rw[Abbr`m`] >> 4881 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >> 4882 qabbrev_tac `t = triplet (m - 1) n` >> 4883 `t.a = leibniz (m - 1) n` by rw[triplet_def, Abbr`t`] >> 4884 `t.b = leibniz m n` by rw[triplet_def, Abbr`t`] >> 4885 `t.c = leibniz m (n + 1)` by rw[triplet_def, Abbr`t`] >> 4886 `t.b divides lcm_run (m + 1)` by metis_tac[lcm_run_leibniz_divisor] >> 4887 `t.c divides lcm_run (m + 1)` by metis_tac[lcm_run_leibniz_divisor] >> 4888 `lcm t.b t.c divides lcm_run (m + 1)` by rw[LCM_IS_LEAST_COMMON_MULTIPLE] >> 4889 qabbrev_tac `k = binomial m n` >> 4890 `lcm t.b t.c = lcm t.b t.a` by rw[leibniz_triplet_lcm, Abbr`t`] >> 4891 `_ = lcm ((m + 1) * k) ((m - n) * k)` by rw[leibniz_def, leibniz_up_alt, Abbr`k`] >> 4892 `_ = lcm ((m + 1) * k) (n * k)` by rw[Abbr`m`] >> 4893 `_ = n * (m + 1) * k` by rw[LCM_COMMON_COPRIME, LCM_SYM] >> 4894 `_ = n * leibniz m n` by rw[leibniz_def, Abbr`k`] >> 4895 metis_tac[]); 4896 4897(* Theorem: n * 4 ** n <= lcm_run (2 * n + 1) *) 4898(* Proof: 4899 If n = 0, LHS = 0, trivially true. 4900 If n <> 0, 0 < n. 4901 Note 4 ** n <= leibniz (2 * n) n by leibniz_middle_lower 4902 so n * 4 ** n <= n * leibniz (2 * n) n by LESS_MONO_MULT, MULT_COMM 4903 Let k = n * leibniz (2 * n) n. 4904 Then k divides lcm_run (2 * n + 1) by lcm_run_odd_factor 4905 Now 0 < lcm_run (2 * n + 1) by lcm_run_pos 4906 so k <= lcm_run (2 * n + 1) by DIVIDES_LE 4907 Overall n * 4 ** n <= lcm_run (2 * n + 1) by LESS_EQ_TRANS 4908*) 4909val lcm_run_lower_odd = store_thm( 4910 "lcm_run_lower_odd", 4911 ``!n. n * 4 ** n <= lcm_run (2 * n + 1)``, 4912 rpt strip_tac >> 4913 Cases_on `n = 0` >- 4914 rw[] >> 4915 `0 < n` by decide_tac >> 4916 `4 ** n <= leibniz (2 * n) n` by rw[leibniz_middle_lower] >> 4917 `n * 4 ** n <= n * leibniz (2 * n) n` by rw[LESS_MONO_MULT, MULT_COMM] >> 4918 `n * leibniz (2 * n) n <= lcm_run (2 * n + 1)` by rw[lcm_run_odd_factor, lcm_run_pos, DIVIDES_LE] >> 4919 rw[LESS_EQ_TRANS]); 4920 4921(* Another direct proof of the same theorem *) 4922 4923(* Theorem: n * 4 ** n <= lcm_run (2 * n + 1) *) 4924(* Proof: 4925 If n = 0, LHS = 0, trivially true. 4926 If n <> 0, 0 < n, or 1 <= n by arithmetic 4927 4928 Let m = 2 * n, 4929 Then n <= 2 * n = m, and 4930 n + 1 <= n + n = m by arithmetic, 1 <= n 4931 Also coprime n (m + 1) by GCD_EUCLID 4932 4933 Identify a triplet: 4934 Let t = triplet (m - 1) n 4935 Then t.a = leibniz (m - 1) n by triplet_def 4936 t.b = leibniz m n by triplet_def 4937 t.c = leibniz m (n + 1) by triplet_def 4938 4939 Note MEM t.b (leibniz_horizontal m) by leibniz_horizontal_mem, n <= m 4940 and MEM t.c (leibniz_horizontal m) by leibniz_horizontal_mem, n + 1 <= m 4941 and POSITIVE (leibniz_horizontal m) by leibniz_horizontal_pos_alt 4942 ==> lcm t.b t.c <= list_lcm (leibniz_horizontal m) by list_lcm_lower_by_lcm_pair 4943 = lcm_run (m + 1) by leibniz_lcm_property 4944 4945 Let k = binomial m n. 4946 lcm t.b t.c 4947 = lcm t.b t.a by leibniz_triplet_lcm 4948 = lcm ((m + 1) * k) t.a by leibniz_def 4949 = lcm ((m + 1) * k) ((m - n) * k) by leibniz_up_alt 4950 = lcm ((m + 1) * k) (n * k) by m = 2 * n 4951 = n * (m + 1) * k by LCM_COMMON_COPRIME, LCM_SYM, coprime n (m + 1) 4952 = n * leibniz m n by leibniz_def 4953 Thus (n * leibniz m n) divides lcm_run (m + 1) 4954 4955 Note 4 ** n <= leibniz m n by leibniz_middle_lower 4956 so n * 4 ** n <= n * leibniz m n by LESS_MONO_MULT, MULT_COMM 4957 Overall n * 4 ** n <= lcm_run (2 * n + 1) by LESS_EQ_TRANS 4958*) 4959val lcm_run_lower_odd = store_thm( 4960 "lcm_run_lower_odd", 4961 ``!n. n * 4 ** n <= lcm_run (2 * n + 1)``, 4962 rpt strip_tac >> 4963 Cases_on `n = 0` >- 4964 rw[] >> 4965 qabbrev_tac `m = 2 * n` >> 4966 `n <= m /\ n + 1 <= m` by rw[Abbr`m`] >> 4967 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >> 4968 qabbrev_tac `t = triplet (m - 1) n` >> 4969 `t.a = leibniz (m - 1) n` by rw[triplet_def, Abbr`t`] >> 4970 `t.b = leibniz m n` by rw[triplet_def, Abbr`t`] >> 4971 `t.c = leibniz m (n + 1)` by rw[triplet_def, Abbr`t`] >> 4972 `MEM t.b (leibniz_horizontal m)` by metis_tac[leibniz_horizontal_mem] >> 4973 `MEM t.c (leibniz_horizontal m)` by metis_tac[leibniz_horizontal_mem] >> 4974 `POSITIVE (leibniz_horizontal m)` by metis_tac[leibniz_horizontal_pos_alt] >> 4975 `lcm t.b t.c <= lcm_run (m + 1)` by metis_tac[leibniz_lcm_property, list_lcm_lower_by_lcm_pair] >> 4976 `lcm t.b t.c = n * leibniz m n` by 4977 (qabbrev_tac `k = binomial m n` >> 4978 `lcm t.b t.c = lcm t.b t.a` by rw[leibniz_triplet_lcm, Abbr`t`] >> 4979 `_ = lcm ((m + 1) * k) ((m - n) * k)` by rw[leibniz_def, leibniz_up_alt, Abbr`k`] >> 4980 `_ = lcm ((m + 1) * k) (n * k)` by rw[Abbr`m`] >> 4981 `_ = n * (m + 1) * k` by rw[LCM_COMMON_COPRIME, LCM_SYM] >> 4982 `_ = n * leibniz m n` by rw[leibniz_def, Abbr`k`] >> 4983 rw[]) >> 4984 `4 ** n <= leibniz m n` by rw[leibniz_middle_lower, Abbr`m`] >> 4985 `n * 4 ** n <= n * leibniz m n` by rw[LESS_MONO_MULT] >> 4986 metis_tac[LESS_EQ_TRANS]); 4987 4988(* Theorem: ODD n ==> (2 ** n <= lcm_run n <=> 5 <= n) *) 4989(* Proof: 4990 If part: 2 ** n <= lcm_run n ==> 5 <= n 4991 By contradiction, suppose n < 5. 4992 By ODD n, n = 1 or n = 3. 4993 If n = 1, LHS = 2 ** 1 = 2 by arithmetic 4994 RHS = lcm_run 1 = 1 by lcm_run_1 4995 Hence false. 4996 If n = 3, LHS = 2 ** 3 = 8 by arithmetic 4997 RHS = lcm_run 3 = 6 by lcm_run_small 4998 Hence false. 4999 Only-if part: 5 <= n ==> 2 ** n <= lcm_run n 5000 Let h = HALF n. 5001 Then n = 2 * h + 1 by ODD_HALF 5002 so 4 <= 2 * h by 5 - 1 = 4 5003 or 2 <= h by arithmetic 5004 ==> 2 * 4 ** h <= h * 4 ** h by LESS_MONO_MULT 5005 But 2 * 4 ** h 5006 = 2 * (2 ** 2) ** h by arithmetic 5007 = 2 * 2 ** (2 * h) by EXP_EXP_MULT 5008 = 2 ** SUC (2 * h) by EXP 5009 = 2 ** n by ADD1, n = 2 * h + 1 5010 With h * 4 ** h <= lcm_run n by lcm_run_lower_odd 5011 or 2 ** n <= lcm_run n by LESS_EQ_TRANS 5012*) 5013val lcm_run_lower_odd_iff = store_thm( 5014 "lcm_run_lower_odd_iff", 5015 ``!n. ODD n ==> (2 ** n <= lcm_run n <=> 5 <= n)``, 5016 rw[EQ_IMP_THM] >| [ 5017 spose_not_then strip_assume_tac >> 5018 `n < 5` by decide_tac >> 5019 `EVEN 0 /\ EVEN 2 /\ EVEN 4` by rw[] >> 5020 `n <> 0 /\ n <> 2 /\ n <> 4` by metis_tac[EVEN_ODD] >> 5021 `(n = 1) \/ (n = 3)` by decide_tac >- 5022 fs[] >> 5023 fs[lcm_run_small], 5024 qabbrev_tac `h = HALF n` >> 5025 `n = 2 * h + 1` by rw[ODD_HALF, Abbr`h`] >> 5026 `2 * 4 ** h <= h * 4 ** h` by rw[] >> 5027 `2 * 4 ** h = 2 * 2 ** (2 * h)` by rw[EXP_EXP_MULT] >> 5028 `_ = 2 ** n` by rw[GSYM EXP] >> 5029 `h * 4 ** h <= lcm_run n` by rw[lcm_run_lower_odd] >> 5030 decide_tac 5031 ]); 5032 5033(* Theorem: EVEN n ==> (2 ** n <= lcm_run n <=> (n = 0) \/ 8 <= n) *) 5034(* Proof: 5035 If part: 2 ** n <= lcm_run n ==> (n = 0) \/ 8 <= n 5036 By contradiction, suppose n <> 0 /\ n < 8. 5037 By EVEN n, n = 2 or n = 4 or n = 6. 5038 If n = 2, LHS = 2 ** 2 = 4 by arithmetic 5039 RHS = lcm_run 2 = 2 by lcm_run_small 5040 Hence false. 5041 If n = 4, LHS = 2 ** 4 = 16 by arithmetic 5042 RHS = lcm_run 4 = 12 by lcm_run_small 5043 Hence false. 5044 If n = 6, LHS = 2 ** 6 = 64 by arithmetic 5045 RHS = lcm_run 6 = 60 by lcm_run_small 5046 Hence false. 5047 Only-if part: (n = 0) \/ 8 <= n ==> 2 ** n <= lcm_run n 5048 If n = 0, LHS = 2 ** 0 = 1 by arithmetic 5049 RHS = lcm_run 0 = 1 by lcm_run_0 5050 Hence true. 5051 If n = 8, LHS = 2 ** 8 = 256 by arithmetic 5052 RHS = lcm_run 8 = 840 by lcm_run_small 5053 Hence true. 5054 Otherwise, 10 <= n, since ODD 9. 5055 Let h = HALF n, k = h - 1. 5056 Then n = 2 * h by EVEN_HALF 5057 = 2 * (k + 1) by k = h - 1 5058 = 2 * k + 2 by arithmetic 5059 But lcm_run (2 * k + 1) <= lcm_run (2 * k + 2) by lcm_run_monotone 5060 and k * 4 ** k <= lcm_run (2 * k + 1) by lcm_run_lower_odd 5061 5062 Now 5 <= h by 10 <= h 5063 so 4 <= k by k = h - 1 5064 ==> 4 * 4 ** k <= k * 4 ** k by LESS_MONO_MULT 5065 5066 4 * 4 ** k 5067 = (2 ** 2) * (2 ** 2) ** k by arithmetic 5068 = (2 ** 2) * (2 ** (2 * k)) by EXP_EXP_MULT 5069 = 2 ** (2 * k + 2) by EXP_ADD 5070 = 2 ** n by n = 2 * k + 2 5071 5072 Overall 2 ** n <= lcm_run n by LESS_EQ_TRANS 5073*) 5074val lcm_run_lower_even_iff = store_thm( 5075 "lcm_run_lower_even_iff", 5076 ``!n. EVEN n ==> (2 ** n <= lcm_run n <=> (n = 0) \/ 8 <= n)``, 5077 rw[EQ_IMP_THM] >| [ 5078 spose_not_then strip_assume_tac >> 5079 `n < 8` by decide_tac >> 5080 `ODD 1 /\ ODD 3 /\ ODD 5 /\ ODD 7` by rw[] >> 5081 `n <> 1 /\ n <> 3 /\ n <> 5 /\ n <> 7` by metis_tac[EVEN_ODD] >> 5082 `(n = 2) \/ (n = 4) \/ (n = 6)` by decide_tac >- 5083 fs[lcm_run_small] >- 5084 fs[lcm_run_small] >> 5085 fs[lcm_run_small], 5086 fs[lcm_run_0], 5087 Cases_on `n = 8` >- 5088 rw[lcm_run_small] >> 5089 `ODD 9` by rw[] >> 5090 `n <> 9` by metis_tac[EVEN_ODD] >> 5091 `10 <= n` by decide_tac >> 5092 qabbrev_tac `h = HALF n` >> 5093 `n = 2 * h` by rw[EVEN_HALF, Abbr`h`] >> 5094 qabbrev_tac `k = h - 1` >> 5095 `lcm_run (2 * k + 1) <= lcm_run (2 * k + 1 + 1)` by rw[lcm_run_monotone] >> 5096 `2 * k + 1 + 1 = n` by rw[Abbr`k`] >> 5097 `k * 4 ** k <= lcm_run (2 * k + 1)` by rw[lcm_run_lower_odd] >> 5098 `4 * 4 ** k <= k * 4 ** k` by rw[Abbr`k`] >> 5099 `4 * 4 ** k = 2 ** 2 * 2 ** (2 * k)` by rw[EXP_EXP_MULT] >> 5100 `_ = 2 ** (2 * k + 2)` by rw[GSYM EXP_ADD] >> 5101 `_ = 2 ** n` by rw[] >> 5102 metis_tac[LESS_EQ_TRANS] 5103 ]); 5104 5105(* Theorem: 2 ** n <= lcm_run n <=> (n = 0) \/ (n = 5) \/ 7 <= n *) 5106(* Proof: 5107 If EVEN n, 5108 Then n <> 5, n <> 7, so 8 <= n by arithmetic 5109 Thus true by lcm_run_lower_even_iff 5110 If ~EVEN n, then ODD n by EVEN_ODD 5111 Then n <> 0, n <> 6, so 5 <= n by arithmetic 5112 Thus true by lcm_run_lower_odd_iff 5113*) 5114val lcm_run_lower_better_iff = store_thm( 5115 "lcm_run_lower_better_iff", 5116 ``!n. 2 ** n <= lcm_run n <=> (n = 0) \/ (n = 5) \/ 7 <= n``, 5117 rpt strip_tac >> 5118 Cases_on `EVEN n` >| [ 5119 `ODD 5 /\ ODD 7` by rw[] >> 5120 `n <> 5 /\ n <> 7` by metis_tac[EVEN_ODD] >> 5121 metis_tac[lcm_run_lower_even_iff, DECIDE``8 <= n <=> (7 <= n /\ n <> 7)``], 5122 `EVEN 0 /\ EVEN 6` by rw[] >> 5123 `ODD n /\ n <> 0 /\ n <> 6` by metis_tac[EVEN_ODD] >> 5124 metis_tac[lcm_run_lower_odd_iff, DECIDE``5 <= n <=> (n = 5) \/ (n = 6) \/ (7 <= n)``] 5125 ]); 5126 5127(* This is the ultimate goal! *) 5128 5129(* ------------------------------------------------------------------------- *) 5130(* Nair's Trick - using consecutive LCM *) 5131(* ------------------------------------------------------------------------- *) 5132 5133(* Define the consecutive LCM function *) 5134val lcm_upto_def = Define` 5135 (lcm_upto 0 = 1) /\ 5136 (lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n)) 5137`; 5138 5139(* Extract theorems from definition *) 5140val lcm_upto_0 = save_thm("lcm_upto_0", lcm_upto_def |> CONJUNCT1); 5141(* val lcm_upto_0 = |- lcm_upto 0 = 1: thm *) 5142 5143val lcm_upto_SUC = save_thm("lcm_upto_SUC", lcm_upto_def |> CONJUNCT2); 5144(* val lcm_upto_SUC = |- !n. lcm_upto (SUC n) = lcm (SUC n) (lcm_upto n): thm *) 5145 5146(* Theorem: (lcm_upto 0 = 1) /\ (!n. lcm_upto (n+1) = lcm (n+1) (lcm_upto n)) *) 5147(* Proof: by lcm_upto_def *) 5148val lcm_upto_alt = store_thm( 5149 "lcm_upto_alt", 5150 ``(lcm_upto 0 = 1) /\ (!n. lcm_upto (n+1) = lcm (n+1) (lcm_upto n))``, 5151 metis_tac[lcm_upto_def, ADD1]); 5152 5153(* Theorem: lcm_upto 1 = 1 *) 5154(* Proof: 5155 lcm_upto 1 5156 = lcm_upto (SUC 0) by ONE 5157 = lcm (SUC 0) (lcm_upto 0) by lcm_upto_SUC 5158 = lcm (SUC 0) 1 by lcm_upto_0 5159 = lcm 1 1 by ONE 5160 = 1 by LCM_REF 5161*) 5162val lcm_upto_1 = store_thm( 5163 "lcm_upto_1", 5164 ``lcm_upto 1 = 1``, 5165 metis_tac[lcm_upto_def, LCM_REF, ONE]); 5166 5167(* Theorem: lcm_upto n for small n *) 5168(* Proof: by evaluation. *) 5169val lcm_upto_small = store_thm( 5170 "lcm_upto_small", 5171 ``(lcm_upto 2 = 2) /\ (lcm_upto 3 = 6) /\ (lcm_upto 4 = 12) /\ 5172 (lcm_upto 5 = 60) /\ (lcm_upto 6 = 60) /\ (lcm_upto 7 = 420) /\ 5173 (lcm_upto 8 = 840) /\ (lcm_upto 9 = 2520) /\ (lcm_upto 10 = 2520)``, 5174 EVAL_TAC); 5175 5176(* Theorem: lcm_upto n = list_lcm [1 .. n] *) 5177(* Proof: 5178 By induction on n. 5179 Base: lcm_upto 0 = list_lcm [1 .. 0] 5180 lcm_upto 0 5181 = 1 by lcm_upto_0 5182 = list_lcm [] by list_lcm_nil 5183 = list_lcm [1 .. 0] by listRangeINC_EMPTY 5184 Step: lcm_upto n = list_lcm [1 .. n] ==> lcm_upto (SUC n) = list_lcm [1 .. SUC n] 5185 lcm_upto (SUC n) 5186 = lcm (SUC n) (lcm_upto n) by lcm_upto_SUC 5187 = lcm (SUC n) (list_lcm [1 .. n]) by induction hypothesis 5188 = list_lcm (SNOC (SUC n) [1 .. n]) by list_lcm_snoc 5189 = list_lcm [1 .. (SUC n)] by listRangeINC_SNOC, ADD1, 1 <= n + 1 5190*) 5191val lcm_upto_eq_list_lcm = store_thm( 5192 "lcm_upto_eq_list_lcm", 5193 ``!n. lcm_upto n = list_lcm [1 .. n]``, 5194 Induct >- 5195 rw[lcm_upto_0, list_lcm_nil, listRangeINC_EMPTY] >> 5196 rw[lcm_upto_SUC, list_lcm_snoc, listRangeINC_SNOC, ADD1]); 5197 5198(* Theorem: 2 ** n <= lcm_upto (n + 1) *) 5199(* Proof: 5200 lcm_upto (n + 1) 5201 = list_lcm [1 .. (n + 1)] by lcm_upto_eq_list_lcm 5202 >= 2 ** n by lcm_lower_bound 5203*) 5204val lcm_upto_lower = store_thm( 5205 "lcm_upto_lower", 5206 ``!n. 2 ** n <= lcm_upto (n + 1)``, 5207 rw[lcm_upto_eq_list_lcm, lcm_lower_bound]); 5208 5209(* Theorem: 0 < lcm_upto (n + 1) *) 5210(* Proof: 5211 lcm_upto (n + 1) 5212 >= 2 ** n by lcm_upto_lower 5213 > 0 by EXP_POS, 0 < 2 5214*) 5215val lcm_upto_pos = store_thm( 5216 "lcm_upto_pos", 5217 ``!n. 0 < lcm_upto (n + 1)``, 5218 metis_tac[lcm_upto_lower, EXP_POS, LESS_LESS_EQ_TRANS, DECIDE``0 < 2``]); 5219 5220(* Theorem: (n + 1) divides lcm_upto (n + 1) /\ (lcm_upto n) divides lcm_upto (n + 1) *) 5221(* Proof: 5222 Note lcm_upto (n + 1) = lcm (n + 1) (lcm_upto n) by lcm_upto_alt 5223 so (n + 1) divides lcm_upto (n + 1) 5224 and (lcm_upto n) divides lcm_upto (n + 1) by LCM_DIVISORS 5225*) 5226val lcm_upto_divisors = store_thm( 5227 "lcm_upto_divisors", 5228 ``!n. (n + 1) divides lcm_upto (n + 1) /\ (lcm_upto n) divides lcm_upto (n + 1)``, 5229 rw[lcm_upto_alt, LCM_DIVISORS]); 5230 5231(* Theorem: lcm_upto n <= lcm_upto (n + 1) *) 5232(* Proof: 5233 Note (lcm_upto n) divides lcm_upto (n + 1) by lcm_upto_divisors 5234 and 0 < lcm_upto (n + 1) by lcm_upto_pos 5235 so lcm_upto n <= lcm_upto (n + 1) by DIVIDES_LE 5236*) 5237val lcm_upto_monotone = store_thm( 5238 "lcm_upto_monotone", 5239 ``!n. lcm_upto n <= lcm_upto (n + 1)``, 5240 rw[lcm_upto_divisors, lcm_upto_pos, DIVIDES_LE]); 5241 5242(* Theorem: k <= n ==> (leibniz n k) divides lcm_upto (n + 1) *) 5243(* Proof: 5244 Note (leibniz n k) divides list_lcm (leibniz_vertical n) by leibniz_vertical_divisor 5245 ==> (leibniz n k) divides list_lcm [1 .. (n + 1)] by notation 5246 or (leibniz n k) divides lcm_upto (n + 1) by lcm_upto_eq_list_lcm 5247*) 5248val lcm_upto_leibniz_divisor = store_thm( 5249 "lcm_upto_leibniz_divisor", 5250 ``!n k. k <= n ==> (leibniz n k) divides lcm_upto (n + 1)``, 5251 metis_tac[leibniz_vertical_divisor, lcm_upto_eq_list_lcm]); 5252 5253(* Theorem: n * 4 ** n <= lcm_upto (2 * n + 1) *) 5254(* Proof: 5255 If n = 0, LHS = 0, trivially true. 5256 If n <> 0, 0 < n. 5257 Let m = 2 * n. 5258 5259 Claim: (m + 1) * binomial m n divides lcm_upto (m + 1) [1] 5260 Proof: Note n <= m by LESS_MONO_MULT, 1 <= 2 5261 ==> (leibniz m n) divides lcm_upto (m + 1) by lcm_upto_leibniz_divisor, n <= m 5262 or (m + 1) * binomial m n divides lcm_upto (m + 1) by leibniz_def 5263 5264 Claim: n * binomial m n divides lcm_upto (m + 1) [2] 5265 Proof: Note (lcm_upto m) divides lcm_upto (m + 1) by lcm_upto_divisors 5266 Also 0 < m /\ n <= m - 1 by 0 < n 5267 and m - 1 + 1 = m by 0 < m 5268 Thus (leibniz (m - 1) n) divides lcm_upto m by lcm_upto_leibniz_divisor, n <= m - 1 5269 or (leibniz (m - 1) n) divides lcm_upto (m + 1) by DIVIDES_TRANS 5270 and leibniz (m - 1) n 5271 = (m - n) * binomial m n by leibniz_up_alt 5272 = n * binomial m n by m - n = n 5273 5274 Note coprime n (m + 1) by GCD_EUCLID, GCD_1, 1 < n 5275 Thus lcm (n * binomial m n) ((m + 1) * binomial m n) 5276 = n * (m + 1) * binomial m n by LCM_COMMON_COPRIME 5277 = n * ((m + 1) * binomial m n) by MULT_ASSOC 5278 = n * leibniz m n by leibniz_def 5279 ==> n * leibniz m n divides lcm_upto (m + 1) by LCM_DIVIDES, [1], [2] 5280 Note 0 < lcm_upto (m + 1) by lcm_upto_pos 5281 or n * leibniz m n <= lcm_upto (m + 1) by DIVIDES_LE, 0 < lcm_upto (m + 1) 5282 Now 4 ** n <= leibniz m n by leibniz_middle_lower 5283 so n * 4 ** n <= n * leibniz m n by LESS_MONO_MULT, MULT_COMM 5284 or n * 4 ** n <= lcm_upto (m + 1) by LESS_EQ_TRANS 5285*) 5286val lcm_upto_lower_odd = store_thm( 5287 "lcm_upto_lower_odd", 5288 ``!n. n * 4 ** n <= lcm_upto (2 * n + 1)``, 5289 rpt strip_tac >> 5290 Cases_on `n = 0` >- 5291 rw[] >> 5292 `0 < n` by decide_tac >> 5293 qabbrev_tac `m = 2 * n` >> 5294 `(m + 1) * binomial m n divides lcm_upto (m + 1)` by 5295 (`n <= m` by rw[Abbr`m`] >> 5296 metis_tac[lcm_upto_leibniz_divisor, leibniz_def]) >> 5297 `n * binomial m n divides lcm_upto (m + 1)` by 5298 (`(lcm_upto m) divides lcm_upto (m + 1)` by rw[lcm_upto_divisors] >> 5299 `0 < m /\ n <= m - 1` by rw[Abbr`m`] >> 5300 `m - 1 + 1 = m` by decide_tac >> 5301 `(leibniz (m - 1) n) divides lcm_upto m` by metis_tac[lcm_upto_leibniz_divisor] >> 5302 `(leibniz (m - 1) n) divides lcm_upto (m + 1)` by metis_tac[DIVIDES_TRANS] >> 5303 `leibniz (m - 1) n = (m - n) * binomial m n` by rw[leibniz_up_alt] >> 5304 `_ = n * binomial m n` by rw[Abbr`m`] >> 5305 metis_tac[]) >> 5306 `coprime n (m + 1)` by rw[GCD_EUCLID, Abbr`m`] >> 5307 `lcm (n * binomial m n) ((m + 1) * binomial m n) = n * (m + 1) * binomial m n` by rw[LCM_COMMON_COPRIME] >> 5308 `_ = n * leibniz m n` by rw[leibniz_def, MULT_ASSOC] >> 5309 `n * leibniz m n divides lcm_upto (m + 1)` by metis_tac[LCM_DIVIDES] >> 5310 `n * leibniz m n <= lcm_upto (m + 1)` by rw[DIVIDES_LE, lcm_upto_pos] >> 5311 `4 ** n <= leibniz m n` by rw[leibniz_middle_lower, Abbr`m`] >> 5312 metis_tac[LESS_MONO_MULT, MULT_COMM, LESS_EQ_TRANS]); 5313 5314(* Theorem: n * 4 ** n <= lcm_upto (2 * (n + 1)) *) 5315(* Proof: 5316 lcm_upto (2 * (n + 1)) 5317 = lcm_upto (2 * n + 2) by arithmetic 5318 >= lcm_upto (2 * n + 1) by lcm_upto_monotone 5319 >= n * 4 ** n by lcm_upto_lower_odd 5320*) 5321val lcm_upto_lower_even = store_thm( 5322 "lcm_upto_lower_even", 5323 ``!n. n * 4 ** n <= lcm_upto (2 * (n + 1))``, 5324 rpt strip_tac >> 5325 `2 * (n + 1) = 2 * n + 1 + 1` by decide_tac >> 5326 metis_tac[lcm_upto_monotone, lcm_upto_lower_odd, LESS_EQ_TRANS]); 5327 5328(* Theorem: 7 <= n ==> 2 ** n <= lcm_upto n *) 5329(* Proof: 5330 If ODD n, ?k. n = SUC (2 * k) by ODD_EXISTS, 5331 When 5 <= 7 <= n = 2 * k + 1 by ADD1 5332 2 <= k by arithmetic 5333 and lcm_upto n 5334 = lcm_upto (2 * k + 1) by notation 5335 >= k * 4 ** k by lcm_upto_lower_odd 5336 >= 2 * 4 ** k by k >= 2, LESS_MONO_MULT 5337 = 2 * 2 ** (2 * k) by EXP_EXP_MULT 5338 = 2 ** SUC (2 * k) by EXP 5339 = 2 ** n by n = SUC (2 * k) 5340 If EVEN n, ?m. n = 2 * m by EVEN_EXISTS 5341 Note ODD 7 /\ ODD 9 by arithmetic 5342 If n = 8, 5343 LHS = 2 ** 8 = 256, 5344 RHS = lcm_upto 8 = 840 by lcm_upto_small 5345 Hence true. 5346 Otherwise, 10 <= n by 7 <= n, n <> 7, n <> 8, n <> 9 5347 Since 0 < n, 0 < m by MULT_EQ_0 5348 so ?k. m = SUC k by num_CASES 5349 When 10 <= n = 2 * (k + 1) by ADD1 5350 4 <= k by arithmetic 5351 and lcm_upto n 5352 = lcm_upto (2 * (k + 1)) by notation 5353 >= k * 4 ** k by lcm_upto_lower_even 5354 >= 4 * 4 ** k by k >= 4, LESS_MONO_MULT 5355 = 4 ** SUC k by EXP 5356 = 4 ** m by notation 5357 = 2 ** (2 * m) by EXP_EXP_MULT 5358 = 2 ** n by n = 2 * m 5359*) 5360val lcm_upto_lower_better = store_thm( 5361 "lcm_upto_lower_better", 5362 ``!n. 7 <= n ==> 2 ** n <= lcm_upto n``, 5363 rpt strip_tac >> 5364 Cases_on `ODD n` >| [ 5365 `?k. n = SUC (2 * k)` by rw[GSYM ODD_EXISTS] >> 5366 `2 <= k` by decide_tac >> 5367 `2 * 4 ** k <= k * 4 ** k` by rw[LESS_MONO_MULT] >> 5368 `lcm_upto n = lcm_upto (2 * k + 1)` by rw[ADD1] >> 5369 `2 ** n = 2 * 2 ** (2 * k)` by rw[EXP] >> 5370 `_ = 2 * 4 ** k` by rw[EXP_EXP_MULT] >> 5371 metis_tac[lcm_upto_lower_odd, LESS_EQ_TRANS], 5372 `ODD 7 /\ ODD 9` by rw[] >> 5373 `EVEN n /\ n <> 7 /\ n <> 9` by metis_tac[ODD_EVEN] >> 5374 `?m. n = 2 * m` by rw[GSYM EVEN_EXISTS] >> 5375 `m <> 0` by decide_tac >> 5376 `?k. m = SUC k` by metis_tac[num_CASES] >> 5377 Cases_on `n = 8` >- 5378 rw[lcm_upto_small] >> 5379 `4 <= k` by decide_tac >> 5380 `4 * 4 ** k <= k * 4 ** k` by rw[LESS_MONO_MULT] >> 5381 `lcm_upto n = lcm_upto (2 * (k + 1))` by rw[ADD1] >> 5382 `2 ** n = 4 ** m` by rw[EXP_EXP_MULT] >> 5383 `_ = 4 * 4 ** k` by rw[EXP] >> 5384 metis_tac[lcm_upto_lower_even, LESS_EQ_TRANS] 5385 ]); 5386 5387(* This is a very significant result. *) 5388 5389(* ------------------------------------------------------------------------- *) 5390(* Simple LCM lower bounds -- rework *) 5391(* ------------------------------------------------------------------------- *) 5392 5393(* Theorem: HALF (n + 1) <= lcm_run n *) 5394(* Proof: 5395 If n = 0, 5396 LHS = HALF 1 = 0 by arithmetic 5397 RHS = lcm_run 0 = 1 by lcm_run_0 5398 Hence true. 5399 If n <> 0, 0 < n. 5400 Let l = [1 .. n]. 5401 Then l <> [] by listRangeINC_NIL, n <> 0 5402 so EVERY_POSITIVE l by listRangeINC_EVERY 5403 lcm_run n 5404 = list_lcm l by notation 5405 >= (SUM l) DIV (LENGTH l) by list_lcm_nonempty_lower, l <> [] 5406 = (SUM l) DIV n by listRangeINC_LEN 5407 = (HALF (n * (n + 1))) DIV n by sum_1_to_n_eqn 5408 = HALF ((n * (n + 1)) DIV n) by DIV_DIV_DIV_MULT, 0 < 2, 0 < n 5409 = HALF (n + 1) by MULT_TO_DIV 5410*) 5411val lcm_run_lower_simple = store_thm( 5412 "lcm_run_lower_simple", 5413 ``!n. HALF (n + 1) <= lcm_run n``, 5414 rpt strip_tac >> 5415 Cases_on `n = 0` >- 5416 rw[lcm_run_0] >> 5417 qabbrev_tac `l = [1 .. n]` >> 5418 `l <> []` by rw[listRangeINC_NIL, Abbr`l`] >> 5419 `EVERY_POSITIVE l` by rw[listRangeINC_EVERY, Abbr`l`] >> 5420 `(SUM l) DIV (LENGTH l) = (SUM l) DIV n` by rw[listRangeINC_LEN, Abbr`l`] >> 5421 `_ = (HALF (n * (n + 1))) DIV n` by rw[sum_1_to_n_eqn, Abbr`l`] >> 5422 `_ = HALF ((n * (n + 1)) DIV n)` by rw[DIV_DIV_DIV_MULT] >> 5423 `_ = HALF (n + 1)` by rw[MULT_TO_DIV] >> 5424 metis_tac[list_lcm_nonempty_lower]); 5425 5426(* This is a simple result, good but not very useful. *) 5427 5428(* Theorem: lcm_run n = list_lcm (leibniz_vertical (n - 1)) *) 5429(* Proof: 5430 If n = 0, 5431 Then n - 1 + 1 = 0 - 1 + 1 = 1 5432 but lcm_run 0 = 1 = lcm_run 1, hence true. 5433 If n <> 0, 5434 Then n - 1 + 1 = n, hence true trivially. 5435*) 5436val lcm_run_alt = store_thm( 5437 "lcm_run_alt", 5438 ``!n. lcm_run n = list_lcm (leibniz_vertical (n - 1))``, 5439 rpt strip_tac >> 5440 Cases_on `n = 0` >- 5441 rw[lcm_run_0, lcm_run_1] >> 5442 rw[]); 5443 5444(* Theorem: 2 ** (n - 1) <= lcm_run n *) 5445(* Proof: 5446 If n = 0, 5447 LHS = HALF 1 = 0 by arithmetic 5448 RHS = lcm_run 0 = 1 by lcm_run_0 5449 Hence true. 5450 If n <> 0, 0 < n, or 1 <= n. 5451 Let l = leibniz_horizontal (n - 1). 5452 Then LENGTH l = n by leibniz_horizontal_len 5453 so l <> [] by LENGTH_NIL, n <> 0 5454 and EVERY_POSITIVE l by leibniz_horizontal_pos 5455 lcm_run n 5456 = list_lcm (leibniz_vertical (n - 1)) by lcm_run_alt 5457 = list_lcm l by leibniz_lcm_property 5458 >= (SUM l) DIV (LENGTH l) by list_lcm_nonempty_lower, l <> [] 5459 = 2 ** (n - 1) by leibniz_horizontal_average_eqn 5460*) 5461val lcm_run_lower_good = store_thm( 5462 "lcm_run_lower_good", 5463 ``!n. 2 ** (n - 1) <= lcm_run n``, 5464 rpt strip_tac >> 5465 Cases_on `n = 0` >- 5466 rw[lcm_run_0] >> 5467 `0 < n /\ 1 <= n /\ (n - 1 + 1 = n)` by decide_tac >> 5468 qabbrev_tac `l = leibniz_horizontal (n - 1)` >> 5469 `lcm_run n = list_lcm l` by metis_tac[leibniz_lcm_property] >> 5470 `LENGTH l = n` by metis_tac[leibniz_horizontal_len] >> 5471 `l <> []` by metis_tac[LENGTH_NIL] >> 5472 `EVERY_POSITIVE l` by rw[leibniz_horizontal_pos, Abbr`l`] >> 5473 metis_tac[list_lcm_nonempty_lower, leibniz_horizontal_average_eqn]); 5474 5475(* ------------------------------------------------------------------------- *) 5476(* Upper Bound by Leibniz Triangle *) 5477(* ------------------------------------------------------------------------- *) 5478 5479(* Theorem: leibniz n k = (n + 1 - k) * binomial (n + 1) k *) 5480(* Proof: by leibniz_up_alt: 5481leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k 5482*) 5483val leibniz_eqn = store_thm( 5484 "leibniz_eqn", 5485 ``!n k. leibniz n k = (n + 1 - k) * binomial (n + 1) k``, 5486 rw[GSYM leibniz_up_alt]); 5487 5488(* Theorem: leibniz n (k + 1) = (n - k) * binomial (n + 1) (k + 1) *) 5489(* Proof: by leibniz_up_alt: 5490leibniz_up_alt |- !n. 0 < n ==> !k. leibniz (n - 1) k = (n - k) * binomial n k 5491*) 5492val leibniz_right_alt = store_thm( 5493 "leibniz_right_alt", 5494 ``!n k. leibniz n (k + 1) = (n - k) * binomial (n + 1) (k + 1)``, 5495 metis_tac[leibniz_up_alt, DECIDE``0 < n + 1 /\ (n + 1 - 1 = n) /\ (n + 1 - (k + 1) = n - k)``]); 5496 5497(* Leibniz Stack: 5498 \ 5499 \ 5500 \ 5501 \ 5502 (L k k) <-- boundary of Leibniz Triangle 5503 | \ |-- (m - k) = distance 5504 | k <= m <= n <-- m 5505 | \ (n - k) = height, or max distance 5506 | binomial (n+1) (m+1) is at south-east of binomial n m 5507 | \ 5508 | \ 5509 n-th row: ....... (L n k) ................. 5510 5511leibniz_binomial_identity 5512|- !m n k. k <= m /\ m <= n ==> (leibniz n k * binomial (n - k) (m - k) = leibniz m k * binomial (n + 1) (m + 1)) 5513This says: (leibniz n k) at bottom is related to a stack entry (leibniz m k). 5514leibniz_divides_leibniz_factor 5515|- !m n k. k <= m /\ m <= n ==> leibniz n k divides leibniz m k * binomial (n + 1) (m + 1) 5516This is just a corollary of leibniz_binomial_identity, by divides_def. 5517 5518leibniz_horizontal_member_divides 5519|- !m n x. n <= TWICE m + 1 /\ m <= n /\ MEM x (leibniz_horizontal n) ==> 5520 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) 5521This says: for the n-th row, q = list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) 5522 is a common multiple of all members of the n-th row when n <= TWICE m + 1 /\ m <= n 5523That means, for the n-th row, pick any m-th row for HALF (n - 1) <= m <= n 5524Compute its list_lcm (leibniz_horizontal m), then multiply by binomial (n + 1) (m + 1) as q. 5525This value q is a common multiple of all members in n-th row. 5526The proof goes through all members of n-th row, i.e. (L n k) for k <= n. 5527To apply leibniz_binomial_identity, the condition is k <= m, not k <= n. 5528Since m has been picked (between HALF n and n), divide k into two parts: k <= m, m < k <= n. 5529For the first part, apply leibniz_binomial_identity. 5530For the second part, use symmetry L n (n - k) = L n k, then apply leibniz_binomial_identity. 5531With k <= m, m <= n, we apply leibniz_binomial_identity: 5532(1) Each member x = leibniz n k divides p = leibniz m k * binomial (n + 1) (m + 1), stack member with a factor. 5533(2) But leibniz m k is a member of (leibniz_horizontal m) 5534(3) Thus leibniz m k divides list_lcm (leibniz_horizontal m), the stack member divides its row list_lcm 5535 ==> p divides q by multiplying both by binomial (n + 1) (m + 1) 5536(4) Hence x divides q. 5537With the other half by symmetry, all members x divides q. 5538Corollary 1: 5539lcm_run_divides_property 5540|- !m n. n <= TWICE m /\ m <= n ==> lcm_run n divides binomial n m * lcm_run m 5541This follows by list_lcm_is_least_common_multiple and leibniz_lcm_property. 5542Corollary 2: 5543lcm_run_bound_recurrence 5544|- !m n. n <= TWICE m /\ m <= n ==> lcm_run n <= lcm_run m * binomial n m 5545Then lcm_run_upper_bound |- !n. lcm_run n <= 4 ** n follows by complete induction on n. 5546*) 5547 5548(* Theorem: k <= m /\ m <= n ==> 5549 ((leibniz n k) * (binomial (n - k) (m - k)) = (leibniz m k) * (binomial (n + 1) (m + 1))) *) 5550(* Proof: 5551 leibniz n k * (binomial (n - k) (m - k)) 5552 = (n + 1) * (binomial n k) * (binomial (n - k) (m - k)) by leibniz_def 5553 n! (n - k)! 5554 = (n + 1) * ------------- * ------------------ binomial formula 5555 k! (n - k)! (m - k)! (n - m)! 5556 n! 1 5557 = (n + 1) * -------------- * ------------------ cancel (n - k)! 5558 k! 1 (m - k)! (n - m)! 5559 n! (m + 1)! 5560 = (n + 1) * -------------- * ------------------ replace by (m + 1)! 5561 k! (m + 1)! (m - k)! (n - m)! 5562 (n + 1)! m! 5563 = (m + 1) * -------------- * ------------------ merge and split factorials 5564 k! (m + 1)! (m - k)! (n - m)! 5565 m! (n + 1)! 5566 = (m + 1) * -------------- * ------------------ binomial formula 5567 k! (m - k)! (m + 1)! (n - m)! 5568 = leibniz m k * binomial (n + 1) (m + 1) by leibniz_def 5569*) 5570val leibniz_binomial_identity = store_thm( 5571 "leibniz_binomial_identity", 5572 ``!m n k. k <= m /\ m <= n ==> 5573 ((leibniz n k) * (binomial (n - k) (m - k)) = (leibniz m k) * (binomial (n + 1) (m + 1)))``, 5574 rw[leibniz_def] >> 5575 `m + 1 <= n + 1` by decide_tac >> 5576 `m - k <= n - k` by decide_tac >> 5577 `(n - k) - (m - k) = n - m` by decide_tac >> 5578 `(n + 1) - (m + 1) = n - m` by decide_tac >> 5579 `FACT m = binomial m k * (FACT (m - k) * FACT k)` by rw[binomial_formula2] >> 5580 `FACT (n + 1) = binomial (n + 1) (m + 1) * (FACT (n - m) * FACT (m + 1))` by metis_tac[binomial_formula2] >> 5581 `FACT n = binomial n k * (FACT (n - k) * FACT k)` by rw[binomial_formula2] >> 5582 `FACT (n - k) = binomial (n - k) (m - k) * (FACT (n - m) * FACT (m - k))` by metis_tac[binomial_formula2] >> 5583 `!n. FACT (n + 1) = (n + 1) * FACT n` by metis_tac[FACT, ADD1] >> 5584 `FACT (n + 1) = FACT (n - m) * (FACT k * (FACT (m - k) * ((m + 1) * (binomial m k) * (binomial (n + 1) (m + 1)))))` by metis_tac[MULT_ASSOC, MULT_COMM] >> 5585 `FACT (n + 1) = FACT (n - m) * (FACT k * (FACT (m - k) * ((n + 1) * (binomial n k) * (binomial (n - k) (m - k)))))` by metis_tac[MULT_ASSOC, MULT_COMM] >> 5586 metis_tac[MULT_LEFT_CANCEL, FACT_LESS, NOT_ZERO_LT_ZERO]); 5587 5588(* Theorem: k <= m /\ m <= n ==> leibniz n k divides leibniz m k * binomial (n + 1) (m + 1) *) 5589(* Proof: 5590 Note leibniz m k * binomial (n + 1) (m + 1) 5591 = leibniz n k * binomial (n - k) (m - k) by leibniz_binomial_identity 5592 Thus leibniz n k divides leibniz m k * binomial (n + 1) (m + 1) 5593 by divides_def, MULT_COMM 5594*) 5595val leibniz_divides_leibniz_factor = store_thm( 5596 "leibniz_divides_leibniz_factor", 5597 ``!m n k. k <= m /\ m <= n ==> leibniz n k divides leibniz m k * binomial (n + 1) (m + 1)``, 5598 metis_tac[leibniz_binomial_identity, divides_def, MULT_COMM]); 5599 5600(* Theorem: n <= 2 * m + 1 /\ m <= n /\ MEM x (leibniz_horizontal n) ==> 5601 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) *) 5602(* Proof: 5603 Let q = list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1). 5604 Note MEM x (leibniz_horizontal n) 5605 ==> ?k. k <= n /\ (x = leibniz n k) by leibniz_horizontal_member 5606 Here the picture is: 5607 HALF n ... m .... n 5608 0 ........ k .......... n 5609 We need k <= m to get x divides q, by applying leibniz_divides_leibniz_factor. 5610 For m < k <= n, we shall use symmetry to get x divides q. 5611 If k <= m, 5612 Let p = (leibniz m k) * binomial (n + 1) (m + 1). 5613 Then x divides p by leibniz_divides_leibniz_factor, k <= m, m <= n 5614 and MEM (leibniz m k) (leibniz_horizontal m) by leibniz_horizontal_member, k <= m 5615 ==> (leibniz m k) divides list_lcm (leibniz_horizontal m) by list_lcm_is_common_multiple 5616 so (leibniz m k) * binomial (n + 1) (m + 1) 5617 divides 5618 list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) by DIVIDES_CANCEL, binomial_pos 5619 or p divides q by notation 5620 Thus x divides q by DIVIDES_TRANS 5621 If ~(k <= m), then m < k. 5622 Note x = leibniz n (n - k) by leibniz_sym, k <= n 5623 Now n <= m + m + 1 by given n <= 2 * m + 1 5624 so n - k <= m + m + 1 - k by arithmetic 5625 and m + m + 1 - k <= m by m < k, so m + 1 <= k 5626 or n - k <= m by LESS_EQ_TRANS 5627 Let j = n - k, p = (leibniz m j) * binomial (n + 1) (m + 1). 5628 Then x divides p by leibniz_divides_leibniz_factor, j <= m, m <= n 5629 and MEM (leibniz m j) (leibniz_horizontal m) by leibniz_horizontal_member, j <= m 5630 ==> (leibniz m j) divides list_lcm (leibniz_horizontal m) by list_lcm_is_common_multiple 5631 so (leibniz m j) * binomial (n + 1) (m + 1) 5632 divides 5633 list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1) by DIVIDES_CANCEL, binomial_pos 5634 or p divides q by notation 5635 Thus x divides q by DIVIDES_TRANS 5636*) 5637val leibniz_horizontal_member_divides = store_thm( 5638 "leibniz_horizontal_member_divides", 5639 ``!m n x. n <= 2 * m + 1 /\ m <= n /\ MEM x (leibniz_horizontal n) ==> 5640 x divides list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)``, 5641 rpt strip_tac >> 5642 qabbrev_tac `q = list_lcm (leibniz_horizontal m) * binomial (n + 1) (m + 1)` >> 5643 `?k. k <= n /\ (x = leibniz n k)` by rw[GSYM leibniz_horizontal_member] >> 5644 Cases_on `k <= m` >| [ 5645 qabbrev_tac `p = (leibniz m k) * binomial (n + 1) (m + 1)` >> 5646 `x divides p` by rw[leibniz_divides_leibniz_factor, Abbr`p`] >> 5647 `MEM (leibniz m k) (leibniz_horizontal m)` by metis_tac[leibniz_horizontal_member] >> 5648 `(leibniz m k) divides list_lcm (leibniz_horizontal m)` by rw[list_lcm_is_common_multiple] >> 5649 `p divides q` by rw[GSYM DIVIDES_CANCEL, binomial_pos, Abbr`p`, Abbr`q`] >> 5650 metis_tac[DIVIDES_TRANS], 5651 `n - k <= m` by decide_tac >> 5652 qabbrev_tac `j = n - k` >> 5653 `x = leibniz n j` by rw[Once leibniz_sym, Abbr`j`] >> 5654 qabbrev_tac `p = (leibniz m j) * binomial (n + 1) (m + 1)` >> 5655 `x divides p` by rw[leibniz_divides_leibniz_factor, Abbr`p`] >> 5656 `MEM (leibniz m j) (leibniz_horizontal m)` by metis_tac[leibniz_horizontal_member] >> 5657 `(leibniz m j) divides list_lcm (leibniz_horizontal m)` by rw[list_lcm_is_common_multiple] >> 5658 `p divides q` by rw[GSYM DIVIDES_CANCEL, binomial_pos, Abbr`p`, Abbr`q`] >> 5659 metis_tac[DIVIDES_TRANS] 5660 ]); 5661 5662(* Theorem: n <= 2 * m /\ m <= n ==> (lcm_run n) divides (lcm_run m) * binomial n m *) 5663(* Proof: 5664 If n = 0, 5665 Then lcm_run 0 = 1 by lcm_run_0 5666 Hence true by ONE_DIVIDES_ALL 5667 If n <> 0, 5668 Then 0 < n, and 0 < m by n <= 2 * m` 5669 Thus m - 1 <= n - 1 by m <= n 5670 and n - 1 <= 2 * m - 1 by n <= 2 * m 5671 = 2 * (m - 1) + 1 5672 Thus !x. MEM x (leibniz_horizontal (n - 1)) ==> 5673 x divides list_lcm (leibniz_horizontal (m - 1)) * binomial n m 5674 by leibniz_horizontal_member_divides 5675 ==> list_lcm (leibniz_horizontal (n - 1)) divides 5676 list_lcm (leibniz_horizontal (m - 1)) * binomial n m 5677 by list_lcm_is_least_common_multiple 5678 But lcm_run n = leibniz_horizontal (n - 1) by leibniz_lcm_property 5679 and lcm_run m = leibniz_horizontal (m - 1) by leibniz_lcm_property 5680 list_lcm (leibniz_horizontal h) divides q by list_lcm_is_least_common_multiple 5681 Thus (lcm_run n) divides (lcm_run m) * binomial n m by above 5682*) 5683val lcm_run_divides_property = store_thm( 5684 "lcm_run_divides_property", 5685 ``!m n. n <= 2 * m /\ m <= n ==> (lcm_run n) divides (lcm_run m) * binomial n m``, 5686 rpt strip_tac >> 5687 Cases_on `n = 0` >- 5688 rw[lcm_run_0] >> 5689 `0 < n` by decide_tac >> 5690 `0 < m` by decide_tac >> 5691 `m - 1 <= n - 1` by decide_tac >> 5692 `n - 1 <= 2 * (m - 1) + 1` by decide_tac >> 5693 `(n - 1 + 1 = n) /\ (m - 1 + 1 = m)` by decide_tac >> 5694 metis_tac[leibniz_horizontal_member_divides, list_lcm_is_least_common_multiple, leibniz_lcm_property]); 5695 5696(* Theorem: n <= 2 * m /\ m <= n ==> (lcm_run n) <= (lcm_run m) * binomial n m *) 5697(* Proof: 5698 Note 0 < lcm_run m by lcm_run_pos 5699 and 0 < binomial n m by binomial_pos 5700 so 0 < lcm_run m * binomial n m by MULT_EQ_0 5701 Now (lcm_run n) divides (lcm_run m) * binomial n m by lcm_run_divides_property 5702 Thus (lcm_run n) <= (lcm_run m) * binomial n m by DIVIDES_LE 5703*) 5704val lcm_run_bound_recurrence = store_thm( 5705 "lcm_run_bound_recurrence", 5706 ``!m n. n <= 2 * m /\ m <= n ==> (lcm_run n) <= (lcm_run m) * binomial n m``, 5707 rpt strip_tac >> 5708 `0 < lcm_run m * binomial n m` by metis_tac[lcm_run_pos, binomial_pos, MULT_EQ_0, NOT_ZERO_LT_ZERO] >> 5709 rw[lcm_run_divides_property, DIVIDES_LE]); 5710 5711(* Theorem: lcm_run n <= 4 ** n *) 5712(* Proof: 5713 By complete induction on n. 5714 If EVEN n, 5715 Base: n = 0. 5716 LHS = lcm_run 0 = 1 by lcm_run_0 5717 RHS = 4 ** 0 = 1 by EXP 5718 Hence true. 5719 Step: n <> 0 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n 5720 Let m = HALF n, c = lcm_run m * binomial n m. 5721 Then n = 2 * m by EVEN_HALF 5722 so m <= 2 * m = n by arithmetic 5723 ==> lcm_run n <= c by lcm_run_bound_recurrence, m <= n 5724 But m <> 0 by n <> 0 5725 so m < n by arithmetic 5726 Now c = lcm_run m * binomial n m by notation 5727 <= 4 ** m * binomial n m by induction hypothesis, m < n 5728 <= 4 ** m * 4 ** m by binomial_middle_upper_bound 5729 = 4 ** (m + m) by EXP_ADD 5730 = 4 ** n by TIMES2, n = 2 * m 5731 Hence lcm_run n <= 4 ** n. 5732 If ~EVEN n, 5733 Then ODD n by EVEN_ODD 5734 Base: n = 1. 5735 LHS = lcm_run 1 = 1 by lcm_run_1 5736 RHS = 4 ** 1 = 4 by EXP 5737 Hence true. 5738 Step: n <> 1 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n 5739 Let m = HALF n, c = lcm_run (m + 1) * binomial n (m + 1). 5740 Then n = 2 * m + 1 by ODD_HALF 5741 and 0 < m by n <> 1 5742 and m + 1 <= 2 * m + 1 = n by arithmetic 5743 ==> (lcm_run n) <= c by lcm_run_bound_recurrence, m + 1 <= n 5744 But m + 1 <> n by m <> 0 5745 so m + 1 < n by m + 1 <> n 5746 Now c = lcm_run (m + 1) * binomial n (m + 1) by notation 5747 <= 4 ** (m + 1) * binomial n (m + 1) by induction hypothesis, m + 1 < n 5748 = 4 ** (m + 1) * binomial n m by binomial_sym, n - (m + 1) = m 5749 <= 4 ** (m + 1) * 4 ** m by binomial_middle_upper_bound 5750 = 4 ** m * 4 ** (m + 1) by arithmetic 5751 = 4 ** (m + (m + 1)) by EXP_ADD 5752 = 4 ** (2 * m + 1) by arithmetic 5753 = 4 ** n by n = 2 * m + 1 5754 Hence lcm_run n <= 4 ** n. 5755*) 5756val lcm_run_upper_bound = store_thm( 5757 "lcm_run_upper_bound", 5758 ``!n. lcm_run n <= 4 ** n``, 5759 completeInduct_on `n` >> 5760 Cases_on `EVEN n` >| [ 5761 Cases_on `n = 0` >- 5762 rw[lcm_run_0] >> 5763 qabbrev_tac `m = HALF n` >> 5764 `n = 2 * m` by rw[EVEN_HALF, Abbr`m`] >> 5765 qabbrev_tac `c = lcm_run m * binomial n m` >> 5766 `lcm_run n <= c` by rw[lcm_run_bound_recurrence, Abbr`c`] >> 5767 `lcm_run m <= 4 ** m` by rw[] >> 5768 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >> 5769 `c <= 4 ** m * 4 ** m` by rw[LESS_MONO_MULT2, Abbr`c`] >> 5770 `4 ** m * 4 ** m = 4 ** n` by metis_tac[EXP_ADD, TIMES2] >> 5771 decide_tac, 5772 `ODD n` by metis_tac[EVEN_ODD] >> 5773 Cases_on `n = 1` >- 5774 rw[lcm_run_1] >> 5775 qabbrev_tac `m = HALF n` >> 5776 `n = 2 * m + 1` by rw[ODD_HALF, Abbr`m`] >> 5777 qabbrev_tac `c = lcm_run (m + 1) * binomial n (m + 1)` >> 5778 `lcm_run n <= c` by rw[lcm_run_bound_recurrence, Abbr`c`] >> 5779 `lcm_run (m + 1) <= 4 ** (m + 1)` by rw[] >> 5780 `binomial n (m + 1) = binomial n m` by rw[Once binomial_sym] >> 5781 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >> 5782 `c <= 4 ** (m + 1) * 4 ** m` by rw[LESS_MONO_MULT2, Abbr`c`] >> 5783 `4 ** (m + 1) * 4 ** m = 4 ** n` by metis_tac[MULT_COMM, EXP_ADD, ADD_ASSOC, TIMES2] >> 5784 decide_tac 5785 ]); 5786 5787(* This is a milestone theorem. *) 5788 5789(* ------------------------------------------------------------------------- *) 5790(* Beta Triangle *) 5791(* ------------------------------------------------------------------------- *) 5792 5793(* Define beta triangle *) 5794(* Use temp_overload so that beta is invisibe outside: 5795val beta_def = Define` 5796 beta n k = k * (binomial n k) 5797`; 5798*) 5799val _ = temp_overload_on ("beta", ``\n k. k * (binomial n k)``); (* for temporary overloading *) 5800(* can use overload, but then hard to print and change the appearance of too many theorem? *) 5801 5802(* 5803 5804Pascal's Triangle (k <= n) 5805n = 0 1 = binomial 0 0 5806n = 1 1 1 5807n = 2 1 2 1 5808n = 3 1 3 3 1 5809n = 4 1 4 6 4 1 5810n = 5 1 5 10 10 5 1 5811n = 6 1 6 15 20 15 6 1 5812 5813Beta Triangle (0 < k <= n) 5814n = 1 1 = 1 * (1) = leibniz_horizontal 0 5815n = 2 2 2 = 2 * (1 1) = leibniz_horizontal 1 5816n = 3 3 6 3 = 3 * (1 2 1) = leibniz_horizontal 2 5817n = 4 4 12 12 4 = 4 * (1 3 3 1) = leibniz_horizontal 3 5818n = 5 5 20 30 20 5 = 5 * (1 4 6 4 1) = leibniz_horizontal 4 5819n = 6 6 30 60 60 30 6 = 6 * (1 5 10 10 5 1) = leibniz_horizontal 5 5820 5821> EVAL ``let n = 10 in let k = 6 in (beta (n+1) (k+1) = leibniz n k)``; --> T 5822> EVAL ``let n = 10 in let k = 4 in (beta (n+1) (k+1) = leibniz n k)``; --> T 5823> EVAL ``let n = 10 in let k = 3 in (beta (n+1) (k+1) = leibniz n k)``; --> T 5824 5825*) 5826 5827(* Theorem: beta 0 n = 0 *) 5828(* Proof: 5829 beta 0 n 5830 = n * (binomial 0 n) by notation 5831 = n * (if n = 0 then 1 else 0) by binomial_0_n 5832 = 0 5833*) 5834val beta_0_n = store_thm( 5835 "beta_0_n", 5836 ``!n. beta 0 n = 0``, 5837 rw[binomial_0_n]); 5838 5839(* Theorem: beta n 0 = 0 *) 5840(* Proof: by notation *) 5841val beta_n_0 = store_thm( 5842 "beta_n_0", 5843 ``!n. beta n 0 = 0``, 5844 rw[]); 5845 5846(* Theorem: n < k ==> (beta n k = 0) *) 5847(* Proof: by notation, binomial_less_0 *) 5848val beta_less_0 = store_thm( 5849 "beta_less_0", 5850 ``!n k. n < k ==> (beta n k = 0)``, 5851 rw[binomial_less_0]); 5852 5853(* Theorem: beta (n + 1) (k + 1) = leibniz n k *) 5854(* Proof: 5855 If k <= n, then k + 1 <= n + 1 by arithmetic 5856 beta (n + 1) (k + 1) 5857 = (k + 1) binomial (n + 1) (k + 1) by notation 5858 = (k + 1) (n + 1)! / (k + 1)! (n - k)! by binomial_formula2 5859 = (n + 1) n! / k! (n - k)! by factorial composing and decomposing 5860 = (n + 1) * binomial n k by binomial_formula2 5861 = leibniz_horizontal n k by leibniz_def 5862 If ~(k <= n), then n < k /\ n + 1 < k + 1 by arithmetic 5863 Then beta (n + 1) (k + 1) = 0 by beta_less_0 5864 and leibniz n k = 0 by leibniz_less_0 5865 Hence true. 5866*) 5867val beta_eqn = store_thm( 5868 "beta_eqn", 5869 ``!n k. beta (n + 1) (k + 1) = leibniz n k``, 5870 rpt strip_tac >> 5871 Cases_on `k <= n` >| [ 5872 `(n + 1) - (k + 1) = n - k` by decide_tac >> 5873 `k + 1 <= n + 1` by decide_tac >> 5874 `FACT (n - k) * FACT k * beta (n + 1) (k + 1) = FACT (n - k) * FACT k * ((k + 1) * binomial (n + 1) (k + 1))` by rw[] >> 5875 `_ = FACT (n - k) * FACT (k + 1) * binomial (n + 1) (k + 1)` by metis_tac[FACT, ADD1, MULT_ASSOC, MULT_COMM] >> 5876 `_ = FACT (n + 1)` by metis_tac[binomial_formula2, MULT_ASSOC, MULT_COMM] >> 5877 `_ = (n + 1) * FACT n` by metis_tac[FACT, ADD1] >> 5878 `_ = FACT (n - k) * FACT k * ((n + 1) * binomial n k)` by metis_tac[binomial_formula2, MULT_ASSOC, MULT_COMM] >> 5879 `_ = FACT (n - k) * FACT k * (leibniz n k)` by rw[leibniz_def] >> 5880 `FACT k <> 0 /\ FACT (n - k) <> 0` by metis_tac[FACT_LESS, NOT_ZERO_LT_ZERO] >> 5881 metis_tac[EQ_MULT_LCANCEL, MULT_ASSOC], 5882 rw[beta_less_0, leibniz_less_0] 5883 ]); 5884 5885(* Theorem: 0 < n /\ 0 < k ==> (beta n k = leibniz (n - 1) (k - 1)) *) 5886(* Proof: by beta_eqn *) 5887val beta_alt = store_thm( 5888 "beta_alt", 5889 ``!n k. 0 < n /\ 0 < k ==> (beta n k = leibniz (n - 1) (k - 1))``, 5890 rw[GSYM beta_eqn]); 5891 5892(* Theorem: 0 < k /\ k <= n ==> 0 < beta n k *) 5893(* Proof: 5894 0 < beta n k 5895 <=> beta n k <> 0 by NOT_ZERO_LT_ZERO 5896 <=> k * (binomial n k) <> 0 by notation 5897 <=> k <> 0 /\ binomial n k <> 0 by MULT_EQ_0 5898 <=> k <> 0 /\ k <= n by binomial_pos 5899 <=> 0 < k /\ k <= n by NOT_ZERO_LT_ZERO 5900*) 5901val beta_pos = store_thm( 5902 "beta_pos", 5903 ``!n k. 0 < k /\ k <= n ==> 0 < beta n k``, 5904 metis_tac[MULT_EQ_0, binomial_pos, NOT_ZERO_LT_ZERO]); 5905 5906(* Theorem: (beta n k = 0) <=> (k = 0) \/ n < k *) 5907(* Proof: 5908 beta n k = 0 5909 <=> k * (binomial n k) = 0 by notation 5910 <=> (k = 0) \/ (binomial n k = 0) by MULT_EQ_0 5911 <=> (k = 0) \/ (n < k) by binomial_eq_0 5912*) 5913val beta_eq_0 = store_thm( 5914 "beta_eq_0", 5915 ``!n k. (beta n k = 0) <=> (k = 0) \/ n < k``, 5916 rw[binomial_eq_0]); 5917 5918(* 5919binomial_sym |- !n k. k <= n ==> (binomial n k = binomial n (n - k)) 5920leibniz_sym |- !n k. k <= n ==> (leibniz n k = leibniz n (n - k)) 5921*) 5922 5923(* Theorem: k <= n ==> (beta n k = beta n (n - k + 1)) *) 5924(* Proof: 5925 If k = 0, 5926 Then beta n 0 = 0 by beta_n_0 5927 and beta n (n + 1) = 0 by beta_less_0 5928 Hence true. 5929 If k <> 0, then 0 < k 5930 Thus 0 < n by k <= n 5931 beta n k 5932 = leibniz (n - 1) (k - 1) by beta_alt 5933 = leibniz (n - 1) (n - k) by leibniz_sym 5934 = leibniz (n - 1) (n - k + 1 - 1) by arithmetic 5935 = beta n (n - k + 1) by beta_alt 5936*) 5937val beta_sym = store_thm( 5938 "beta_sym", 5939 ``!n k. k <= n ==> (beta n k = beta n (n - k + 1))``, 5940 rpt strip_tac >> 5941 Cases_on `k = 0` >- 5942 rw[beta_n_0, beta_less_0] >> 5943 rw[beta_alt, Once leibniz_sym]); 5944 5945(* ------------------------------------------------------------------------- *) 5946(* Beta Horizontal List *) 5947(* ------------------------------------------------------------------------- *) 5948 5949(* 5950> EVAL ``leibniz_horizontal 3``; --> [4; 12; 12; 4] 5951> EVAL ``GENLIST (beta 4) 5``; --> [0; 4; 12; 12; 4] 5952> EVAL ``TL (GENLIST (beta 4) 5)``; --> [4; 12; 12; 4] 5953*) 5954 5955(* Use overloading for a row of beta n k, k = 1 to n. *) 5956(* val _ = overload_on("beta_horizontal", ``\n. TL (GENLIST (beta n) (n + 1))``); *) 5957(* use a direct GENLIST rather than tail of a GENLIST *) 5958val _ = temp_overload_on("beta_horizontal", ``\n. GENLIST (beta n o SUC) n``); (* for temporary overloading *) 5959 5960(* 5961> EVAL ``leibniz_horizontal 5``; --> [6; 30; 60; 60; 30; 6] 5962> EVAL ``beta_horizontal 6``; --> [6; 30; 60; 60; 30; 6] 5963*) 5964 5965(* Theorem: beta_horizontal 0 = [] *) 5966(* Proof: 5967 beta_horizontal 0 5968 = GENLIST (beta 0 o SUC) 0 by notation 5969 = [] by GENLIST 5970*) 5971val beta_horizontal_0 = store_thm( 5972 "beta_horizontal_0", 5973 ``beta_horizontal 0 = []``, 5974 rw[]); 5975 5976(* Theorem: LENGTH (beta_horizontal n) = n *) 5977(* Proof: 5978 LENGTH (beta_horizontal n) 5979 = LENGTH (GENLIST (beta n o SUC) n) by notation 5980 = n by LENGTH_GENLIST 5981*) 5982val beta_horizontal_len = store_thm( 5983 "beta_horizontal_len", 5984 ``!n. LENGTH (beta_horizontal n) = n``, 5985 rw[]); 5986 5987(* Theorem: beta_horizontal (n + 1) = leibniz_horizontal n *) 5988(* Proof: 5989 Note beta_horizontal (n + 1) = GENLIST ((beta (n + 1) o SUC)) (n + 1) by notation 5990 and leibniz_horizontal n = GENLIST (leibniz n) (n + 1) by notation 5991 Now (beta (n + 1)) o SUC) k 5992 = beta (n + 1) (k + 1) by ADD1 5993 = leibniz n k by beta_eqn 5994 Thus beta_horizontal (n + 1) = leibniz_horizontal n by GENLIST_FUN_EQ 5995*) 5996val beta_horizontal_eqn = store_thm( 5997 "beta_horizontal_eqn", 5998 ``!n. beta_horizontal (n + 1) = leibniz_horizontal n``, 5999 rw[GENLIST_FUN_EQ, beta_eqn, ADD1]); 6000 6001(* Theorem: 0 < n ==> (beta_horizontal n = leibniz_horizontal (n - 1)) *) 6002(* Proof: by beta_horizontal_eqn *) 6003val beta_horizontal_alt = store_thm( 6004 "beta_horizontal_alt", 6005 ``!n. 0 < n ==> (beta_horizontal n = leibniz_horizontal (n - 1))``, 6006 metis_tac[beta_horizontal_eqn, DECIDE``0 < n ==> (n - 1 + 1 = n)``]); 6007 6008(* Theorem: 0 < k /\ k <= n ==> MEM (beta n k) (beta_horizontal n) *) 6009(* Proof: 6010 By MEM_GENLIST, this is to show: 6011 ?m. m < n /\ (beta n k = beta n (SUC m)) 6012 Since k <> 0, k = SUC m, 6013 and SUC m = k <= n ==> m < n by arithmetic 6014 So take this m, and the result follows. 6015*) 6016val beta_horizontal_mem = store_thm( 6017 "beta_horizontal_mem", 6018 ``!n k. 0 < k /\ k <= n ==> MEM (beta n k) (beta_horizontal n)``, 6019 rpt strip_tac >> 6020 rw[MEM_GENLIST] >> 6021 `?m. k = SUC m` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO] >> 6022 `m < n` by decide_tac >> 6023 metis_tac[]); 6024 6025(* too weak: 6026binomial_horizontal_mem |- !n k. k < n + 1 ==> MEM (binomial n k) (binomial_horizontal n) 6027leibniz_horizontal_mem |- !n k. k <= n ==> MEM (leibniz n k) (leibniz_horizontal n) 6028*) 6029 6030(* Theorem: MEM (beta n k) (beta_horizontal n) <=> 0 < k /\ k <= n *) 6031(* Proof: 6032 By MEM_GENLIST, this is to show: 6033 (?m. m < n /\ (beta n k = beta n (SUC m))) <=> 0 < k /\ k <= n 6034 If part: (?m. m < n /\ (beta n k = beta n (SUC m))) ==> 0 < k /\ k <= n 6035 By contradiction, suppose k = 0 \/ n < k 6036 Note SUC m <> 0 /\ ~(n < SUC m) by m < n 6037 Thus beta n (SUC m) <> 0 by beta_eq_0 6038 or beta n k <> 0 by beta n k = beta n (SUC m) 6039 ==> (k <> 0) /\ ~(n < k) by beta_eq_0 6040 This contradicts k = 0 \/ n < k. 6041 Only-if part: 0 < k /\ k <= n ==> ?m. m < n /\ (beta n k = beta n (SUC m)) 6042 Note k <> 0, so ?m. k = SUC m by num_CASES 6043 and SUC m <= n <=> m < n by LESS_EQ 6044 so Take this m, and the result follows. 6045*) 6046val beta_horizontal_mem_iff = store_thm( 6047 "beta_horizontal_mem_iff", 6048 ``!n k. MEM (beta n k) (beta_horizontal n) <=> 0 < k /\ k <= n``, 6049 rw[MEM_GENLIST] >> 6050 rewrite_tac[EQ_IMP_THM] >> 6051 strip_tac >| [ 6052 spose_not_then strip_assume_tac >> 6053 `SUC m <> 0 /\ ~(n < SUC m)` by decide_tac >> 6054 `(k <> 0) /\ ~(n < k)` by metis_tac[beta_eq_0] >> 6055 decide_tac, 6056 strip_tac >> 6057 `?m. k = SUC m` by metis_tac[num_CASES, NOT_ZERO_LT_ZERO] >> 6058 metis_tac[LESS_EQ] 6059 ]); 6060 6061(* Theorem: MEM x (beta_horizontal n) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k) *) 6062(* Proof: 6063 By MEM_GENLIST, this is to show: 6064 (?m. m < n /\ (x = beta n (SUC m))) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k) 6065 Since 0 < k /\ k <= n <=> ?m. (k = SUC m) /\ m < n by num_CASES, LESS_EQ 6066 This is trivially true. 6067*) 6068val beta_horizontal_member = store_thm( 6069 "beta_horizontal_member", 6070 ``!n x. MEM x (beta_horizontal n) <=> ?k. 0 < k /\ k <= n /\ (x = beta n k)``, 6071 rw[MEM_GENLIST] >> 6072 metis_tac[num_CASES, NOT_ZERO_LT_ZERO, SUC_NOT_ZERO, LESS_EQ]); 6073 6074(* Theorem: k < n ==> (EL k (beta_horizontal n) = beta n (k + 1)) *) 6075(* Proof: by EL_GENLIST, ADD1 *) 6076val beta_horizontal_element = store_thm( 6077 "beta_horizontal_element", 6078 ``!n k. k < n ==> (EL k (beta_horizontal n) = beta n (k + 1))``, 6079 rw[EL_GENLIST, ADD1]); 6080 6081(* Theorem: 0 < n ==> (lcm_run n = list_lcm (beta_horizontal n)) *) 6082(* Proof: 6083 Note n <> 0 6084 ==> n = SUC k for some k by num_CASES 6085 or n = k + 1 by ADD1 6086 lcm_run n 6087 = lcm_run (k + 1) 6088 = list_lcm (leibniz_horizontal k) by leibniz_lcm_property 6089 = list_lcm (beta_horizontal n) by beta_horizontal_eqn 6090*) 6091val lcm_run_by_beta_horizontal = store_thm( 6092 "lcm_run_by_beta_horizontal", 6093 ``!n. 0 < n ==> (lcm_run n = list_lcm (beta_horizontal n))``, 6094 metis_tac[leibniz_lcm_property, beta_horizontal_eqn, num_CASES, ADD1, NOT_ZERO_LT_ZERO]); 6095 6096(* Theorem: 0 < k /\ k <= n ==> (beta n k) divides lcm_run n *) 6097(* Proof: 6098 Note 0 < n by 0 < k /\ k <= n 6099 and MEM (beta n k) (beta_horizontal n) by beta_horizontal_mem 6100 also lcm_run n = list_lcm (beta_horizontal n) by lcm_run_by_beta_horizontal, 0 < n 6101 Thus (beta n k) divides lcm_run n by list_lcm_is_common_multiple 6102*) 6103val lcm_run_beta_divisor = store_thm( 6104 "lcm_run_beta_divisor", 6105 ``!n k. 0 < k /\ k <= n ==> (beta n k) divides lcm_run n``, 6106 rw[beta_horizontal_mem, lcm_run_by_beta_horizontal, list_lcm_is_common_multiple]); 6107 6108(* Theorem: k <= m /\ m <= n ==> (beta n k) divides (beta m k) * (binomial n m) *) 6109(* Proof: 6110 Note (binomial m k) * (binomial n m) 6111 = (binomial n k) * (binomial (n - k) (m - k)) by binomial_product_identity 6112 Thus binomial n k divides binomial m k * binomial n m by divides_def, MULT_COMM 6113 ==> k * binomial n k divides k * (binomial m k * binomial n m) by DIVIDES_CANCEL_COMM 6114 = (k * binomial m k) * binomial n m by MULT_ASSOC 6115 or (beta n k) divides (beta m k) * (binomial n m) by notation 6116*) 6117val beta_divides_beta_factor = store_thm( 6118 "beta_divides_beta_factor", 6119 ``!m n k. k <= m /\ m <= n ==> (beta n k) divides (beta m k) * (binomial n m)``, 6120 rw[] >> 6121 `binomial n k divides binomial m k * binomial n m` by metis_tac[binomial_product_identity, divides_def, MULT_COMM] >> 6122 metis_tac[DIVIDES_CANCEL_COMM, MULT_ASSOC]); 6123 6124(* Theorem: n <= 2 * m /\ m <= n ==> (lcm_run n) divides (binomial n m) * (lcm_run m) *) 6125(* Proof: 6126 If n = 0, 6127 Then lcm_run 0 = 1 by lcm_run_0 6128 Hence true by ONE_DIVIDES_ALL 6129 If n <> 0, then 0 < n. 6130 Let q = (binomial n m) * (lcm_run m) 6131 6132 Claim: !x. MEM x (beta_horizontal n) ==> x divides q 6133 Proof: Note MEM x (beta_horizontal n) 6134 ==> ?k. 0 < k /\ k <= n /\ (x = beta n k) by beta_horizontal_member 6135 Here the picture is: 6136 HALF n ... m .... n 6137 0 ........ k ........... n 6138 We need k <= m to get x divides q. 6139 For m < k <= n, we shall use symmetry to get x divides q. 6140 If k <= m, 6141 Let p = (beta m k) * (binomial n m). 6142 Then x divides p by beta_divides_beta_factor, k <= m, m <= n 6143 and (beta m k) divides lcm_run m by lcm_run_beta_divisor, 0 < k /\ k <= m 6144 so (beta m k) * (binomial n m) 6145 divides 6146 (lcm_run m) * (binomial n m) by DIVIDES_CANCEL, binomial_pos 6147 or p divides q by MULT_COMM 6148 Thus x divides q by DIVIDES_TRANS 6149 If ~(k <= m), then m < k. 6150 Note x = beta n (n - k + 1) by beta_sym, k <= n 6151 Now n <= m + m by given 6152 so n - k + 1 <= m + m + 1 - k by arithmetic 6153 and m + m + 1 - k <= m by m < k 6154 ==> n - k + 1 <= m by arithmetic 6155 Let h = n - k + 1, p = (beta m h) * (binomial n m). 6156 Then x divides p by beta_divides_beta_factor, h <= m, m <= n 6157 and (beta m h) divides lcm_run m by lcm_run_beta_divisor, 0 < h /\ h <= m 6158 so (beta m h) * (binomial n m) 6159 divides 6160 (lcm_run m) * (binomial n m) by DIVIDES_CANCEL, binomial_pos 6161 or p divides q by MULT_COMM 6162 Thus x divides q by DIVIDES_TRANS 6163 6164 Therefore, 6165 (list_lcm (beta_horizontal n)) divides q by list_lcm_is_least_common_multiple, Claim 6166 or (lcm_run n) divides q by lcm_run_by_beta_horizontal, 0 < n 6167*) 6168val lcm_run_divides_property_alt = store_thm( 6169 "lcm_run_divides_property_alt", 6170 ``!m n. n <= 2 * m /\ m <= n ==> (lcm_run n) divides (binomial n m) * (lcm_run m)``, 6171 rpt strip_tac >> 6172 Cases_on `n = 0` >- 6173 rw[lcm_run_0] >> 6174 `0 < n` by decide_tac >> 6175 qabbrev_tac `q = (binomial n m) * (lcm_run m)` >> 6176 `!x. MEM x (beta_horizontal n) ==> x divides q` by 6177 (rpt strip_tac >> 6178 `?k. 0 < k /\ k <= n /\ (x = beta n k)` by rw[GSYM beta_horizontal_member] >> 6179 Cases_on `k <= m` >| [ 6180 qabbrev_tac `p = (beta m k) * (binomial n m)` >> 6181 `x divides p` by rw[beta_divides_beta_factor, Abbr`p`] >> 6182 `(beta m k) divides lcm_run m` by rw[lcm_run_beta_divisor] >> 6183 `p divides q` by metis_tac[DIVIDES_CANCEL, MULT_COMM, binomial_pos] >> 6184 metis_tac[DIVIDES_TRANS], 6185 `x = beta n (n - k + 1)` by rw[Once beta_sym] >> 6186 `n - k + 1 <= m` by decide_tac >> 6187 qabbrev_tac `h = n - k + 1` >> 6188 qabbrev_tac `p = (beta m h) * (binomial n m)` >> 6189 `x divides p` by rw[beta_divides_beta_factor, Abbr`p`] >> 6190 `(beta m h) divides lcm_run m` by rw[lcm_run_beta_divisor, Abbr`h`] >> 6191 `p divides q` by metis_tac[DIVIDES_CANCEL, MULT_COMM, binomial_pos] >> 6192 metis_tac[DIVIDES_TRANS] 6193 ]) >> 6194 `(list_lcm (beta_horizontal n)) divides q` by metis_tac[list_lcm_is_least_common_multiple] >> 6195 metis_tac[lcm_run_by_beta_horizontal]); 6196 6197(* This is the original lcm_run_divides_property to give lcm_run_upper_bound. *) 6198 6199(* Theorem: lcm_run n <= 4 ** n *) 6200(* Proof: 6201 By complete induction on n. 6202 If EVEN n, 6203 Base: n = 0. 6204 LHS = lcm_run 0 = 1 by lcm_run_0 6205 RHS = 4 ** 0 = 1 by EXP 6206 Hence true. 6207 Step: n <> 0 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n 6208 Let m = HALF n, c = binomial n m * lcm_run m. 6209 Then n = 2 * m by EVEN_HALF 6210 so m <= 2 * m = n by arithmetic 6211 Note 0 < binomial n m by binomial_pos, m <= n 6212 and 0 < lcm_run m by lcm_run_pos 6213 ==> 0 < c by MULT_EQ_0 6214 Thus (lcm_run n) divides c by lcm_run_divides_property, m <= n 6215 or lcm_run n 6216 <= c by DIVIDES_LE, 0 < c 6217 = (binomial n m) * lcm_run m by notation 6218 <= (binomial n m) * 4 ** m by induction hypothesis, m < n 6219 <= 4 ** m * 4 ** m by binomial_middle_upper_bound 6220 = 4 ** (m + m) by EXP_ADD 6221 = 4 ** n by TIMES2, n = 2 * m 6222 Hence lcm_run n <= 4 ** n. 6223 If ~EVEN n, 6224 Then ODD n by EVEN_ODD 6225 Base: n = 1. 6226 LHS = lcm_run 1 = 1 by lcm_run_1 6227 RHS = 4 ** 1 = 4 by EXP 6228 Hence true. 6229 Step: n <> 1 /\ !m. m < n ==> lcm_run m <= 4 ** m ==> lcm_run n <= 4 ** n 6230 Let m = HALF n, c = binomial n (m + 1) * lcm_run (m + 1). 6231 Then n = 2 * m + 1 by ODD_HALF 6232 and 0 < m by n <> 1 6233 and m + 1 <= 2 * m + 1 = n by arithmetic 6234 But m + 1 <> n by m <> 0 6235 so m + 1 < n by m + 1 <> n 6236 Note 0 < binomial n (m + 1) by binomial_pos, m + 1 <= n 6237 and 0 < lcm_run (m + 1) by lcm_run_pos 6238 ==> 0 < c by MULT_EQ_0 6239 Thus (lcm_run n) divides c by lcm_run_divides_property, 0 < m + 1, m + 1 <= n 6240 or lcm_run n 6241 <= c by DIVIDES_LE, 0 < c 6242 = (binomial n (m + 1)) * lcm_run (m + 1) by notation 6243 <= (binomial n (m + 1)) * 4 ** (m + 1) by induction hypothesis, m + 1 < n 6244 = (binomial n m) * 4 ** (m + 1) by binomial_sym, n - (m + 1) = m 6245 <= 4 ** m * 4 ** (m + 1) by binomial_middle_upper_bound 6246 = 4 ** (m + (m + 1)) by EXP_ADD 6247 = 4 ** (2 * m + 1) by arithmetic 6248 = 4 ** n by n = 2 * m + 1 6249 Hence lcm_run n <= 4 ** n. 6250*) 6251val lcm_run_upper_bound = store_thm( 6252 "lcm_run_upper_bound", 6253 ``!n. lcm_run n <= 4 ** n``, 6254 completeInduct_on `n` >> 6255 Cases_on `EVEN n` >| [ 6256 Cases_on `n = 0` >- 6257 rw[lcm_run_0] >> 6258 qabbrev_tac `m = HALF n` >> 6259 `n = 2 * m` by rw[EVEN_HALF, Abbr`m`] >> 6260 qabbrev_tac `c = binomial n m * lcm_run m` >> 6261 `m <= n` by decide_tac >> 6262 `0 < c` by metis_tac[binomial_pos, lcm_run_pos, MULT_EQ_0, NOT_ZERO_LT_ZERO] >> 6263 `lcm_run n <= c` by rw[lcm_run_divides_property, DIVIDES_LE, Abbr`c`] >> 6264 `lcm_run m <= 4 ** m` by rw[] >> 6265 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >> 6266 `c <= 4 ** m * 4 ** m` by rw[LESS_MONO_MULT2, Abbr`c`] >> 6267 `4 ** m * 4 ** m = 4 ** n` by metis_tac[EXP_ADD, TIMES2] >> 6268 decide_tac, 6269 `ODD n` by metis_tac[EVEN_ODD] >> 6270 Cases_on `n = 1` >- 6271 rw[lcm_run_1] >> 6272 qabbrev_tac `m = HALF n` >> 6273 `n = 2 * m + 1` by rw[ODD_HALF, Abbr`m`] >> 6274 `0 < m` by rw[] >> 6275 qabbrev_tac `c = binomial n (m + 1) * lcm_run (m + 1)` >> 6276 `m + 1 <= n` by decide_tac >> 6277 `0 < c` by metis_tac[binomial_pos, lcm_run_pos, MULT_EQ_0, NOT_ZERO_LT_ZERO] >> 6278 `lcm_run n <= c` by rw[lcm_run_divides_property, DIVIDES_LE, Abbr`c`] >> 6279 `lcm_run (m + 1) <= 4 ** (m + 1)` by rw[] >> 6280 `binomial n (m + 1) = binomial n m` by rw[Once binomial_sym] >> 6281 `binomial n m <= 4 ** m` by metis_tac[binomial_middle_upper_bound] >> 6282 `c <= 4 ** m * 4 ** (m + 1)` by rw[LESS_MONO_MULT2, Abbr`c`] >> 6283 `4 ** m * 4 ** (m + 1) = 4 ** n` by metis_tac[EXP_ADD, ADD_ASSOC, TIMES2] >> 6284 decide_tac 6285 ]); 6286 6287(* This is the original proof of the upper bound. *) 6288 6289(* ------------------------------------------------------------------------- *) 6290(* LCM Lower Bound using Maximum *) 6291(* ------------------------------------------------------------------------- *) 6292 6293(* Theorem: POSITIVE l ==> MAX_LIST l <= list_lcm l *) 6294(* Proof: 6295 If l = [], 6296 Note MAX_LIST [] = 0 by MAX_LIST_NIL 6297 and list_lcm [] = 1 by list_lcm_nil 6298 Hence true. 6299 If l <> [], 6300 Let x = MAX_LIST l. 6301 Then MEM x l by MAX_LIST_MEM 6302 and x divides (list_lcm l) by list_lcm_is_common_multiple 6303 Now 0 < list_lcm l by list_lcm_pos, EVERY_MEM 6304 so x <= list_lcm l by DIVIDES_LE, 0 < list_lcm l 6305*) 6306val list_lcm_ge_max = store_thm( 6307 "list_lcm_ge_max", 6308 ``!l. POSITIVE l ==> MAX_LIST l <= list_lcm l``, 6309 rpt strip_tac >> 6310 Cases_on `l = []` >- 6311 rw[MAX_LIST_NIL, list_lcm_nil] >> 6312 `MEM (MAX_LIST l) l` by rw[MAX_LIST_MEM] >> 6313 `0 < list_lcm l` by rw[list_lcm_pos, EVERY_MEM] >> 6314 rw[list_lcm_is_common_multiple, DIVIDES_LE]); 6315 6316(* Theorem: (n + 1) * binomial n (HALF n) <= list_lcm [1 .. (n + 1)] *) 6317(* Proof: 6318 Note !k. MEM k (binomial_horizontal n) ==> 0 < k by binomial_horizontal_pos_alt [1] 6319 6320 list_lcm [1 .. (n + 1)] 6321 = list_lcm (leibniz_vertical n) by notation 6322 = list_lcm (leibniz_horizontal n) by leibniz_lcm_property 6323 = (n + 1) * list_lcm (binomial_horizontal n) by leibniz_horizontal_lcm_alt 6324 >= (n + 1) * MAX_LIST (binomial_horizontal n) by list_lcm_ge_max, [1], LE_MULT_LCANCEL 6325 = (n + 1) * binomial n (HALF n) by binomial_horizontal_max 6326*) 6327val lcm_lower_bound_by_list_lcm = store_thm( 6328 "lcm_lower_bound_by_list_lcm", 6329 ``!n. (n + 1) * binomial n (HALF n) <= list_lcm [1 .. (n + 1)]``, 6330 rpt strip_tac >> 6331 `MAX_LIST (binomial_horizontal n) <= list_lcm (binomial_horizontal n)` by 6332 (irule list_lcm_ge_max >> 6333 metis_tac[binomial_horizontal_pos_alt]) >> 6334 `list_lcm (leibniz_vertical n) = list_lcm (leibniz_horizontal n)` by rw[leibniz_lcm_property] >> 6335 `_ = (n + 1) * list_lcm (binomial_horizontal n)` by rw[leibniz_horizontal_lcm_alt] >> 6336 `n + 1 <> 0` by decide_tac >> 6337 metis_tac[LE_MULT_LCANCEL, binomial_horizontal_max]); 6338 6339(* Theorem: FINITE s /\ (!x. x IN s ==> 0 < x) ==> MAX_SET s <= big_lcm s *) 6340(* Proof: 6341 If s = {}, 6342 Note MAX_SET {} = 0 by MAX_SET_EMPTY 6343 and big_lcm {} = 1 by big_lcm_empty 6344 Hence true. 6345 If s <> {}, 6346 Let x = MAX_SET s. 6347 Then x IN s by MAX_SET_IN_SET 6348 and x divides (big_lcm s) by big_lcm_is_common_multiple 6349 Now 0 < big_lcm s by big_lcm_positive 6350 so x <= big_lcm s by DIVIDES_LE, 0 < big_lcm s 6351*) 6352val big_lcm_ge_max = store_thm( 6353 "big_lcm_ge_max", 6354 ``!s. FINITE s /\ (!x. x IN s ==> 0 < x) ==> MAX_SET s <= big_lcm s``, 6355 rpt strip_tac >> 6356 Cases_on `s = {}` >- 6357 rw[MAX_SET_EMPTY, big_lcm_empty] >> 6358 `(MAX_SET s) IN s` by rw[MAX_SET_IN_SET] >> 6359 `0 < big_lcm s` by rw[big_lcm_positive] >> 6360 rw[big_lcm_is_common_multiple, DIVIDES_LE]); 6361 6362(* Theorem: (n + 1) * binomial n (HALF n) <= big_lcm (natural (n + 1)) *) 6363(* Proof: 6364 Claim: MAX_SET (IMAGE (binomial n) (count (n + 1))) <= big_lcm (IMAGE (binomial n) count (n + 1)) 6365 Proof: By big_lcm_ge_max, this is to show: 6366 (1) FINITE (IMAGE (binomial n) (count (n + 1))) 6367 This is true by FINITE_COUNT, IMAGE_FINITE 6368 (2) !x. x IN IMAGE (binomial n) (count (n + 1)) ==> 0 < x 6369 This is true by binomial_pos, IN_IMAGE, IN_COUNT 6370 6371 big_lcm (natural (n + 1)) 6372 = (n + 1) * big_lcm (IMAGE (binomial n) (count (n + 1))) by big_lcm_natural_eqn 6373 >= (n + 1) * MAX_SET (IMAGE (binomial n) (count (n + 1))) by claim, LE_MULT_LCANCEL 6374 = (n + 1) * binomial n (HALF n) by binomial_row_max 6375*) 6376val lcm_lower_bound_by_big_lcm = store_thm( 6377 "lcm_lower_bound_by_big_lcm", 6378 ``!n. (n + 1) * binomial n (HALF n) <= big_lcm (natural (n + 1))``, 6379 rpt strip_tac >> 6380 `MAX_SET (IMAGE (binomial n) (count (n + 1))) <= 6381 big_lcm (IMAGE (binomial n) (count (n + 1)))` by 6382 ((irule big_lcm_ge_max >> rpt conj_tac) >- 6383 metis_tac[binomial_pos, IN_IMAGE, IN_COUNT, DECIDE``x < n + 1 ==> x <= n``] >> 6384 rw[] 6385 ) >> 6386 metis_tac[big_lcm_natural_eqn, LE_MULT_LCANCEL, binomial_row_max, DECIDE``n + 1 <> 0``]); 6387 6388(* ------------------------------------------------------------------------- *) 6389(* Consecutive LCM function *) 6390(* ------------------------------------------------------------------------- *) 6391 6392(* Theorem: Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==> 6393 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= list_lcm [1 .. n] *) 6394(* Proof: 6395 Note ODD n ==> n <> 0 by EVEN_0, EVEN_ODD 6396 If n = 1, 6397 Note 1 <= pi by 0 < pi 6398 so 2 <= 2 * pi by LE_MULT_LCANCEL, 2 <> 0 6399 or 1 < 2 * pi by arithmetic 6400 Thus 1 DIV (2 * pi) = 0 by ONE_DIV, 1 < 2 * pi 6401 and SQRT (1 DIV (2 * pi)) = 0 by ZERO_EXP, 0 ** h, h <> 0 6402 But list_lcm [1 .. 1] = 1 by list_lcm_sing 6403 so SQRT (1 DIV (2 * pi)) * 2 ** 1 <= list_lcm [1 .. 1] by MULT 6404 If n <> 1, 6405 Then 0 < n - 1. 6406 Let m = n - 1, then n = m + 1 by arithmetic 6407 and n * binomial m (HALF m) <= list_lcm [1 .. n] by lcm_lower_bound_by_list_lcm 6408 Now !a b c. (a DIV b) * c = (a * c) DIV b by DIV_1, MULT_RIGHT_1, c = c DIV 1, b * 1 = b 6409 Note ODD n ==> EVEN m by EVEN_ODD_SUC, ADD1 6410 n * binomial m (HALF m) 6411 = n * (2 ** n DIV SQRT (2 * pi * m)) by binomial_middle_by_stirling 6412 = (2 ** n DIV SQRT (2 * pi * m)) * n by MULT_COMM 6413 = (2 ** n * n) DIV (SQRT (2 * pi * m)) by above 6414 = (n * 2 ** n) DIV (SQRT (2 * pi * m)) by MULT_COMM 6415 = (n DIV SQRT (2 * pi * m)) * 2 ** n by above 6416 = (SQRT (n DIV (2 * pi)) * 2 ** n by assumption, m = n - 1 6417 Hence SQRT (n DIV (2 * pi))) * (2 ** n) <= list_lcm [1 .. n] 6418*) 6419val lcm_lower_bound_by_list_lcm_stirling = store_thm( 6420 "lcm_lower_bound_by_list_lcm_stirling", 6421 ``Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==> 6422 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= list_lcm [1 .. n]``, 6423 rpt strip_tac >> 6424 `!n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = 2 ** (n + 1) DIV SQRT (2 * pi * n))` by prove_tac[binomial_middle_by_stirling] >> 6425 `n <> 0` by metis_tac[EVEN_0, EVEN_ODD] >> 6426 Cases_on `n = 1` >| [ 6427 `1 <= pi` by decide_tac >> 6428 `1 < 2 * pi` by decide_tac >> 6429 `1 DIV (2 * pi) = 0` by rw[ONE_DIV] >> 6430 `SQRT (1 DIV (2 * pi)) * 2 ** 1 = 0` by rw[] >> 6431 rw[list_lcm_sing], 6432 `0 < n - 1 /\ (n = (n - 1) + 1)` by decide_tac >> 6433 qabbrev_tac `m = n - 1` >> 6434 `n * binomial m (HALF m) <= list_lcm [1 .. n]` by metis_tac[lcm_lower_bound_by_list_lcm] >> 6435 `EVEN m` by metis_tac[EVEN_ODD_SUC, ADD1] >> 6436 `!a b c. (a DIV b) * c = (a * c) DIV b` by metis_tac[DIV_1, MULT_RIGHT_1] >> 6437 `n * binomial m (HALF m) = n * (2 ** n DIV SQRT (2 * pi * m))` by rw[] >> 6438 `_ = (n DIV SQRT (2 * pi * m)) * 2 ** n` by metis_tac[MULT_COMM] >> 6439 metis_tac[] 6440 ]); 6441 6442(* Theorem: big_lcm (natural n) <= big_lcm (natural (n + 1)) *) 6443(* Proof: 6444 Note FINITE (natural n) by natural_finite 6445 and 0 < big_lcm (natural n) by big_lcm_positive, natural_element 6446 big_lcm (natural n) 6447 <= lcm (SUC n) (big_lcm (natural n)) by LCM_LE, 0 < SUC n, 0 < big_lcm (natural n) 6448 = big_lcm ((SUC n) INSERT (natural n)) by big_lcm_insert 6449 = big_lcm (natural (SUC n)) by natural_suc 6450 = big_lcm (natural (n + 1)) by ADD1 6451*) 6452val big_lcm_non_decreasing = store_thm( 6453 "big_lcm_non_decreasing", 6454 ``!n. big_lcm (natural n) <= big_lcm (natural (n + 1))``, 6455 rpt strip_tac >> 6456 `FINITE (natural n)` by rw[natural_finite] >> 6457 `0 < big_lcm (natural n)` by rw[big_lcm_positive, natural_element] >> 6458 `big_lcm (natural (n + 1)) = big_lcm (natural (SUC n))` by rw[ADD1] >> 6459 `_ = big_lcm ((SUC n) INSERT (natural n))` by rw[natural_suc] >> 6460 `_ = lcm (SUC n) (big_lcm (natural n))` by rw[big_lcm_insert] >> 6461 rw[LCM_LE]); 6462 6463(* Theorem: Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==> 6464 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= big_lcm (natural n) *) 6465(* Proof: 6466 Note ODD n ==> n <> 0 by EVEN_0, EVEN_ODD 6467 If n = 1, 6468 Note 1 <= pi by 0 < pi 6469 so 2 <= 2 * pi by LE_MULT_LCANCEL, 2 <> 0 6470 or 1 < 2 * pi by arithmetic 6471 Thus 1 DIV (2 * pi) = 0 by ONE_DIV, 1 < 2 * pi 6472 and SQRT (1 DIV (2 * pi)) = 0 by ZERO_EXP, 0 ** h, h <> 0 6473 But big_lcm (natural 1) = 1 by list_lcm_sing, natural_1 6474 so SQRT (1 DIV (2 * pi)) * 2 ** 1 <= big_lcm (natural 1) by MULT 6475 If n <> 1, 6476 Then 0 < n - 1. 6477 Let m = n - 1, then n = m + 1 by arithmetic 6478 and n * binomial m (HALF m) <= big_lcm (natural n) by lcm_lower_bound_by_big_lcm 6479 Now !a b c. (a DIV b) * c = (a * c) DIV b by DIV_1, MULT_RIGHT_1, c = c DIV 1, b * 1 = b 6480 Note ODD n ==> EVEN m by EVEN_ODD_SUC, ADD1 6481 n * binomial m (HALF m) 6482 = n * (2 ** n DIV SQRT (2 * pi * m)) by binomial_middle_by_stirling 6483 = (2 ** n DIV SQRT (2 * pi * m)) * n by MULT_COMM 6484 = (2 ** n * n) DIV (SQRT (2 * pi * m)) by above 6485 = (n * 2 ** n) DIV (SQRT (2 * pi * m)) by MULT_COMM 6486 = (n DIV SQRT (2 * pi * m)) * 2 ** n by above 6487 = (SQRT (n DIV (2 * pi)) * 2 ** n by assumption, m = n - 1 6488 Hence SQRT (n DIV (2 * pi))) * (2 ** n) <= big_lcm (natural n) 6489*) 6490val lcm_lower_bound_by_big_lcm_stirling = store_thm( 6491 "lcm_lower_bound_by_big_lcm_stirling", 6492 ``Stirling /\ (!n c. n DIV (SQRT (c * (n - 1))) = SQRT (n DIV c)) ==> 6493 !n. ODD n ==> (SQRT (n DIV (2 * pi))) * (2 ** n) <= big_lcm (natural n)``, 6494 rpt strip_tac >> 6495 `!n. 0 < n /\ EVEN n ==> (binomial n (HALF n) = 2 ** (n + 1) DIV SQRT (2 * pi * n))` by prove_tac[binomial_middle_by_stirling] >> 6496 `n <> 0` by metis_tac[EVEN_0, EVEN_ODD] >> 6497 Cases_on `n = 1` >| [ 6498 `1 <= pi` by decide_tac >> 6499 `1 < 2 * pi` by decide_tac >> 6500 `1 DIV (2 * pi) = 0` by rw[ONE_DIV] >> 6501 `SQRT (1 DIV (2 * pi)) * 2 ** 1 = 0` by rw[] >> 6502 rw[big_lcm_sing], 6503 `0 < n - 1 /\ (n = (n - 1) + 1)` by decide_tac >> 6504 qabbrev_tac `m = n - 1` >> 6505 `n * binomial m (HALF m) <= big_lcm (natural n)` by metis_tac[lcm_lower_bound_by_big_lcm] >> 6506 `EVEN m` by metis_tac[EVEN_ODD_SUC, ADD1] >> 6507 `!a b c. (a DIV b) * c = (a * c) DIV b` by metis_tac[DIV_1, MULT_RIGHT_1] >> 6508 `n * binomial m (HALF m) = n * (2 ** n DIV SQRT (2 * pi * m))` by rw[] >> 6509 `_ = (n DIV SQRT (2 * pi * m)) * 2 ** n` by metis_tac[MULT_COMM] >> 6510 metis_tac[] 6511 ]); 6512 6513(* ------------------------------------------------------------------------- *) 6514(* Extra Theorems (not used) *) 6515(* ------------------------------------------------------------------------- *) 6516 6517(* 6518This is GCD_CANCEL_MULT by coprime p n, and coprime p n ==> coprime (p ** k) n by coprime_exp. 6519Note prime_not_divides_is_coprime. 6520*) 6521 6522(* Theorem: prime p /\ m divides n /\ ~((p * m) divides n) ==> (gcd (p * m) n = m) *) 6523(* Proof: 6524 Note m divides n ==> ?q. n = q * m by divides_def 6525 6526 Claim: coprime p q 6527 Proof: By contradiction, suppose gcd p q <> 1. 6528 Since (gcd p q) divides p by GCD_IS_GREATEST_COMMON_DIVISOR 6529 so gcd p q = p by prime_def, gcd p q <> 1. 6530 or p divides q by divides_iff_gcd_fix 6531 Now, m <> 0 because 6532 If m = 0, p * m = 0 by MULT_0 6533 Then m divides n and ~((p * m) divides n) are contradictory. 6534 Thus p * m divides q * m by DIVIDES_MULTIPLE_IFF, MULT_COMM, p divides q, m <> 0 6535 But q * m = n, contradicting ~((p * m) divides n). 6536 6537 gcd (p * m) n 6538 = gcd (p * m) (q * m) by n = q * m 6539 = m * gcd p q by GCD_COMMON_FACTOR, MULT_COMM 6540 = m * 1 by coprime p q, from Claim 6541 = m 6542*) 6543val gcd_prime_product_property = store_thm( 6544 "gcd_prime_product_property", 6545 ``!p m n. prime p /\ m divides n /\ ~((p * m) divides n) ==> (gcd (p * m) n = m)``, 6546 rpt strip_tac >> 6547 `?q. n = q * m` by rw[GSYM divides_def] >> 6548 `m <> 0` by metis_tac[MULT_0] >> 6549 `coprime p q` by 6550 (spose_not_then strip_assume_tac >> 6551 `(gcd p q) divides p` by rw[GCD_IS_GREATEST_COMMON_DIVISOR] >> 6552 `gcd p q = p` by metis_tac[prime_def] >> 6553 `p divides q` by rw[divides_iff_gcd_fix] >> 6554 metis_tac[DIVIDES_MULTIPLE_IFF, MULT_COMM]) >> 6555 metis_tac[GCD_COMMON_FACTOR, MULT_COMM, MULT_RIGHT_1]); 6556 6557(* Theorem: prime p /\ m divides n /\ ~((p * m) divides n) ==>(lcm (p * m) n = p * n) *) 6558(* Proof: 6559 Note m <> 0 by MULT_0, m divides n /\ ~((p * m) divides n) 6560 and m * lcm (p * m) n 6561 = gcd (p * m) n * lcm (p * m) n by gcd_prime_product_property 6562 = (p * m) * n by GCD_LCM 6563 = (m * p) * n by MULT_COMM 6564 = m * (p * n) by MULT_ASSOC 6565 Thus lcm (p * m) n = p * n by MULT_LEFT_CANCEL 6566*) 6567val lcm_prime_product_property = store_thm( 6568 "lcm_prime_product_property", 6569 ``!p m n. prime p /\ m divides n /\ ~((p * m) divides n) ==>(lcm (p * m) n = p * n)``, 6570 rpt strip_tac >> 6571 `m <> 0` by metis_tac[MULT_0] >> 6572 `m * lcm (p * m) n = gcd (p * m) n * lcm (p * m) n` by rw[gcd_prime_product_property] >> 6573 `_ = (p * m) * n` by rw[GCD_LCM] >> 6574 `_ = m * (p * n)` by metis_tac[MULT_COMM, MULT_ASSOC] >> 6575 metis_tac[MULT_LEFT_CANCEL]); 6576 6577(* Theorem: prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l) *) 6578(* Proof: 6579 By induction on l. 6580 Base: prime p /\ p divides list_lcm [] ==> p divides PROD_SET (set []) 6581 Note list_lcm [] = 1 by list_lcm_nil 6582 and PROD_SET (set []) 6583 = PROD_SET {} by LIST_TO_SET 6584 = 1 by PROD_SET_EMPTY 6585 Hence conclusion is alredy in predicate, thus true. 6586 Step: prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l) ==> 6587 prime p /\ p divides list_lcm (h::l) ==> p divides PROD_SET (set (h::l)) 6588 Note PROD_SET (set (h::l)) 6589 = PROD_SET (h INSERT set l) by LIST_TO_SET 6590 This is to show: p divides PROD_SET (h INSERT set l) 6591 6592 Let x = list_lcm l. 6593 Since p divides (lcm h x) by given 6594 so p divides (gcd h x) * (lcm h x) by DIVIDES_MULTIPLE 6595 or p divides h * x by GCD_LCM 6596 ==> p divides h or p divides x by P_EUCLIDES 6597 Case: p divides h. 6598 If h IN set l, or MEM h l, 6599 Then h divides x by list_lcm_is_common_multiple 6600 so p divides x by DIVIDES_TRANS 6601 Thus p divides PROD_SET (set l) by induction hypothesis 6602 or p divides PROD_SET (h INSERT set l) by ABSORPTION 6603 If ~(h IN set l), 6604 Then PROD_SET (h INSERT set l) = h * PROD_SET (set l) by PROD_SET_INSERT 6605 or p divides PROD_SET (h INSERT set l) by DIVIDES_MULTIPLE, MULT_COMM 6606 Case: p divides x. 6607 If h IN set l, or MEM h l, 6608 Then p divides PROD_SET (set l) by induction hypothesis 6609 or p divides PROD_SET (h INSERT set l) by ABSORPTION 6610 If ~(h IN set l), 6611 Then PROD_SET (h INSERT set l) = h * PROD_SET (set l) by PROD_SET_INSERT 6612 or p divides PROD_SET (h INSERT set l) by DIVIDES_MULTIPLE 6613*) 6614val list_lcm_prime_factor = store_thm( 6615 "list_lcm_prime_factor", 6616 ``!p l. prime p /\ p divides list_lcm l ==> p divides PROD_SET (set l)``, 6617 strip_tac >> 6618 Induct >- 6619 rw[] >> 6620 rw[] >> 6621 qabbrev_tac `x = list_lcm l` >> 6622 `(gcd h x) * (lcm h x) = h * x` by rw[GCD_LCM] >> 6623 `p divides (h * x)` by metis_tac[DIVIDES_MULTIPLE] >> 6624 `p divides h \/ p divides x` by rw[P_EUCLIDES] >| [ 6625 Cases_on `h IN set l` >| [ 6626 `h divides x` by rw[list_lcm_is_common_multiple, Abbr`x`] >> 6627 `p divides x` by metis_tac[DIVIDES_TRANS] >> 6628 fs[ABSORPTION], 6629 rw[PROD_SET_INSERT] >> 6630 metis_tac[DIVIDES_MULTIPLE, MULT_COMM] 6631 ], 6632 Cases_on `h IN set l` >- 6633 fs[ABSORPTION] >> 6634 rw[PROD_SET_INSERT] >> 6635 metis_tac[DIVIDES_MULTIPLE] 6636 ]); 6637 6638(* Theorem: prime p /\ p divides PROD_SET (set l) ==> ?x. MEM x l /\ p divides x *) 6639(* Proof: 6640 By induction on l. 6641 Base: prime p /\ p divides PROD_SET (set []) ==> ?x. MEM x [] /\ p divides x 6642 p divides PROD_SET (set []) 6643 ==> p divides PROD_SET {} by LIST_TO_SET 6644 ==> p divides 1 by PROD_SET_EMPTY 6645 ==> p = 1 by DIVIDES_ONE 6646 This contradicts with 1 < p by ONE_LT_PRIME 6647 Step: prime p /\ p divides PROD_SET (set l) ==> ?x. MEM x l /\ p divides x ==> 6648 !h. prime p /\ p divides PROD_SET (set (h::l)) ==> ?x. MEM x (h::l) /\ p divides x 6649 Note PROD_SET (set (h::l)) 6650 = PROD_SET (h INSERT set l) by LIST_TO_SET 6651 This is to show: ?x. ((x = h) \/ MEM x l) /\ p divides x by MEM 6652 If h IN set l, or MEM h l, 6653 Then h INSERT set l = set l by ABSORPTION 6654 Thus ?x. MEM x l /\ p divides x by induction hypothesis 6655 If ~(h IN set l), 6656 Then PROD_SET (h INSERT set l) = h * PROD_SET (set l) by PROD_SET_INSERT 6657 Thus p divides h \/ p divides (PROD_SET (set l)) by P_EUCLIDES 6658 Case p divides h. 6659 Take x = h, the result is true. 6660 Case p divides PROD_SET (set l). 6661 Then ?x. MEM x l /\ p divides x by induction hypothesis 6662*) 6663val list_product_prime_factor = store_thm( 6664 "list_product_prime_factor", 6665 ``!p l. prime p /\ p divides PROD_SET (set l) ==> ?x. MEM x l /\ p divides x``, 6666 strip_tac >> 6667 Induct >| [ 6668 rpt strip_tac >> 6669 `PROD_SET (set []) = 1` by rw[PROD_SET_EMPTY] >> 6670 `1 < p` by rw[ONE_LT_PRIME] >> 6671 `p <> 1` by decide_tac >> 6672 metis_tac[DIVIDES_ONE], 6673 rw[] >> 6674 Cases_on `h IN set l` >- 6675 metis_tac[ABSORPTION] >> 6676 fs[PROD_SET_INSERT] >> 6677 `p divides h \/ p divides (PROD_SET (set l))` by rw[P_EUCLIDES] >- 6678 metis_tac[] >> 6679 metis_tac[] 6680 ]); 6681 6682(* Theorem: prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x *) 6683(* Proof: by list_lcm_prime_factor, list_product_prime_factor *) 6684val list_lcm_prime_factor_member = store_thm( 6685 "list_lcm_prime_factor_member", 6686 ``!p l. prime p /\ p divides list_lcm l ==> ?x. MEM x l /\ p divides x``, 6687 rw[list_lcm_prime_factor, list_product_prime_factor]); 6688 6689(* ------------------------------------------------------------------------- *) 6690 6691(* export theory at end *) 6692val _ = export_theory(); 6693 6694(*===========================================================================*) 6695