1(* ------------------------------------------------------------------------- *) 2(* Helper Theorems - a collection of useful results -- for Lists. *) 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 "helperList"; 12 13(* ------------------------------------------------------------------------- *) 14 15 16(* val _ = load "jcLib"; *) 17open jcLib; 18 19(* open dependent theories *) 20open pred_setTheory listTheory rich_listTheory; 21 22(* val _ = load "helperNumTheory"; *) 23open helperNumTheory; 24 25(* (* val _ = load "dividesTheory"; -- in helperNumTheory *) *) 26(* (* val _ = load "gcdTheory"; -- in helperNumTheory *) *) 27open arithmeticTheory dividesTheory gcdTheory; 28 29(* use listRange: [1 .. 3] = [1; 2; 3], [1 ..< 3] = [1; 2] *) 30(* val _ = load "listRangeTheory"; *) 31open listRangeTheory; 32open rich_listTheory; (* for EVERY_REVERSE *) 33 34 35(* ------------------------------------------------------------------------- *) 36(* HelperList Documentation *) 37(* ------------------------------------------------------------------------- *) 38(* Overloading: 39 m downto n = REVERSE [m .. n] 40 turn_exp l n = FUNPOW turn n l 41 POSITIVE l = !x. MEM x l ==> 0 < x 42 EVERY_POSITIVE l = EVERY (\k. 0 < k) l 43 MONO f = !x y. x <= y ==> f x <= f y 44 MONO2 f = !x1 y1 x2 y2. x1 <= x2 /\ y1 <= y2 ==> f x1 y1 <= f x2 y2 45 MONO3 f = !x1 y1 z1 x2 y2 z2. x1 <= x2 /\ y1 <= y2 /\ z1 <= z2 ==> f x1 y1 z1 <= f x2 y2 z2 46 RMONO f = !x y. x <= y ==> f y <= f x 47 RMONO2 f = !x1 y1 x2 y2. x1 <= x2 /\ y1 <= y2 ==> f x2 y2 <= f x1 y1 48 RMONO3 f = !x1 y1 z1 x2 y2 z2. x1 <= x2 /\ y1 <= y2 /\ z1 <= z2 ==> f x2 y2 z2 <= f x1 y1 z1 49 MONO_INC ls = !m n. m <= n /\ n < LENGTH ls ==> EL m ls <= EL n ls 50 MONO_DEC ls = !m n. m <= n /\ n < LENGTH ls ==> EL n ls <= EL m ls 51*) 52 53(* Definitions and Theorems (# are exported): 54 55 List Theorems: 56 LIST_NOT_NIL |- !ls. ls <> [] <=> (ls = HD ls::TL ls) 57 LIST_HEAD_TAIL |- !ls. 0 < LENGTH ls <=> (ls = HD ls::TL ls) 58 LIST_EQ_HEAD_TAIL|- !p q. p <> [] /\ q <> [] ==> ((p = q) <=> (HD p = HD q) /\ (TL p = TL q)) 59 LIST_SING_EQ |- !x y. ([x] = [y]) <=> (x = y) 60 LENGTH_NON_NIL |- !l. 0 < LENGTH l <=> l <> [] 61 LENGTH_EQ_0 |- !l. (LENGTH l = 0) <=> (l = []) 62 LENGTH_EQ_1 |- !l. (LENGTH l = 1) <=> ?x. l = [x] 63 LENGTH_SING |- !x. LENGTH [x] = 1 64 LENGTH_TL_LT |- !ls. ls <> [] ==> LENGTH (TL ls) < LENGTH ls 65 SNOC_NIL |- !x. SNOC x [] = [x] 66 SNOC_CONS |- !x x' l. SNOC x (x'::l) = x'::SNOC x l 67 SNOC_LAST_FRONT |- !l. l <> [] ==> (l = SNOC (LAST l) (FRONT l)) 68 MAP_COMPOSE |- !f g l. MAP f (MAP g l) = MAP (f o g) l 69 MAP_SING |- !f x. MAP f [x] = [f x] 70 LAST_EL_CONS |- !h t. t <> [] ==> LAST t = EL (LENGTH t) (h::t) 71 FRONT_LENGTH |- !l. l <> [] ==> (LENGTH (FRONT l) = PRE (LENGTH l)) 72 FRONT_EL |- !l n. l <> [] /\ n < LENGTH (FRONT l) ==> (EL n (FRONT l) = EL n l) 73 FRONT_EQ_NIL |- !l. LENGTH l = 1 ==> FRONT l = [] 74 FRONT_NON_NIL |- !l. 1 < LENGTH l ==> FRONT l <> [] 75 HEAD_MEM |- !ls. ls <> [] ==> MEM (HD ls) ls 76 LAST_MEM |- !ls. ls <> [] ==> MEM (LAST ls) ls 77 DROP_1 |- !h t. DROP 1 (h::t) = t 78 FRONT_SING |- !x. FRONT [x] = [] 79 TAIL_BY_DROP |- !ls. ls <> [] ==> TL ls = DROP 1 ls 80 FRONT_BY_TAKE |- !ls. ls <> [] ==> FRONT ls = TAKE (LENGTH ls - 1) ls 81 HD_APPEND |- !h t ls. HD (h::t ++ ls) = h 82 EL_TAIL |- !h t n. 0 <> n ==> (EL (n - 1) t = EL n (h::t)) 83 MONOLIST_SET_SING|- !c ls. ls <> [] /\ EVERY ($= c) ls ==> SING (set ls) 84 85 List Reversal: 86 REVERSE_SING |- !x. REVERSE [x] = [x] 87 REVERSE_HD |- !ls. ls <> [] ==> (HD (REVERSE ls) = LAST ls) 88 REVERSE_TL |- !ls. ls <> [] ==> (TL (REVERSE ls) = REVERSE (FRONT ls)) 89 90 91 Extra List Theorems: 92 EVERY_ELEMENT_PROPERTY |- !p R. EVERY (\c. c IN R) p ==> !k. k < LENGTH p ==> EL k p IN R 93 EVERY_MONOTONIC_MAP |- !l f P Q. (!x. P x ==> (Q o f) x) /\ EVERY P l ==> EVERY Q (MAP f l) 94 EVERY_LT_IMP_EVERY_LE |- !ls n. EVERY (\j. j < n) ls ==> EVERY (\j. j <= n) ls 95 ZIP_SNOC |- !x1 x2 l1 l2. (LENGTH l1 = LENGTH l2) ==> 96 (ZIP (SNOC x1 l1,SNOC x2 l2) = SNOC (x1,x2) (ZIP (l1,l2))) 97 ZIP_MAP_MAP |- !ls f g. ZIP (MAP f ls,MAP g ls) = MAP (\x. (f x,g x)) ls 98 MAP2_MAP_MAP |- !ls f g1 g2. MAP2 f (MAP g1 ls) (MAP g2 ls) = MAP (\x. f (g1 x) (g2 x)) ls 99 EL_APPEND |- !n l1 l2. EL n (l1 ++ l2) = if n < LENGTH l1 then EL n l1 else EL (n - LENGTH l1) l2 100 EL_ALL_PROPERTY |- !h1 t1 h2 t2 P. (LENGTH (h1::t1) = LENGTH (h2::t2)) /\ 101 (!k. k < LENGTH (h1::t1) ==> P (EL k (h1::t1)) (EL k (h2::t2))) ==> 102 P h1 h2 /\ !k. k < LENGTH t1 ==> P (EL k t1) (EL k t2) 103 APPEND_EQ_APPEND_EQ |- !l1 l2 m1 m2. 104 (l1 ++ l2 = m1 ++ m2) /\ (LENGTH l1 = LENGTH m1) <=> (l1 = m1) /\ (l2 = m2) 105 LUPDATE_LEN |- !e n l. LENGTH (LUPDATE e n l) = LENGTH l 106 LUPDATE_EL |- !e n l p. p < LENGTH l ==> EL p (LUPDATE e n l) = if p = n then e else EL p l 107 LUPDATE_SAME_SPOT |- !ls n p q. LUPDATE q n (LUPDATE p n ls) = LUPDATE q n ls 108 LUPDATE_DIFF_SPOT |- !ls m n p q. m <> n ==> 109 LUPDATE q n (LUPDATE p m ls) = LUPDATE p m (LUPDATE q n ls) 110 EL_LENGTH_APPEND_0 |- !ls h t. EL (LENGTH ls) (ls ++ h::t) = h 111 EL_LENGTH_APPEND_1 |- !ls h k t. EL (LENGTH ls + 1) (ls ++ h::k::t) = k 112 LUPDATE_APPEND_0 |- !ls a h t. LUPDATE a (LENGTH ls) (ls ++ h::t) = ls ++ a::t 113 LUPDATE_APPEND_1 |- !ls b h k t. LUPDATE b (LENGTH ls + 1) (ls ++ h::k::t) = ls ++ h::b::t 114 LUPDATE_APPEND_0_1 |- !ls a b h k t. LUPDATE b (LENGTH ls + 1) 115 (LUPDATE a (LENGTH ls) (ls ++ h::k::t)) = ls ++ a::b::t 116 117 DROP and TAKE: 118 DROP_LENGTH_NIL |- !l. DROP (LENGTH l) l = [] 119 HD_DROP |- !ls n. n < LENGTH ls ==> HD (DROP n ls) = EL n ls 120 TAKE_1_APPEND |- !x y. x <> [] ==> (TAKE 1 (x ++ y) = TAKE 1 x) 121 DROP_1_APPEND |- !x y. x <> [] ==> (DROP 1 (x ++ y) = DROP 1 x ++ y) 122 DROP_SUC |- !n x. DROP (SUC n) x = DROP 1 (DROP n x) 123 TAKE_SUC |- !n x. TAKE (SUC n) x = TAKE n x ++ TAKE 1 (DROP n x) 124 TAKE_SUC_BY_TAKE |- !k x. k < LENGTH x ==> (TAKE (SUC k) x = SNOC (EL k x) (TAKE k x)) 125 DROP_BY_DROP_SUC |- !k x. k < LENGTH x ==> (DROP k x = EL k x::DROP (SUC k) x) 126 DROP_HEAD_ELEMENT |- !ls n. n < LENGTH ls ==> ?u. DROP n ls = [EL n ls] ++ u 127 DROP_TAKE_EQ_NIL |- !ls n. DROP n (TAKE n ls) = [] 128 TAKE_DROP_SWAP |- !ls m n. TAKE m (DROP n ls) = DROP n (TAKE (n + m) ls) 129 TAKE_LENGTH_APPEND2 |- !l1 l2 x k. TAKE (LENGTH l1) (LUPDATE x (LENGTH l1 + k) (l1 ++ l2)) = l1 130 LENGTH_TAKE_LE |- !n l. LENGTH (TAKE n l) <= LENGTH l 131 132 List Rotation: 133 rotate_def |- !n l. rotate n l = DROP n l ++ TAKE n l 134 rotate_shift_element |- !l n. n < LENGTH l ==> (rotate n l = EL n l::(DROP (SUC n) l ++ TAKE n l)) 135 rotate_0 |- !l. rotate 0 l = l 136 rotate_nil |- !n. rotate n [] = [] 137 rotate_full |- !l. rotate (LENGTH l) l = l 138 rotate_suc |- !l n. n < LENGTH l ==> (rotate (SUC n) l = rotate 1 (rotate n l)) 139 rotate_same_length |- !l n. LENGTH (rotate n l) = LENGTH l 140 rotate_same_set |- !l n. set (rotate n l) = set l 141 rotate_add |- !n m l. n + m <= LENGTH l ==> (rotate n (rotate m l) = rotate (n + m) l) 142 rotate_lcancel |- !k l. k < LENGTH l ==> (rotate (LENGTH l - k) (rotate k l) = l) 143 rotate_rcancel |- !k l. k < LENGTH l ==> (rotate k (rotate (LENGTH l - k) l) = l) 144 145 List Turn: 146 turn_def |- !l. turn l = if l = [] then [] else LAST l::FRONT l 147 turn_nil |- turn [] = [] 148 turn_not_nil |- !l. l <> [] ==> (turn l = LAST l::FRONT l) 149 turn_length |- !l. LENGTH (turn l) = LENGTH l 150 turn_eq_nil |- !p. (turn p = []) <=> (p = []) 151 head_turn |- !ls. ls <> [] ==> HD (turn ls) = LAST ls 152 tail_turn |- !ls. ls <> [] ==> (TL (turn ls) = FRONT ls) 153 turn_snoc |- !ls x. turn (SNOC x ls) = x::ls 154 turn_exp_0 |- !l. turn_exp l 0 = l 155 turn_exp_1 |- !l. turn_exp l 1 = turn l 156 turn_exp_2 |- !l. turn_exp l 2 = turn (turn l) 157 turn_exp_SUC |- !l n. turn_exp l (SUC n) = turn_exp (turn l) n 158 turn_exp_suc |- !l n. turn_exp l (SUC n) = turn (turn_exp l n) 159 turn_exp_length |- !l n. LENGTH (turn_exp l n) = LENGTH l 160 head_turn_exp |- !ls n. n < LENGTH ls ==> 161 HD (turn_exp ls n) = EL (if n = 0 then 0 else (LENGTH ls - n)) ls 162 163 Unit-List and Mono-List: 164 LIST_TO_SET_SING |- !l. (LENGTH l = 1) ==> SING (set l) 165 MONOLIST_EQ |- !l1 l2. SING (set l1) /\ SING (set l2) ==> 166 ((l1 = l2) <=> (LENGTH l1 = LENGTH l2) /\ (set l1 = set l2)) 167 NON_MONO_TAIL_PROPERTY |- !l. ~SING (set (h::t)) ==> ?h'. MEM h' t /\ h' <> h 168 169 GENLIST Theorems: 170 GENLIST_0 |- !f. GENLIST f 0 = [] 171 GENLIST_1 |- !f. GENLIST f 1 = [f 0] 172 GENLIST_EQ |- !f1 f2 n. (!m. m < n ==> f1 m = f2 m) ==> GENLIST f1 n = GENLIST f2 n 173 GENLIST_EQ_NIL |- !f n. (GENLIST f n = []) <=> (n = 0) 174 GENLIST_LAST |- !f n. LAST (GENLIST f (SUC n)) = f n 175 GENLIST_CONSTANT |- !f n c. (!k. k < n ==> (f k = c)) <=> EVERY (\x. x = c) (GENLIST f n) 176 GENLIST_K_CONS |- !e n. GENLIST (K e) (SUC n) = e::GENLIST (K e) n 177 GENLIST_K_ADD |- !e n m. GENLIST (K e) (n + m) = GENLIST (K e) m ++ GENLIST (K e) n 178 GENLIST_K_LESS |- !f e n. (!k. k < n ==> (f k = e)) ==> (GENLIST f n = GENLIST (K e) n) 179 GENLIST_K_RANGE |- !f e n. (!k. 0 < k /\ k <= n ==> (f k = e)) ==> (GENLIST (f o SUC) n = GENLIST (K e) n) 180 GENLIST_K_APPEND |- !a b c. GENLIST (K c) a ++ GENLIST (K c) b = GENLIST (K c) (a + b) 181 GENLIST_K_APPEND_K |- !c n. GENLIST (K c) n ++ [c] = [c] ++ GENLIST (K c) n 182 GENLIST_K_MEM |- !x c n. 0 < n ==> (MEM x (GENLIST (K c) n) <=> (x = c)) 183 GENLIST_K_SET |- !c n. 0 < n ==> (set (GENLIST (K c) n) = {c}) 184 LIST_TO_SET_SING_IFF|- !ls. ls <> [] ==> (SING (set ls) <=> ?c. ls = GENLIST (K c) (LENGTH ls)) 185 186 SUM Theorems: 187 SUM_NIL |- SUM [] = 0 188 SUM_CONS |- !h t. SUM (h::t) = h + SUM t 189 SUM_SING |- !n. SUM [n] = n 190 SUM_MULT |- !s k. k * SUM s = SUM (MAP ($* k) s) 191 SUM_RIGHT_ADD_DISTRIB |- !s m n. (m + n) * SUM s = SUM (MAP ($* m) s) + SUM (MAP ($* n) s) 192 SUM_LEFT_ADD_DISTRIB |- !s m n. SUM s * (m + n) = SUM (MAP ($* m) s) + SUM (MAP ($* n) s) 193 194 SUM_GENLIST |- !f n. SUM (GENLIST f n) = SIGMA f (count n) 195 SUM_DECOMPOSE_FIRST |- !f n. SUM (GENLIST f (SUC n)) = f 0 + SUM (GENLIST (f o SUC) n) 196 SUM_DECOMPOSE_LAST |- !f n. SUM (GENLIST f (SUC n)) = SUM (GENLIST f n) + f n 197 SUM_ADD_GENLIST |- !a b n. SUM (GENLIST a n) + SUM (GENLIST b n) = 198 SUM (GENLIST (\k. a k + b k) n) 199 SUM_GENLIST_APPEND |- !a b n. SUM (GENLIST a n ++ GENLIST b n) = SUM (GENLIST (\k. a k + b k) n) 200 SUM_DECOMPOSE_FIRST_LAST |- !f n. 0 < n ==> 201 (SUM (GENLIST f (SUC n)) = f 0 + SUM (GENLIST (f o SUC) (PRE n)) + f n) 202 SUM_MOD |- !n. 0 < n ==> !l. (SUM l) MOD n = (SUM (MAP (\x. x MOD n) l)) MOD n 203 SUM_EQ_0 |- !l. (SUM l = 0) <=> EVERY (\x. x = 0) l 204 SUM_GENLIST_MOD |- !n. 0 < n ==> !f. SUM (GENLIST ((\k. f k) o SUC) (PRE n)) MOD n = 205 SUM (GENLIST ((\k. f k MOD n) o SUC) (PRE n)) MOD n 206 SUM_CONSTANT |- !n x. SUM (GENLIST (\j. x) n) = n * x 207 SUM_GENLIST_K |- !m n. SUM (GENLIST (K m) n) = m * n 208 SUM_LE |- !l1 l2. (LENGTH l1 = LENGTH l2) /\ 209 (!k. k < LENGTH l1 ==> EL k l1 <= EL k l2) ==> SUM l1 <= SUM l2 210 SUM_LE_MEM |- !l x. MEM x l ==> x <= SUM l: 211 SUM_LE_EL |- !l n. n < LENGTH l ==> EL n l <= SUM l 212 SUM_LE_SUM_EL |- !l m n. m < n /\ n < LENGTH l ==> EL m l + EL n l <= SUM l 213 SUM_DOUBLING_LIST |- !m n. SUM (GENLIST (\j. n * 2 ** j) m) = n * (2 ** m - 1) 214 215 Maximum of a List: 216 MAX_LIST_def |- (MAX_LIST [] = 0) /\ !h t. MAX_LIST (h::t) = MAX h (MAX_LIST t) 217# MAX_LIST_NIL |- MAX_LIST [] = 0 218# MAX_LIST_CONS |- !h t. MAX_LIST (h::t) = MAX h (MAX_LIST t) 219 MAX_LIST_SING |- !x. MAX_LIST [x] = x 220 MAX_LIST_EQ_0 |- !l. (MAX_LIST l = 0) <=> EVERY (\x. x = 0) l 221 MAX_LIST_MEM |- !l. l <> [] ==> MEM (MAX_LIST l) l 222 MAX_LIST_PROPERTY |- !l x. MEM x l ==> x <= MAX_LIST l 223 MAX_LIST_TEST |- !l. l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> y <= x) ==> (x = MAX_LIST l) 224 MAX_LIST_LE |- !h t. MAX_LIST t <= MAX_LIST (h::t) 225 MAX_LIST_MONO_MAP |- !f. (!x y. x <= y ==> f x <= f y) ==> 226 !ls. ls <> [] ==> MAX_LIST (MAP f ls) = f (MAX_LIST ls) 227 228 Minimum of a List: 229 MIN_LIST_def |- !h t. MIN_LIST (h::t) = if t = [] then h else MIN h (MIN_LIST t) 230# MIN_LIST_SING |- !x. MIN_LIST [x] = x 231# MIN_LIST_CONS |- !h t. t <> [] ==> (MIN_LIST (h::t) = MIN h (MIN_LIST t)) 232 MIN_LIST_MEM |- !l. l <> [] ==> MEM (MIN_LIST l) l 233 MIN_LIST_PROPERTY |- !l. l <> [] ==> !x. MEM x l ==> MIN_LIST l <= x 234 MIN_LIST_TEST |- !l. l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> x <= y) ==> (x = MIN_LIST l) 235 MIN_LIST_LE_MAX_LIST |- !l. l <> [] ==> MIN_LIST l <= MAX_LIST l 236 MIN_LIST_LE |- !h t. t <> [] ==> MIN_LIST (h::t) <= MIN_LIST t 237 MIN_LIST_MONO_MAP |- !f. (!x y. x <= y ==> f x <= f y) ==> 238 !ls. ls <> [] ==> MIN_LIST (MAP f ls) = f (MIN_LIST ls) 239 240 List Nub and Set: 241 nub_nil |- nub [] = [] 242 nub_cons |- !x l. nub (x::l) = if MEM x l then nub l else x::nub l 243 nub_sing |- !x. nub [x] = [x] 244 nub_all_distinct |- !l. ALL_DISTINCT (nub l) 245 CARD_LIST_TO_SET_EQ |- !l. CARD (set l) = LENGTH (nub l) 246 MONO_LIST_TO_SET |- !x. set [x] = {x} 247 DISTINCT_LIST_TO_SET_EQ_SING |- !l x. ALL_DISTINCT l /\ (set l = {x}) <=> (l = [x]) 248 MEM_SPLIT_APPEND_distinct |- !l. ALL_DISTINCT l ==> 249 !x. MEM x l <=> ?p1 p2. (l = p1 ++ [x] ++ p2) /\ ~MEM x p1 /\ ~MEM x p2 250 LIST_TO_SET_REDUCTION |- !l1 l2 h. ~MEM h l1 /\ (set (h::l1) = set l2) ==> 251 ?p1 p2. ~MEM h p1 /\ ~MEM h p2 /\ (nub l2 = p1 ++ [h] ++ p2) /\ (set l1 = set (p1 ++ p2)) 252 253 Constant List and Padding: 254 PAD_LEFT_NIL |- !n c. PAD_LEFT c n [] = GENLIST (K c) n 255 PAD_RIGHT_NIL |- !n c. PAD_RIGHT c n [] = GENLIST (K c) n 256 PAD_LEFT_LENGTH |- !n c s. LENGTH (PAD_LEFT c n s) = MAX n (LENGTH s) 257 PAD_RIGHT_LENGTH |- !n c s. LENGTH (PAD_RIGHT c n s) = MAX n (LENGTH s) 258 PAD_LEFT_ID |- !l c n. n <= LENGTH l ==> (PAD_LEFT c n l = l) 259 PAD_RIGHT_ID |- !l c n. n <= LENGTH l ==> (PAD_RIGHT c n l = l) 260 PAD_LEFT_0 |- !l c. PAD_LEFT c 0 l = l 261 PAD_RIGHT_0 |- !l c. PAD_RIGHT c 0 l = l 262 PAD_LEFT_CONS |- !l n. LENGTH l <= n ==> !c. PAD_LEFT c (SUC n) l = c::PAD_LEFT c n l 263 PAD_RIGHT_SNOC |- !l n. LENGTH l <= n ==> !c. PAD_RIGHT c (SUC n) l = SNOC c (PAD_RIGHT c n l) 264 PAD_RIGHT_CONS |- !h t c n. h::PAD_RIGHT c n t = PAD_RIGHT c (SUC n) (h::t) 265 PAD_LEFT_LAST |- !l c n. l <> [] ==> (LAST (PAD_LEFT c n l) = LAST l) 266 PAD_LEFT_EQ_NIL |- !l c n. (PAD_LEFT c n l = []) <=> (l = []) /\ (n = 0) 267 PAD_RIGHT_EQ_NIL |- !l c n. (PAD_RIGHT c n l = []) <=> (l = []) /\ (n = 0) 268 PAD_LEFT_NIL_EQ |- !n c. 0 < n ==> (PAD_LEFT c n [] = PAD_LEFT c n [c]) 269 PAD_RIGHT_NIL_EQ |- !n c. 0 < n ==> (PAD_RIGHT c n [] = PAD_RIGHT c n [c]) 270 PAD_RIGHT_BY_RIGHT|- !ls c n. PAD_RIGHT c n ls = ls ++ PAD_RIGHT c (n - LENGTH ls) [] 271 PAD_RIGHT_BY_LEFT |- !ls c n. PAD_RIGHT c n ls = ls ++ PAD_LEFT c (n - LENGTH ls) [] 272 PAD_LEFT_BY_RIGHT |- !ls c n. PAD_LEFT c n ls = PAD_RIGHT c (n - LENGTH ls) [] ++ ls 273 PAD_LEFT_BY_LEFT |- !ls c n. PAD_LEFT c n ls = PAD_LEFT c (n - LENGTH ls) [] ++ ls 274 275 PROD for List, similar to SUM for List: 276 POSITIVE_THM |- !ls. EVERY_POSITIVE ls <=> POSITIVE ls 277# PROD |- (PROD [] = 1) /\ !h t. PROD (h::t) = h * PROD t 278 PROD_NIL |- PROD [] = 1 279 PROD_CONS |- !h t. PROD (h::t) = h * PROD t 280 PROD_SING |- !n. PROD [n] = n 281 PROD_eval |- !ls. PROD ls = if ls = [] then 1 else HD ls * PROD (TL ls) 282 PROD_eq_1 |- !ls. (PROD ls = 1) <=> !x. MEM x ls ==> (x = 1) 283 PROD_SNOC |- !x l. PROD (SNOC x l) = PROD l * x 284 PROD_APPEND |- !l1 l2. PROD (l1 ++ l2) = PROD l1 * PROD l2 285 PROD_MAP_FOLDL |- !ls f. PROD (MAP f ls) = FOLDL (\a e. a * f e) 1 ls 286 PROD_IMAGE_eq_PROD_MAP_SET_TO_LIST |- !s. FINITE s ==> !f. PI f s = PROD (MAP f (SET_TO_LIST s)) 287 PROD_ACC_DEF |- (!acc. PROD_ACC [] acc = acc) /\ 288 !h t acc. PROD_ACC (h::t) acc = PROD_ACC t (h * acc) 289 PROD_ACC_PROD_LEM |- !L n. PROD_ACC L n = PROD L * n 290 PROD_PROD_ACC |- !L. PROD L = PROD_ACC L 1 291 PROD_GENLIST_K |- !m n. PROD (GENLIST (K m) n) = m ** n 292 PROD_CONSTANT |- !n x. PROD (GENLIST (\j. x) n) = x ** n 293 PROD_EQ_0 |- !l. (PROD l = 0) <=> MEM 0 l 294 PROD_POS |- !l. EVERY_POSITIVE l ==> 0 < PROD l 295 PROD_POS_ALT |- !l. POSITIVE l ==> 0 < PROD l 296 PROD_SQUARING_LIST|- !m n. PROD (GENLIST (\j. n ** 2 ** j) m) = n ** (2 ** m - 1) 297 298 List Range: 299 listRangeINC_LEN |- !m n. LENGTH [m .. n] = n + 1 - m 300 listRangeINC_NIL |- !m n. ([m .. n] = []) <=> n + 1 <= m 301 listRangeINC_MEM |- !m n x. MEM x [m .. n] <=> m <= x /\ x <= n 302 listRangeINC_EL |- !m n i. m + i <= n ==> EL i [m .. n] = m + i 303 listRangeINC_EVERY |- !P m n. EVERY P [m .. n] <=> !x. m <= x /\ x <= n ==> P x 304 listRangeINC_EXISTS |- !P m n. EXISTS P [m .. n] <=> ?x. m <= x /\ x <= n /\ P x 305 listRangeINC_EVERY_EXISTS |- !P m n. EVERY P [m .. n] <=> ~EXISTS ($~ o P) [m .. n] 306 listRangeINC_EXISTS_EVERY |- !P m n. EXISTS P [m .. n] <=> ~EVERY ($~ o P) [m .. n] 307 listRangeINC_SNOC |- !m n. m <= n + 1 ==> ([m .. n + 1] = SNOC (n + 1) [m .. n]) 308 listRangeINC_FRONT |- !m n. m <= n + 1 ==> (FRONT [m .. n + 1] = [m .. n]) 309 listRangeINC_LAST |- !m n. m <= n ==> (LAST [m .. n] = n) 310 listRangeINC_REVERSE |- !m n. REVERSE [m .. n] = MAP (\x. n - x + m) [m .. n] 311 listRangeINC_REVERSE_MAP |- !f m n. REVERSE (MAP f [m .. n]) = MAP (f o (\x. n - x + m)) [m .. n] 312 listRangeINC_MAP_SUC |- !f m n. MAP f [m + 1 .. n + 1] = MAP (f o SUC) [m .. n] 313 listRangeINC_APPEND |- !a b c. a <= b /\ b <= c ==> ([a .. b] ++ [b + 1 .. c] = [a .. c]) 314 listRangeINC_SUM |- !m n. SUM [m .. n] = SUM [1 .. n] - SUM [1 .. m - 1] 315 listRangeINC_PROD_pos |- !m n. 0 < m ==> 0 < PROD [m .. n] 316 listRangeINC_PROD |- !m n. 0 < m /\ m <= n ==> (PROD [m .. n] = PROD [1 .. n] DIV PROD [1 .. m - 1]) 317 listRangeINC_has_divisors |- !m n x. 0 < n /\ m <= x /\ x divides n ==> MEM x [m .. n] 318 listRangeINC_1_n |- !n. [1 .. n] = GENLIST SUC n 319 listRangeINC_MAP |- !f n. MAP f [1 .. n] = GENLIST (f o SUC) n 320 listRangeINC_SUM_MAP |- !f n. SUM (MAP f [1 .. SUC n]) = f (SUC n) + SUM (MAP f [1 .. n]) 321 322 listRangeLHI_to_listRangeINC |- !m n. [m ..< n + 1] = [m .. n] 323 listRangeLHI_LEN |- !m n. LENGTH [m ..< n] = n - m 324 listRangeLHI_NIL |- !m n. [m ..< n] = [] <=> n <= m 325 listRangeLHI_MEM |- !m n x. MEM x [m ..< n] <=> m <= x /\ x < n 326 listRangeLHI_EL |- !m n i. m + i < n ==> EL i [m ..< n] = m + i 327 listRangeLHI_EVERY |- !P m n. EVERY P [m ..< n] <=> !x. m <= x /\ x < n ==> P x 328 listRangeLHI_SNOC |- !m n. m <= n ==> [m ..< n + 1] = SNOC n [m ..< n] 329 listRangeLHI_FRONT |- !m n. m <= n ==> (FRONT [m ..< n + 1] = [m ..< n]) 330 listRangeLHI_LAST |- !m n. m <= n ==> (LAST [m ..< n + 1] = n) 331 listRangeLHI_REVERSE |- !m n. REVERSE [m ..< n] = MAP (\x. n - 1 - x + m) [m ..< n] 332 listRangeLHI_REVERSE_MAP |- !f m n. REVERSE (MAP f [m ..< n]) = MAP (f o (\x. n - 1 - x + m)) [m ..< n] 333 listRangeLHI_MAP_SUC |- !f m n. MAP f [m + 1 ..< n + 1] = MAP (f o SUC) [m ..< n] 334 listRangeLHI_APPEND |- !a b c. a <= b /\ b <= c ==> [a ..< b] ++ [b ..< c] = [a ..< c] 335 listRangeLHI_SUM |- !m n. SUM [m ..< n] = SUM [1 ..< n] - SUM [1 ..< m] 336 listRangeLHI_PROD_pos |- !m n. 0 < m ==> 0 < PROD [m ..< n] 337 listRangeLHI_PROD |- !m n. 0 < m /\ m <= n ==> PROD [m ..< n] = PROD [1 ..< n] DIV PROD [1 ..< m] 338 listRangeLHI_has_divisors |- !m n x. 0 < n /\ m <= x /\ x divides n ==> MEM x [m ..< n + 1] 339 listRangeLHI_0_n |- !n. [0 ..< n] = GENLIST I n 340 listRangeLHI_MAP |- !f n. MAP f [0 ..< n] = GENLIST f n 341 listRangeLHI_SUM_MAP |- !f n. SUM (MAP f [0 ..< SUC n]) = f n + SUM (MAP f [0 ..< n]) 342 343 List Summation and Product: 344 sum_1_to_n_eq_tri_n |- !n. SUM [1 .. n] = tri n 345 sum_1_to_n_eqn |- !n. SUM [1 .. n] = HALF (n * (n + 1)) 346 sum_1_to_n_double |- !n. TWICE (SUM [1 .. n]) = n * (n + 1) 347 prod_1_to_n_eq_fact_n |- !n. PROD [1 .. n] = FACT n 348 power_predecessor_eqn |- !t n. t ** n - 1 = (t - 1) * SUM (MAP (\j. t ** j) [0 ..< n]) 349 geometric_sum_eqn |- !t n. 1 < t ==> SUM (MAP (\j. t ** j) [0 ..< n]) = (t ** n - 1) DIV (t - 1) 350 geometric_sum_eqn_alt |- !t n. 1 < t ==> SUM (MAP (\j. t ** j) [0 .. n]) = (t ** (n + 1) - 1) DIV (t - 1) 351 arithmetic_sum_eqn |- !n. SUM [1 ..< n] = HALF (n * (n - 1)) 352 arithmetic_sum_eqn_alt |- !n. SUM [1 .. n] = HALF (n * (n + 1)) 353 SUM_GENLIST_REVERSE |- !f n. SUM (GENLIST (\j. f (n - j)) n) = SUM (MAP f [1 .. n]) 354 355 MAP of function with 3 list arguments: 356 MAP3_DEF |- (!t3 t2 t1 h3 h2 h1 f. 357 MAP3 f (h1::t1) (h2::t2) (h3::t3) = f h1 h2 h3::MAP3 f t1 t2 t3) /\ 358 (!z y f. MAP3 f [] y z = []) /\ 359 (!z v5 v4 f. MAP3 f (v4::v5) [] z = []) /\ 360 !v5 v4 v13 v12 f. MAP3 f (v4::v5) (v12::v13) [] = [] 361 MAP3 |- (!f. MAP3 f [] [] [] = []) /\ 362 !f h1 t1 h2 t2 h3 t3. 363 MAP3 f (h1::t1) (h2::t2) (h3::t3) = f h1 h2 h3::MAP3 f t1 t2 t3 364 LENGTH_MAP3 |- !lx ly lz f. LENGTH (MAP3 f lx ly lz) = MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) 365 EL_MAP3 |- !lx ly lz n. n < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==> 366 !f. EL n (MAP3 f lx ly lz) = f (EL n lx) (EL n ly) (EL n lz) 367 MEM_MAP2 |- !f x l1 l2. MEM x (MAP2 f l1 l2) ==> 368 ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 l2 369 MEM_MAP3 |- !f x l1 l2 l3. MEM x (MAP3 f l1 l2 l3) ==> 370 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 l1 /\ MEM y2 l2 /\ MEM y3 l3 371 SUM_MAP_K |- !ls c. SUM (MAP (K c) ls) = c * LENGTH ls 372 SUM_MAP_K_LE|- !ls a b. a <= b ==> SUM (MAP (K a) ls) <= SUM (MAP (K b) ls) 373 SUM_MAP2_K |- !lx ly c. SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) 374 SUM_MAP3_K |- !lx ly lz c. SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz) 375 376 Bounds on Lists: 377 SUM_UPPER |- !ls. SUM ls <= MAX_LIST ls * LENGTH ls 378 SUM_LOWER |- !ls. MIN_LIST ls * LENGTH ls <= SUM ls 379 SUM_MAP_LE |- !f g ls. EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls) 380 SUM_MAP_LT |- !f g ls. EVERY (\x. f x < g x) ls /\ ls <> [] ==> SUM (MAP f ls) < SUM (MAP g ls) 381 MEM_MAP_UPPER |- !f. MONO f ==> !ls e. MEM e (MAP f ls) ==> e <= f (MAX_LIST ls) 382 MEM_MAP2_UPPER |- !f. MONO2 f ==>!lx ly e. MEM e (MAP2 f lx ly) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) 383 MEM_MAP3_UPPER |- !f. MONO3 f ==> 384 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) 385 MEM_MAP_LOWER |- !f. MONO f ==> !ls e. MEM e (MAP f ls) ==> f (MIN_LIST ls) <= e 386 MEM_MAP2_LOWER |- !f. MONO2 f ==> !lx ly e. MEM e (MAP2 f lx ly) ==> f (MIN_LIST lx) (MIN_LIST ly) <= e 387 MEM_MAP3_LOWER |- !f. MONO3 f ==> 388 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> f (MIN_LIST lx) (MIN_LIST ly) (MIN_LIST lz) <= e 389 MAX_LIST_MAP_LE |- !f g. (!x. f x <= g x) ==> 390 !ls. MAX_LIST (MAP f ls) <= MAX_LIST (MAP g ls) 391 MIN_LIST_MAP_LE |- !f g. (!x. f x <= g x) ==> 392 !ls. MIN_LIST (MAP f ls) <= MIN_LIST (MAP g ls) 393 MAP_LE |- !f g. (!x. f x <= g x) ==> !ls n. EL n (MAP f ls) <= EL n (MAP g ls) 394 MAP2_LE |- !f g. (!x y. f x y <= g x y) ==> 395 !lx ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly) 396 MAP3_LE |- !f g. (!x y z. f x y z <= g x y z) ==> 397 !lx ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz) 398 SUM_MONO_MAP |- !f1 f2. (!x. f1 x <= f2 x) ==> !ls. SUM (MAP f1 ls) <= SUM (MAP f2 ls) 399 SUM_MONO_MAP2 |- !f1 f2. (!x y. f1 x y <= f2 x y) ==> 400 !lx ly. SUM (MAP2 f1 lx ly) <= SUM (MAP2 f2 lx ly) 401 SUM_MONO_MAP3 |- !f1 f2. (!x y z. f1 x y z <= f2 x y z) ==> 402 !lx ly lz. SUM (MAP3 f1 lx ly lz) <= SUM (MAP3 f2 lx ly lz) 403 SUM_MAP_UPPER |- !f. MONO f ==> !ls. SUM (MAP f ls) <= f (MAX_LIST ls) * LENGTH ls 404 SUM_MAP2_UPPER |- !f. MONO2 f ==> 405 !lx ly. SUM (MAP2 f lx ly) <= f (MAX_LIST lx) (MAX_LIST ly) * LENGTH (MAP2 f lx ly) 406 SUM_MAP3_UPPER |- !f. MONO3 f ==> 407 !lx ly lz. SUM (MAP3 f lx ly lz) <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) * LENGTH (MAP3 f lx ly lz) 408 409 Increasing and decreasing list bounds: 410 GENLIST_MONO_INC |- !f n. MONO f ==> MONO_INC (GENLIST f n) 411 GENLIST_MONO_DEC |- !f n. RMONO f ==> MONO_DEC (GENLIST f n) 412 MAX_LIST_MONO_INC |- !ls. ls <> [] /\ MONO_INC ls ==> MAX_LIST ls = LAST ls 413 MAX_LIST_MONO_DEC |- !ls. ls <> [] /\ MONO_DEC ls ==> MAX_LIST ls = HD ls 414 MIN_LIST_MONO_INC |- !ls. ls <> [] /\ MONO_INC ls ==> MIN_LIST ls = HD ls 415 MIN_LIST_MONO_DEC |- !ls. ls <> [] /\ MONO_DEC ls ==> MIN_LIST ls = LAST ls 416 417 List Dilation: 418 419 List Dilation (Multiplicative): 420 MDILATE_def |- (!e n. MDILATE e n [] = []) /\ 421 !e n h t. MDILATE e n (h::t) = if t = [] then [h] else h::GENLIST (K e) (PRE n) ++ MDILATE e n t 422# MDILATE_NIL |- !e n. MDILATE e n [] = [] 423# MDILATE_SING |- !e n x. MDILATE e n [x] = [x] 424 MDILATE_CONS |- !e n h t. MDILATE e n (h::t) = 425 if t = [] then [h] else h::GENLIST (K e) (PRE n) ++ MDILATE e n t 426 MDILATE_1 |- !l e. MDILATE e 1 l = l 427 MDILATE_0 |- !l e. MDILATE e 0 l = l 428 MDILATE_LENGTH |- !l e n. LENGTH (MDILATE e n l) = 429 if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l)) 430 MDILATE_LENGTH_LOWER |- !l e n. LENGTH l <= LENGTH (MDILATE e n l) 431 MDILATE_LENGTH_UPPER |- !l e n. 0 < n ==> LENGTH (MDILATE e n l) <= SUC (n * PRE (LENGTH l)) 432 MDILATE_EL |- !l e n k. k < LENGTH (MDILATE e n l) ==> 433 (EL k (MDILATE e n l) = if n = 0 then EL k l else if k MOD n = 0 then EL (k DIV n) l else e) 434 MDILATE_EQ_NIL |- !l e n. (MDILATE e n l = []) <=> (l = []) 435 MDILATE_LAST |- !l e n. LAST (MDILATE e n l) = LAST l 436 437 List Dilation (Additive): 438 DILATE_def |- (!n m e. DILATE e n m [] = []) /\ 439 (!n m h e. DILATE e n m [h] = [h]) /\ 440 !v9 v8 n m h e. DILATE e n m (h::v8::v9) = 441 h:: (TAKE n (v8::v9) ++ GENLIST (K e) m ++ DILATE e n m (DROP n (v8::v9))) 442# DILATE_NIL |- !n m e. DILATE e n m [] = [] 443# DILATE_SING |- !n m h e. DILATE e n m [h] = [h] 444 DILATE_CONS |- !n m h t e. DILATE e n m (h::t) = 445 if t = [] then [h] else h::(TAKE n t ++ GENLIST (K e) m ++ DILATE e n m (DROP n t)) 446 DILATE_0_CONS |- !n h t e. DILATE e 0 n (h::t) = 447 if t = [] then [h] else h::(GENLIST (K e) n ++ DILATE e 0 n t) 448 DILATE_0_0 |- !l e. DILATE e 0 0 l = l 449 DILATE_0_SUC |- !l e n. DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l) 450 DILATE_0_LENGTH |- !l e n. LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l)) 451 DILATE_0_LENGTH_LOWER |- !l e n. LENGTH l <= LENGTH (DILATE e 0 n l) 452 DILATE_0_LENGTH_UPPER |- !l e n. LENGTH (DILATE e 0 n l) <= SUC (SUC n * PRE (LENGTH l)) 453 DILATE_0_EL |- !l e n k. k < LENGTH (DILATE e 0 n l) ==> 454 (EL k (DILATE e 0 n l) = if k MOD SUC n = 0 then EL (k DIV SUC n) l else e) 455 DILATE_0_EQ_NIL |- !l e n. (DILATE e 0 n l = []) <=> (l = []) 456 DILATE_0_LAST |- !l e n. LAST (DILATE e 0 n l) = LAST l 457 458 Range Conjunction and Disjunction: 459 every_range_sing |- !a j. a <= j /\ j <= a <=> (j = a) 460 every_range_cons |- !f a b. a <= b ==> 461 ((!j. a <= j /\ j <= b ==> f j) <=> 462 f a /\ !j. a + 1 <= j /\ j <= b ==> f j) 463 exists_range_sing |- !a. ?j. a <= j /\ j <= a <=> (j = a) 464 exists_range_cons |- !f a b. a <= b ==> 465 ((?j. a <= j /\ j <= b /\ f j) <=> 466 f a \/ ?j. a + 1 <= j /\ j <= b /\ f j) 467*) 468 469(* ------------------------------------------------------------------------- *) 470(* List Theorems *) 471(* ------------------------------------------------------------------------- *) 472 473(* Theorem: ls <> [] <=> (ls = HD ls::TL ls) *) 474(* Proof: 475 If part: ls <> [] ==> (ls = HD ls::TL ls) 476 ls <> [] 477 ==> ?h t. ls = h::t by list_CASES 478 ==> ls = (HD ls)::(TL ls) by HD, TL 479 Only-if part: (ls = HD ls::TL ls) ==> ls <> [] 480 This is true by NOT_NIL_CONS 481*) 482val LIST_NOT_NIL = store_thm( 483 "LIST_NOT_NIL", 484 ``!ls. ls <> [] <=> (ls = HD ls::TL ls)``, 485 metis_tac[list_CASES, HD, TL, NOT_NIL_CONS]); 486 487(* NOT_NIL_EQ_LENGTH_NOT_0 |- x <> [] <=> 0 < LENGTH x *) 488 489(* Theorem: 0 < LENGTH ls <=> (ls = HD ls::TL ls) *) 490(* Proof: 491 If part: 0 < LENGTH ls ==> (ls = HD ls::TL ls) 492 Note LENGTH ls <> 0 by arithmetic 493 so ~(NULL l) by NULL_LENGTH 494 or ls = HD ls :: TL ls by CONS 495 Only-if part: (ls = HD ls::TL ls) ==> 0 < LENGTH ls 496 Note LENGTH ls = SUC (LENGTH (TL ls)) by LENGTH 497 but 0 < SUC (LENGTH (TL ls)) by SUC_POS 498*) 499val LIST_HEAD_TAIL = store_thm( 500 "LIST_HEAD_TAIL", 501 ``!ls. 0 < LENGTH ls <=> (ls = HD ls::TL ls)``, 502 metis_tac[LIST_NOT_NIL, NOT_NIL_EQ_LENGTH_NOT_0]); 503 504(* Theorem: p <> [] /\ q <> [] ==> ((p = q) <=> ((HD p = HD q) /\ (TL p = TL q))) *) 505(* Proof: by cases on p and cases on q, CONS_11 *) 506val LIST_EQ_HEAD_TAIL = store_thm( 507 "LIST_EQ_HEAD_TAIL", 508 ``!p q. p <> [] /\ q <> [] ==> 509 ((p = q) <=> ((HD p = HD q) /\ (TL p = TL q)))``, 510 (Cases_on `p` >> Cases_on `q` >> fs[])); 511 512(* Theorem: [x] = [y] <=> x = y *) 513(* Proof: by EQ_LIST and notation. *) 514val LIST_SING_EQ = store_thm( 515 "LIST_SING_EQ", 516 ``!x y. ([x] = [y]) <=> (x = y)``, 517 rw_tac bool_ss[]); 518 519(* Note: There is LENGTH_NIL, but no LENGTH_NON_NIL *) 520 521(* Theorem: 0 < LENGTH l <=> l <> [] *) 522(* Proof: 523 Since (LENGTH l = 0) <=> (l = []) by LENGTH_NIL 524 l <> [] <=> LENGTH l <> 0, 525 or 0 < LENGTH l by NOT_ZERO_LT_ZERO 526*) 527val LENGTH_NON_NIL = store_thm( 528 "LENGTH_NON_NIL", 529 ``!l. 0 < LENGTH l <=> l <> []``, 530 metis_tac[LENGTH_NIL, NOT_ZERO_LT_ZERO]); 531 532(* val LENGTH_EQ_0 = save_thm("LENGTH_EQ_0", LENGTH_EQ_NUM |> CONJUNCT1); *) 533val LENGTH_EQ_0 = save_thm("LENGTH_EQ_0", LENGTH_NIL); 534(* > val LENGTH_EQ_0 = |- !l. (LENGTH l = 0) <=> (l = []): thm *) 535 536(* Theorem: (LENGTH l = 1) <=> ?x. l = [x] *) 537(* Proof: 538 If part: (LENGTH l = 1) ==> ?x. l = [x] 539 Since LENGTH l <> 0, l <> [] by LENGTH_NIL 540 or ?h t. l = h::t by list_CASES 541 and LENGTH t = 0 by LENGTH 542 so t = [] by LENGTH_NIL 543 Hence l = [x] 544 Only-if part: (l = [x]) ==> (LENGTH l = 1) 545 True by LENGTH. 546*) 547val LENGTH_EQ_1 = store_thm( 548 "LENGTH_EQ_1", 549 ``!l. (LENGTH l = 1) <=> ?x. l = [x]``, 550 rw[EQ_IMP_THM] >| [ 551 `LENGTH l <> 0` by decide_tac >> 552 `?h t. l = h::t` by metis_tac[LENGTH_NIL, list_CASES] >> 553 `SUC (LENGTH t) = 1` by metis_tac[LENGTH] >> 554 `LENGTH t = 0` by decide_tac >> 555 metis_tac[LENGTH_NIL], 556 rw[] 557 ]); 558 559(* Theorem: LENGTH [x] = 1 *) 560(* Proof: by LENGTH, ONE. *) 561val LENGTH_SING = store_thm( 562 "LENGTH_SING", 563 ``!x. LENGTH [x] = 1``, 564 rw_tac bool_ss[LENGTH, ONE]); 565 566(* Theorem: ls <> [] ==> LENGTH (TL ls) < LENGTH ls *) 567(* Proof: by LENGTH_TL, LENGTH_EQ_0 *) 568val LENGTH_TL_LT = store_thm( 569 "LENGTH_TL_LT", 570 ``!ls. ls <> [] ==> LENGTH (TL ls) < LENGTH ls``, 571 metis_tac[LENGTH_TL, LENGTH_EQ_0, NOT_ZERO_LT_ZERO, DECIDE``n <> 0 ==> n - 1 < n``]); 572 573val SNOC_NIL = save_thm("SNOC_NIL", SNOC |> CONJUNCT1); 574(* > val SNOC_NIL = |- !x. SNOC x [] = [x]: thm *) 575val SNOC_CONS = save_thm("SNOC_CONS", SNOC |> CONJUNCT2); 576(* > val SNOC_CONS = |- !x x' l. SNOC x (x'::l) = x'::SNOC x l: thm *) 577 578(* Theorem: l <> [] ==> (l = SNOC (LAST l) (FRONT l)) *) 579(* Proof: 580 l 581 = FRONT l ++ [LAST l] by APPEND_FRONT_LAST, l <> [] 582 = SNOC (LAST l) (FRONT l) by SNOC_APPEND 583*) 584val SNOC_LAST_FRONT = store_thm( 585 "SNOC_LAST_FRONT", 586 ``!l. l <> [] ==> (l = SNOC (LAST l) (FRONT l))``, 587 rw[APPEND_FRONT_LAST]); 588 589(* Theorem alias *) 590val MAP_COMPOSE = save_thm("MAP_COMPOSE", MAP_MAP_o); 591(* val MAP_COMPOSE = |- !f g l. MAP f (MAP g l) = MAP (f o g) l: thm *) 592 593(* Theorem: MAP f [x] = [f x] *) 594(* Proof: by MAP *) 595val MAP_SING = store_thm( 596 "MAP_SING", 597 ``!f x. MAP f [x] = [f x]``, 598 rw[]); 599 600 601(* 602LAST_EL |- !ls. ls <> [] ==> LAST ls = EL (PRE (LENGTH ls)) ls 603*) 604 605(* Theorem: t <> [] ==> (LAST t = EL (LENGTH t) (h::t)) *) 606(* Proof: 607 Note LENGTH t <> 0 by LENGTH_EQ_0 608 or 0 < LENGTH t 609 LAST t 610 = EL (PRE (LENGTH t)) t by LAST_EL 611 = EL (SUC (PRE (LENGTH t))) (h::t) by EL 612 = EL (LENGTH t) (h::t) bu SUC_PRE, 0 < LENGTH t 613*) 614val LAST_EL_CONS = store_thm( 615 "LAST_EL_CONS", 616 ``!h t. t <> [] ==> (LAST t = EL (LENGTH t) (h::t))``, 617 rpt strip_tac >> 618 `0 < LENGTH t` by metis_tac[LENGTH_EQ_0, NOT_ZERO_LT_ZERO] >> 619 `LAST t = EL (PRE (LENGTH t)) t` by rw[LAST_EL] >> 620 `_ = EL (SUC (PRE (LENGTH t))) (h::t)` by rw[] >> 621 metis_tac[SUC_PRE]); 622 623(* Theorem alias *) 624val FRONT_LENGTH = save_thm ("FRONT_LENGTH", LENGTH_FRONT); 625(* val FRONT_LENGTH = |- !l. l <> [] ==> (LENGTH (FRONT l) = PRE (LENGTH l)): thm *) 626 627val FRONT_EL = save_thm ("FRONT_EL", EL_FRONT); 628(* val FRONT_EL = |- !l n. n < LENGTH (FRONT l) /\ ~NULL l ==> (EL n (FRONT l) = EL n l) *) 629(* This is not convenient. *) 630 631(* Theorem: l <> [] /\ n < LENGTH (FRONT l) ==> (EL n (FRONT l) = EL n l) *) 632(* Proof: by EL_FRONT, NULL *) 633val FRONT_EL = store_thm( 634 "FRONT_EL", 635 ``!l n. l <> [] /\ n < LENGTH (FRONT l) ==> (EL n (FRONT l) = EL n l)``, 636 metis_tac[EL_FRONT, NULL, list_CASES]); 637 638(* Theorem: (LENGTH l = 1) ==> (FRONT l = []) *) 639(* Proof: 640 Note ?x. l = [x] by LENGTH_EQ_1 641 FRONT l 642 = FRONT [x] by above 643 = [] by FRONT_DEF 644*) 645val FRONT_EQ_NIL = store_thm( 646 "FRONT_EQ_NIL", 647 ``!l. (LENGTH l = 1) ==> (FRONT l = [])``, 648 rw[LENGTH_EQ_1] >> 649 rw[FRONT_DEF]); 650 651(* Theorem: 1 < LENGTH l ==> FRONT l <> [] *) 652(* Proof: 653 Note LENGTH l <> 0 by 1 < LENGTH l 654 Thus ?h s. l = h::s by list_CASES 655 or 1 < 1 + LENGTH s 656 so 0 < LENGTH s by arithmetic 657 Thus ?k t. s = k::t by list_CASES 658 FRONT l 659 = FRONT (h::k::t) 660 = h::FRONT (k::t) by FRONT_CONS 661 <> [] by list_CASES 662*) 663val FRONT_NON_NIL = store_thm( 664 "FRONT_NON_NIL", 665 ``!l. 1 < LENGTH l ==> FRONT l <> []``, 666 rpt strip_tac >> 667 `LENGTH l <> 0` by decide_tac >> 668 `?h s. l = h::s` by metis_tac[list_CASES, LENGTH_EQ_0] >> 669 `LENGTH l = 1 + LENGTH s` by rw[] >> 670 `LENGTH s <> 0` by decide_tac >> 671 `?k t. s = k::t` by metis_tac[list_CASES, LENGTH_EQ_0] >> 672 `FRONT l = h::FRONT (k::t)` by fs[FRONT_CONS] >> 673 fs[]); 674 675(* Theorem: ls <> [] ==> MEM (HD ls) ls *) 676(* Proof: 677 Note ls = h::t by list_CASES 678 MEM (HD (h::t)) (h::t) 679 <=> MEM h (h::t) by HD 680 <=> T by MEM 681*) 682val HEAD_MEM = store_thm( 683 "HEAD_MEM", 684 ``!ls. ls <> [] ==> MEM (HD ls) ls``, 685 (Cases_on `ls` >> simp[])); 686 687(* Theorem: ls <> [] ==> MEM (LAST ls) ls *) 688(* Proof: 689 By induction on ls. 690 Base: [] <> [] ==> MEM (LAST []) [] 691 True by [] <> [] = F. 692 Step: ls <> [] ==> MEM (LAST ls) ls ==> 693 !h. h::ls <> [] ==> MEM (LAST (h::ls)) (h::ls) 694 If ls = [], 695 MEM (LAST [h]) [h] 696 <=> MEM h [h] by LAST_DEF 697 <=> T by MEM 698 If ls <> [], 699 MEM (LAST [h::ls]) (h::ls) 700 <=> MEM (LAST ls) (h::ls) by LAST_DEF 701 <=> LAST ls = h \/ MEM (LAST ls) ls by MEM 702 <=> LAST ls = h \/ T by induction hypothesis 703 <=> T by logical or 704*) 705val LAST_MEM = store_thm( 706 "LAST_MEM", 707 ``!ls. ls <> [] ==> MEM (LAST ls) ls``, 708 Induct >- 709 decide_tac >> 710 (Cases_on `ls = []` >> rw[LAST_DEF])); 711 712(* Theorem: DROP 1 (h::t) = t *) 713(* Proof: DROP_def *) 714val DROP_1 = store_thm( 715 "DROP_1", 716 ``!h t. DROP 1 (h::t) = t``, 717 rw[]); 718 719(* Theorem: FRONT [x] = [] *) 720(* Proof: FRONT_def *) 721val FRONT_SING = store_thm( 722 "FRONT_SING", 723 ``!x. FRONT [x] = []``, 724 rw[]); 725 726(* Theorem: ls <> [] ==> (TL ls = DROP 1 ls) *) 727(* Proof: 728 Note ls = h::t by list_CASES 729 so TL (h::t) 730 = t by TL 731 = DROP 1 (h::t) by DROP_def 732*) 733val TAIL_BY_DROP = store_thm( 734 "TAIL_BY_DROP", 735 ``!ls. ls <> [] ==> (TL ls = DROP 1 ls)``, 736 Cases_on `ls` >- 737 decide_tac >> 738 rw[]); 739 740(* Theorem: ls <> [] ==> (FRONT ls = TAKE (LENGTH ls - 1) ls) *) 741(* Proof: 742 By induction on ls. 743 Base: [] <> [] ==> FRONT [] = TAKE (LENGTH [] - 1) [] 744 True by [] <> [] = F. 745 Step: ls <> [] ==> FRONT ls = TAKE (LENGTH ls - 1) ls ==> 746 !h. h::ls <> [] ==> FRONT (h::ls) = TAKE (LENGTH (h::ls) - 1) (h::ls) 747 If ls = [], 748 FRONT [h] 749 = [] by FRONT_SING 750 = TAKE 0 [h] by TAKE_0 751 = TAKE (LENGTH [h] - 1) [h] by LENGTH_SING 752 If ls <> [], 753 FRONT (h::ls) 754 = h::FRONT ls by FRONT_DEF 755 = h::TAKE (LENGTH ls - 1) ls by induction hypothesis 756 = TAKE (LENGTH (h::ls) - 1) (h::ls) by TAKE_def 757*) 758val FRONT_BY_TAKE = store_thm( 759 "FRONT_BY_TAKE", 760 ``!ls. ls <> [] ==> (FRONT ls = TAKE (LENGTH ls - 1) ls)``, 761 Induct >- 762 decide_tac >> 763 rpt strip_tac >> 764 Cases_on `ls = []` >- 765 rw[] >> 766 `LENGTH ls <> 0` by rw[] >> 767 rw[FRONT_DEF]); 768 769(* Theorem: HD (h::t ++ ls) = h *) 770(* Proof: 771 HD (h::t ++ ls) 772 = HD (h::(t ++ ls)) by APPEND 773 = h by HD 774*) 775Theorem HD_APPEND: 776 !h t ls. HD (h::t ++ ls) = h 777Proof 778 simp[] 779QED 780 781(* Theorem: 0 <> n ==> (EL (n-1) t = EL n (h::t)) *) 782(* Proof: 783 Note n = SUC k for some k by num_CASES 784 so EL k t = EL (SUC k) (h::t) by EL_restricted 785*) 786Theorem EL_TAIL: 787 !h t n. 0 <> n ==> (EL (n-1) t = EL n (h::t)) 788Proof 789 rpt strip_tac >> 790 `n = SUC (n - 1)` by decide_tac >> 791 metis_tac[EL_restricted] 792QED 793 794(* Idea: If all elements are the same, the set is SING. *) 795 796(* Theorem: ls <> [] /\ EVERY ($= c) ls ==> SING (set ls) *) 797(* Proof: 798 Note set ls = {c} by LIST_TO_SET_EQ_SING 799 thus SING (set ls) by SING_DEF 800*) 801Theorem MONOLIST_SET_SING: 802 !c ls. ls <> [] /\ EVERY ($= c) ls ==> SING (set ls) 803Proof 804 metis_tac[LIST_TO_SET_EQ_SING, SING_DEF] 805QED 806 807(* ------------------------------------------------------------------------- *) 808(* List Reversal. *) 809(* ------------------------------------------------------------------------- *) 810 811(* Overload for REVERSE [m .. n] *) 812val _ = overload_on ("downto", ``\n m. REVERSE [m .. n]``); 813val _ = set_fixity "downto" (Infix(NONASSOC, 450)); (* same as relation *) 814 815(* Theorem: REVERSE [x] = [x] *) 816(* Proof: 817 REVERSE [x] 818 = [] ++ [x] by REVERSE_DEF 819 = [x] by APPEND 820*) 821val REVERSE_SING = store_thm( 822 "REVERSE_SING", 823 ``!x. REVERSE [x] = [x]``, 824 rw[]); 825 826(* Theorem: ls <> [] ==> (HD (REVERSE ls) = LAST ls) *) 827(* Proof: 828 HD (REVERSE ls) 829 = HD (REVERSE (SNOC (LAST ls) (FRONT ls))) by SNOC_LAST_FRONT 830 = HD (LAST ls :: (REVERSE (FRONT ls)) by REVERSE_SNOC 831 = LAST ls by HD 832*) 833Theorem REVERSE_HD: 834 !ls. ls <> [] ==> (HD (REVERSE ls) = LAST ls) 835Proof 836 metis_tac[SNOC_LAST_FRONT, REVERSE_SNOC, HD] 837QED 838 839(* Theorem: ls <> [] ==> (TL (REVERSE ls) = REVERSE (FRONT ls)) *) 840(* Proof: 841 TL (REVERSE ls) 842 = TL (REVERSE (SNOC (LAST ls) (FRONT ls))) by SNOC_LAST_FRONT 843 = TL (LAST ls :: (REVERSE (FRONT ls)) by REVERSE_SNOC 844 = REVERSE (FRONT ls) by TL 845*) 846Theorem REVERSE_TL: 847 !ls. ls <> [] ==> (TL (REVERSE ls) = REVERSE (FRONT ls)) 848Proof 849 metis_tac[SNOC_LAST_FRONT, REVERSE_SNOC, TL] 850QED 851 852(* ------------------------------------------------------------------------- *) 853(* Extra List Theorems *) 854(* ------------------------------------------------------------------------- *) 855 856(* Theorem: EVERY (\c. c IN R) p ==> !k. k < LENGTH p ==> EL k p IN R *) 857(* Proof: by EVERY_EL. *) 858val EVERY_ELEMENT_PROPERTY = store_thm( 859 "EVERY_ELEMENT_PROPERTY", 860 ``!p R. EVERY (\c. c IN R) p ==> !k. k < LENGTH p ==> EL k p IN R``, 861 rw[EVERY_EL]); 862 863(* Theorem: (!x. P x ==> (Q o f) x) /\ EVERY P l ==> EVERY Q (MAP f l) *) 864(* Proof: 865 Since !x. P x ==> (Q o f) x, 866 EVERY P l 867 ==> EVERY Q o f l by EVERY_MONOTONIC 868 ==> EVERY Q (MAP f l) by EVERY_MAP 869*) 870val EVERY_MONOTONIC_MAP = store_thm( 871 "EVERY_MONOTONIC_MAP", 872 ``!l f P Q. (!x. P x ==> (Q o f) x) /\ EVERY P l ==> EVERY Q (MAP f l)``, 873 metis_tac[EVERY_MONOTONIC, EVERY_MAP]); 874 875(* Theorem: EVERY (\j. j < n) ls ==> EVERY (\j. j <= n) ls *) 876(* Proof: by EVERY_EL, arithmetic. *) 877val EVERY_LT_IMP_EVERY_LE = store_thm( 878 "EVERY_LT_IMP_EVERY_LE", 879 ``!ls n. EVERY (\j. j < n) ls ==> EVERY (\j. j <= n) ls``, 880 simp[EVERY_EL, LESS_IMP_LESS_OR_EQ]); 881 882(* Theorem: LENGTH l1 = LENGTH l2 ==> ZIP (SNOC x1 l1, SNOC x2 l2) = SNOC (x1, x2) ZIP (l1, l2) *) 883(* Proof: 884 By induction on l1, 885 Base case: !l2. (LENGTH [] = LENGTH l2) ==> (ZIP (SNOC x1 [],SNOC x2 l2) = SNOC (x1,x2) (ZIP ([],l2))) 886 Since LENGTH l2 = LENGTH [] = 0, l2 = [] by LENGTH_NIL 887 ZIP (SNOC x1 [],SNOC x2 []) 888 = ZIP ([x1], [x2]) by SNOC 889 = ([x1], [x2]) by ZIP 890 = SNOC ([x1], [x2]) [] by SNOC 891 = SNOC ([x1], [x2]) ZIP ([][]) by ZIP 892 Step case: !h l2. (LENGTH (h::l1) = LENGTH l2) ==> (ZIP (SNOC x1 (h::l1),SNOC x2 l2) = SNOC (x1,x2) (ZIP (h::l1,l2))) 893 Expand by LENGTH_CONS, this is to show: 894 ZIP (h::(l1 ++ [x1]),h'::l' ++ [x2]) = ZIP (h::l1,h'::l') ++ [(x1,x2)] 895 ZIP (h::(l1 ++ [x1]),h'::l' ++ [x2]) 896 = (h, h') :: ZIP (l1 ++ [x1],l' ++ [x2]) by ZIP 897 = (h, h') :: ZIP (SNOC x1 l1, SNOC x2 l') by SNOC 898 = (h, h') :: SNOC (x1, x2) (ZIP (l1, l')) by induction hypothesis 899 = (h, h') :: ZIP (l1, l') ++ [(x1, x2)] by SNOC 900 = ZIP (h::l1, h'::l') ++ [(x1, x2)] by ZIP 901*) 902val ZIP_SNOC = store_thm( 903 "ZIP_SNOC", 904 ``!x1 x2 l1 l2. (LENGTH l1 = LENGTH l2) ==> (ZIP (SNOC x1 l1, SNOC x2 l2) = SNOC (x1, x2) (ZIP (l1, l2)))``, 905 ntac 2 strip_tac >> 906 Induct_on `l1` >- 907 rw[] >> 908 rw[LENGTH_CONS] >> 909 `ZIP (h::(l1 ++ [x1]),h'::l' ++ [x2]) = (h, h') :: ZIP (l1 ++ [x1],l' ++ [x2])` by rw[] >> 910 `_ = (h, h') :: ZIP (SNOC x1 l1, SNOC x2 l')` by rw[] >> 911 `_ = (h, h') :: SNOC (x1, x2) (ZIP (l1, l'))` by metis_tac[] >> 912 `_ = (h, h') :: ZIP (l1, l') ++ [(x1, x2)]` by rw[] >> 913 `_ = ZIP (h::l1, h'::l') ++ [(x1, x2)]` by rw[] >> 914 metis_tac[]); 915 916(* MAP_ZIP_SAME |- !ls f. MAP f (ZIP (ls,ls)) = MAP (\x. f (x,x)) ls *) 917 918(* Theorem: ZIP ((MAP f ls), (MAP g ls)) = MAP (\x. (f x, g x)) ls *) 919(* Proof: 920 ZIP ((MAP f ls), (MAP g ls)) 921 = MAP (\(x, y). (f x, y)) (ZIP (ls, (MAP g ls))) by ZIP_MAP 922 = MAP (\(x, y). (f x, y)) (MAP (\(x, y). (x, g y)) (ZIP (ls, ls))) by ZIP_MAP 923 = MAP (\(x, y). (f x, y)) (MAP (\j. (\(x, y). (x, g y)) (j,j)) ls) by MAP_ZIP_SAME 924 = MAP (\(x, y). (f x, y)) o (\j. (\(x, y). (x, g y)) (j,j)) ls by MAP_COMPOSE 925 = MAP (\x. (f x, g x)) ls by FUN_EQ_THM 926*) 927val ZIP_MAP_MAP = store_thm( 928 "ZIP_MAP_MAP", 929 ``!ls f g. ZIP ((MAP f ls), (MAP g ls)) = MAP (\x. (f x, g x)) ls``, 930 rw[ZIP_MAP, MAP_COMPOSE] >> 931 qabbrev_tac `f1 = \p. (f (FST p),SND p)` >> 932 qabbrev_tac `f2 = \x. (x,g x)` >> 933 qabbrev_tac `f3 = \x. (f x,g x)` >> 934 `f1 o f2 = f3` by rw[FUN_EQ_THM, Abbr`f1`, Abbr`f2`, Abbr`f3`] >> 935 rw[]); 936 937(* Theorem: MAP2 f (MAP g1 ls) (MAP g2 ls) = MAP (\x. f (g1 x) (g2 x)) ls *) 938(* Proof: 939 Let k = LENGTH ls. 940 Note LENGTH (MAP g1 ls) = k by LENGTH_MAP 941 and LENGTH (MAP g2 ls) = k by LENGTH_MAP 942 MAP2 f (MAP g1 ls) (MAP g2 ls) 943 = MAP (UNCURRY f) (ZIP ((MAP g1 ls), (MAP g2 ls))) by MAP2_MAP 944 = MAP (UNCURRY f) (MAP (\x. (g1 x, g2 x)) ls) by ZIP_MAP_MAP 945 = MAP ((UNCURRY f) o (\x. (g1 x, g2 x))) ls by MAP_COMPOSE 946 = MAP (\x. f (g1 x) (g2 y)) ls by FUN_EQ_THM 947*) 948val MAP2_MAP_MAP = store_thm( 949 "MAP2_MAP_MAP", 950 ``!ls f g1 g2. MAP2 f (MAP g1 ls) (MAP g2 ls) = MAP (\x. f (g1 x) (g2 x)) ls``, 951 rw[MAP2_MAP, ZIP_MAP_MAP, MAP_COMPOSE] >> 952 qabbrev_tac `f1 = UNCURRY f o (\x. (g1 x,g2 x))` >> 953 qabbrev_tac `f2 = \x. f (g1 x) (g2 x)` >> 954 `f1 = f2` by rw[FUN_EQ_THM, Abbr`f1`, Abbr`f2`] >> 955 rw[]); 956 957(* Theorem: EL n (l1 ++ l2) = if n < LENGTH l1 then EL n l1 else EL (n - LENGTH l1) l2 *) 958(* Proof: by EL_APPEND1, EL_APPEND2 *) 959val EL_APPEND = store_thm( 960 "EL_APPEND", 961 ``!n l1 l2. EL n (l1 ++ l2) = if n < LENGTH l1 then EL n l1 else EL (n - LENGTH l1) l2``, 962 rw[EL_APPEND1, EL_APPEND2]); 963 964(* Theorem: (LENGTH (h1::t1) = LENGTH (h2::t2)) /\ 965 (!k. k < LENGTH (h1::t1) ==> P (EL k (h1::t1)) (EL k (h2::t2))) ==> 966 (P h1 h2) /\ (!k. k < LENGTH t1 ==> P (EL k t1) (EL k t2)) *) 967(* Proof: 968 Put k = 0, 969 Then LENGTH (h1::t1) = SUC (LENGTH t1) by LENGTH 970 > 0 by SUC_POS 971 and P (EL 0 (h1::t1)) (EL 0 (h2::t2)) by implication, 0 < LENGTH (h1::t1) 972 or P HD (h1::t1) HD (h2::t2) by EL 973 or P h1 h2 by HD 974 Note k < LENGTH t1 975 ==> k + 1 < SUC (LENGTH t1) by ADD1 976 = LENGTH (h1::t1) by LENGTH 977 Thus P (EL (k + 1) (h1::t1)) (EL (k + 1) (h2::t2)) by implication 978 or P (EL (PRE (k + 1) t1)) (EL (PRE (k + 1)) t2) by EL_CONS 979 or P (EL k t1) (EL k t2) by PRE, ADD1 980*) 981val EL_ALL_PROPERTY = store_thm( 982 "EL_ALL_PROPERTY", 983 ``!h1 t1 h2 t2 P. (LENGTH (h1::t1) = LENGTH (h2::t2)) /\ 984 (!k. k < LENGTH (h1::t1) ==> P (EL k (h1::t1)) (EL k (h2::t2))) ==> 985 (P h1 h2) /\ (!k. k < LENGTH t1 ==> P (EL k t1) (EL k t2))``, 986 rpt strip_tac >| [ 987 `0 < LENGTH (h1::t1)` by metis_tac[LENGTH, SUC_POS] >> 988 metis_tac[EL, HD], 989 `k + 1 < SUC (LENGTH t1)` by decide_tac >> 990 `k + 1 < LENGTH (h1::t1)` by metis_tac[LENGTH] >> 991 `0 < k + 1 /\ (PRE (k + 1) = k)` by decide_tac >> 992 metis_tac[EL_CONS] 993 ]); 994 995(* Theorem: (l1 ++ l2 = m1 ++ m2) /\ (LENGTH l1 = LENGTH m1) <=> (l1 = m1) /\ (l2 = m2) *) 996(* Proof: 997 By APPEND_EQ_APPEND, 998 ?l. (l1 = m1 ++ l) /\ (m2 = l ++ l2) \/ ?l. (m1 = l1 ++ l) /\ (l2 = l ++ m2). 999 Thus this is to show: 1000 (1) LENGTH (m1 ++ l) = LENGTH m1 ==> m1 ++ l = m1, true since l = [] by LENGTH_APPEND, LENGTH_NIL 1001 (2) LENGTH (m1 ++ l) = LENGTH m1 ==> l2 = l ++ l2, true since l = [] by LENGTH_APPEND, LENGTH_NIL 1002 (3) LENGTH l1 = LENGTH (l1 ++ l) ==> l1 = l1 ++ l, true since l = [] by LENGTH_APPEND, LENGTH_NIL 1003 (4) LENGTH l1 = LENGTH (l1 ++ l) ==> l ++ m2 = m2, true since l = [] by LENGTH_APPEND, LENGTH_NIL 1004*) 1005val APPEND_EQ_APPEND_EQ = store_thm( 1006 "APPEND_EQ_APPEND_EQ", 1007 ``!l1 l2 m1 m2. (l1 ++ l2 = m1 ++ m2) /\ (LENGTH l1 = LENGTH m1) <=> (l1 = m1) /\ (l2 = m2)``, 1008 rw[APPEND_EQ_APPEND] >> 1009 rw[EQ_IMP_THM] >- 1010 fs[] >- 1011 fs[] >- 1012 (fs[] >> 1013 `LENGTH l = 0` by decide_tac >> 1014 fs[]) >> 1015 fs[] >> 1016 `LENGTH l = 0` by decide_tac >> 1017 fs[]); 1018 1019(* 1020LUPDATE_SEM |- (!e n l. LENGTH (LUPDATE e n l) = LENGTH l) /\ 1021 !e n l p. p < LENGTH l ==> EL p (LUPDATE e n l) = if p = n then e else EL p l 1022EL_LUPDATE |- !ys x i k. EL i (LUPDATE x k ys) = if i = k /\ k < LENGTH ys then x else EL i ys 1023LENGTH_LUPDATE |- !x n ys. LENGTH (LUPDATE x n ys) = LENGTH ys 1024*) 1025 1026(* Extract useful theorem from LUPDATE semantics *) 1027val LUPDATE_LEN = save_thm("LUPDATE_LEN", LUPDATE_SEM |> CONJUNCT1); 1028(* val LUPDATE_LEN = |- !e n l. LENGTH (LUPDATE e n l) = LENGTH l: thm *) 1029val LUPDATE_EL = save_thm("LUPDATE_EL", LUPDATE_SEM |> CONJUNCT2); 1030(* val LUPDATE_EL = |- !e n l p. p < LENGTH l ==> EL p (LUPDATE e n l) = if p = n then e else EL p l: thm *) 1031 1032(* Theorem: LUPDATE q n (LUPDATE p n ls) = LUPDATE q n ls *) 1033(* Proof: 1034 Let l1 = LUPDATE q n (LUPDATE p n ls), l2 = LUPDATE q n ls. 1035 By LIST_EQ, this is to show: 1036 (1) LENGTH l1 = LENGTH l2 1037 LENGTH l1 1038 = LENGTH (LUPDATE q n (LUPDATE p n ls)) by notation 1039 = LENGTH (LUPDATE p n ls) by LUPDATE_LEN 1040 = ls by LUPDATE_LEN 1041 = LENGTH (LUPDATE q n ls) by LUPDATE_LEN 1042 = LENGTH l2 by notation 1043 (2) !x. x < LENGTH l1 ==> EL x l1 = EL x l2 1044 EL x l1 1045 = EL x (LUPDATE q n (LUPDATE p n ls)) by notation 1046 = if x = n then q else EL x (LUPDATE p n ls) by LUPDATE_EL 1047 = if x = n then q else (if x = n then p else EL x ls) by LUPDATE_EL 1048 = if x = n then q else EL x ls by simplification 1049 = EL x (LUPDATE q n ls) by LUPDATE_EL 1050 = EL x l2 by notation 1051*) 1052val LUPDATE_SAME_SPOT = store_thm( 1053 "LUPDATE_SAME_SPOT", 1054 ``!ls n p q. LUPDATE q n (LUPDATE p n ls) = LUPDATE q n ls``, 1055 rpt strip_tac >> 1056 qabbrev_tac `l1 = LUPDATE q n (LUPDATE p n ls)` >> 1057 qabbrev_tac `l2 = LUPDATE q n ls` >> 1058 `LENGTH l1 = LENGTH l2` by rw[LUPDATE_LEN, Abbr`l1`, Abbr`l2`] >> 1059 `!x. x < LENGTH l1 ==> (EL x l1 = EL x l2)` by fs[LUPDATE_EL, Abbr`l1`, Abbr`l2`] >> 1060 rw[LIST_EQ]); 1061 1062(* Theorem: m <> n ==> 1063 (LUPDATE q n (LUPDATE p m ls) = LUPDATE p m (LUPDATE q n ls)) *) 1064(* Proof: 1065 Let l1 = LUPDATE q n (LUPDATE p m ls), 1066 l2 = LUPDATE p m (LUPDATE q n ls). 1067 LENGTH l1 1068 = LENGTH (LUPDATE q n (LUPDATE p m ls)) by notation 1069 = LENGTH (LUPDATE p m ls) by LUPDATE_LEN 1070 = LENGTH ls by LUPDATE_LEN 1071 = LENGTH (LUPDATE q n ls) by LUPDATE_LEN 1072 = LENGTH (LUPDATE p m (LUPDATE q n ls)) by LUPDATE_LEN 1073 = LENGTH l2 by notation 1074 !x. x < LENGTH l1 ==> 1075 EL x l1 1076 = EL x ((LUPDATE q n (LUPDATE p m ls)) by notation 1077 = EL x ls if x <> n, x <> m, or p if x = m, q if x = n 1078 by LUPDATE_EL 1079 EL x l2 1080 = EL x ((LUPDATE p m (LUPDATE q n ls)) by notation 1081 = EL x ls if x <> m, x <> n, or q if x = n, p if x = m 1082 by LUPDATE_EL 1083 = EL x l1 1084 Hence l1 = l2 by LIST_EQ 1085*) 1086val LUPDATE_DIFF_SPOT = store_thm( 1087 "LUPDATE_DIFF_SPOT", 1088 `` !ls m n p q. m <> n ==> 1089 (LUPDATE q n (LUPDATE p m ls) = LUPDATE p m (LUPDATE q n ls))``, 1090 rpt strip_tac >> 1091 qabbrev_tac `l1 = LUPDATE q n (LUPDATE p m ls)` >> 1092 qabbrev_tac `l2 = LUPDATE p m (LUPDATE q n ls)` >> 1093 irule LIST_EQ >> 1094 rw[LUPDATE_EL, Abbr`l1`, Abbr`l2`]); 1095 1096(* Theorem: EL (LENGTH ls) (ls ++ h::t) = h *) 1097(* Proof: 1098 Let l2 = h::t. 1099 Note ~NULL l2 by NULL 1100 so EL (LENGTH ls) (ls ++ h::t) 1101 = EL (LENGTH ls) (ls ++ l2) by notation 1102 = HD l2 by EL_LENGTH_APPEND 1103 = HD (h::t) = h by notation 1104*) 1105val EL_LENGTH_APPEND_0 = store_thm( 1106 "EL_LENGTH_APPEND_0", 1107 ``!ls h t. EL (LENGTH ls) (ls ++ h::t) = h``, 1108 rw[EL_LENGTH_APPEND]); 1109 1110(* Theorem: EL (LENGTH ls + 1) (ls ++ h::k::t) = k *) 1111(* Proof: 1112 Let l1 = ls ++ [h]. 1113 Then LENGTH l1 = LENGTH ls + 1 by LENGTH 1114 Note ls ++ h::k::t = l1 ++ k::t by APPEND 1115 EL (LENGTH ls + 1) (ls ++ h::k::t) 1116 = EL (LENGTH l1) (l1 ++ k::t) by above 1117 = k by EL_LENGTH_APPEND_0 1118*) 1119val EL_LENGTH_APPEND_1 = store_thm( 1120 "EL_LENGTH_APPEND_1", 1121 ``!ls h k t. EL (LENGTH ls + 1) (ls ++ h::k::t) = k``, 1122 rpt strip_tac >> 1123 qabbrev_tac `l1 = ls ++ [h]` >> 1124 `LENGTH l1 = LENGTH ls + 1` by rw[Abbr`l1`] >> 1125 `ls ++ h::k::t = l1 ++ k::t` by rw[Abbr`l1`] >> 1126 metis_tac[EL_LENGTH_APPEND_0]); 1127 1128(* Theorem: LUPDATE a (LENGTH ls) (ls ++ (h::t)) = ls ++ (a::t) *) 1129(* Proof: 1130 LUPDATE a (LENGTH ls) (ls ++ h::t) 1131 = ls ++ LUPDATE a (LENGTH ls - LENGTH ls) (h::t) by LUPDATE_APPEND2 1132 = ls ++ LUPDATE a 0 (h::t) by arithmetic 1133 = ls ++ (a::t) by LUPDATE_def 1134*) 1135val LUPDATE_APPEND_0 = store_thm( 1136 "LUPDATE_APPEND_0", 1137 ``!ls a h t. LUPDATE a (LENGTH ls) (ls ++ (h::t)) = ls ++ (a::t)``, 1138 rw_tac std_ss[LUPDATE_APPEND2, LUPDATE_def]); 1139 1140(* Theorem: LUPDATE b (LENGTH ls + 1) (ls ++ h::k::t) = ls ++ h::b::t *) 1141(* Proof: 1142 LUPDATE b (LENGTH ls + 1) (ls ++ h::k::t) 1143 = ls ++ LUPDATE b (LENGTH ls + 1 - LENGTH ls) (h::k::t) by LUPDATE_APPEND2 1144 = ls ++ LUPDATE b 1 (h::k::t) by arithmetic 1145 = ls ++ (h::b::t) by LUPDATE_def 1146*) 1147val LUPDATE_APPEND_1 = store_thm( 1148 "LUPDATE_APPEND_1", 1149 ``!ls b h k t. LUPDATE b (LENGTH ls + 1) (ls ++ h::k::t) = ls ++ h::b::t``, 1150 rpt strip_tac >> 1151 `LUPDATE b 1 (h::k::t) = h::LUPDATE b 0 (k::t)` by rw[GSYM LUPDATE_def] >> 1152 `_ = h::b::t` by rw[LUPDATE_def] >> 1153 `LUPDATE b (LENGTH ls + 1) (ls ++ h::k::t) = 1154 ls ++ LUPDATE b (LENGTH ls + 1 - LENGTH ls) (h::k::t)` by metis_tac[LUPDATE_APPEND2, DECIDE``n <= n + 1``] >> 1155 fs[]); 1156 1157(* Theorem: LUPDATE b (LENGTH ls + 1) 1158 (LUPDATE a (LENGTH ls) (ls ++ h::k::t)) = ls ++ a::b::t *) 1159(* Proof: 1160 Let l1 = LUPDATE a (LENGTH ls) (ls ++ h::k::t) 1161 = ls ++ a::k::t by LUPDATE_APPEND_0 1162 LUPDATE b (LENGTH ls + 1) l1 1163 = LUPDATE b (LENGTH ls + 1) (ls ++ a::k::t) 1164 = ls ++ a::b::t by LUPDATE_APPEND2_1 1165*) 1166val LUPDATE_APPEND_0_1 = store_thm( 1167 "LUPDATE_APPEND_0_1", 1168 ``!ls a b h k t. 1169 LUPDATE b (LENGTH ls + 1) 1170 (LUPDATE a (LENGTH ls) (ls ++ h::k::t)) = ls ++ a::b::t``, 1171 rw_tac std_ss[LUPDATE_APPEND_0, LUPDATE_APPEND_1]); 1172 1173(* ------------------------------------------------------------------------- *) 1174(* DROP and TAKE *) 1175(* ------------------------------------------------------------------------- *) 1176 1177(* Note: There is TAKE_LENGTH_ID, but no DROP_LENGTH_NIL, now have DROP_LENGTH_TOO_LONG *) 1178 1179(* Theorem: DROP (LENGTH l) l = [] *) 1180(* Proof: 1181 By induction on l. 1182 Base case: DROP (LENGTH []) [] = [] 1183 True by DROP_def: DROP n [] = []. 1184 Step case: DROP (LENGTH l) l = [] ==> 1185 !h. DROP (LENGTH (h::l)) (h::l) = [] 1186 Since LENGTH (h::l) = SUC (LENGTH l) by LENGTH 1187 so LENGTH (h::l) <> 0 by NOT_SUC 1188 and SUC (LENGTH l) - 1 = LENGTH l by SUC_SUB1 1189 DROP (LENGTH (h::l) (h::l) 1190 = DROP (LENGTH l) l by DROP_def 1191 = [] by induction hypothesis 1192*) 1193val DROP_LENGTH_NIL = store_thm( 1194 "DROP_LENGTH_NIL", 1195 ``!l. DROP (LENGTH l) l = []``, 1196 Induct >> rw[]); 1197 1198(* Theorem: n < LENGTH ls ==> (HD (DROP n ls) = EL n ls) *) 1199(* Proof: 1200 HD (DROP n ls) 1201 = HD (EL n ls :: DROP (n + 1) ls) by DROP_EL_CONS, n < LENGTH ls 1202 = EL n ls 1203*) 1204val HD_DROP = store_thm( 1205 "HD_DROP", 1206 ``!ls n. n < LENGTH ls ==> (HD (DROP n ls) = EL n ls)``, 1207 rw[DROP_EL_CONS]); 1208 1209(* Theorem: x <> [] ==> (TAKE 1 (x ++ y) = TAKE 1 x) *) 1210(* Proof: 1211 x <> [] means ?h t. x = h::t by list_CASES 1212 TAKE 1 (x ++ y) 1213 = TAKE 1 ((h::t) ++ y) 1214 = TAKE 1 (h:: t ++ y) by APPEND 1215 = h::TAKE 0 (t ++ y) by TAKE_def 1216 = h::TAKE 0 t by TAKE_0 1217 = TAKE 1 (h::t) by TAKE_def 1218*) 1219val TAKE_1_APPEND = store_thm( 1220 "TAKE_1_APPEND", 1221 ``!x y. x <> [] ==> (TAKE 1 (x ++ y) = TAKE 1 x)``, 1222 Cases_on `x`>> rw[]); 1223 1224(* Theorem: x <> [] ==> (DROP 1 (x ++ y) = (DROP 1 x) ++ y) *) 1225(* Proof: 1226 x <> [] means ?h t. x = h::t by list_CASES 1227 DROP 1 (x ++ y) 1228 = DROP 1 ((h::t) ++ y) 1229 = DROP 1 (h:: t ++ y) by APPEND 1230 = DROP 0 (t ++ y) by DROP_def 1231 = t ++ y by DROP_0 1232 = (DROP 1 (h::t)) ++ y by DROP_def 1233*) 1234val DROP_1_APPEND = store_thm( 1235 "DROP_1_APPEND", 1236 ``!x y. x <> [] ==> (DROP 1 (x ++ y) = (DROP 1 x) ++ y)``, 1237 Cases_on `x` >> rw[]); 1238 1239(* Theorem: DROP (SUC n) x = DROP 1 (DROP n x) *) 1240(* Proof: 1241 By induction on x. 1242 Base case: !n. DROP (SUC n) [] = DROP 1 (DROP n []) 1243 LHS = DROP (SUC n) [] = [] by DROP_def 1244 RHS = DROP 1 (DROP n []) 1245 = DROP 1 [] by DROP_def 1246 = [] = LHS by DROP_def 1247 Step case: !n. DROP (SUC n) x = DROP 1 (DROP n x) ==> 1248 !h n. DROP (SUC n) (h::x) = DROP 1 (DROP n (h::x)) 1249 If n = 0, 1250 LHS = DROP (SUC 0) (h::x) 1251 = DROP 1 (h::x) by ONE 1252 RHS = DROP 1 (DROP 0 (h::x)) 1253 = DROP 1 (h::x) = LHS by DROP_0 1254 If n <> 0, 1255 LHS = DROP (SUC n) (h::x) 1256 = DROP n x by DROP_def 1257 RHS = DROP 1 (DROP n (h::x) 1258 = DROP 1 (DROP (n-1) x) by DROP_def 1259 = DROP (SUC (n-1)) x by induction hypothesis 1260 = DROP n x = LHS by SUC (n-1) = n, n <> 0. 1261*) 1262val DROP_SUC = store_thm( 1263 "DROP_SUC", 1264 ``!n x. DROP (SUC n) x = DROP 1 (DROP n x)``, 1265 Induct_on `x` >> 1266 rw[DROP_def] >> 1267 `n = SUC (n-1)` by decide_tac >> 1268 metis_tac[]); 1269 1270(* Theorem: TAKE (SUC n) x = (TAKE n x) ++ (TAKE 1 (DROP n x)) *) 1271(* Proof: 1272 By induction on x. 1273 Base case: !n. TAKE (SUC n) [] = TAKE n [] ++ TAKE 1 (DROP n []) 1274 LHS = TAKE (SUC n) [] = [] by TAKE_def 1275 RHS = TAKE n [] ++ TAKE 1 (DROP n []) 1276 = [] ++ TAKE 1 [] by TAKE_def, DROP_def 1277 = TAKE 1 [] by APPEND 1278 = [] = LHS by TAKE_def 1279 Step case: !n. TAKE (SUC n) x = TAKE n x ++ TAKE 1 (DROP n x) ==> 1280 !h n. TAKE (SUC n) (h::x) = TAKE n (h::x) ++ TAKE 1 (DROP n (h::x)) 1281 If n = 0, 1282 LHS = TAKE (SUC 0) (h::x) 1283 = TAKE 1 (h::x) by ONE 1284 RHS = TAKE 0 (h::x) ++ TAKE 1 (DROP 0 (h::x)) 1285 = [] ++ TAKE 1 (h::x) by TAKE_def, DROP_def 1286 = TAKE 1 (h::x) = LHS by APPEND 1287 If n <> 0, 1288 LHS = TAKE (SUC n) (h::x) 1289 = h :: TAKE n x by TAKE_def 1290 RHS = TAKE n (h::x) ++ TAKE 1 (DROP n (h::x)) 1291 = (h:: TAKE (n-1) x) ++ TAKE 1 (DROP (n-1) x) by TAKE_def, DROP_def, n <> 0. 1292 = h :: (TAKE (n-1) x ++ TAKE 1 (DROP (n-1) x)) by APPEND 1293 = h :: TAKE (SUC (n-1)) x by induction hypothesis 1294 = h :: TAKE n x by SUC (n-1) = n, n <> 0. 1295*) 1296val TAKE_SUC = store_thm( 1297 "TAKE_SUC", 1298 ``!n x. TAKE (SUC n) x = (TAKE n x) ++ (TAKE 1 (DROP n x))``, 1299 Induct_on `x` >> 1300 rw[TAKE_def, DROP_def] >> 1301 `n = SUC (n-1)` by decide_tac >> 1302 metis_tac[]); 1303 1304(* Theorem: k < LENGTH x ==> (TAKE (SUC k) x = SNOC (EL k x) (TAKE k x)) *) 1305(* Proof: 1306 By induction on k. 1307 Base case: !x. 0 < LENGTH x ==> (TAKE (SUC 0) x = SNOC (EL 0 x) (TAKE 0 x)) 1308 0 < LENGTH x 1309 ==> ?h t. x = h::t by LENGTH_NIL, list_CASES 1310 LHS = TAKE (SUC 0) x 1311 = TAKE 1 (h::t) by ONE 1312 = h::TAKE 0 t by TAKE_def 1313 = h::[] by TAKE_0 1314 = [h] 1315 = SNOC h [] by SNOC 1316 = SNOC h (TAKE 0 (h::t)) by TAKE_0 1317 = SNOC (EL 0 (h::t)) (TAKE 0 (h::t)) by EL 1318 = RHS 1319 Step case: !x. k < LENGTH x ==> (TAKE (SUC k) x = SNOC (EL k x) (TAKE k x)) ==> 1320 !x. SUC k < LENGTH x ==> (TAKE (SUC (SUC k)) x = SNOC (EL (SUC k) x) (TAKE (SUC k) x)) 1321 Since 0 < SUC k by prim_recTheory.LESS_0 1322 0 < LENGTH x by LESS_TRANS 1323 ==> ?h t. x = h::t by LENGTH_NIL, list_CASES 1324 and LENGTH (h::t) = SUC (LENGTH t) by LENGTH 1325 hence k < LENGTH t by LESS_MONO_EQ 1326 LHS = TAKE (SUC (SUC k)) (h::t) 1327 = h :: TAKE (SUC k) t by TAKE_def 1328 = h :: SNOC (EL k t) (TAKE k t) by induction hypothesis, k < LENGTH t. 1329 = SNOC (EL k t) (h :: TAKE k t) by SNOC 1330 = SNOC (EL (SUC k) (h::t)) (h :: TAKE k t) by EL_restricted 1331 = SNOC (EL (SUC k) (h::t)) (TAKE (SUC k) (h::t)) by TAKE_def 1332 = RHS 1333*) 1334val TAKE_SUC_BY_TAKE = store_thm( 1335 "TAKE_SUC_BY_TAKE", 1336 ``!k x. k < LENGTH x ==> (TAKE (SUC k) x = SNOC (EL k x) (TAKE k x))``, 1337 Induct_on `k` >| [ 1338 rpt strip_tac >> 1339 `LENGTH x <> 0` by decide_tac >> 1340 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >> 1341 rw[], 1342 rpt strip_tac >> 1343 `LENGTH x <> 0` by decide_tac >> 1344 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >> 1345 `k < LENGTH t` by metis_tac[LENGTH, LESS_MONO_EQ] >> 1346 rw_tac std_ss[TAKE_def, SNOC, EL_restricted] 1347 ]); 1348 1349(* Theorem: k < LENGTH x ==> (DROP k x = (EL k x) :: (DROP (SUC k) x)) *) 1350(* Proof: 1351 By induction on k. 1352 Base case: !x. 0 < LENGTH x ==> (DROP 0 x = EL 0 x::DROP (SUC 0) x) 1353 0 < LENGTH x 1354 ==> ?h t. x = h::t by LENGTH_NIL, list_CASES 1355 LHS = DROP 0 (h::t) 1356 = h::t by DROP_0 1357 = (EL 0 (h::t))::t by EL 1358 = (EL 0 (h::t))::(DROP 1 (h::t)) by DROP_def 1359 = EL 0 x::DROP (SUC 0) x by ONE 1360 = RHS 1361 Step case: !x. k < LENGTH x ==> (DROP k x = EL k x::DROP (SUC k) x) ==> 1362 !x. SUC k < LENGTH x ==> (DROP (SUC k) x = EL (SUC k) x::DROP (SUC (SUC k)) x) 1363 Since 0 < SUC k by prim_recTheory.LESS_0 1364 0 < LENGTH x by LESS_TRANS 1365 ==> ?h t. x = h::t by LENGTH_NIL, list_CASES 1366 and LENGTH (h::t) = SUC (LENGTH t) by LENGTH 1367 hence k < LENGTH t by LESS_MONO_EQ 1368 LHS = DROP (SUC k) (h::t) 1369 = DROP k t by DROP_def 1370 = EL k x::DROP (SUC k) x by induction hypothesis 1371 = EL k t :: DROP (SUC (SUC k)) (h::t) by DROP_def 1372 = EL (SUC k) (h::t)::DROP (SUC (SUC k)) (h::t) by EL 1373 = RHS 1374*) 1375val DROP_BY_DROP_SUC = store_thm( 1376 "DROP_BY_DROP_SUC", 1377 ``!k x. k < LENGTH x ==> (DROP k x = (EL k x) :: (DROP (SUC k) x))``, 1378 Induct_on `k` >| [ 1379 rpt strip_tac >> 1380 `LENGTH x <> 0` by decide_tac >> 1381 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >> 1382 rw[], 1383 rpt strip_tac >> 1384 `LENGTH x <> 0` by decide_tac >> 1385 `?h t. x = h::t` by metis_tac[LENGTH_NIL, list_CASES] >> 1386 `k < LENGTH t` by metis_tac[LENGTH, LESS_MONO_EQ] >> 1387 rw[] 1388 ]); 1389 1390(* Theorem: n < LENGTH ls ==> ?u. DROP n ls = [EL n ls] ++ u *) 1391(* Proof: 1392 By induction on n. 1393 Base: !ls. 0 < LENGTH ls ==> ?u. DROP 0 ls = [EL 0 ls] ++ u 1394 Note LENGTH ls <> 0 by 0 < LENGTH ls 1395 ==> ls <> [] by LENGTH_NIL 1396 ==> ?h t. ls = h::t by list_CASES 1397 DROP 0 ls 1398 = ls by DROP_0 1399 = [h] ++ t by ls = h::t, CONS_APPEND 1400 = [EL 0 ls] ++ t by EL 1401 Take u = t. 1402 Step: !ls. n < LENGTH ls ==> ?u. DROP n ls = [EL n ls] ++ u ==> 1403 !ls. SUC n < LENGTH ls ==> ?u. DROP (SUC n) ls = [EL (SUC n) ls] ++ u 1404 Note LENGTH ls <> 0 by SUC n < LENGTH ls 1405 ==> ?h t. ls = h::t by list_CASES, LENGTH_NIL 1406 Now LENGTH ls = SUC (LENGTH t) by LENGTH 1407 ==> n < LENGTH t by SUC n < SUC (LENGTH t) 1408 Thus ?u. DROP n t = [EL n t] ++ u by induction hypothesis 1409 1410 DROP (SUC n) ls 1411 = DROP (SUC n) (h::t) by ls = h::t 1412 = DROP n t by DROP_def 1413 = [EL n t] ++ u by above 1414 = [EL (SUC n) (h::t)] ++ u by EL_restricted 1415 Take this u. 1416*) 1417val DROP_HEAD_ELEMENT = store_thm( 1418 "DROP_HEAD_ELEMENT", 1419 ``!ls n. n < LENGTH ls ==> ?u. DROP n ls = [EL n ls] ++ u``, 1420 Induct_on `n` >| [ 1421 rpt strip_tac >> 1422 `LENGTH ls <> 0` by decide_tac >> 1423 `?h t. ls = h::t` by metis_tac[list_CASES, LENGTH_NIL] >> 1424 rw[], 1425 rw[] >> 1426 `LENGTH ls <> 0` by decide_tac >> 1427 `?h t. ls = h::t` by metis_tac[list_CASES, LENGTH_NIL] >> 1428 `LENGTH ls = SUC (LENGTH t)` by rw[] >> 1429 `n < LENGTH t` by decide_tac >> 1430 `?u. DROP n t = [EL n t] ++ u` by rw[] >> 1431 rw[] 1432 ]); 1433 1434(* Theorem: DROP n (TAKE n ls) = [] *) 1435(* Proof: 1436 If n <= LENGTH ls, 1437 Then LENGTH (TAKE n ls) = n by LENGTH_TAKE_EQ 1438 Thus DROP n (TAKE n ls) = [] by DROP_LENGTH_TOO_LONG 1439 If LENGTH ls < n 1440 Then LENGTH (TAKE n ls) = LENGTH ls by LENGTH_TAKE_EQ 1441 Thus DROP n (TAKE n ls) = [] by DROP_LENGTH_TOO_LONG 1442*) 1443val DROP_TAKE_EQ_NIL = store_thm( 1444 "DROP_TAKE_EQ_NIL", 1445 ``!ls n. DROP n (TAKE n ls) = []``, 1446 rw[LENGTH_TAKE_EQ, DROP_LENGTH_TOO_LONG]); 1447 1448(* Theorem: TAKE m (DROP n ls) = DROP n (TAKE (n + m) ls) *) 1449(* Proof: 1450 If n <= LENGTH ls, 1451 Then LENGTH (TAKE n ls) = n by LENGTH_TAKE_EQ, n <= LENGTH ls 1452 DROP n (TAKE (n + m) ls) 1453 = DROP n (TAKE n ls ++ TAKE m (DROP n ls)) by TAKE_SUM 1454 = DROP n (TAKE n ls) ++ DROP (n - LENGTH (TAKE n ls)) (TAKE m (DROP n ls)) by DROP_APPEND 1455 = [] ++ DROP (n - LENGTH (TAKE n ls)) (TAKE m (DROP n ls)) by DROP_TAKE_EQ_NIL 1456 = DROP (n - LENGTH (TAKE n ls)) (TAKE m (DROP n ls)) by APPEND 1457 = DROP 0 (TAKE m (DROP n ls)) by above 1458 = TAKE m (DROP n ls) by DROP_0 1459 If LENGTH ls < n, 1460 Then DROP n ls = [] by DROP_LENGTH_TOO_LONG 1461 and TAKE (n + m) ls = ls by TAKE_LENGTH_TOO_LONG 1462 DROP n (TAKE (n + m) ls) 1463 = DROP n ls by TAKE_LENGTH_TOO_LONG 1464 = [] by DROP_LENGTH_TOO_LONG 1465 = TAKE m [] by TAKE_nil 1466 = TAKE m (DROP n ls) by DROP_LENGTH_TOO_LONG 1467*) 1468val TAKE_DROP_SWAP = store_thm( 1469 "TAKE_DROP_SWAP", 1470 ``!ls m n. TAKE m (DROP n ls) = DROP n (TAKE (n + m) ls)``, 1471 rpt strip_tac >> 1472 Cases_on `n <= LENGTH ls` >| [ 1473 qabbrev_tac `x = TAKE m (DROP n ls)` >> 1474 `DROP n (TAKE (n + m) ls) = DROP n (TAKE n ls ++ x)` by rw[TAKE_SUM, Abbr`x`] >> 1475 `_ = DROP n (TAKE n ls) ++ DROP (n - LENGTH (TAKE n ls)) x` by rw[DROP_APPEND] >> 1476 `_ = DROP (n - LENGTH (TAKE n ls)) x` by rw[DROP_TAKE_EQ_NIL] >> 1477 `_ = DROP 0 x` by rw[LENGTH_TAKE_EQ] >> 1478 rw[], 1479 `DROP n ls = []` by rw[DROP_LENGTH_TOO_LONG] >> 1480 `TAKE (n + m) ls = ls` by rw[TAKE_LENGTH_TOO_LONG] >> 1481 rw[] 1482 ]); 1483 1484(* Theorem: TAKE (LENGTH l1) (LUPDATE x (LENGTH l1 + k) (l1 ++ l2)) = l1 *) 1485(* Proof: 1486 TAKE (LENGTH l1) (LUPDATE x (LENGTH l1 + k) (l1 ++ l2)) 1487 = TAKE (LENGTH l1) (l1 ++ LUPDATE x k l2) by LUPDATE_APPEND2 1488 = l1 by TAKE_LENGTH_APPEND 1489*) 1490val TAKE_LENGTH_APPEND2 = store_thm( 1491 "TAKE_LENGTH_APPEND2", 1492 ``!l1 l2 x k. TAKE (LENGTH l1) (LUPDATE x (LENGTH l1 + k) (l1 ++ l2)) = l1``, 1493 rw_tac std_ss[LUPDATE_APPEND2, TAKE_LENGTH_APPEND]); 1494 1495(* Theorem: LENGTH (TAKE n l) <= LENGTH l *) 1496(* Proof: by LENGTH_TAKE_EQ *) 1497val LENGTH_TAKE_LE = store_thm( 1498 "LENGTH_TAKE_LE", 1499 ``!n l. LENGTH (TAKE n l) <= LENGTH l``, 1500 rw[LENGTH_TAKE_EQ]); 1501 1502(* ------------------------------------------------------------------------- *) 1503(* List Rotation. *) 1504(* ------------------------------------------------------------------------- *) 1505 1506(* Define rotation of a list *) 1507val rotate_def = Define ` 1508 rotate n l = DROP n l ++ TAKE n l 1509`; 1510 1511(* Theorem: Rotate shifts element 1512 rotate n l = EL n l::(DROP (SUC n) l ++ TAKE n l) *) 1513(* Proof: 1514 h h t t t t t t --> t t t t t h h 1515 k k 1516 TAKE 2 x = h h 1517 DROP 2 x = t t t t t t 1518 k 1519 DROP 2 x ++ TAKE 2 x has element k at front. 1520 1521 Proof: by induction on l. 1522 Base case: !n. n < LENGTH [] ==> (DROP n [] = EL n []::DROP (SUC n) []) 1523 Since n < LENGTH [] = 0 is F, this is true. 1524 Step case: !h n. n < LENGTH (h::l) ==> (DROP n (h::l) = EL n (h::l)::DROP (SUC n) (h::l)) 1525 i.e. n <> 0 /\ n < SUC (LENGTH l) ==> DROP (n - 1) l = EL n (h::l)::DROP n l by DROP_def 1526 n <> 0 means ?j. n = SUC j < SUC (LENGTH l), so j < LENGTH l. 1527 LHS = DROP (SUC j - 1) l 1528 = DROP j l by SUC j - 1 = j 1529 = EL j l :: DROP (SUC j) l by induction hypothesis 1530 RHS = EL (SUC j) (h::l) :: DROP (SUC (SUC j)) (h::l) 1531 = EL j l :: DROP (SUC j) l by EL, DROP_def 1532 = LHS 1533*) 1534val rotate_shift_element = store_thm( 1535 "rotate_shift_element", 1536 ``!l n. n < LENGTH l ==> (rotate n l = EL n l::(DROP (SUC n) l ++ TAKE n l))``, 1537 rw[rotate_def] >> 1538 pop_assum mp_tac >> 1539 qid_spec_tac `n` >> 1540 Induct_on `l` >- 1541 rw[] >> 1542 rw[DROP_def] >- 1543 rw[EL_CONS, PRE_SUB1] >> 1544 `?j. n = SUC j` by metis_tac[num_CASES] >> 1545 `j < LENGTH l` by decide_tac >> 1546 `SUC j - 1 = j` by decide_tac >> 1547 rw[DROP_def, TAKE_def]); 1548(* Michael's proof *) 1549val rotate_shift_element = store_thm( 1550 "rotate_shift_element", 1551 ``!l n. n < LENGTH l ==> (rotate n l = EL n l::(DROP (SUC n) l ++ TAKE n l))``, 1552 rw[rotate_def] >> 1553 pop_assum mp_tac >> 1554 qid_spec_tac `n` >> 1555 Induct_on `l` >- 1556 rw[] >> 1557 rw[DROP_def] >> Cases_on `n` >> fs[]); 1558 1559(* Theorem: rotate 0 l = l *) 1560(* Proof: 1561 rotate 0 l 1562 = DROP 0 l ++ TAKE 0 l by rotate_def 1563 = l ++ [] by DROP_def, TAKE_def 1564 = l by APPEND 1565*) 1566val rotate_0 = store_thm( 1567 "rotate_0", 1568 ``!l. rotate 0 l = l``, 1569 rw[rotate_def]); 1570 1571(* Theorem: rotate n [] = [] *) 1572(* Proof: 1573 rotate n [] 1574 = DROP n [] ++ TAKE n [] by rotate_def 1575 = [] ++ [] by DROP_def, TAKE_def 1576 = [] by APPEND 1577*) 1578val rotate_nil = store_thm( 1579 "rotate_nil", 1580 ``!n. rotate n [] = []``, 1581 rw[rotate_def]); 1582 1583(* Theorem: rotate (LENGTH l) l = l *) 1584(* Proof: 1585 rotate (LENGTH l) l 1586 = DROP (LENGTH l) l ++ TAKE (LENGTH l) l by rotate_def 1587 = [] ++ TAKE (LENGTH l) l by DROP_LENGTH_NIL 1588 = [] ++ l by TAKE_LENGTH_ID 1589 = l 1590*) 1591val rotate_full = store_thm( 1592 "rotate_full", 1593 ``!l. rotate (LENGTH l) l = l``, 1594 rw[rotate_def, DROP_LENGTH_NIL]); 1595 1596(* Theorem: n < LENGTH l ==> rotate (SUC n) l = rotate 1 (rotate n l) *) 1597(* Proof: 1598 Since n < LENGTH l, l <> [] by LENGTH_NIL. 1599 Thus DROP n l <> [] by DROP_EQ_NIL (need n < LENGTH l) 1600 Expand by rotate_def, this is to show: 1601 DROP (SUC n) l ++ TAKE (SUC n) l = DROP 1 (DROP n l ++ TAKE n l) ++ TAKE 1 (DROP n l ++ TAKE n l) 1602 LHS = DROP (SUC n) l ++ TAKE (SUC n) l 1603 = DROP 1 (DROP n l) ++ (TAKE n l ++ TAKE 1 (DROP n l)) by DROP_SUC, TAKE_SUC 1604 Since DROP n l <> [] from above, 1605 RHS = DROP 1 (DROP n l ++ TAKE n l) ++ TAKE 1 (DROP n l ++ TAKE n l) 1606 = DROP 1 (DROP n l) ++ (TAKE n l ++ TAKE 1 (DROP n l)) by DROP_1_APPEND, TAKE_1_APPEND 1607 = LHS 1608*) 1609val rotate_suc = store_thm( 1610 "rotate_suc", 1611 ``!l n. n < LENGTH l ==> (rotate (SUC n) l = rotate 1 (rotate n l))``, 1612 rpt strip_tac >> 1613 `LENGTH l <> 0` by decide_tac >> 1614 `l <> []` by metis_tac[LENGTH_NIL] >> 1615 `DROP n l <> []` by simp[DROP_EQ_NIL] >> 1616 rw[rotate_def, DROP_1_APPEND, TAKE_1_APPEND, DROP_SUC, TAKE_SUC]); 1617 1618(* Theorem: Rotate keeps LENGTH (of necklace): LENGTH (rotate n l) = LENGTH l *) 1619(* Proof: 1620 LENGTH (rotate n l) 1621 = LENGTH (DROP n l ++ TAKE n l) by rotate_def 1622 = LENGTH (DROP n l) + LENGTH (TAKE n l) by LENGTH_APPEND 1623 = LENGTH (TAKE n l) + LENGTH (DROP n l) by arithmetic 1624 = LENGTH (TAKE n l ++ DROP n l) by LENGTH_APPEND 1625 = LENGTH l by TAKE_DROP 1626*) 1627val rotate_same_length = store_thm( 1628 "rotate_same_length", 1629 ``!l n. LENGTH (rotate n l) = LENGTH l``, 1630 rpt strip_tac >> 1631 `LENGTH (rotate n l) = LENGTH (DROP n l ++ TAKE n l)` by rw[rotate_def] >> 1632 `_ = LENGTH (DROP n l) + LENGTH (TAKE n l)` by rw[] >> 1633 `_ = LENGTH (TAKE n l) + LENGTH (DROP n l)` by rw[ADD_COMM] >> 1634 `_ = LENGTH (TAKE n l ++ DROP n l)` by rw[] >> 1635 rw_tac std_ss[TAKE_DROP]); 1636 1637(* Theorem: Rotate keeps SET (of elements): set (rotate n l) = set l *) 1638(* Proof: 1639 set (rotate n l) 1640 = set (DROP n l ++ TAKE n l) by rotate_def 1641 = set (DROP n l) UNION set (TAKE n l) by LIST_TO_SET_APPEND 1642 = set (TAKE n l) UNION set (DROP n l) by UNION_COMM 1643 = set (TAKE n l ++ DROP n l) by LIST_TO_SET_APPEND 1644 = set l by TAKE_DROP 1645*) 1646val rotate_same_set = store_thm( 1647 "rotate_same_set", 1648 ``!l n. set (rotate n l) = set l``, 1649 rpt strip_tac >> 1650 `set (rotate n l) = set (DROP n l ++ TAKE n l)` by rw[rotate_def] >> 1651 `_ = set (DROP n l) UNION set (TAKE n l)` by rw[] >> 1652 `_ = set (TAKE n l) UNION set (DROP n l)` by rw[UNION_COMM] >> 1653 `_ = set (TAKE n l ++ DROP n l)` by rw[] >> 1654 rw_tac std_ss[TAKE_DROP]); 1655 1656(* Theorem: n + m <= LENGTH l ==> rotate n (rotate m l) = rotate (n + m) l *) 1657(* Proof: 1658 By induction on n. 1659 Base case: !m l. 0 + m <= LENGTH l ==> (rotate 0 (rotate m l) = rotate (0 + m) l) 1660 rotate 0 (rotate m l) 1661 = rotate m l by rotate_0 1662 = rotate (0 + m) l by ADD 1663 Step case: !m l. SUC n + m <= LENGTH l ==> (rotate (SUC n) (rotate m l) = rotate (SUC n + m) l) 1664 rotate (SUC n) (rotate m l) 1665 = rotate 1 (rotate n (rotate m l)) by rotate_suc 1666 = rotate 1 (rotate (n + m) l) by induction hypothesis 1667 = rotate (SUC (n + m)) l by rotate_suc 1668 = rotate (SUC n + m) l by ADD_CLAUSES 1669*) 1670val rotate_add = store_thm( 1671 "rotate_add", 1672 ``!n m l. n + m <= LENGTH l ==> (rotate n (rotate m l) = rotate (n + m) l)``, 1673 Induct >- 1674 rw[rotate_0] >> 1675 rw[] >> 1676 `LENGTH (rotate m l) = LENGTH l` by rw[rotate_same_length] >> 1677 `LENGTH (rotate (n + m) l) = LENGTH l` by rw[rotate_same_length] >> 1678 `n < LENGTH l /\ n + m < LENGTH l /\ n + m <= LENGTH l` by decide_tac >> 1679 rw[rotate_suc, ADD_CLAUSES]); 1680 1681(* Theorem: !k. k < LENGTH l ==> rotate (LENGTH l - k) (rotate k l) = l *) 1682(* Proof: 1683 Since k < LENGTH l 1684 LENGTH 1 - k + k = LENGTH l <= LENGTH l by EQ_LESS_EQ 1685 rotate (LENGTH l - k) (rotate k l) 1686 = rotate (LENGTH l - k + k) l by rotate_add 1687 = rotate (LENGTH l) l by arithmetic 1688 = l by rotate_full 1689*) 1690val rotate_lcancel = store_thm( 1691 "rotate_lcancel", 1692 ``!k l. k < LENGTH l ==> (rotate (LENGTH l - k) (rotate k l) = l)``, 1693 rpt strip_tac >> 1694 `LENGTH l - k + k = LENGTH l` by decide_tac >> 1695 `LENGTH l <= LENGTH l` by rw[] >> 1696 rw[rotate_add, rotate_full]); 1697 1698(* Theorem: !k. k < LENGTH l ==> rotate k (rotate (LENGTH l - k) l) = l *) 1699(* Proof: 1700 Since k < LENGTH l 1701 k + (LENGTH 1 - k) = LENGTH l <= LENGTH l by EQ_LESS_EQ 1702 rotate k (rotate (LENGTH l - k) l) 1703 = rotate (k + (LENGTH l - k)) l by rotate_add 1704 = rotate (LENGTH l) l by arithmetic 1705 = l by rotate_full 1706*) 1707val rotate_rcancel = store_thm( 1708 "rotate_rcancel", 1709 ``!k l. k < LENGTH l ==> (rotate k (rotate (LENGTH l - k) l) = l)``, 1710 rpt strip_tac >> 1711 `k + (LENGTH l - k) = LENGTH l` by decide_tac >> 1712 `LENGTH l <= LENGTH l` by rw[] >> 1713 rw[rotate_add, rotate_full]); 1714 1715(* ------------------------------------------------------------------------- *) 1716(* List Turn *) 1717(* ------------------------------------------------------------------------- *) 1718 1719(* Define a rotation turn of a list (like a turnstile) *) 1720val turn_def = Define` 1721 turn l = if l = [] then [] else ((LAST l) :: (FRONT l)) 1722`; 1723 1724(* Theorem: turn [] = [] *) 1725(* Proof: by turn_def *) 1726val turn_nil = store_thm( 1727 "turn_nil", 1728 ``turn [] = []``, 1729 rw[turn_def]); 1730 1731(* Theorem: l <> [] ==> (turn l = (LAST l) :: (FRONT l)) *) 1732(* Proof: by turn_def *) 1733val turn_not_nil = store_thm( 1734 "turn_not_nil", 1735 ``!l. l <> [] ==> (turn l = (LAST l) :: (FRONT l))``, 1736 rw[turn_def]); 1737 1738(* Theorem: LENGTH (turn l) = LENGTH l *) 1739(* Proof: 1740 If l = [], 1741 LENGTH (turn []) = LENGTH [] by turn_def 1742 If l <> [], 1743 Then LENGTH l <> 0 by LENGTH_NIL 1744 LENGTH (turn l) 1745 = LENGTH ((LAST l) :: (FRONT l)) by turn_def 1746 = SUC (LENGTH (FRONT l)) by LENGTH 1747 = SUC (PRE (LENGTH l)) by LENGTH_FRONT 1748 = LENGTH l by SUC_PRE, 0 < LENGTH l 1749*) 1750val turn_length = store_thm( 1751 "turn_length", 1752 ``!l. LENGTH (turn l) = LENGTH l``, 1753 metis_tac[turn_def, list_CASES, LENGTH, LENGTH_FRONT_CONS, SUC_PRE, NOT_ZERO_LT_ZERO]); 1754 1755(* Theorem: (turn p = []) <=> (p = []) *) 1756(* Proof: 1757 turn p = [] 1758 <=> LENGTH (turn p) = 0 by LENGTH_NIL 1759 <=> LENGTH p = 0 by turn_length 1760 <=> p = [] by LENGTH_NIL 1761*) 1762val turn_eq_nil = store_thm( 1763 "turn_eq_nil", 1764 ``!p. (turn p = []) <=> (p = [])``, 1765 metis_tac[turn_length, LENGTH_NIL]); 1766 1767(* Theorem: ls <> [] ==> (HD (turn ls) = LAST ls) *) 1768(* Proof: 1769 HD (turn ls) 1770 = HD (LAST ls :: FRONT ls) by turn_def, ls <> [] 1771 = LAST ls by HD 1772*) 1773val head_turn = store_thm( 1774 "head_turn", 1775 ``!ls. ls <> [] ==> (HD (turn ls) = LAST ls)``, 1776 rw[turn_def]); 1777 1778(* Theorem: ls <> [] ==> (TL (turn ls) = FRONT ls) *) 1779(* Proof: 1780 TL (turn ls) 1781 = TL (LAST ls :: FRONT ls) by turn_def, ls <> [] 1782 = FRONT ls by TL 1783*) 1784Theorem tail_turn: 1785 !ls. ls <> [] ==> (TL (turn ls) = FRONT ls) 1786Proof 1787 rw[turn_def] 1788QED 1789 1790(* Theorem: turn (SNOC x ls) = x :: ls *) 1791(* Proof: 1792 Note (SNOC x ls) <> [] by NOT_SNOC_NIL 1793 turn (SNOC x ls) 1794 = LAST (SNOC x ls) :: FRONT (SNOC x ls) by turn_def 1795 = x :: FRONT (SNOC x ls) by LAST_SNOC 1796 = x :: ls by FRONT_SNOC 1797*) 1798Theorem turn_snoc: 1799 !ls x. turn (SNOC x ls) = x :: ls 1800Proof 1801 metis_tac[NOT_SNOC_NIL, turn_def, LAST_SNOC, FRONT_SNOC] 1802QED 1803 1804(* Overload repeated turns *) 1805val _ = overload_on("turn_exp", ``\l n. FUNPOW turn n l``); 1806 1807(* Theorem: turn_exp l 0 = l *) 1808(* Proof: 1809 turn_exp l 0 1810 = FUNPOW turn 0 l by notation 1811 = l by FUNPOW 1812*) 1813val turn_exp_0 = store_thm( 1814 "turn_exp_0", 1815 ``!l. turn_exp l 0 = l``, 1816 rw[]); 1817 1818(* Theorem: turn_exp l 1 = turn l *) 1819(* Proof: 1820 turn_exp l 1 1821 = FUNPOW turn 1 l by notation 1822 = turn l by FUNPOW 1823*) 1824val turn_exp_1 = store_thm( 1825 "turn_exp_1", 1826 ``!l. turn_exp l 1 = turn l``, 1827 rw[]); 1828 1829(* Theorem: turn_exp l 2 = turn (turn l) *) 1830(* Proof: 1831 turn_exp l 2 1832 = FUNPOW turn 2 l by notation 1833 = turn (FUNPOW turn 1 l) by FUNPOW_SUC 1834 = turn (turn_exp l 1) by notation 1835 = turn (turn l) by turn_exp_1 1836*) 1837val turn_exp_2 = store_thm( 1838 "turn_exp_2", 1839 ``!l. turn_exp l 2 = turn (turn l)``, 1840 metis_tac[FUNPOW_SUC, turn_exp_1, TWO]); 1841 1842(* Theorem: turn_exp l (SUC n) = turn_exp (turn l) n *) 1843(* Proof: 1844 turn_exp l (SUC n) 1845 = FUNPOW turn (SUC n) l by notation 1846 = FUNPOW turn n (turn l) by FUNPOW 1847 = turn_exp (turn l) n by notation 1848*) 1849val turn_exp_SUC = store_thm( 1850 "turn_exp_SUC", 1851 ``!l n. turn_exp l (SUC n) = turn_exp (turn l) n``, 1852 rw[FUNPOW]); 1853 1854(* Theorem: turn_exp l (SUC n) = turn (turn_exp l n) *) 1855(* Proof: 1856 turn_exp l (SUC n) 1857 = FUNPOW turn (SUC n) l by notation 1858 = turn (FUNPOW turn n l) by FUNPOW_SUC 1859 = turn (turn_exp l n) by notation 1860*) 1861val turn_exp_suc = store_thm( 1862 "turn_exp_suc", 1863 ``!l n. turn_exp l (SUC n) = turn (turn_exp l n)``, 1864 rw[FUNPOW_SUC]); 1865 1866(* Theorem: LENGTH (turn_exp l n) = LENGTH l *) 1867(* Proof: 1868 By induction on n. 1869 Base: LENGTH (turn_exp l 0) = LENGTH l 1870 True by turn_exp l 0 = l by turn_exp_0 1871 Step: LENGTH (turn_exp l n) = LENGTH l ==> LENGTH (turn_exp l (SUC n)) = LENGTH l 1872 LENGTH (turn_exp l (SUC n)) 1873 = LENGTH (turn (turn_exp l n)) by turn_exp_suc 1874 = LENGTH (turn_exp l n) by turn_length 1875 = LENGTH l by induction hypothesis 1876*) 1877val turn_exp_length = store_thm( 1878 "turn_exp_length", 1879 ``!l n. LENGTH (turn_exp l n) = LENGTH l``, 1880 strip_tac >> 1881 Induct >- 1882 rw[] >> 1883 rw[turn_exp_suc, turn_length]); 1884 1885(* Theorem: n < LENGTH ls ==> 1886 (HD (turn_exp ls n) = EL (if n = 0 then 0 else LENGTH ls - n) ls) *) 1887(* Proof: 1888 By induction on n. 1889 Base: !ls. 0 < LENGTH ls ==> 1890 HD (turn_exp ls 0) = EL 0 ls 1891 HD (turn_exp ls 0) 1892 = HD ls by FUNPOW_0 1893 = EL 0 ls by EL 1894 Step: !ls. n < LENGTH ls ==> HD (turn_exp ls n) = EL (if n = 0 then 0 else (LENGTH ls - n)) ls ==> 1895 !ls. SUC n < LENGTH ls ==> HD (turn_exp ls (SUC n)) = EL (LENGTH ls - SUC n) ls 1896 Let k = LENGTH ls, then SUC n < k 1897 Note LENGTH (FRONT ls) = PRE k by FRONT_LENGTH 1898 and n < PRE k by SUC n < k 1899 Also LENGTH (turn ls) = k by turn_length 1900 so n < k by n < SUC n, SUC n < k 1901 Note ls <> [] by k <> 0 1902 1903 HD (turn_exp ls (SUC n)) 1904 = HD (turn_exp (turn ls) n) by turn_exp_SUC 1905 = EL (if n = 0 then 0 else (LENGTH (turn ls) - n)) (turn ls) 1906 by induction hypothesis, apply to (turn ls) 1907 = EL (if n = 0 then 0 else (k - n) (turn ls)) by above 1908 1909 If n = 0, 1910 = EL 0 (turn ls) 1911 = LAST ls by turn_def 1912 = EL (PRE k) ls by LAST_EL 1913 = EL (k - SUC 0) ls by ONE 1914 If n <> 0 1915 = EL (k - n) (turn ls) 1916 = EL (k - n) (LAST ls :: FRONT ls) by turn_def 1917 = EL (k - n - 1) (FRONT ls) by EL 1918 = EL (k - n - 1) ls by FRONT_EL, k - n - 1 < PRE k, n <> 0 1919 = EL (k - SUC n) ls by arithmetic 1920*) 1921val head_turn_exp = store_thm( 1922 "head_turn_exp", 1923 ``!ls n. n < LENGTH ls ==> 1924 (HD (turn_exp ls n) = EL (if n = 0 then 0 else LENGTH ls - n) ls)``, 1925 (Induct_on `n` >> simp[]) >> 1926 rpt strip_tac >> 1927 qabbrev_tac `k = LENGTH ls` >> 1928 `n < k` by rw[Abbr`k`] >> 1929 `LENGTH (turn ls) = k` by rw[turn_length, Abbr`k`] >> 1930 `HD (turn_exp ls (SUC n)) = HD (turn_exp (turn ls) n)` by rw[turn_exp_SUC] >> 1931 `_ = EL (if n = 0 then 0 else (k - n)) (turn ls)` by rw[] >> 1932 `k <> 0` by decide_tac >> 1933 `ls <> []` by metis_tac[LENGTH_NIL] >> 1934 (Cases_on `n = 0` >> fs[]) >| [ 1935 `PRE k = k - 1` by decide_tac >> 1936 rw[head_turn, LAST_EL], 1937 `k - n = SUC (k - SUC n)` by decide_tac >> 1938 rw[turn_def, Abbr`k`] >> 1939 `LENGTH (FRONT ls) = PRE (LENGTH ls)` by rw[FRONT_LENGTH] >> 1940 `n < PRE (LENGTH ls)` by decide_tac >> 1941 rw[FRONT_EL] 1942 ]); 1943 1944(* ------------------------------------------------------------------------- *) 1945(* Unit-List and Mono-List *) 1946(* ------------------------------------------------------------------------- *) 1947 1948(* Theorem: (LENGTH l = 1) ==> SING (set l) *) 1949(* Proof: 1950 Since ?x. l = [x] by LENGTH_EQ_1 1951 set l = {x} by LIST_TO_SET_DEF 1952 or SING (set l) by SING_DEF 1953*) 1954val LIST_TO_SET_SING = store_thm( 1955 "LIST_TO_SET_SING", 1956 ``!l. (LENGTH l = 1) ==> SING (set l)``, 1957 rw[LENGTH_EQ_1, SING_DEF] >> 1958 `set [x] = {x}` by rw[] >> 1959 metis_tac[]); 1960 1961(* Mono-list Theory: a mono-list is a list l with SING (set l) *) 1962 1963(* Theorem: Two mono-lists are equal if their lengths and sets are equal. 1964 SING (set l1) /\ SING (set l2) ==> 1965 ((l1 = l2) <=> (LENGTH l1 = LENGTH l2) /\ (set l1 = set l2)) *) 1966(* Proof: 1967 By induction on l1. 1968 Base case: !l2. SING (set []) /\ SING (set l2) ==> 1969 (([] = l2) <=> (LENGTH [] = LENGTH l2) /\ (set [] = set l2)) 1970 True by SING (set []) is False, by SING_EMPTY. 1971 Step case: !l2. SING (set l1) /\ SING (set l2) ==> 1972 ((l1 = l2) <=> (LENGTH l1 = LENGTH l2) /\ (set l1 = set l2)) ==> 1973 !h l2. SING (set (h::l1)) /\ SING (set l2) ==> 1974 ((h::l1 = l2) <=> (LENGTH (h::l1) = LENGTH l2) /\ (set (h::l1) = set l2)) 1975 This is to show: 1976 (1) 1 = LENGTH l2 /\ {h} = set l2 ==> 1977 ([h] = l2) <=> (SUC (LENGTH []) = LENGTH l2) /\ (h INSERT set [] = set l2) 1978 If-part, l2 = [h], 1979 LENGTH l2 = 1 = SUC 0 = SUC (LENGTH []) by LENGTH, ONE 1980 and set l2 = set [h] = {h} = h INSERT set [] by LIST_TO_SET 1981 Only-if part, LENGTH l2 = SUC 0 = 1 by ONE 1982 Then ?x. l2 = [x] by LENGTH_EQ_1 1983 so set l2 = {x} = {h} by LIST_TO_SET 1984 or x = h, hence l2 = [h] by EQUAL_SING 1985 (2) set l1 = {h} /\ SING (set l2) ==> 1986 (h::l1 = l2) <=> (SUC (LENGTH l1) = LENGTH l2) /\ (h INSERT set l1 = set l2) 1987 If part, h::l1 = l2. 1988 Then LENGTH l2 = LENGTH (h::l1) = SUC (LENGTH l1) by LENGTH 1989 and set l2 = set (h::l1) = h INSERT set l1 by LIST_TO_SET 1990 Only-if part, SUC (LENGTH l1) = LENGTH l2. 1991 Since 0 < SUC (LENGTH l1) by prim_recTheory.LESS_0 1992 0 < LENGTH l2 by LESS_TRANS 1993 so ?k t. l2 = k::t by LENGTH_NON_NIL, list_CASES 1994 Since LENGTH l2 = SUC (LENGTH t) by LENGTH 1995 LENGTH l1 = LENGTH t by prim_recTheory.INV_SUC_EQ 1996 and set l2 = k INSERT set t by LIST_TO_SET 1997 Given SING (set l2), 1998 either (set t = {}), or (set t = {k}) by SING_INSERT 1999 If set t = {}, 2000 then t = [] by LIST_TO_SET_EQ_EMPTY 2001 and l1 = [] by LENGTH_NIL, LENGTH l1 = LENGTH t. 2002 so set l1 = {} by LIST_TO_SET_EQ_EMPTY 2003 contradicting set l1 = {h} by NOT_SING_EMPTY 2004 If set t = {k}, 2005 then set l2 = set t by ABSORPTION, set l2 = k INSERT set {k}. 2006 or k = h by IN_SING 2007 so l1 = t by induction hypothesis 2008 giving l2 = h::l1 2009*) 2010val MONOLIST_EQ = store_thm( 2011 "MONOLIST_EQ", 2012 ``!l1 l2. SING (set l1) /\ SING (set l2) ==> 2013 ((l1 = l2) <=> (LENGTH l1 = LENGTH l2) /\ (set l1 = set l2))``, 2014 Induct >- 2015 rw[] >> 2016 rw[] >| [ 2017 rw[EQ_IMP_THM] >- 2018 rw[] >- 2019 rw[] >> 2020 `?x. l2 = [x]` by rw[GSYM LENGTH_EQ_1] >> 2021 `set l2 = {x}` by rw[] >> 2022 metis_tac[EQUAL_SING], 2023 rw[EQ_IMP_THM] >- 2024 rw[] >- 2025 rw[] >> 2026 `0 < LENGTH l2` by decide_tac >> 2027 `?k t. l2 = k::t` by metis_tac[LENGTH_NON_NIL, list_CASES] >> 2028 `LENGTH l2 = SUC (LENGTH t)` by rw[] >> 2029 `LENGTH l1 = LENGTH t` by decide_tac >> 2030 `set l2 = k INSERT set t` by rw[] >> 2031 `(set t = {}) \/ (set t = {k})` by metis_tac[SING_INSERT] >- 2032 metis_tac[LIST_TO_SET_EQ_EMPTY, LENGTH_NIL, NOT_SING_EMPTY] >> 2033 `set l2 = set t` by rw[] >> 2034 metis_tac[IN_SING] 2035 ]); 2036(* Michael's Proof *) 2037val MONOLIST_EQ = store_thm( 2038 "MONOLIST_EQ", 2039 ``!l1 l2. SING (set l1) /\ SING (set l2) ==> 2040 ((l1 = l2) <=> (LENGTH l1 = LENGTH l2) /\ (set l1 = set l2))``, 2041 Induct >> rw[NOT_SING_EMPTY, SING_INSERT] >| [ 2042 Cases_on `l2` >> rw[] >> 2043 full_simp_tac (srw_ss()) [SING_INSERT, EQUAL_SING] >> 2044 rw[LENGTH_NIL, NOT_SING_EMPTY, EQUAL_SING] >> metis_tac[], 2045 Cases_on `l2` >> rw[] >> 2046 full_simp_tac (srw_ss()) [SING_INSERT, LENGTH_NIL, NOT_SING_EMPTY, EQUAL_SING] >> 2047 metis_tac[] 2048 ]); 2049 2050(* Theorem: A non-mono-list has at least one element in tail that is distinct from its head. 2051 ~SING (set (h::t)) ==> ?h'. h' IN set t /\ h' <> h *) 2052(* Proof: 2053 By SING_INSERT, this is to show: 2054 t <> [] /\ set t <> {h} ==> ?h'. MEM h' t /\ h' <> h 2055 Now, t <> [] ==> set t <> {} by LIST_TO_SET_EQ_EMPTY 2056 so ?e. e IN set t by MEMBER_NOT_EMPTY 2057 hence MEM e t, 2058 and MEM x t <=/=> (x = h) by EXTENSION 2059 Therefore, e <> h, so take h' = e. 2060*) 2061val NON_MONO_TAIL_PROPERTY = store_thm( 2062 "NON_MONO_TAIL_PROPERTY", 2063 ``!l. ~SING (set (h::t)) ==> ?h'. h' IN set t /\ h' <> h``, 2064 rw[SING_INSERT] >> 2065 `set t <> {}` by metis_tac[LIST_TO_SET_EQ_EMPTY] >> 2066 `?e. e IN set t` by metis_tac[MEMBER_NOT_EMPTY] >> 2067 full_simp_tac (srw_ss())[EXTENSION] >> 2068 metis_tac[]); 2069 2070(* ------------------------------------------------------------------------- *) 2071(* GENLIST Theorems *) 2072(* ------------------------------------------------------------------------- *) 2073 2074(* Theorem: GENLIST f 0 = [] *) 2075(* Proof: by GENLIST *) 2076val GENLIST_0 = store_thm( 2077 "GENLIST_0", 2078 ``!f. GENLIST f 0 = []``, 2079 rw[]); 2080 2081(* Theorem: GENLIST f 1 = [f 0] *) 2082(* Proof: 2083 GENLIST f 1 2084 = GENLIST f (SUC 0) by ONE 2085 = SNOC (f 0) (GENLIST f 0) by GENLIST 2086 = SNOC (f 0) [] by GENLIST 2087 = [f 0] by SNOC 2088*) 2089val GENLIST_1 = store_thm( 2090 "GENLIST_1", 2091 ``!f. GENLIST f 1 = [f 0]``, 2092 rw[]); 2093 2094(* Theorem alias *) 2095Theorem GENLIST_EQ = 2096 listTheory.GENLIST_CONG |> GEN ``n:num`` |> GEN ``f2:num -> 'a`` 2097 |> GEN ``f1:num -> 'a``; 2098(* 2099val GENLIST_EQ = |- !f1 f2 n. (!m. m < n ==> f1 m = f2 m) ==> GENLIST f1 n = GENLIST f2 n: thm 2100*) 2101 2102(* Theorem: (GENLIST f n = []) <=> (n = 0) *) 2103(* Proof: 2104 If part: GENLIST f n = [] ==> n = 0 2105 By contradiction, suppose n <> 0. 2106 Then LENGTH (GENLIST f n) = n <> 0 by LENGTH_GENLIST 2107 This contradicts LENGTH [] = 0. 2108 Only-if part: GENLIST f 0 = [], true by GENLIST_0 2109*) 2110val GENLIST_EQ_NIL = store_thm( 2111 "GENLIST_EQ_NIL", 2112 ``!f n. (GENLIST f n = []) <=> (n = 0)``, 2113 rw[EQ_IMP_THM] >> 2114 metis_tac[LENGTH_GENLIST, LENGTH_NIL]); 2115 2116(* Theorem: LAST (GENLIST f (SUC n)) = f n *) 2117(* Proof: 2118 LAST (GENLIST f (SUC n)) 2119 = LAST (SNOC (f n) (GENLIST f n)) by GENLIST 2120 = f n by LAST_SNOC 2121*) 2122val GENLIST_LAST = store_thm( 2123 "GENLIST_LAST", 2124 ``!f n. LAST (GENLIST f (SUC n)) = f n``, 2125 rw[GENLIST]); 2126 2127(* Note: 2128 2129- EVERY_MAP; 2130> val it = |- !P f l. EVERY P (MAP f l) <=> EVERY (\x. P (f x)) l : thm 2131- EVERY_GENLIST; 2132> val it = |- !n. EVERY P (GENLIST f n) <=> !i. i < n ==> P (f i) : thm 2133- MAP_GENLIST; 2134> val it = |- !f g n. MAP f (GENLIST g n) = GENLIST (f o g) n : thm 2135*) 2136 2137(* Note: the following can use EVERY_GENLIST. *) 2138 2139(* Theorem: !k. (k < n ==> f k = c) <=> EVERY (\x. x = c) (GENLIST f n) *) 2140(* Proof: by induction on n. 2141 Base case: !c. (!k. k < 0 ==> (f k = c)) <=> EVERY (\x. x = c) (GENLIST f 0) 2142 Since GENLIST f 0 = [], this is true as no k < 0. 2143 Step case: (!k. k < n ==> (f k = c)) <=> EVERY (\x. x = c) (GENLIST f n) ==> 2144 (!k. k < SUC n ==> (f k = c)) <=> EVERY (\x. x = c) (GENLIST f (SUC n)) 2145 EVERY (\x. x = c) (GENLIST f (SUC n)) 2146 <=> EVERY (\x. x = c) (SNOC (f n) (GENLIST f n)) by GENLIST 2147 <=> EVERY (\x. x = c) (GENLIST f n) /\ (f n = c) by EVERY_SNOC 2148 <=> (!k. k < n ==> (f k = c)) /\ (f n = c) by induction hypothesis 2149 <=> !k. k < SUC n ==> (f k = c) 2150*) 2151val GENLIST_CONSTANT = store_thm( 2152 "GENLIST_CONSTANT", 2153 ``!f n c. (!k. k < n ==> (f k = c)) <=> EVERY (\x. x = c) (GENLIST f n)``, 2154 strip_tac >> 2155 Induct >- 2156 rw[] >> 2157 rw_tac std_ss[EVERY_DEF, GENLIST, EVERY_SNOC, EQ_IMP_THM] >- 2158 metis_tac[prim_recTheory.LESS_SUC] >> 2159 Cases_on `k = n` >- 2160 rw_tac std_ss[] >> 2161 metis_tac[prim_recTheory.LESS_THM]); 2162 2163(* Theorem: GENLIST (K e) (SUC n) = e :: GENLIST (K e) n *) 2164(* Proof: 2165 GENLIST (K e) (SUC n) 2166 = (K e) 0::GENLIST ((K e) o SUC) n by GENLIST_CONS 2167 = e :: GENLIST ((K e) o SUC) n by K_THM 2168 = e :: GENLIST (K e) n by K_o_THM 2169*) 2170val GENLIST_K_CONS = save_thm("GENLIST_K_CONS", 2171 SIMP_CONV (srw_ss()) [GENLIST_CONS] ``GENLIST (K e) (SUC n)`` |> GEN ``n:num`` |> GEN ``e``); 2172(* val GENLIST_K_CONS = |- !e n. GENLIST (K e) (SUC n) = e::GENLIST (K e) n: thm *) 2173 2174(* Theorem: GENLIST (K e) (n + m) = GENLIST (K e) m ++ GENLIST (K e) n *) 2175(* Proof: 2176 Note (\t. e) = K e by FUN_EQ_THM 2177 GENLIST (K e) (n + m) 2178 = GENLIST (K e) m ++ GENLIST (\t. (K e) (t + m)) n by GENLIST_APPEND 2179 = GENLIST (K e) m ++ GENLIST (\t. e) n by K_THM 2180 = GENLIST (K e) m ++ GENLIST (K e) n by above 2181*) 2182val GENLIST_K_ADD = store_thm( 2183 "GENLIST_K_ADD", 2184 ``!e n m. GENLIST (K e) (n + m) = GENLIST (K e) m ++ GENLIST (K e) n``, 2185 rpt strip_tac >> 2186 `(\t. e) = K e` by rw[FUN_EQ_THM] >> 2187 rw[GENLIST_APPEND] >> 2188 metis_tac[]); 2189 2190(* Theorem: (!k. k < n ==> (f k = e)) ==> (GENLIST f n = GENLIST (K e) n) *) 2191(* Proof: 2192 By induction on n. 2193 Base: GENLIST f 0 = GENLIST (K e) 0 2194 GENLIST f 0 2195 = [] by GENLIST_0 2196 = GENLIST (K e) 0 by GENLIST_0 2197 Step: GENLIST f n = GENLIST (K e) n ==> 2198 GENLIST f (SUC n) = GENLIST (K e) (SUC n) 2199 GENLIST f (SUC n) 2200 = SNOC (f n) (GENLIST f n) by GENLIST 2201 = SNOC e (GENLIST f n) by applying f to n 2202 = SNOC e (GENLIST (K e) n) by induction hypothesis 2203 = GENLIST (K e) (SUC n) by GENLIST 2204*) 2205val GENLIST_K_LESS = store_thm( 2206 "GENLIST_K_LESS", 2207 ``!f e n. (!k. k < n ==> (f k = e)) ==> (GENLIST f n = GENLIST (K e) n)``, 2208 rpt strip_tac >> 2209 Induct_on `n` >> 2210 rw[GENLIST]); 2211 2212(* Theorem: (!k. 0 < k /\ k <= n ==> (f k = e)) ==> (GENLIST (f o SUC) n = GENLIST (K e) n) *) 2213(* Proof: 2214 Base: GENLIST (f o SUC) 0 = GENLIST (K e) 0 2215 GENLIST (f o SUC) 0 2216 = [] by GENLIST_0 2217 = GENLIST (K e) 0 by GENLIST_0 2218 Step: GENLIST (f o SUC) n = GENLIST (K e) n ==> 2219 GENLIST (f o SUC) (SUC n) = GENLIST (K e) (SUC n) 2220 GENLIST (f o SUC) (SUC n) 2221 = SNOC (f n) (GENLIST (f o SUC) n) by GENLIST 2222 = SNOC e (GENLIST (f o SUC) n) by applying f to n 2223 = SNOC e GENLIST (K e) n by induction hypothesis 2224 = GENLIST (K e) (SUC n) by GENLIST 2225*) 2226val GENLIST_K_RANGE = store_thm( 2227 "GENLIST_K_RANGE", 2228 ``!f e n. (!k. 0 < k /\ k <= n ==> (f k = e)) ==> (GENLIST (f o SUC) n = GENLIST (K e) n)``, 2229 rpt strip_tac >> 2230 Induct_on `n` >> 2231 rw[GENLIST]); 2232 2233(* Theorem: GENLIST (K c) a ++ GENLIST (K c) b = GENLIST (K c) (a + b) *) 2234(* Proof: 2235 Note (\t. c) = K c by FUN_EQ_THM 2236 GENLIST (K c) (a + b) 2237 = GENLIST (K c) (b + a) by ADD_COMM 2238 = GENLIST (K c) a ++ GENLIST (\t. (K c) (t + a)) b by GENLIST_APPEND 2239 = GENLIST (K c) a ++ GENLIST (\t. c) b by applying constant function 2240 = GENLIST (K c) a ++ GENLIST (K c) b by GENLIST_FUN_EQ 2241*) 2242val GENLIST_K_APPEND = store_thm( 2243 "GENLIST_K_APPEND", 2244 ``!a b c. GENLIST (K c) a ++ GENLIST (K c) b = GENLIST (K c) (a + b)``, 2245 rpt strip_tac >> 2246 `(\t. c) = K c` by rw[FUN_EQ_THM] >> 2247 `GENLIST (K c) (a + b) = GENLIST (K c) (b + a)` by rw[] >> 2248 `_ = GENLIST (K c) a ++ GENLIST (\t. (K c) (t + a)) b` by rw[GENLIST_APPEND] >> 2249 rw[GENLIST_FUN_EQ]); 2250 2251(* Theorem: GENLIST (K c) n ++ [c] = [c] ++ GENLIST (K c) n *) 2252(* Proof: 2253 GENLIST (K c) n ++ [c] 2254 = GENLIST (K c) n ++ GENLIST (K c) 1 by GENLIST_1 2255 = GENLIST (K c) (n + 1) by GENLIST_K_APPEND 2256 = GENLIST (K c) (1 + n) by ADD_COMM 2257 = GENLIST (K c) 1 ++ GENLIST (K c) n by GENLIST_K_APPEND 2258 = [c] ++ GENLIST (K c) n by GENLIST_1 2259*) 2260val GENLIST_K_APPEND_K = store_thm( 2261 "GENLIST_K_APPEND_K", 2262 ``!c n. GENLIST (K c) n ++ [c] = [c] ++ GENLIST (K c) n``, 2263 metis_tac[GENLIST_K_APPEND, GENLIST_1, ADD_COMM, combinTheory.K_THM]); 2264 2265(* Theorem: 0 < n ==> (MEM x (GENLIST (K c) n) <=> (x = c)) *) 2266(* Proof: 2267 MEM x (GENLIST (K c) n 2268 <=> ?m. m < n /\ (x = (K c) m) by MEM_GENLIST 2269 <=> ?m. m < n /\ (x = c) by K_THM 2270 <=> (x = c) by taking m = 0, 0 < n 2271*) 2272Theorem GENLIST_K_MEM: 2273 !x c n. 0 < n ==> (MEM x (GENLIST (K c) n) <=> (x = c)) 2274Proof 2275 metis_tac[MEM_GENLIST, combinTheory.K_THM] 2276QED 2277 2278(* Theorem: 0 < n ==> (set (GENLIST (K c) n) = {c}) *) 2279(* Proof: 2280 By induction on n. 2281 Base: 0 < 0 ==> (set (GENLIST (K c) 0) = {c}) 2282 Since 0 < 0 = F, hence true. 2283 Step: 0 < n ==> (set (GENLIST (K c) n) = {c}) ==> 2284 0 < SUC n ==> (set (GENLIST (K c) (SUC n)) = {c}) 2285 If n = 0, 2286 set (GENLIST (K c) (SUC 0) 2287 = set (GENLIST (K c) 1 by ONE 2288 = set [(K c) 0] by GENLIST_1 2289 = set [c] by K_THM 2290 = {c} by LIST_TO_SET 2291 If n <> 0, 0 < n. 2292 set (GENLIST (K c) (SUC n) 2293 = set (SNOC ((K c) n) (GENLIST (K c) n)) by GENLIST 2294 = set (SNOC c (GENLIST (K c) n) by K_THM 2295 = c INSERT set (GENLIST (K c) n) by LIST_TO_SET_SNOC 2296 = c INSERT {c} by induction hypothesis 2297 = {c} by IN_INSERT 2298 *) 2299Theorem GENLIST_K_SET: 2300 !c n. 0 < n ==> (set (GENLIST (K c) n) = {c}) 2301Proof 2302 rpt strip_tac >> 2303 Induct_on `n` >- 2304 simp[] >> 2305 (Cases_on `n = 0` >> simp[]) >> 2306 `0 < n` by decide_tac >> 2307 simp[GENLIST, LIST_TO_SET_SNOC] 2308QED 2309 2310(* Theorem: ls <> [] ==> (SING (set ls) <=> ?c. ls = GENLIST (K c) (LENGTH ls)) *) 2311(* Proof: 2312 By induction on ls. 2313 Base: [] <> [] ==> (SING (set []) <=> ?c. [] = GENLIST (K c) (LENGTH [])) 2314 Since [] <> [] = F, hence true. 2315 Step: ls <> [] ==> (SING (set ls) <=> ?c. ls = GENLIST (K c) (LENGTH ls)) ==> 2316 !h. h::ls <> [] ==> 2317 (SING (set (h::ls)) <=> ?c. h::ls = GENLIST (K c) (LENGTH (h::ls))) 2318 Note h::ls <> [] = T. 2319 If part: SING (set (h::ls)) ==> ?c. h::ls = GENLIST (K c) (LENGTH (h::ls)) 2320 Note SING (set (h::ls)) means 2321 set ls = {h} by LIST_TO_SET_DEF, IN_SING 2322 Let n = LENGTH ls, 0 < n by LENGTH_NON_NIL 2323 Note ls <> [] by LIST_TO_SET, IN_SING, MEMBER_NOT_EMPTY 2324 and SING (set ls) by SING_DEF 2325 ==> ?c. ls = GENLIST (K c) n by induction hypothesis 2326 so set ls = {c} by GENLIST_K_SET, 0 < n 2327 ==> h = c by IN_SING 2328 GENLIST (K c) (LENGTH (h::ls) 2329 = (K c) h :: ls by GENLIST_K_CONS 2330 = c :: ls by K_THM 2331 = h::ls by h = c 2332 Only-if part: ?c. h::ls = GENLIST (K c) (LENGTH (h::ls)) ==> SING (set (h::ls)) 2333 set (h::ls) 2334 = set (GENLIST (K c) (LENGTH (h::ls))) by given 2335 = set ((K c) h :: GENLIST (K c) (LENGTH ls)) by GENLIST_K_CONS 2336 = set (c :: GENLIST (K c) (LENGTH ls)) by K_THM 2337 = c INSERT set (GENLIST (K c) (LENGTH ls)) by LIST_TO_SET 2338 = c INSERT {c} by GENLIST_K_SET 2339 = {c} by IN_INSERT 2340 Hence SING (set (h::ls)) by SING_DEF 2341*) 2342Theorem LIST_TO_SET_SING_IFF: 2343 !ls. ls <> [] ==> (SING (set ls) <=> ?c. ls = GENLIST (K c) (LENGTH ls)) 2344Proof 2345 Induct >- 2346 simp[] >> 2347 (rw[EQ_IMP_THM] >> simp[]) >| [ 2348 qexists_tac `h` >> 2349 qabbrev_tac `n = LENGTH ls` >> 2350 `ls <> []` by metis_tac[LIST_TO_SET, IN_SING, MEMBER_NOT_EMPTY] >> 2351 `SING (set ls)` by fs[SING_DEF] >> 2352 fs[] >> 2353 `0 < n` by metis_tac[LENGTH_NON_NIL] >> 2354 `h = c` by metis_tac[GENLIST_K_SET, IN_SING] >> 2355 simp[GENLIST_K_CONS], 2356 spose_not_then strip_assume_tac >> 2357 fs[GENLIST_K_CONS] >> 2358 `0 < LENGTH ls` by metis_tac[LENGTH_NON_NIL] >> 2359 metis_tac[GENLIST_K_SET] 2360 ] 2361QED 2362 2363(* ------------------------------------------------------------------------- *) 2364(* SUM Theorems *) 2365(* ------------------------------------------------------------------------- *) 2366 2367(* Defined: SUM for summation of list = sequence *) 2368 2369(* Theorem: SUM [] = 0 *) 2370(* Proof: by definition. *) 2371val SUM_NIL = save_thm("SUM_NIL", SUM |> CONJUNCT1); 2372(* > val SUM_NIL = |- SUM [] = 0 : thm *) 2373 2374(* Theorem: SUM h::t = h + SUM t *) 2375(* Proof: by definition. *) 2376val SUM_CONS = save_thm("SUM_CONS", SUM |> CONJUNCT2); 2377(* val SUM_CONS = |- !h t. SUM (h::t) = h + SUM t: thm *) 2378 2379(* Theorem: SUM [n] = n *) 2380(* Proof: by SUM *) 2381val SUM_SING = store_thm( 2382 "SUM_SING", 2383 ``!n. SUM [n] = n``, 2384 rw[]); 2385 2386(* Theorem: SUM (s ++ t) = SUM s + SUM t *) 2387(* Proof: by induction on s *) 2388(* 2389val SUM_APPEND = store_thm( 2390 "SUM_APPEND", 2391 ``!s t. SUM (s ++ t) = SUM s + SUM t``, 2392 Induct_on `s` >- 2393 rw[] >> 2394 rw[ADD_ASSOC]); 2395*) 2396(* There is already a SUM_APPEND in up-to-date listTheory *) 2397 2398(* Theorem: constant multiplication: k * SUM s = SUM (k * s) *) 2399(* Proof: by induction on s. 2400 Base case: !k. k * SUM [] = SUM (MAP ($* k) []) 2401 LHS = k * SUM [] = k * 0 = 0 by SUM_NIL, MULT_0 2402 = SUM [] by SUM_NIL 2403 = SUM (MAP ($* k) []) = RHS by MAP 2404 Step case: !k. k * SUM s = SUM (MAP ($* k) s) ==> 2405 !h k. k * SUM (h::s) = SUM (MAP ($* k) (h::s)) 2406 LHS = k * SUM (h::s) 2407 = k * (h + SUM s) by SUM_CONS 2408 = k * h + k * SUM s by LEFT_ADD_DISTRIB 2409 = k * h + SUM (MAP ($* k) s) by induction hypothesis 2410 = SUM (k * h :: (MAP ($* k) s)) by SUM_CONS 2411 = SUM (MAP ($* k) (h::s)) by MAP 2412 = RHS 2413*) 2414val SUM_MULT = store_thm( 2415 "SUM_MULT", 2416 ``!s k. k * SUM s = SUM (MAP ($* k) s)``, 2417 Induct_on `s` >- 2418 metis_tac[SUM, MAP, MULT_0] >> 2419 metis_tac[SUM, MAP, LEFT_ADD_DISTRIB]); 2420 2421(* Theorem: (m + n) * SUM s = SUM (m * s) + SUM (n * s) *) 2422(* Proof: generalization of 2423- RIGHT_ADD_DISTRIB; 2424> val it = |- !m n p. (m + n) * p = m * p + n * p : thm 2425 (m + n) * SUM s 2426 = m * SUM s + n * SUM s by RIGHT_ADD_DISTRIB 2427 = SUM (MAP (\x. m * x) s) + SUM (MAP (\x. n * x) s) by SUM_MULT 2428*) 2429val SUM_RIGHT_ADD_DISTRIB = store_thm( 2430 "SUM_RIGHT_ADD_DISTRIB", 2431 ``!s m n. (m + n) * SUM s = SUM (MAP ($* m) s) + SUM (MAP ($* n) s)``, 2432 metis_tac[RIGHT_ADD_DISTRIB, SUM_MULT]); 2433 2434(* Theorem: (SUM s) * (m + n) = SUM (m * s) + SUM (n * s) *) 2435(* Proof: generalization of 2436- LEFT_ADD_DISTRIB; 2437> val it = |- !m n p. p * (m + n) = p * m + p * n : thm 2438 (SUM s) * (m + n) 2439 = (m + n) * SUM s by MULT_COMM 2440 = SUM (MAP ($* m) s) + SUM (MAP ($* n) s) by SUM_RIGHT_ADD_DISTRIB 2441*) 2442val SUM_LEFT_ADD_DISTRIB = store_thm( 2443 "SUM_LEFT_ADD_DISTRIB", 2444 ``!s m n. (SUM s) * (m + n) = SUM (MAP ($* m) s) + SUM (MAP ($* n) s)``, 2445 metis_tac[SUM_RIGHT_ADD_DISTRIB, MULT_COMM]); 2446 2447 2448(* 2449- EVAL ``GENLIST I 4``; 2450> val it = |- GENLIST I 4 = [0; 1; 2; 3] : thm 2451- EVAL ``GENLIST SUC 4``; 2452> val it = |- GENLIST SUC 4 = [1; 2; 3; 4] : thm 2453- EVAL ``GENLIST (\k. binomial 4 k) 5``; 2454> val it = |- GENLIST (\k. binomial 4 k) 5 = [1; 4; 6; 4; 1] : thm 2455- EVAL ``GENLIST (\k. binomial 5 k) 6``; 2456> val it = |- GENLIST (\k. binomial 5 k) 6 = [1; 5; 10; 10; 5; 1] : thm 2457- EVAL ``GENLIST (\k. binomial 10 k) 11``; 2458> val it = |- GENLIST (\k. binomial 10 k) 11 = [1; 10; 45; 120; 210; 252; 210; 120; 45; 10; 1] : thm 2459*) 2460 2461(* Theorems on GENLIST: 2462 2463- GENLIST; 2464> val it = |- (!f. GENLIST f 0 = []) /\ 2465 !f n. GENLIST f (SUC n) = SNOC (f n) (GENLIST f n) : thm 2466- NULL_GENLIST; 2467> val it = |- !n f. NULL (GENLIST f n) <=> (n = 0) : thm 2468- GENLIST_CONS; 2469> val it = |- GENLIST f (SUC n) = f 0::GENLIST (f o SUC) n : thm 2470- EL_GENLIST; 2471> val it = |- !f n x. x < n ==> (EL x (GENLIST f n) = f x) : thm 2472- EXISTS_GENLIST; 2473> val it = |- !n. EXISTS P (GENLIST f n) <=> ?i. i < n /\ P (f i) : thm 2474- EVERY_GENLIST; 2475> val it = |- !n. EVERY P (GENLIST f n) <=> !i. i < n ==> P (f i) : thm 2476- MAP_GENLIST; 2477> val it = |- !f g n. MAP f (GENLIST g n) = GENLIST (f o g) n : thm 2478- GENLIST_APPEND; 2479> val it = |- !f a b. GENLIST f (a + b) = GENLIST f b ++ GENLIST (\t. f (t + b)) a : thm 2480- HD_GENLIST; 2481> val it = |- HD (GENLIST f (SUC n)) = f 0 : thm 2482- TL_GENLIST; 2483> val it = |- !f n. TL (GENLIST f (SUC n)) = GENLIST (f o SUC) n : thm 2484- HD_GENLIST_COR; 2485> val it = |- !n f. 0 < n ==> (HD (GENLIST f n) = f 0) : thm 2486- GENLIST_FUN_EQ; 2487> val it = |- !n f g. (GENLIST f n = GENLIST g n) <=> !x. x < n ==> (f x = g x) : thm 2488 2489*) 2490 2491(* Theorem: SUM (GENLIST f n) = SIGMA f (count n) *) 2492(* Proof: 2493 By induction on n. 2494 Base: SUM (GENLIST f 0) = SIGMA f (count 0) 2495 2496 SUM (GENLIST f 0) 2497 = SUM [] by GENLIST_0 2498 = 0 by SUM_NIL 2499 = SIGMA f {} by SUM_IMAGE_THM 2500 = SIGMA f (count 0) by COUNT_0 2501 2502 Step: SUM (GENLIST f n) = SIGMA f (count n) ==> 2503 SUM (GENLIST f (SUC n)) = SIGMA f (count (SUC n)) 2504 2505 SUM (GENLIST f (SUC n)) 2506 = SUM (SNOC (f n) (GENLIST f n)) by GENLIST 2507 = f n + SUM (GENLIST f n) by SUM_SNOC 2508 = f n + SIGMA f (count n) by induction hypothesis 2509 = f n + SIGMA f (count n DELETE n) by IN_COUNT, DELETE_NON_ELEMENT 2510 = SIGMA f (n INSERT count n) by SUM_IMAGE_THM, FINITE_COUNT 2511 = SIGMA f (count (SUC n)) by COUNT_SUC 2512*) 2513val SUM_GENLIST = store_thm( 2514 "SUM_GENLIST", 2515 ``!f n. SUM (GENLIST f n) = SIGMA f (count n)``, 2516 strip_tac >> 2517 Induct >- 2518 rw[SUM_IMAGE_THM] >> 2519 `SUM (GENLIST f (SUC n)) = SUM (SNOC (f n) (GENLIST f n))` by rw[GENLIST] >> 2520 `_ = f n + SUM (GENLIST f n)` by rw[SUM_SNOC] >> 2521 `_ = f n + SIGMA f (count n)` by rw[] >> 2522 `_ = f n + SIGMA f (count n DELETE n)` by metis_tac[IN_COUNT, LESS_SELF, DELETE_NON_ELEMENT] >> 2523 `_ = SIGMA f (n INSERT count n)` by rw[SUM_IMAGE_THM] >> 2524 `_ = SIGMA f (count (SUC n))` by rw[COUNT_SUC] >> 2525 decide_tac); 2526 2527(* Theorem: SUM (k=0..n) f(k) = f(0) + SUM (k=1..n) f(k) *) 2528(* Proof: 2529 SUM (GENLIST f (SUC n)) 2530 = SUM (f 0 :: GENLIST (f o SUC) n) by GENLIST_CONS 2531 = f 0 + SUM (GENLIST (f o SUC) n) by SUM definition. 2532*) 2533val SUM_DECOMPOSE_FIRST = store_thm( 2534 "SUM_DECOMPOSE_FIRST", 2535 ``!f n. SUM (GENLIST f (SUC n)) = f 0 + SUM (GENLIST (f o SUC) n)``, 2536 metis_tac[GENLIST_CONS, SUM]); 2537 2538(* Theorem: SUM (k=0..n) f(k) = SUM (k=0..(n-1)) f(k) + f n *) 2539(* Proof: 2540 SUM (GENLIST f (SUC n)) 2541 = SUM (SNOC (f n) (GENLIST f n)) by GENLIST definition 2542 = SUM ((GENLIST f n) ++ [f n]) by SNOC_APPEND 2543 = SUM (GENLIST f n) + SUM [f n] by SUM_APPEND 2544 = SUM (GENLIST f n) + f n by SUM definition: SUM (h::t) = h + SUM t, and SUM [] = 0. 2545*) 2546val SUM_DECOMPOSE_LAST = store_thm( 2547 "SUM_DECOMPOSE_LAST", 2548 ``!f n. SUM (GENLIST f (SUC n)) = SUM (GENLIST f n) + f n``, 2549 rpt strip_tac >> 2550 `SUM (GENLIST f (SUC n)) = SUM (SNOC (f n) (GENLIST f n))` by metis_tac[GENLIST] >> 2551 `_ = SUM ((GENLIST f n) ++ [f n])` by metis_tac[SNOC_APPEND] >> 2552 `_ = SUM (GENLIST f n) + SUM [f n]` by metis_tac[SUM_APPEND] >> 2553 rw[SUM]); 2554 2555(* Theorem: SUM (GENLIST a n) + SUM (GENLIST b n) = SUM (GENLIST (\k. a k + b k) n) *) 2556(* Proof: by induction on n. 2557 Base case: !a b. SUM (GENLIST a 0) + SUM (GENLIST b 0) = SUM (GENLIST (\k. a k + b k) 0) 2558 Since GENLIST f 0 = [] by GENLIST 2559 and SUM [] = 0 by SUM_NIL 2560 This is just 0 + 0 = 0, true by arithmetic. 2561 Step case: !a b. SUM (GENLIST a n) + SUM (GENLIST b n) = 2562 SUM (GENLIST (\k. a k + b k) n) ==> 2563 !a b. SUM (GENLIST a (SUC n)) + SUM (GENLIST b (SUC n)) = 2564 SUM (GENLIST (\k. a k + b k) (SUC n)) 2565 SUM (GENLIST a (SUC n)) + SUM (GENLIST b (SUC n) 2566 = (SUM (GENLIST a n) + a n) + (SUM (GENLIST b n) + b n) by SUM_DECOMPOSE_LAST 2567 = SUM (GENLIST a n) + SUM (GENLIST b n) + (a n + b n) by arithmetic 2568 = SUM (GENLIST (\k. a k + b k) n) + (a n + b n) by induction hypothesis 2569 = SUM (GENLIST (\k. a k + b k) (SUC n)) by SUM_DECOMPOSE_LAST 2570*) 2571val SUM_ADD_GENLIST = store_thm( 2572 "SUM_ADD_GENLIST", 2573 ``!a b n. SUM (GENLIST a n) + SUM (GENLIST b n) = SUM (GENLIST (\k. a k + b k) n)``, 2574 Induct_on `n` >- 2575 rw[] >> 2576 rw[SUM_DECOMPOSE_LAST]); 2577 2578(* Theorem: SUM (GENLIST a n ++ GENLIST b n) = SUM (GENLIST (\k. a k + b k) n) *) 2579(* Proof: 2580 SUM (GENLIST a n ++ GENLIST b n) 2581 = SUM (GENLIST a n) + SUM (GENLIST b n) by SUM_APPEND 2582 = SUM (GENLIST (\k. a k + b k) n) by SUM_ADD_GENLIST 2583*) 2584val SUM_GENLIST_APPEND = store_thm( 2585 "SUM_GENLIST_APPEND", 2586 ``!a b n. SUM (GENLIST a n ++ GENLIST b n) = SUM (GENLIST (\k. a k + b k) n)``, 2587 metis_tac[SUM_APPEND, SUM_ADD_GENLIST]); 2588 2589(* Theorem: 0 < n ==> SUM (GENLIST f (SUC n)) = f 0 + SUM (GENLIST (f o SUC) (PRE n)) + f n *) 2590(* Proof: 2591 SUM (GENLIST f (SUC n)) 2592 = SUM (GENLIST f n) + f n by SUM_DECOMPOSE_LAST 2593 = SUM (GENLIST f (SUC m)) + f n by n = SUC m, 0 < n 2594 = f 0 + SUM (GENLIST (f o SUC) m) + f n by SUM_DECOMPOSE_FIRST 2595 = f 0 + SUM (GENLIST (f o SUC) (PRE n)) + f n by PRE_SUC_EQ 2596*) 2597val SUM_DECOMPOSE_FIRST_LAST = store_thm( 2598 "SUM_DECOMPOSE_FIRST_LAST", 2599 ``!f n. 0 < n ==> (SUM (GENLIST f (SUC n)) = f 0 + SUM (GENLIST (f o SUC) (PRE n)) + f n)``, 2600 metis_tac[SUM_DECOMPOSE_LAST, SUM_DECOMPOSE_FIRST, LESS_EQ_SUC, PRE_SUC_EQ]); 2601 2602(* Theorem: (SUM l) MOD n = (SUM (MAP (\x. x MOD n) l)) MOD n *) 2603(* Proof: by list induction. 2604 Base case: SUM [] MOD n = SUM (MAP (\x. x MOD n) []) MOD n 2605 true by SUM [] = 0, MAP f [] = 0, and 0 MOD n = 0. 2606 Step case: SUM l MOD n = SUM (MAP (\x. x MOD n) l) MOD n ==> 2607 !h. SUM (h::l) MOD n = SUM (MAP (\x. x MOD n) (h::l)) MOD n 2608 SUM (h::l) MOD n 2609 = (h + SUM l) MOD n by SUM 2610 = (h MOD n + (SUM l) MOD n) MOD n by MOD_PLUS 2611 = (h MOD n + SUM (MAP (\x. x MOD n) l) MOD n) MOD n by induction hypothesis 2612 = ((h MOD n) MOD n + SUM (MAP (\x. x MOD n) l) MOD n) MOD n by MOD_MOD 2613 = ((h MOD n + SUM (MAP (\x. x MOD n) l)) MOD n) MOD n by MOD_PLUS 2614 = (h MOD n + SUM (MAP (\x. x MOD n) l)) MOD n by MOD_MOD 2615 = (SUM (h MOD n ::(MAP (\x. x MOD n) l))) MOD n by SUM 2616 = (SUM (MAP (\x. x MOD n) (h::l))) MOD n by MAP 2617*) 2618val SUM_MOD = store_thm( 2619 "SUM_MOD", 2620 ``!n. 0 < n ==> !l. (SUM l) MOD n = (SUM (MAP (\x. x MOD n) l)) MOD n``, 2621 rpt strip_tac >> 2622 Induct_on `l` >- 2623 rw[] >> 2624 rpt strip_tac >> 2625 `SUM (h::l) MOD n = (h MOD n + (SUM l) MOD n) MOD n` by rw_tac std_ss[SUM, MOD_PLUS] >> 2626 `_ = ((h MOD n) MOD n + SUM (MAP (\x. x MOD n) l) MOD n) MOD n` by rw_tac std_ss[MOD_MOD] >> 2627 rw[MOD_PLUS]); 2628 2629(* Theorem: SUM l = 0 <=> l = EVERY (\x. x = 0) l *) 2630(* Proof: by induction on l. 2631 Base case: (SUM [] = 0) <=> EVERY (\x. x = 0) [] 2632 true by SUM [] = 0 and GENLIST f 0 = []. 2633 Step case: (SUM l = 0) <=> EVERY (\x. x = 0) l ==> 2634 !h. (SUM (h::l) = 0) <=> EVERY (\x. x = 0) (h::l) 2635 SUM (h::l) = 0 2636 <=> h + SUM l = 0 by SUM 2637 <=> h = 0 /\ SUM l = 0 by ADD_EQ_0 2638 <=> h = 0 /\ EVERY (\x. x = 0) l by induction hypothesis 2639 <=> EVERY (\x. x = 0) (h::l) by EVERY_DEF 2640*) 2641val SUM_EQ_0 = store_thm( 2642 "SUM_EQ_0", 2643 ``!l. (SUM l = 0) <=> EVERY (\x. x = 0) l``, 2644 Induct >> 2645 rw[]); 2646 2647(* Theorem: SUM (GENLIST ((\k. f k) o SUC) (PRE n)) MOD n = 2648 SUM (GENLIST ((\k. f k MOD n) o SUC) (PRE n)) MOD n *) 2649(* Proof: 2650 SUM (GENLIST ((\k. f k) o SUC) (PRE n)) MOD n 2651 = SUM (MAP (\x. x MOD n) (GENLIST ((\k. f k) o SUC) (PRE n))) MOD n by SUM_MOD 2652 = SUM (GENLIST ((\x. x MOD n) o ((\k. f k) o SUC)) (PRE n)) MOD n by MAP_GENLIST 2653 = SUM (GENLIST ((\x. x MOD n) o (\k. f k) o SUC) (PRE n)) MOD n by composition associative 2654 = SUM (GENLIST ((\k. f k MOD n) o SUC) (PRE n)) MOD n by composition 2655*) 2656val SUM_GENLIST_MOD = store_thm( 2657 "SUM_GENLIST_MOD", 2658 ``!n. 0 < n ==> !f. SUM (GENLIST ((\k. f k) o SUC) (PRE n)) MOD n = SUM (GENLIST ((\k. f k MOD n) o SUC) (PRE n)) MOD n``, 2659 rpt strip_tac >> 2660 `SUM (GENLIST ((\k. f k) o SUC) (PRE n)) MOD n = 2661 SUM (MAP (\x. x MOD n) (GENLIST ((\k. f k) o SUC) (PRE n))) MOD n` by metis_tac[SUM_MOD] >> 2662 rw_tac std_ss[MAP_GENLIST, combinTheory.o_ASSOC, combinTheory.o_ABS_L]); 2663 2664(* Theorem: SUM (GENLIST (\j. x) n) = n * x *) 2665(* Proof: 2666 By induction on n. 2667 Base case: !x. SUM (GENLIST (\j. x) 0) = 0 * x 2668 SUM (GENLIST (\j. x) 0) 2669 = SUM [] by GENLIST 2670 = 0 by SUM 2671 = 0 * x by MULT 2672 Step case: !x. SUM (GENLIST (\j. x) n) = n * x ==> 2673 !x. SUM (GENLIST (\j. x) (SUC n)) = SUC n * x 2674 SUM (GENLIST (\j. x) (SUC n)) 2675 = SUM (SNOC x (GENLIST (\j. x) n)) by GENLIST 2676 = SUM (GENLIST (\j. x) n) + x by SUM_SNOC 2677 = n * x + x by induction hypothesis 2678 = SUC n * x by MULT 2679*) 2680val SUM_CONSTANT = store_thm( 2681 "SUM_CONSTANT", 2682 ``!n x. SUM (GENLIST (\j. x) n) = n * x``, 2683 Induct >- 2684 rw[] >> 2685 rw_tac std_ss[GENLIST, SUM_SNOC, MULT]); 2686 2687(* Theorem: SUM (GENLIST (K m) n) = m * n *) 2688(* Proof: 2689 By induction on n. 2690 Base: SUM (GENLIST (K m) 0) = m * 0 2691 SUM (GENLIST (K m) 0) 2692 = SUM [] by GENLIST 2693 = 0 by SUM 2694 = m * 0 by MULT_0 2695 Step: SUM (GENLIST (K m) n) = m * n ==> SUM (GENLIST (K m) (SUC n)) = m * SUC n 2696 SUM (GENLIST (K m) (SUC n)) 2697 = SUM (SNOC m (GENLIST (K m) n)) by GENLIST 2698 = SUM (GENLIST (K m) n) + m by SUM_SNOC 2699 = m * n + m by induction hypothesis 2700 = m + m * n by ADD_COMM 2701 = m * SUC n by MULT_SUC 2702*) 2703val SUM_GENLIST_K = store_thm( 2704 "SUM_GENLIST_K", 2705 ``!m n. SUM (GENLIST (K m) n) = m * n``, 2706 strip_tac >> 2707 Induct >- 2708 rw[] >> 2709 rw[GENLIST, SUM_SNOC, MULT_SUC]); 2710 2711(* Theorem: (LENGTH l1 = LENGTH l2) /\ (!k. k <= LENGTH l1 ==> EL k l1 <= EL k l2) ==> SUM l1 <= SUM l2 *) 2712(* Proof: 2713 By induction on l1. 2714 Base: LENGTH [] = LENGTH l2 ==> SUM [] <= SUM l2 2715 Note l2 = [] by LENGTH_EQ_0 2716 so SUM [] = SUM [] 2717 or SUM [] <= SUM l2 by EQ_LESS_EQ 2718 Step: !l2. (LENGTH l1 = LENGTH l2) /\ ... ==> SUM l1 <= SUM l2 ==> 2719 (LENGTH (h::l1) = LENGTH l2) /\ ... ==> SUM h::l1 <= SUM l2 2720 Note l2 <> [] by LENGTH_EQ_0 2721 so ?h1 t2. l2 = h1::t1 by list_CASES 2722 and LENGTH l1 = LENGTH t1 by LENGTH 2723 SUM (h::l1) 2724 = h + SUM l1 by SUM_CONS 2725 <= h1 + SUM t1 by EL_ALL_PROPERTY, induction hypothesis 2726 = SUM l2 by SUM_CONS 2727*) 2728val SUM_LE = store_thm( 2729 "SUM_LE", 2730 ``!l1 l2. (LENGTH l1 = LENGTH l2) /\ (!k. k < LENGTH l1 ==> EL k l1 <= EL k l2) ==> 2731 SUM l1 <= SUM l2``, 2732 Induct >- 2733 metis_tac[LENGTH_EQ_0, EQ_LESS_EQ] >> 2734 rpt strip_tac >> 2735 `?h1 t1. l2 = h1::t1` by metis_tac[LENGTH_EQ_0, list_CASES] >> 2736 `LENGTH l1 = LENGTH t1` by metis_tac[LENGTH, SUC_EQ] >> 2737 `SUM (h::l1) = h + SUM l1` by rw[SUM_CONS] >> 2738 `SUM l2 = h1 + SUM t1` by rw[SUM_CONS] >> 2739 `(h <= h1) /\ SUM l1 <= SUM t1` by metis_tac[EL_ALL_PROPERTY] >> 2740 decide_tac); 2741 2742(* Theorem: MEM x l ==> x <= SUM l *) 2743(* Proof: 2744 By induction on l. 2745 Base: !x. MEM x [] ==> x <= SUM [] 2746 True since MEM x [] = F by MEM 2747 Step: !x. MEM x l ==> x <= SUM l ==> !h x. MEM x (h::l) ==> x <= SUM (h::l) 2748 If x = h, 2749 Then h <= h + SUM l = SUM (h::l) by SUM 2750 If x <> h, 2751 Then MEM x l by MEM 2752 ==> x <= SUM l by induction hypothesis 2753 or x <= h + SUM l = SUM (h::l) by SUM 2754*) 2755val SUM_LE_MEM = store_thm( 2756 "SUM_LE_MEM", 2757 ``!l x. MEM x l ==> x <= SUM l``, 2758 Induct >- 2759 rw[] >> 2760 rw[] >- 2761 decide_tac >> 2762 `x <= SUM l` by rw[] >> 2763 decide_tac); 2764 2765(* Theorem: n < LENGTH l ==> (EL n l) <= SUM l *) 2766(* Proof: by SUM_LE_MEM, MEM_EL *) 2767val SUM_LE_EL = store_thm( 2768 "SUM_LE_EL", 2769 ``!l n. n < LENGTH l ==> (EL n l) <= SUM l``, 2770 metis_tac[SUM_LE_MEM, MEM_EL]); 2771 2772(* Theorem: m < n /\ n < LENGTH l ==> (EL m l) + (EL n l) <= SUM l *) 2773(* Proof: 2774 By induction on l. 2775 Base: !m n. m < n /\ n < LENGTH [] ==> EL m [] + EL n [] <= SUM [] 2776 True since n < LENGTH [] = F by LENGTH 2777 Step: !m n. m < LENGTH l /\ n < LENGTH l ==> EL m l + EL n l <= SUM l ==> 2778 !h m n. m < LENGTH (h::l) /\ n < LENGTH (h::l) ==> EL m (h::l) + EL n (h::l) <= SUM (h::l) 2779 Note 0 < n, or n <> 0 by m < n 2780 so ?k. n = SUC k by num_CASES 2781 and k < LENGTH l by SUC k < SUC (LENGTH l) 2782 and EL n (h::l) = EL k l by EL_restricted 2783 If m = 0, 2784 Then EL m (h::l) = h by EL_restricted 2785 and EL k l <= SUM l by SUM_LE_EL 2786 Thus EL m (h::l) + EL n (h::l) 2787 = h + SUM l 2788 = SUM (h::l) by SUM 2789 If m <> 0, 2790 Then ?j. m = SUC j by num_CASES 2791 and j < k by SUC j < SUC k 2792 and EL m (h::l) = EL j l by EL_restricted 2793 Thus EL m (h::l) + EL n (h::l) 2794 = EL j l + EL k l by above 2795 <= SUM l by induction hypothesis 2796 <= h + SUM l by arithmetic 2797 = SUM (h::l) by SUM 2798*) 2799val SUM_LE_SUM_EL = store_thm( 2800 "SUM_LE_SUM_EL", 2801 ``!l m n. m < n /\ n < LENGTH l ==> (EL m l) + (EL n l) <= SUM l``, 2802 Induct >- 2803 rw[] >> 2804 rw[] >> 2805 `n <> 0` by decide_tac >> 2806 `?k. n = SUC k` by metis_tac[num_CASES] >> 2807 `k < LENGTH l` by decide_tac >> 2808 `EL n (h::l) = EL k l` by rw[] >> 2809 Cases_on `m = 0` >| [ 2810 `EL m (h::l) = h` by rw[] >> 2811 `EL k l <= SUM l` by rw[SUM_LE_EL] >> 2812 decide_tac, 2813 `?j. m = SUC j` by metis_tac[num_CASES] >> 2814 `j < k` by decide_tac >> 2815 `EL m (h::l) = EL j l` by rw[] >> 2816 `EL j l + EL k l <= SUM l` by rw[] >> 2817 decide_tac 2818 ]); 2819 2820(* Theorem: SUM (GENLIST (\j. n * 2 ** j) m) = n * (2 ** m - 1) *) 2821(* Proof: 2822 The computation is: 2823 n + (n * 2) + (n * 4) + ... + (n * (2 ** (m - 1))) 2824 = n * (1 + 2 + 4 + ... + 2 ** (m - 1)) 2825 = n * (2 ** m - 1) 2826 2827 By induction on m. 2828 Base: SUM (GENLIST (\j. n * 2 ** j) 0) = n * (2 ** 0 - 1) 2829 LHS = SUM (GENLIST (\j. n * 2 ** j) 0) 2830 = SUM [] by GENLIST_0 2831 = 0 by PROD 2832 RHS = n * (1 - 1) by EXP_0 2833 = n * 0 = 0 = LHS by MULT_0 2834 Step: SUM (GENLIST (\j. n * 2 ** j) m) = n * (2 ** m - 1) ==> 2835 SUM (GENLIST (\j. n * 2 ** j) (SUC m)) = n * (2 ** SUC m - 1) 2836 SUM (GENLIST (\j. n * 2 ** j) (SUC m)) 2837 = SUM (SNOC (n * 2 ** m) (GENLIST (\j. n * 2 ** j) m)) by GENLIST 2838 = SUM (GENLIST (\j. n * 2 ** j) m) + (n * 2 ** m) by SUM_SNOC 2839 = n * (2 ** m - 1) + n * 2 ** m by induction hypothesis 2840 = n * (2 ** m - 1 + 2 ** m) by LEFT_ADD_DISTRIB 2841 = n * (2 * 2 ** m - 1) by arithmetic 2842 = n * (2 ** SUC m - 1) by EXP 2843*) 2844val SUM_DOUBLING_LIST = store_thm( 2845 "SUM_DOUBLING_LIST", 2846 ``!m n. SUM (GENLIST (\j. n * 2 ** j) m) = n * (2 ** m - 1)``, 2847 rpt strip_tac >> 2848 Induct_on `m` >- 2849 rw[] >> 2850 qabbrev_tac `f = \j. n * 2 ** j` >> 2851 `SUM (GENLIST f (SUC m)) = SUM (SNOC (n * 2 ** m) (GENLIST f m))` by rw[GENLIST, Abbr`f`] >> 2852 `_ = SUM (GENLIST f m) + (n * 2 ** m)` by rw[SUM_SNOC] >> 2853 `_ = n * (2 ** m - 1) + n * 2 ** m` by rw[] >> 2854 `_ = n * (2 ** m - 1 + 2 ** m)` by rw[LEFT_ADD_DISTRIB] >> 2855 rw[EXP]); 2856 2857(* ------------------------------------------------------------------------- *) 2858(* Maximum of a List *) 2859(* ------------------------------------------------------------------------- *) 2860 2861(* Define MAX of a list *) 2862val MAX_LIST_def = Define` 2863 (MAX_LIST [] = 0) /\ 2864 (MAX_LIST (h::t) = MAX h (MAX_LIST t)) 2865`; 2866 2867(* export simple recursive definition *) 2868(* val _ = export_rewrites["MAX_LIST_def"]; *) 2869 2870(* Theorem: MAX_LIST [] = 0 *) 2871(* Proof: by MAX_LIST_def *) 2872val MAX_LIST_NIL = save_thm("MAX_LIST_NIL", MAX_LIST_def |> CONJUNCT1); 2873(* val MAX_LIST_NIL = |- MAX_LIST [] = 0: thm *) 2874 2875(* Theorem: MAX_LIST (h::t) = MAX h (MAX_LIST t) *) 2876(* Proof: by MAX_LIST_def *) 2877val MAX_LIST_CONS = save_thm("MAX_LIST_CONS", MAX_LIST_def |> CONJUNCT2); 2878(* val MAX_LIST_CONS = |- !h t. MAX_LIST (h::t) = MAX h (MAX_LIST t): thm *) 2879 2880(* export simple results *) 2881val _ = export_rewrites["MAX_LIST_NIL", "MAX_LIST_CONS"]; 2882 2883(* Theorem: MAX_LIST [x] = x *) 2884(* Proof: 2885 MAX_LIST [x] 2886 = MAX x (MAX_LIST []) by MAX_LIST_CONS 2887 = MAX x 0 by MAX_LIST_NIL 2888 = x by MAX_0 2889*) 2890val MAX_LIST_SING = store_thm( 2891 "MAX_LIST_SING", 2892 ``!x. MAX_LIST [x] = x``, 2893 rw[]); 2894 2895(* Theorem: (MAX_LIST l = 0) <=> EVERY (\x. x = 0) l *) 2896(* Proof: 2897 By induction on l. 2898 Base: (MAX_LIST [] = 0) <=> EVERY (\x. x = 0) [] 2899 LHS: MAX_LIST [] = 0, true by MAX_LIST_NIL 2900 RHS: EVERY (\x. x = 0) [], true by EVERY_DEF 2901 Step: (MAX_LIST l = 0) <=> EVERY (\x. x = 0) l ==> 2902 !h. (MAX_LIST (h::l) = 0) <=> EVERY (\x. x = 0) (h::l) 2903 MAX_LIST (h::l) = 0 2904 <=> MAX h (MAX_LIST l) = 0 by MAX_LIST_CONS 2905 <=> (h = 0) /\ (MAX_LIST l = 0) by MAX_EQ_0 2906 <=> (h = 0) /\ EVERY (\x. x = 0) l by induction hypothesis 2907 <=> EVERY (\x. x = 0) (h::l) by EVERY_DEF 2908*) 2909val MAX_LIST_EQ_0 = store_thm( 2910 "MAX_LIST_EQ_0", 2911 ``!l. (MAX_LIST l = 0) <=> EVERY (\x. x = 0) l``, 2912 Induct >> 2913 rw[MAX_EQ_0]); 2914 2915(* Theorem: l <> [] ==> MEM (MAX_LIST l) l *) 2916(* Proof: 2917 By induction on l. 2918 Base: [] <> [] ==> MEM (MAX_LIST []) [] 2919 Trivially true by [] <> [] = F. 2920 Step: l <> [] ==> MEM (MAX_LIST l) l ==> 2921 !h. h::l <> [] ==> MEM (MAX_LIST (h::l)) (h::l) 2922 If l = [], 2923 Note MAX_LIST [h] = h by MAX_LIST_SING 2924 and MEM h [h] by MEM 2925 Hence true. 2926 If l <> [], 2927 Let x = MAX_LIST (h::l) 2928 = MAX h (MAX_LIST l) by MAX_LIST_CONS 2929 ==> x = h \/ x = MAX_LIST l by MAX_CASES 2930 If x = h, MEM x (h::l) by MEM 2931 If x = MAX_LIST l, MEM x l by induction hypothesis 2932*) 2933val MAX_LIST_MEM = store_thm( 2934 "MAX_LIST_MEM", 2935 ``!l. l <> [] ==> MEM (MAX_LIST l) l``, 2936 Induct >- 2937 rw[] >> 2938 rpt strip_tac >> 2939 Cases_on `l = []` >- 2940 rw[] >> 2941 rw[] >> 2942 metis_tac[MAX_CASES]); 2943 2944(* Theorem: MEM x l ==> x <= MAX_LIST l *) 2945(* Proof: 2946 By induction on l. 2947 Base: !x. MEM x [] ==> x <= MAX_LIST [] 2948 Trivially true since MEM x [] = F by MEM 2949 Step: !x. MEM x l ==> x <= MAX_LIST l ==> !h x. MEM x (h::l) ==> x <= MAX_LIST (h::l) 2950 Note MEM x (h::l) means (x = h) \/ MEM x l by MEM 2951 and MAX_LIST (h::l) = MAX h (MAX_LIST l) by MAX_LIST_CONS 2952 If x = h, x <= MAX h (MAX_LIST l) by MAX_LE 2953 If MEM x l, x <= MAX_LIST l by induction hypothesis 2954 or x <= MAX h (MAX_LIST l) by MAX_LE, LESS_EQ_TRANS 2955*) 2956val MAX_LIST_PROPERTY = store_thm( 2957 "MAX_LIST_PROPERTY", 2958 ``!l x. MEM x l ==> x <= MAX_LIST l``, 2959 Induct >- 2960 rw[] >> 2961 rw[MAX_LIST_CONS] >- 2962 decide_tac >> 2963 rw[]); 2964 2965(* Theorem: l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> y <= x) ==> (x = MAX_LIST l) *) 2966(* Proof: 2967 Let m = MAX_LIST l. 2968 Since MEM x l /\ x <= m by MAX_LIST_PROPERTY 2969 and MEM m l ==> m <= x by MAX_LIST_MEM, implication, l <> [] 2970 Hence x = m by EQ_LESS_EQ 2971*) 2972val MAX_LIST_TEST = store_thm( 2973 "MAX_LIST_TEST", 2974 ``!l. l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> y <= x) ==> (x = MAX_LIST l)``, 2975 metis_tac[MAX_LIST_MEM, MAX_LIST_PROPERTY, EQ_LESS_EQ]); 2976 2977(* Theorem: MAX_LIST t <= MAX_LIST (h::t) *) 2978(* Proof: 2979 Note MAX_LIST (h::t) = MAX h (MAX_LIST t) by MAX_LIST_def 2980 and MAX_LIST t <= MAX h (MAX_LIST t) by MAX_IS_MAX 2981 Thus MAX_LIST t <= MAX_LIST (h::t) 2982*) 2983val MAX_LIST_LE = store_thm( 2984 "MAX_LIST_LE", 2985 ``!h t. MAX_LIST t <= MAX_LIST (h::t)``, 2986 rw_tac std_ss[MAX_LIST_def]); 2987 2988(* Theorem: (!x y. x <= y ==> f x <= f y) ==> 2989 !ls. ls <> [] ==> (MAX_LIST (MAP f ls) = f (MAX_LIST ls)) *) 2990(* Proof: 2991 By induction on ls. 2992 Base: [] <> [] ==> MAX_LIST (MAP f []) = f (MAX_LIST []) 2993 True by [] <> [] = F. 2994 Step: ls <> [] ==> MAX_LIST (MAP f ls) = f (MAX_LIST ls) ==> 2995 !h. h::ls <> [] ==> MAX_LIST (MAP f (h::ls)) = f (MAX_LIST (h::ls)) 2996 If ls = [], 2997 MAX_LIST (MAP f [h]) 2998 = MAX_LIST [f h] by MAP 2999 = f h by MAX_LIST_def 3000 = f (MAX_LIST [h]) by MAX_LIST_def 3001 If ls <> [], 3002 MAX_LIST (MAP f (h::ls)) 3003 = MAX_LIST (f h::MAP f ls) by MAP 3004 = MAX (f h) MAX_LIST (MAP f ls) by MAX_LIST_def 3005 = MAX (f h) (f (MAX_LIST ls)) by induction hypothesis 3006 = f (MAX h (MAX_LIST ls)) by MAX_SWAP 3007 = f (MAX_LIST (h::ls)) by MAX_LIST_def 3008*) 3009val MAX_LIST_MONO_MAP = store_thm( 3010 "MAX_LIST_MONO_MAP", 3011 ``!f. (!x y. x <= y ==> f x <= f y) ==> 3012 !ls. ls <> [] ==> (MAX_LIST (MAP f ls) = f (MAX_LIST ls))``, 3013 rpt strip_tac >> 3014 Induct_on `ls` >- 3015 rw[] >> 3016 rpt strip_tac >> 3017 Cases_on `ls = []` >- 3018 rw[] >> 3019 rw[MAX_SWAP]); 3020 3021(* ------------------------------------------------------------------------- *) 3022(* Minimum of a List *) 3023(* ------------------------------------------------------------------------- *) 3024 3025(* Define MIN of a list *) 3026val MIN_LIST_def = Define` 3027 MIN_LIST (h::t) = if t = [] then h else MIN h (MIN_LIST t) 3028`; 3029 3030(* Theorem: MIN_LIST [x] = x *) 3031(* Proof: by MIN_LIST_def *) 3032val MIN_LIST_SING = store_thm( 3033 "MIN_LIST_SING", 3034 ``!x. MIN_LIST [x] = x``, 3035 rw[MIN_LIST_def]); 3036 3037(* Theorem: t <> [] ==> (MIN_LIST (h::t) = MIN h (MIN_LIST t)) *) 3038(* Proof: by MIN_LIST_def *) 3039val MIN_LIST_CONS = store_thm( 3040 "MIN_LIST_CONS", 3041 ``!h t. t <> [] ==> (MIN_LIST (h::t) = MIN h (MIN_LIST t))``, 3042 rw[MIN_LIST_def]); 3043 3044(* export simple results *) 3045val _ = export_rewrites["MIN_LIST_SING", "MIN_LIST_CONS"]; 3046 3047(* Theorem: l <> [] ==> MEM (MIN_LIST l) l *) 3048(* Proof: 3049 By induction on l. 3050 Base: [] <> [] ==> MEM (MIN_LIST []) [] 3051 Trivially true by [] <> [] = F. 3052 Step: l <> [] ==> MEM (MIN_LIST l) l ==> 3053 !h. h::l <> [] ==> MEM (MIN_LIST (h::l)) (h::l) 3054 If l = [], 3055 Note MIN_LIST [h] = h by MIN_LIST_SING 3056 and MEM h [h] by MEM 3057 Hence true. 3058 If l <> [], 3059 Let x = MIN_LIST (h::l) 3060 = MIN h (MIN_LIST l) by MIN_LIST_CONS 3061 ==> x = h \/ x = MIN_LIST l by MIN_CASES 3062 If x = h, MEM x (h::l) by MEM 3063 If x = MIN_LIST l, MEM x l by induction hypothesis 3064*) 3065val MIN_LIST_MEM = store_thm( 3066 "MIN_LIST_MEM", 3067 ``!l. l <> [] ==> MEM (MIN_LIST l) l``, 3068 Induct >- 3069 rw[] >> 3070 rpt strip_tac >> 3071 Cases_on `l = []` >- 3072 rw[] >> 3073 rw[] >> 3074 metis_tac[MIN_CASES]); 3075 3076(* Theorem: l <> [] ==> !x. MEM x l ==> (MIN_LIST l) <= x *) 3077(* Proof: 3078 By induction on l. 3079 Base: [] <> [] ==> ... 3080 Trivially true since [] <> [] = F 3081 Step: l <> [] ==> !x. MEM x l ==> MIN_LIST l <= x ==> 3082 !h. h::l <> [] ==> !x. MEM x (h::l) ==> MIN_LIST (h::l) <= x 3083 Note MEM x (h::l) means (x = h) \/ MEM x l by MEM 3084 If l = [], 3085 MEM x [h] means x = h by MEM 3086 and MIN_LIST [h] = h, hence true by MIN_LIST_SING 3087 If l <> [], 3088 MIN_LIST (h::l) = MIN h (MIN_LIST l) by MIN_LIST_CONS 3089 If x = h, MIN h (MIN_LIST l) <= x by MIN_LE 3090 If MEM x l, MIN_LIST l <= x by induction hypothesis 3091 or MIN h (MIN_LIST l) <= x by MIN_LE, LESS_EQ_TRANS 3092*) 3093val MIN_LIST_PROPERTY = store_thm( 3094 "MIN_LIST_PROPERTY", 3095 ``!l. l <> [] ==> !x. MEM x l ==> (MIN_LIST l) <= x``, 3096 Induct >- 3097 rw[] >> 3098 rpt strip_tac >> 3099 Cases_on `l = []` >- 3100 fs[MIN_LIST_SING, MEM] >> 3101 fs[MIN_LIST_CONS, MEM]); 3102 3103(* Theorem: l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> x <= y) ==> (x = MIN_LIST l) *) 3104(* Proof: 3105 Let m = MIN_LIST l. 3106 Since MEM x l /\ m <= x by MIN_LIST_PROPERTY 3107 and MEM m l ==> x <= m by MIN_LIST_MEM, implication, l <> [] 3108 Hence x = m by EQ_LESS_EQ 3109*) 3110val MIN_LIST_TEST = store_thm( 3111 "MIN_LIST_TEST", 3112 ``!l. l <> [] ==> !x. MEM x l /\ (!y. MEM y l ==> x <= y) ==> (x = MIN_LIST l)``, 3113 metis_tac[MIN_LIST_MEM, MIN_LIST_PROPERTY, EQ_LESS_EQ]); 3114 3115(* Theorem: l <> [] ==> MIN_LIST l <= MAX_LIST l *) 3116(* Proof: 3117 Since MEM (MIN_LIST l) l by MIN_LIST_MEM 3118 so MIN_LIST l <= MAX_LIST l by MAX_LIST_PROPERTY 3119*) 3120val MIN_LIST_LE_MAX_LIST = store_thm( 3121 "MIN_LIST_LE_MAX_LIST", 3122 ``!l. l <> [] ==> MIN_LIST l <= MAX_LIST l``, 3123 rw[MIN_LIST_MEM, MAX_LIST_PROPERTY]); 3124 3125(* Theorem: t <> [] ==> MIN_LIST (h::t) <= MIN_LIST t *) 3126(* Proof: 3127 Note MIN_LIST (h::t) = MIN h (MIN_LIST t) by MIN_LIST_def, t <> [] 3128 and MIN h (MIN_LIST t) <= MIN_LIST t by MIN_IS_MIN 3129 Thus MIN_LIST (h::t) <= MIN_LIST t 3130*) 3131val MIN_LIST_LE = store_thm( 3132 "MIN_LIST_LE", 3133 ``!h t. t <> [] ==> MIN_LIST (h::t) <= MIN_LIST t``, 3134 rw_tac std_ss[MIN_LIST_def]); 3135 3136(* Theorem: (!x y. x <= y ==> f x <= f y) ==> 3137 !ls. ls <> [] ==> (MIN_LIST (MAP f ls) = f (MIN_LIST ls)) *) 3138(* Proof: 3139 By induction on ls. 3140 Base: [] <> [] ==> MIN_LIST (MAP f []) = f (MIN_LIST []) 3141 True by [] <> [] = F. 3142 Step: ls <> [] ==> MIN_LIST (MAP f ls) = f (MIN_LIST ls) ==> 3143 !h. h::ls <> [] ==> MIN_LIST (MAP f (h::ls)) = f (MIN_LIST (h::ls)) 3144 If ls = [], 3145 MIN_LIST (MAP f [h]) 3146 = MIN_LIST [f h] by MAP 3147 = f h by MIN_LIST_def 3148 = f (MIN_LIST [h]) by MIN_LIST_def 3149 If ls <> [], 3150 MIN_LIST (MAP f (h::ls)) 3151 = MIN_LIST (f h::MAP f ls) by MAP 3152 = MIN (f h) MIN_LIST (MAP f ls) by MIN_LIST_def 3153 = MIN (f h) (f (MIN_LIST ls)) by induction hypothesis 3154 = f (MIN h (MIN_LIST ls)) by MIN_SWAP 3155 = f (MIN_LIST (h::ls)) by MIN_LIST_def 3156*) 3157val MIN_LIST_MONO_MAP = store_thm( 3158 "MIN_LIST_MONO_MAP", 3159 ``!f. (!x y. x <= y ==> f x <= f y) ==> 3160 !ls. ls <> [] ==> (MIN_LIST (MAP f ls) = f (MIN_LIST ls))``, 3161 rpt strip_tac >> 3162 Induct_on `ls` >- 3163 rw[] >> 3164 rpt strip_tac >> 3165 Cases_on `ls = []` >- 3166 rw[] >> 3167 rw[MIN_SWAP]); 3168 3169(* ------------------------------------------------------------------------- *) 3170(* List Nub and Set *) 3171(* ------------------------------------------------------------------------- *) 3172 3173(* Note: 3174> nub_def; 3175|- (nub [] = []) /\ !x l. nub (x::l) = if MEM x l then nub l else x::nub l 3176*) 3177 3178(* Theorem: nub [] = [] *) 3179(* Proof: by nub_def *) 3180val nub_nil = save_thm("nub_nil", nub_def |> CONJUNCT1); 3181(* val nub_nil = |- nub [] = []: thm *) 3182 3183(* Theorem: nub (x::l) = if MEM x l then nub l else x::nub l *) 3184(* Proof: by nub_def *) 3185val nub_cons = save_thm("nub_cons", nub_def |> CONJUNCT2); 3186(* val nub_cons = |- !x l. nub (x::l) = if MEM x l then nub l else x::nub l: thm *) 3187 3188(* Theorem: nub [x] = [x] *) 3189(* Proof: 3190 nub [x] 3191 = nub (x::[]) by notation 3192 = x :: nub [] by nub_cons, MEM x [] = F 3193 = x ::[] by nub_nil 3194 = [x] by notation 3195*) 3196val nub_sing = store_thm( 3197 "nub_sing", 3198 ``!x. nub [x] = [x]``, 3199 rw[nub_def]); 3200 3201(* Theorem: ALL_DISTINCT (nub l) *) 3202(* Proof: 3203 By induction on l. 3204 Base: ALL_DISTINCT (nub []) 3205 ALL_DISTINCT (nub []) 3206 <=> ALL_DISTINCT [] by nub_nil 3207 <=> T by ALL_DISTINCT 3208 Step: ALL_DISTINCT (nub l) ==> !h. ALL_DISTINCT (nub (h::l)) 3209 If MEM h l, 3210 Then nub (h::l) = nub l by nub_cons 3211 Thus ALL_DISTINCT (nub l) by induction hypothesis 3212 ==> ALL_DISTINCT (nub (h::l)) 3213 If ~(MEM h l), 3214 Then nub (h::l) = h:nub l by nub_cons 3215 With ALL_DISTINCT (nub l) by induction hypothesis 3216 ==> ALL_DISTINCT (h::nub l) by ALL_DISTINCT, ~(MEM h l) 3217 or ALL_DISTINCT (nub (h::l)) 3218*) 3219val nub_all_distinct = store_thm( 3220 "nub_all_distinct", 3221 ``!l. ALL_DISTINCT (nub l)``, 3222 Induct >- 3223 rw[nub_nil] >> 3224 rw[nub_cons]); 3225 3226(* Theorem: CARD (set l) = LENGTH (nub l) *) 3227(* Proof: 3228 Note set (nub l) = set l by nub_set 3229 and ALL_DISTINCT (nub l) by nub_all_distinct 3230 CARD (set l) 3231 = CARD (set (nub l)) by above 3232 = LENGTH (nub l) by ALL_DISTINCT_CARD_LIST_TO_SET, ALL_DISTINCT (nub l) 3233*) 3234val CARD_LIST_TO_SET_EQ = store_thm( 3235 "CARD_LIST_TO_SET_EQ", 3236 ``!l. CARD (set l) = LENGTH (nub l)``, 3237 rpt strip_tac >> 3238 `set (nub l) = set l` by rw[nub_set] >> 3239 `ALL_DISTINCT (nub l)` by rw[nub_all_distinct] >> 3240 rw[GSYM ALL_DISTINCT_CARD_LIST_TO_SET]); 3241 3242(* Theorem: set [x] = {x} *) 3243(* Proof: 3244 set [x] 3245 = x INSERT set [] by LIST_TO_SET 3246 = x INSERT {} by LIST_TO_SET 3247 = {x} by INSERT_DEF 3248*) 3249val MONO_LIST_TO_SET = store_thm( 3250 "MONO_LIST_TO_SET", 3251 ``!x. set [x] = {x}``, 3252 rw[]); 3253 3254(* Theorem: ALL_DISTINCT l /\ (set l = {x}) <=> (l = [x]) *) 3255(* Proof: 3256 If part: ALL_DISTINCT l /\ set l = {x} ==> l = [x] 3257 Note set l = {x} 3258 ==> l <> [] /\ EVERY ($= x) l by LIST_TO_SET_EQ_SING 3259 Let P = (S= x). 3260 Note l <> [] ==> ?h t. l = h::t by list_CASES 3261 so h = x /\ EVERY P t by EVERY_DEF 3262 and ~(MEM h t) /\ ALL_DISTINCT t by ALL_DISTINCT 3263 By contradiction, suppose l <> [x]. 3264 Then t <> [] ==> ?u v. t = u::v by list_CASES 3265 and MEM u t by MEM 3266 but u = h by EVERY_DEF 3267 ==> MEM h t, which contradicts ~(MEM h t). 3268 3269 Only-if part: l = [x] ==> ALL_DISTINCT l /\ set l = {x} 3270 Note ALL_DISTINCT [x] = T by ALL_DISTINCT_SING 3271 and set [x] = {x} by MONO_LIST_TO_SET 3272*) 3273val DISTINCT_LIST_TO_SET_EQ_SING = store_thm( 3274 "DISTINCT_LIST_TO_SET_EQ_SING", 3275 ``!l x. ALL_DISTINCT l /\ (set l = {x}) <=> (l = [x])``, 3276 rw[EQ_IMP_THM] >> 3277 qabbrev_tac `P = ($= x)` >> 3278 `!y. P y ==> (y = x)` by rw[Abbr`P`] >> 3279 `l <> [] /\ EVERY P l` by metis_tac[LIST_TO_SET_EQ_SING, Abbr`P`] >> 3280 `?h t. l = h::t` by metis_tac[list_CASES] >> 3281 `(h = x) /\ (EVERY P t)` by metis_tac[EVERY_DEF] >> 3282 `~(MEM h t) /\ ALL_DISTINCT t` by metis_tac[ALL_DISTINCT] >> 3283 spose_not_then strip_assume_tac >> 3284 `t <> []` by rw[] >> 3285 `?u v. t = u::v` by metis_tac[list_CASES] >> 3286 `MEM u t` by rw[] >> 3287 metis_tac[EVERY_DEF]); 3288 3289(* Theorem: ALL_DISTINCT l ==> !x. MEM x l <=> ?p1 p2. (l = p1 ++ [x] ++ p2) /\ ~MEM x p1 /\ ~MEM x p2 *) 3290(* Proof: 3291 If part: MEM x l ==> ?p1 p2. (l = p1 ++ [x] ++ p2) /\ ~MEM x p1 /\ ~MEM x p2 3292 Note ?p1 p2. (l = p1 ++ [x] ++ p2) /\ ~MEM x p2 by MEM_SPLIT_APPEND_last 3293 Now ALL_DISTINCT (p1 ++ [x]) by ALL_DISTINCT_APPEND, ALL_DISTINCT l 3294 But MEM x [x] by MEM 3295 so ~MEM x p1 by ALL_DISTINCT_APPEND 3296 3297 Only-if part: MEM x (p1 ++ [x] ++ p2), true by MEM_APPEND 3298*) 3299val MEM_SPLIT_APPEND_distinct = store_thm( 3300 "MEM_SPLIT_APPEND_distinct", 3301 ``!l. ALL_DISTINCT l ==> !x. MEM x l <=> ?p1 p2. (l = p1 ++ [x] ++ p2) /\ ~MEM x p1 /\ ~MEM x p2``, 3302 rw[EQ_IMP_THM] >- 3303 metis_tac[MEM_SPLIT_APPEND_last, ALL_DISTINCT_APPEND, MEM] >> 3304 rw[]); 3305 3306(* Theorem: ~(MEM h l1) /\ (set (h::l1) = set l2) ==> 3307 ?p1 p2. ~(MEM h p1) /\ ~(MEM h p2) /\ (nub l2 = p1 ++ [h] ++ p2) /\ (set l1 = set (p1 ++ p2)) *) 3308(* Proof: 3309 Note MEM h (h::l1) by MEM 3310 or h IN set (h::l1) by notation 3311 so h IN set l2 by given 3312 or h IN set (nub l2) by nub_set 3313 so MEM h (nub l2) by notation 3314 or ?p1 p2. nub l2 = p1 ++ [h] ++ h2 3315 and ~(MEM h p1) /\ ~(MEM h p2) by MEM_SPLIT_APPEND_distinct 3316 Remaining goal: set l1 = set (p1 ++ p2) 3317 3318 Step 1: show set l1 SUBSET set (p1 ++ p2) 3319 Let x IN set l1. 3320 Then MEM x l1 ==> MEM x (h::l1) by MEM 3321 so x IN set (h::l1) 3322 or x IN set l2 by given 3323 or x IN set (nub l2) by nub_set 3324 or MEM x (nub l2) by notation 3325 But h <> x since MEM x l1 but ~MEM h l1 3326 so MEM x (p1 ++ p2) by MEM, MEM_APPEND 3327 or x IN set (p1 ++ p2) by notation 3328 Thus l1 SUBSET set (p1 ++ p2) by SUBSET_DEF 3329 3330 Step 2: show set (p1 ++ p2) SUBSET set l1 3331 Let x IN set (p1 ++ p2) 3332 or MEM x (p1 ++ p2) by notation 3333 so MEM x (nub l2) by MEM, MEM_APPEND 3334 or x IN set (nub l2) by notation 3335 ==> x IN set l2 by nub_set 3336 or x IN set (h::l1) by given 3337 or MEM x (h::l1) by notation 3338 But x <> h by MEM_APPEND, MEM x (p1 ++ p2) but ~(MEM h p1) /\ ~(MEM h p2) 3339 ==> MEM x l1 by MEM 3340 or x IN set l1 by notation 3341 Thus set (p1 ++ p2) SUBSET set l1 by SUBSET_DEF 3342 3343 Thus set l1 = set (p1 ++ p2) by SUBSET_ANTISYM 3344*) 3345val LIST_TO_SET_REDUCTION = store_thm( 3346 "LIST_TO_SET_REDUCTION", 3347 ``!l1 l2 h. ~(MEM h l1) /\ (set (h::l1) = set l2) ==> 3348 ?p1 p2. ~(MEM h p1) /\ ~(MEM h p2) /\ (nub l2 = p1 ++ [h] ++ p2) /\ (set l1 = set (p1 ++ p2))``, 3349 rpt strip_tac >> 3350 `MEM h (nub l2)` by metis_tac[MEM, nub_set] >> 3351 qabbrev_tac `l = nub l2` >> 3352 `?n. n < LENGTH l /\ (h = EL n l)` by rw[GSYM MEM_EL] >> 3353 `ALL_DISTINCT l` by rw[nub_all_distinct, Abbr`l`] >> 3354 `?p1 p2. (l = p1 ++ [h] ++ p2) /\ ~MEM h p1 /\ ~MEM h p2` by rw[GSYM MEM_SPLIT_APPEND_distinct] >> 3355 qexists_tac `p1` >> 3356 qexists_tac `p2` >> 3357 rpt strip_tac >- 3358 rw[] >> 3359 `set l1 SUBSET set (p1 ++ p2) /\ set (p1 ++ p2) SUBSET set l1` suffices_by metis_tac[SUBSET_ANTISYM] >> 3360 rewrite_tac[SUBSET_DEF] >> 3361 rpt strip_tac >- 3362 metis_tac[MEM_APPEND, MEM, nub_set] >> 3363 metis_tac[MEM_APPEND, MEM, nub_set]); 3364 3365(* ------------------------------------------------------------------------- *) 3366(* List Padding *) 3367(* ------------------------------------------------------------------------- *) 3368 3369(* Theorem: PAD_LEFT c n [] = GENLIST (K c) n *) 3370(* Proof: by PAD_LEFT *) 3371val PAD_LEFT_NIL = store_thm( 3372 "PAD_LEFT_NIL", 3373 ``!n c. PAD_LEFT c n [] = GENLIST (K c) n``, 3374 rw[PAD_LEFT]); 3375 3376(* Theorem: PAD_RIGHT c n [] = GENLIST (K c) n *) 3377(* Proof: by PAD_RIGHT *) 3378val PAD_RIGHT_NIL = store_thm( 3379 "PAD_RIGHT_NIL", 3380 ``!n c. PAD_RIGHT c n [] = GENLIST (K c) n``, 3381 rw[PAD_RIGHT]); 3382 3383(* Theorem: LENGTH (PAD_LEFT c n s) = MAX n (LENGTH s) *) 3384(* Proof: 3385 LENGTH (PAD_LEFT c n s) 3386 = LENGTH (GENLIST (K c) (n - LENGTH s) ++ s) by PAD_LEFT 3387 = LENGTH (GENLIST (K c) (n - LENGTH s)) + LENGTH s by LENGTH_APPEND 3388 = n - LENGTH s + LENGTH s by LENGTH_GENLIST 3389 = MAX n (LENGTH s) by MAX_DEF 3390*) 3391val PAD_LEFT_LENGTH = store_thm( 3392 "PAD_LEFT_LENGTH", 3393 ``!n c s. LENGTH (PAD_LEFT c n s) = MAX n (LENGTH s)``, 3394 rw[PAD_LEFT, MAX_DEF]); 3395 3396(* Theorem: LENGTH (PAD_RIGHT c n s) = MAX n (LENGTH s) *) 3397(* Proof: 3398 LENGTH (PAD_LEFT c n s) 3399 = LENGTH (s ++ GENLIST (K c) (n - LENGTH s)) by PAD_RIGHT 3400 = LENGTH s + LENGTH (GENLIST (K c) (n - LENGTH s)) by LENGTH_APPEND 3401 = LENGTH s + (n - LENGTH s) by LENGTH_GENLIST 3402 = MAX n (LENGTH s) by MAX_DEF 3403*) 3404val PAD_RIGHT_LENGTH = store_thm( 3405 "PAD_RIGHT_LENGTH", 3406 ``!n c s. LENGTH (PAD_RIGHT c n s) = MAX n (LENGTH s)``, 3407 rw[PAD_RIGHT, MAX_DEF]); 3408 3409(* Theorem: n <= LENGTH l ==> (PAD_LEFT c n l = l) *) 3410(* Proof: 3411 Note n - LENGTH l = 0 by n <= LENGTH l 3412 PAD_LEFT c (LENGTH l) l 3413 = GENLIST (K c) 0 ++ l by PAD_LEFT 3414 = [] ++ l by GENLIST 3415 = l by APPEND 3416*) 3417val PAD_LEFT_ID = store_thm( 3418 "PAD_LEFT_ID", 3419 ``!l c n. n <= LENGTH l ==> (PAD_LEFT c n l = l)``, 3420 rpt strip_tac >> 3421 `n - LENGTH l = 0` by decide_tac >> 3422 rw[PAD_LEFT]); 3423 3424(* Theorem: n <= LENGTH l ==> (PAD_RIGHT c n l = l) *) 3425(* Proof: 3426 Note n - LENGTH l = 0 by n <= LENGTH l 3427 PAD_RIGHT c (LENGTH l) l 3428 = ll ++ GENLIST (K c) 0 by PAD_RIGHT 3429 = [] ++ l by GENLIST 3430 = l by APPEND_NIL 3431*) 3432val PAD_RIGHT_ID = store_thm( 3433 "PAD_RIGHT_ID", 3434 ``!l c n. n <= LENGTH l ==> (PAD_RIGHT c n l = l)``, 3435 rpt strip_tac >> 3436 `n - LENGTH l = 0` by decide_tac >> 3437 rw[PAD_RIGHT]); 3438 3439(* Theorem: PAD_LEFT c 0 l = l *) 3440(* Proof: by PAD_LEFT_ID *) 3441val PAD_LEFT_0 = store_thm( 3442 "PAD_LEFT_0", 3443 ``!l c. PAD_LEFT c 0 l = l``, 3444 rw_tac std_ss[PAD_LEFT_ID]); 3445 3446(* Theorem: PAD_RIGHT c 0 l = l *) 3447(* Proof: by PAD_RIGHT_ID *) 3448val PAD_RIGHT_0 = store_thm( 3449 "PAD_RIGHT_0", 3450 ``!l c. PAD_RIGHT c 0 l = l``, 3451 rw_tac std_ss[PAD_RIGHT_ID]); 3452 3453(* Theorem: LENGTH l <= n ==> !c. PAD_LEFT c (SUC n) l = c:: PAD_LEFT c n l *) 3454(* Proof: 3455 PAD_LEFT c (SUC n) l 3456 = GENLIST (K c) (SUC n - LENGTH l) ++ l by PAD_LEFT 3457 = GENLIST (K c) (SUC (n - LENGTH l)) ++ l by LENGTH l <= n 3458 = SNOC c (GENLIST (K c) (n - LENGTH l)) ++ l by GENLIST 3459 = (GENLIST (K c) (n - LENGTH l)) ++ [c] ++ l by SNOC_APPEND 3460 = [c] ++ (GENLIST (K c) (n - LENGTH l)) ++ l by GENLIST_K_APPEND_K 3461 = [c] ++ ((GENLIST (K c) (n - LENGTH l)) ++ l) by APPEND_ASSOC 3462 = [c] ++ PAD_LEFT c n l by PAD_LEFT 3463 = c :: PAD_LEFT c n l by CONS_APPEND 3464*) 3465val PAD_LEFT_CONS = store_thm( 3466 "PAD_LEFT_CONS", 3467 ``!l n. LENGTH l <= n ==> !c. PAD_LEFT c (SUC n) l = c:: PAD_LEFT c n l``, 3468 rpt strip_tac >> 3469 qabbrev_tac `m = LENGTH l` >> 3470 `SUC n - m = SUC (n - m)` by decide_tac >> 3471 `PAD_LEFT c (SUC n) l = GENLIST (K c) (SUC n - m) ++ l` by rw[PAD_LEFT, Abbr`m`] >> 3472 `_ = SNOC c (GENLIST (K c) (n - m)) ++ l` by rw[GENLIST] >> 3473 `_ = (GENLIST (K c) (n - m)) ++ [c] ++ l` by rw[SNOC_APPEND] >> 3474 `_ = [c] ++ (GENLIST (K c) (n - m)) ++ l` by rw[GENLIST_K_APPEND_K] >> 3475 `_ = [c] ++ ((GENLIST (K c) (n - m)) ++ l)` by rw[APPEND_ASSOC] >> 3476 `_ = [c] ++ PAD_LEFT c n l` by rw[PAD_LEFT] >> 3477 `_ = c :: PAD_LEFT c n l` by rw[] >> 3478 rw[]); 3479 3480(* Theorem: LENGTH l <= n ==> !c. PAD_RIGHT c (SUC n) l = SNOC c (PAD_RIGHT c n l) *) 3481(* Proof: 3482 PAD_RIGHT c (SUC n) l 3483 = l ++ GENLIST (K c) (SUC n - LENGTH l) by PAD_RIGHT 3484 = l ++ GENLIST (K c) (SUC (n - LENGTH l)) by LENGTH l <= n 3485 = l ++ SNOC c (GENLIST (K c) (n - LENGTH l)) by GENLIST 3486 = SNOC c (l ++ (GENLIST (K c) (n - LENGTH l))) by APPEND_SNOC 3487 = SNOC c (PAD_RIGHT c n l) by PAD_RIGHT 3488*) 3489val PAD_RIGHT_SNOC = store_thm( 3490 "PAD_RIGHT_SNOC", 3491 ``!l n. LENGTH l <= n ==> !c. PAD_RIGHT c (SUC n) l = SNOC c (PAD_RIGHT c n l)``, 3492 rpt strip_tac >> 3493 qabbrev_tac `m = LENGTH l` >> 3494 `SUC n - m = SUC (n - m)` by decide_tac >> 3495 rw[PAD_RIGHT, GENLIST, APPEND_SNOC]); 3496 3497(* Theorem: h :: PAD_RIGHT c n t = PAD_RIGHT c (SUC n) (h::t) *) 3498(* Proof: 3499 h :: PAD_RIGHT c n t 3500 = h :: (t ++ GENLIST (K c) (n - LENGTH t)) by PAD_RIGHT 3501 = (h::t) ++ GENLIST (K c) (n - LENGTH t) by APPEND 3502 = (h::t) ++ GENLIST (K c) (SUC n - LENGTH (h::t)) by LENGTH 3503 = PAD_RIGHT c (SUC n) (h::t) by PAD_RIGHT 3504*) 3505val PAD_RIGHT_CONS = store_thm( 3506 "PAD_RIGHT_CONS", 3507 ``!h t c n. h :: PAD_RIGHT c n t = PAD_RIGHT c (SUC n) (h::t)``, 3508 rw[PAD_RIGHT]); 3509 3510(* Theorem: l <> [] ==> (LAST (PAD_LEFT c n l) = LAST l) *) 3511(* Proof: 3512 Note ?h t. l = h::t by list_CASES 3513 LAST (PAD_LEFT c n l) 3514 = LAST (GENLIST (K c) (n - LENGTH (h::t)) ++ (h::t)) by PAD_LEFT 3515 = LAST (h::t) by LAST_APPEND_CONS 3516 = LAST l by notation 3517*) 3518val PAD_LEFT_LAST = store_thm( 3519 "PAD_LEFT_LAST", 3520 ``!l c n. l <> [] ==> (LAST (PAD_LEFT c n l) = LAST l)``, 3521 rpt strip_tac >> 3522 `?h t. l = h::t` by metis_tac[list_CASES] >> 3523 rw[PAD_LEFT, LAST_APPEND_CONS]); 3524 3525(* Theorem: (PAD_LEFT c n l = []) <=> ((l = []) /\ (n = 0)) *) 3526(* Proof: 3527 PAD_LEFT c n l = [] 3528 <=> GENLIST (K c) (n - LENGTH l) ++ l = [] by PAD_LEFT 3529 <=> GENLIST (K c) (n - LENGTH l) = [] /\ l = [] by APPEND_eq_NIL 3530 <=> GENLIST (K c) n = [] /\ l = [] by LENGTH l = 0 3531 <=> n = 0 /\ l = [] by GENLIST_EQ_NIL 3532*) 3533val PAD_LEFT_EQ_NIL = store_thm( 3534 "PAD_LEFT_EQ_NIL", 3535 ``!l c n. (PAD_LEFT c n l = []) <=> ((l = []) /\ (n = 0))``, 3536 rw[PAD_LEFT, EQ_IMP_THM] >> 3537 fs[GENLIST_EQ_NIL]); 3538 3539(* Theorem: (PAD_RIGHT c n l = []) <=> ((l = []) /\ (n = 0)) *) 3540(* Proof: 3541 PAD_RIGHT c n l = [] 3542 <=> l ++ GENLIST (K c) (n - LENGTH l) = [] by PAD_RIGHT 3543 <=> l = [] /\ GENLIST (K c) (n - LENGTH l) = [] by APPEND_eq_NIL 3544 <=> l = [] /\ GENLIST (K c) n = [] by LENGTH l = 0 3545 <=> l = [] /\ n = 0 by GENLIST_EQ_NIL 3546*) 3547val PAD_RIGHT_EQ_NIL = store_thm( 3548 "PAD_RIGHT_EQ_NIL", 3549 ``!l c n. (PAD_RIGHT c n l = []) <=> ((l = []) /\ (n = 0))``, 3550 rw[PAD_RIGHT, EQ_IMP_THM] >> 3551 fs[GENLIST_EQ_NIL]); 3552 3553(* Theorem: 0 < n ==> (PAD_LEFT c n [] = PAD_LEFT c n [c]) *) 3554(* Proof: 3555 PAD_LEFT c n [] 3556 = GENLIST (K c) n by PAD_LEFT, APPEND_NIL 3557 = GENLIST (K c) (SUC k) by n = SUC k, 0 < n 3558 = SNOC c (GENLIST (K c) k) by GENLIST, (K c) k = c 3559 = GENLIST (K c) k ++ [c] by SNOC_APPEND 3560 = PAD_LEFT c n [c] by PAD_LEFT 3561*) 3562val PAD_LEFT_NIL_EQ = store_thm( 3563 "PAD_LEFT_NIL_EQ", 3564 ``!n c. 0 < n ==> (PAD_LEFT c n [] = PAD_LEFT c n [c])``, 3565 rw[PAD_LEFT] >> 3566 `SUC (n - 1) = n` by decide_tac >> 3567 qabbrev_tac `f = (K c):num -> 'a` >> 3568 `f (n - 1) = c` by rw[Abbr`f`] >> 3569 metis_tac[SNOC_APPEND, GENLIST]); 3570 3571(* Theorem: 0 < n ==> (PAD_RIGHT c n [] = PAD_RIGHT c n [c]) *) 3572(* Proof: 3573 PAD_RIGHT c n [] 3574 = GENLIST (K c) n by PAD_RIGHT 3575 = GENLIST (K c) (SUC (n - 1)) by 0 < n 3576 = c :: GENLIST (K c) (n - 1) by GENLIST_K_CONS 3577 = [c] ++ GENLIST (K c) (n - 1) by CONS_APPEND 3578 = PAD_RIGHT c (SUC (n - 1)) [c] by PAD_RIGHT 3579 = PAD_RIGHT c n [c] by 0 < n 3580*) 3581val PAD_RIGHT_NIL_EQ = store_thm( 3582 "PAD_RIGHT_NIL_EQ", 3583 ``!n c. 0 < n ==> (PAD_RIGHT c n [] = PAD_RIGHT c n [c])``, 3584 rw[PAD_RIGHT] >> 3585 `SUC (n - 1) = n` by decide_tac >> 3586 metis_tac[GENLIST_K_CONS]); 3587 3588(* Theorem: PAD_RIGHT c n ls = ls ++ PAD_RIGHT c (n - LENGTH ls) [] *) 3589(* Proof: 3590 PAD_RIGHT c n ls 3591 = ls ++ GENLIST (K c) (n - LENGTH ls) by PAD_RIGHT 3592 = ls ++ ([] ++ GENLIST (K c) ((n - LENGTH ls) - 0) by APPEND_NIL, LENGTH 3593 = ls ++ PAD_RIGHT c (n - LENGTH ls) [] by PAD_RIGHT 3594*) 3595val PAD_RIGHT_BY_RIGHT = store_thm( 3596 "PAD_RIGHT_BY_RIGHT", 3597 ``!ls c n. PAD_RIGHT c n ls = ls ++ PAD_RIGHT c (n - LENGTH ls) []``, 3598 rw[PAD_RIGHT]); 3599 3600(* Theorem: PAD_RIGHT c n ls = ls ++ PAD_LEFT c (n - LENGTH ls) [] *) 3601(* Proof: 3602 PAD_RIGHT c n ls 3603 = ls ++ GENLIST (K c) (n - LENGTH ls) by PAD_RIGHT 3604 = ls ++ (GENLIST (K c) ((n - LENGTH ls) - 0) ++ []) by APPEND_NIL, LENGTH 3605 = ls ++ PAD_LEFT c (n - LENGTH ls) [] by PAD_LEFT 3606*) 3607val PAD_RIGHT_BY_LEFT = store_thm( 3608 "PAD_RIGHT_BY_LEFT", 3609 ``!ls c n. PAD_RIGHT c n ls = ls ++ PAD_LEFT c (n - LENGTH ls) []``, 3610 rw[PAD_RIGHT, PAD_LEFT]); 3611 3612(* Theorem: PAD_LEFT c n ls = (PAD_RIGHT c (n - LENGTH ls) []) ++ ls *) 3613(* Proof: 3614 PAD_LEFT c n ls 3615 = GENLIST (K c) (n - LENGTH ls) ++ ls by PAD_LEFT 3616 = ([] ++ GENLIST (K c) ((n - LENGTH ls) - 0) ++ ls by APPEND_NIL, LENGTH 3617 = (PAD_RIGHT c (n - LENGTH ls) []) ++ ls by PAD_RIGHT 3618*) 3619val PAD_LEFT_BY_RIGHT = store_thm( 3620 "PAD_LEFT_BY_RIGHT", 3621 ``!ls c n. PAD_LEFT c n ls = (PAD_RIGHT c (n - LENGTH ls) []) ++ ls``, 3622 rw[PAD_RIGHT, PAD_LEFT]); 3623 3624(* Theorem: PAD_LEFT c n ls = (PAD_LEFT c (n - LENGTH ls) []) ++ ls *) 3625(* Proof: 3626 PAD_LEFT c n ls 3627 = GENLIST (K c) (n - LENGTH ls) ++ ls by PAD_LEFT 3628 = ((GENLIST (K c) ((n - LENGTH ls) - 0) ++ []) ++ ls by APPEND_NIL, LENGTH 3629 = (PAD_LEFT c (n - LENGTH ls) []) ++ ls by PAD_LEFT 3630*) 3631val PAD_LEFT_BY_LEFT = store_thm( 3632 "PAD_LEFT_BY_LEFT", 3633 ``!ls c n. PAD_LEFT c n ls = (PAD_LEFT c (n - LENGTH ls) []) ++ ls``, 3634 rw[PAD_LEFT]); 3635 3636(* ------------------------------------------------------------------------- *) 3637(* PROD for List, similar to SUM for List *) 3638(* ------------------------------------------------------------------------- *) 3639 3640(* Overload a positive list *) 3641val _ = overload_on("POSITIVE", ``\l. !x. MEM x l ==> 0 < x``); 3642val _ = overload_on("EVERY_POSITIVE", ``\l. EVERY (\k. 0 < k) l``); 3643 3644(* Theorem: EVERY_POSITIVE ls <=> POSITIVE ls *) 3645(* Proof: by EVERY_MEM *) 3646val POSITIVE_THM = store_thm( 3647 "POSITIVE_THM", 3648 ``!ls. EVERY_POSITIVE ls <=> POSITIVE ls``, 3649 rw[EVERY_MEM]); 3650 3651(* Note: For product of a number list, any zero element will make the product 0. *) 3652 3653(* Define PROD, similar to SUM *) 3654val PROD = new_recursive_definition 3655 {name = "PROD", 3656 rec_axiom = list_Axiom, 3657 def = ``(PROD [] = 1) /\ 3658 (!h t. PROD (h::t) = h * PROD t)``}; 3659 3660(* export simple definition *) 3661val _ = export_rewrites["PROD"]; 3662 3663(* Extract theorems from definition *) 3664val PROD_NIL = save_thm("PROD_NIL", PROD |> CONJUNCT1); 3665(* val PROD_NIL = |- PROD [] = 1: thm *) 3666 3667val PROD_CONS = save_thm("PROD_CONS", PROD |> CONJUNCT2); 3668(* val PROD_CONS = |- !h t. PROD (h::t) = h * PROD t: thm *) 3669 3670(* Theorem: PROD [n] = n *) 3671(* Proof: by PROD *) 3672val PROD_SING = store_thm( 3673 "PROD_SING", 3674 ``!n. PROD [n] = n``, 3675 rw[]); 3676 3677(* Theorem: PROD ls = if ls = [] then 1 else (HD ls) * PROD (TL ls) *) 3678(* Proof: by PROD *) 3679val PROD_eval = store_thm( 3680 "PROD_eval[compute]", (* put in computeLib *) 3681 ``!ls. PROD ls = if ls = [] then 1 else (HD ls) * PROD (TL ls)``, 3682 metis_tac[PROD, list_CASES, HD, TL]); 3683 3684(* enable PROD computation -- use [compute] above. *) 3685(* val _ = computeLib.add_persistent_funs ["PROD_eval"]; *) 3686 3687(* Theorem: (PROD ls = 1) = !x. MEM x ls ==> (x = 1) *) 3688(* Proof: 3689 By induction on ls. 3690 Base: (PROD [] = 1) <=> !x. MEM x [] ==> (x = 1) 3691 LHS: PROD [] = 1 is true by PROD 3692 RHS: is true since MEM x [] = F by MEM 3693 Step: (PROD ls = 1) <=> !x. MEM x ls ==> (x = 1) ==> 3694 !h. (PROD (h::ls) = 1) <=> !x. MEM x (h::ls) ==> (x = 1) 3695 Note 1 = PROD (h::ls) by given 3696 = h * PROD ls by PROD 3697 Thus h = 1 /\ PROD ls = 1 by MULT_EQ_1 3698 or h = 1 /\ !x. MEM x ls ==> (x = 1) by induction hypothesis 3699 or !x. MEM x (h::ls) ==> (x = 1) by MEM 3700*) 3701val PROD_eq_1 = store_thm( 3702 "PROD_eq_1", 3703 ``!ls. (PROD ls = 1) = !x. MEM x ls ==> (x = 1)``, 3704 Induct >> 3705 rw[] >> 3706 metis_tac[]); 3707(* proof like SUM_eq_0 *) 3708val PROD_eq_1 = store_thm("PROD_eq_1", 3709 ``!ls. (PROD ls = 1) = !x. MEM x ls ==> (x = 1)``, 3710 INDUCT_THEN list_INDUCT ASSUME_TAC THEN SRW_TAC[] [PROD, MEM] THEN METIS_TAC[]); 3711 3712(* Theorem: PROD (SNOC x l) = (PROD l) * x *) 3713(* Proof: 3714 By induction on l. 3715 Base: PROD (SNOC x []) = PROD [] * x 3716 PROD (SNOC x []) 3717 = PROD [x] by SNOC 3718 = x by PROD 3719 = 1 * x by MULT_LEFT_1 3720 = PROD [] * x by PROD 3721 Step: PROD (SNOC x l) = PROD l * x ==> !h. PROD (SNOC x (h::l)) = PROD (h::l) * x 3722 PROD (SNOC x (h::l)) 3723 = PROD (h:: SNOC x l) by SNOC 3724 = h * PROD (SNOC x l) by PROD 3725 = h * (PROD l * x) by induction hypothesis 3726 = (h * PROD l) * x by MULT_ASSOC 3727 = PROD (h::l) * x by PROD 3728*) 3729val PROD_SNOC = store_thm( 3730 "PROD_SNOC", 3731 ``!x l. PROD (SNOC x l) = (PROD l) * x``, 3732 strip_tac >> 3733 Induct >> 3734 rw[]); 3735(* proof like SUM_SNOC *) 3736val PROD_SNOC = store_thm("PROD_SNOC", 3737 (``!x l. PROD (SNOC x l) = (PROD l) * x``), 3738 GEN_TAC THEN INDUCT_THEN list_INDUCT ASSUME_TAC THEN REWRITE_TAC[PROD, SNOC, MULT, MULT_CLAUSES] 3739 THEN GEN_TAC THEN ASM_REWRITE_TAC[MULT_ASSOC]); 3740 3741(* Theorem: PROD (APPEND l1 l2) = PROD l1 * PROD l2 *) 3742(* Proof: 3743 By induction on l1. 3744 Base: PROD ([] ++ l2) = PROD [] * PROD l2 3745 PROD ([] ++ l2) 3746 = PROD l2 by APPEND 3747 = 1 * PROD l2 by MULT_LEFT_1 3748 = PROD [] * PROD l2 by PROD 3749 Step: !l2. PROD (l1 ++ l2) = PROD l1 * PROD l2 ==> !h l2. PROD (h::l1 ++ l2) = PROD (h::l1) * PROD l2 3750 PROD (h::l1 ++ l2) 3751 = PROD (h::(l1 ++ l2)) by APPEND 3752 = h * PROD (l1 ++ l2) by PROD 3753 = h * (PROD l1 * PROD l2) by induction hypothesis 3754 = (h * PROD l1) * PROD l2 by MULT_ASSOC 3755 = PROD (h::l1) * PROD l2 by PROD 3756*) 3757val PROD_APPEND = store_thm( 3758 "PROD_APPEND", 3759 ``!l1 l2. PROD (APPEND l1 l2) = PROD l1 * PROD l2``, 3760 Induct >> 3761 rw[]); 3762(* proof like SUM_APPEND *) 3763val PROD_APPEND = store_thm("PROD_APPEND", 3764 (``!l1 l2. PROD (APPEND l1 l2) = PROD l1 * PROD l2``), 3765 INDUCT_THEN list_INDUCT ASSUME_TAC THEN ASM_REWRITE_TAC[PROD, APPEND, MULT_LEFT_1, MULT_ASSOC]); 3766 3767(* Theorem: PROD (MAP f ls) = FOLDL (\a e. a * f e) 1 ls *) 3768(* Proof: 3769 By SNOC_INDUCT |- !P. P [] /\ (!l. P l ==> !x. P (SNOC x l)) ==> !l. P l 3770 Base: PROD (MAP f []) = FOLDL (\a e. a * f e) 1 [] 3771 PROD (MAP f []) 3772 = PROD [] by MAP 3773 = 1 by PROD 3774 = FOLDL (\a e. a * f e) 1 [] by FOLDL 3775 Step: !f. PROD (MAP f ls) = FOLDL (\a e. a * f e) 1 ls ==> 3776 PROD (MAP f (SNOC x ls)) = FOLDL (\a e. a * f e) 1 (SNOC x ls) 3777 PROD (MAP f (SNOC x ls)) 3778 = PROD (SNOC (f x) (MAP f ls)) by MAP_SNOC 3779 = PROD (MAP f ls) * (f x) by PROD_SNOC 3780 = (FOLDL (\a e. a * f e) 1 ls) * (f x) by induction hypothesis 3781 = (\a e. a * f e) (FOLDL (\a e. a * f e) 1 ls) x by function application 3782 = FOLDL (\a e. a * f e) 1 (SNOC x ls) by FOLDL_SNOC 3783*) 3784val PROD_MAP_FOLDL = store_thm( 3785 "PROD_MAP_FOLDL", 3786 ``!ls f. PROD (MAP f ls) = FOLDL (\a e. a * f e) 1 ls``, 3787 HO_MATCH_MP_TAC SNOC_INDUCT >> 3788 rpt strip_tac >- 3789 rw[] >> 3790 rw[MAP_SNOC, PROD_SNOC, FOLDL_SNOC]); 3791(* proof like SUM_MAP_FOLDL *) 3792val PROD_MAP_FOLDL = Q.store_thm("PROD_MAP_FOLDL", 3793 `!ls f. PROD (MAP f ls) = FOLDL (\a e. a * f e) 1 ls`, 3794 HO_MATCH_MP_TAC SNOC_INDUCT THEN 3795 SRW_TAC [] [FOLDL_SNOC, MAP_SNOC, PROD_SNOC, MAP, PROD, FOLDL]); 3796 3797(* Theorem: FINITE s ==> !f. PI f s = PROD (MAP f (SET_TO_LIST s)) *) 3798(* Proof: 3799 PI f s 3800 = ITSET (\e acc. f e * acc) s 1 by PROD_IMAGE_DEF 3801 = FOLDL (combin$C (\e acc. f e * acc)) 1 (SET_TO_LIST s) by ITSET_eq_FOLDL_SET_TO_LIST, FINITE s 3802 = FOLDL (\a e. a * f e) 1 (SET_TO_LIST s) by FUN_EQ_THM 3803 = PROD (MAP f (SET_TO_LIST s)) by PROD_MAP_FOLDL 3804*) 3805val PROD_IMAGE_eq_PROD_MAP_SET_TO_LIST = store_thm( 3806 "PROD_IMAGE_eq_PROD_MAP_SET_TO_LIST", 3807 ``!s. FINITE s ==> !f. PI f s = PROD (MAP f (SET_TO_LIST s))``, 3808 rw[PROD_IMAGE_DEF] >> 3809 rw[ITSET_eq_FOLDL_SET_TO_LIST, PROD_MAP_FOLDL] >> 3810 rpt AP_THM_TAC >> 3811 AP_TERM_TAC >> 3812 rw[FUN_EQ_THM]); 3813(* proof like SUM_IMAGE_eq_SUM_MAP_SET_TO_LIST *) 3814val PROD_IMAGE_eq_PROD_MAP_SET_TO_LIST = Q.store_thm( 3815 "PROD_IMAGE_eq_PROD_MAP_SET_TO_LIST", 3816 `!s. FINITE s ==> !f. PI f s = PROD (MAP f (SET_TO_LIST s))`, 3817 SRW_TAC [] [PROD_IMAGE_DEF] THEN 3818 SRW_TAC [] [ITSET_eq_FOLDL_SET_TO_LIST, PROD_MAP_FOLDL] THEN 3819 AP_THM_TAC THEN AP_THM_TAC THEN AP_TERM_TAC THEN 3820 SRW_TAC [] [FUN_EQ_THM, arithmeticTheory.MULT_COMM]); 3821 3822(* Define PROD using accumulator *) 3823val PROD_ACC_DEF = Lib.with_flag (Defn.def_suffix, "_DEF") Define 3824 `(PROD_ACC [] acc = acc) /\ 3825 (PROD_ACC (h::t) acc = PROD_ACC t (h * acc))`; 3826 3827(* Theorem: PROD_ACC L n = PROD L * n *) 3828(* Proof: 3829 By induction on L. 3830 Base: !n. PROD_ACC [] n = PROD [] * n 3831 PROD_ACC [] n 3832 = n by PROD_ACC_DEF 3833 = 1 * n by MULT_LEFT_1 3834 = PROD [] * n by PROD 3835 Step: !n. PROD_ACC L n = PROD L * n ==> !h n. PROD_ACC (h::L) n = PROD (h::L) * n 3836 PROD_ACC (h::L) n 3837 = PROD_ACC L (h * n) by PROD_ACC_DEF 3838 = PROD L * (h * n) by induction hypothesis 3839 = (PROD L * h) * n by MULT_ASSOC 3840 = (h * PROD L) * n by MULT_COMM 3841 = PROD (h::L) * n by PROD 3842*) 3843val PROD_ACC_PROD_LEM = store_thm( 3844 "PROD_ACC_PROD_LEM", 3845 ``!L n. PROD_ACC L n = PROD L * n``, 3846 Induct >> 3847 rw[PROD_ACC_DEF]); 3848(* proof SUM_ACC_SUM_LEM *) 3849val PROD_ACC_PROD_LEM = store_thm 3850("PROD_ACC_SUM_LEM", 3851 ``!L n. PROD_ACC L n = PROD L * n``, 3852 Induct THEN RW_TAC arith_ss [PROD_ACC_DEF, PROD]); 3853 3854(* Theorem: PROD L = PROD_ACC L 1 *) 3855(* Proof: Put n = 1 in PROD_ACC_PROD_LEM *) 3856val PROD_PROD_ACC = store_thm( 3857 "PROD_PROD_ACC", 3858 ``!L. PROD L = PROD_ACC L 1``, 3859 rw[PROD_ACC_PROD_LEM]); 3860(* proof like SUM_SUM_ACC *) 3861val PROD_PROD_ACC = store_thm 3862("PROD_PROD_ACC", 3863 ``!L. PROD L = PROD_ACC L 1``, 3864 PROVE_TAC [PROD_ACC_PROD_LEM, MULT_RIGHT_1]); 3865 3866(* Put in computeLib *) 3867val _ = computeLib.add_funs [PROD_PROD_ACC]; 3868 3869(* EVAL ``PROD [1; 2; 3; 4]``; --> 24 *) 3870 3871(* Theorem: PROD (GENLIST (K m) n) = m ** n *) 3872(* Proof: 3873 By induction on n. 3874 Base: PROD (GENLIST (K m) 0) = m ** 0 3875 PROD (GENLIST (K m) 0) 3876 = PROD [] by GENLIST 3877 = 1 by PROD 3878 = m ** 0 by EXP 3879 Step: PROD (GENLIST (K m) n) = m ** n ==> PROD (GENLIST (K m) (SUC n)) = m ** SUC n 3880 PROD (GENLIST (K m) (SUC n)) 3881 = PROD (SNOC m (GENLIST (K m) n)) by GENLIST 3882 = PROD (GENLIST (K m) n) * m by PROD_SNOC 3883 = m ** n * m by induction hypothesis 3884 = m * m ** n by MULT_COMM 3885 = m * SUC n by EXP 3886*) 3887val PROD_GENLIST_K = store_thm( 3888 "PROD_GENLIST_K", 3889 ``!m n. PROD (GENLIST (K m) n) = m ** n``, 3890 strip_tac >> 3891 Induct >- 3892 rw[] >> 3893 rw[GENLIST, PROD_SNOC, EXP]); 3894 3895(* Same as PROD_GENLIST_K, formulated slightly different. *) 3896 3897(* Theorem: PPROD (GENLIST (\j. x) n) = x ** n *) 3898(* Proof: 3899 Note (\j. x) = K x by FUN_EQ_THM 3900 PROD (GENLIST (\j. x) n) 3901 = PROD (GENLIST (K x) n) by GENLIST_FUN_EQ 3902 = x ** n by PROD_GENLIST_K 3903*) 3904val PROD_CONSTANT = store_thm( 3905 "PROD_CONSTANT", 3906 ``!n x. PROD (GENLIST (\j. x) n) = x ** n``, 3907 rpt strip_tac >> 3908 `(\j. x) = K x` by rw[FUN_EQ_THM] >> 3909 metis_tac[PROD_GENLIST_K, GENLIST_FUN_EQ]); 3910 3911(* Theorem: (PROD l = 0) <=> MEM 0 l *) 3912(* Proof: 3913 By induction on l. 3914 Base: (PROD [] = 0) <=> MEM 0 [] 3915 LHS = F by PROD_NIL, 1 <> 0 3916 RHS = F by MEM 3917 Step: (PROD l = 0) <=> MEM 0 l ==> !h. (PROD (h::l) = 0) <=> MEM 0 (h::l) 3918 Note PROD (h::l) = h * PROD l by PROD_CONS 3919 Thus PROD (h::l) = 0 3920 ==> h = 0 \/ PROD l = 0 by MULT_EQ_0 3921 If h = 0, then MEM 0 (h::l) by MEM 3922 If PROD l = 0, then MEM 0 l by induction hypothesis 3923 or MEM 0 (h::l) by MEM 3924*) 3925val PROD_EQ_0 = store_thm( 3926 "PROD_EQ_0", 3927 ``!l. (PROD l = 0) <=> MEM 0 l``, 3928 Induct >- 3929 rw[] >> 3930 metis_tac[PROD_CONS, MULT_EQ_0, MEM]); 3931 3932(* Theorem: EVERY (\x. 0 < x) l ==> 0 < PROD l *) 3933(* Proof: 3934 By contradiction, suppose PROD l = 0. 3935 Then MEM 0 l by PROD_EQ_0 3936 or 0 < 0 = F by EVERY_MEM 3937*) 3938val PROD_POS = store_thm( 3939 "PROD_POS", 3940 ``!l. EVERY (\x. 0 < x) l ==> 0 < PROD l``, 3941 metis_tac[EVERY_MEM, PROD_EQ_0, NOT_ZERO_LT_ZERO]); 3942 3943(* Theorem: POSITIVE l ==> 0 < PROD l *) 3944(* Proof: PROD_POS, EVERY_MEM *) 3945val PROD_POS_ALT = store_thm( 3946 "PROD_POS_ALT", 3947 ``!l. POSITIVE l ==> 0 < PROD l``, 3948 rw[PROD_POS, EVERY_MEM]); 3949 3950(* Theorem: PROD (GENLIST (\j. n ** 2 ** j) m) = n ** (2 ** m - 1) *) 3951(* Proof: 3952 The computation is: 3953 n * (n ** 2) * (n ** 4) * ... * (n ** (2 ** (m - 1))) 3954 = n ** (1 + 2 + 4 + ... + 2 ** (m - 1)) 3955 = n ** (2 ** m - 1) 3956 3957 By induction on m. 3958 Base: PROD (GENLIST (\j. n ** 2 ** j) 0) = n ** (2 ** 0 - 1) 3959 LHS = PROD (GENLIST (\j. n ** 2 ** j) 0) 3960 = PROD [] by GENLIST_0 3961 = 1 by PROD 3962 RHS = n ** (1 - 1) by EXP_0 3963 = n ** 0 = 1 = LHS by EXP_0 3964 Step: PROD (GENLIST (\j. n ** 2 ** j) m) = n ** (2 ** m - 1) ==> 3965 PROD (GENLIST (\j. n ** 2 ** j) (SUC m)) = n ** (2 ** SUC m - 1) 3966 PROD (GENLIST (\j. n ** 2 ** j) (SUC m)) 3967 = PROD (SNOC (n ** 2 ** m) (GENLIST (\j. n ** 2 ** j) m)) by GENLIST 3968 = PROD (GENLIST (\j. n ** 2 ** j) m) * (n ** 2 ** m) by PROD_SNOC 3969 = n ** (2 ** m - 1) * n ** 2 ** m by induction hypothesis 3970 = n ** (2 ** m - 1 + 2 ** m) by EXP_ADD 3971 = n ** (2 * 2 ** m - 1) by arithmetic 3972 = n ** (2 ** SUC m - 1) by EXP 3973*) 3974val PROD_SQUARING_LIST = store_thm( 3975 "PROD_SQUARING_LIST", 3976 ``!m n. PROD (GENLIST (\j. n ** 2 ** j) m) = n ** (2 ** m - 1)``, 3977 rpt strip_tac >> 3978 Induct_on `m` >- 3979 rw[] >> 3980 qabbrev_tac `f = \j. n ** 2 ** j` >> 3981 `PROD (GENLIST f (SUC m)) = PROD (SNOC (n ** 2 ** m) (GENLIST f m))` by rw[GENLIST, Abbr`f`] >> 3982 `_ = PROD (GENLIST f m) * (n ** 2 ** m)` by rw[PROD_SNOC] >> 3983 `_ = n ** (2 ** m - 1) * n ** 2 ** m` by rw[] >> 3984 `_ = n ** (2 ** m - 1 + 2 ** m)` by rw[EXP_ADD] >> 3985 rw[EXP]); 3986 3987(* ------------------------------------------------------------------------- *) 3988(* List Range *) 3989(* ------------------------------------------------------------------------- *) 3990 3991(* Theorem: LENGTH [m .. n] = n + 1 - m *) 3992(* Proof: 3993 LENGTH [m .. n] 3994 = LENGTH (GENLIST (\i. m + i) (n + 1 - m)) by listRangeINC_def 3995 = n + 1 - m by LENGTH_GENLIST 3996*) 3997val listRangeINC_LEN = store_thm( 3998 "listRangeINC_LEN", 3999 ``!m n. LENGTH [m .. n] = n + 1 - m``, 4000 rw[listRangeINC_def]); 4001 4002(* Theorem: ([m .. n] = []) <=> (n + 1 <= m) *) 4003(* Proof: 4004 [m .. n] = [] 4005 <=> LENGTH [m .. n] = 0 by LENGTH_NIL 4006 <=> n + 1 - m = 0 by listRangeINC_LEN 4007 <=> n + 1 <= m by arithmetic 4008*) 4009val listRangeINC_NIL = store_thm( 4010 "listRangeINC_NIL", 4011 ``!m n. ([m .. n] = []) <=> (n + 1 <= m)``, 4012 metis_tac[listRangeINC_LEN, LENGTH_NIL, DECIDE``(n + 1 - m = 0) <=> (n + 1 <= m)``]); 4013 4014(* Rename a theorem *) 4015val listRangeINC_MEM = save_thm("listRangeINC_MEM", 4016 MEM_listRangeINC |> GEN ``x:num`` |> GEN ``n:num`` |> GEN ``m:num``); 4017(* 4018val listRangeINC_MEM = |- !m n x. MEM x [m .. n] <=> m <= x /\ x <= n: thm 4019*) 4020 4021(* 4022EL_listRangeLHI 4023|- lo + i < hi ==> EL i [lo ..< hi] = lo + i 4024*) 4025 4026(* Theorem: m + i <= n ==> (EL i [m .. n] = m + i) *) 4027(* Proof: by listRangeINC_def *) 4028val listRangeINC_EL = store_thm( 4029 "listRangeINC_EL", 4030 ``!m n i. m + i <= n ==> (EL i [m .. n] = m + i)``, 4031 rw[listRangeINC_def]); 4032 4033(* Theorem: EVERY P [m .. n] <=> !x. m <= x /\ x <= n ==> P x *) 4034(* Proof: 4035 EVERY P [m .. n] 4036 <=> !x. MEM x [m .. n] ==> P x by EVERY_MEM 4037 <=> !x. m <= x /\ x <= n ==> P x by MEM_listRangeINC 4038*) 4039val listRangeINC_EVERY = store_thm( 4040 "listRangeINC_EVERY", 4041 ``!P m n. EVERY P [m .. n] <=> !x. m <= x /\ x <= n ==> P x``, 4042 rw[EVERY_MEM, MEM_listRangeINC]); 4043 4044(* Theorem: EXISTS P [m .. n] <=> ?x. m <= x /\ x <= n /\ P x *) 4045(* Proof: 4046 EXISTS P [m .. n] 4047 <=> ?x. MEM x [m .. n] /\ P x by EXISTS_MEM 4048 <=> ?x. m <= x /\ x <= n /\ P e by MEM_listRangeINC 4049*) 4050val listRangeINC_EXISTS = store_thm( 4051 "listRangeINC_EXISTS", 4052 ``!P m n. EXISTS P [m .. n] <=> ?x. m <= x /\ x <= n /\ P x``, 4053 metis_tac[EXISTS_MEM, MEM_listRangeINC]); 4054 4055(* Theorem: EVERY P [m .. n] <=> ~(EXISTS ($~ o P) [m .. n]) *) 4056(* Proof: 4057 EVERY P [m .. n] 4058 <=> !x. m <= x /\ x <= n ==> P x by listRangeINC_EVERY 4059 <=> ~(?x. m <= x /\ x <= n /\ ~(P x)) by negation 4060 <=> ~(EXISTS ($~ o P) [m .. m]) by listRangeINC_EXISTS 4061*) 4062val listRangeINC_EVERY_EXISTS = store_thm( 4063 "listRangeINC_EVERY_EXISTS", 4064 ``!P m n. EVERY P [m .. n] <=> ~(EXISTS ($~ o P) [m .. n])``, 4065 rw[listRangeINC_EVERY, listRangeINC_EXISTS]); 4066 4067(* Theorem: EXISTS P [m .. n] <=> ~(EVERY ($~ o P) [m .. n]) *) 4068(* Proof: 4069 EXISTS P [m .. n] 4070 <=> ?x. m <= x /\ x <= m /\ P x by listRangeINC_EXISTS 4071 <=> ~(!x. m <= x /\ x <= n ==> ~(P x)) by negation 4072 <=> ~(EVERY ($~ o P) [m .. n]) by listRangeINC_EVERY 4073*) 4074val listRangeINC_EXISTS_EVERY = store_thm( 4075 "listRangeINC_EXISTS_EVERY", 4076 ``!P m n. EXISTS P [m .. n] <=> ~(EVERY ($~ o P) [m .. n])``, 4077 rw[listRangeINC_EXISTS, listRangeINC_EVERY]); 4078 4079(* Theorem: m <= n + 1 ==> ([m .. (n + 1)] = SNOC (n + 1) [m .. n]) *) 4080(* Proof: 4081 [m .. (n + 1)] 4082 = GENLIST (\i. m + i) ((n + 1) + 1 - m) by listRangeINC_def 4083 = GENLIST (\i. m + i) (1 + (n + 1 - m)) by arithmetic 4084 = GENLIST (\i. m + i) (n + 1 - m) ++ GENLIST (\t. (\i. m + i) (t + n + 1 - m)) 1 by GENLIST_APPEND 4085 = [m .. n] ++ GENLIST (\t. (\i. m + i) (t + n + 1 - m)) 1 by listRangeINC_def 4086 = [m .. n] ++ [(\t. (\i. m + i) (t + n + 1 - m)) 0] by GENLIST_1 4087 = [m .. n] ++ [m + n + 1 - m] by function evaluation 4088 = [m .. n] ++ [n + 1] by arithmetic 4089 = SNOC (n + 1) [m .. n] by SNOC_APPEND 4090*) 4091val listRangeINC_SNOC = store_thm( 4092 "listRangeINC_SNOC", 4093 ``!m n. m <= n + 1 ==> ([m .. (n + 1)] = SNOC (n + 1) [m .. n])``, 4094 rw[listRangeINC_def] >> 4095 `(n + 2 - m = 1 + (n + 1 - m)) /\ (n + 1 - m + m = n + 1)` by decide_tac >> 4096 rw_tac std_ss[GENLIST_APPEND, GENLIST_1]); 4097 4098(* Theorem: m <= n + 1 ==> (FRONT [m .. (n + 1)] = [m .. n]) *) 4099(* Proof: 4100 FRONT [m .. (n + 1)] 4101 = FRONT (SNOC (n + 1) [m .. n])) by listRangeINC_SNOC 4102 = [m .. n] by FRONT_SNOC 4103*) 4104Theorem listRangeINC_FRONT: 4105 !m n. m <= n + 1 ==> (FRONT [m .. (n + 1)] = [m .. n]) 4106Proof 4107 simp[listRangeINC_SNOC, FRONT_SNOC] 4108QED 4109 4110(* Theorem: m <= n ==> (LAST [m .. n] = n) *) 4111(* Proof: 4112 Let ls = [m .. n] 4113 Note ls <> [] by listRangeINC_NIL 4114 so LAST ls 4115 = EL (PRE (LENGTH ls)) ls by LAST_EL 4116 = EL (PRE (n + 1 - m)) ls by listRangeINC_LEN 4117 = EL (n - m) ls by arithmetic 4118 = n by listRangeINC_EL 4119 Or 4120 LAST [m .. n] 4121 = LAST (GENLIST (\i. m + i) (n + 1 - m)) by listRangeINC_def 4122 = LAST (GENLIST (\i. m + i) (SUC (n - m)) by arithmetic, m <= n 4123 = (\i. m + i) (n - m) by GENLIST_LAST 4124 = m + (n - m) by function application 4125 = n by m <= n 4126 Or 4127 If n = 0, then m <= 0 means m = 0. 4128 LAST [0 .. 0] = LAST [0] = 0 = n by LAST_DEF 4129 Otherwise n = SUC k. 4130 LAST [m .. n] 4131 = LAST (SNOC n [m .. k]) by listRangeINC_SNOC, ADD1 4132 = n by LAST_SNOC 4133*) 4134Theorem listRangeINC_LAST: 4135 !m n. m <= n ==> (LAST [m .. n] = n) 4136Proof 4137 rpt strip_tac >> 4138 Cases_on `n` >- 4139 fs[] >> 4140 metis_tac[listRangeINC_SNOC, LAST_SNOC, ADD1] 4141QED 4142 4143(* Theorem: REVERSE [m .. n] = MAP (\x. n - x + m) [m .. n] *) 4144(* Proof: 4145 REVERSE [m .. n] 4146 = REVERSE (GENLIST (\i. m + i) (n + 1 - m)) by listRangeINC_def 4147 = GENLIST (\x. (\i. m + i) (PRE (n + 1 - m) - x)) (n + 1 - m) by REVERSE_GENLIST 4148 = GENLIST (\x. (\i. m + i) (n - m - x)) (n + 1 - m) by PRE 4149 = GENLIST (\x. (m + n - m - x) (n + 1 - m) by function application 4150 = GENLIST (\x. n - x) (n + 1 - m) by arithmetic 4151 4152 MAP (\x. n - x + m) [m .. n] 4153 = MAP (\x. n - x + m) (GENLIST (\i. m + i) (n + 1 - m)) by listRangeINC_def 4154 = GENLIST ((\x. n - x + m) o (\i. m + i)) (n + 1 - m) by MAP_GENLIST 4155 = GENLIST (\i. n - (m + i) + m) (n + 1 - m) by function composition 4156 = GENLIST (\i. n - i) (n + 1 - m) by arithmetic 4157*) 4158val listRangeINC_REVERSE = store_thm( 4159 "listRangeINC_REVERSE", 4160 ``!m n. REVERSE [m .. n] = MAP (\x. n - x + m) [m .. n]``, 4161 rpt strip_tac >> 4162 `(\m'. PRE (n + 1 - m) - m' + m) = ((\x. n - x + m) o (\i. i + m))` by rw[FUN_EQ_THM, combinTheory.o_THM] >> 4163 rw[listRangeINC_def, REVERSE_GENLIST, MAP_GENLIST]); 4164 4165(* Theorem: REVERSE (MAP f [m .. n]) = MAP (f o (\x. n - x + m)) [m .. n] *) 4166(* Proof: 4167 REVERSE (MAP f [m .. n]) 4168 = MAP f (REVERSE [m .. n]) by MAP_REVERSE 4169 = MAP f (MAP (\x. n - x + m) [m .. n]) by listRangeINC_REVERSE 4170 = MAP (f o (\x. n - x + m)) [m .. n] by MAP_MAP_o 4171*) 4172val listRangeINC_REVERSE_MAP = store_thm( 4173 "listRangeINC_REVERSE_MAP", 4174 ``!f m n. REVERSE (MAP f [m .. n]) = MAP (f o (\x. n - x + m)) [m .. n]``, 4175 metis_tac[MAP_REVERSE, listRangeINC_REVERSE, MAP_MAP_o]); 4176 4177(* Theorem: MAP f [(m + 1) .. (n + 1)] = MAP (f o SUC) [m .. n] *) 4178(* Proof: 4179 Note (\i. (m + 1) + i) = SUC o (\i. (m + i)) by FUN_EQ_THM 4180 MAP f [(m + 1) .. (n + 1)] 4181 = MAP f (GENLIST (\i. (m + 1) + i) ((n + 1) + 1 - (m + 1))) by listRangeINC_def 4182 = MAP f (GENLIST (\i. (m + 1) + i) (n + 1 - m)) by arithmetic 4183 = MAP f (GENLIST (SUC o (\i. (m + i))) (n + 1 - m)) by above 4184 = MAP (f o SUC) (GENLIST (\i. (m + i)) (n + 1 - m)) by MAP_GENLIST 4185 = MAP (f o SUC) [m .. n] by listRangeINC_def 4186*) 4187val listRangeINC_MAP_SUC = store_thm( 4188 "listRangeINC_MAP_SUC", 4189 ``!f m n. MAP f [(m + 1) .. (n + 1)] = MAP (f o SUC) [m .. n]``, 4190 rpt strip_tac >> 4191 `(\i. (m + 1) + i) = SUC o (\i. (m + i))` by rw[FUN_EQ_THM] >> 4192 rw[listRangeINC_def, MAP_GENLIST]); 4193 4194(* Theorem: a <= b /\ b <= c ==> ([a .. b] ++ [(b + 1) .. c] = [a .. c]) *) 4195(* Proof: 4196 By listRangeINC_def, this is to show: 4197 GENLIST (\i. a + i) (b + 1 - a) ++ GENLIST (\i. b + (i + 1)) (c - b) = GENLIST (\i. a + i) (c + 1 - a) 4198 Let f = \i. a + i. 4199 Note (\t. f (t + (b + 1 - a))) = (\i. b + (i + 1)) by FUN_EQ_THM 4200 Thus GENLIST (\i. b + (i + 1)) (c - b) = GENLIST (\t. f (t + (b + 1 - a))) (c - b) by GENLIST_FUN_EQ 4201 Now (c - b) + (b + 1 - a) = c + 1 - a by a <= b /\ b <= c 4202 The result follows by GENLIST_APPEND 4203*) 4204val listRangeINC_APPEND = store_thm( 4205 "listRangeINC_APPEND", 4206 ``!a b c. a <= b /\ b <= c ==> ([a .. b] ++ [(b + 1) .. c] = [a .. c])``, 4207 rw[listRangeINC_def] >> 4208 qabbrev_tac `f = \i. a + i` >> 4209 `(\t. f (t + (b + 1 - a))) = (\i. b + (i + 1))` by rw[FUN_EQ_THM, Abbr`f`] >> 4210 `GENLIST (\i. b + (i + 1)) (c - b) = GENLIST (\t. f (t + (b + 1 - a))) (c - b)` by rw[GSYM GENLIST_FUN_EQ] >> 4211 `(c - b) + (b + 1 - a) = c + 1 - a` by decide_tac >> 4212 metis_tac[GENLIST_APPEND]); 4213 4214(* Theorem: SUM [m .. n] = SUM [1 .. n] - SUM [1 .. (m - 1)] *) 4215(* Proof: 4216 If m = 0, 4217 Then [1 .. (m-1)] = [1 .. 0] = [] by listRangeINC_EMPTY 4218 SUM [0 .. n] 4219 = SUM (0::[1 .. n]) by listRangeINC_CONS 4220 = 0 + SUM [1 .. n] by SUM_CONS 4221 = SUM [1 .. n] - 0 by arithmetic 4222 = SUM [1 .. n] - SUM [] by SUM_NIL 4223 If m = 1, 4224 Then [1 .. (m-1)] = [1 .. 0] = [] by listRangeINC_EMPTY 4225 SUM [1 .. n] 4226 = SUM [1 .. n] - 0 by arithmetic 4227 = SUM [1 .. n] - SUM [] by SUM_NIL 4228 Otherwise 1 < m, or 1 <= m - 1. 4229 If n < m, 4230 Then SUM [m .. n] = 0 by listRangeINC_EMPTY 4231 If n = 0, 4232 Then SUM [1 .. 0] = 0 by listRangeINC_EMPTY 4233 and 0 - SUM [1 .. (m - 1)] = 0 by integer subtraction 4234 If n <> 0, 4235 Then 1 <= n /\ n <= m - 1 by arithmetic 4236 ==> [1 .. m - 1] = 4237 [1 .. n] ++ [(n + 1) .. (m - 1)] by listRangeINC_APPEND 4238 or SUM [1 .. m - 1] 4239 = SUM [1 .. n] + SUM [(n + 1) .. (m - 1)] by SUM_APPEND 4240 Thus SUM [1 .. n] - SUM [1 .. m - 1] = 0 by subtraction 4241 If ~(n < m), then m <= n. 4242 Note m - 1 < n /\ (m - 1 + 1 = m) by arithmetic 4243 Thus [1 .. n] = [1 .. (m - 1)] ++ [m .. n] by listRangeINC_APPEND 4244 or SUM [1 .. n] 4245 = SUM [1 .. (m - 1)] + SUM [m .. n] by SUM_APPEND 4246 The result follows by subtraction 4247*) 4248val listRangeINC_SUM = store_thm( 4249 "listRangeINC_SUM", 4250 ``!m n. SUM [m .. n] = SUM [1 .. n] - SUM [1 .. (m - 1)]``, 4251 rpt strip_tac >> 4252 Cases_on `m = 0` >- 4253 rw[listRangeINC_EMPTY, listRangeINC_CONS] >> 4254 Cases_on `m = 1` >- 4255 rw[listRangeINC_EMPTY] >> 4256 Cases_on `n < m` >| [ 4257 Cases_on `n = 0` >- 4258 rw[listRangeINC_EMPTY] >> 4259 `1 <= n /\ n <= m - 1` by decide_tac >> 4260 `[1 .. m - 1] = [1 .. n] ++ [(n + 1) .. (m - 1)]` by rw[listRangeINC_APPEND] >> 4261 `SUM [1 .. m - 1] = SUM [1 .. n] + SUM [(n + 1) .. (m - 1)]` by rw[GSYM SUM_APPEND] >> 4262 `SUM [m .. n] = 0` by rw[listRangeINC_EMPTY] >> 4263 decide_tac, 4264 `1 <= m - 1 /\ m - 1 <= n /\ (m - 1 + 1 = m)` by decide_tac >> 4265 `[1 .. n] = [1 .. (m - 1)] ++ [m .. n]` by metis_tac[listRangeINC_APPEND] >> 4266 `SUM [1 .. n] = SUM [1 .. (m - 1)] + SUM [m .. n]` by rw[GSYM SUM_APPEND] >> 4267 decide_tac 4268 ]); 4269 4270(* Theorem: 0 < m ==> 0 < PROD [m .. n] *) 4271(* Proof: 4272 Note MEM 0 [m .. n] = F by MEM_listRangeINC 4273 Thus PROD [m .. n] <> 0 by PROD_EQ_0 4274 The result follows. 4275 or 4276 Note EVERY_POSITIVE [m .. n] by listRangeINC_EVERY 4277 Thus 0 < PROD [m .. n] by PROD_POS 4278*) 4279val listRangeINC_PROD_pos = store_thm( 4280 "listRangeINC_PROD_pos", 4281 ``!m n. 0 < m ==> 0 < PROD [m .. n]``, 4282 rw[PROD_POS, listRangeINC_EVERY]); 4283 4284(* Theorem: 0 < m /\ m <= n ==> (PROD [m .. n] = PROD [1 .. n] DIV PROD [1 .. (m - 1)]) *) 4285(* Proof: 4286 If m = 1, 4287 Then [1 .. (m-1)] = [1 .. 0] = [] by listRangeINC_EMPTY 4288 PROD [1 .. n] 4289 = PROD [1 .. n] DIV 1 by DIV_ONE 4290 = PROD [1 .. n] DIV PROD [] by PROD_NIL 4291 If m <> 1, then 1 <= m by m <> 0, m <> 1 4292 Note 1 <= m - 1 /\ m - 1 < n /\ (m - 1 + 1 = m) by arithmetic 4293 Thus [1 .. n] = [1 .. (m - 1)] ++ [m .. n] by listRangeINC_APPEND 4294 or PROD [1 .. n] = PROD [1 .. (m - 1)] * PROD [m .. n] by PROD_POS 4295 Now 0 < PROD [1 .. (m - 1)] by listRangeINC_PROD_pos 4296 The result follows by MULT_TO_DIV 4297*) 4298val listRangeINC_PROD = store_thm( 4299 "listRangeINC_PROD", 4300 ``!m n. 0 < m /\ m <= n ==> (PROD [m .. n] = PROD [1 .. n] DIV PROD [1 .. (m - 1)])``, 4301 rpt strip_tac >> 4302 Cases_on `m = 1` >- 4303 rw[listRangeINC_EMPTY] >> 4304 `1 <= m - 1 /\ m - 1 <= n /\ (m - 1 + 1 = m)` by decide_tac >> 4305 `[1 .. n] = [1 .. (m - 1)] ++ [m .. n]` by metis_tac[listRangeINC_APPEND] >> 4306 `PROD [1 .. n] = PROD [1 .. (m - 1)] * PROD [m .. n]` by rw[GSYM PROD_APPEND] >> 4307 `0 < PROD [1 .. (m - 1)]` by rw[listRangeINC_PROD_pos] >> 4308 metis_tac[MULT_TO_DIV]); 4309 4310(* Theorem: 0 < n /\ m <= x /\ x divides n ==> MEM x [m .. n] *) 4311(* Proof: 4312 Note x divdes n ==> x <= n by DIVIDES_LE, 0 < n 4313 so MEM x [m .. n] by listRangeINC_MEM 4314*) 4315val listRangeINC_has_divisors = store_thm( 4316 "listRangeINC_has_divisors", 4317 ``!m n x. 0 < n /\ m <= x /\ x divides n ==> MEM x [m .. n]``, 4318 rw[listRangeINC_MEM, DIVIDES_LE]); 4319 4320(* Theorem: [1 .. n] = GENLIST SUC n *) 4321(* Proof: by listRangeINC_def *) 4322val listRangeINC_1_n = store_thm( 4323 "listRangeINC_1_n", 4324 ``!n. [1 .. n] = GENLIST SUC n``, 4325 rpt strip_tac >> 4326 `(\i. i + 1) = SUC` by rw[FUN_EQ_THM] >> 4327 rw[listRangeINC_def]); 4328 4329(* Theorem: MAP f [1 .. n] = GENLIST (f o SUC) n *) 4330(* Proof: 4331 MAP f [1 .. n] 4332 = MAP f (GENLIST SUC n) by listRangeINC_1_n 4333 = GENLIST (f o SUC) n by MAP_GENLIST 4334*) 4335val listRangeINC_MAP = store_thm( 4336 "listRangeINC_MAP", 4337 ``!f n. MAP f [1 .. n] = GENLIST (f o SUC) n``, 4338 rw[listRangeINC_1_n, MAP_GENLIST]); 4339 4340(* Theorem: SUM (MAP f [1 .. (SUC n)]) = f (SUC n) + SUM (MAP f [1 .. n]) *) 4341(* Proof: 4342 SUM (MAP f [1 .. (SUC n)]) 4343 = SUM (MAP f (SNOC (SUC n) [1 .. n])) by listRangeINC_SNOC 4344 = SUM (SNOC (f (SUC n)) (MAP f [1 .. n])) by MAP_SNOC 4345 = f (SUC n) + SUM (MAP f [1 .. n]) by SUM_SNOC 4346*) 4347val listRangeINC_SUM_MAP = store_thm( 4348 "listRangeINC_SUM_MAP", 4349 ``!f n. SUM (MAP f [1 .. (SUC n)]) = f (SUC n) + SUM (MAP f [1 .. n])``, 4350 rw[listRangeINC_SNOC, MAP_SNOC, SUM_SNOC, ADD1]); 4351 4352(* Theorem: [m ..< (n + 1)] = [m .. n] *) 4353(* Proof: 4354 [m ..< (n + 1)] 4355 = GENLIST (\i. m + i) (n + 1 - m) by listRangeLHI_def 4356 = [m .. n] by listRangeINC_def 4357*) 4358val listRangeLHI_to_listRangeINC = store_thm( 4359 "listRangeLHI_to_listRangeINC", 4360 ``!m n. [m ..< (n + 1)] = [m .. n]``, 4361 rw[listRangeLHI_def, listRangeINC_def]); 4362 4363(* Theorem alias *) 4364val listRangeLHI_LEN = save_thm("listRangeLHI_LEN", LENGTH_listRangeLHI |> GEN_ALL); 4365(* val listRangeLHI_LEN = |- !lo hi. LENGTH [lo ..< hi] = hi - lo: thm *) 4366 4367(* Theorem: LENGTH [m ..< n] = n - m *) 4368(* Proof: by LENGTH_listRangeLHI *) 4369val listRangeLHI_LEN = store_thm( 4370 "listRangeLHI_LEN", 4371 ``!m n. LENGTH [m ..< n] = n - m``, 4372 rw[LENGTH_listRangeLHI]); 4373 4374(* Theorem: ([m ..< n] = []) <=> n <= m *) 4375(* Proof: 4376 If n = 0, LHS = T, RHS = T hence true. 4377 If n <> 0, then n = SUC k by num_CASES 4378 [m ..< n] = [] 4379 <=> [m ..< SUC k] = [] by n = SUC k 4380 <=> [m .. k] = [] by listRangeLHI_to_listRangeINC 4381 <=> k + 1 <= m by listRangeINC_NIL 4382 <=> n <= m by ADD1 4383*) 4384val listRangeLHI_NIL = store_thm( 4385 "listRangeLHI_NIL", 4386 ``!m n. ([m ..< n] = []) <=> n <= m``, 4387 rpt strip_tac >> 4388 Cases_on `n` >- 4389 rw[listRangeLHI_def] >> 4390 rw[listRangeLHI_to_listRangeINC, listRangeINC_NIL, ADD1]); 4391 4392(* Theorem: MEM x [m ..< n] <=> m <= x /\ x < n *) 4393(* Proof: by MEM_listRangeLHI *) 4394val listRangeLHI_MEM = store_thm( 4395 "listRangeLHI_MEM", 4396 ``!m n x. MEM x [m ..< n] <=> m <= x /\ x < n``, 4397 rw[MEM_listRangeLHI]); 4398 4399(* Theorem: m + i < n ==> EL i [m ..< n] = m + i *) 4400(* Proof: EL_listRangeLHI *) 4401val listRangeLHI_EL = store_thm( 4402 "listRangeLHI_EL", 4403 ``!m n i. m + i < n ==> (EL i [m ..< n] = m + i)``, 4404 rw[EL_listRangeLHI]); 4405 4406(* Theorem: EVERY P [m ..< n] <=> !x. m <= x /\ x < n ==> P x *) 4407(* Proof: 4408 EVERY P [m ..< n] 4409 <=> !x. MEM x [m ..< n] ==> P e by EVERY_MEM 4410 <=> !x. m <= x /\ x < n ==> P e by MEM_listRangeLHI 4411*) 4412val listRangeLHI_EVERY = store_thm( 4413 "listRangeLHI_EVERY", 4414 ``!P m n. EVERY P [m ..< n] <=> !x. m <= x /\ x < n ==> P x``, 4415 rw[EVERY_MEM, MEM_listRangeLHI]); 4416 4417(* Theorem: m <= n ==> ([m ..< n + 1] = SNOC n [m ..< n]) *) 4418(* Proof: 4419 If n = 0, 4420 Then m = 0 by m <= n 4421 LHS = [0 ..< 1] = [0] 4422 RHS = SNOC 0 [0 ..< 0] 4423 = SNOC 0 [] by listRangeLHI_def 4424 = [0] = LHS by SNOC 4425 If n <> 0, 4426 Then n = (n - 1) + 1 by arithmetic 4427 [m ..< n + 1] 4428 = [m .. n] by listRangeLHI_to_listRangeINC 4429 = SNOC n [m .. n - 1] by listRangeINC_SNOC, m <= (n - 1) + 1 4430 = SNOC n [m ..< n] by listRangeLHI_to_listRangeINC 4431*) 4432val listRangeLHI_SNOC = store_thm( 4433 "listRangeLHI_SNOC", 4434 ``!m n. m <= n ==> ([m ..< n + 1] = SNOC n [m ..< n])``, 4435 rpt strip_tac >> 4436 Cases_on `n = 0` >| [ 4437 `m = 0` by decide_tac >> 4438 rw[listRangeLHI_def], 4439 `n = (n - 1) + 1` by decide_tac >> 4440 `[m ..< n + 1] = [m .. n]` by rw[listRangeLHI_to_listRangeINC] >> 4441 `_ = SNOC n [m .. n - 1]` by metis_tac[listRangeINC_SNOC] >> 4442 `_ = SNOC n [m ..< n]` by rw[GSYM listRangeLHI_to_listRangeINC] >> 4443 rw[] 4444 ]); 4445 4446(* Theorem: m <= n ==> (FRONT [m .. < n + 1] = [m .. <n]) *) 4447(* Proof: 4448 FRONT [m ..< n + 1] 4449 = FRONT (SNOC n [m ..< n])) by listRangeLHI_SNOC 4450 = [m ..< n] by FRONT_SNOC 4451*) 4452Theorem listRangeLHI_FRONT: 4453 !m n. m <= n ==> (FRONT [m ..< n + 1] = [m ..< n]) 4454Proof 4455 simp[listRangeLHI_SNOC, FRONT_SNOC] 4456QED 4457 4458(* Theorem: m <= n ==> (LAST [m ..< n + 1] = n) *) 4459(* Proof: 4460 LAST [m ..< n + 1] 4461 = LAST (SNOC n [m ..< n]) by listRangeLHI_SNOC 4462 = n by LAST_SNOC 4463*) 4464Theorem listRangeLHI_LAST: 4465 !m n. m <= n ==> (LAST [m ..< n + 1] = n) 4466Proof 4467 simp[listRangeLHI_SNOC, LAST_SNOC] 4468QED 4469 4470(* Theorem: REVERSE [m ..< n] = MAP (\x. n - 1 - x + m) [m ..< n] *) 4471(* Proof: 4472 If n = 0, 4473 LHS = REVERSE [] by listRangeLHI_def 4474 = [] by REVERSE_DEF 4475 = MAP f [] = RHS by MAP 4476 If n <> 0, 4477 Then n = k + 1 for some k by num_CASES, ADD1 4478 REVERSE [m ..< n] 4479 = REVERSE [m .. k] by listRangeLHI_to_listRangeINC 4480 = MAP (\x. k - x + m) [m .. k] by listRangeINC_REVERSE 4481 = MAP (\x. n - 1 - x + m) [m ..< n] by listRangeLHI_to_listRangeINC 4482*) 4483val listRangeLHI_REVERSE = store_thm( 4484 "listRangeLHI_REVERSE", 4485 ``!m n. REVERSE [m ..< n] = MAP (\x. n - 1 - x + m) [m ..< n]``, 4486 rpt strip_tac >> 4487 Cases_on `n` >- 4488 rw[listRangeLHI_def] >> 4489 `REVERSE [m ..< SUC n'] = REVERSE [m .. n']` by rw[listRangeLHI_to_listRangeINC, ADD1] >> 4490 `_ = MAP (\x. n' - x + m) [m .. n']` by rw[listRangeINC_REVERSE] >> 4491 `_ = MAP (\x. n' - x + m) [m ..< (SUC n')]` by rw[GSYM listRangeLHI_to_listRangeINC, ADD1] >> 4492 rw[]); 4493 4494(* Theorem: REVERSE (MAP f [m ..< n]) = MAP (f o (\x. n - 1 - x + m)) [m ..< n] *) 4495(* Proof: 4496 REVERSE (MAP f [m ..< n]) 4497 = MAP f (REVERSE [m ..< n]) by MAP_REVERSE 4498 = MAP f (MAP (\x. n - 1 - x + m) [m ..< n]) by listRangeLHI_REVERSE 4499 = MAP (f o (\x. n - 1 - x + m)) [m ..< n] by MAP_MAP_o 4500*) 4501val listRangeLHI_REVERSE_MAP = store_thm( 4502 "listRangeLHI_REVERSE_MAP", 4503 ``!f m n. REVERSE (MAP f [m ..< n]) = MAP (f o (\x. n - 1 - x + m)) [m ..< n]``, 4504 metis_tac[MAP_REVERSE, listRangeLHI_REVERSE, MAP_MAP_o]); 4505 4506(* Theorem: MAP f [(m + 1) ..< (n + 1)] = MAP (f o SUC) [m ..< n] *) 4507(* Proof: 4508 Note (\i. (m + 1) + i) = SUC o (\i. (m + i)) by FUN_EQ_THM 4509 MAP f [(m + 1) ..< (n + 1)] 4510 = MAP f (GENLIST (\i. (m + 1) + i) ((n + 1) - (m + 1))) by listRangeLHI_def 4511 = MAP f (GENLIST (\i. (m + 1) + i) (n - m)) by arithmetic 4512 = MAP f (GENLIST (SUC o (\i. (m + i))) (n - m)) by above 4513 = MAP (f o SUC) (GENLIST (\i. (m + i)) (n - m)) by MAP_GENLIST 4514 = MAP (f o SUC) [m ..< n] by listRangeLHI_def 4515*) 4516val listRangeLHI_MAP_SUC = store_thm( 4517 "listRangeLHI_MAP_SUC", 4518 ``!f m n. MAP f [(m + 1) ..< (n + 1)] = MAP (f o SUC) [m ..< n]``, 4519 rpt strip_tac >> 4520 `(\i. (m + 1) + i) = SUC o (\i. (m + i))` by rw[FUN_EQ_THM] >> 4521 rw[listRangeLHI_def, MAP_GENLIST]); 4522 4523 4524(* Theorem: a <= b /\ b <= c ==> [a ..< b] ++ [b ..< c] = [a ..< c] *) 4525(* Proof: 4526 If a = b, 4527 LHS = [a ..< a] ++ [a ..< c] 4528 = [] ++ [a ..< c] by listRangeLHI_def 4529 = [a ..< c] = RHS by APPEND 4530 If a <> b, 4531 Then a < b, by a <= b 4532 so b <> 0, and c <> 0 by b <= c 4533 Let b = b' + 1, c = c' + 1 by num_CASES, ADD1 4534 Then a <= b' /\ b' <= c. 4535 [a ..< b] ++ [b ..< c] 4536 = [a .. b'] ++ [b' + 1 .. c'] by listRangeLHI_to_listRangeINC 4537 = [a .. c'] by listRangeINC_APPEND 4538 = [a ..< c] by listRangeLHI_to_listRangeINC 4539*) 4540val listRangeLHI_APPEND = store_thm( 4541 "listRangeLHI_APPEND", 4542 ``!a b c. a <= b /\ b <= c ==> ([a ..< b] ++ [b ..< c] = [a ..< c])``, 4543 rpt strip_tac >> 4544 `(a = b) \/ (a < b)` by decide_tac >- 4545 rw[listRangeLHI_def] >> 4546 `b <> 0 /\ c <> 0` by decide_tac >> 4547 `?b' c'. (b = b' + 1) /\ (c = c' + 1)` by metis_tac[num_CASES, ADD1] >> 4548 `a <= b' /\ b' <= c` by decide_tac >> 4549 `[a ..< b] ++ [b ..< c] = [a .. b'] ++ [b' + 1 .. c']` by rw[listRangeLHI_to_listRangeINC] >> 4550 `_ = [a .. c']` by rw[listRangeINC_APPEND] >> 4551 `_ = [a ..< c]` by rw[GSYM listRangeLHI_to_listRangeINC] >> 4552 rw[]); 4553 4554(* Theorem: SUM [m ..< n] = SUM [1 ..< n] - SUM [1 ..< m] *) 4555(* Proof: 4556 If n = 0, 4557 LHS = SUM [m ..< 0] = SUM [] = 0 by listRangeLHI_EMPTY 4558 RHS = SUM [1 ..< 0] - SUM [1 ..< m] 4559 = SUM [] - SUM [1 ..< m] by listRangeLHI_EMPTY 4560 = 0 - SUM [1 ..< m] = 0 = LHS by integer subtraction 4561 If m = 0, 4562 LHS = SUM [0 ..< n] 4563 = SUM (0 :: [1 ..< n]) by listRangeLHI_CONS 4564 = 0 + SUM [1 ..< n] by SUM 4565 = SUM [1 ..< n] by arithmetic 4566 RHS = SUM [1 ..< n] - SUM [1 ..< 0] by integer subtraction 4567 = SUM [1 ..< n] - SUM [] by listRangeLHI_EMPTY 4568 = SUM [1 ..< n] - 0 by SUM 4569 = LHS 4570 Otherwise, 4571 n <> 0, and m <> 0. 4572 Let n = n' + 1, m = m' + 1 by num_CASES, ADD1 4573 SUM [m ..< n] 4574 = SUM [m .. n'] by listRangeLHI_to_listRangeINC 4575 = SUM [1 .. n'] - SUM [1 .. m - 1] by listRangeINC_SUM 4576 = SUM [1 .. n'] - SUM [1 .. m'] by m' = m - 1 4577 = SUM [1 ..< n] - SUM [1 ..< m] by listRangeLHI_to_listRangeINC 4578*) 4579val listRangeLHI_SUM = store_thm( 4580 "listRangeLHI_SUM", 4581 ``!m n. SUM [m ..< n] = SUM [1 ..< n] - SUM [1 ..< m]``, 4582 rpt strip_tac >> 4583 Cases_on `n = 0` >- 4584 rw[listRangeLHI_EMPTY] >> 4585 Cases_on `m = 0` >- 4586 rw[listRangeLHI_EMPTY, listRangeLHI_CONS] >> 4587 `?n' m'. (n = n' + 1) /\ (m = m' + 1)` by metis_tac[num_CASES, ADD1] >> 4588 `SUM [m ..< n] = SUM [m .. n']` by rw[listRangeLHI_to_listRangeINC] >> 4589 `_ = SUM [1 .. n'] - SUM [1 .. m - 1]` by rw[GSYM listRangeINC_SUM] >> 4590 `_ = SUM [1 .. n'] - SUM [1 .. m']` by rw[] >> 4591 `_ = SUM [1 ..< n] - SUM [1 ..< m]` by rw[GSYM listRangeLHI_to_listRangeINC] >> 4592 rw[]); 4593 4594(* Theorem: 0 < m ==> 0 < PROD [m ..< n] *) 4595(* Proof: 4596 Note MEM 0 [m ..< n] = F by MEM_listRangeLHI 4597 Thus PROD [m ..< n] <> 0 by PROD_EQ_0 4598 The result follows. 4599 or, 4600 Note EVERY_POSITIVE [m ..< n] by listRangeLHI_EVERY 4601 Thus 0 < PROD [m ..< n] by PROD_POS 4602*) 4603val listRangeLHI_PROD_pos = store_thm( 4604 "listRangeLHI_PROD_pos", 4605 ``!m n. 0 < m ==> 0 < PROD [m ..< n]``, 4606 rw[PROD_POS, listRangeLHI_EVERY]); 4607 4608(* Theorem: 0 < m /\ m <= n ==> (PROD [m ..< n] = PROD [1 ..< n] DIV PROD [1 ..< m]) *) 4609(* Proof: 4610 Note n <> 0 by 0 < m /\ m <= n 4611 Let m = m' + 1, n = n' + 1 by num_CASES, ADD1 4612 If m = n, 4613 Note 0 < PROD [1 ..< n] by listRangeLHI_PROD_pos 4614 LHS = PROD [n ..< n] 4615 = PROD [] = 1 by listRangeLHI_EMPTY 4616 RHS = PROD [1 ..< n] DIV PROD [1 ..< n] 4617 = 1 by DIVMOD_ID, 0 < PROD [1 ..< n] 4618 If m <> n, 4619 Then m < n, or m <= n' by arithmetic 4620 PROD [m ..< n] 4621 = PROD [m .. n'] by listRangeLHI_to_listRangeINC 4622 = PROD [1 .. n'] DIV PROD [1 .. m - 1] by listRangeINC_PROD, m <= n' 4623 = PROD [1 .. n'] DIV PROD [1 .. m'] by m' = m - 1 4624 = PROD [1 ..< n] DIV PROD [1 ..< m] by listRangeLHI_to_listRangeINC 4625*) 4626val listRangeLHI_PROD = store_thm( 4627 "listRangeLHI_PROD", 4628 ``!m n. 0 < m /\ m <= n ==> (PROD [m ..< n] = PROD [1 ..< n] DIV PROD [1 ..< m])``, 4629 rpt strip_tac >> 4630 `m <> 0 /\ n <> 0` by decide_tac >> 4631 `?n' m'. (n = n' + 1) /\ (m = m' + 1)` by metis_tac[num_CASES, ADD1] >> 4632 Cases_on `m = n` >| [ 4633 `0 < PROD [1 ..< n]` by rw[listRangeLHI_PROD_pos] >> 4634 rfs[listRangeLHI_EMPTY, DIVMOD_ID], 4635 `m <= n'` by decide_tac >> 4636 `PROD [m ..< n] = PROD [m .. n']` by rw[listRangeLHI_to_listRangeINC] >> 4637 `_ = PROD [1 .. n'] DIV PROD [1 .. m - 1]` by rw[GSYM listRangeINC_PROD] >> 4638 `_ = PROD [1 .. n'] DIV PROD [1 .. m']` by rw[] >> 4639 `_ = PROD [1 ..< n] DIV PROD [1 ..< m]` by rw[GSYM listRangeLHI_to_listRangeINC] >> 4640 rw[] 4641 ]); 4642 4643(* Theorem: 0 < n /\ m <= x /\ x divides n ==> MEM x [m ..< n + 1] *) 4644(* Proof: 4645 Note the condition implies: 4646 MEM x [m .. n] by listRangeINC_has_divisors 4647 = MEM x [m ..< n + 1] by listRangeLHI_to_listRangeINC 4648*) 4649val listRangeLHI_has_divisors = store_thm( 4650 "listRangeLHI_has_divisors", 4651 ``!m n x. 0 < n /\ m <= x /\ x divides n ==> MEM x [m ..< n + 1]``, 4652 metis_tac[listRangeINC_has_divisors, listRangeLHI_to_listRangeINC]); 4653 4654(* Theorem: [0 ..< n] = GENLIST I n *) 4655(* Proof: by listRangeINC_def *) 4656val listRangeLHI_0_n = store_thm( 4657 "listRangeLHI_0_n", 4658 ``!n. [0 ..< n] = GENLIST I n``, 4659 rpt strip_tac >> 4660 `(\i:num. i) = I` by rw[FUN_EQ_THM] >> 4661 rw[listRangeLHI_def]); 4662 4663(* Theorem: MAP f [0 ..< n] = GENLIST f n *) 4664(* Proof: 4665 MAP f [0 ..< n] 4666 = MAP f (GENLIST I n) by listRangeLHI_0_n 4667 = GENLIST (f o I) n by MAP_GENLIST 4668 = GENLIST f n by I_THM 4669*) 4670val listRangeLHI_MAP = store_thm( 4671 "listRangeLHI_MAP", 4672 ``!f n. MAP f [0 ..< n] = GENLIST f n``, 4673 rw[listRangeLHI_0_n, MAP_GENLIST]); 4674 4675(* Theorem: SUM (MAP f [0 ..< (SUC n)]) = f n + SUM (MAP f [0 ..< n]) *) 4676(* Proof: 4677 SUM (MAP f [0 ..< (SUC n)]) 4678 = SUM (MAP f (SNOC n [0 ..< n])) by listRangeLHI_SNOC 4679 = SUM (SNOC (f n) (MAP f [0 ..< n])) by MAP_SNOC 4680 = f n + SUM (MAP f [0 ..< n]) by SUM_SNOC 4681*) 4682val listRangeLHI_SUM_MAP = store_thm( 4683 "listRangeLHI_SUM_MAP", 4684 ``!f n. SUM (MAP f [0 ..< (SUC n)]) = f n + SUM (MAP f [0 ..< n])``, 4685 rw[listRangeLHI_SNOC, MAP_SNOC, SUM_SNOC, ADD1]); 4686 4687(* ------------------------------------------------------------------------- *) 4688(* List Summation and Product *) 4689(* ------------------------------------------------------------------------- *) 4690 4691(* 4692> numpairTheory.tri_def; 4693val it = |- tri 0 = 0 /\ !n. tri (SUC n) = SUC n + tri n: thm 4694*) 4695 4696(* Theorem: SUM [1 .. n] = tri n *) 4697(* Proof: 4698 By induction on n, 4699 Base: SUM [1 .. 0] = tri 0 4700 SUM [1 .. 0] 4701 = SUM [] by listRangeINC_EMPTY 4702 = 0 by SUM_NIL 4703 = tri 0 by tri_def 4704 Step: SUM [1 .. n] = tri n ==> SUM [1 .. SUC n] = tri (SUC n) 4705 SUM [1 .. SUC n] 4706 = SUM (SNOC (SUC n) [1 .. n]) by listRangeINC_SNOC, 1 < n 4707 = SUM [1 .. n] + (SUC n) by SUM_SNOC 4708 = tri n + (SUC n) by induction hypothesis 4709 = tri (SUC n) by tri_def 4710*) 4711val sum_1_to_n_eq_tri_n = store_thm( 4712 "sum_1_to_n_eq_tri_n", 4713 ``!n. SUM [1 .. n] = tri n``, 4714 Induct >- 4715 rw[listRangeINC_EMPTY, SUM_NIL, numpairTheory.tri_def] >> 4716 rw[listRangeINC_SNOC, ADD1, SUM_SNOC, numpairTheory.tri_def]); 4717 4718(* Theorem: SUM [1 .. n] = HALF (n * (n + 1)) *) 4719(* Proof: 4720 SUM [1 .. n] 4721 = tri n by sum_1_to_n_eq_tri_n 4722 = HALF (n * (n + 1)) by tri_formula 4723*) 4724val sum_1_to_n_eqn = store_thm( 4725 "sum_1_to_n_eqn", 4726 ``!n. SUM [1 .. n] = HALF (n * (n + 1))``, 4727 rw[sum_1_to_n_eq_tri_n, numpairTheory.tri_formula]); 4728 4729(* Theorem: 2 * SUM [1 .. n] = n * (n + 1) *) 4730(* Proof: 4731 Note EVEN (n * (n + 1)) by EVEN_PARTNERS 4732 or 2 divides (n * (n + 1)) by EVEN_ALT 4733 Thus n * (n + 1) 4734 = ((n * (n + 1)) DIV 2) * 2 by DIV_MULT_EQ 4735 = (SUM [1 .. n]) * 2 by sum_1_to_n_eqn 4736 = 2 * SUM [1 .. n] by MULT_COMM 4737*) 4738val sum_1_to_n_double = store_thm( 4739 "sum_1_to_n_double", 4740 ``!n. 2 * SUM [1 .. n] = n * (n + 1)``, 4741 rpt strip_tac >> 4742 `2 divides (n * (n + 1))` by rw[EVEN_PARTNERS, GSYM EVEN_ALT] >> 4743 metis_tac[sum_1_to_n_eqn, DIV_MULT_EQ, MULT_COMM, DECIDE``0 < 2``]); 4744 4745(* Theorem: PROD [1 .. n] = FACT n *) 4746(* Proof: 4747 By induction on n, 4748 Base: PROD [1 .. 0] = FACT 0 4749 PROD [1 .. 0] 4750 = PROD [] by listRangeINC_EMPTY 4751 = 1 by PROD_NIL 4752 = FACT 0 by FACT 4753 Step: PROD [1 .. n] = FACT n ==> PROD [1 .. SUC n] = FACT (SUC n) 4754 PROD [1 .. SUC n] = FACT (SUC n) 4755 = PROD (SNOC (SUC n) [1 .. n]) by listRangeINC_SNOC, 1 < n 4756 = PROD [1 .. n] * (SUC n) by PROD_SNOC 4757 = (FACT n) * (SUC n) by induction hypothesis 4758 = FACT (SUC n) by FACT 4759*) 4760val prod_1_to_n_eq_fact_n = store_thm( 4761 "prod_1_to_n_eq_fact_n", 4762 ``!n. PROD [1 .. n] = FACT n``, 4763 Induct >- 4764 rw[listRangeINC_EMPTY, PROD_NIL, FACT] >> 4765 rw[listRangeINC_SNOC, ADD1, PROD_SNOC, FACT]); 4766 4767(* This is numerical version of: 4768poly_cyclic_cofactor |- !r. Ring r /\ #1 <> #0 ==> !n. unity n = unity 1 * cyclic n 4769*) 4770(* Theorem: (t ** n - 1 = (t - 1) * SUM (MAP (\j. t ** j) [0 ..< n])) *) 4771(* Proof: 4772 Let f = (\j. t ** j). 4773 By induction on n. 4774 Base: t ** 0 - 1 = (t - 1) * SUM (MAP f [0 ..< 0]) 4775 LHS = t ** 0 - 1 = 0 by EXP_0 4776 RHS = (t - 1) * SUM (MAP f [0 ..< 0]) 4777 = (t - 1) * SUM [] by listRangeLHI_EMPTY 4778 = (t - 1) * 0 = 0 by SUM 4779 Step: t ** n - 1 = (t - 1) * SUM (MAP f [0 ..< n]) ==> 4780 t ** SUC n - 1 = (t - 1) * SUM (MAP f [0 ..< SUC n]) 4781 If t = 0, 4782 LHS = 0 ** SUC n - 1 = 0 by EXP_0 4783 RHS = (0 - 1) * SUM (MAP f [0 ..< SUC n]) 4784 = 0 * SUM (MAP f [0 ..< SUC n]) by integer subtraction 4785 = 0 = LHS 4786 If t <> 0, 4787 Then 0 < t ** n by EXP_POS 4788 or 1 <= t ** n by arithmetic 4789 so (t ** n - 1) + (t * t ** n - t ** n) = t * t ** n - 1 4790 (t - 1) * SUM (MAP (\j. t ** j) [0 ..< (SUC n)]) 4791 = (t - 1) * SUM (MAP (\j. t ** j) [0 ..< n + 1]) by ADD1 4792 = (t - 1) * SUM (MAP (\j. t ** j) (SNOC n [0 ..< n])) by listRangeLHI_SNOC 4793 = (t - 1) * SUM (SNOC (t ** n) (MAP f [0 ..< n])) by MAP_SNOC 4794 = (t - 1) * (SUM (MAP f [0 ..< n]) + t ** n) by SUM_SNOC 4795 = (t - 1) * SUM (MAP f [0 ..< n]) + (t - 1) * t ** n by RIGHT_ADD_DISTRIB 4796 = (t ** n - 1) + (t - 1) * t ** n by induction hypothesis 4797 = t ** SUC n - 1 by EXP 4798*) 4799val power_predecessor_eqn = store_thm( 4800 "power_predecessor_eqn", 4801 ``!t n. t ** n - 1 = (t - 1) * SUM (MAP (\j. t ** j) [0 ..< n])``, 4802 rpt strip_tac >> 4803 qabbrev_tac `f = \j. t ** j` >> 4804 Induct_on `n` >- 4805 rw[EXP_0, Abbr`f`] >> 4806 Cases_on `t = 0` >- 4807 rw[ZERO_EXP, Abbr`f`] >> 4808 `(t ** n - 1) + (t * t ** n - t ** n) = t * t ** n - 1` by 4809 (`0 < t` by decide_tac >> 4810 `0 < t ** n` by rw[EXP_POS] >> 4811 `1 <= t ** n` by decide_tac >> 4812 `t ** n <= t * t ** n` by rw[] >> 4813 decide_tac) >> 4814 `(t - 1) * SUM (MAP f [0 ..< (SUC n)]) = (t - 1) * SUM (MAP f [0 ..< n + 1])` by rw[ADD1] >> 4815 `_ = (t - 1) * SUM (MAP f (SNOC n [0 ..< n]))` by rw[listRangeLHI_SNOC] >> 4816 `_ = (t - 1) * SUM (SNOC (t ** n) (MAP f [0 ..< n]))` by rw[MAP_SNOC, Abbr`f`] >> 4817 `_ = (t - 1) * (SUM (MAP f [0 ..< n]) + t ** n)` by rw[SUM_SNOC] >> 4818 `_ = (t - 1) * SUM (MAP f [0 ..< n]) + (t - 1) * t ** n` by rw[RIGHT_ADD_DISTRIB] >> 4819 `_ = (t ** n - 1) + (t - 1) * t ** n` by rw[] >> 4820 `_ = (t ** n - 1) + (t * t ** n - t ** n)` by rw[LEFT_SUB_DISTRIB] >> 4821 `_ = t * t ** n - 1` by rw[] >> 4822 `_ = t ** SUC n - 1 ` by rw[GSYM EXP] >> 4823 rw[]); 4824 4825(* Above is the formal proof of the following observation for any base: 4826 9 = 9 * 1 4827 99 = 9 * 11 4828 999 = 9 * 111 4829 9999 = 9 * 1111 4830 99999 = 8 * 11111 4831 etc. 4832 4833 This asserts: 4834 (t ** n - 1) = (t - 1) * (1 + t + t ** 2 + ... + t ** (n-1)) 4835 or 1 + t + t ** 2 + ... + t ** (n - 1) = (t ** n - 1) DIV (t - 1), 4836 which is the sum of the geometric series. 4837*) 4838 4839(* Theorem: 1 < t ==> (SUM (MAP (\j. t ** j) [0 ..< n]) = (t ** n - 1) DIV (t - 1)) *) 4840(* Proof: 4841 Note 0 < t - 1 by 1 < t 4842 Let s = SUM (MAP (\j. t ** j) [0 ..< n]). 4843 Then (t ** n - 1) = (t - 1) * s by power_predecessor_eqn 4844 Thus s = (t ** n - 1) DIV (t - 1) by MULT_TO_DIV, 0 < t - 1 4845*) 4846val geometric_sum_eqn = store_thm( 4847 "geometric_sum_eqn", 4848 ``!t n. 1 < t ==> (SUM (MAP (\j. t ** j) [0 ..< n]) = (t ** n - 1) DIV (t - 1))``, 4849 rpt strip_tac >> 4850 `0 < t - 1` by decide_tac >> 4851 rw_tac std_ss[power_predecessor_eqn, MULT_TO_DIV]); 4852 4853(* Theorem: 1 < t ==> (SUM (MAP (\j. t ** j) [0 .. n]) = (t ** (n + 1) - 1) DIV (t - 1)) *) 4854(* Proof: 4855 SUM (MAP (\j. t ** j) [0 .. n]) 4856 = SUM (MAP (\j. t ** j) [0 ..< n + 1]) by listRangeLHI_to_listRangeINC 4857 = (t ** (n + 1) - 1) DIV (t - 1) by geometric_sum_eqn 4858*) 4859val geometric_sum_eqn_alt = store_thm( 4860 "geometric_sum_eqn_alt", 4861 ``!t n. 1 < t ==> (SUM (MAP (\j. t ** j) [0 .. n]) = (t ** (n + 1) - 1) DIV (t - 1))``, 4862 rw_tac std_ss[GSYM listRangeLHI_to_listRangeINC, geometric_sum_eqn]); 4863 4864(* Theorem: SUM [1 ..< n] = HALF (n * (n - 1)) *) 4865(* Proof: 4866 If n = 0, 4867 LHS = SUM [1 ..< 0] 4868 = SUM [] = 0 by listRangeLHI_EMPTY 4869 RHS = HALF (0 * (0 - 1)) 4870 = 0 = LHS by arithmetic 4871 If n <> 0, 4872 Then n = (n - 1) + 1 by arithmetic, n <> 0 4873 SUM [1 ..< n] 4874 = SUM [1 .. n - 1] by listRangeLHI_to_listRangeINC 4875 = HALF ((n - 1) * (n - 1 + 1)) by sum_1_to_n_eqn 4876 = HALF (n * (n - 1)) by arithmetic 4877*) 4878val arithmetic_sum_eqn = store_thm( 4879 "arithmetic_sum_eqn", 4880 ``!n. SUM [1 ..< n] = HALF (n * (n - 1))``, 4881 rpt strip_tac >> 4882 Cases_on `n = 0` >- 4883 rw[listRangeLHI_EMPTY] >> 4884 `n = (n - 1) + 1` by decide_tac >> 4885 `SUM [1 ..< n] = SUM [1 .. n - 1]` by rw[GSYM listRangeLHI_to_listRangeINC] >> 4886 `_ = HALF ((n - 1) * (n - 1 + 1))` by rw[sum_1_to_n_eqn] >> 4887 `_ = HALF (n * (n - 1))` by rw[] >> 4888 rw[]); 4889 4890(* Theorem alias *) 4891val arithmetic_sum_eqn_alt = save_thm("arithmetic_sum_eqn_alt", sum_1_to_n_eqn); 4892(* val arithmetic_sum_eqn_alt = |- !n. SUM [1 .. n] = HALF (n * (n + 1)): thm *) 4893 4894(* Theorem: SUM (GENLIST (\j. f (n - j)) n) = SUM (MAP f [1 .. n]) *) 4895(* Proof: 4896 SUM (GENLIST (\j. f (n - j)) n) 4897 = SUM (REVERSE (GENLIST (\j. f (n - j)) n)) by SUM_REVERSE 4898 = SUM (GENLIST (\j. f (n - (PRE n - j))) n) by REVERSE_GENLIST 4899 = SUM (GENLIST (\j. f (1 + j)) n) by LIST_EQ, SUB_SUB 4900 = SUM (GENLIST (f o SUC) n) by FUN_EQ_THM 4901 = SUM (MAP f [1 .. n]) by listRangeINC_MAP 4902*) 4903val SUM_GENLIST_REVERSE = store_thm( 4904 "SUM_GENLIST_REVERSE", 4905 ``!f n. SUM (GENLIST (\j. f (n - j)) n) = SUM (MAP f [1 .. n])``, 4906 rpt strip_tac >> 4907 `GENLIST (\j. f (n - (PRE n - j))) n = GENLIST (f o SUC) n` by 4908 (irule LIST_EQ >> 4909 rw[] >> 4910 `n + x - PRE n = SUC x` by decide_tac >> 4911 simp[]) >> 4912 qabbrev_tac `g = \j. f (n - j)` >> 4913 `SUM (GENLIST g n) = SUM (REVERSE (GENLIST g n))` by rw[SUM_REVERSE] >> 4914 `_ = SUM (GENLIST (\j. g (PRE n - j)) n)` by rw[REVERSE_GENLIST] >> 4915 `_ = SUM (GENLIST (f o SUC) n)` by rw[Abbr`g`] >> 4916 `_ = SUM (MAP f [1 .. n])` by rw[listRangeINC_MAP] >> 4917 decide_tac); 4918(* Note: locate here due to use of listRangeINC_MAP *) 4919 4920(* ------------------------------------------------------------------------- *) 4921(* MAP of function with 3 list arguments *) 4922(* ------------------------------------------------------------------------- *) 4923 4924(* Define MAP3 similar to MAP2 in listTheory. *) 4925val dDefine = Lib.with_flag (Defn.def_suffix, "_DEF") Define; 4926val MAP3_DEF = dDefine` 4927 (MAP3 f (h1::t1) (h2::t2) (h3::t3) = f h1 h2 h3::MAP3 f t1 t2 t3) /\ 4928 (MAP3 f x y z = [])`; 4929val _ = export_rewrites["MAP3_DEF"]; 4930val MAP3 = store_thm ("MAP3", 4931``(!f. MAP3 f [] [] [] = []) /\ 4932 (!f h1 t1 h2 t2 h3 t3. MAP3 f (h1::t1) (h2::t2) (h3::t3) = f h1 h2 h3::MAP3 f t1 t2 t3)``, 4933 METIS_TAC[MAP3_DEF]); 4934 4935(* 4936LENGTH_MAP |- !l f. LENGTH (MAP f l) = LENGTH l 4937LENGTH_MAP2 |- !xs ys. LENGTH (MAP2 f xs ys) = MIN (LENGTH xs) (LENGTH ys) 4938*) 4939 4940(* Theorem: LENGTH (MAP3 f lx ly lz) = MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) *) 4941(* Proof: 4942 By induction on lx. 4943 Base: !ly lz f. LENGTH (MAP3 f [] ly lz) = MIN (MIN (LENGTH []) (LENGTH ly)) (LENGTH lz) 4944 LHS = LENGTH [] = 0 by MAP3, LENGTH 4945 RHS = MIN (MIN 0 (LENGTH ly)) (LENGTH lz) by LENGTH 4946 = MIN 0 (LENGTH lz) = 0 = LHS by MIN_DEF 4947 Step: !ly lz f. LENGTH (MAP3 f lx ly lz) = MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==> 4948 !h ly lz f. LENGTH (MAP3 f (h::lx) ly lz) = MIN (MIN (LENGTH (h::lx)) (LENGTH ly)) (LENGTH lz) 4949 If ly = [], 4950 LHS = LENGTH (MAP3 f (h::lx) [] lz) = 0 by MAP3, LENGTH 4951 RHS = MIN (MIN (LENGTH (h::lx)) (LENGTH [])) (LENGTH lz) 4952 = MIN 0 (LENGTH lz) = 0 = LHS by MIN_DEF 4953 Otherwise, ly = h'::t. 4954 If lz = [], 4955 LHS = LENGTH (MAP3 f (h::lx) (h'::t) []) = 0 by MAP3, LENGTH 4956 RHS = MIN (MIN (LENGTH (h::lx)) (LENGTH (h'::t))) (LENGTH []) 4957 = 0 = LHS by MIN_DEF 4958 Otherwise, lz = h''::t'. 4959 LHS = LENGTH (MAP3 f (h::lx) (h'::t) (h''::t')) 4960 = LENGTH (f h' h''::MAP3 lx t t'') by MAP3 4961 = SUC (LENGTH MAP3 lx t t'') by LENGTH 4962 = SUC (MIN (MIN (LENGTH lx) (LENGTH t)) (LENGTH t'')) by induction hypothesis 4963 RHS = MIN (MIN (LENGTH (h::lx)) (LENGTH (h'::t))) (LENGTH (h''::t')) 4964 = MIN (MIN (SUC (LENGTH lx)) (SUC (LENGTH t))) (SUC (LENGTH t')) by LENGTH 4965 = MIN (SUC (MIN (LENGTH lx) (LENGTH t))) (SUC (LESS_TWICE t')) by MIN_DEF 4966 = SUC (MIN (MIN (LENGTH lx) (LENGTH t)) (LENGTH t'')) = LHS by MIN_DEF 4967*) 4968val LENGTH_MAP3 = store_thm( 4969 "LENGTH_MAP3", 4970 ``!lx ly lz f. LENGTH (MAP3 f lx ly lz) = MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz)``, 4971 Induct_on `lx` >- 4972 rw[] >> 4973 rpt strip_tac >> 4974 Cases_on `ly` >- 4975 rw[] >> 4976 Cases_on `lz` >- 4977 rw[] >> 4978 rw[MIN_DEF]); 4979 4980(* 4981EL_MAP |- !n l. n < LENGTH l ==> !f. EL n (MAP f l) = f (EL n l) 4982EL_MAP2 |- !ts tt n. n < MIN (LENGTH ts) (LENGTH tt) ==> (EL n (MAP2 f ts tt) = f (EL n ts) (EL n tt)) 4983*) 4984 4985(* Theorem: n < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==> 4986 !f. EL n (MAP3 f lx ly lz) = f (EL n lx) (EL n ly) (EL n lz) *) 4987(* Proof: 4988 By induction on n. 4989 Base: !lx ly lz. 0 < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==> 4990 !f. EL 0 (MAP3 f lx ly lz) = f (EL 0 lx) (EL 0 ly) (EL 0 lz) 4991 Note ?x tx. lx = x::tx by LENGTH_EQ_0, list_CASES 4992 and ?y ty. ly = y::ty by LENGTH_EQ_0, list_CASES 4993 and ?z tz. lz = z::tz by LENGTH_EQ_0, list_CASES 4994 EL 0 (MAP3 f lx ly lz) 4995 = EL 0 (MAP3 f (x::lx) (y::ty) (z::tz)) 4996 = EL 0 (f x y z::MAP3 f tx ty tz) by MAP3 4997 = f x y z by EL 4998 = f (EL 0 lx) (EL 0 ly) (EL 0 lz) by EL 4999 Step: !lx ly lz. n < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==> 5000 !f. EL n (MAP3 f lx ly lz) = f (EL n lx) (EL n ly) (EL n lz) ==> 5001 !lx ly lz. SUC n < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==> 5002 !f. EL (SUC n) (MAP3 f lx ly lz) = f (EL (SUC n) lx) (EL (SUC n) ly) (EL (SUC n) lz) 5003 Note ?x tx. lx = x::tx by LENGTH_EQ_0, list_CASES 5004 and ?y ty. ly = y::ty by LENGTH_EQ_0, list_CASES 5005 and ?z tz. lz = z::tz by LENGTH_EQ_0, list_CASES 5006 Also n < LENGTH tx /\ n < LENGTH ty /\ n < LENGTH tz by LENGTH 5007 Thus n < MIN (MIN (LENGTH tx) (LENGTH ty)) (LENGTH tz) by MIN_DEF 5008 EL (SUC n) (MAP3 f lx ly lz) 5009 = EL (SUC n) (MAP3 f (x::lx) (y::ty) (z::tz)) 5010 = EL (SUC n) (f x y z::MAP3 f tx ty tz) by MAP3 5011 = EL n (MAP3 f tx ty tz) by EL 5012 = f (EL n tx) (EL n ty) (EL n tz) by induction hypothesis 5013 = f (EL (SUC n) lx) (EL (SUC n) ly) (EL (SUC n) lz) 5014 by EL 5015*) 5016val EL_MAP3 = store_thm( 5017 "EL_MAP3", 5018 ``!lx ly lz n. n < MIN (MIN (LENGTH lx) (LENGTH ly)) (LENGTH lz) ==> 5019 !f. EL n (MAP3 f lx ly lz) = f (EL n lx) (EL n ly) (EL n lz)``, 5020 Induct_on `n` >| [ 5021 rw[] >> 5022 `?x tx. lx = x::tx` by metis_tac[LENGTH_EQ_0, list_CASES, NOT_ZERO_LT_ZERO] >> 5023 `?y ty. ly = y::ty` by metis_tac[LENGTH_EQ_0, list_CASES, NOT_ZERO_LT_ZERO] >> 5024 `?z tz. lz = z::tz` by metis_tac[LENGTH_EQ_0, list_CASES, NOT_ZERO_LT_ZERO] >> 5025 rw[], 5026 rw[] >> 5027 `!a. SUC n < a ==> a <> 0` by decide_tac >> 5028 `?x tx. lx = x::tx` by metis_tac[LENGTH_EQ_0, list_CASES] >> 5029 `?y ty. ly = y::ty` by metis_tac[LENGTH_EQ_0, list_CASES] >> 5030 `?z tz. lz = z::tz` by metis_tac[LENGTH_EQ_0, list_CASES] >> 5031 `n < LENGTH tx /\ n < LENGTH ty /\ n < LENGTH tz` by fs[] >> 5032 rw[] 5033 ]); 5034 5035(* 5036MEM_MAP |- !l f x. MEM x (MAP f l) <=> ?y. x = f y /\ MEM y l 5037*) 5038 5039(* Theorem: MEM x (MAP2 f l1 l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 l2 *) 5040(* Proof: 5041 By induction on l1. 5042 Base: !l2. MEM x (MAP2 f [] l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 [] /\ MEM y2 l2 5043 Note MAP2 f [] l2 = [] by MAP2_DEF 5044 and MEM x [] = F, hence true by MEM 5045 Step: !l2. MEM x (MAP2 f l1 l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 l2 ==> 5046 !h l2. MEM x (MAP2 f (h::l1) l2) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 (h::l1) /\ MEM y2 l2 5047 If l2 = [], 5048 Then MEM x (MAP2 f (h::l1) []) = F, hence true by MEM 5049 Otherwise, l2 = h'::t, 5050 to show: MEM x (MAP2 f (h::l1) (h'::t)) ==> ?y1 y2. x = f y1 y2 /\ MEM y1 (h::l1) /\ MEM y2 (h'::t) 5051 Note MAP2 f (h::l1) (h'::t) 5052 = (f h h')::MAP2 f l1 t by MAP2 5053 Thus x = f h h' or MEM x (MAP2 f l1 t) by MEM 5054 If x = f h h', 5055 Take y1 = h, y2 = h', and the result follows by MEM 5056 If MEM x (MAP2 f l1 t) 5057 Then ?y1 y2. x = f y1 y2 /\ MEM y1 l1 /\ MEM y2 t by induction hypothesis 5058 Take this y1 and y2, the result follows by MEM 5059*) 5060val MEM_MAP2 = store_thm( 5061 "MEM_MAP2", 5062 ``!f x l1 l2. MEM x (MAP2 f l1 l2) ==> ?y1 y2. (x = f y1 y2) /\ MEM y1 l1 /\ MEM y2 l2``, 5063 ntac 2 strip_tac >> 5064 Induct_on `l1` >- 5065 rw[] >> 5066 rpt strip_tac >> 5067 Cases_on `l2` >- 5068 fs[] >> 5069 fs[] >- 5070 metis_tac[] >> 5071 metis_tac[MEM]); 5072 5073(* Theorem: MEM x (MAP3 f l1 l2 l3) ==> ?y1 y2 y3. (x = f y1 y2 y3) /\ MEM y1 l1 /\ MEM y2 l2 /\ MEM y3 l3 *) 5074(* Proof: 5075 By induction on l1. 5076 Base: !l2 l3. MEM x (MAP3 f [] l2 l3) ==> ... 5077 Note MAP3 f [] l2 l3 = [], and MEM x [] = F, hence true. 5078 Step: !l2 l3. MEM x (MAP3 f l1 l2 l3) ==> 5079 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 l1 /\ MEM y2 l2 /\ MEM y3 l3 ==> 5080 !h l2 l3. MEM x (MAP3 f (h::l1) l2 l3) ==> 5081 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 (h::l1) /\ MEM y2 l2 /\ MEM y3 l3 5082 If l2 = [], 5083 Then MEM x (MAP3 f (h::l1) [] l3) = MEM x [] = F, hence true by MAP3_DEF 5084 Otherwise, l2 = h'::t, 5085 to show: MEM x (MAP3 f (h::l1) (h'::t) l3) ==> 5086 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 (h::l1) /\ MEM y2 (h'::t) /\ MEM y3 l3 5087 If l3 = [], 5088 Then MEM x (MAP3 f (h::l1) l2 []) = MEM x [] = F, hence true by MAP3_DEF 5089 Otherwise, l3 = h''::t', 5090 to show: MEM x (MAP3 f (h::l1) (h'::t) (h''::t')) ==> 5091 ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 (h::l1) /\ MEM y2 (h'::t) /\ MEM y3 (h''::t') 5092 5093 Note MAP3 f (h::l1) (h'::t) (h''::t') 5094 = (f h h' h'')::MAP3 f l1 t t' by MAP3 5095 Thus x = f h h' h'' or MEM x (MAP3 f l1 t t') by MEM 5096 If x = f h h' h'', 5097 Take y1 = h, y2 = h', y3 = h'' and the result follows by MEM 5098 If MEM x (MAP3 f l1 t t') 5099 Then ?y1 y2 y3. x = f y1 y2 y3 /\ MEM y1 t /\ MEM y2 l2 /\ MEM y3 t' 5100 by induction hypothesis 5101 Take this y1, y2 and y3, the result follows by MEM 5102*) 5103val MEM_MAP3 = store_thm( 5104 "MEM_MAP3", 5105 ``!f x l1 l2 l3. MEM x (MAP3 f l1 l2 l3) ==> 5106 ?y1 y2 y3. (x = f y1 y2 y3) /\ MEM y1 l1 /\ MEM y2 l2 /\ MEM y3 l3``, 5107 ntac 2 strip_tac >> 5108 Induct_on `l1` >- 5109 rw[] >> 5110 rpt strip_tac >> 5111 Cases_on `l2` >- 5112 fs[] >> 5113 Cases_on `l3` >- 5114 fs[] >> 5115 fs[] >- 5116 metis_tac[] >> 5117 metis_tac[MEM]); 5118 5119(* Theorem: SUM (MAP (K c) ls) = c * LENGTH ls *) 5120(* Proof: 5121 By induction on ls. 5122 Base: !c. SUM (MAP (K c) []) = c * LENGTH [] 5123 LHS = SUM (MAP (K c) []) 5124 = SUM [] = 0 by MAP, SUM 5125 RHS = c * LENGTH [] 5126 = c * 0 = 0 = LHS by LENGTH 5127 Step: !c. SUM (MAP (K c) ls) = c * LENGTH ls ==> 5128 !h c. SUM (MAP (K c) (h::ls)) = c * LENGTH (h::ls) 5129 SUM (MAP (K c) (h::ls)) 5130 = SUM (c :: MAP (K c) ls) by MAP 5131 = c + SUM (MAP (K c) ls) by SUM 5132 = c + c * LENGTH ls by induction hypothesis 5133 = c * (1 + LENGTH ls) by RIGHT_ADD_DISTRIB 5134 = c * (SUC (LENGTH ls)) by ADD1 5135 = c * LENGTH (h::ls) by LENGTH 5136*) 5137val SUM_MAP_K = store_thm( 5138 "SUM_MAP_K", 5139 ``!ls c. SUM (MAP (K c) ls) = c * LENGTH ls``, 5140 Induct >- 5141 rw[] >> 5142 rw[ADD1]); 5143 5144(* Theorem: a <= b ==> SUM (MAP (K a) ls) <= SUM (MAP (K b) ls) *) 5145(* Proof: 5146 SUM (MAP (K a) ls) 5147 = a * LENGTH ls by SUM_MAP_K 5148 <= b * LENGTH ls by a <= b 5149 = SUM (MAP (K b) ls) by SUM_MAP_K 5150*) 5151val SUM_MAP_K_LE = store_thm( 5152 "SUM_MAP_K_LE", 5153 ``!ls a b. a <= b ==> SUM (MAP (K a) ls) <= SUM (MAP (K b) ls)``, 5154 rw[SUM_MAP_K]); 5155 5156(* Theorem: SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) *) 5157(* Proof: 5158 By induction on lx. 5159 Base: !ly c. SUM (MAP2 (\x y. c) [] ly) = c * LENGTH (MAP2 (\x y. c) [] ly) 5160 LHS = SUM (MAP2 (\x y. c) [] ly) 5161 = SUM [] = 0 by MAP2_DEF, SUM 5162 RHS = c * LENGTH (MAP2 (\x y. c) [] ly) 5163 = c * 0 = 0 = LHS by MAP2_DEF, LENGTH 5164 Step: !ly c. SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) ==> 5165 !h ly c. SUM (MAP2 (\x y. c) (h::lx) ly) = c * LENGTH (MAP2 (\x y. c) (h::lx) ly) 5166 If ly = [], 5167 to show: SUM (MAP2 (\x y. c) (h::lx) []) = c * LENGTH (MAP2 (\x y. c) (h::lx) []) 5168 LHS = SUM (MAP2 (\x y. c) (h::lx) []) 5169 = SUM [] = 0 by MAP2_DEF, SUM 5170 RHS = c * LENGTH (MAP2 (\x y. c) (h::lx) []) 5171 = c * 0 = 0 = LHS by MAP2_DEF, LENGTH 5172 Otherwise, ly = h'::t, 5173 to show: SUM (MAP2 (\x y. c) (h::lx) (h'::t)) = c * LENGTH (MAP2 (\x y. c) (h::lx) (h'::t)) 5174 5175 SUM (MAP2 (\x y. c) (h::lx) (h'::t)) 5176 = SUM (c :: MAP2 (\x y. c) lx t) by MAP2_DEF 5177 = c + SUM (MAP2 (\x y. c) lx t) by SUM 5178 = c + c * LENGTH (MAP2 (\x y. c) lx t) by induction hypothesis 5179 = c * (1 + LENGTH (MAP2 (\x y. c) lx t) by RIGHT_ADD_DISTRIB 5180 = c * (SUC (LENGTH (MAP2 (\x y. c) lx t)) by ADD1 5181 = c * LENGTH (MAP2 (\x y. c) (h::lx) (h'::t)) by LENGTH 5182*) 5183val SUM_MAP2_K = store_thm( 5184 "SUM_MAP2_K", 5185 ``!lx ly c. SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly)``, 5186 Induct >- 5187 rw[] >> 5188 rpt strip_tac >> 5189 Cases_on `ly` >- 5190 rw[] >> 5191 rw[ADD1, MIN_DEF]); 5192 5193(* Theorem: SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz) *) 5194(* Proof: 5195 By induction on lx. 5196 Base: !ly lz c. SUM (MAP3 (\x y z. c) [] ly lz) = c * LENGTH (MAP3 (\x y z. c) [] ly lz) 5197 LHS = SUM (MAP3 (\x y z. c) [] ly lz) 5198 = SUM [] = 0 by MAP3_DEF, SUM 5199 RHS = c * LENGTH (MAP3 (\x y z. c) [] ly lz) 5200 = c * 0 = 0 = LHS by MAP3_DEF, LENGTH 5201 Step: !ly lz c. SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz) ==> 5202 !h ly lz c. SUM (MAP3 (\x y z. c) (h::lx) ly lz) = c * LENGTH (MAP3 (\x y z. c) (h::lx) ly lz) 5203 If ly = [], 5204 to show: SUM (MAP3 (\x y z. c) (h::lx) [] lz) = c * LENGTH (MAP3 (\x y z. c) (h::lx) [] lz) 5205 LHS = SUM (MAP3 (\x y z. c) (h::lx) [] lz) 5206 = SUM [] = 0 by MAP3_DEF, SUM 5207 RHS = c * LENGTH (MAP3 (\x y z. c) (h::lx) [] lz) 5208 = c * 0 = 0 = LHS by MAP3_DEF, LENGTH 5209 Otherwise, ly = h'::t, 5210 to show: SUM (MAP3 (\x y z. c) (h::lx) (h'::t) lz) = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) lz) 5211 If lz = [], 5212 to show: SUM (MAP3 (\x y z. c) (h::lx) (h'::t) []) = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) []) 5213 LHS = SUM (MAP3 (\x y z. c) (h::lx) (h'::t) []) 5214 = SUM [] = 0 by MAP3_DEF, SUM 5215 RHS = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) []) 5216 = c * 0 = 0 by MAP3_DEF, LENGTH 5217 Otherwise, lz = h''::t', 5218 to show: SUM (MAP3 (\x y z. c) (h::lx) (h'::t) (h''::t')) = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) (h''::t')) 5219 SUM (MAP3 (\x y z. c) (h::lx) (h'::t) (h''::t')) 5220 = SUM (c :: MAP3 (\x y z. c) lx t t') by MAP3_DEF 5221 = c + SUM (MAP3 (\x y z. c) lx t t') by SUM 5222 = c + c * LENGTH (MAP3 (\x y z. c) lx t t') by induction hypothesis 5223 = c * (1 + LENGTH (MAP3 (\x y z. c) lx t t') by RIGHT_ADD_DISTRIB 5224 = c * (SUC (LENGTH (MAP3 (\x y z. c) lx t t')) by ADD1 5225 = c * LENGTH (MAP3 (\x y z. c) (h::lx) (h'::t) (h''::t')) by LENGTH 5226*) 5227val SUM_MAP3_K = store_thm( 5228 "SUM_MAP3_K", 5229 ``!lx ly lz c. SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz)``, 5230 Induct >- 5231 rw[] >> 5232 rpt strip_tac >> 5233 Cases_on `ly` >- 5234 rw[] >> 5235 Cases_on `lz` >- 5236 rw[] >> 5237 rw[ADD1]); 5238 5239(* ------------------------------------------------------------------------- *) 5240(* Bounds on Lists *) 5241(* ------------------------------------------------------------------------- *) 5242 5243(* Overload non-decreasing functions with different arity. *) 5244val _ = overload_on("MONO", ``\f:num -> num. !x y. x <= y ==> f x <= f y``); 5245val _ = overload_on("MONO2", ``\f:num -> num -> num. !x1 y1 x2 y2. x1 <= x2 /\ y1 <= y2 ==> f x1 y1 <= f x2 y2``); 5246val _ = overload_on("MONO3", ``\f:num -> num -> num -> num. !x1 y1 z1 x2 y2 z2. x1 <= x2 /\ y1 <= y2 /\ z1 <= z2 ==> f x1 y1 z1 <= f x2 y2 z2``); 5247 5248(* Overload non-increasing functions with different arity. *) 5249val _ = overload_on("RMONO", ``\f:num -> num. !x y. x <= y ==> f y <= f x``); 5250val _ = overload_on("RMONO2", ``\f:num -> num -> num. !x1 y1 x2 y2. x1 <= x2 /\ y1 <= y2 ==> f x2 y2 <= f x1 y1``); 5251val _ = overload_on("RMONO3", ``\f:num -> num -> num -> num. !x1 y1 z1 x2 y2 z2. x1 <= x2 /\ y1 <= y2 /\ z1 <= z2 ==> f x2 y2 z2 <= f x1 y1 z1``); 5252 5253 5254(* Theorem: SUM ls <= (MAX_LIST ls) * LENGTH ls *) 5255(* Proof: 5256 By induction on ls. 5257 Base: SUM [] <= MAX_LIST [] * LENGTH [] 5258 LHS = SUM [] = 0 by SUM 5259 RHS = MAX_LIST [] * LENGTH [] 5260 = 0 * 0 = 0 by MAX_LIST, LENGTH 5261 Hence true. 5262 Step: SUM ls <= MAX_LIST ls * LENGTH ls ==> 5263 !h. SUM (h::ls) <= MAX_LIST (h::ls) * LENGTH (h::ls) 5264 SUM (h::ls) 5265 = h + SUM ls by SUM 5266 <= h + MAX_LIST ls * LENGTH ls by induction hypothesis 5267 <= MAX_LIST (h::ls) + MAX_LIST ls * LENGTH ls by MAX_LIST_PROPERTY 5268 <= MAX_LIST (h::ls) + MAX_LIST (h::ls) * LENGTH ls by MAX_LIST_LE 5269 = MAX_LIST (h::ls) * (1 + LENGTH ls) by LEFT_ADD_DISTRIB 5270 = MAX_LIST (h::ls) * LENGTH (h::ls) by LENGTH 5271*) 5272val SUM_UPPER = store_thm( 5273 "SUM_UPPER", 5274 ``!ls. SUM ls <= (MAX_LIST ls) * LENGTH ls``, 5275 Induct_on `ls` >- 5276 rw[] >> 5277 strip_tac >> 5278 `SUM (h::ls) <= h + MAX_LIST ls * LENGTH ls` by rw[] >> 5279 `h + MAX_LIST ls * LENGTH ls <= MAX_LIST (h::ls) + MAX_LIST ls * LENGTH ls` by rw[] >> 5280 `MAX_LIST (h::ls) + MAX_LIST ls * LENGTH ls <= MAX_LIST (h::ls) + MAX_LIST (h::ls) * LENGTH ls` by rw[] >> 5281 `MAX_LIST (h::ls) + MAX_LIST (h::ls) * LENGTH ls = MAX_LIST (h::ls) * (1 + LENGTH ls)` by rw[] >> 5282 `_ = MAX_LIST (h::ls) * LENGTH (h::ls)` by rw[] >> 5283 decide_tac); 5284 5285(* Theorem: (MIN_LIST ls) * LENGTH ls <= SUM ls *) 5286(* Proof: 5287 By induction on ls. 5288 Base: MIN_LIST [] * LENGTH [] <= SUM [] 5289 LHS = (MIN_LIST []) * LENGTH [] = 0 by LENGTH 5290 RHS = SUM [] = 0 by SUM 5291 Hence true. 5292 Step: MIN_LIST ls * LENGTH ls <= SUM ls ==> 5293 !h. MIN_LIST (h::ls) * LENGTH (h::ls) <= SUM (h::ls) 5294 If ls = [], 5295 LHS = (MIN_LIST [h]) * LENGTH [h] 5296 = h * 1 = h by MIN_LIST_def, LENGTH 5297 RHS = SUM [h] = h by SUM 5298 Hence true. 5299 If ls <> [], 5300 MIN_LIST (h::ls) * LENGTH (h::ls) 5301 = (MIN h (MIN_LIST ls)) * (1 + LENGTH ls) by MIN_LIST_def, LENGTH 5302 = (MIN h (MIN_LIST ls)) + (MIN h (MIN_LIST ls)) * LENGTH ls 5303 by RIGHT_ADD_DISTRIB 5304 <= h + (MIN_LIST ls) * LENGTH ls by MIN_IS_MIN 5305 <= h + SUM ls by induction hypothesis 5306 = SUM (h::ls) by SUM 5307*) 5308val SUM_LOWER = store_thm( 5309 "SUM_LOWER", 5310 ``!ls. (MIN_LIST ls) * LENGTH ls <= SUM ls``, 5311 Induct_on `ls` >- 5312 rw[] >> 5313 strip_tac >> 5314 Cases_on `ls = []` >- 5315 rw[] >> 5316 `MIN_LIST (h::ls) * LENGTH (h::ls) = (MIN h (MIN_LIST ls)) * (1 + LENGTH ls)` by rw[] >> 5317 `_ = (MIN h (MIN_LIST ls)) + (MIN h (MIN_LIST ls)) * LENGTH ls` by rw[] >> 5318 `(MIN h (MIN_LIST ls)) <= h` by rw[] >> 5319 `(MIN h (MIN_LIST ls)) * LENGTH ls <= (MIN_LIST ls) * LENGTH ls` by rw[] >> 5320 rw[]); 5321 5322(* Theorem: EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls) *) 5323(* Proof: 5324 By induction on ls. 5325 Base: EVERY (\x. f x <= g x) [] ==> SUM (MAP f []) <= SUM (MAP g []) 5326 EVERY (\x. f x <= g x) [] = T by EVERY_DEF 5327 SUM (MAP f []) 5328 = SUM [] by MAP 5329 = SUM (MAP g []) by MAP 5330 Step: EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls) ==> 5331 !h. EVERY (\x. f x <= g x) (h::ls) ==> SUM (MAP f (h::ls)) <= SUM (MAP g (h::ls)) 5332 Note f h <= g h /\ 5333 EVERY (\x. f x <= g x) ls by EVERY_DEF 5334 SUM (MAP f (h::ls)) 5335 = SUM (f h :: MAP f ls) by MAP 5336 = f h + SUM (MAP f ls) by SUM 5337 <= g h + SUM (MAP g ls) by above, induction hypothesis 5338 = SUM (g h :: MAP g ls) by SUM 5339 = SUM (MAP g (h::ls)) by MAP 5340*) 5341val SUM_MAP_LE = store_thm( 5342 "SUM_MAP_LE", 5343 ``!f g ls. EVERY (\x. f x <= g x) ls ==> SUM (MAP f ls) <= SUM (MAP g ls)``, 5344 rpt strip_tac >> 5345 Induct_on `ls` >> 5346 rw[] >> 5347 rw[] >> 5348 fs[]); 5349 5350(* Theorem: EVERY (\x. f x < g x) ls /\ ls <> [] ==> SUM (MAP f ls) < SUM (MAP g ls) *) 5351(* Proof: 5352 By induction on ls. 5353 Base: EVERY (\x. f x <= g x) [] /\ [] <> [] ==> SUM (MAP f []) <= SUM (MAP g []) 5354 True since [] <> [] = F. 5355 Step: EVERY (\x. f x <= g x) ls ==> ls <> [] ==> SUM (MAP f ls) <= SUM (MAP g ls) ==> 5356 !h. EVERY (\x. f x <= g x) (h::ls) ==> h::ls <> [] ==> SUM (MAP f (h::ls)) <= SUM (MAP g (h::ls)) 5357 Note f h < g h /\ 5358 EVERY (\x. f x < g x) ls by EVERY_DEF 5359 5360 If ls = [], 5361 SUM (MAP f [h]) 5362 = SUM (f h) by MAP 5363 = f h by SUM 5364 < g h by above 5365 = SUM (g h) by SUM 5366 = SUM (MAP g [h]) by MAP 5367 5368 If ls <> [], 5369 SUM (MAP f (h::ls)) 5370 = SUM (f h :: MAP f ls) by MAP 5371 = f h + SUM (MAP f ls) by SUM 5372 < g h + SUM (MAP g ls) by induction hypothesis 5373 = SUM (g h :: MAP g ls) by SUM 5374 = SUM (MAP g (h::ls)) by MAP 5375*) 5376val SUM_MAP_LT = store_thm( 5377 "SUM_MAP_LT", 5378 ``!f g ls. EVERY (\x. f x < g x) ls /\ ls <> [] ==> SUM (MAP f ls) < SUM (MAP g ls)``, 5379 rpt strip_tac >> 5380 Induct_on `ls` >> 5381 rw[] >> 5382 rw[] >> 5383 (Cases_on `ls = []` >> fs[])); 5384 5385(* 5386MAX_LIST_PROPERTY |- !l x. MEM x l ==> x <= MAX_LIST l 5387MIN_LIST_PROPERTY |- !l. l <> [] ==> !x. MEM x l ==> MIN_LIST l <= x 5388*) 5389 5390(* Theorem: MONO f ==> !ls e. MEM e (MAP f ls) ==> e <= f (MAX_LIST ls) *) 5391(* Proof: 5392 Note ?y. (e = f y) /\ MEM y ls by MEM_MAP 5393 and y <= MAX_LIST ls by MAX_LIST_PROPERTY 5394 Thus f y <= f (MAX_LIST ls) by given 5395 or e <= f (MAX_LIST ls) by e = f y 5396*) 5397val MEM_MAP_UPPER = store_thm( 5398 "MEM_MAP_UPPER", 5399 ``!f. MONO f ==> !ls e. MEM e (MAP f ls) ==> e <= f (MAX_LIST ls)``, 5400 rpt strip_tac >> 5401 `?y. (e = f y) /\ MEM y ls` by rw[GSYM MEM_MAP] >> 5402 `y <= MAX_LIST ls` by rw[MAX_LIST_PROPERTY] >> 5403 rw[]); 5404 5405(* Theorem: MONO2 f ==> !lx ly e. MEM e (MAP2 f lx ly) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) *) 5406(* Proof: 5407 Note ?ex ey. (e = f ex ey) /\ 5408 MEM ex lx /\ MEM ey ly by MEM_MAP2 5409 and ex <= MAX_LIST lx by MAX_LIST_PROPERTY 5410 and ey <= MAX_LIST ly by MAX_LIST_PROPERTY 5411 The result follows by the non-decreasing condition on f. 5412*) 5413val MEM_MAP2_UPPER = store_thm( 5414 "MEM_MAP2_UPPER", 5415 ``!f. MONO2 f ==> !lx ly e. MEM e (MAP2 f lx ly) ==> e <= f (MAX_LIST lx) (MAX_LIST ly)``, 5416 metis_tac[MEM_MAP2, MAX_LIST_PROPERTY]); 5417 5418(* Theorem: MONO3 f ==> 5419 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) *) 5420(* Proof: 5421 Note ?ex ey ez. (e = f ex ey ez) /\ 5422 MEM ex lx /\ MEM ey ly /\ MEM ez lz by MEM_MAP3 5423 and ex <= MAX_LIST lx by MAX_LIST_PROPERTY 5424 and ey <= MAX_LIST ly by MAX_LIST_PROPERTY 5425 and ez <= MAX_LIST lz by MAX_LIST_PROPERTY 5426 The result follows by the non-decreasing condition on f. 5427*) 5428val MEM_MAP3_UPPER = store_thm( 5429 "MEM_MAP3_UPPER", 5430 ``!f. MONO3 f ==> 5431 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> e <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz)``, 5432 metis_tac[MEM_MAP3, MAX_LIST_PROPERTY]); 5433 5434(* Theorem: MONO f ==> !ls e. MEM e (MAP f ls) ==> f (MIN_LIST ls) <= e *) 5435(* Proof: 5436 Note ?y. (e = f y) /\ MEM y ls by MEM_MAP 5437 and ls <> [] by MEM, MEM y ls 5438 then MIN_LIST ls <= y by MIN_LIST_PROPERTY, ls <> [] 5439 Thus f (MIN_LIST ls) <= f y by given 5440 or f (MIN_LIST ls) <= e by e = f y 5441*) 5442val MEM_MAP_LOWER = store_thm( 5443 "MEM_MAP_LOWER", 5444 ``!f. MONO f ==> !ls e. MEM e (MAP f ls) ==> f (MIN_LIST ls) <= e``, 5445 rpt strip_tac >> 5446 `?y. (e = f y) /\ MEM y ls` by rw[GSYM MEM_MAP] >> 5447 `ls <> []` by metis_tac[MEM] >> 5448 `MIN_LIST ls <= y` by rw[MIN_LIST_PROPERTY] >> 5449 rw[]); 5450 5451(* Theorem: MONO2 f ==> 5452 !lx ly e. MEM e (MAP2 f lx ly) ==> f (MIN_LIST lx) (MIN_LIST ly) <= e *) 5453(* Proof: 5454 Note ?ex ey. (e = f ex ey) /\ 5455 MEM ex lx /\ MEM ey ly by MEM_MAP2 5456 and lx <> [] /\ ly <> [] by MEM 5457 and MIN_LIST lx <= ex by MIN_LIST_PROPERTY 5458 and MIN_LIST ly <= ey by MIN_LIST_PROPERTY 5459 The result follows by the non-decreasing condition on f. 5460*) 5461val MEM_MAP2_LOWER = store_thm( 5462 "MEM_MAP2_LOWER", 5463 ``!f. MONO2 f ==> 5464 !lx ly e. MEM e (MAP2 f lx ly) ==> f (MIN_LIST lx) (MIN_LIST ly) <= e``, 5465 metis_tac[MEM_MAP2, MEM, MIN_LIST_PROPERTY]); 5466 5467(* Theorem: MONO3 f ==> 5468 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> f (MIN_LIST lx) (MIN_LIST ly) (MIN_LIST lz) <= e *) 5469(* Proof: 5470 Note ?ex ey ez. (e = f ex ey ez) /\ 5471 MEM ex lx /\ MEM ey ly /\ MEM ez lz by MEM_MAP3 5472 and lx <> [] /\ ly <> [] /\ lz <> [] by MEM 5473 and MIN_LIST lx <= ex by MIN_LIST_PROPERTY 5474 and MIN_LIST ly <= ey by MIN_LIST_PROPERTY 5475 and MIN_LIST lz <= ez by MIN_LIST_PROPERTY 5476 The result follows by the non-decreasing condition on f. 5477*) 5478val MEM_MAP3_LOWER = store_thm( 5479 "MEM_MAP3_LOWER", 5480 ``!f. MONO3 f ==> 5481 !lx ly lz e. MEM e (MAP3 f lx ly lz) ==> f (MIN_LIST lx) (MIN_LIST ly) (MIN_LIST lz) <= e``, 5482 rpt strip_tac >> 5483 `?ex ey ez. (e = f ex ey ez) /\ MEM ex lx /\ MEM ey ly /\ MEM ez lz` by rw[MEM_MAP3] >> 5484 `lx <> [] /\ ly <> [] /\ lz <> []` by metis_tac[MEM] >> 5485 rw[MIN_LIST_PROPERTY]); 5486 5487(* Theorem: (!x. f x <= g x) ==> !ls. MAX_LIST (MAP f ls) <= MAX_LIST (MAP g ls) *) 5488(* Proof: 5489 By induction on ls. 5490 Base: MAX_LIST (MAP f []) <= MAX_LIST (MAP g []) 5491 LHS = MAX_LIST (MAP f []) = MAX_LIST [] by MAP 5492 RHS = MAX_LIST (MAP g []) = MAX_LIST [] by MAP 5493 Hence true. 5494 Step: MAX_LIST (MAP f ls) <= MAX_LIST (MAP g ls) ==> 5495 !h. MAX_LIST (MAP f (h::ls)) <= MAX_LIST (MAP g (h::ls)) 5496 MAX_LIST (MAP f (h::ls)) 5497 = MAX_LIST (f h::MAP f ls) by MAP 5498 = MAX (f h) (MAX_LIST (MAP f ls)) by MAX_LIST_def 5499 <= MAX (f h) (MAX_LIST (MAP g ls)) by induction hypothesis 5500 <= MAX (g h) (MAX_LIST (MAP g ls)) by properties of f, g 5501 = MAX_LIST (g h::MAP g ls) by MAX_LIST_def 5502 = MAX_LIST (MAP g (h::ls)) by MAP 5503*) 5504val MAX_LIST_MAP_LE = store_thm( 5505 "MAX_LIST_MAP_LE", 5506 ``!f g. (!x. f x <= g x) ==> !ls. MAX_LIST (MAP f ls) <= MAX_LIST (MAP g ls)``, 5507 rpt strip_tac >> 5508 Induct_on `ls` >- 5509 rw[] >> 5510 rw[]); 5511 5512(* Theorem: (!x. f x <= g x) ==> !ls. MIN_LIST (MAP f ls) <= MIN_LIST (MAP g ls) *) 5513(* Proof: 5514 By induction on ls. 5515 Base: MIN_LIST (MAP f []) <= MIN_LIST (MAP g []) 5516 LHS = MIN_LIST (MAP f []) = MIN_LIST [] by MAP 5517 RHS = MIN_LIST (MAP g []) = MIN_LIST [] by MAP 5518 Hence true. 5519 Step: MIN_LIST (MAP f ls) <= MIN_LIST (MAP g ls) ==> 5520 !h. MIN_LIST (MAP f (h::ls)) <= MIN_LIST (MAP g (h::ls)) 5521 If ls = [], 5522 MIN_LIST (MAP f [h]) 5523 = MIN_LIST [f h] by MAP 5524 = f h by MIN_LIST_def 5525 <= g h by properties of f, g 5526 = MIN_LIST [g h] by MIN_LIST_def 5527 = MIN_LIST (MAP g [h]) by MAP 5528 Otherwise ls <> [], 5529 MIN_LIST (MAP f (h::ls)) 5530 = MIN_LIST (f h::MAP f ls) by MAP 5531 = MIN (f h) (MIN_LIST (MAP f ls)) by MIN_LIST_def 5532 <= MIN (g h) (MIN_LIST (MAP g ls)) by MIN_LE_PAIR, induction hypothesis 5533 = MIN_LIST (g h::MAP g ls) by MIN_LIST_def 5534 = MIN_LIST (MAP g (h::ls)) by MAP 5535*) 5536val MIN_LIST_MAP_LE = store_thm( 5537 "MIN_LIST_MAP_LE", 5538 ``!f g. (!x. f x <= g x) ==> !ls. MIN_LIST (MAP f ls) <= MIN_LIST (MAP g ls)``, 5539 rpt strip_tac >> 5540 Induct_on `ls` >- 5541 rw[] >> 5542 rpt strip_tac >> 5543 Cases_on `ls = []` >- 5544 rw[MIN_LIST_def] >> 5545 rw[MIN_LIST_def, MIN_LE_PAIR]); 5546 5547(* Theorem: (!x. f x <= g x) ==> !ls n. EL n (MAP f ls) <= EL n (MAP g ls) *) 5548(* Proof: 5549 By induction on ls. 5550 Base: !n. EL n (MAP f []) <= EL n (MAP g []) 5551 LHS = EL n [] = RHS by MAP 5552 Step: !n. EL n (MAP f ls) <= EL n (MAP g ls) ==> 5553 !h n. EL n (MAP f (h::ls)) <= EL n (MAP g (h::ls)) 5554 If n = 0, 5555 EL 0 (MAP f (h::ls)) 5556 = EL 0 (f h::MAP f ls) by MAP 5557 = f h by EL 5558 <= g h by given 5559 = EL 0 (g h::MAP g ls) by EL 5560 = EL 0 (MAP g (h::ls)) by MAP 5561 If n <> 0, then n = SUC k by num_CASES 5562 EL n (MAP f (h::ls)) 5563 = EL (SUC k) (f h::MAP f ls) by MAP 5564 = EL k (MAP f ls) by EL 5565 <= EL k (MAP g ls) by induction hypothesis 5566 = EL (SUC k) (g h::MAP g ls) by EL 5567 = EL n (MAP g (h::ls)) by MAP 5568*) 5569val MAP_LE = store_thm( 5570 "MAP_LE", 5571 ``!(f:num -> num) g. (!x. f x <= g x) ==> !ls n. EL n (MAP f ls) <= EL n (MAP g ls)``, 5572 ntac 3 strip_tac >> 5573 Induct_on `ls` >- 5574 rw[] >> 5575 Cases_on `n` >- 5576 rw[] >> 5577 rw[]); 5578 5579(* Theorem: (!x y. f x y <= g x y) ==> !lx ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly) *) 5580(* Proof: 5581 By induction on lx. 5582 Base: !ly n. EL n (MAP2 f [] ly) <= EL n (MAP2 g [] ly) 5583 LHS = EL n [] = RHS by MAP2_DEF 5584 Step: !ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly) ==> 5585 !h ly n. EL n (MAP2 f (h::lx) ly) <= EL n (MAP2 g (h::lx) ly) 5586 If ly = [], 5587 to show: EL n (MAP2 f (h::lx) []) <= EL n (MAP2 g (h::lx) []) 5588 True since LHS = EL n [] = RHS by MAP2_DEF 5589 Otherwise, ly = h'::t. 5590 to show: EL n (MAP2 f (h::lx) (h'::t)) <= EL n (MAP2 g (h::lx) (h'::t)) 5591 If n = 0, 5592 EL 0 (MAP2 f (h::lx) (h'::t)) 5593 = EL 0 (f h h'::MAP2 f lx t) by MAP2 5594 = f h h' by EL 5595 <= g h h' by given 5596 = EL 0 (g h h'::MAP2 g lx t) by EL 5597 = EL 0 (MAP2 g (h::lx) (h'::t)) by MAP2 5598 If n <> 0, then n = SUC k by num_CASES 5599 EL n (MAP2 f (h::lx) (h'::t)) 5600 = EL (SUC k) (f h h'::MAP2 f lx t) by MAP2 5601 = EL k (MAP2 f lx t) by EL 5602 <= EL k (MAP2 g lx t) by induction hypothesis 5603 = EL (SUC k) (g h h'::MAP2 g lx t) by EL 5604 = EL n (MAP2 g (h::lx) (h'::t)) by MAP2 5605*) 5606val MAP2_LE = store_thm( 5607 "MAP2_LE", 5608 ``!(f:num -> num -> num) g. (!x y. f x y <= g x y) ==> 5609 !lx ly n. EL n (MAP2 f lx ly) <= EL n (MAP2 g lx ly)``, 5610 ntac 3 strip_tac >> 5611 Induct_on `lx` >- 5612 rw[] >> 5613 rpt strip_tac >> 5614 Cases_on `ly` >- 5615 rw[] >> 5616 Cases_on `n` >- 5617 rw[] >> 5618 rw[]); 5619 5620(* Theorem: (!x y z. f x y z <= g x y z) ==> 5621 !lx ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz) *) 5622(* Proof: 5623 By induction on lx. 5624 Base: !ly lz n. EL n (MAP3 f [] ly lz) <= EL n (MAP3 g [] ly lz) 5625 LHS = EL n [] = RHS by MAP3_DEF 5626 Step: !ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz) ==> 5627 !h ly lz n. EL n (MAP3 f (h::lx) ly lz) <= EL n (MAP3 g (h::lx) ly lz) 5628 If ly = [], 5629 to show: EL n (MAP3 f (h::lx) [] lz) <= EL n (MAP3 g (h::lx) [] lz) 5630 True since LHS = EL n [] = RHS by MAP3_DEF 5631 Otherwise, ly = h'::t. 5632 to show: EL n (MAP3 f (h::lx) (h'::t) lz) <= EL n (MAP3 g (h::lx) (h'::t) lz) 5633 If lz = [], 5634 to show: EL n (MAP3 f (h::lx) (h'::t) []) <= EL n (MAP3 g (h::lx) (h'::t) []) 5635 True since LHS = EL n [] = RHS by MAP3_DEF 5636 Otherwise, lz = h''::t'. 5637 to show: EL n (MAP3 f (h::lx) (h'::t) (h''::t')) <= EL n (MAP3 g (h::lx) (h'::t) (h''::t')) 5638 If n = 0, 5639 EL 0 (MAP3 f (h::lx) (h'::t) (h''::t')) 5640 = EL 0 (f h h' h''::MAP3 f lx t t') by MAP3 5641 = f h h' h'' by EL 5642 <= g h h' h'' by given 5643 = EL 0 (g h h' h''::MAP3 g lx t t') by EL 5644 = EL 0 (MAP3 g (h::lx) (h'::t) (h''::t')) by MAP3 5645 If n <> 0, then n = SUC k by num_CASES 5646 EL n (MAP3 f (h::lx) (h'::t) (h''::t')) 5647 = EL (SUC k) (f h h' h''::MAP3 f lx t t') by MAP3 5648 = EL k (MAP3 f lx t t') by EL 5649 <= EL k (MAP3 g lx t t') by induction hypothesis 5650 = EL (SUC k) (g h h' h''::MAP3 g lx t t') by EL 5651 = EL n (MAP3 g (h::lx) (h'::t) (h''::t')) by MAP3 5652*) 5653val MAP3_LE = store_thm( 5654 "MAP3_LE", 5655 ``!(f:num -> num -> num -> num) g. (!x y z. f x y z <= g x y z) ==> 5656 !lx ly lz n. EL n (MAP3 f lx ly lz) <= EL n (MAP3 g lx ly lz)``, 5657 ntac 3 strip_tac >> 5658 Induct_on `lx` >- 5659 rw[] >> 5660 rpt strip_tac >> 5661 Cases_on `ly` >- 5662 rw[] >> 5663 Cases_on `lz` >- 5664 rw[] >> 5665 Cases_on `n` >- 5666 rw[] >> 5667 rw[]); 5668 5669(* 5670SUM_MAP_PLUS |- !f g ls. SUM (MAP (\x. f x + g x) ls) = SUM (MAP f ls) + SUM (MAP g ls) 5671SUM_MAP_PLUS_ZIP |- !ls1 ls2. LENGTH ls1 = LENGTH ls2 /\ (!x y. f (x,y) = g x + h y) ==> 5672 SUM (MAP f (ZIP (ls1,ls2))) = SUM (MAP g ls1) + SUM (MAP h ls2) 5673*) 5674 5675(* Theorem: (!x. f1 x <= f2 x) ==> !ls. SUM (MAP f1 ls) <= SUM (MAP f2 ls) *) 5676(* Proof: 5677 By SUM_LE, this is to show: 5678 (1) !k. k < LENGTH (MAP f1 ls) ==> EL k (MAP f1 ls) <= EL k (MAP f2 ls) 5679 This is true by EL_MAP 5680 (2) LENGTH (MAP f1 ls) = LENGTH (MAP f2 ls) 5681 This is true by LENGTH_MAP 5682*) 5683val SUM_MONO_MAP = store_thm( 5684 "SUM_MONO_MAP", 5685 ``!f1 f2. (!x. f1 x <= f2 x) ==> !ls. SUM (MAP f1 ls) <= SUM (MAP f2 ls)``, 5686 rpt strip_tac >> 5687 irule SUM_LE >> 5688 rw[EL_MAP]); 5689 5690(* Theorem: (!x y. f1 x y <= f2 x y) ==> !lx ly. SUM (MAP2 f1 lx ly) <= SUM (MAP2 f2 lx ly) *) 5691(* Proof: 5692 By SUM_LE, this is to show: 5693 (1) !k. k < LENGTH (MAP2 f1 lx ly) ==> EL k (MAP2 f1 lx ly) <= EL k (MAP2 f2 lx ly) 5694 This is true by EL_MAP2, LENGTH_MAP2 5695 (2) LENGTH (MAP2 f1 lx ly) = LENGTH (MAP2 f2 lx ly) 5696 This is true by LENGTH_MAP2 5697*) 5698val SUM_MONO_MAP2 = store_thm( 5699 "SUM_MONO_MAP2", 5700 ``!f1 f2. (!x y. f1 x y <= f2 x y) ==> !lx ly. SUM (MAP2 f1 lx ly) <= SUM (MAP2 f2 lx ly)``, 5701 rpt strip_tac >> 5702 irule SUM_LE >> 5703 rw[EL_MAP2]); 5704 5705(* Theorem: (!x y z. f1 x y z <= f2 x y z) ==> !lx ly lz. SUM (MAP3 f1 lx ly lz) <= SUM (MAP3 f2 lx ly lz) *) 5706(* Proof: 5707 By SUM_LE, this is to show: 5708 (1) !k. k < LENGTH (MAP3 f1 lx ly lz) ==> EL k (MAP3 f1 lx ly lz) <= EL k (MAP3 f2 lx ly lz) 5709 This is true by EL_MAP3, LENGTH_MAP3 5710 (2)LENGTH (MAP3 f1 lx ly lz) = LENGTH (MAP3 f2 lx ly lz) 5711 This is true by LENGTH_MAP3 5712*) 5713val SUM_MONO_MAP3 = store_thm( 5714 "SUM_MONO_MAP3", 5715 ``!f1 f2. (!x y z. f1 x y z <= f2 x y z) ==> 5716 !lx ly lz. SUM (MAP3 f1 lx ly lz) <= SUM (MAP3 f2 lx ly lz)``, 5717 rpt strip_tac >> 5718 irule SUM_LE >> 5719 rw[EL_MAP3, LENGTH_MAP3]); 5720 5721(* Theorem: MONO f ==> !ls. SUM (MAP f ls) <= f (MAX_LIST ls) * LENGTH ls *) 5722(* Proof: 5723 Let c = f (MAX_LIST ls). 5724 5725 Claim: SUM (MAP f ls) <= SUM (MAP (K c) ls) 5726 Proof: By SUM_LE, this is to show: 5727 (1) LENGTH (MAP f ls) = LENGTH (MAP (K c) ls) 5728 This is true by LENGTH_MAP 5729 (2) !k. k < LENGTH (MAP f ls) ==> EL k (MAP f ls) <= EL k (MAP (K c) ls) 5730 Note EL k (MAP f ls) = f (EL k ls) by EL_MAP 5731 and EL k (MAP (K c) ls) 5732 = (K c) (EL k ls) by EL_MAP 5733 = c by K_THM 5734 Now MEM (EL k ls) ls by EL_MEM 5735 so EL k ls <= MAX_LIST ls by MAX_LIST_PROPERTY 5736 Thus f (EL k ls) <= c by property of f 5737 5738 Note SUM (MAP (K c) ls) = c * LENGTH ls by SUM_MAP_K 5739 Thus SUM (MAP f ls) <= c * LENGTH ls by Claim 5740*) 5741val SUM_MAP_UPPER = store_thm( 5742 "SUM_MAP_UPPER", 5743 ``!f. MONO f ==> !ls. SUM (MAP f ls) <= f (MAX_LIST ls) * LENGTH ls``, 5744 rpt strip_tac >> 5745 qabbrev_tac `c = f (MAX_LIST ls)` >> 5746 `SUM (MAP f ls) <= SUM (MAP (K c) ls)` by 5747 ((irule SUM_LE >> rw[]) >> 5748 rw[EL_MAP, EL_MEM, MAX_LIST_PROPERTY, Abbr`c`]) >> 5749 `SUM (MAP (K c) ls) = c * LENGTH ls` by rw[SUM_MAP_K] >> 5750 decide_tac); 5751 5752(* Theorem: MONO2 f ==> 5753 !lx ly. SUM (MAP2 f lx ly) <= (f (MAX_LIST lx) (MAX_LIST ly)) * LENGTH (MAP2 f lx ly) *) 5754(* Proof: 5755 Let c = f (MAX_LIST lx) (MAX_LIST ly). 5756 5757 Claim: SUM (MAP2 f lx ly) <= SUM (MAP2 (\x y. c) lx ly) 5758 Proof: By SUM_LE, this is to show: 5759 (1) LENGTH (MAP2 f lx ly) = LENGTH (MAP2 (\x y. c) lx ly) 5760 This is true by LENGTH_MAP2 5761 (2) !k. k < LENGTH (MAP2 f lx ly) ==> EL k (MAP2 f lx ly) <= EL k (MAP2 (\x y. c) lx ly) 5762 Note EL k (MAP2 f lx ly) 5763 = f (EL k lx) (EL k ly) by EL_MAP2 5764 and EL k (MAP2 (\x y. c) lx ly) 5765 = (\x y. c) (EL k lx) (EL k ly) by EL_MAP2 5766 = c by function application 5767 Note k < LENGTH lx, k < LENGTH ly by LENGTH_MAP2 5768 Now MEM (EL k lx) lx by EL_MEM 5769 and MEM (EL k ly) ly by EL_MEM 5770 so EL k lx <= MAX_LIST lx by MAX_LIST_PROPERTY 5771 and EL k ly <= MAX_LIST ly by MAX_LIST_PROPERTY 5772 Thus f (EL k lx) (EL k ly) <= c by property of f 5773 5774 Note SUM (MAP (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly) by SUM_MAP2_K 5775 and LENGTH (MAP2 (\x y. c) lx ly) = LENGTH (MAP2 f lx ly) by LENGTH_MAP2 5776 Thus SUM (MAP f lx ly) <= c * LENGTH (MAP2 f lx ly) by Claim 5777*) 5778val SUM_MAP2_UPPER = store_thm( 5779 "SUM_MAP2_UPPER", 5780 ``!f. MONO2 f ==> 5781 !lx ly. SUM (MAP2 f lx ly) <= (f (MAX_LIST lx) (MAX_LIST ly)) * LENGTH (MAP2 f lx ly)``, 5782 rpt strip_tac >> 5783 qabbrev_tac `c = f (MAX_LIST lx) (MAX_LIST ly)` >> 5784 `SUM (MAP2 f lx ly) <= SUM (MAP2 (\x y. c) lx ly)` by 5785 ((irule SUM_LE >> rw[]) >> 5786 rw[EL_MAP2, EL_MEM, MAX_LIST_PROPERTY, Abbr`c`]) >> 5787 `SUM (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 (\x y. c) lx ly)` by rw[SUM_MAP2_K, Abbr`c`] >> 5788 `c * LENGTH (MAP2 (\x y. c) lx ly) = c * LENGTH (MAP2 f lx ly)` by rw[] >> 5789 decide_tac); 5790 5791(* Theorem: MONO3 f ==> 5792 !lx ly lz. SUM (MAP3 f lx ly lz) <= 5793 f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) * LENGTH (MAP3 f lx ly lz) *) 5794(* Proof: 5795 Let c = f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz). 5796 5797 Claim: SUM (MAP3 f lx ly lz) <= SUM (MAP3 (\x y z. c) lx ly lz) 5798 Proof: By SUM_LE, this is to show: 5799 (1) LENGTH (MAP3 f lx ly lz) = LENGTH (MAP3 (\x y z. c) lx ly lz) 5800 This is true by LENGTH_MAP3 5801 (2) !k. k < LENGTH (MAP3 f lx ly lz) ==> EL k (MAP3 f lx ly lz) <= EL k (MAP3 (\x y z. c) lx ly lz) 5802 Note EL k (MAP3 f lx ly lz) 5803 = f (EL k lx) (EL k ly) (EL k lz) by EL_MAP3 5804 and EL k (MAP3 (\x y z. c) lx ly lz) 5805 = (\x y z. c) (EL k lx) (EL k ly) (EL k lz) by EL_MAP3 5806 = c by function application 5807 Note k < LENGTH lx, k < LENGTH ly, k < LENGTH lz 5808 by LENGTH_MAP3 5809 Now MEM (EL k lx) lx by EL_MEM 5810 and MEM (EL k ly) ly by EL_MEM 5811 and MEM (EL k lz) lz by EL_MEM 5812 so EL k lx <= MAX_LIST lx by MAX_LIST_PROPERTY 5813 and EL k ly <= MAX_LIST ly by MAX_LIST_PROPERTY 5814 and EL k lz <= MAX_LIST lz by MAX_LIST_PROPERTY 5815 Thus f (EL k lx) (EL k ly) (EL k lz) <= c by property of f 5816 5817 Note SUM (MAP (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz) by SUM_MAP3_K 5818 and LENGTH (MAP3 (\x y z. c) lx ly lz) = LENGTH (MAP3 f lx ly lz) by LENGTH_MAP3 5819 Thus SUM (MAP f lx ly lz) <= c * LENGTH (MAP3 f lx ly lz) by Claim 5820*) 5821val SUM_MAP3_UPPER = store_thm( 5822 "SUM_MAP3_UPPER", 5823 ``!f. MONO3 f ==> 5824 !lx ly lz. SUM (MAP3 f lx ly lz) <= f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz) * LENGTH (MAP3 f lx ly lz)``, 5825 rpt strip_tac >> 5826 qabbrev_tac `c = f (MAX_LIST lx) (MAX_LIST ly) (MAX_LIST lz)` >> 5827 `SUM (MAP3 f lx ly lz) <= SUM (MAP3 (\x y z. c) lx ly lz)` by 5828 (`LENGTH (MAP3 f lx ly lz) = LENGTH (MAP3 (\x y z. c) lx ly lz)` by rw[LENGTH_MAP3] >> 5829 (irule SUM_LE >> rw[]) >> 5830 fs[LENGTH_MAP3] >> 5831 rw[EL_MAP3, EL_MEM, MAX_LIST_PROPERTY, Abbr`c`]) >> 5832 `SUM (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 (\x y z. c) lx ly lz)` by rw[SUM_MAP3_K] >> 5833 `c * LENGTH (MAP3 (\x y z. c) lx ly lz) = c * LENGTH (MAP3 f lx ly lz)` by rw[LENGTH_MAP3] >> 5834 decide_tac); 5835 5836(* ------------------------------------------------------------------------- *) 5837(* Increasing and decreasing list bounds *) 5838(* ------------------------------------------------------------------------- *) 5839 5840(* Overload increasing list and decreasing list *) 5841val _ = overload_on("MONO_INC", 5842 ``\ls:num list. !m n. m <= n /\ n < LENGTH ls ==> EL m ls <= EL n ls``); 5843val _ = overload_on("MONO_DEC", 5844 ``\ls:num list. !m n. m <= n /\ n < LENGTH ls ==> EL n ls <= EL m ls``); 5845 5846(* Theorem: MONO f ==> MONO_INC (GENLIST f n) *) 5847(* Proof: 5848 Let ls = GENLIST f n. 5849 Then LENGTH ls = n by LENGTH_GENLIST 5850 and !k. k < n ==> EL k ls = f k by EL_GENLIST 5851 Thus MONO_INC ls 5852*) 5853val GENLIST_MONO_INC = store_thm( 5854 "GENLIST_MONO_INC", 5855 ``!f:num -> num n. MONO f ==> MONO_INC (GENLIST f n)``, 5856 rw[]); 5857 5858(* Theorem: RMONO f ==> MONO_DEC (GENLIST f n) *) 5859(* Proof: 5860 Let ls = GENLIST f n. 5861 Then LENGTH ls = n by LENGTH_GENLIST 5862 and !k. k < n ==> EL k ls = f k by EL_GENLIST 5863 Thus MONO_DEC ls 5864*) 5865val GENLIST_MONO_DEC = store_thm( 5866 "GENLIST_MONO_DEC", 5867 ``!f:num -> num n. RMONO f ==> MONO_DEC (GENLIST f n)``, 5868 rw[]); 5869 5870(* Theorem: ls <> [] /\ (!m n. m <= n ==> EL m ls <= EL n ls) ==> (MAX_LIST ls = LAST ls) *) 5871(* Proof: 5872 By induction on ls. 5873 Base: [] <> [] /\ MONO_INC [] ==> MAX_LIST [] = LAST [] 5874 Note [] <> [] = F, hence true. 5875 Step: ls <> [] /\ MONO_INC ls ==> MAX_LIST ls = LAST ls ==> 5876 !h. h::ls <> [] /\ MONO_INC (h::ls) ==> MAX_LIST (h::ls) = LAST (h::ls) 5877 If ls = [], 5878 LHS = MAX_LIST [h] = h by MAX_LIST_def 5879 RHS = LAST [h] = h = LHS by LAST_DEF 5880 If ls <> [], 5881 Note h <= LAST ls by LAST_EL_CONS, increasing property 5882 and MONO_INC ls by EL, m <= n ==> SUC m <= SUC n 5883 MAX_LIST (h::ls) 5884 = MAX h (MAX_LIST ls) by MAX_LIST_def 5885 = MAX h (LAST ls) by induction hypothesis 5886 = LAST ls by MAX_DEF, h <= LAST ls 5887 = LAST (h::ls) by LAST_DEF 5888*) 5889val MAX_LIST_MONO_INC = store_thm( 5890 "MAX_LIST_MONO_INC", 5891 ``!ls. ls <> [] /\ MONO_INC ls ==> (MAX_LIST ls = LAST ls)``, 5892 Induct >- 5893 rw[] >> 5894 rpt strip_tac >> 5895 Cases_on `ls = []` >- 5896 rw[] >> 5897 `h <= LAST ls` by 5898 (`LAST ls = EL (LENGTH ls) (h::ls)` by rw[LAST_EL_CONS] >> 5899 `h = EL 0 (h::ls)` by rw[] >> 5900 `LENGTH ls < LENGTH (h::ls)` by rw[] >> 5901 metis_tac[DECIDE``0 <= n``]) >> 5902 `MONO_INC ls` by 5903 (rpt strip_tac >> 5904 `SUC m <= SUC n` by decide_tac >> 5905 `EL (SUC m) (h::ls) <= EL (SUC n) (h::ls)` by rw[] >> 5906 fs[]) >> 5907 rw[MAX_DEF, LAST_DEF]); 5908 5909(* Theorem: ls <> [] /\ MONO_DEC ls ==> (MAX_LIST ls = HD ls) *) 5910(* Proof: 5911 By induction on ls. 5912 Base: [] <> [] /\ MONO_DEC [] ==> MAX_LIST [] = HD [] 5913 Note [] <> [] = F, hence true. 5914 Step: ls <> [] /\ MONO_DEC ls ==> MAX_LIST ls = HD ls ==> 5915 !h. h::ls <> [] /\ MONO_DEC (h::ls) ==> MAX_LIST (h::ls) = HD (h::ls) 5916 If ls = [], 5917 LHS = MAX_LIST [h] = h by MAX_LIST_def 5918 RHS = HD [h] = h = LHS by HD 5919 If ls <> [], 5920 Note HD ls <= h by HD, decreasing property 5921 and MONO_DEC ls by EL, m <= n ==> SUC m <= SUC n 5922 MAX_LIST (h::ls) 5923 = MAX h (MAX_LIST ls) by MAX_LIST_def 5924 = MAX h (HD ls) by induction hypothesis 5925 = h by MAX_DEF, HD ls <= h 5926 = HD (h::ls) by HD 5927*) 5928val MAX_LIST_MONO_DEC = store_thm( 5929 "MAX_LIST_MONO_DEC", 5930 ``!ls. ls <> [] /\ MONO_DEC ls ==> (MAX_LIST ls = HD ls)``, 5931 Induct >- 5932 rw[] >> 5933 rpt strip_tac >> 5934 Cases_on `ls = []` >- 5935 rw[] >> 5936 `HD ls <= h` by 5937 (`HD ls = EL 1 (h::ls)` by rw[] >> 5938 `h = EL 0 (h::ls)` by rw[] >> 5939 `0 < LENGTH ls` by metis_tac[LENGTH_EQ_0, NOT_ZERO_LT_ZERO] >> 5940 `1 < LENGTH (h::ls)` by rw[] >> 5941 metis_tac[DECIDE``0 <= 1``]) >> 5942 `MONO_DEC ls` by 5943 (rpt strip_tac >> 5944 `SUC m <= SUC n` by decide_tac >> 5945 `EL (SUC n) (h::ls) <= EL (SUC m) (h::ls)` by rw[] >> 5946 fs[]) >> 5947 rw[MAX_DEF]); 5948 5949(* Theorem: ls <> [] /\ MONO_INC ls ==> (MIN_LIST ls = HD ls) *) 5950(* Proof: 5951 By induction on ls. 5952 Base: [] <> [] /\ MONO_INC [] ==> MIN_LIST [] = HD [] 5953 Note [] <> [] = F, hence true. 5954 Step: ls <> [] /\ MONO_INC ls ==> MIN_LIST ls = HD ls ==> 5955 !h. h::ls <> [] /\ MONO_INC (h::ls) ==> MIN_LIST (h::ls) = HD (h::ls) 5956 If ls = [], 5957 LHS = MIN_LIST [h] = h by MIN_LIST_def 5958 RHS = HD [h] = h = LHS by HD 5959 If ls <> [], 5960 Note h <= HD ls by HD, increasing property 5961 and MONO_INC ls by EL, m <= n ==> SUC m <= SUC n 5962 MIN_LIST (h::ls) 5963 = MIN h (MIN_LIST ls) by MIN_LIST_def 5964 = MIN h (HD ls) by induction hypothesis 5965 = h by MIN_DEF, h <= HD ls 5966 = HD (h::ls) by HD 5967*) 5968val MIN_LIST_MONO_INC = store_thm( 5969 "MIN_LIST_MONO_INC", 5970 ``!ls. ls <> [] /\ MONO_INC ls ==> (MIN_LIST ls = HD ls)``, 5971 Induct >- 5972 rw[] >> 5973 rpt strip_tac >> 5974 Cases_on `ls = []` >- 5975 rw[] >> 5976 `h <= HD ls` by 5977 (`HD ls = EL 1 (h::ls)` by rw[] >> 5978 `h = EL 0 (h::ls)` by rw[] >> 5979 `0 < LENGTH ls` by metis_tac[LENGTH_EQ_0, NOT_ZERO_LT_ZERO] >> 5980 `1 < LENGTH (h::ls)` by rw[] >> 5981 metis_tac[DECIDE``0 <= 1``]) >> 5982 `MONO_INC ls` by 5983 (rpt strip_tac >> 5984 `SUC m <= SUC n` by decide_tac >> 5985 `EL (SUC m) (h::ls) <= EL (SUC n) (h::ls)` by rw[] >> 5986 fs[]) >> 5987 rw[MIN_DEF]); 5988 5989(* Theorem: ls <> [] /\ MONO_DEC ls ==> (MIN_LIST ls = LAST ls) *) 5990(* Proof: 5991 By induction on ls. 5992 Base: [] <> [] /\ MONO_DEC [] ==> MIN_LIST [] = LAST [] 5993 Note [] <> [] = F, hence true. 5994 Step: ls <> [] /\ MONO_DEC ls ==> MIN_LIST ls = LAST ls ==> 5995 !h. h::ls <> [] /\ MONO_DEC (h::ls) ==> MAX_LIST (h::ls) = LAST (h::ls) 5996 If ls = [], 5997 LHS = MIN_LIST [h] = h by MIN_LIST_def 5998 RHS = LAST [h] = h = LHS by LAST_DEF 5999 If ls <> [], 6000 Note LAST ls <= h by LAST_EL_CONS, decreasing property 6001 and MONO_DEC ls by EL, m <= n ==> SUC m <= SUC n 6002 MIN_LIST (h::ls) 6003 = MIN h (MIN_LIST ls) by MIN_LIST_def 6004 = MIN h (LAST ls) by induction hypothesis 6005 = LAST ls by MIN_DEF, LAST ls <= h 6006 = LAST (h::ls) by LAST_DEF 6007*) 6008val MIN_LIST_MONO_DEC = store_thm( 6009 "MIN_LIST_MONO_DEC", 6010 ``!ls. ls <> [] /\ MONO_DEC ls ==> (MIN_LIST ls = LAST ls)``, 6011 Induct >- 6012 rw[] >> 6013 rpt strip_tac >> 6014 Cases_on `ls = []` >- 6015 rw[] >> 6016 `LAST ls <= h` by 6017 (`LAST ls = EL (LENGTH ls) (h::ls)` by rw[LAST_EL_CONS] >> 6018 `h = EL 0 (h::ls)` by rw[] >> 6019 `LENGTH ls < LENGTH (h::ls)` by rw[] >> 6020 metis_tac[DECIDE``0 <= n``]) >> 6021 `MONO_DEC ls` by 6022 (rpt strip_tac >> 6023 `SUC m <= SUC n` by decide_tac >> 6024 `EL (SUC n) (h::ls) <= EL (SUC m) (h::ls)` by rw[] >> 6025 fs[]) >> 6026 rw[MIN_DEF, LAST_DEF]); 6027 6028(* ------------------------------------------------------------------------- *) 6029(* List Dilation *) 6030(* ------------------------------------------------------------------------- *) 6031 6032(* 6033Use the concept of dilating a list. 6034 6035Let p = [1;2;3], that is, p = 1 + 2x + 3x^2. 6036Then q = peval p (x^3) is just q = 1 + 2(x^3) + 3(x^3)^2 = [1;0;0;2;0;0;3] 6037 6038DILATE 3 [] = [] 6039DILATE 3 (h::t) = [h;0;0] ++ MDILATE 3 t 6040 6041val DILATE_3_DEF = Define` 6042 (DILATE_3 [] = []) /\ 6043 (DILATE_3 (h::t) = [h;0;0] ++ (MDILATE_3 t)) 6044`; 6045> EVAL ``DILATE_3 [1;2;3]``; 6046val it = |- MDILATE_3 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3; 0; 0]: thm 6047 6048val DILATE_3_DEF = Define` 6049 (DILATE_3 [] = []) /\ 6050 (DILATE_3 [h] = [h]) /\ 6051 (DILATE_3 (h::t) = [h;0;0] ++ (MDILATE_3 t)) 6052`; 6053> EVAL ``DILATE_3 [1;2;3]``; 6054val it = |- MDILATE_3 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3]: thm 6055*) 6056 6057(* ------------------------------------------------------------------------- *) 6058(* List Dilation (Multiplicative) *) 6059(* ------------------------------------------------------------------------- *) 6060 6061(* Note: 6062 It would be better to define: MDILATE e n l = inserting n (e)'s, 6063 that is, using GENLIST (K e) n, so that only MDILATE e 0 l = l. 6064 However, the intention is to have later, for polynomials: 6065 peval p (X ** n) = pdilate n p 6066 and since X ** 1 = X, and peval p X = p, 6067 it is desirable to have MDILATE e 1 l = l, with the definition below. 6068 6069 However, the multiplicative feature at the end destroys such an application. 6070*) 6071 6072(* Dilate a list with an element e, for a factor n (n <> 0) *) 6073val MDILATE_def = Define` 6074 (MDILATE e n [] = []) /\ 6075 (MDILATE e n (h::t) = if t = [] then [h] else (h:: GENLIST (K e) (PRE n)) ++ (MDILATE e n t)) 6076`; 6077(* 6078> EVAL ``MDILATE 0 2 [1;2;3]``; 6079val it = |- MDILATE 0 2 [1; 2; 3] = [1; 0; 2; 0; 3]: thm 6080> EVAL ``MDILATE 0 3 [1;2;3]``; 6081val it = |- MDILATE 0 3 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3]: thm 6082> EVAL ``MDILATE #0 3 [a;b;#1]``; 6083val it = |- MDILATE #0 3 [a; b; #1] = [a; #0; #0; b; #0; #0; #1]: thm 6084*) 6085 6086(* Theorem: MDILATE e n [] = [] *) 6087(* Proof: by MDILATE_def *) 6088val MDILATE_NIL = store_thm( 6089 "MDILATE_NIL", 6090 ``!e n. MDILATE e n [] = []``, 6091 rw[MDILATE_def]); 6092 6093(* export simple result *) 6094val _ = export_rewrites["MDILATE_NIL"]; 6095 6096(* Theorem: MDILATE e n [x] = [x] *) 6097(* Proof: by MDILATE_def *) 6098val MDILATE_SING = store_thm( 6099 "MDILATE_SING", 6100 ``!e n x. MDILATE e n [x] = [x]``, 6101 rw[MDILATE_def]); 6102 6103(* export simple result *) 6104val _ = export_rewrites["MDILATE_SING"]; 6105 6106(* Theorem: MDILATE e n (h::t) = 6107 if t = [] then [h] else (h:: GENLIST (K e) (PRE n)) ++ (MDILATE e n t) *) 6108(* Proof: by MDILATE_def *) 6109val MDILATE_CONS = store_thm( 6110 "MDILATE_CONS", 6111 ``!e n h t. MDILATE e n (h::t) = 6112 if t = [] then [h] else (h:: GENLIST (K e) (PRE n)) ++ (MDILATE e n t)``, 6113 rw[MDILATE_def]); 6114 6115(* Theorem: MDILATE e 1 l = l *) 6116(* Proof: 6117 By induction on l. 6118 Base: !e. MDILATE e 1 [] = [], true by MDILATE_NIL 6119 Step: !e. MDILATE e 1 l = l ==> !h e. MDILATE e 1 (h::l) = h::l 6120 If l = [], 6121 MDILATE e 1 [h] 6122 = [h] by MDILATE_SING 6123 If l <> [], 6124 MDILATE e 1 (h::l) 6125 = (h:: GENLIST (K e) (PRE 1)) ++ (MDILATE e n l) by MDILATE_CONS 6126 = (h:: GENLIST (K e) (PRE 1)) ++ l by induction hypothesis 6127 = (h:: GENLIST (K e) 0) ++ l by PRE 6128 = [h] ++ l by GENLIST_0 6129 = h::l by CONS_APPEND 6130*) 6131val MDILATE_1 = store_thm( 6132 "MDILATE_1", 6133 ``!l e. MDILATE e 1 l = l``, 6134 Induct_on `l` >> 6135 rw[MDILATE_def]); 6136 6137(* Theorem: MDILATE e 0 l = l *) 6138(* Proof: 6139 By induction on l, and note GENLIST (K e) (PRE 0) = GENLIST (K e) 0 = []. 6140*) 6141val MDILATE_0 = store_thm( 6142 "MDILATE_0", 6143 ``!l e. MDILATE e 0 l = l``, 6144 Induct_on `l` >> rw[MDILATE_def]); 6145 6146(* Theorem: LENGTH (MDILATE e n l) = 6147 if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l)) *) 6148(* Proof: 6149 If n = 0, 6150 Then MDILATE e 0 l = l by MDILATE_0 6151 Hence true. 6152 If n <> 0, 6153 Then 0 < n by NOT_ZERO_LT_ZERO 6154 By induction on l. 6155 Base: LENGTH (MDILATE e n []) = if n = 0 then LENGTH [] else if [] = [] then 0 else SUC (n * PRE (LENGTH [])) 6156 LENGTH (MDILATE e n []) 6157 = LENGTH [] by MDILATE_NIL 6158 = 0 by LENGTH_NIL 6159 Step: LENGTH (MDILATE e n l) = if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l)) ==> 6160 !h. LENGTH (MDILATE e n (h::l)) = if n = 0 then LENGTH (h::l) else if h::l = [] then 0 else SUC (n * PRE (LENGTH (h::l))) 6161 Note h::l = [] <=> F by NOT_CONS_NIL 6162 If l = [], 6163 LENGTH (MDILATE e n [h]) 6164 = LENGTH [h] by MDILATE_SING 6165 = 1 by LENGTH_EQ_1 6166 = SUC 0 by ONE 6167 = SUC (n * 0) by MULT_0 6168 = SUC (n * (PRE (LENGTH [h]))) by LENGTH_EQ_1, PRE_SUC_EQ 6169 If l <> [], 6170 Then LENGTH l <> 0 by LENGTH_NIL 6171 LENGTH (MDILATE e n (h::l)) 6172 = LENGTH (h:: GENLIST (K e) (PRE n) ++ MDILATE e n l) by MDILATE_CONS 6173 = LENGTH (h:: GENLIST (K e) (PRE n)) + LENGTH (MDILATE e n l) by LENGTH_APPEND 6174 = n + LENGTH (MDILATE e n l) by LENGTH_GENLIST 6175 = n + SUC (n * PRE (LENGTH l)) by induction hypothesis 6176 = SUC (n + n * PRE (LENGTH l)) by ADD_SUC 6177 = SUC (n * SUC (PRE (LENGTH l))) by MULT_SUC 6178 = SUC (n * LENGTH l) by SUC_PRE, 0 < LENGTH l 6179 = SUC (n * PRE (LENGTH (h::l))) by LENGTH, PRE_SUC_EQ 6180*) 6181val MDILATE_LENGTH = store_thm( 6182 "MDILATE_LENGTH", 6183 ``!l e n. LENGTH (MDILATE e n l) = 6184 if n = 0 then LENGTH l else if l = [] then 0 else SUC (n * PRE (LENGTH l))``, 6185 rpt strip_tac >> 6186 Cases_on `n = 0` >- 6187 rw[MDILATE_0] >> 6188 `0 < n` by decide_tac >> 6189 Induct_on `l` >- 6190 rw[] >> 6191 rw[MDILATE_def] >> 6192 `LENGTH l <> 0` by metis_tac[LENGTH_NIL] >> 6193 `0 < LENGTH l` by decide_tac >> 6194 `PRE n + SUC (n * PRE (LENGTH l)) = SUC (PRE n) + n * PRE (LENGTH l)` by rw[] >> 6195 `_ = n + n * PRE (LENGTH l)` by decide_tac >> 6196 `_ = n * SUC (PRE (LENGTH l))` by rw[MULT_SUC] >> 6197 `_ = n * LENGTH l` by metis_tac[SUC_PRE] >> 6198 decide_tac); 6199 6200(* Theorem: LENGTH l <= LENGTH (MDILATE e n l) *) 6201(* Proof: 6202 If n = 0, 6203 LENGTH (MDILATE e 0 l) 6204 = LENGTH l by MDILATE_LENGTH 6205 >= LENGTH l 6206 If l = [], 6207 LENGTH (MDILATE e n []) 6208 = LENGTH [] by MDILATE_NIL 6209 >= LENGTH [] 6210 If l <> [], 6211 Then ?h t. l = h::t by list_CASES 6212 LENGTH (MDILATE e n (h::t)) 6213 = SUC (n * PRE (LENGTH (h::t))) by MDILATE_LENGTH 6214 = SUC (n * PRE (SUC (LENGTH t))) by LENGTH 6215 = SUC (n * LENGTH t) by PRE 6216 = n * LENGTH t + 1 by ADD1 6217 >= LENGTH t + 1 by LE_MULT_CANCEL_LBARE, 0 < n 6218 = SUC (LENGTH t) by ADD1 6219 = LENGTH (h::t) by LENGTH 6220*) 6221val MDILATE_LENGTH_LOWER = store_thm( 6222 "MDILATE_LENGTH_LOWER", 6223 ``!l e n. LENGTH l <= LENGTH (MDILATE e n l)``, 6224 rw[MDILATE_LENGTH] >> 6225 `?h t. l = h::t` by metis_tac[list_CASES] >> 6226 rw[]); 6227 6228(* Theorem: 0 < n ==> LENGTH (MDILATE e n l) <= SUC (n * PRE (LENGTH l)) *) 6229(* Proof: 6230 Since n <> 0, 6231 If l = [], 6232 LENGTH (MDILATE e n []) 6233 = LENGTH [] by MDILATE_NIL 6234 = 0 by LENGTH_NIL 6235 SUC (n * PRE (LENGTH [])) 6236 = SUC (n * PRE 0) by LENGTH_NIL 6237 = SUC 0 by PRE, MULT_0 6238 > 0 by LESS_SUC 6239 If l <> [], 6240 LENGTH (MDILATE e n l) 6241 = SUC (n * PRE (LENGTH l)) by MDILATE_LENGTH, n <> 0 6242*) 6243val MDILATE_LENGTH_UPPER = store_thm( 6244 "MDILATE_LENGTH_UPPER", 6245 ``!l e n. 0 < n ==> LENGTH (MDILATE e n l) <= SUC (n * PRE (LENGTH l))``, 6246 rw[MDILATE_LENGTH]); 6247 6248(* Theorem: k < LENGTH (MDILATE e n l) ==> 6249 (EL k (MDILATE e n l) = if n = 0 then EL k l else if k MOD n = 0 then EL (k DIV n) l else e) *) 6250(* Proof: 6251 If n = 0, 6252 Then MDILATE e 0 l = l by MDILATE_0 6253 Hence true trivially. 6254 If n <> 0, 6255 Then 0 < n by NOT_ZERO_LT_ZERO 6256 By induction on l. 6257 Base: !k. k < LENGTH (MDILATE e n []) ==> 6258 (EL k (MDILATE e n []) = if n = 0 then EL k [] else if k MOD n = 0 then EL (k DIV n) [] else e) 6259 Note LENGTH (MDILATE e n []) 6260 = LENGTH [] by MDILATE_NIL 6261 = 0 by LENGTH_NIL 6262 Thus k < 0 <=> F by NOT_ZERO_LT_ZERO 6263 Step: !k. k < LENGTH (MDILATE e n l) ==> (EL k (MDILATE e n l) = if n = 0 then EL k l else if k MOD n = 0 then EL (k DIV n) l else e) ==> 6264 !h k. k < LENGTH (MDILATE e n (h::l)) ==> (EL k (MDILATE e n (h::l)) = if n = 0 then EL k (h::l) else if k MOD n = 0 then EL (k DIV n) (h::l) else e) 6265 Note LENGTH (MDILATE e n [h]) = 1 by MDILATE_SING 6266 and LENGTH (MDILATE e n (h::l)) 6267 = SUC (n * PRE (LENGTH (h::l))) by MDILATE_LENGTH, n <> 0 6268 = SUC (n * PRE (SUC (LENGTH l))) by LENGTH 6269 = SUC (n * LENGTH l) by PRE 6270 6271 If l = [], 6272 Then MDILATE e n [h] = [h] by MDILATE_SING 6273 and LENGTH (MDILATE e n [h]) = 1 by LENGTH 6274 so k < 1 means k = 0. 6275 and 0 DIV n = 0 by ZERO_DIV, 0 < n 6276 and 0 MOD n = 0 by ZERO_MOD, 0 < n 6277 Thus EL k [h] = EL (k DIV n) [h]. 6278 6279 If l <> [], 6280 Let t = h::GENLIST (K e) (PRE n) 6281 Note LENGTH t = n by LENGTH_GENLIST 6282 If k < n, 6283 Then k MOD n = k by LESS_MOD, k < n 6284 EL k (MDILATE e n (h::l)) 6285 = EL k (t ++ MDILATE e n l) by MDILATE_CONS 6286 = EL k t by EL_APPEND, k < LENGTH t 6287 If k = 0, 6288 EL 0 t 6289 = EL 0 (h:: GENLIST (K e) (PRE n)) by notation of t 6290 = h 6291 = EL (0 DIV n) (h::l) by EL, HD 6292 If k <> 0, 6293 EL k t 6294 = EL k (h:: GENLIST (K e) (PRE n)) by notation of t 6295 = EL (PRE k) (GENLIST (K e) (PRE n)) by EL_CONS 6296 = (K e) (PRE k) by EL_GENLIST, PRE k < PRE n 6297 = e by application of K 6298 If ~(k < n), n <= k. 6299 Given k < LENGTH (MDILATE e n (h::l)) 6300 or k < SUC (n * LENGTH l) by above 6301 ==> k - n < SUC (n * LENGTH l) - n by n <= k 6302 = SUC (n * LENGTH l - n) by SUB 6303 = SUC (n * (LENGTH l - 1)) by LEFT_SUB_DISTRIB 6304 = SUC (n * PRE (LENGTH l)) by PRE_SUB1 6305 or k - n < LENGTH (MDILATE e n l) by MDILATE_LENGTH 6306 Thus (k - n) MOD n = k MOD n by SUB_MOD 6307 and (k - n) DIV n = k DIV n - 1 by SUB_DIV 6308 If k MOD n = 0, 6309 Note 0 < k DIV n by DIVIDES_MOD_0, DIV_POS 6310 EL k (t ++ MDILATE e n l) 6311 = EL (k - n) (MDILATE e n l) by EL_APPEND, n <= k 6312 = EL (k DIV n - 1) l by induction hypothesis, (k - n) MOD n = 0 6313 = EL (PRE (k DIV n)) l by PRE_SUB1 6314 = EL (k DIV n) (h::l) by EL_CONS, 0 < k DIV n 6315 If k MOD n <> 0, 6316 EL k (t ++ MDILATE e n l) 6317 = EL (k - n) (MDILATE e n l) by EL_APPEND, n <= k 6318 = e by induction hypothesis, (k - n) MOD n <> 0 6319*) 6320val MDILATE_EL = store_thm( 6321 "MDILATE_EL", 6322 ``!l e n k. k < LENGTH (MDILATE e n l) ==> 6323 (EL k (MDILATE e n l) = if n = 0 then EL k l else if k MOD n = 0 then EL (k DIV n) l else e)``, 6324 ntac 3 strip_tac >> 6325 Cases_on `n = 0` >- 6326 rw[MDILATE_0] >> 6327 `0 < n` by decide_tac >> 6328 Induct_on `l` >- 6329 rw[] >> 6330 rpt strip_tac >> 6331 `LENGTH (MDILATE e n [h]) = 1` by rw[MDILATE_SING] >> 6332 `LENGTH (MDILATE e n (h::l)) = SUC (n * LENGTH l)` by rw[MDILATE_LENGTH] >> 6333 qabbrev_tac `t = h:: GENLIST (K e) (PRE n)` >> 6334 `!k. k < 1 <=> (k = 0)` by decide_tac >> 6335 rw_tac std_ss[MDILATE_def] >- 6336 metis_tac[ZERO_DIV] >- 6337 metis_tac[ZERO_MOD] >- 6338 (rw_tac std_ss[EL_APPEND] >| [ 6339 `LENGTH t = n` by rw[Abbr`t`] >> 6340 `k MOD n = k` by rw[LESS_MOD] >> 6341 `!x. EL 0 (h::x) = h` by rw[] >> 6342 metis_tac[ZERO_DIV], 6343 `LENGTH t = n` by rw[Abbr`t`] >> 6344 `k - n < LENGTH (MDILATE e n l)` by rw[MDILATE_LENGTH] >> 6345 `(k - n) MOD n = k MOD n` by rw[SUB_MOD] >> 6346 `(k - n) DIV n = k DIV n - 1` by rw[GSYM SUB_DIV] >> 6347 `0 < k DIV n` by rw[DIVIDES_MOD_0, DIV_POS] >> 6348 `EL (k - n) (MDILATE e n l) = EL (k DIV n - 1) l` by rw[] >> 6349 `_ = EL (PRE (k DIV n)) l` by rw[PRE_SUB1] >> 6350 `_ = EL (k DIV n) (h::l)` by rw[EL_CONS] >> 6351 rw[] 6352 ]) >> 6353 rw_tac std_ss[EL_APPEND] >| [ 6354 `LENGTH t = n` by rw[Abbr`t`] >> 6355 `k MOD n = k` by rw[LESS_MOD] >> 6356 `0 < k /\ PRE k < PRE n` by decide_tac >> 6357 `EL k t = EL (PRE k) (GENLIST (K e) (PRE n))` by rw[EL_CONS, Abbr`t`] >> 6358 `_ = e` by rw[] >> 6359 rw[], 6360 `LENGTH t = n` by rw[Abbr`t`] >> 6361 `k - n < LENGTH (MDILATE e n l)` by rw[MDILATE_LENGTH] >> 6362 `n <= k` by decide_tac >> 6363 `(k - n) MOD n = k MOD n` by rw[SUB_MOD] >> 6364 `EL (k - n) (MDILATE e n l) = e` by rw[] >> 6365 rw[] 6366 ]); 6367 6368(* This is a milestone theorem. *) 6369 6370(* Theorem: (MDILATE e n l = []) <=> (l = []) *) 6371(* Proof: 6372 If part: MDILATE e n l = [] ==> l = [] 6373 By contradiction, suppose l <> []. 6374 If n = 0, 6375 Then MDILATE e 0 l = l by MDILATE_0 6376 This contradicts MDILATE e 0 l = []. 6377 If n <> 0, 6378 Then LENGTH (MDILATE e n l) 6379 = SUC (n * PRE (LENGTH l)) by MDILATE_LENGTH 6380 <> 0 by SUC_NOT 6381 So (MDILATE e n l) <> [] by LENGTH_NIL 6382 This contradicts MDILATE e n l = [] 6383 Only-if part: l = [] ==> MDILATE e n l = [] 6384 True by MDILATE_NIL 6385*) 6386val MDILATE_EQ_NIL = store_thm( 6387 "MDILATE_EQ_NIL", 6388 ``!l e n. (MDILATE e n l = []) <=> (l = [])``, 6389 rw[EQ_IMP_THM] >> 6390 spose_not_then strip_assume_tac >> 6391 Cases_on `n = 0` >| [ 6392 `MDILATE e 0 l = l` by rw[GSYM MDILATE_0] >> 6393 metis_tac[], 6394 `LENGTH (MDILATE e n l) = SUC (n * PRE (LENGTH l))` by rw[MDILATE_LENGTH] >> 6395 `LENGTH (MDILATE e n l) <> 0` by decide_tac >> 6396 metis_tac[LENGTH_EQ_0] 6397 ]); 6398 6399(* Theorem: LAST (MDILATE e n l) = LAST l *) 6400(* Proof: 6401 If l = [], 6402 LAST (MDILATE e n []) 6403 = LAST [] by MDILATE_NIL 6404 If l <> [], 6405 If n = 0, 6406 LAST (MDILATE e 0 l) 6407 = LAST l by MDILATE_0 6408 If n <> 0, then 0 < m by LESS_0 6409 Then MDILATE e n l <> [] by MDILATE_EQ_NIL 6410 or LENGTH (MDILATE e n l) <> 0 by LENGTH_NIL 6411 Note PRE (LENGTH (MDILATE e n l)) 6412 = PRE (SUC (n * PRE (LENGTH l))) by MDILATE_LENGTH 6413 = n * PRE (LENGTH l) by PRE 6414 Let k = PRE (LENGTH (MDILATE e n l)). 6415 Then k < LENGTH (MDILATE e n l) by PRE x < x 6416 and k MOD n = 0 by MOD_EQ_0, MULT_COMM, 0 < n 6417 and k DIV n = PRE (LENGTH l) by MULT_DIV, MULT_COMM 6418 6419 LAST (MDILATE e n l) 6420 = EL k (MDILATE e n l) by LAST_EL 6421 = EL (k DIV n) l by MDILATE_EL 6422 = EL (PRE (LENGTH l)) l by above 6423 = LAST l by LAST_EL 6424*) 6425val MDILATE_LAST = store_thm( 6426 "MDILATE_LAST", 6427 ``!l e n. LAST (MDILATE e n l) = LAST l``, 6428 rpt strip_tac >> 6429 Cases_on `l = []` >- 6430 rw[] >> 6431 Cases_on `n = 0` >- 6432 rw[MDILATE_0] >> 6433 `0 < n` by decide_tac >> 6434 `MDILATE e n l <> []` by rw[MDILATE_EQ_NIL] >> 6435 `LENGTH (MDILATE e n l) <> 0` by metis_tac[LENGTH_NIL] >> 6436 qabbrev_tac `k = PRE (LENGTH (MDILATE e n l))` >> 6437 rw[LAST_EL] >> 6438 `k = n * PRE (LENGTH l)` by rw[MDILATE_LENGTH, Abbr`k`] >> 6439 `k MOD n = 0` by metis_tac[MOD_EQ_0, MULT_COMM] >> 6440 `k DIV n = PRE (LENGTH l)` by metis_tac[MULT_DIV, MULT_COMM] >> 6441 `k < LENGTH (MDILATE e n l)` by rw[Abbr`k`] >> 6442 rw[MDILATE_EL]); 6443 6444(* 6445Succesive dilation: 6446 6447> EVAL ``MDILATE #0 3 [a; b; c]``; 6448val it = |- MDILATE #0 3 [a; b; c] = [a; #0; #0; b; #0; #0; c]: thm 6449> EVAL ``MDILATE #0 4 [a; b; c]``; 6450val it = |- MDILATE #0 4 [a; b; c] = [a; #0; #0; #0; b; #0; #0; #0; c]: thm 6451> EVAL ``MDILATE #0 1 (MDILATE #0 3 [a; b; c])``; 6452val it = |- MDILATE #0 1 (MDILATE #0 3 [a; b; c]) = [a; #0; #0; b; #0; #0; c]: thm 6453> EVAL ``MDILATE #0 2 (MDILATE #0 3 [a; b; c])``; 6454val it = |- MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = [a; #0; #0; #0; #0; #0; b; #0; #0; #0; #0; #0; c]: thm 6455> EVAL ``MDILATE #0 2 (MDILATE #0 2 [a; b; c])``; 6456val it = |- MDILATE #0 2 (MDILATE #0 2 [a; b; c]) = [a; #0; #0; #0; b; #0; #0; #0; c]: thm 6457> EVAL ``MDILATE #0 2 (MDILATE #0 2 [a; b; c]) = MDILATE #0 4 [a; b; c]``; 6458val it = |- (MDILATE #0 2 (MDILATE #0 2 [a; b; c]) = MDILATE #0 4 [a; b; c]) <=> T: thm 6459> EVAL ``MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 5 [a; b; c]``; 6460val it = |- (MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 5 [a; b; c]) <=> F: thm 6461> EVAL ``MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 6 [a; b; c]``; 6462val it = |- (MDILATE #0 2 (MDILATE #0 3 [a; b; c]) = MDILATE #0 6 [a; b; c]) <=> T: thm 6463 6464So successive dilation is related to product, or factorisation, or primes: 6465MDILATE e m (MDILATE e n l) = MDILATE e (m * n) l, for 0 < m, 0 < n. 6466 6467*) 6468 6469(* ------------------------------------------------------------------------- *) 6470(* List Dilation (Additive) *) 6471(* ------------------------------------------------------------------------- *) 6472 6473(* Dilate by inserting m zeroes, at position n of tail *) 6474val DILATE_def = tDefine "DILATE" ` 6475 (DILATE e n m [] = []) /\ 6476 (DILATE e n m [h] = [h]) /\ 6477 (DILATE e n m (h::t) = h:: (TAKE n t ++ (GENLIST (K e) m) ++ DILATE e n m (DROP n t))) 6478`( 6479 WF_REL_TAC `measure (\(a,b,c,d). LENGTH d)` >> 6480 rw[LENGTH_DROP]); 6481 6482(* 6483> EVAL ``DILATE 0 0 1 [1;2;3]``; 6484val it = |- DILATE 0 0 1 [1; 2; 3] = [1; 0; 2; 0; 3]: thm 6485> EVAL ``DILATE 0 0 2 [1;2;3]``; 6486val it = |- DILATE 0 0 2 [1; 2; 3] = [1; 0; 0; 2; 0; 0; 3]: thm 6487> EVAL ``DILATE 0 1 1 [1;2;3]``; 6488val it = |- DILATE 0 1 1 [1; 2; 3] = [1; 2; 0; 3]: thm 6489> EVAL ``DILATE 0 1 1 (DILATE 0 0 1 [1;2;3])``; 6490val it = |- DILATE 0 1 1 (DILATE 0 0 1 [1; 2; 3]) = [1; 0; 0; 2; 0; 0; 3]: thm 6491> EVAL ``DILATE 0 0 3 [1;2;3]``; 6492val it = |- DILATE 0 0 3 [1; 2; 3] = [1; 0; 0; 0; 2; 0; 0; 0; 3]: thm 6493> EVAL ``DILATE 0 1 1 (DILATE 0 0 2 [1;2;3])``; 6494val it = |- DILATE 0 1 1 (DILATE 0 0 2 [1; 2; 3]) = [1; 0; 0; 0; 2; 0; 0; 0; 0; 3]: thm 6495> EVAL ``DILATE 0 0 3 [1;2;3] = DILATE 0 2 1 (DILATE 0 0 2 [1;2;3])``; 6496val it = |- (DILATE 0 0 3 [1; 2; 3] = DILATE 0 2 1 (DILATE 0 0 2 [1; 2; 3])) <=> T: thm 6497 6498> EVAL ``DILATE 0 0 0 [1;2;3]``; 6499val it = |- DILATE 0 0 0 [1; 2; 3] = [1; 2; 3]: thm 6500> EVAL ``DILATE 1 0 0 [1;2;3]``; 6501val it = |- DILATE 1 0 0 [1; 2; 3] = [1; 2; 3]: thm 6502> EVAL ``DILATE 1 0 1 [1;2;3]``; 6503val it = |- DILATE 1 0 1 [1; 2; 3] = [1; 1; 2; 1; 3]: thm 6504> EVAL ``DILATE 1 1 1 [1;2;3]``; 6505val it = |- DILATE 1 1 1 [1; 2; 3] = [1; 2; 1; 3]: thm 6506> EVAL ``DILATE 1 1 2 [1;2;3]``; 6507val it = |- DILATE 1 1 2 [1; 2; 3] = [1; 2; 1; 1; 3]: thm 6508> EVAL ``DILATE 1 1 3 [1;2;3]``; 6509val it = |- DILATE 1 1 3 [1; 2; 3] = [1; 2; 1; 1; 1; 3]: thm 6510*) 6511 6512(* Theorem: DILATE e n m [] = [] *) 6513(* Proof: by DILATE_def *) 6514val DILATE_NIL = save_thm("DILATE_NIL", DILATE_def |> CONJUNCT1); 6515(* val DILATE_NIL = |- !n m e. DILATE e n m [] = []: thm *) 6516 6517(* export simple result *) 6518val _ = export_rewrites["DILATE_NIL"]; 6519 6520(* Theorem: DILATE e n m [h] = [h] *) 6521(* Proof: by DILATE_def *) 6522val DILATE_SING = save_thm("DILATE_SING", DILATE_def |> CONJUNCT2 |> CONJUNCT1); 6523(* val DILATE_SING = |- !n m h e. DILATE e n m [h] = [h]: thm *) 6524 6525(* export simple result *) 6526val _ = export_rewrites["DILATE_SING"]; 6527 6528(* Theorem: DILATE e n m (h::t) = 6529 if t = [] then [h] else h:: (TAKE n t ++ (GENLIST (K e) m) ++ DILATE e n m (DROP n t)) *) 6530(* Proof: by DILATE_def, list_CASES *) 6531val DILATE_CONS = store_thm( 6532 "DILATE_CONS", 6533 ``!n m h t e. DILATE e n m (h::t) = 6534 if t = [] then [h] else h:: (TAKE n t ++ (GENLIST (K e) m) ++ DILATE e n m (DROP n t))``, 6535 metis_tac[DILATE_def, list_CASES]); 6536 6537(* Theorem: DILATE e 0 n (h::t) = if t = [] then [h] else h::(GENLIST (K e) n ++ DILATE e 0 n t) *) 6538(* Proof: 6539 If t = [], 6540 DILATE e 0 n (h::t) = [h] by DILATE_CONS 6541 If t <> [], 6542 DILATE e 0 n (h::t) 6543 = h:: (TAKE 0 t ++ (GENLIST (K e) n) ++ DILATE e 0 n (DROP 0 t)) by DILATE_CONS 6544 = h:: ([] ++ (GENLIST (K e) n) ++ DILATE e 0 n t) by TAKE_0, DROP_0 6545 = h:: (GENLIST (K e) n ++ DILATE e 0 n t) by APPEND 6546*) 6547val DILATE_0_CONS = store_thm( 6548 "DILATE_0_CONS", 6549 ``!n h t e. DILATE e 0 n (h::t) = if t = [] then [h] else h::(GENLIST (K e) n ++ DILATE e 0 n t)``, 6550 rw[DILATE_CONS]); 6551 6552(* Theorem: DILATE e 0 0 l = l *) 6553(* Proof: 6554 By induction on l. 6555 Base: DILATE e 0 0 [] = [], true by DILATE_NIL 6556 Step: DILATE e 0 0 l = l ==> !h. DILATE e 0 0 (h::l) = h::l 6557 If l = [], 6558 DILATE e 0 0 [h] = [h] by DILATE_SING 6559 If l <> [], 6560 DILATE e 0 0 (h::l) 6561 = h::(GENLIST (K e) 0 ++ DILATE e 0 0 l) by DILATE_0_CONS 6562 = h::([] ++ DILATE e 0 0 l) by GENLIST_0 6563 = h:: DILATE e 0 0 l by APPEND 6564 = h::l by induction hypothesis 6565*) 6566val DILATE_0_0 = store_thm( 6567 "DILATE_0_0", 6568 ``!l e. DILATE e 0 0 l = l``, 6569 Induct >> 6570 rw[DILATE_0_CONS]); 6571 6572(* Theorem: DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l) *) 6573(* Proof: 6574 If n = 0, 6575 DILATE e 0 1 l = DILATE e 0 1 (DILATE e 0 0 l) by DILATE_0_0 6576 If n <> 0, 6577 GENLIST (K e) n <> [] by LENGTH_GENLIST, LENGTH_NIL 6578 By induction on l. 6579 Base: DILATE e 0 (SUC n) [] = DILATE e n 1 (DILATE e 0 n []) 6580 DILATE e 0 (SUC n) [] = [] by DILATE_NIL 6581 DILATE e n 1 (DILATE e 0 n []) 6582 = DILATE e n 1 [] = [] by DILATE_NIL 6583 Step: DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l) ==> 6584 !h. DILATE e 0 (SUC n) (h::l) = DILATE e n 1 (DILATE e 0 n (h::l)) 6585 If l = [], 6586 DILATE e 0 (SUC n) [h] = [h] by DILATE_SING 6587 DILATE e n 1 (DILATE e 0 n [h]) 6588 = DILATE e n 1 [h] = [h] by DILATE_SING 6589 If l <> [], 6590 DILATE e 0 (SUC n) (h::l) 6591 = h::(GENLIST (K e) (SUC n) ++ DILATE e 0 (SUC n) l) by DILATE_0_CONS 6592 = h::(GENLIST (K e) (SUC n) ++ DILATE e n 1 (DILATE e 0 n l)) by induction hypothesis 6593 6594 Note LENGTH (GENLIST (K e) n) = n by LENGTH_GENLIST 6595 so (GENLIST (K e) n ++ DILATE e 0 n l) <> [] by APPEND_eq_NIL, LENGTH_NIL [1] 6596 and TAKE n (GENLIST (K e) n ++ DILATE e 0 n l) = GENLIST (K e) n by TAKE_LENGTH_APPEND [2] 6597 and DROP n (GENLIST (K e) n ++ DILATE e 0 n l) = DILATE e 0 n l by DROP_LENGTH_APPEND [3] 6598 and GENLIST (K e) (SUC n) 6599 = GENLIST (K e) (1 + n) by SUC_ONE_ADD 6600 = GENLIST (K e) n ++ GENLIST (K e) 1 by GENLIST_K_ADD [4] 6601 6602 DILATE e n 1 (DILATE e 0 n (h::l)) 6603 = DILATE e n 1 (h::(GENLIST (K e) n ++ DILATE e 0 n l)) by DILATE_0_CONS 6604 = h::(TAKE n (GENLIST (K e) n ++ DILATE e 0 n l) ++ GENLIST (K e) 1 ++ 6605 DILATE e n 1 (DROP n (GENLIST (K e) n ++ DILATE e 0 n l))) by DILATE_CONS, [1] 6606 = h::(GENLIST (K e) n ++ GENLIST (K e) 1 ++ DILATE e n 1 (DILATE e 0 n l)) by above [2], [3] 6607 = h::(GENLIST (K e) (SUC n) ++ DILATE e n 1 (DILATE e 0 n l)) by above [4] 6608*) 6609val DILATE_0_SUC = store_thm( 6610 "DILATE_0_SUC", 6611 ``!l e n. DILATE e 0 (SUC n) l = DILATE e n 1 (DILATE e 0 n l)``, 6612 rpt strip_tac >> 6613 Cases_on `n = 0` >- 6614 rw[DILATE_0_0] >> 6615 Induct_on `l` >- 6616 rw[] >> 6617 rpt strip_tac >> 6618 Cases_on `l = []` >- 6619 rw[DILATE_SING] >> 6620 qabbrev_tac `a = GENLIST (K e) n ++ DILATE e 0 n l` >> 6621 `LENGTH (GENLIST (K e) n) = n` by rw[] >> 6622 `a <> []` by metis_tac[APPEND_eq_NIL, LENGTH_NIL] >> 6623 `TAKE n a = GENLIST (K e) n` by metis_tac[TAKE_LENGTH_APPEND] >> 6624 `DROP n a = DILATE e 0 n l` by metis_tac[DROP_LENGTH_APPEND] >> 6625 `GENLIST (K e) (SUC n) = GENLIST (K e) n ++ GENLIST (K e) 1` by rw_tac std_ss[SUC_ONE_ADD, GENLIST_K_ADD] >> 6626 metis_tac[DILATE_0_CONS, DILATE_CONS]); 6627 6628(* Theorem: LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l)) *) 6629(* Proof: 6630 By induction on l. 6631 Base: LENGTH (DILATE e 0 n []) = 0 6632 LENGTH (DILATE e 0 n []) 6633 = LENGTH [] by DILATE_NIL 6634 = 0 by LENGTH_NIL 6635 Step: LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l)) ==> 6636 !h. LENGTH (DILATE e 0 n (h::l)) = SUC (SUC n * PRE (LENGTH (h::l))) 6637 If l = [], 6638 LENGTH (DILATE e 0 n [h]) 6639 = LENGTH [h] by DILATE_SING 6640 = 1 by LENGTH 6641 SUC (SUC n * PRE (LENGTH [h]) 6642 = SUC (SUC n * PRE 1) by LENGTH 6643 = SUC (SUC n * 0) by PRE_SUB1 6644 = SUC 0 by MULT_0 6645 = 1 by ONE 6646 If l <> [], 6647 Note LENGTH l <> 0 by LENGTH_NIL 6648 LENGTH (DILATE e 0 n (h::l)) 6649 = LENGTH (h::(GENLIST (K e) n ++ DILATE e 0 n l)) by DILATE_0_CONS 6650 = SUC (LENGTH (GENLIST (K e) n ++ DILATE e 0 n l)) by LENGTH 6651 = SUC (LENGTH (GENLIST (K e) n) + LENGTH (DILATE e 0 n l)) by LENGTH_APPEND 6652 = SUC (n + LENGTH (DILATE e 0 n l)) by LENGTH_GENLIST 6653 = SUC (n + SUC (SUC n * PRE (LENGTH l))) by induction hypothesis 6654 = SUC (SUC (n + SUC n * PRE (LENGTH l))) by ADD_SUC 6655 = SUC (SUC n + SUC n * PRE (LENGTH l)) by ADD_COMM, ADD_SUC 6656 = SUC (SUC n * SUC (PRE (LENGTH l))) by MULT_SUC 6657 = SUC (SUC n * LENGTH l) by SUC_PRE, 0 < LENGTH l 6658 = SUC (SUC n * PRE (LENGTH (h::l))) by LENGTH, PRE_SUC_EQ 6659*) 6660val DILATE_0_LENGTH = store_thm( 6661 "DILATE_0_LENGTH", 6662 ``!l e n. LENGTH (DILATE e 0 n l) = if l = [] then 0 else SUC (SUC n * PRE (LENGTH l))``, 6663 Induct >- 6664 rw[] >> 6665 rw_tac std_ss[LENGTH] >> 6666 Cases_on `l = []` >- 6667 rw[] >> 6668 `0 < LENGTH l` by metis_tac[LENGTH_NIL, NOT_ZERO_LT_ZERO] >> 6669 `LENGTH (DILATE e 0 n (h::l)) = LENGTH (h::(GENLIST (K e) n ++ DILATE e 0 n l))` by rw[DILATE_0_CONS] >> 6670 `_ = SUC (LENGTH (GENLIST (K e) n ++ DILATE e 0 n l))` by rw[] >> 6671 `_ = SUC (n + LENGTH (DILATE e 0 n l))` by rw[] >> 6672 `_ = SUC (n + SUC (SUC n * PRE (LENGTH l)))` by rw[] >> 6673 `_ = SUC (SUC (n + SUC n * PRE (LENGTH l)))` by rw[] >> 6674 `_ = SUC (SUC n + SUC n * PRE (LENGTH l))` by rw[] >> 6675 `_ = SUC (SUC n * SUC (PRE (LENGTH l)))` by rw[MULT_SUC] >> 6676 `_ = SUC (SUC n * LENGTH l)` by rw[SUC_PRE] >> 6677 rw[]); 6678 6679(* Theorem: LENGTH l <= LENGTH (DILATE e 0 n l) *) 6680(* Proof: 6681 If l = [], 6682 LENGTH (DILATE e 0 n []) 6683 = LENGTH [] by DILATE_NIL 6684 >= LENGTH [] 6685 If l <> [], 6686 Then ?h t. l = h::t by list_CASES 6687 LENGTH (DILATE e 0 n (h::t)) 6688 = SUC (SUC n * PRE (LENGTH (h::t))) by DILATE_0_LENGTH 6689 = SUC (SUC n * PRE (SUC (LENGTH t))) by LENGTH 6690 = SUC (SUC n * LENGTH t) by PRE 6691 = SUC n * LENGTH t + 1 by ADD1 6692 >= LENGTH t + 1 by LE_MULT_CANCEL_LBARE, 0 < SUC n 6693 = SUC (LENGTH t) by ADD1 6694 = LENGTH (h::t) by LENGTH 6695*) 6696val DILATE_0_LENGTH_LOWER = store_thm( 6697 "DILATE_0_LENGTH_LOWER", 6698 ``!l e n. LENGTH l <= LENGTH (DILATE e 0 n l)``, 6699 rw[DILATE_0_LENGTH] >> 6700 `?h t. l = h::t` by metis_tac[list_CASES] >> 6701 rw[]); 6702 6703(* Theorem: LENGTH (DILATE e 0 n l) <= SUC (SUC n * PRE (LENGTH l)) *) 6704(* Proof: 6705 If l = [], 6706 LENGTH (DILATE e 0 n []) 6707 = LENGTH [] by DILATE_NIL 6708 = 0 by LENGTH_NIL 6709 SUC (SUC n * PRE (LENGTH [])) 6710 = SUC (SUC n * PRE 0) by LENGTH_NIL 6711 = SUC 0 by PRE, MULT_0 6712 > 0 by LESS_SUC 6713 If l <> [], 6714 LENGTH (DILATE e 0 n l) 6715 = SUC (SUC n * PRE (LENGTH l)) by DILATE_0_LENGTH 6716*) 6717val DILATE_0_LENGTH_UPPER = store_thm( 6718 "DILATE_0_LENGTH_UPPER", 6719 ``!l e n. LENGTH (DILATE e 0 n l) <= SUC (SUC n * PRE (LENGTH l))``, 6720 rw[DILATE_0_LENGTH]); 6721 6722(* Theorem: k < LENGTH (DILATE e 0 n l) ==> 6723 (EL k (DILATE e 0 n l) = if k MOD (SUC n) = 0 then EL (k DIV (SUC n)) l else e) *) 6724(* Proof: 6725 Let m = SUC n, then 0 < m. 6726 By induction on l. 6727 Base: !k. k < LENGTH (DILATE e 0 n []) ==> (EL k (DILATE e 0 n []) = if k MOD m = 0 then EL (k DIV m) [] else e) 6728 Note LENGTH (DILATE e 0 n []) 6729 = LENGTH [] by DILATE_NIL 6730 = 0 by LENGTH_NIL 6731 Thus k < 0 <=> F by NOT_ZERO_LT_ZERO 6732 Step: !k. k < LENGTH (DILATE e 0 n l) ==> (EL k (DILATE e 0 n l) = if k MOD m = 0 then EL (k DIV m) l else e) ==> 6733 !h k. k < LENGTH (DILATE e 0 n (h::l)) ==> (EL k (DILATE e 0 n (h::l)) = if k MOD m = 0 then EL (k DIV m) (h::l) else e) 6734 Note LENGTH (DILATE e 0 n [h]) = 1 by DILATE_SING 6735 and LENGTH (DILATE e 0 n (h::l)) 6736 = SUC (m * PRE (LENGTH (h::l))) by DILATE_0_LENGTH, n <> 0 6737 = SUC (m * PRE (SUC (LENGTH l))) by LENGTH 6738 = SUC (m * LENGTH l) by PRE 6739 6740 If l = [], 6741 Then DILATE e 0 n [h] = [h] by DILATE_SING 6742 and LENGTH (DILATE e 0 n [h]) = 1 by LENGTH 6743 so k < 1 means k = 0. 6744 and 0 DIV m = 0 by ZERO_DIV, 0 < m 6745 and 0 MOD m = 0 by ZERO_MOD, 0 < m 6746 Thus EL k [h] = EL (k DIV m) [h]. 6747 6748 If l <> [], 6749 Let t = h:: GENLIST (K e) n. 6750 Note LENGTH t = SUC n = m by LENGTH_GENLIST 6751 If k < m, 6752 Then k MOD m = k by LESS_MOD, k < m 6753 EL k (DILATE e 0 n (h::l)) 6754 = EL k (t ++ DILATE e 0 n l) by DILATE_0_CONS 6755 = EL k t by EL_APPEND, k < LENGTH t 6756 If k = 0, i.e. k MOD m = 0. 6757 EL 0 t 6758 = EL 0 (h:: GENLIST (K e) (PRE n)) by notation of t 6759 = h 6760 = EL (0 DIV m) (h::l) by EL, HD 6761 If k <> 0, i.e. k MOD m <> 0. 6762 EL k t 6763 = EL k (h:: GENLIST (K e) n) by notation of t 6764 = EL (PRE k) (GENLIST (K e) n) by EL_CONS 6765 = (K e) (PRE k) by EL_GENLIST, PRE k < PRE m = n 6766 = e by application of K 6767 If ~(k < m), then m <= k. 6768 Given k < LENGTH (DILATE e 0 n (h::l)) 6769 or k < SUC (m * LENGTH l) by above 6770 ==> k - m < SUC (m * LENGTH l) - m by m <= k 6771 = SUC (m * LENGTH l - m) by SUB 6772 = SUC (m * (LENGTH l - 1)) by LEFT_SUB_DISTRIB 6773 = SUC (m * PRE (LENGTH l)) by PRE_SUB1 6774 or k - m < LENGTH (MDILATE e n l) by MDILATE_LENGTH 6775 Thus (k - m) MOD m = k MOD m by SUB_MOD 6776 and (k - m) DIV m = k DIV m - 1 by SUB_DIV 6777 If k MOD m = 0, 6778 Note 0 < k DIV m by DIVIDES_MOD_0, DIV_POS 6779 EL k (t ++ DILATE e 0 n l) 6780 = EL (k - m) (DILATE e 0 n l) by EL_APPEND, m <= k 6781 = EL (k DIV m - 1) l by induction hypothesis, (k - m) MOD m = 0 6782 = EL (PRE (k DIV m)) l by PRE_SUB1 6783 = EL (k DIV m) (h::l) by EL_CONS, 0 < k DIV m 6784 If k MOD m <> 0, 6785 EL k (t ++ DILATE e 0 n l) 6786 = EL (k - m) (DILATE e 0 n l) by EL_APPEND, n <= k 6787 = e by induction hypothesis, (k - m) MOD n <> 0 6788*) 6789Theorem DILATE_0_EL: 6790 !l e n k. 6791 k < LENGTH (DILATE e 0 n l) ==> 6792 EL k (DILATE e 0 n l) = if k MOD (SUC n) = 0 then EL (k DIV (SUC n)) l 6793 else e 6794Proof 6795 ntac 3 strip_tac >> 6796 `0 < SUC n` by decide_tac >> 6797 qabbrev_tac `m = SUC n` >> 6798 Induct_on `l` >- rw[] >> 6799 rpt strip_tac >> 6800 `LENGTH (DILATE e 0 n [h]) = 1` by rw[DILATE_SING] >> 6801 `LENGTH (DILATE e 0 n (h::l)) = SUC (m * LENGTH l)` by rw[DILATE_0_LENGTH, Abbr`m`] >> 6802 Cases_on `l = []` >| [ 6803 `k = 0` by rw[] >> 6804 `k MOD m = 0` by rw[] >> 6805 `k DIV m = 0` by rw[ZERO_DIV] >> 6806 rw_tac std_ss[DILATE_SING], 6807 qabbrev_tac `t = h::GENLIST (K e) n` >> 6808 `DILATE e 0 n (h::l) = t ++ DILATE e 0 n l` by rw[DILATE_0_CONS, Abbr`t`] >> 6809 `m = LENGTH t` by rw[Abbr`t`] >> 6810 Cases_on `k < m` >| [ 6811 `k MOD m = k` by rw[] >> 6812 `EL k (DILATE e 0 n (h::l)) = EL k t` by rw[EL_APPEND] >> 6813 Cases_on `k = 0` >| [ 6814 `EL 0 t = h` by rw[Abbr`t`] >> 6815 rw[ZERO_DIV], 6816 `PRE m = n` by rw[Abbr`m`] >> 6817 `PRE k < n` by decide_tac >> 6818 `EL k t = EL (PRE k) (GENLIST (K e) n)` by rw[EL_CONS, Abbr`t`] >> 6819 `_ = (K e) (PRE k)` by rw[EL_GENLIST] >> 6820 rw[] 6821 ], 6822 `m <= k` by decide_tac >> 6823 `EL k (t ++ DILATE e 0 n l) = EL (k - m) (DILATE e 0 n l)` 6824 by simp[EL_APPEND] >> 6825 `k - m < LENGTH (DILATE e 0 n l)` 6826 by (trace ("BasicProvers.var_eq_old", 1)(rw[DILATE_0_LENGTH])) >> 6827 `(k - m) MOD m = k MOD m` by simp[SUB_MOD] >> 6828 `(k - m) DIV m = k DIV m - 1` by simp[SUB_DIV] >> 6829 Cases_on `k MOD m = 0` >| [ 6830 `0 < k DIV m` by rw[DIVIDES_MOD_0, DIV_POS] >> 6831 `EL (k - m) (DILATE e 0 n l) = EL (k DIV m - 1) l` by rw[] >> 6832 `_ = EL (PRE (k DIV m)) l` by rw[PRE_SUB1] >> 6833 `_ = EL (k DIV m) (h::l)` by rw[EL_CONS] >> 6834 rw[], 6835 `EL (k - m) (DILATE e 0 n l) = e` 6836 by trace ("BasicProvers.var_eq_old", 1)(rw[]) >> 6837 rw[] 6838 ] 6839 ] 6840 ] 6841QED 6842 6843(* This is a milestone theorem. *) 6844 6845(* Theorem: (DILATE e 0 n l = []) <=> (l = []) *) 6846(* Proof: 6847 If part: DILATE e 0 n l = [] ==> l = [] 6848 By contradiction, suppose l <> []. 6849 If n = 0, 6850 Then DILATE e n 0 l = l by DILATE_0_0 6851 This contradicts DILATE e n 0 l = []. 6852 If n <> 0, 6853 Then LENGTH (DILATE e 0 n l) 6854 = SUC (SUC n * PRE (LENGTH l)) by DILATE_0_LENGTH 6855 <> 0 by SUC_NOT 6856 So (DILATE e 0 n l) <> [] by LENGTH_NIL 6857 This contradicts DILATE e 0 n l = [] 6858 Only-if part: l = [] ==> DILATE e 0 n l = [] 6859 True by DILATE_NIL 6860*) 6861val DILATE_0_EQ_NIL = store_thm( 6862 "DILATE_0_EQ_NIL", 6863 ``!l e n. (DILATE e 0 n l = []) <=> (l = [])``, 6864 rw[EQ_IMP_THM] >> 6865 spose_not_then strip_assume_tac >> 6866 Cases_on `n = 0` >| [ 6867 `DILATE e 0 0 l = l` by rw[GSYM DILATE_0_0] >> 6868 metis_tac[], 6869 `LENGTH (DILATE e 0 n l) = SUC (SUC n * PRE (LENGTH l))` by rw[DILATE_0_LENGTH] >> 6870 `LENGTH (DILATE e 0 n l) <> 0` by decide_tac >> 6871 metis_tac[LENGTH_EQ_0] 6872 ]); 6873 6874(* Theorem: LAST (DILATE e 0 n l) = LAST l *) 6875(* Proof: 6876 If l = [], 6877 LAST (DILATE e 0 n []) 6878 = LAST [] by DILATE_NIL 6879 If l <> [], 6880 If n = 0, 6881 LAST (DILATE e 0 0 l) 6882 = LAST l by DILATE_0_0 6883 If n <> 0, 6884 Then DILATE e 0 n l <> [] by DILATE_0_EQ_NIL 6885 or LENGTH (DILATE e 0 n l) <> 0 by LENGTH_NIL 6886 Let m = SUC n, then 0 < m by LESS_0 6887 Note PRE (LENGTH (DILATE e 0 n l)) 6888 = PRE (SUC (m * PRE (LENGTH l))) by DILATE_0_LENGTH 6889 = m * PRE (LENGTH l) by PRE 6890 Let k = PRE (LENGTH (DILATE e 0 n l)). 6891 Then k < LENGTH (DILATE e 0 n l) by PRE x < x 6892 and k MOD m = 0 by MOD_EQ_0, MULT_COMM, 0 < m 6893 and k DIV m = PRE (LENGTH l) by MULT_DIV, MULT_COMM 6894 6895 LAST (DILATE e 0 n l) 6896 = EL k (DILATE e 0 n l) by LAST_EL 6897 = EL (k DIV m) l by DILATE_0_EL 6898 = EL (PRE (LENGTH l)) l by above 6899 = LAST l by LAST_EL 6900*) 6901val DILATE_0_LAST = store_thm( 6902 "DILATE_0_LAST", 6903 ``!l e n. LAST (DILATE e 0 n l) = LAST l``, 6904 rpt strip_tac >> 6905 Cases_on `l = []` >- 6906 rw[] >> 6907 Cases_on `n = 0` >- 6908 rw[DILATE_0_0] >> 6909 `0 < n` by decide_tac >> 6910 `DILATE e 0 n l <> []` by rw[DILATE_0_EQ_NIL] >> 6911 `LENGTH (DILATE e 0 n l) <> 0` by metis_tac[LENGTH_NIL] >> 6912 qabbrev_tac `k = PRE (LENGTH (DILATE e 0 n l))` >> 6913 rw[LAST_EL] >> 6914 `0 < SUC n` by decide_tac >> 6915 qabbrev_tac `m = SUC n` >> 6916 `k = m * PRE (LENGTH l)` by rw[DILATE_0_LENGTH, Abbr`k`, Abbr`m`] >> 6917 `k MOD m = 0` by metis_tac[MOD_EQ_0, MULT_COMM] >> 6918 `k DIV m = PRE (LENGTH l)` by metis_tac[MULT_DIV, MULT_COMM] >> 6919 `k < LENGTH (DILATE e 0 n l)` by simp[Abbr`k`] >> 6920 Q.RM_ABBREV_TAC ���k��� >> 6921 rw[DILATE_0_EL]); 6922 6923(* ------------------------------------------------------------------------- *) 6924(* Range Conjunction and Disjunction *) 6925(* ------------------------------------------------------------------------- *) 6926 6927(* Theorem: a <= j /\ j <= a <=> (j = a) *) 6928(* Proof: trivial by arithmetic. *) 6929val every_range_sing = store_thm( 6930 "every_range_sing", 6931 ``!a j. a <= j /\ j <= a <=> (j = a)``, 6932 decide_tac); 6933 6934(* Theorem: a <= b ==> 6935 ((!j. a <= j /\ j <= b ==> f j) <=> (f a /\ !j. a + 1 <= j /\ j <= b ==> f j)) *) 6936(* Proof: 6937 If part: !j. a <= j /\ j <= b ==> f j ==> 6938 f a /\ !j. a + 1 <= j /\ j <= b ==> f j 6939 This is trivial since a + 1 = SUC a. 6940 Only-if part: f a /\ !j. a + 1 <= j /\ j <= b ==> f j ==> 6941 !j. a <= j /\ j <= b ==> f j 6942 Note a <= j <=> a = j or a < j by arithmetic 6943 If a = j, this is trivial. 6944 If a < j, then a + 1 <= j, also trivial. 6945*) 6946val every_range_cons = store_thm( 6947 "every_range_cons", 6948 ``!f a b. a <= b ==> 6949 ((!j. a <= j /\ j <= b ==> f j) <=> (f a /\ !j. a + 1 <= j /\ j <= b ==> f j))``, 6950 rw[EQ_IMP_THM] >> 6951 `(a = j) \/ (a < j)` by decide_tac >- 6952 fs[] >> 6953 fs[]); 6954 6955(* Theorem: ?j. a <= j /\ j <= a <=> (j = a) *) 6956(* Proof: trivial by arithmetic. *) 6957val exists_range_sing = store_thm( 6958 "exists_range_sing", 6959 ``!a. ?j. a <= j /\ j <= a <=> (j = a)``, 6960 metis_tac[LESS_EQ_REFL]); 6961 6962(* Theorem: a <= b ==> 6963 ((?j. a <= j /\ j <= b /\ f j) <=> (f a \/ ?j. a + 1 <= j /\ j <= b /\ f j)) *) 6964(* Proof: 6965 If part: ?j. a <= j /\ j <= b /\ f j ==> 6966 f a \/ ?j. a + 1 <= j /\ j <= b /\ f j 6967 This is trivial since a + 1 = SUC a. 6968 Only-if part: f a /\ ?j. a + 1 <= j /\ j <= b /\ f j ==> 6969 ?j. a <= j /\ j <= b /\ f j 6970 Note a <= j <=> a = j or a < j by arithmetic 6971 If a = j, this is trivial. 6972 If a < j, then a + 1 <= j, also trivial. 6973*) 6974val exists_range_cons = store_thm( 6975 "exists_range_cons", 6976 ``!f a b. a <= b ==> 6977 ((?j. a <= j /\ j <= b /\ f j) <=> (f a \/ ?j. a + 1 <= j /\ j <= b /\ f j))``, 6978 rw[EQ_IMP_THM] >| [ 6979 `(a = j) \/ (a < j)` by decide_tac >- 6980 fs[] >> 6981 `a + 1 <= j` by decide_tac >> 6982 metis_tac[], 6983 metis_tac[LESS_EQ_REFL], 6984 `a <= j` by decide_tac >> 6985 metis_tac[] 6986 ]); 6987 6988 6989 6990(* ------------------------------------------------------------------------- *) 6991 6992(* export theory at end *) 6993val _ = export_theory(); 6994 6995(*===========================================================================*) 6996