# HG changeset patch # User wenzelm # Date 1467384755 -7200 # Node ID d10eab0672f96bd79a6a06684a5b918201dca155 # Parent 65a9eb946ff2e854178becdad46b37aa481904a8 misc tuning and modernization; diff -r 65a9eb946ff2 -r d10eab0672f9 src/HOL/Proofs/Extraction/Euclid.thy --- a/src/HOL/Proofs/Extraction/Euclid.thy Fri Jul 01 10:56:54 2016 +0200 +++ b/src/HOL/Proofs/Extraction/Euclid.thy Fri Jul 01 16:52:35 2016 +0200 @@ -14,8 +14,8 @@ begin text \ -A constructive version of the proof of Euclid's theorem by -Markus Wenzel and Freek Wiedijk @{cite "Wenzel-Wiedijk-JAR2002"}. + A constructive version of the proof of Euclid's theorem by + Markus Wenzel and Freek Wiedijk @{cite "Wenzel-Wiedijk-JAR2002"}. \ lemma factor_greater_one1: "n = m * k \ m < n \ k < n \ Suc 0 < m" @@ -24,11 +24,10 @@ lemma factor_greater_one2: "n = m * k \ m < n \ k < n \ Suc 0 < k" by (induct k) auto -lemma prod_mn_less_k: - "(0::nat) < n ==> 0 < k ==> Suc 0 < m ==> m * n = k ==> n < k" +lemma prod_mn_less_k: "0 < n \ 0 < k \ Suc 0 < m \ m * n = k \ n < k" by (induct m) auto -lemma prime_eq: "prime (p::nat) = (1 < p \ (\m. m dvd p \ 1 < m \ m = p))" +lemma prime_eq: "prime p \ 1 < p \ (\m. m dvd p \ 1 < m \ m = p)" apply (simp add: prime_def) apply (rule iffI) apply blast @@ -39,29 +38,25 @@ apply (erule allE) apply (erule impE) apply assumption - apply (case_tac "m=0") + apply (case_tac "m = 0") apply simp - apply (case_tac "m=Suc 0") + apply (case_tac "m = Suc 0") apply simp apply simp done -lemma prime_eq': "prime (p::nat) = (1 < p \ (\m k. p = m * k \ 1 < m \ m = p))" +lemma prime_eq': "prime p \ 1 < p \ (\m k. p = m * k \ 1 < m \ m = p)" by (simp add: prime_eq dvd_def HOL.all_simps [symmetric] del: HOL.all_simps) lemma not_prime_ex_mk: assumes n: "Suc 0 < n" shows "(\m k. Suc 0 < m \ Suc 0 < k \ m < n \ k < n \ n = m * k) \ prime n" proof - - { - fix k - from nat_eq_dec - have "(\m \ (\mkm \ (\kmm \ (\mkm \ (\kmkm (\kmkm m * k" by iprover + then have A: "\km m * k" by iprover have "\m k. n = m * k \ Suc 0 < m \ m = n" proof (intro allI impI) fix m k @@ -99,11 +94,11 @@ qed with n have "prime n" by (simp only: prime_eq' One_nat_def simp_thms) - thus ?thesis .. + then show ?thesis .. qed qed -lemma dvd_factorial: "0 < m \ m \ n \ m dvd fact (n::nat)" +lemma dvd_factorial: "0 < m \ m \ n \ m dvd fact n" proof (induct n rule: nat_induct) case 0 then show ?case by simp @@ -124,30 +119,30 @@ qed lemma dvd_prod [iff]: "n dvd (\m::nat \# mset (n # ns). m)" - by (simp add: msetprod_Un msetprod_singleton) + by (simp add: msetprod_Un) -definition all_prime :: "nat list \ bool" where - "all_prime ps \ (\p\set ps. prime p)" +definition all_prime :: "nat list \ bool" + where "all_prime ps \ (\p\set ps. prime p)" lemma all_prime_simps: "all_prime []" "all_prime (p # ps) \ prime p \ all_prime ps" by (simp_all add: all_prime_def) -lemma all_prime_append: - "all_prime (ps @ qs) \ all_prime ps \ all_prime qs" +lemma all_prime_append: "all_prime (ps @ qs) \ all_prime ps \ all_prime qs" by (simp add: all_prime_def ball_Un) lemma split_all_prime: assumes "all_prime ms" and "all_prime ns" - shows "\qs. all_prime qs \ (\m::nat \# mset qs. m) = - (\m::nat \# mset ms. m) * (\m::nat \# mset ns. m)" (is "\qs. ?P qs \ ?Q qs") + shows "\qs. all_prime qs \ + (\m::nat \# mset qs. m) = (\m::nat \# mset ms. m) * (\m::nat \# mset ns. m)" + (is "\qs. ?P qs \ ?Q qs") proof - from assms have "all_prime (ms @ ns)" by (simp add: all_prime_append) - moreover from assms have "(\m::nat \# mset (ms @ ns). m) = - (\m::nat \# mset ms. m) * (\m::nat \# mset ns. m)" - by (simp add: msetprod_Un) + moreover + have "(\m::nat \# mset (ms @ ns). m) = (\m::nat \# mset ms. m) * (\m::nat \# mset ns. m)" + using assms by (simp add: msetprod_Un) ultimately have "?P (ms @ ns) \ ?Q (ms @ ns)" .. then show ?thesis .. qed @@ -155,8 +150,10 @@ lemma all_prime_nempty_g_one: assumes "all_prime ps" and "ps \ []" shows "Suc 0 < (\m::nat \# mset ps. m)" - using \ps \ []\ \all_prime ps\ unfolding One_nat_def [symmetric] by (induct ps rule: list_nonempty_induct) - (simp_all add: all_prime_simps msetprod_singleton msetprod_Un prime_gt_1_nat less_1_mult del: One_nat_def) + using \ps \ []\ \all_prime ps\ + unfolding One_nat_def [symmetric] + by (induct ps rule: list_nonempty_induct) + (simp_all add: all_prime_simps msetprod_Un prime_gt_1_nat less_1_mult del: One_nat_def) lemma factor_exists: "Suc 0 < n \ (\ps. all_prime ps \ (\m::nat \# mset ps. m) = n)" proof (induct n rule: nat_wf_ind) @@ -165,14 +162,17 @@ have "(\m k. Suc 0 < m \ Suc 0 < k \ m < n \ k < n \ n = m * k) \ prime n" by (rule not_prime_ex_mk) then show ?case - proof + proof assume "\m k. Suc 0 < m \ Suc 0 < k \ m < n \ k < n \ n = m * k" then obtain m k where m: "Suc 0 < m" and k: "Suc 0 < k" and mn: "m < n" - and kn: "k < n" and nmk: "n = m * k" by iprover - from mn and m have "\ps. all_prime ps \ (\m::nat \# mset ps. m) = m" by (rule 1) + and kn: "k < n" and nmk: "n = m * k" + by iprover + from mn and m have "\ps. all_prime ps \ (\m::nat \# mset ps. m) = m" + by (rule 1) then obtain ps1 where "all_prime ps1" and prod_ps1_m: "(\m::nat \# mset ps1. m) = m" by iprover - from kn and k have "\ps. all_prime ps \ (\m::nat \# mset ps. m) = k" by (rule 1) + from kn and k have "\ps. all_prime ps \ (\m::nat \# mset ps. m) = k" + by (rule 1) then obtain ps2 where "all_prime ps2" and prod_ps2_k: "(\m::nat \# mset ps2. m) = k" by iprover from \all_prime ps1\ \all_prime ps2\ @@ -192,27 +192,27 @@ assumes N: "(1::nat) < n" shows "\p. prime p \ p dvd n" proof - - from N obtain ps where "all_prime ps" - and prod_ps: "n = (\m::nat \# mset ps. m)" using factor_exists - by simp iprover + from N obtain ps where "all_prime ps" and prod_ps: "n = (\m::nat \# mset ps. m)" + using factor_exists by simp iprover with N have "ps \ []" - by (auto simp add: all_prime_nempty_g_one msetprod_empty) - then obtain p qs where ps: "ps = p # qs" by (cases ps) simp - with \all_prime ps\ have "prime p" by (simp add: all_prime_simps) - moreover from \all_prime ps\ ps prod_ps - have "p dvd n" by (simp only: dvd_prod) + by (auto simp add: all_prime_nempty_g_one) + then obtain p qs where ps: "ps = p # qs" + by (cases ps) simp + with \all_prime ps\ have "prime p" + by (simp add: all_prime_simps) + moreover from \all_prime ps\ ps prod_ps have "p dvd n" + by (simp only: dvd_prod) ultimately show ?thesis by iprover qed -text \ -Euclid's theorem: there are infinitely many primes. -\ +text \Euclid's theorem: there are infinitely many primes.\ -lemma Euclid: "\p::nat. prime p \ n < p" +lemma Euclid: "\p. prime p \ n < p" proof - let ?k = "fact n + (1::nat)" have "1 < ?k" by simp - then obtain p where prime: "prime p" and dvd: "p dvd ?k" using prime_factor_exists by iprover + then obtain p where prime: "prime p" and dvd: "p dvd ?k" + using prime_factor_exists by iprover have "n < p" proof - have "\ p \ n" @@ -232,10 +232,10 @@ extract Euclid text \ -The program extracted from the proof of Euclid's theorem looks as follows. -@{thm [display] Euclid_def} -The program corresponding to the proof of the factorization theorem is -@{thm [display] factor_exists_def} + The program extracted from the proof of Euclid's theorem looks as follows. + @{thm [display] Euclid_def} + The program corresponding to the proof of the factorization theorem is + @{thm [display] factor_exists_def} \ instantiation nat :: default @@ -256,9 +256,10 @@ end -primrec iterate :: "nat \ ('a \ 'a) \ 'a \ 'a list" where +primrec iterate :: "nat \ ('a \ 'a) \ 'a \ 'a list" +where "iterate 0 f x = []" - | "iterate (Suc n) f x = (let y = f x in y # iterate n f y)" +| "iterate (Suc n) f x = (let y = f x in y # iterate n f y)" lemma "factor_exists 1007 = [53, 19]" by eval lemma "factor_exists 567 = [7, 3, 3, 3, 3]" by eval diff -r 65a9eb946ff2 -r d10eab0672f9 src/HOL/Proofs/Extraction/Greatest_Common_Divisor.thy --- a/src/HOL/Proofs/Extraction/Greatest_Common_Divisor.thy Fri Jul 01 10:56:54 2016 +0200 +++ b/src/HOL/Proofs/Extraction/Greatest_Common_Divisor.thy Fri Jul 01 16:52:35 2016 +0200 @@ -10,8 +10,9 @@ begin theorem greatest_common_divisor: - "\n::nat. Suc m < n \ \k n1 m1. k * n1 = n \ k * m1 = Suc m \ - (\l l1 l2. l * l1 = n \ l * l2 = Suc m \ l \ k)" + "\n::nat. Suc m < n \ + \k n1 m1. k * n1 = n \ k * m1 = Suc m \ + (\l l1 l2. l * l1 = n \ l * l2 = Suc m \ l \ k)" proof (induct m rule: nat_wf_ind) case (1 m n) from division obtain r q where h1: "n = Suc m * q + r" and h2: "r \ m" @@ -21,33 +22,28 @@ case 0 with h1 have "Suc m * q = n" by simp moreover have "Suc m * 1 = Suc m" by simp - moreover { - fix l2 have "\l l1. l * l1 = n \ l * l2 = Suc m \ l \ Suc m" - by (cases l2) simp_all } + moreover have "l * l1 = n \ l * l2 = Suc m \ l \ Suc m" for l l1 l2 + by (cases l2) simp_all ultimately show ?thesis by iprover next case (Suc nat) with h2 have h: "nat < m" by simp moreover from h have "Suc nat < Suc m" by simp ultimately have "\k m1 r1. k * m1 = Suc m \ k * r1 = Suc nat \ - (\l l1 l2. l * l1 = Suc m \ l * l2 = Suc nat \ l \ k)" + (\l l1 l2. l * l1 = Suc m \ l * l2 = Suc nat \ l \ k)" by (rule 1) - then obtain k m1 r1 where - h1': "k * m1 = Suc m" + then obtain k m1 r1 where h1': "k * m1 = Suc m" and h2': "k * r1 = Suc nat" and h3': "\l l1 l2. l * l1 = Suc m \ l * l2 = Suc nat \ l \ k" by iprover have mn: "Suc m < n" by (rule 1) - from h1 h1' h2' Suc have "k * (m1 * q + r1) = n" + from h1 h1' h2' Suc have "k * (m1 * q + r1) = n" by (simp add: add_mult_distrib2 mult.assoc [symmetric]) - moreover have "\l l1 l2. l * l1 = n \ l * l2 = Suc m \ l \ k" + moreover have "l \ k" if ll1n: "l * l1 = n" and ll2m: "l * l2 = Suc m" for l l1 l2 proof - - fix l l1 l2 - assume ll1n: "l * l1 = n" - assume ll2m: "l * l2 = Suc m" - moreover have "l * (l1 - l2 * q) = Suc nat" + have "l * (l1 - l2 * q) = Suc nat" by (simp add: diff_mult_distrib2 h1 Suc [symmetric] mn ll1n ll2m [symmetric]) - ultimately show "l \ k" by (rule h3') + with ll2m show "l \ k" by (rule h3') qed ultimately show ?thesis using h1' by iprover qed @@ -56,8 +52,8 @@ extract greatest_common_divisor text \ -The extracted program for computing the greatest common divisor is -@{thm [display] greatest_common_divisor_def} + The extracted program for computing the greatest common divisor is + @{thm [display] greatest_common_divisor_def} \ instantiation nat :: default diff -r 65a9eb946ff2 -r d10eab0672f9 src/HOL/Proofs/Extraction/Higman.thy --- a/src/HOL/Proofs/Extraction/Higman.thy Fri Jul 01 10:56:54 2016 +0200 +++ b/src/HOL/Proofs/Extraction/Higman.thy Fri Jul 01 16:52:35 2016 +0200 @@ -18,43 +18,44 @@ inductive emb :: "letter list \ letter list \ bool" where - emb0 [Pure.intro]: "emb [] bs" - | emb1 [Pure.intro]: "emb as bs \ emb as (b # bs)" - | emb2 [Pure.intro]: "emb as bs \ emb (a # as) (a # bs)" + emb0 [Pure.intro]: "emb [] bs" +| emb1 [Pure.intro]: "emb as bs \ emb as (b # bs)" +| emb2 [Pure.intro]: "emb as bs \ emb (a # as) (a # bs)" inductive L :: "letter list \ letter list list \ bool" for v :: "letter list" where - L0 [Pure.intro]: "emb w v \ L v (w # ws)" - | L1 [Pure.intro]: "L v ws \ L v (w # ws)" + L0 [Pure.intro]: "emb w v \ L v (w # ws)" +| L1 [Pure.intro]: "L v ws \ L v (w # ws)" inductive good :: "letter list list \ bool" where - good0 [Pure.intro]: "L w ws \ good (w # ws)" - | good1 [Pure.intro]: "good ws \ good (w # ws)" + good0 [Pure.intro]: "L w ws \ good (w # ws)" +| good1 [Pure.intro]: "good ws \ good (w # ws)" inductive R :: "letter \ letter list list \ letter list list \ bool" for a :: letter where - R0 [Pure.intro]: "R a [] []" - | R1 [Pure.intro]: "R a vs ws \ R a (w # vs) ((a # w) # ws)" + R0 [Pure.intro]: "R a [] []" +| R1 [Pure.intro]: "R a vs ws \ R a (w # vs) ((a # w) # ws)" inductive T :: "letter \ letter list list \ letter list list \ bool" for a :: letter where - T0 [Pure.intro]: "a \ b \ R b ws zs \ T a (w # zs) ((a # w) # zs)" - | T1 [Pure.intro]: "T a ws zs \ T a (w # ws) ((a # w) # zs)" - | T2 [Pure.intro]: "a \ b \ T a ws zs \ T a ws ((b # w) # zs)" + T0 [Pure.intro]: "a \ b \ R b ws zs \ T a (w # zs) ((a # w) # zs)" +| T1 [Pure.intro]: "T a ws zs \ T a (w # ws) ((a # w) # zs)" +| T2 [Pure.intro]: "a \ b \ T a ws zs \ T a ws ((b # w) # zs)" inductive bar :: "letter list list \ bool" where - bar1 [Pure.intro]: "good ws \ bar ws" - | bar2 [Pure.intro]: "(\w. bar (w # ws)) \ bar ws" + bar1 [Pure.intro]: "good ws \ bar ws" +| bar2 [Pure.intro]: "(\w. bar (w # ws)) \ bar ws" -theorem prop1: "bar ([] # ws)" by iprover +theorem prop1: "bar ([] # ws)" + by iprover theorem lemma1: "L as ws \ L (a # as) ws" - by (erule L.induct, iprover+) + by (erule L.induct) iprover+ lemma lemma2': "R a vs ws \ L as vs \ L (a # as) ws" apply (induct set: R) @@ -123,7 +124,7 @@ apply simp done -lemma letter_neq: "(a::letter) \ b \ c \ a \ c = b" +lemma letter_neq: "a \ b \ c \ a \ c = b" for a b c :: letter apply (case_tac a) apply (case_tac b) apply (case_tac c, simp, simp) @@ -133,7 +134,7 @@ apply (case_tac c, simp, simp) done -lemma letter_eq_dec: "(a::letter) = b \ a \ b" +lemma letter_eq_dec: "a = b \ a \ b" for a b :: letter apply (case_tac a) apply (case_tac b) apply simp @@ -145,42 +146,46 @@ theorem prop2: assumes ab: "a \ b" and bar: "bar xs" - shows "\ys zs. bar ys \ T a xs zs \ T b ys zs \ bar zs" using bar + shows "\ys zs. bar ys \ T a xs zs \ T b ys zs \ bar zs" + using bar proof induct - fix xs zs assume "T a xs zs" and "good xs" - hence "good zs" by (rule lemma3) + fix xs zs + assume "T a xs zs" and "good xs" + then have "good zs" by (rule lemma3) then show "bar zs" by (rule bar1) next fix xs ys assume I: "\w ys zs. bar ys \ T a (w # xs) zs \ T b ys zs \ bar zs" assume "bar ys" - thus "\zs. T a xs zs \ T b ys zs \ bar zs" + then show "\zs. T a xs zs \ T b ys zs \ bar zs" proof induct - fix ys zs assume "T b ys zs" and "good ys" + fix ys zs + assume "T b ys zs" and "good ys" then have "good zs" by (rule lemma3) then show "bar zs" by (rule bar1) next - fix ys zs assume I': "\w zs. T a xs zs \ T b (w # ys) zs \ bar zs" - and ys: "\w. bar (w # ys)" and Ta: "T a xs zs" and Tb: "T b ys zs" + fix ys zs + assume I': "\w zs. T a xs zs \ T b (w # ys) zs \ bar zs" + and ys: "\w. bar (w # ys)" and Ta: "T a xs zs" and Tb: "T b ys zs" show "bar zs" proof (rule bar2) fix w show "bar (w # zs)" proof (cases w) case Nil - thus ?thesis by simp (rule prop1) + then show ?thesis by simp (rule prop1) next case (Cons c cs) from letter_eq_dec show ?thesis proof assume ca: "c = a" from ab have "bar ((a # cs) # zs)" by (iprover intro: I ys Ta Tb) - thus ?thesis by (simp add: Cons ca) + then show ?thesis by (simp add: Cons ca) next assume "c \ a" with ab have cb: "c = b" by (rule letter_neq) from ab have "bar ((b # cs) # zs)" by (iprover intro: I' Ta Tb) - thus ?thesis by (simp add: Cons cb) + then show ?thesis by (simp add: Cons cb) qed qed qed @@ -189,7 +194,8 @@ theorem prop3: assumes bar: "bar xs" - shows "\zs. xs \ [] \ R a xs zs \ bar zs" using bar + shows "\zs. xs \ [] \ R a xs zs \ bar zs" + using bar proof induct fix xs zs assume "R a xs zs" and "good xs" @@ -198,7 +204,7 @@ next fix xs zs assume I: "\w zs. w # xs \ [] \ R a (w # xs) zs \ bar zs" - and xsb: "\w. bar (w # xs)" and xsn: "xs \ []" and R: "R a xs zs" + and xsb: "\w. bar (w # xs)" and xsn: "xs \ []" and R: "R a xs zs" show "bar zs" proof (rule bar2) fix w @@ -211,11 +217,11 @@ from letter_eq_dec show ?case proof assume "c = a" - thus ?thesis by (iprover intro: I [simplified] R) + then show ?thesis by (iprover intro: I [simplified] R) next from R xsn have T: "T a xs zs" by (rule lemma4) assume "c \ a" - thus ?thesis by (iprover intro: prop2 Cons xsb xsn R T) + then show ?thesis by (iprover intro: prop2 Cons xsb xsn R T) qed qed qed @@ -229,58 +235,60 @@ show "bar [[]]" by (rule prop1) next fix c cs assume "bar [cs]" - thus "bar [c # cs]" by (rule prop3) (simp, iprover) + then show "bar [c # cs]" by (rule prop3) (simp, iprover) qed qed -primrec - is_prefix :: "'a list \ (nat \ 'a) \ bool" +primrec is_prefix :: "'a list \ (nat \ 'a) \ bool" where - "is_prefix [] f = True" - | "is_prefix (x # xs) f = (x = f (length xs) \ is_prefix xs f)" + "is_prefix [] f = True" +| "is_prefix (x # xs) f = (x = f (length xs) \ is_prefix xs f)" theorem L_idx: assumes L: "L w ws" - shows "is_prefix ws f \ \i. emb (f i) w \ i < length ws" using L + shows "is_prefix ws f \ \i. emb (f i) w \ i < length ws" + using L proof induct case (L0 v ws) - hence "emb (f (length ws)) w" by simp + then have "emb (f (length ws)) w" by simp moreover have "length ws < length (v # ws)" by simp ultimately show ?case by iprover next case (L1 ws v) then obtain i where emb: "emb (f i) w" and "i < length ws" by simp iprover - hence "i < length (v # ws)" by simp + then have "i < length (v # ws)" by simp with emb show ?case by iprover qed theorem good_idx: assumes good: "good ws" - shows "is_prefix ws f \ \i j. emb (f i) (f j) \ i < j" using good + shows "is_prefix ws f \ \i j. emb (f i) (f j) \ i < j" + using good proof induct case (good0 w ws) - hence "w = f (length ws)" and "is_prefix ws f" by simp_all + then have "w = f (length ws)" and "is_prefix ws f" by simp_all with good0 show ?case by (iprover dest: L_idx) next case (good1 ws w) - thus ?case by simp + then show ?case by simp qed theorem bar_idx: assumes bar: "bar ws" - shows "is_prefix ws f \ \i j. emb (f i) (f j) \ i < j" using bar + shows "is_prefix ws f \ \i j. emb (f i) (f j) \ i < j" + using bar proof induct case (bar1 ws) - thus ?case by (rule good_idx) + then show ?case by (rule good_idx) next case (bar2 ws) - hence "is_prefix (f (length ws) # ws) f" by simp - thus ?case by (rule bar2) + then have "is_prefix (f (length ws) # ws) f" by simp + then show ?case by (rule bar2) qed text \ -Strong version: yields indices of words that can be embedded into each other. + Strong version: yields indices of words that can be embedded into each other. \ theorem higman_idx: "\(i::nat) j. emb (f i) (f j) \ i < j" @@ -290,26 +298,25 @@ qed text \ -Weak version: only yield sequence containing words -that can be embedded into each other. + Weak version: only yield sequence containing words + that can be embedded into each other. \ theorem good_prefix_lemma: assumes bar: "bar ws" - shows "is_prefix ws f \ \vs. is_prefix vs f \ good vs" using bar + shows "is_prefix ws f \ \vs. is_prefix vs f \ good vs" + using bar proof induct case bar1 - thus ?case by iprover + then show ?case by iprover next case (bar2 ws) from bar2.prems have "is_prefix (f (length ws) # ws) f" by simp - thus ?case by (iprover intro: bar2) + then show ?case by (iprover intro: bar2) qed theorem good_prefix: "\vs. is_prefix vs f \ good vs" using higman by (rule good_prefix_lemma) simp+ -(*<*) end -(*>*) diff -r 65a9eb946ff2 -r d10eab0672f9 src/HOL/Proofs/Extraction/Higman_Extraction.thy --- a/src/HOL/Proofs/Extraction/Higman_Extraction.thy Fri Jul 01 10:56:54 2016 +0200 +++ b/src/HOL/Proofs/Extraction/Higman_Extraction.thy Fri Jul 01 16:52:35 2016 +0200 @@ -3,13 +3,11 @@ Author: Monika Seisenberger, LMU Muenchen *) -(*<*) +subsection \Extracting the program\ + theory Higman_Extraction imports Higman "~~/src/HOL/Library/State_Monad" Random begin -(*>*) - -subsection \Extracting the program\ declare R.induct [ind_realizer] declare T.induct [ind_realizer] @@ -48,7 +46,8 @@ end -function mk_word_aux :: "nat \ Random.seed \ letter list \ Random.seed" where +function mk_word_aux :: "nat \ Random.seed \ letter list \ Random.seed" +where "mk_word_aux k = exec { i \ Random.range 10; (if i > 7 \ k > 2 \ k > 1000 then Pair [] @@ -57,54 +56,58 @@ ls \ mk_word_aux (Suc k); Pair (l # ls) })}" -by pat_completeness auto -termination by (relation "measure ((op -) 1001)") auto + by pat_completeness auto +termination + by (relation "measure ((op -) 1001)") auto -definition mk_word :: "Random.seed \ letter list \ Random.seed" where - "mk_word = mk_word_aux 0" +definition mk_word :: "Random.seed \ letter list \ Random.seed" + where "mk_word = mk_word_aux 0" -primrec mk_word_s :: "nat \ Random.seed \ letter list \ Random.seed" where +primrec mk_word_s :: "nat \ Random.seed \ letter list \ Random.seed" +where "mk_word_s 0 = mk_word" - | "mk_word_s (Suc n) = exec { - _ \ mk_word; - mk_word_s n - }" +| "mk_word_s (Suc n) = exec { + _ \ mk_word; + mk_word_s n + }" -definition g1 :: "nat \ letter list" where - "g1 s = fst (mk_word_s s (20000, 1))" +definition g1 :: "nat \ letter list" + where "g1 s = fst (mk_word_s s (20000, 1))" -definition g2 :: "nat \ letter list" where - "g2 s = fst (mk_word_s s (50000, 1))" +definition g2 :: "nat \ letter list" + where "g2 s = fst (mk_word_s s (50000, 1))" -fun f1 :: "nat \ letter list" where +fun f1 :: "nat \ letter list" +where "f1 0 = [A, A]" - | "f1 (Suc 0) = [B]" - | "f1 (Suc (Suc 0)) = [A, B]" - | "f1 _ = []" +| "f1 (Suc 0) = [B]" +| "f1 (Suc (Suc 0)) = [A, B]" +| "f1 _ = []" -fun f2 :: "nat \ letter list" where +fun f2 :: "nat \ letter list" +where "f2 0 = [A, A]" - | "f2 (Suc 0) = [B]" - | "f2 (Suc (Suc 0)) = [B, A]" - | "f2 _ = []" +| "f2 (Suc 0) = [B]" +| "f2 (Suc (Suc 0)) = [B, A]" +| "f2 _ = []" ML_val \ -local - val higman_idx = @{code higman_idx}; - val g1 = @{code g1}; - val g2 = @{code g2}; - val f1 = @{code f1}; - val f2 = @{code f2}; -in - val (i1, j1) = higman_idx g1; - val (v1, w1) = (g1 i1, g1 j1); - val (i2, j2) = higman_idx g2; - val (v2, w2) = (g2 i2, g2 j2); - val (i3, j3) = higman_idx f1; - val (v3, w3) = (f1 i3, f1 j3); - val (i4, j4) = higman_idx f2; - val (v4, w4) = (f2 i4, f2 j4); -end; + local + val higman_idx = @{code higman_idx}; + val g1 = @{code g1}; + val g2 = @{code g2}; + val f1 = @{code f1}; + val f2 = @{code f2}; + in + val (i1, j1) = higman_idx g1; + val (v1, w1) = (g1 i1, g1 j1); + val (i2, j2) = higman_idx g2; + val (v2, w2) = (g2 i2, g2 j2); + val (i3, j3) = higman_idx f1; + val (v3, w3) = (f1 i3, f1 j3); + val (i4, j4) = higman_idx f2; + val (v4, w4) = (f2 i4, f2 j4); + end; \ end diff -r 65a9eb946ff2 -r d10eab0672f9 src/HOL/Proofs/Extraction/Pigeonhole.thy --- a/src/HOL/Proofs/Extraction/Pigeonhole.thy Fri Jul 01 10:56:54 2016 +0200 +++ b/src/HOL/Proofs/Extraction/Pigeonhole.thy Fri Jul 01 16:52:35 2016 +0200 @@ -9,131 +9,126 @@ begin text \ -We formalize two proofs of the pigeonhole principle, which lead -to extracted programs of quite different complexity. The original -formalization of these proofs in {\sc Nuprl} is due to -Aleksey Nogin @{cite "Nogin-ENTCS-2000"}. + We formalize two proofs of the pigeonhole principle, which lead + to extracted programs of quite different complexity. The original + formalization of these proofs in {\sc Nuprl} is due to + Aleksey Nogin @{cite "Nogin-ENTCS-2000"}. -This proof yields a polynomial program. + This proof yields a polynomial program. \ theorem pigeonhole: "\f. (\i. i \ Suc n \ f i \ n) \ \i j. i \ Suc n \ j < i \ f i = f j" proof (induct n) case 0 - hence "Suc 0 \ Suc 0 \ 0 < Suc 0 \ f (Suc 0) = f 0" by simp - thus ?case by iprover + then have "Suc 0 \ Suc 0 \ 0 < Suc 0 \ f (Suc 0) = f 0" by simp + then show ?case by iprover next case (Suc n) - { - fix k - have - "k \ Suc (Suc n) \ - (\i j. Suc k \ i \ i \ Suc (Suc n) \ j < i \ f i \ f j) \ - (\i j. i \ k \ j < i \ f i = f j)" - proof (induct k) - case 0 - let ?f = "\i. if f i = Suc n then f (Suc (Suc n)) else f i" - have "\ (\i j. i \ Suc n \ j < i \ ?f i = ?f j)" - proof - assume "\i j. i \ Suc n \ j < i \ ?f i = ?f j" - then obtain i j where i: "i \ Suc n" and j: "j < i" - and f: "?f i = ?f j" by iprover - from j have i_nz: "Suc 0 \ i" by simp - from i have iSSn: "i \ Suc (Suc n)" by simp - have S0SSn: "Suc 0 \ Suc (Suc n)" by simp + have r: + "k \ Suc (Suc n) \ + (\i j. Suc k \ i \ i \ Suc (Suc n) \ j < i \ f i \ f j) \ + (\i j. i \ k \ j < i \ f i = f j)" for k + proof (induct k) + case 0 + let ?f = "\i. if f i = Suc n then f (Suc (Suc n)) else f i" + have "\ (\i j. i \ Suc n \ j < i \ ?f i = ?f j)" + proof + assume "\i j. i \ Suc n \ j < i \ ?f i = ?f j" + then obtain i j where i: "i \ Suc n" and j: "j < i" and f: "?f i = ?f j" + by iprover + from j have i_nz: "Suc 0 \ i" by simp + from i have iSSn: "i \ Suc (Suc n)" by simp + have S0SSn: "Suc 0 \ Suc (Suc n)" by simp + show False + proof cases + assume fi: "f i = Suc n" + show False + proof cases + assume fj: "f j = Suc n" + from i_nz and iSSn and j have "f i \ f j" by (rule 0) + moreover from fi have "f i = f j" + by (simp add: fj [symmetric]) + ultimately show ?thesis .. + next + from i and j have "j < Suc (Suc n)" by simp + with S0SSn and le_refl have "f (Suc (Suc n)) \ f j" + by (rule 0) + moreover assume "f j \ Suc n" + with fi and f have "f (Suc (Suc n)) = f j" by simp + ultimately show False .. + qed + next + assume fi: "f i \ Suc n" show False proof cases - assume fi: "f i = Suc n" - show False - proof cases - assume fj: "f j = Suc n" - from i_nz and iSSn and j have "f i \ f j" by (rule 0) - moreover from fi have "f i = f j" - by (simp add: fj [symmetric]) - ultimately show ?thesis .. - next - from i and j have "j < Suc (Suc n)" by simp - with S0SSn and le_refl have "f (Suc (Suc n)) \ f j" - by (rule 0) - moreover assume "f j \ Suc n" - with fi and f have "f (Suc (Suc n)) = f j" by simp - ultimately show False .. + from i have "i < Suc (Suc n)" by simp + with S0SSn and le_refl have "f (Suc (Suc n)) \ f i" + by (rule 0) + moreover assume "f j = Suc n" + with fi and f have "f (Suc (Suc n)) = f i" by simp + ultimately show False .. + next + from i_nz and iSSn and j + have "f i \ f j" by (rule 0) + moreover assume "f j \ Suc n" + with fi and f have "f i = f j" by simp + ultimately show False .. + qed + qed + qed + moreover have "?f i \ n" if "i \ Suc n" for i + proof - + from that have i: "i < Suc (Suc n)" by simp + have "f (Suc (Suc n)) \ f i" + by (rule 0) (simp_all add: i) + moreover have "f (Suc (Suc n)) \ Suc n" + by (rule Suc) simp + moreover from i have "i \ Suc (Suc n)" by simp + then have "f i \ Suc n" by (rule Suc) + ultimately show ?thesis + by simp + qed + then have "\i j. i \ Suc n \ j < i \ ?f i = ?f j" + by (rule Suc) + ultimately show ?case .. + next + case (Suc k) + from search [OF nat_eq_dec] show ?case + proof + assume "\j (\ji j. i \ k \ j < i \ f i = f j" + proof (rule Suc) + from Suc show "k \ Suc (Suc n)" by simp + fix i j assume k: "Suc k \ i" and i: "i \ Suc (Suc n)" + and j: "j < i" + show "f i \ f j" + proof cases + assume eq: "i = Suc k" + show ?thesis + proof + assume "f i = f j" + then have "f (Suc k) = f j" by (simp add: eq) + with nex and j and eq show False by iprover qed next - assume fi: "f i \ Suc n" - show False - proof cases - from i have "i < Suc (Suc n)" by simp - with S0SSn and le_refl have "f (Suc (Suc n)) \ f i" - by (rule 0) - moreover assume "f j = Suc n" - with fi and f have "f (Suc (Suc n)) = f i" by simp - ultimately show False .. - next - from i_nz and iSSn and j - have "f i \ f j" by (rule 0) - moreover assume "f j \ Suc n" - with fi and f have "f i = f j" by simp - ultimately show False .. - qed + assume "i \ Suc k" + with k have "Suc (Suc k) \ i" by simp + then show ?thesis using i and j by (rule Suc) qed qed - moreover have "\i. i \ Suc n \ ?f i \ n" - proof - - fix i assume "i \ Suc n" - hence i: "i < Suc (Suc n)" by simp - have "f (Suc (Suc n)) \ f i" - by (rule 0) (simp_all add: i) - moreover have "f (Suc (Suc n)) \ Suc n" - by (rule Suc) simp - moreover from i have "i \ Suc (Suc n)" by simp - hence "f i \ Suc n" by (rule Suc) - ultimately show "?thesis i" - by simp - qed - hence "\i j. i \ Suc n \ j < i \ ?f i = ?f j" - by (rule Suc) - ultimately show ?case .. - next - case (Suc k) - from search [OF nat_eq_dec] show ?case - proof - assume "\j (\ji j. i \ k \ j < i \ f i = f j" - proof (rule Suc) - from Suc show "k \ Suc (Suc n)" by simp - fix i j assume k: "Suc k \ i" and i: "i \ Suc (Suc n)" - and j: "j < i" - show "f i \ f j" - proof cases - assume eq: "i = Suc k" - show ?thesis - proof - assume "f i = f j" - hence "f (Suc k) = f j" by (simp add: eq) - with nex and j and eq show False by iprover - qed - next - assume "i \ Suc k" - with k have "Suc (Suc k) \ i" by simp - thus ?thesis using i and j by (rule Suc) - qed - qed - thus ?thesis by (iprover intro: le_SucI) - qed + then show ?thesis by (iprover intro: le_SucI) qed - } - note r = this + qed show ?case by (rule r) simp_all qed text \ -The following proof, although quite elegant from a mathematical point of view, -leads to an exponential program: + The following proof, although quite elegant from a mathematical point of view, + leads to an exponential program: \ theorem pigeonhole_slow: @@ -149,10 +144,10 @@ from search [OF nat_eq_dec] show ?case proof assume "\j < Suc (Suc n). f (Suc (Suc n)) = f j" - thus ?case by (iprover intro: le_refl) + then show ?case by (iprover intro: le_refl) next assume "\ (\j < Suc (Suc n). f (Suc (Suc n)) = f j)" - hence nex: "\j < Suc (Suc n). f (Suc (Suc n)) \ f j" by iprover + then have nex: "\j < Suc (Suc n). f (Suc (Suc n)) \ f j" by iprover let ?f = "\i. if f i = Suc n then f (Suc (Suc n)) else f i" have "\i. i \ Suc n \ ?f i \ n" proof - @@ -171,7 +166,7 @@ with False show ?thesis by simp qed qed - hence "\i j. i \ Suc n \ j < i \ ?f i = ?f j" by (rule Suc) + then have "\i j. i \ Suc n \ j < i \ ?f i = ?f j" by (rule Suc) then obtain i j where i: "i \ Suc n" and ji: "j < i" and f: "?f i = ?f j" by iprover have "f i = f j" @@ -206,16 +201,16 @@ extract pigeonhole pigeonhole_slow text \ -The programs extracted from the above proofs look as follows: -@{thm [display] pigeonhole_def} -@{thm [display] pigeonhole_slow_def} -The program for searching for an element in an array is -@{thm [display,eta_contract=false] search_def} -The correctness statement for @{term "pigeonhole"} is -@{thm [display] pigeonhole_correctness [no_vars]} + The programs extracted from the above proofs look as follows: + @{thm [display] pigeonhole_def} + @{thm [display] pigeonhole_slow_def} + The program for searching for an element in an array is + @{thm [display,eta_contract=false] search_def} + The correctness statement for @{term "pigeonhole"} is + @{thm [display] pigeonhole_correctness [no_vars]} -In order to analyze the speed of the above programs, -we generate ML code from them. + In order to analyze the speed of the above programs, + we generate ML code from them. \ instantiation nat :: default @@ -236,14 +231,11 @@ end -definition - "test n u = pigeonhole (nat_of_integer n) (\m. m - 1)" -definition - "test' n u = pigeonhole_slow (nat_of_integer n) (\m. m - 1)" -definition - "test'' u = pigeonhole 8 (List.nth [0, 1, 2, 3, 4, 5, 6, 3, 7, 8])" +definition "test n u = pigeonhole (nat_of_integer n) (\m. m - 1)" +definition "test' n u = pigeonhole_slow (nat_of_integer n) (\m. m - 1)" +definition "test'' u = pigeonhole 8 (List.nth [0, 1, 2, 3, 4, 5, 6, 3, 7, 8])" -ML_val "timeit (@{code test} 10)" +ML_val "timeit (@{code test} 10)" ML_val "timeit (@{code test'} 10)" ML_val "timeit (@{code test} 20)" ML_val "timeit (@{code test'} 20)" diff -r 65a9eb946ff2 -r d10eab0672f9 src/HOL/Proofs/Extraction/QuotRem.thy --- a/src/HOL/Proofs/Extraction/QuotRem.thy Fri Jul 01 10:56:54 2016 +0200 +++ b/src/HOL/Proofs/Extraction/QuotRem.thy Fri Jul 01 16:52:35 2016 +0200 @@ -14,7 +14,7 @@ proof (induct a) case 0 have "0 = Suc b * 0 + 0 \ 0 \ b" by simp - thus ?case by iprover + then show ?case by iprover next case (Suc a) then obtain r q where I: "a = Suc b * q + r" and "r \ b" by iprover @@ -22,12 +22,12 @@ proof assume "r = b" with I have "Suc a = Suc b * (Suc q) + 0 \ 0 \ b" by simp - thus ?case by iprover + then show ?case by iprover next assume "r \ b" with \r \ b\ have "r < b" by (simp add: order_less_le) with I have "Suc a = Suc b * q + (Suc r) \ (Suc r) \ b" by simp - thus ?case by iprover + then show ?case by iprover qed qed diff -r 65a9eb946ff2 -r d10eab0672f9 src/HOL/Proofs/Extraction/Util.thy --- a/src/HOL/Proofs/Extraction/Util.thy Fri Jul 01 10:56:54 2016 +0200 +++ b/src/HOL/Proofs/Extraction/Util.thy Fri Jul 01 16:52:35 2016 +0200 @@ -8,9 +8,7 @@ imports "~~/src/HOL/Library/Old_Datatype" begin -text \ -Decidability of equality on natural numbers. -\ +text \Decidability of equality on natural numbers.\ lemma nat_eq_dec: "\n::nat. m = n \ m \ n" apply (induct m) @@ -20,8 +18,8 @@ done text \ -Well-founded induction on natural numbers, derived using the standard -structural induction rule. + Well-founded induction on natural numbers, derived using the standard + structural induction rule. \ lemma nat_wf_ind: @@ -31,7 +29,7 @@ show "\y. y < z \ P y" proof (induct z) case 0 - thus ?case by simp + then show ?case by simp next case (Suc n y) from nat_eq_dec show ?case @@ -43,23 +41,22 @@ next assume "n \ y" with Suc have "y < n" by simp - thus ?case by (rule Suc) + then show ?case by (rule Suc) qed qed qed -text \ -Bounded search for a natural number satisfying a decidable predicate. -\ +text \Bounded search for a natural number satisfying a decidable predicate.\ lemma search: assumes dec: "\x::nat. P x \ \ P x" shows "(\x \ (\xxx 'a \ b) \ 'a \ 'a list \ 'a \ bool" -where - "is_path' r x [] z = (r x z = T)" - | "is_path' r x (y # ys) z = (r x y = T \ is_path' r y ys z)" - -definition - is_path :: "(nat \ nat \ b) \ (nat * nat list * nat) \ - nat \ nat \ nat \ bool" +primrec is_path' :: "('a \ 'a \ b) \ 'a \ 'a list \ 'a \ bool" where - "is_path r p i j k \ fst p = j \ snd (snd p) = k \ - list_all (\x. x < i) (fst (snd p)) \ - is_path' r (fst p) (fst (snd p)) (snd (snd p))" + "is_path' r x [] z \ r x z = T" +| "is_path' r x (y # ys) z \ r x y = T \ is_path' r y ys z" -definition - conc :: "('a * 'a list * 'a) \ ('a * 'a list * 'a) \ ('a * 'a list * 'a)" -where - "conc p q = (fst p, fst (snd p) @ fst q # fst (snd q), snd (snd q))" +definition is_path :: "(nat \ nat \ b) \ (nat * nat list * nat) \ nat \ nat \ nat \ bool" + where "is_path r p i j k \ + fst p = j \ snd (snd p) = k \ + list_all (\x. x < i) (fst (snd p)) \ + is_path' r (fst p) (fst (snd p)) (snd (snd p))" -theorem is_path'_snoc [simp]: - "\x. is_path' r x (ys @ [y]) z = (is_path' r x ys y \ r y z = T)" +definition conc :: "'a \ 'a list \ 'a \ 'a \ 'a list \ 'a \ 'a \ 'a list * 'a" + where "conc p q = (fst p, fst (snd p) @ fst q # fst (snd q), snd (snd q))" + +theorem is_path'_snoc [simp]: "\x. is_path' r x (ys @ [y]) z = (is_path' r x ys y \ r y z = T)" by (induct ys) simp+ theorem list_all_scoc [simp]: "list_all P (xs @ [x]) \ P x \ list_all P xs" - by (induct xs, simp+, iprover) + by (induct xs) (simp+, iprover) -theorem list_all_lemma: - "list_all P xs \ (\x. P x \ Q x) \ list_all Q xs" +theorem list_all_lemma: "list_all P xs \ (\x. P x \ Q x) \ list_all Q xs" proof - assume PQ: "\x. P x \ Q x" show "list_all P xs \ list_all Q xs" @@ -51,7 +44,7 @@ show ?case by simp next case (Cons y ys) - hence Py: "P y" by simp + then have Py: "P y" by simp from Cons have Pys: "list_all P ys" by simp show ?case by simp (rule conjI PQ Py Cons Pys)+ @@ -59,7 +52,7 @@ qed theorem lemma1: "\p. is_path r p i j k \ is_path r p (Suc i) j k" - apply (unfold is_path_def) + unfolding is_path_def apply (simp cong add: conj_cong add: split_paired_all) apply (erule conjE)+ apply (erule list_all_lemma) @@ -67,7 +60,7 @@ done theorem lemma2: "\p. is_path r p 0 j k \ r j k = T" - apply (unfold is_path_def) + unfolding is_path_def apply (simp cong add: conj_cong add: split_paired_all) apply (case_tac "aa") apply simp+ @@ -80,11 +73,11 @@ show "\j. is_path' r j xs i \ is_path' r j (xs @ i # ys) k" proof (induct xs) case (Nil j) - hence "r j i = T" by simp + then have "r j i = T" by simp with pys show ?case by simp next case (Cons z zs j) - hence jzr: "r j z = T" by simp + then have jzr: "r j z = T" by simp from Cons have pzs: "is_path' r z zs i" by simp show ?case by simp (rule conjI jzr Cons pzs)+ @@ -93,7 +86,7 @@ theorem lemma3: "\p q. is_path r p i j i \ is_path r q i i k \ - is_path r (conc p q) (Suc i) j k" + is_path r (conc p q) (Suc i) j k" apply (unfold is_path_def conc_def) apply (simp cong add: conj_cong add: split_paired_all) apply (erule conjE)+ @@ -108,8 +101,8 @@ done theorem lemma5: - "\p. is_path r p (Suc i) j k \ ~ is_path r p i j k \ - (\q. is_path r q i j i) \ (\q'. is_path r q' i i k)" + "\p. is_path r p (Suc i) j k \ \ is_path r p i j k \ + (\q. is_path r q i j i) \ (\q'. is_path r q' i i k)" proof (simp cong add: conj_cong add: split_paired_all is_path_def, (erule conjE)+) fix xs assume asms: @@ -124,7 +117,7 @@ \ys. list_all (\x. x < i) ys \ is_path' r j ys i" (is "PROP ?ih xs") proof (induct xs) case Nil - thus ?case by simp + then show ?case by simp next case (Cons a as j) show ?case @@ -133,7 +126,7 @@ show ?thesis proof from True and Cons have "r j i = T" by simp - thus "list_all (\x. x < i) [] \ is_path' r j [] i" by simp + then show "list_all (\x. x < i) [] \ is_path' r j [] i" by simp qed next case False @@ -157,7 +150,7 @@ \ys. list_all (\x. x < i) ys \ is_path' r i ys k" (is "PROP ?ih xs") proof (induct xs rule: rev_induct) case Nil - thus ?case by simp + then show ?case by simp next case (snoc a as k) show ?case @@ -166,7 +159,7 @@ show ?thesis proof from True and snoc have "r i k = T" by simp - thus "list_all (\x. x < i) [] \ is_path' r i [] k" by simp + then show "list_all (\x. x < i) [] \ is_path' r i [] k" by simp qed next case False @@ -191,30 +184,29 @@ theorem lemma5': "\p. is_path r p (Suc i) j k \ \ is_path r p i j k \ - \ (\q. \ is_path r q i j i) \ \ (\q'. \ is_path r q' i i k)" + \ (\q. \ is_path r q i j i) \ \ (\q'. \ is_path r q' i i k)" by (iprover dest: lemma5) -theorem warshall: - "\j k. \ (\p. is_path r p i j k) \ (\p. is_path r p i j k)" +theorem warshall: "\j k. \ (\p. is_path r p i j k) \ (\p. is_path r p i j k)" proof (induct i) case (0 j k) show ?case proof (cases "r j k") assume "r j k = T" - hence "is_path r (j, [], k) 0 j k" + then have "is_path r (j, [], k) 0 j k" by (simp add: is_path_def) - hence "\p. is_path r p 0 j k" .. - thus ?thesis .. + then have "\p. is_path r p 0 j k" .. + then show ?thesis .. next assume "r j k = F" - hence "r j k ~= T" by simp - hence "\ (\p. is_path r p 0 j k)" + then have "r j k \ T" by simp + then have "\ (\p. is_path r p 0 j k)" by (iprover dest: lemma2) - thus ?thesis .. + then show ?thesis .. qed next case (Suc i j k) - thus ?case + then show ?case proof assume h1: "\ (\p. is_path r p i j k)" from Suc show ?case @@ -222,7 +214,7 @@ assume "\ (\p. is_path r p i j i)" with h1 have "\ (\p. is_path r p (Suc i) j k)" by (iprover dest: lemma5') - thus ?case .. + then show ?case .. next assume "\p. is_path r p i j i" then obtain p where h2: "is_path r p i j i" .. @@ -231,21 +223,21 @@ assume "\ (\p. is_path r p i i k)" with h1 have "\ (\p. is_path r p (Suc i) j k)" by (iprover dest: lemma5') - thus ?case .. + then show ?case .. next assume "\q. is_path r q i i k" then obtain q where "is_path r q i i k" .. with h2 have "is_path r (conc p q) (Suc i) j k" by (rule lemma3) - hence "\pq. is_path r pq (Suc i) j k" .. - thus ?case .. + then have "\pq. is_path r pq (Suc i) j k" .. + then show ?case .. qed qed next assume "\p. is_path r p i j k" - hence "\p. is_path r p (Suc i) j k" + then have "\p. is_path r p (Suc i) j k" by (iprover intro: lemma1) - thus ?case .. + then show ?case .. qed qed