5388 apply (induct_tac x, rule allI) |
5388 apply (induct_tac x, rule allI) |
5389 apply (case_tac x, simp, simp) |
5389 apply (case_tac x, simp, simp) |
5390 apply (rule allI, case_tac x, simp, simp) |
5390 apply (rule allI, case_tac x, simp, simp) |
5391 by blast |
5391 by blast |
5392 |
5392 |
|
5393 text {* |
|
5394 Predicate version of lexicographic order integrated with Isabelle's order type classes. |
|
5395 Author: Andreas Lochbihler |
|
5396 *} |
|
5397 |
|
5398 thm not_less |
|
5399 context ord begin |
|
5400 |
|
5401 inductive lexordp :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" |
|
5402 where |
|
5403 Nil: "lexordp [] (y # ys)" |
|
5404 | Cons: "x < y \<Longrightarrow> lexordp (x # xs) (y # ys)" |
|
5405 | Cons_eq: |
|
5406 "\<lbrakk> \<not> x < y; \<not> y < x; lexordp xs ys \<rbrakk> \<Longrightarrow> lexordp (x # xs) (y # ys)" |
|
5407 |
|
5408 lemma lexordp_simps [simp]: |
|
5409 "lexordp [] ys = (ys \<noteq> [])" |
|
5410 "lexordp xs [] = False" |
|
5411 "lexordp (x # xs) (y # ys) \<longleftrightarrow> x < y \<or> \<not> y < x \<and> lexordp xs ys" |
|
5412 by(subst lexordp.simps, fastforce simp add: neq_Nil_conv)+ |
|
5413 |
|
5414 inductive lexordp_eq :: "'a list \<Rightarrow> 'a list \<Rightarrow> bool" where |
|
5415 Nil: "lexordp_eq [] ys" |
|
5416 | Cons: "x < y \<Longrightarrow> lexordp_eq (x # xs) (y # ys)" |
|
5417 | Cons_eq: "\<lbrakk> \<not> x < y; \<not> y < x; lexordp_eq xs ys \<rbrakk> \<Longrightarrow> lexordp_eq (x # xs) (y # ys)" |
|
5418 |
|
5419 lemma lexordp_eq_simps [simp]: |
|
5420 "lexordp_eq [] ys = True" |
|
5421 "lexordp_eq xs [] \<longleftrightarrow> xs = []" |
|
5422 "lexordp_eq (x # xs) [] = False" |
|
5423 "lexordp_eq (x # xs) (y # ys) \<longleftrightarrow> x < y \<or> \<not> y < x \<and> lexordp_eq xs ys" |
|
5424 by(subst lexordp_eq.simps, fastforce)+ |
|
5425 |
|
5426 lemma lexordp_append_rightI: "ys \<noteq> Nil \<Longrightarrow> lexordp xs (xs @ ys)" |
|
5427 by(induct xs)(auto simp add: neq_Nil_conv) |
|
5428 |
|
5429 lemma lexordp_append_left_rightI: "x < y \<Longrightarrow> lexordp (us @ x # xs) (us @ y # ys)" |
|
5430 by(induct us) auto |
|
5431 |
|
5432 lemma lexordp_eq_refl: "lexordp_eq xs xs" |
|
5433 by(induct xs) simp_all |
|
5434 |
|
5435 lemma lexordp_append_leftI: "lexordp us vs \<Longrightarrow> lexordp (xs @ us) (xs @ vs)" |
|
5436 by(induct xs) auto |
|
5437 |
|
5438 lemma lexordp_append_leftD: "\<lbrakk> lexordp (xs @ us) (xs @ vs); \<forall>a. \<not> a < a \<rbrakk> \<Longrightarrow> lexordp us vs" |
|
5439 by(induct xs) auto |
|
5440 |
|
5441 lemma lexordp_irreflexive: |
|
5442 assumes irrefl: "\<forall>x. \<not> x < x" |
|
5443 shows "\<not> lexordp xs xs" |
|
5444 proof |
|
5445 assume "lexordp xs xs" |
|
5446 thus False by(induct xs ys\<equiv>xs)(simp_all add: irrefl) |
|
5447 qed |
|
5448 |
|
5449 lemma lexordp_into_lexordp_eq: |
|
5450 assumes "lexordp xs ys" |
|
5451 shows "lexordp_eq xs ys" |
|
5452 using assms by induct simp_all |
|
5453 |
|
5454 end |
|
5455 |
|
5456 declare ord.lexordp_simps [simp, code] |
|
5457 declare ord.lexordp_eq_simps [code, simp] |
|
5458 |
|
5459 lemma lexord_code [code, code_unfold]: "lexordp = ord.lexordp less" |
|
5460 unfolding lexordp_def ord.lexordp_def .. |
|
5461 |
|
5462 context order begin |
|
5463 |
|
5464 lemma lexordp_antisym: |
|
5465 assumes "lexordp xs ys" "lexordp ys xs" |
|
5466 shows False |
|
5467 using assms by induct auto |
|
5468 |
|
5469 lemma lexordp_irreflexive': "\<not> lexordp xs xs" |
|
5470 by(rule lexordp_irreflexive) simp |
|
5471 |
|
5472 end |
|
5473 |
|
5474 context linorder begin |
|
5475 |
|
5476 lemma lexordp_cases [consumes 1, case_names Nil Cons Cons_eq, cases pred: lexordp]: |
|
5477 assumes "lexordp xs ys" |
|
5478 obtains (Nil) y ys' where "xs = []" "ys = y # ys'" |
|
5479 | (Cons) x xs' y ys' where "xs = x # xs'" "ys = y # ys'" "x < y" |
|
5480 | (Cons_eq) x xs' ys' where "xs = x # xs'" "ys = x # ys'" "lexordp xs' ys'" |
|
5481 using assms by cases (fastforce simp add: not_less_iff_gr_or_eq)+ |
|
5482 |
|
5483 lemma lexordp_induct [consumes 1, case_names Nil Cons Cons_eq, induct pred: lexordp]: |
|
5484 assumes major: "lexordp xs ys" |
|
5485 and Nil: "\<And>y ys. P [] (y # ys)" |
|
5486 and Cons: "\<And>x xs y ys. x < y \<Longrightarrow> P (x # xs) (y # ys)" |
|
5487 and Cons_eq: "\<And>x xs ys. \<lbrakk> lexordp xs ys; P xs ys \<rbrakk> \<Longrightarrow> P (x # xs) (x # ys)" |
|
5488 shows "P xs ys" |
|
5489 using major by induct (simp_all add: Nil Cons not_less_iff_gr_or_eq Cons_eq) |
|
5490 |
|
5491 lemma lexordp_iff: |
|
5492 "lexordp xs ys \<longleftrightarrow> (\<exists>x vs. ys = xs @ x # vs) \<or> (\<exists>us a b vs ws. a < b \<and> xs = us @ a # vs \<and> ys = us @ b # ws)" |
|
5493 (is "?lhs = ?rhs") |
|
5494 proof |
|
5495 assume ?lhs thus ?rhs |
|
5496 proof induct |
|
5497 case Cons_eq thus ?case by simp (metis append.simps(2)) |
|
5498 qed(fastforce intro: disjI2 del: disjCI intro: exI[where x="[]"])+ |
|
5499 next |
|
5500 assume ?rhs thus ?lhs |
|
5501 by(auto intro: lexordp_append_leftI[where us="[]", simplified] lexordp_append_leftI) |
|
5502 qed |
|
5503 |
|
5504 lemma lexordp_conv_lexord: |
|
5505 "lexordp xs ys \<longleftrightarrow> (xs, ys) \<in> lexord {(x, y). x < y}" |
|
5506 by(simp add: lexordp_iff lexord_def) |
|
5507 |
|
5508 lemma lexordp_eq_antisym: |
|
5509 assumes "lexordp_eq xs ys" "lexordp_eq ys xs" |
|
5510 shows "xs = ys" |
|
5511 using assms by induct simp_all |
|
5512 |
|
5513 lemma lexordp_eq_trans: |
|
5514 assumes "lexordp_eq xs ys" and "lexordp_eq ys zs" |
|
5515 shows "lexordp_eq xs zs" |
|
5516 using assms |
|
5517 apply(induct arbitrary: zs) |
|
5518 apply(case_tac [2-3] zs) |
|
5519 apply auto |
|
5520 done |
|
5521 |
|
5522 lemma lexordp_trans: |
|
5523 assumes "lexordp xs ys" "lexordp ys zs" |
|
5524 shows "lexordp xs zs" |
|
5525 using assms |
|
5526 apply(induct arbitrary: zs) |
|
5527 apply(case_tac [2-3] zs) |
|
5528 apply auto |
|
5529 done |
|
5530 |
|
5531 lemma lexordp_linear: "lexordp xs ys \<or> xs = ys \<or> lexordp ys xs" |
|
5532 proof(induct xs arbitrary: ys) |
|
5533 case Nil thus ?case by(cases ys) simp_all |
|
5534 next |
|
5535 case Cons thus ?case by(cases ys) auto |
|
5536 qed |
|
5537 |
|
5538 lemma lexordp_conv_lexordp_eq: "lexordp xs ys \<longleftrightarrow> lexordp_eq xs ys \<and> \<not> lexordp_eq ys xs" |
|
5539 (is "?lhs \<longleftrightarrow> ?rhs") |
|
5540 proof |
|
5541 assume ?lhs |
|
5542 moreover hence "\<not> lexordp_eq ys xs" by induct simp_all |
|
5543 ultimately show ?rhs by(simp add: lexordp_into_lexordp_eq) |
|
5544 next |
|
5545 assume ?rhs |
|
5546 hence "lexordp_eq xs ys" "\<not> lexordp_eq ys xs" by simp_all |
|
5547 thus ?lhs by induct simp_all |
|
5548 qed |
|
5549 |
|
5550 lemma lexordp_eq_conv_lexord: "lexordp_eq xs ys \<longleftrightarrow> xs = ys \<or> lexordp xs ys" |
|
5551 by(auto simp add: lexordp_conv_lexordp_eq lexordp_eq_refl dest: lexordp_eq_antisym) |
|
5552 |
|
5553 lemma lexordp_eq_linear: "lexordp_eq xs ys \<or> lexordp_eq ys xs" |
|
5554 apply(induct xs arbitrary: ys) |
|
5555 apply(case_tac [!] ys) |
|
5556 apply auto |
|
5557 done |
|
5558 |
|
5559 lemma lexordp_linorder: "class.linorder lexordp_eq lexordp" |
|
5560 by unfold_locales(auto simp add: lexordp_conv_lexordp_eq lexordp_eq_refl lexordp_eq_antisym intro: lexordp_eq_trans del: disjCI intro: lexordp_eq_linear) |
|
5561 |
|
5562 end |
5393 |
5563 |
5394 subsubsection {* Lexicographic combination of measure functions *} |
5564 subsubsection {* Lexicographic combination of measure functions *} |
5395 |
5565 |
5396 text {* These are useful for termination proofs *} |
5566 text {* These are useful for termination proofs *} |
5397 |
5567 |