src/HOL/Data_Structures/Sorted_Less.thy
author wenzelm
Tue, 23 May 2017 10:59:01 +0200
changeset 65908 aefdb9e664c9
parent 61696 ce6320b9ef9b
child 66441 b9468503742a
permissions -rw-r--r--
tuned;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
61640
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     1
(* Author: Tobias Nipkow *)
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     2
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     3
section {* Lists Sorted wrt $<$ *}
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     4
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     5
theory Sorted_Less
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     6
imports Less_False
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     7
begin
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     8
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
     9
hide_const sorted
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    10
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    11
text \<open>Is a list sorted without duplicates, i.e., wrt @{text"<"}?
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    12
Could go into theory List under a name like @{term sorted_less}.\<close>
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    13
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    14
fun sorted :: "'a::linorder list \<Rightarrow> bool" where
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    15
"sorted [] = True" |
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    16
"sorted [x] = True" |
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    17
"sorted (x#y#zs) = (x < y \<and> sorted(y#zs))"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    18
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    19
lemma sorted_Cons_iff:
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    20
  "sorted(x # xs) = (sorted xs \<and> (\<forall>y \<in> set xs. x < y))"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    21
by(induction xs rule: sorted.induct) auto
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    22
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    23
lemma sorted_snoc_iff:
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    24
  "sorted(xs @ [x]) = (sorted xs \<and> (\<forall>y \<in> set xs. y < x))"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    25
by(induction xs rule: sorted.induct) auto
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    26
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    27
lemma sorted_cons: "sorted (x#xs) \<Longrightarrow> sorted xs"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    28
by(simp add: sorted_Cons_iff)
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    29
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    30
lemma sorted_cons': "ASSUMPTION (sorted (x#xs)) \<Longrightarrow> sorted xs"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    31
by(rule ASSUMPTION_D [THEN sorted_cons])
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    32
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    33
lemma sorted_snoc: "sorted (xs @ [y]) \<Longrightarrow> sorted xs"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    34
by(simp add: sorted_snoc_iff)
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    35
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    36
lemma sorted_snoc': "ASSUMPTION (sorted (xs @ [y])) \<Longrightarrow> sorted xs"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    37
by(rule ASSUMPTION_D [THEN sorted_snoc])
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    38
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    39
lemma sorted_mid_iff:
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    40
  "sorted(xs @ y # ys) = (sorted(xs @ [y]) \<and> sorted(y # ys))"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    41
by(induction xs rule: sorted.induct) auto
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    42
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    43
lemma sorted_mid_iff2:
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    44
  "sorted(x # xs @ y # ys) =
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    45
  (sorted(x # xs) \<and> x < y \<and> sorted(xs @ [y]) \<and> sorted(y # ys))"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    46
by(induction xs rule: sorted.induct) auto
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    47
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    48
lemma sorted_mid_iff': "NO_MATCH [] ys \<Longrightarrow>
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    49
  sorted(xs @ y # ys) = (sorted(xs @ [y]) \<and> sorted(y # ys))"
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    50
by(rule sorted_mid_iff)
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    51
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    52
lemmas sorted_lems = sorted_mid_iff' sorted_mid_iff2 sorted_cons' sorted_snoc'
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    53
61696
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    54
text\<open>Splay trees need two additional @{const sorted} lemmas:\<close>
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    55
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    56
lemma sorted_snoc_le:
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    57
  "ASSUMPTION(sorted(xs @ [x])) \<Longrightarrow> x \<le> y \<Longrightarrow> sorted (xs @ [y])"
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    58
by (auto simp add: Sorted_Less.sorted_snoc_iff ASSUMPTION_def)
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    59
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    60
lemma sorted_Cons_le:
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    61
  "ASSUMPTION(sorted(x # xs)) \<Longrightarrow> y \<le> x \<Longrightarrow> sorted (y # xs)"
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    62
by (auto simp add: Sorted_Less.sorted_Cons_iff ASSUMPTION_def)
ce6320b9ef9b moved lemmas
nipkow
parents: 61640
diff changeset
    63
61640
44c9198f210c no CRLF
nipkow
parents: 61203
diff changeset
    64
end