src/HOL/List.thy
author haftmann
Thu, 17 Jun 2010 16:15:15 +0200
changeset 37451 3058c918e7a3
parent 37424 ed431cc99f17
child 37455 059ee3176686
child 37457 7201c7e0db87
permissions -rw-r--r--
rev is reverse in Haskell
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
     1
(*  Title:      HOL/List.thy
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
     2
    Author:     Tobias Nipkow
923
ff1574a81019 new version of HOL with curried function application
clasohm
parents:
diff changeset
     3
*)
ff1574a81019 new version of HOL with curried function application
clasohm
parents:
diff changeset
     4
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
     5
header {* The datatype of finite lists *}
13122
wenzelm
parents: 13114
diff changeset
     6
15131
c69542757a4d New theory header syntax.
nipkow
parents: 15113
diff changeset
     7
theory List
35827
f552152d7747 renamed "ATP_Linkup" theory to "Sledgehammer"
blanchet
parents: 35608
diff changeset
     8
imports Plain Presburger Sledgehammer Recdef
31055
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
     9
uses ("Tools/list_code.ML")
15131
c69542757a4d New theory header syntax.
nipkow
parents: 15113
diff changeset
    10
begin
923
ff1574a81019 new version of HOL with curried function application
clasohm
parents:
diff changeset
    11
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
    12
datatype 'a list =
13366
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
    13
    Nil    ("[]")
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
    14
  | Cons 'a  "'a list"    (infixr "#" 65)
923
ff1574a81019 new version of HOL with curried function application
clasohm
parents:
diff changeset
    15
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    16
syntax
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    17
  -- {* list Enumeration *}
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
    18
  "_list" :: "args => 'a list"    ("[(_)]")
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    19
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    20
translations
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    21
  "[x, xs]" == "x#[xs]"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    22
  "[x]" == "x#[]"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    23
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
    24
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
    25
subsection {* Basic list processing functions *}
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
    26
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    27
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    28
  hd :: "'a list \<Rightarrow> 'a" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    29
  "hd (x # xs) = x"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    30
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    31
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    32
  tl :: "'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    33
    "tl [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    34
  | "tl (x # xs) = xs"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    35
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    36
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    37
  last :: "'a list \<Rightarrow> 'a" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    38
  "last (x # xs) = (if xs = [] then x else last xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    39
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    40
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    41
  butlast :: "'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    42
    "butlast []= []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    43
  | "butlast (x # xs) = (if xs = [] then [] else x # butlast xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    44
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    45
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    46
  set :: "'a list \<Rightarrow> 'a set" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    47
    "set [] = {}"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    48
  | "set (x # xs) = insert x (set xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    49
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    50
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    51
  map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    52
    "map f [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    53
  | "map f (x # xs) = f x # map f xs"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    54
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    55
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    56
  append :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixr "@" 65) where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    57
    append_Nil:"[] @ ys = ys"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    58
  | append_Cons: "(x#xs) @ ys = x # xs @ ys"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    59
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    60
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    61
  rev :: "'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    62
    "rev [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    63
  | "rev (x # xs) = rev xs @ [x]"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    64
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    65
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    66
  filter:: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    67
    "filter P [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    68
  | "filter P (x # xs) = (if P x then x # filter P xs else filter P xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    69
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    70
syntax
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    71
  -- {* Special syntax for filter *}
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
    72
  "_filter" :: "[pttrn, 'a list, bool] => 'a list"    ("(1[_<-_./ _])")
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    73
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    74
translations
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    75
  "[x<-xs . P]"== "CONST filter (%x. P) xs"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    76
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    77
syntax (xsymbols)
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
    78
  "_filter" :: "[pttrn, 'a list, bool] => 'a list"("(1[_\<leftarrow>_ ./ _])")
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    79
syntax (HTML output)
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
    80
  "_filter" :: "[pttrn, 'a list, bool] => 'a list"("(1[_\<leftarrow>_ ./ _])")
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    81
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    82
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    83
  foldl :: "('b \<Rightarrow> 'a \<Rightarrow> 'b) \<Rightarrow> 'b \<Rightarrow> 'a list \<Rightarrow> 'b" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    84
    foldl_Nil: "foldl f a [] = a"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    85
  | foldl_Cons: "foldl f a (x # xs) = foldl f (f a x) xs"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    86
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    87
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    88
  foldr :: "('a \<Rightarrow> 'b \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> 'b \<Rightarrow> 'b" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    89
    "foldr f [] a = a"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    90
  | "foldr f (x # xs) a = f x (foldr f xs a)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    91
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    92
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    93
  concat:: "'a list list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    94
    "concat [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    95
  | "concat (x # xs) = x @ concat xs"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    96
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    97
primrec (in monoid_add)
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    98
  listsum :: "'a list \<Rightarrow> 'a" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
    99
    "listsum [] = 0"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   100
  | "listsum (x # xs) = x + listsum xs"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   101
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   102
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   103
  drop:: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   104
    drop_Nil: "drop n [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   105
  | drop_Cons: "drop n (x # xs) = (case n of 0 \<Rightarrow> x # xs | Suc m \<Rightarrow> drop m xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   106
  -- {*Warning: simpset does not contain this definition, but separate
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   107
       theorems for @{text "n = 0"} and @{text "n = Suc k"} *}
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   108
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   109
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   110
  take:: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   111
    take_Nil:"take n [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   112
  | take_Cons: "take n (x # xs) = (case n of 0 \<Rightarrow> [] | Suc m \<Rightarrow> x # take m xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   113
  -- {*Warning: simpset does not contain this definition, but separate
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   114
       theorems for @{text "n = 0"} and @{text "n = Suc k"} *}
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   115
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   116
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   117
  nth :: "'a list => nat => 'a" (infixl "!" 100) where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   118
  nth_Cons: "(x # xs) ! n = (case n of 0 \<Rightarrow> x | Suc k \<Rightarrow> xs ! k)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   119
  -- {*Warning: simpset does not contain this definition, but separate
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   120
       theorems for @{text "n = 0"} and @{text "n = Suc k"} *}
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   121
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   122
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   123
  list_update :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   124
    "list_update [] i v = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   125
  | "list_update (x # xs) i v = (case i of 0 \<Rightarrow> v # xs | Suc j \<Rightarrow> x # list_update xs j v)"
923
ff1574a81019 new version of HOL with curried function application
clasohm
parents:
diff changeset
   126
13146
f43153b63361 *** empty log message ***
nipkow
parents: 13145
diff changeset
   127
nonterminals lupdbinds lupdbind
5077
71043526295f * HOL/List: new function list_update written xs[i:=v] that updates the i-th
nipkow
parents: 4643
diff changeset
   128
923
ff1574a81019 new version of HOL with curried function application
clasohm
parents:
diff changeset
   129
syntax
13366
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   130
  "_lupdbind":: "['a, 'a] => lupdbind"    ("(2_ :=/ _)")
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   131
  "" :: "lupdbind => lupdbinds"    ("_")
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   132
  "_lupdbinds" :: "[lupdbind, lupdbinds] => lupdbinds"    ("_,/ _")
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   133
  "_LUpdate" :: "['a, lupdbinds] => 'a"    ("_/[(_)]" [900,0] 900)
5077
71043526295f * HOL/List: new function list_update written xs[i:=v] that updates the i-th
nipkow
parents: 4643
diff changeset
   134
923
ff1574a81019 new version of HOL with curried function application
clasohm
parents:
diff changeset
   135
translations
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   136
  "_LUpdate xs (_lupdbinds b bs)" == "_LUpdate (_LUpdate xs b) bs"
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   137
  "xs[i:=x]" == "CONST list_update xs i x"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   138
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   139
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   140
  takeWhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   141
    "takeWhile P [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   142
  | "takeWhile P (x # xs) = (if P x then x # takeWhile P xs else [])"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   143
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   144
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   145
  dropWhile :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   146
    "dropWhile P [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   147
  | "dropWhile P (x # xs) = (if P x then dropWhile P xs else x # xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   148
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   149
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   150
  zip :: "'a list \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   151
    "zip xs [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   152
  | zip_Cons: "zip xs (y # ys) = (case xs of [] => [] | z # zs => (z, y) # zip zs ys)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   153
  -- {*Warning: simpset does not contain this definition, but separate
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   154
       theorems for @{text "xs = []"} and @{text "xs = z # zs"} *}
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   155
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   156
primrec 
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   157
  upt :: "nat \<Rightarrow> nat \<Rightarrow> nat list" ("(1[_..</_'])") where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   158
    upt_0: "[i..<0] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   159
  | upt_Suc: "[i..<(Suc j)] = (if i <= j then [i..<j] @ [j] else [])"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   160
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   161
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   162
  distinct :: "'a list \<Rightarrow> bool" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   163
    "distinct [] \<longleftrightarrow> True"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   164
  | "distinct (x # xs) \<longleftrightarrow> x \<notin> set xs \<and> distinct xs"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   165
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   166
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   167
  remdups :: "'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   168
    "remdups [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   169
  | "remdups (x # xs) = (if x \<in> set xs then remdups xs else x # remdups xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   170
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
   171
definition
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
   172
  insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
   173
  "insert x xs = (if x \<in> set xs then xs else x # xs)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
   174
36176
3fe7e97ccca8 replaced generic 'hide' command by more conventional 'hide_class', 'hide_type', 'hide_const', 'hide_fact' -- frees some popular keywords;
wenzelm
parents: 36154
diff changeset
   175
hide_const (open) insert
3fe7e97ccca8 replaced generic 'hide' command by more conventional 'hide_class', 'hide_type', 'hide_const', 'hide_fact' -- frees some popular keywords;
wenzelm
parents: 36154
diff changeset
   176
hide_fact (open) insert_def
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
   177
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   178
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   179
  remove1 :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   180
    "remove1 x [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   181
  | "remove1 x (y # xs) = (if x = y then xs else y # remove1 x xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   182
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   183
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   184
  removeAll :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   185
    "removeAll x [] = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   186
  | "removeAll x (y # xs) = (if x = y then removeAll x xs else y # removeAll x xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   187
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   188
primrec
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   189
  replicate :: "nat \<Rightarrow> 'a \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   190
    replicate_0: "replicate 0 x = []"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   191
  | replicate_Suc: "replicate (Suc n) x = x # replicate n x"
3342
ec3b55fcb165 New operator "lists" for formalizing sets of lists
paulson
parents: 3320
diff changeset
   192
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   193
text {*
14589
feae7b5fd425 tuned document;
wenzelm
parents: 14565
diff changeset
   194
  Function @{text size} is overloaded for all datatypes. Users may
13366
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   195
  refer to the list version as @{text length}. *}
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   196
19363
667b5ea637dd refined 'abbreviation';
wenzelm
parents: 19302
diff changeset
   197
abbreviation
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   198
  length :: "'a list \<Rightarrow> nat" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   199
  "length \<equiv> size"
15307
10dd989282fd indentation
paulson
parents: 15305
diff changeset
   200
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   201
definition
21404
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   202
  rotate1 :: "'a list \<Rightarrow> 'a list" where
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   203
  "rotate1 xs = (case xs of [] \<Rightarrow> [] | x#xs \<Rightarrow> xs @ [x])"
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   204
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   205
definition
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   206
  rotate :: "nat \<Rightarrow> 'a list \<Rightarrow> 'a list" where
30971
7fbebf75b3ef funpow and relpow with shared "^^" syntax
haftmann
parents: 30952
diff changeset
   207
  "rotate n = rotate1 ^^ n"
21404
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   208
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   209
definition
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   210
  list_all2 :: "('a => 'b => bool) => 'a list => 'b list => bool" where
28562
4e74209f113e `code func` now just `code`
haftmann
parents: 28537
diff changeset
   211
  [code del]: "list_all2 P xs ys =
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   212
    (length xs = length ys \<and> (\<forall>(x, y) \<in> set (zip xs ys). P x y))"
21404
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   213
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   214
definition
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   215
  sublist :: "'a list => nat set => 'a list" where
eb85850d3eb7 more robust syntax for definition/abbreviation/notation;
wenzelm
parents: 21211
diff changeset
   216
  "sublist xs A = map fst (filter (\<lambda>p. snd p \<in> A) (zip xs [0..<size xs]))"
17086
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
   217
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
   218
primrec
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   219
  splice :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   220
    "splice [] ys = ys"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
   221
  | "splice (x # xs) ys = (if ys = [] then x # xs else x # hd ys # splice xs (tl ys))"
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   222
    -- {*Warning: simpset does not contain the second eqn but a derived one. *}
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   223
26771
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   224
text{*
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   225
\begin{figure}[htbp]
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   226
\fbox{
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   227
\begin{tabular}{l}
27381
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   228
@{lemma "[a,b]@[c,d] = [a,b,c,d]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   229
@{lemma "length [a,b,c] = 3" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   230
@{lemma "set [a,b,c] = {a,b,c}" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   231
@{lemma "map f [a,b,c] = [f a, f b, f c]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   232
@{lemma "rev [a,b,c] = [c,b,a]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   233
@{lemma "hd [a,b,c,d] = a" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   234
@{lemma "tl [a,b,c,d] = [b,c,d]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   235
@{lemma "last [a,b,c,d] = d" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   236
@{lemma "butlast [a,b,c,d] = [a,b,c]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   237
@{lemma[source] "filter (\<lambda>n::nat. n<2) [0,2,1] = [0,1]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   238
@{lemma "concat [[a,b],[c,d,e],[],[f]] = [a,b,c,d,e,f]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   239
@{lemma "foldl f x [a,b,c] = f (f (f x a) b) c" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   240
@{lemma "foldr f [a,b,c] x = f a (f b (f c x))" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   241
@{lemma "zip [a,b,c] [x,y,z] = [(a,x),(b,y),(c,z)]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   242
@{lemma "zip [a,b] [x,y,z] = [(a,x),(b,y)]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   243
@{lemma "splice [a,b,c] [x,y,z] = [a,x,b,y,c,z]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   244
@{lemma "splice [a,b,c,d] [x,y] = [a,x,b,y,c,d]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   245
@{lemma "take 2 [a,b,c,d] = [a,b]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   246
@{lemma "take 6 [a,b,c,d] = [a,b,c,d]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   247
@{lemma "drop 2 [a,b,c,d] = [c,d]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   248
@{lemma "drop 6 [a,b,c,d] = []" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   249
@{lemma "takeWhile (%n::nat. n<3) [1,2,3,0] = [1,2]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   250
@{lemma "dropWhile (%n::nat. n<3) [1,2,3,0] = [3,0]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   251
@{lemma "distinct [2,0,1::nat]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   252
@{lemma "remdups [2,0,2,1::nat,2] = [0,1,2]" by simp}\\
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
   253
@{lemma "List.insert 2 [0::nat,1,2] = [0,1,2]" by (simp add: List.insert_def)}\\
35295
397295fa8387 lemma distinct_insert
haftmann
parents: 35248
diff changeset
   254
@{lemma "List.insert 3 [0::nat,1,2] = [3,0,1,2]" by (simp add: List.insert_def)}\\
27381
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   255
@{lemma "remove1 2 [2,0,2,1::nat,2] = [0,2,1,2]" by simp}\\
27693
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
   256
@{lemma "removeAll 2 [2,0,2,1::nat,2] = [0,1]" by simp}\\
27381
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   257
@{lemma "nth [a,b,c,d] 2 = c" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   258
@{lemma "[a,b,c,d][2 := x] = [a,b,x,d]" by simp}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   259
@{lemma "sublist [a,b,c,d,e] {0,2,3} = [a,c,d]" by (simp add:sublist_def)}\\
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   260
@{lemma "rotate1 [a,b,c,d] = [b,c,d,a]" by (simp add:rotate1_def)}\\
35216
7641e8d831d2 get rid of many duplicate simp rule warnings
huffman
parents: 35115
diff changeset
   261
@{lemma "rotate 3 [a,b,c,d] = [d,a,b,c]" by (simp add:rotate1_def rotate_def nat_number')}\\
7641e8d831d2 get rid of many duplicate simp rule warnings
huffman
parents: 35115
diff changeset
   262
@{lemma "replicate 4 a = [a,a,a,a]" by (simp add:nat_number')}\\
7641e8d831d2 get rid of many duplicate simp rule warnings
huffman
parents: 35115
diff changeset
   263
@{lemma "[2..<5] = [2,3,4]" by (simp add:nat_number')}\\
27381
19ae7064f00f @{lemma}: 'by' keyword;
wenzelm
parents: 27368
diff changeset
   264
@{lemma "listsum [1,2,3::nat] = 6" by simp}
26771
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   265
\end{tabular}}
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   266
\caption{Characteristic examples}
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   267
\label{fig:Characteristic}
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   268
\end{figure}
29927
ae8f42c245b2 Added nitpick attribute, and fixed typo.
blanchet
parents: 29856
diff changeset
   269
Figure~\ref{fig:Characteristic} shows characteristic examples
26771
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   270
that should give an intuitive understanding of the above functions.
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   271
*}
1d67ab20f358 Added documentation
nipkow
parents: 26749
diff changeset
   272
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
   273
text{* The following simple sort functions are intended for proofs,
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
   274
not for efficient implementations. *}
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
   275
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   276
context linorder
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   277
begin
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   278
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   279
fun sorted :: "'a list \<Rightarrow> bool" where
24697
b37d3980da3c fixed haftmann bug
nipkow
parents: 24657
diff changeset
   280
"sorted [] \<longleftrightarrow> True" |
b37d3980da3c fixed haftmann bug
nipkow
parents: 24657
diff changeset
   281
"sorted [x] \<longleftrightarrow> True" |
25062
af5ef0d4d655 global class syntax
haftmann
parents: 24902
diff changeset
   282
"sorted (x#y#zs) \<longleftrightarrow> x <= y \<and> sorted (y#zs)"
24697
b37d3980da3c fixed haftmann bug
nipkow
parents: 24657
diff changeset
   283
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   284
primrec insort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b \<Rightarrow> 'b list \<Rightarrow> 'b list" where
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   285
"insort_key f x [] = [x]" |
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   286
"insort_key f x (y#ys) = (if f x \<le> f y then (x#y#ys) else y#(insort_key f x ys))"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   287
35195
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
   288
definition sort_key :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b list \<Rightarrow> 'b list" where
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
   289
"sort_key f xs = foldr (insort_key f) xs []"
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   290
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   291
abbreviation "sort \<equiv> sort_key (\<lambda>x. x)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   292
abbreviation "insort \<equiv> insort_key (\<lambda>x. x)"
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
   293
35608
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
   294
definition insort_insert :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
   295
  "insort_insert x xs = (if x \<in> set xs then xs else insort x xs)"
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
   296
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   297
end
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   298
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
   299
23388
77645da0db85 tuned proofs: avoid implicit prems;
wenzelm
parents: 23279
diff changeset
   300
subsubsection {* List comprehension *}
23192
ec73b9707d48 Moved list comprehension into List
nipkow
parents: 23096
diff changeset
   301
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   302
text{* Input syntax for Haskell-like list comprehension notation.
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   303
Typical example: @{text"[(x,y). x \<leftarrow> xs, y \<leftarrow> ys, x \<noteq> y]"},
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   304
the list of all pairs of distinct elements from @{text xs} and @{text ys}.
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   305
The syntax is as in Haskell, except that @{text"|"} becomes a dot
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   306
(like in Isabelle's set comprehension): @{text"[e. x \<leftarrow> xs, \<dots>]"} rather than
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   307
\verb![e| x <- xs, ...]!.
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   308
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   309
The qualifiers after the dot are
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   310
\begin{description}
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   311
\item[generators] @{text"p \<leftarrow> xs"},
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   312
 where @{text p} is a pattern and @{text xs} an expression of list type, or
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   313
\item[guards] @{text"b"}, where @{text b} is a boolean expression.
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   314
%\item[local bindings] @ {text"let x = e"}.
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   315
\end{description}
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   316
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   317
Just like in Haskell, list comprehension is just a shorthand. To avoid
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   318
misunderstandings, the translation into desugared form is not reversed
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   319
upon output. Note that the translation of @{text"[e. x \<leftarrow> xs]"} is
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   320
optmized to @{term"map (%x. e) xs"}.
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   321
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   322
It is easy to write short list comprehensions which stand for complex
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   323
expressions. During proofs, they may become unreadable (and
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   324
mangled). In such cases it can be advisable to introduce separate
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   325
definitions for the list comprehensions in question.  *}
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   326
23209
098a23702aba *** empty log message ***
nipkow
parents: 23192
diff changeset
   327
(*
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   328
Proper theorem proving support would be nice. For example, if
23192
ec73b9707d48 Moved list comprehension into List
nipkow
parents: 23096
diff changeset
   329
@{text"set[f x y. x \<leftarrow> xs, y \<leftarrow> ys, P x y]"}
ec73b9707d48 Moved list comprehension into List
nipkow
parents: 23096
diff changeset
   330
produced something like
23209
098a23702aba *** empty log message ***
nipkow
parents: 23192
diff changeset
   331
@{term"{z. EX x: set xs. EX y:set ys. P x y \<and> z = f x y}"}.
098a23702aba *** empty log message ***
nipkow
parents: 23192
diff changeset
   332
*)
098a23702aba *** empty log message ***
nipkow
parents: 23192
diff changeset
   333
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   334
nonterminals lc_qual lc_quals
23192
ec73b9707d48 Moved list comprehension into List
nipkow
parents: 23096
diff changeset
   335
ec73b9707d48 Moved list comprehension into List
nipkow
parents: 23096
diff changeset
   336
syntax
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   337
"_listcompr" :: "'a \<Rightarrow> lc_qual \<Rightarrow> lc_quals \<Rightarrow> 'a list"  ("[_ . __")
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   338
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ <- _")
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   339
"_lc_test" :: "bool \<Rightarrow> lc_qual" ("_")
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   340
(*"_lc_let" :: "letbinds => lc_qual"  ("let _")*)
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   341
"_lc_end" :: "lc_quals" ("]")
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   342
"_lc_quals" :: "lc_qual \<Rightarrow> lc_quals \<Rightarrow> lc_quals" (", __")
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   343
"_lc_abs" :: "'a => 'b list => 'b list"
23192
ec73b9707d48 Moved list comprehension into List
nipkow
parents: 23096
diff changeset
   344
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   345
(* These are easier than ML code but cannot express the optimized
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   346
   translation of [e. p<-xs]
23192
ec73b9707d48 Moved list comprehension into List
nipkow
parents: 23096
diff changeset
   347
translations
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   348
"[e. p<-xs]" => "concat(map (_lc_abs p [e]) xs)"
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   349
"_listcompr e (_lc_gen p xs) (_lc_quals Q Qs)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   350
 => "concat (map (_lc_abs p (_listcompr e Q Qs)) xs)"
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   351
"[e. P]" => "if P then [e] else []"
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   352
"_listcompr e (_lc_test P) (_lc_quals Q Qs)"
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   353
 => "if P then (_listcompr e Q Qs) else []"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   354
"_listcompr e (_lc_let b) (_lc_quals Q Qs)"
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   355
 => "_Let b (_listcompr e Q Qs)"
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   356
*)
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   357
23279
e39dd93161d9 tuned list comprehension, changed filter syntax from : to <-
nipkow
parents: 23246
diff changeset
   358
syntax (xsymbols)
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   359
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ \<leftarrow> _")
23279
e39dd93161d9 tuned list comprehension, changed filter syntax from : to <-
nipkow
parents: 23246
diff changeset
   360
syntax (HTML output)
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   361
"_lc_gen" :: "'a \<Rightarrow> 'a list \<Rightarrow> lc_qual" ("_ \<leftarrow> _")
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   362
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   363
parse_translation (advanced) {*
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   364
let
35256
b73ae1a8fe7e adapted to authentic syntax;
wenzelm
parents: 35248
diff changeset
   365
  val NilC = Syntax.const @{const_syntax Nil};
b73ae1a8fe7e adapted to authentic syntax;
wenzelm
parents: 35248
diff changeset
   366
  val ConsC = Syntax.const @{const_syntax Cons};
b73ae1a8fe7e adapted to authentic syntax;
wenzelm
parents: 35248
diff changeset
   367
  val mapC = Syntax.const @{const_syntax map};
b73ae1a8fe7e adapted to authentic syntax;
wenzelm
parents: 35248
diff changeset
   368
  val concatC = Syntax.const @{const_syntax concat};
b73ae1a8fe7e adapted to authentic syntax;
wenzelm
parents: 35248
diff changeset
   369
  val IfC = Syntax.const @{const_syntax If};
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   370
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   371
  fun singl x = ConsC $ x $ NilC;
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   372
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   373
  fun pat_tr ctxt p e opti = (* %x. case x of p => e | _ => [] *)
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   374
    let
29281
b22ccb3998db eliminated OldTerm.add_term_free_names;
wenzelm
parents: 29270
diff changeset
   375
      val x = Free (Name.variant (fold Term.add_free_names [p, e] []) "x", dummyT);
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   376
      val e = if opti then singl e else e;
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   377
      val case1 = Syntax.const @{syntax_const "_case1"} $ p $ e;
35256
b73ae1a8fe7e adapted to authentic syntax;
wenzelm
parents: 35248
diff changeset
   378
      val case2 =
b73ae1a8fe7e adapted to authentic syntax;
wenzelm
parents: 35248
diff changeset
   379
        Syntax.const @{syntax_const "_case1"} $
b73ae1a8fe7e adapted to authentic syntax;
wenzelm
parents: 35248
diff changeset
   380
          Syntax.const @{const_syntax dummy_pattern} $ NilC;
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   381
      val cs = Syntax.const @{syntax_const "_case2"} $ case1 $ case2;
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   382
      val ft = Datatype_Case.case_tr false Datatype.info_of_constr ctxt [x, cs];
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   383
    in lambda x ft end;
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   384
35256
b73ae1a8fe7e adapted to authentic syntax;
wenzelm
parents: 35248
diff changeset
   385
  fun abs_tr ctxt (p as Free (s, T)) e opti =
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   386
        let
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   387
          val thy = ProofContext.theory_of ctxt;
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   388
          val s' = Sign.intern_const thy s;
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   389
        in
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   390
          if Sign.declared_const thy s'
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   391
          then (pat_tr ctxt p e opti, false)
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   392
          else (lambda p e, true)
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   393
        end
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   394
    | abs_tr ctxt p e opti = (pat_tr ctxt p e opti, false);
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   395
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   396
  fun lc_tr ctxt [e, Const (@{syntax_const "_lc_test"}, _) $ b, qs] =
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   397
        let
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   398
          val res =
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   399
            (case qs of
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   400
              Const (@{syntax_const "_lc_end"}, _) => singl e
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   401
            | Const (@{syntax_const "_lc_quals"}, _) $ q $ qs => lc_tr ctxt [e, q, qs]);
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   402
        in IfC $ b $ res $ NilC end
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   403
    | lc_tr ctxt
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   404
          [e, Const (@{syntax_const "_lc_gen"}, _) $ p $ es,
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   405
            Const(@{syntax_const "_lc_end"}, _)] =
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   406
        (case abs_tr ctxt p e true of
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   407
          (f, true) => mapC $ f $ es
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   408
        | (f, false) => concatC $ (mapC $ f $ es))
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   409
    | lc_tr ctxt
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   410
          [e, Const (@{syntax_const "_lc_gen"}, _) $ p $ es,
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   411
            Const (@{syntax_const "_lc_quals"}, _) $ q $ qs] =
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   412
        let val e' = lc_tr ctxt [e, q, qs];
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   413
        in concatC $ (mapC $ (fst (abs_tr ctxt p e' false)) $ es) end;
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   414
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   415
in [(@{syntax_const "_listcompr"}, lc_tr)] end
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   416
*}
23279
e39dd93161d9 tuned list comprehension, changed filter syntax from : to <-
nipkow
parents: 23246
diff changeset
   417
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   418
term "[(x,y,z). b]"
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   419
term "[(x,y,z). x\<leftarrow>xs]"
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   420
term "[e x y. x\<leftarrow>xs, y\<leftarrow>ys]"
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   421
term "[(x,y,z). x<a, x>b]"
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   422
term "[(x,y,z). x\<leftarrow>xs, x>b]"
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
   423
term "[(x,y,z). x<a, x\<leftarrow>xs]"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   424
term "[(x,y). Cons True x \<leftarrow> xs]"
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   425
term "[(x,y,z). Cons x [] \<leftarrow> xs]"
23240
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   426
term "[(x,y,z). x<a, x>b, x=d]"
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   427
term "[(x,y,z). x<a, x>b, y\<leftarrow>ys]"
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   428
term "[(x,y,z). x<a, x\<leftarrow>xs,y>b]"
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   429
term "[(x,y,z). x<a, x\<leftarrow>xs, y\<leftarrow>ys]"
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   430
term "[(x,y,z). x\<leftarrow>xs, x>b, y<a]"
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   431
term "[(x,y,z). x\<leftarrow>xs, x>b, y\<leftarrow>ys]"
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   432
term "[(x,y,z). x\<leftarrow>xs, y\<leftarrow>ys,y>x]"
7077dc80a14b tuned list comprehension
nipkow
parents: 23235
diff changeset
   433
term "[(x,y,z). x\<leftarrow>xs, y\<leftarrow>ys,z\<leftarrow>zs]"
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   434
(*
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   435
term "[(x,y). x\<leftarrow>xs, let xx = x+x, y\<leftarrow>ys, y \<noteq> xx]"
23192
ec73b9707d48 Moved list comprehension into List
nipkow
parents: 23096
diff changeset
   436
*)
ec73b9707d48 Moved list comprehension into List
nipkow
parents: 23096
diff changeset
   437
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
   438
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   439
subsubsection {* @{const Nil} and @{const Cons} *}
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   440
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   441
lemma not_Cons_self [simp]:
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   442
  "xs \<noteq> x # xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   443
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   444
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   445
lemmas not_Cons_self2 [simp] = not_Cons_self [symmetric]
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   446
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   447
lemma neq_Nil_conv: "(xs \<noteq> []) = (\<exists>y ys. xs = y # ys)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   448
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   449
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   450
lemma length_induct:
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   451
  "(\<And>xs. \<forall>ys. length ys < length xs \<longrightarrow> P ys \<Longrightarrow> P xs) \<Longrightarrow> P xs"
17589
58eeffd73be1 renamed rules to iprover
nipkow
parents: 17501
diff changeset
   452
by (rule measure_induct [of length]) iprover
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   453
37289
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   454
lemma list_nonempty_induct [consumes 1, case_names single cons]:
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   455
  assumes "xs \<noteq> []"
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   456
  assumes single: "\<And>x. P [x]"
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   457
  assumes cons: "\<And>x xs. xs \<noteq> [] \<Longrightarrow> P xs \<Longrightarrow> P (x # xs)"
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   458
  shows "P xs"
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   459
using `xs \<noteq> []` proof (induct xs)
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   460
  case Nil then show ?case by simp
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   461
next
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   462
  case (Cons x xs) show ?case proof (cases xs)
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   463
    case Nil with single show ?thesis by simp
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   464
  next
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   465
    case Cons then have "xs \<noteq> []" by simp
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   466
    moreover with Cons.hyps have "P xs" .
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   467
    ultimately show ?thesis by (rule cons)
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   468
  qed
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   469
qed
881fa5012451 induction over non-empty lists
haftmann
parents: 37123
diff changeset
   470
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   471
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   472
subsubsection {* @{const length} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   473
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   474
text {*
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   475
  Needs to come before @{text "@"} because of theorem @{text
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   476
  append_eq_append_conv}.
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   477
*}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   478
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   479
lemma length_append [simp]: "length (xs @ ys) = length xs + length ys"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   480
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   481
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   482
lemma length_map [simp]: "length (map f xs) = length xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   483
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   484
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   485
lemma length_rev [simp]: "length (rev xs) = length xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   486
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   487
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   488
lemma length_tl [simp]: "length (tl xs) = length xs - 1"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   489
by (cases xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   490
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   491
lemma length_0_conv [iff]: "(length xs = 0) = (xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   492
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   493
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   494
lemma length_greater_0_conv [iff]: "(0 < length xs) = (xs \<noteq> [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   495
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   496
23479
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
   497
lemma length_pos_if_in_set: "x : set xs \<Longrightarrow> length xs > 0"
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
   498
by auto
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
   499
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   500
lemma length_Suc_conv:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   501
"(length xs = Suc n) = (\<exists>y ys. xs = y # ys \<and> length ys = n)"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   502
by (induct xs) auto
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   503
14025
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
   504
lemma Suc_length_conv:
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
   505
"(Suc n = length xs) = (\<exists>y ys. xs = y # ys \<and> length ys = n)"
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
   506
apply (induct xs, simp, simp)
14025
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
   507
apply blast
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
   508
done
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
   509
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   510
lemma impossible_Cons: "length xs <= length ys ==> xs = x # ys = False"
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   511
  by (induct xs) auto
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   512
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   513
lemma list_induct2 [consumes 1, case_names Nil Cons]:
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   514
  "length xs = length ys \<Longrightarrow> P [] [] \<Longrightarrow>
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   515
   (\<And>x xs y ys. length xs = length ys \<Longrightarrow> P xs ys \<Longrightarrow> P (x#xs) (y#ys))
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   516
   \<Longrightarrow> P xs ys"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   517
proof (induct xs arbitrary: ys)
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   518
  case Nil then show ?case by simp
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   519
next
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   520
  case (Cons x xs ys) then show ?case by (cases ys) simp_all
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   521
qed
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   522
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   523
lemma list_induct3 [consumes 2, case_names Nil Cons]:
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   524
  "length xs = length ys \<Longrightarrow> length ys = length zs \<Longrightarrow> P [] [] [] \<Longrightarrow>
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   525
   (\<And>x xs y ys z zs. length xs = length ys \<Longrightarrow> length ys = length zs \<Longrightarrow> P xs ys zs \<Longrightarrow> P (x#xs) (y#ys) (z#zs))
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   526
   \<Longrightarrow> P xs ys zs"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   527
proof (induct xs arbitrary: ys zs)
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   528
  case Nil then show ?case by simp
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   529
next
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   530
  case (Cons x xs ys zs) then show ?case by (cases ys, simp_all)
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   531
    (cases zs, simp_all)
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
   532
qed
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   533
36154
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   534
lemma list_induct4 [consumes 3, case_names Nil Cons]:
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   535
  "length xs = length ys \<Longrightarrow> length ys = length zs \<Longrightarrow> length zs = length ws \<Longrightarrow>
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   536
   P [] [] [] [] \<Longrightarrow> (\<And>x xs y ys z zs w ws. length xs = length ys \<Longrightarrow>
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   537
   length ys = length zs \<Longrightarrow> length zs = length ws \<Longrightarrow> P xs ys zs ws \<Longrightarrow>
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   538
   P (x#xs) (y#ys) (z#zs) (w#ws)) \<Longrightarrow> P xs ys zs ws"
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   539
proof (induct xs arbitrary: ys zs ws)
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   540
  case Nil then show ?case by simp
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   541
next
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   542
  case (Cons x xs ys zs ws) then show ?case by ((cases ys, simp_all), (cases zs,simp_all)) (cases ws, simp_all)
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   543
qed
11c6106d7787 Respectfullness and preservation of list_rel
Cezary Kaliszyk <kaliszyk@in.tum.de>
parents: 35828
diff changeset
   544
22493
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
   545
lemma list_induct2': 
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
   546
  "\<lbrakk> P [] [];
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
   547
  \<And>x xs. P (x#xs) [];
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
   548
  \<And>y ys. P [] (y#ys);
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
   549
   \<And>x xs y ys. P xs ys  \<Longrightarrow> P (x#xs) (y#ys) \<rbrakk>
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
   550
 \<Longrightarrow> P xs ys"
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
   551
by (induct xs arbitrary: ys) (case_tac x, auto)+
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
   552
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   553
lemma neq_if_length_neq: "length xs \<noteq> length ys \<Longrightarrow> (xs = ys) == False"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
   554
by (rule Eq_FalseI) auto
24037
0a41d2ebc0cd proper simproc_setup for "list_neq";
wenzelm
parents: 23983
diff changeset
   555
0a41d2ebc0cd proper simproc_setup for "list_neq";
wenzelm
parents: 23983
diff changeset
   556
simproc_setup list_neq ("(xs::'a list) = ys") = {*
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   557
(*
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   558
Reduces xs=ys to False if xs and ys cannot be of the same length.
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   559
This is the case if the atomic sublists of one are a submultiset
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   560
of those of the other list and there are fewer Cons's in one than the other.
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   561
*)
24037
0a41d2ebc0cd proper simproc_setup for "list_neq";
wenzelm
parents: 23983
diff changeset
   562
0a41d2ebc0cd proper simproc_setup for "list_neq";
wenzelm
parents: 23983
diff changeset
   563
let
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   564
29856
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   565
fun len (Const(@{const_name Nil},_)) acc = acc
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   566
  | len (Const(@{const_name Cons},_) $ _ $ xs) (ts,n) = len xs (ts,n+1)
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   567
  | len (Const(@{const_name append},_) $ xs $ ys) acc = len xs (len ys acc)
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   568
  | len (Const(@{const_name rev},_) $ xs) acc = len xs acc
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   569
  | len (Const(@{const_name map},_) $ _ $ xs) acc = len xs acc
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   570
  | len t (ts,n) = (t::ts,n);
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   571
24037
0a41d2ebc0cd proper simproc_setup for "list_neq";
wenzelm
parents: 23983
diff changeset
   572
fun list_neq _ ss ct =
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   573
  let
24037
0a41d2ebc0cd proper simproc_setup for "list_neq";
wenzelm
parents: 23983
diff changeset
   574
    val (Const(_,eqT) $ lhs $ rhs) = Thm.term_of ct;
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   575
    val (ls,m) = len lhs ([],0) and (rs,n) = len rhs ([],0);
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   576
    fun prove_neq() =
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   577
      let
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   578
        val Type(_,listT::_) = eqT;
22994
02440636214f abstract size function in hologic.ML
haftmann
parents: 22940
diff changeset
   579
        val size = HOLogic.size_const listT;
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   580
        val eq_len = HOLogic.mk_eq (size $ lhs, size $ rhs);
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   581
        val neq_len = HOLogic.mk_Trueprop (HOLogic.Not $ eq_len);
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   582
        val thm = Goal.prove (Simplifier.the_context ss) [] [] neq_len
22633
haftmann
parents: 22551
diff changeset
   583
          (K (simp_tac (Simplifier.inherit_context ss @{simpset}) 1));
haftmann
parents: 22551
diff changeset
   584
      in SOME (thm RS @{thm neq_if_length_neq}) end
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   585
  in
23214
dc23c062b58c renamed gen_submultiset to submultiset;
wenzelm
parents: 23212
diff changeset
   586
    if m < n andalso submultiset (op aconv) (ls,rs) orelse
dc23c062b58c renamed gen_submultiset to submultiset;
wenzelm
parents: 23212
diff changeset
   587
       n < m andalso submultiset (op aconv) (rs,ls)
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   588
    then prove_neq() else NONE
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   589
  end;
24037
0a41d2ebc0cd proper simproc_setup for "list_neq";
wenzelm
parents: 23983
diff changeset
   590
in list_neq end;
22143
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   591
*}
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   592
cf58486ca11b Added simproc list_neq (prompted by an application)
nipkow
parents: 21911
diff changeset
   593
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
   594
subsubsection {* @{text "@"} -- append *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   595
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   596
lemma append_assoc [simp]: "(xs @ ys) @ zs = xs @ (ys @ zs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   597
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   598
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   599
lemma append_Nil2 [simp]: "xs @ [] = xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   600
by (induct xs) auto
3507
157be29ad5ba Improved length = size translation.
nipkow
parents: 3465
diff changeset
   601
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   602
lemma append_is_Nil_conv [iff]: "(xs @ ys = []) = (xs = [] \<and> ys = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   603
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   604
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   605
lemma Nil_is_append_conv [iff]: "([] = xs @ ys) = (xs = [] \<and> ys = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   606
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   607
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   608
lemma append_self_conv [iff]: "(xs @ ys = xs) = (ys = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   609
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   610
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   611
lemma self_append_conv [iff]: "(xs = xs @ ys) = (ys = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   612
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   613
35828
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
   614
lemma append_eq_append_conv [simp, no_atp]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
   615
 "length xs = length ys \<or> length us = length vs
13883
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
   616
 ==> (xs@us = ys@vs) = (xs=ys \<and> us=vs)"
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
   617
apply (induct xs arbitrary: ys)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
   618
 apply (case_tac ys, simp, force)
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
   619
apply (case_tac ys, force, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   620
done
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   621
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
   622
lemma append_eq_append_conv2: "(xs @ ys = zs @ ts) =
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
   623
  (EX us. xs = zs @ us & us @ ys = ts | xs @ us = zs & ys = us@ ts)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
   624
apply (induct xs arbitrary: ys zs ts)
14495
e2a1c31cf6d3 Added append_eq_append_conv2
nipkow
parents: 14402
diff changeset
   625
 apply fastsimp
e2a1c31cf6d3 Added append_eq_append_conv2
nipkow
parents: 14402
diff changeset
   626
apply(case_tac zs)
e2a1c31cf6d3 Added append_eq_append_conv2
nipkow
parents: 14402
diff changeset
   627
 apply simp
e2a1c31cf6d3 Added append_eq_append_conv2
nipkow
parents: 14402
diff changeset
   628
apply fastsimp
e2a1c31cf6d3 Added append_eq_append_conv2
nipkow
parents: 14402
diff changeset
   629
done
e2a1c31cf6d3 Added append_eq_append_conv2
nipkow
parents: 14402
diff changeset
   630
34910
b23bd3ee4813 same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents: 34064
diff changeset
   631
lemma same_append_eq [iff, induct_simp]: "(xs @ ys = xs @ zs) = (ys = zs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   632
by simp
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   633
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   634
lemma append1_eq_conv [iff]: "(xs @ [x] = ys @ [y]) = (xs = ys \<and> x = y)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   635
by simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   636
34910
b23bd3ee4813 same_append_eq / append_same_eq are now used for simplifying induction rules.
berghofe
parents: 34064
diff changeset
   637
lemma append_same_eq [iff, induct_simp]: "(ys @ xs = zs @ xs) = (ys = zs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   638
by simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   639
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   640
lemma append_self_conv2 [iff]: "(xs @ ys = ys) = (xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   641
using append_same_eq [of _ _ "[]"] by auto
3507
157be29ad5ba Improved length = size translation.
nipkow
parents: 3465
diff changeset
   642
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   643
lemma self_append_conv2 [iff]: "(ys = xs @ ys) = (xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   644
using append_same_eq [of "[]"] by auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   645
35828
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
   646
lemma hd_Cons_tl [simp,no_atp]: "xs \<noteq> [] ==> hd xs # tl xs = xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   647
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   648
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   649
lemma hd_append: "hd (xs @ ys) = (if xs = [] then hd ys else hd xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   650
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   651
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   652
lemma hd_append2 [simp]: "xs \<noteq> [] ==> hd (xs @ ys) = hd xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   653
by (simp add: hd_append split: list.split)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   654
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   655
lemma tl_append: "tl (xs @ ys) = (case xs of [] => tl ys | z#zs => zs @ ys)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   656
by (simp split: list.split)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   657
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   658
lemma tl_append2 [simp]: "xs \<noteq> [] ==> tl (xs @ ys) = tl xs @ ys"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   659
by (simp add: tl_append split: list.split)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   660
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   661
14300
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
   662
lemma Cons_eq_append_conv: "x#xs = ys@zs =
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
   663
 (ys = [] & x#xs = zs | (EX ys'. x#ys' = ys & xs = ys'@zs))"
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
   664
by(cases ys) auto
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
   665
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
   666
lemma append_eq_Cons_conv: "(ys@zs = x#xs) =
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
   667
 (ys = [] & zs = x#xs | (EX ys'. ys = x#ys' & ys'@zs = xs))"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
   668
by(cases ys) auto
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
   669
14300
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
   670
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   671
text {* Trivial rules for solving @{text "@"}-equations automatically. *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   672
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   673
lemma eq_Nil_appendI: "xs = ys ==> xs = [] @ ys"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   674
by simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   675
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   676
lemma Cons_eq_appendI:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   677
"[| x # xs1 = ys; xs = xs1 @ zs |] ==> x # xs = ys @ zs"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   678
by (drule sym) simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   679
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   680
lemma append_eq_appendI:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   681
"[| xs @ xs1 = zs; ys = xs1 @ us |] ==> xs @ ys = zs @ us"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   682
by (drule sym) simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   683
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   684
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   685
text {*
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   686
Simplification procedure for all list equalities.
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   687
Currently only tries to rearrange @{text "@"} to see if
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   688
- both lists end in a singleton list,
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   689
- or both lists end in the same list.
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   690
*}
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   691
26480
544cef16045b replaced 'ML_setup' by 'ML';
wenzelm
parents: 26442
diff changeset
   692
ML {*
3507
157be29ad5ba Improved length = size translation.
nipkow
parents: 3465
diff changeset
   693
local
157be29ad5ba Improved length = size translation.
nipkow
parents: 3465
diff changeset
   694
29856
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   695
fun last (cons as Const(@{const_name Cons},_) $ _ $ xs) =
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   696
  (case xs of Const(@{const_name Nil},_) => cons | _ => last xs)
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   697
  | last (Const(@{const_name append},_) $ _ $ ys) = last ys
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   698
  | last t = t;
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   699
29856
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   700
fun list1 (Const(@{const_name Cons},_) $ _ $ Const(@{const_name Nil},_)) = true
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   701
  | list1 _ = false;
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   702
29856
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   703
fun butlast ((cons as Const(@{const_name Cons},_) $ x) $ xs) =
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   704
  (case xs of Const(@{const_name Nil},_) => xs | _ => cons $ butlast xs)
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   705
  | butlast ((app as Const(@{const_name append},_) $ xs) $ ys) = app $ butlast ys
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   706
  | butlast xs = Const(@{const_name Nil},fastype_of xs);
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   707
22633
haftmann
parents: 22551
diff changeset
   708
val rearr_ss = HOL_basic_ss addsimps [@{thm append_assoc},
haftmann
parents: 22551
diff changeset
   709
  @{thm append_Nil}, @{thm append_Cons}];
16973
b2a894562b8f simprocs: Simplifier.inherit_bounds;
wenzelm
parents: 16965
diff changeset
   710
20044
92cc2f4c7335 simprocs: no theory argument -- use simpset context instead;
wenzelm
parents: 19890
diff changeset
   711
fun list_eq ss (F as (eq as Const(_,eqT)) $ lhs $ rhs) =
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   712
  let
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   713
    val lastl = last lhs and lastr = last rhs;
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   714
    fun rearr conv =
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   715
      let
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   716
        val lhs1 = butlast lhs and rhs1 = butlast rhs;
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   717
        val Type(_,listT::_) = eqT
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   718
        val appT = [listT,listT] ---> listT
29856
984191be0357 const_name antiquotations
huffman
parents: 29829
diff changeset
   719
        val app = Const(@{const_name append},appT)
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   720
        val F2 = eq $ (app$lhs1$lastl) $ (app$rhs1$lastr)
13480
bb72bd43c6c3 use Tactic.prove instead of prove_goalw_cterm in internal proofs!
wenzelm
parents: 13462
diff changeset
   721
        val eq = HOLogic.mk_Trueprop (HOLogic.mk_eq (F,F2));
20044
92cc2f4c7335 simprocs: no theory argument -- use simpset context instead;
wenzelm
parents: 19890
diff changeset
   722
        val thm = Goal.prove (Simplifier.the_context ss) [] [] eq
17877
67d5ab1cb0d8 Simplifier.inherit_context instead of Simplifier.inherit_bounds;
wenzelm
parents: 17830
diff changeset
   723
          (K (simp_tac (Simplifier.inherit_context ss rearr_ss) 1));
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15489
diff changeset
   724
      in SOME ((conv RS (thm RS trans)) RS eq_reflection) end;
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   725
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   726
  in
22633
haftmann
parents: 22551
diff changeset
   727
    if list1 lastl andalso list1 lastr then rearr @{thm append1_eq_conv}
haftmann
parents: 22551
diff changeset
   728
    else if lastl aconv lastr then rearr @{thm append_same_eq}
15531
08c8dad8e399 Deleted Library.option type.
skalberg
parents: 15489
diff changeset
   729
    else NONE
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   730
  end;
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   731
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   732
in
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   733
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   734
val list_eq_simproc =
32010
cb1a1c94b4cd more antiquotations;
wenzelm
parents: 32007
diff changeset
   735
  Simplifier.simproc @{theory} "list_eq" ["(xs::'a list) = ys"] (K list_eq);
13462
56610e2ba220 sane interface for simprocs;
wenzelm
parents: 13366
diff changeset
   736
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   737
end;
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   738
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   739
Addsimprocs [list_eq_simproc];
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   740
*}
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   741
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   742
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
   743
subsubsection {* @{text map} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   744
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   745
lemma map_ext: "(!!x. x : set xs --> f x = g x) ==> map f xs = map g xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   746
by (induct xs) simp_all
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   747
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   748
lemma map_ident [simp]: "map (\<lambda>x. x) = (\<lambda>xs. xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   749
by (rule ext, induct_tac xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   750
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   751
lemma map_append [simp]: "map f (xs @ ys) = map f xs @ map f ys"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   752
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   753
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   754
lemma map_map [simp]: "map f (map g xs) = map (f \<circ> g) xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   755
by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
   756
35208
2b9bce05e84b added lemma
nipkow
parents: 35195
diff changeset
   757
lemma map_comp_map[simp]: "((map f) o (map g)) = map(f o g)"
2b9bce05e84b added lemma
nipkow
parents: 35195
diff changeset
   758
apply(rule ext)
2b9bce05e84b added lemma
nipkow
parents: 35195
diff changeset
   759
apply(simp)
2b9bce05e84b added lemma
nipkow
parents: 35195
diff changeset
   760
done
2b9bce05e84b added lemma
nipkow
parents: 35195
diff changeset
   761
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   762
lemma rev_map: "rev (map f xs) = map f (rev xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   763
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   764
13737
e564c3d2d174 added a few lemmas
nipkow
parents: 13601
diff changeset
   765
lemma map_eq_conv[simp]: "(map f xs = map g xs) = (!x : set xs. f x = g x)"
e564c3d2d174 added a few lemmas
nipkow
parents: 13601
diff changeset
   766
by (induct xs) auto
e564c3d2d174 added a few lemmas
nipkow
parents: 13601
diff changeset
   767
19770
be5c23ebe1eb HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents: 19623
diff changeset
   768
lemma map_cong [fundef_cong, recdef_cong]:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   769
"xs = ys ==> (!!x. x : set ys ==> f x = g x) ==> map f xs = map g ys"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   770
-- {* a congruence rule for @{text map} *}
13737
e564c3d2d174 added a few lemmas
nipkow
parents: 13601
diff changeset
   771
by simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   772
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   773
lemma map_is_Nil_conv [iff]: "(map f xs = []) = (xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   774
by (cases xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   775
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   776
lemma Nil_is_map_conv [iff]: "([] = map f xs) = (xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   777
by (cases xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   778
18447
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
   779
lemma map_eq_Cons_conv:
14025
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
   780
 "(map f xs = y#ys) = (\<exists>z zs. xs = z#zs \<and> f z = y \<and> map f zs = ys)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   781
by (cases xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   782
18447
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
   783
lemma Cons_eq_map_conv:
14025
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
   784
 "(x#xs = map f ys) = (\<exists>z zs. ys = z#zs \<and> x = f z \<and> xs = map f zs)"
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
   785
by (cases ys) auto
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
   786
18447
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
   787
lemmas map_eq_Cons_D = map_eq_Cons_conv [THEN iffD1]
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
   788
lemmas Cons_eq_map_D = Cons_eq_map_conv [THEN iffD1]
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
   789
declare map_eq_Cons_D [dest!]  Cons_eq_map_D [dest!]
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
   790
14111
993471c762b8 Some new thm (ex_map_conv?)
nipkow
parents: 14099
diff changeset
   791
lemma ex_map_conv:
993471c762b8 Some new thm (ex_map_conv?)
nipkow
parents: 14099
diff changeset
   792
  "(EX xs. ys = map f xs) = (ALL y : set ys. EX x. y = f x)"
18447
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
   793
by(induct ys, auto simp add: Cons_eq_map_conv)
14111
993471c762b8 Some new thm (ex_map_conv?)
nipkow
parents: 14099
diff changeset
   794
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   795
lemma map_eq_imp_length_eq:
35510
64d2d54cbf03 Slightly generalised a theorem
paulson
parents: 35296
diff changeset
   796
  assumes "map f xs = map g ys"
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   797
  shows "length xs = length ys"
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   798
using assms proof (induct ys arbitrary: xs)
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   799
  case Nil then show ?case by simp
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   800
next
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   801
  case (Cons y ys) then obtain z zs where xs: "xs = z # zs" by auto
35510
64d2d54cbf03 Slightly generalised a theorem
paulson
parents: 35296
diff changeset
   802
  from Cons xs have "map f zs = map g ys" by simp
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   803
  moreover with Cons have "length zs = length ys" by blast
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   804
  with xs show ?case by simp
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   805
qed
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   806
  
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   807
lemma map_inj_on:
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   808
 "[| map f xs = map f ys; inj_on f (set xs Un set ys) |]
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   809
  ==> xs = ys"
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   810
apply(frule map_eq_imp_length_eq)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   811
apply(rotate_tac -1)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   812
apply(induct rule:list_induct2)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   813
 apply simp
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   814
apply(simp)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   815
apply (blast intro:sym)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   816
done
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   817
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   818
lemma inj_on_map_eq_map:
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   819
 "inj_on f (set xs Un set ys) \<Longrightarrow> (map f xs = map f ys) = (xs = ys)"
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   820
by(blast dest:map_inj_on)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   821
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   822
lemma map_injective:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
   823
 "map f xs = map f ys ==> inj f ==> xs = ys"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
   824
by (induct ys arbitrary: xs) (auto dest!:injD)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   825
14339
ec575b7bde7a *** empty log message ***
nipkow
parents: 14338
diff changeset
   826
lemma inj_map_eq_map[simp]: "inj f \<Longrightarrow> (map f xs = map f ys) = (xs = ys)"
ec575b7bde7a *** empty log message ***
nipkow
parents: 14338
diff changeset
   827
by(blast dest:map_injective)
ec575b7bde7a *** empty log message ***
nipkow
parents: 14338
diff changeset
   828
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   829
lemma inj_mapI: "inj f ==> inj (map f)"
17589
58eeffd73be1 renamed rules to iprover
nipkow
parents: 17501
diff changeset
   830
by (iprover dest: map_injective injD intro: inj_onI)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   831
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   832
lemma inj_mapD: "inj (map f) ==> inj f"
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
   833
apply (unfold inj_on_def, clarify)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   834
apply (erule_tac x = "[x]" in ballE)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
   835
 apply (erule_tac x = "[y]" in ballE, simp, blast)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   836
apply blast
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   837
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   838
14339
ec575b7bde7a *** empty log message ***
nipkow
parents: 14338
diff changeset
   839
lemma inj_map[iff]: "inj (map f) = inj f"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   840
by (blast dest: inj_mapD intro: inj_mapI)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   841
15303
eedbb8d22ca2 added lemmas
nipkow
parents: 15302
diff changeset
   842
lemma inj_on_mapI: "inj_on f (\<Union>(set ` A)) \<Longrightarrow> inj_on (map f) A"
eedbb8d22ca2 added lemmas
nipkow
parents: 15302
diff changeset
   843
apply(rule inj_onI)
eedbb8d22ca2 added lemmas
nipkow
parents: 15302
diff changeset
   844
apply(erule map_inj_on)
eedbb8d22ca2 added lemmas
nipkow
parents: 15302
diff changeset
   845
apply(blast intro:inj_onI dest:inj_onD)
eedbb8d22ca2 added lemmas
nipkow
parents: 15302
diff changeset
   846
done
eedbb8d22ca2 added lemmas
nipkow
parents: 15302
diff changeset
   847
14343
6bc647f472b9 map_idI
kleing
parents: 14339
diff changeset
   848
lemma map_idI: "(\<And>x. x \<in> set xs \<Longrightarrow> f x = x) \<Longrightarrow> map f xs = xs"
6bc647f472b9 map_idI
kleing
parents: 14339
diff changeset
   849
by (induct xs, auto)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   850
14402
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
   851
lemma map_fun_upd [simp]: "y \<notin> set xs \<Longrightarrow> map (f(y:=v)) xs = map f xs"
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
   852
by (induct xs) auto
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
   853
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   854
lemma map_fst_zip[simp]:
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   855
  "length xs = length ys \<Longrightarrow> map fst (zip xs ys) = xs"
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   856
by (induct rule:list_induct2, simp_all)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   857
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   858
lemma map_snd_zip[simp]:
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   859
  "length xs = length ys \<Longrightarrow> map snd (zip xs ys) = ys"
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   860
by (induct rule:list_induct2, simp_all)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   861
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
   862
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
   863
subsubsection {* @{text rev} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   864
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   865
lemma rev_append [simp]: "rev (xs @ ys) = rev ys @ rev xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   866
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   867
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   868
lemma rev_rev_ident [simp]: "rev (rev xs) = xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   869
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   870
15870
4320bce5873f more on rev
kleing
parents: 15868
diff changeset
   871
lemma rev_swap: "(rev xs = ys) = (xs = rev ys)"
4320bce5873f more on rev
kleing
parents: 15868
diff changeset
   872
by auto
4320bce5873f more on rev
kleing
parents: 15868
diff changeset
   873
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   874
lemma rev_is_Nil_conv [iff]: "(rev xs = []) = (xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   875
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   876
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   877
lemma Nil_is_rev_conv [iff]: "([] = rev xs) = (xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   878
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   879
15870
4320bce5873f more on rev
kleing
parents: 15868
diff changeset
   880
lemma rev_singleton_conv [simp]: "(rev xs = [x]) = (xs = [x])"
4320bce5873f more on rev
kleing
parents: 15868
diff changeset
   881
by (cases xs) auto
4320bce5873f more on rev
kleing
parents: 15868
diff changeset
   882
4320bce5873f more on rev
kleing
parents: 15868
diff changeset
   883
lemma singleton_rev_conv [simp]: "([x] = rev xs) = (xs = [x])"
4320bce5873f more on rev
kleing
parents: 15868
diff changeset
   884
by (cases xs) auto
4320bce5873f more on rev
kleing
parents: 15868
diff changeset
   885
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   886
lemma rev_is_rev_conv [iff]: "(rev xs = rev ys) = (xs = ys)"
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
   887
apply (induct xs arbitrary: ys, force)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
   888
apply (case_tac ys, simp, force)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   889
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   890
15439
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
   891
lemma inj_on_rev[iff]: "inj_on rev A"
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
   892
by(simp add:inj_on_def)
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
   893
13366
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   894
lemma rev_induct [case_names Nil snoc]:
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   895
  "[| P []; !!x xs. P xs ==> P (xs @ [x]) |] ==> P xs"
15489
d136af442665 Replaced application of subst by simplesubst in proof of rev_induct
berghofe
parents: 15439
diff changeset
   896
apply(simplesubst rev_rev_ident[symmetric])
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   897
apply(rule_tac list = "rev xs" in list.induct, simp_all)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   898
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   899
13366
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   900
lemma rev_exhaust [case_names Nil snoc]:
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   901
  "(xs = [] ==> P) ==>(!!ys y. xs = ys @ [y] ==> P) ==> P"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   902
by (induct xs rule: rev_induct) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   903
13366
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   904
lemmas rev_cases = rev_exhaust
114b7c14084a moved stuff from Main.thy;
wenzelm
parents: 13187
diff changeset
   905
18423
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
   906
lemma rev_eq_Cons_iff[iff]: "(rev xs = y#ys) = (xs = rev ys @ [y])"
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
   907
by(rule rev_cases[of xs]) auto
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
   908
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   909
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
   910
subsubsection {* @{text set} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   911
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   912
lemma finite_set [iff]: "finite (set xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   913
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   914
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   915
lemma set_append [simp]: "set (xs @ ys) = (set xs \<union> set ys)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   916
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   917
17830
695a2365d32f added hd lemma
nipkow
parents: 17765
diff changeset
   918
lemma hd_in_set[simp]: "xs \<noteq> [] \<Longrightarrow> hd xs : set xs"
695a2365d32f added hd lemma
nipkow
parents: 17765
diff changeset
   919
by(cases xs) auto
14099
55d244f3c86d added fold_red, o2l, postfix, some thms
oheimb
parents: 14050
diff changeset
   920
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   921
lemma set_subset_Cons: "set xs \<subseteq> set (x # xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   922
by auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   923
14099
55d244f3c86d added fold_red, o2l, postfix, some thms
oheimb
parents: 14050
diff changeset
   924
lemma set_ConsD: "y \<in> set (x # xs) \<Longrightarrow> y=x \<or> y \<in> set xs" 
55d244f3c86d added fold_red, o2l, postfix, some thms
oheimb
parents: 14050
diff changeset
   925
by auto
55d244f3c86d added fold_red, o2l, postfix, some thms
oheimb
parents: 14050
diff changeset
   926
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   927
lemma set_empty [iff]: "(set xs = {}) = (xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   928
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   929
15245
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
   930
lemma set_empty2[iff]: "({} = set xs) = (xs = [])"
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
   931
by(induct xs) auto
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
   932
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   933
lemma set_rev [simp]: "set (rev xs) = set xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   934
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   935
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   936
lemma set_map [simp]: "set (map f xs) = f`(set xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   937
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   938
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   939
lemma set_filter [simp]: "set (filter P xs) = {x. x : set xs \<and> P x}"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
   940
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   941
32417
e87d9c78910c tuned code generation for lists
nipkow
parents: 32415
diff changeset
   942
lemma set_upt [simp]: "set[i..<j] = {i..<j}"
e87d9c78910c tuned code generation for lists
nipkow
parents: 32415
diff changeset
   943
by (induct j) (simp_all add: atLeastLessThanSuc)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
   944
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
   945
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   946
lemma split_list: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs"
18049
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
   947
proof (induct xs)
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   948
  case Nil thus ?case by simp
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   949
next
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   950
  case Cons thus ?case by (auto intro: Cons_eq_appendI)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   951
qed
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   952
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   953
lemma in_set_conv_decomp: "x \<in> set xs \<longleftrightarrow> (\<exists>ys zs. xs = ys @ x # zs)"
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   954
  by (auto elim: split_list)
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   955
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   956
lemma split_list_first: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys"
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   957
proof (induct xs)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   958
  case Nil thus ?case by simp
18049
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
   959
next
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
   960
  case (Cons a xs)
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
   961
  show ?case
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
   962
  proof cases
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
   963
    assume "x = a" thus ?case using Cons by fastsimp
18049
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
   964
  next
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   965
    assume "x \<noteq> a" thus ?case using Cons by(fastsimp intro!: Cons_eq_appendI)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   966
  qed
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   967
qed
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   968
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   969
lemma in_set_conv_decomp_first:
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   970
  "(x : set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set ys)"
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   971
  by (auto dest!: split_list_first)
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   972
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   973
lemma split_list_last: "x : set xs \<Longrightarrow> \<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set zs"
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   974
proof (induct xs rule:rev_induct)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   975
  case Nil thus ?case by simp
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   976
next
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   977
  case (snoc a xs)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   978
  show ?case
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   979
  proof cases
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   980
    assume "x = a" thus ?case using snoc by simp (metis ex_in_conv set_empty2)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   981
  next
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   982
    assume "x \<noteq> a" thus ?case using snoc by fastsimp
18049
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
   983
  qed
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
   984
qed
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
   985
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   986
lemma in_set_conv_decomp_last:
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   987
  "(x : set xs) = (\<exists>ys zs. xs = ys @ x # zs \<and> x \<notin> set zs)"
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   988
  by (auto dest!: split_list_last)
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   989
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   990
lemma split_list_prop: "\<exists>x \<in> set xs. P x \<Longrightarrow> \<exists>ys x zs. xs = ys @ x # zs & P x"
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   991
proof (induct xs)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   992
  case Nil thus ?case by simp
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   993
next
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   994
  case Cons thus ?case
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   995
    by(simp add:Bex_def)(metis append_Cons append.simps(1))
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   996
qed
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   997
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
   998
lemma split_list_propE:
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
   999
  assumes "\<exists>x \<in> set xs. P x"
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1000
  obtains ys x zs where "xs = ys @ x # zs" and "P x"
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1001
using split_list_prop [OF assms] by blast
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1002
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1003
lemma split_list_first_prop:
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1004
  "\<exists>x \<in> set xs. P x \<Longrightarrow>
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1005
   \<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y)"
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1006
proof (induct xs)
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1007
  case Nil thus ?case by simp
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1008
next
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1009
  case (Cons x xs)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1010
  show ?case
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1011
  proof cases
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1012
    assume "P x"
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1013
    thus ?thesis by simp
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1014
      (metis Un_upper1 contra_subsetD in_set_conv_decomp_first self_append_conv2 set_append)
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1015
  next
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1016
    assume "\<not> P x"
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1017
    hence "\<exists>x\<in>set xs. P x" using Cons(2) by simp
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1018
    thus ?thesis using `\<not> P x` Cons(1) by (metis append_Cons set_ConsD)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1019
  qed
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1020
qed
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1021
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1022
lemma split_list_first_propE:
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1023
  assumes "\<exists>x \<in> set xs. P x"
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1024
  obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>y \<in> set ys. \<not> P y"
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1025
using split_list_first_prop [OF assms] by blast
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1026
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1027
lemma split_list_first_prop_iff:
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1028
  "(\<exists>x \<in> set xs. P x) \<longleftrightarrow>
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1029
   (\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>y \<in> set ys. \<not> P y))"
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1030
by (rule, erule split_list_first_prop) auto
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1031
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1032
lemma split_list_last_prop:
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1033
  "\<exists>x \<in> set xs. P x \<Longrightarrow>
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1034
   \<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z)"
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1035
proof(induct xs rule:rev_induct)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1036
  case Nil thus ?case by simp
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1037
next
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1038
  case (snoc x xs)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1039
  show ?case
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1040
  proof cases
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1041
    assume "P x" thus ?thesis by (metis emptyE set_empty)
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1042
  next
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1043
    assume "\<not> P x"
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1044
    hence "\<exists>x\<in>set xs. P x" using snoc(2) by simp
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1045
    thus ?thesis using `\<not> P x` snoc(1) by fastsimp
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1046
  qed
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1047
qed
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1048
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1049
lemma split_list_last_propE:
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1050
  assumes "\<exists>x \<in> set xs. P x"
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1051
  obtains ys x zs where "xs = ys @ x # zs" and "P x" and "\<forall>z \<in> set zs. \<not> P z"
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1052
using split_list_last_prop [OF assms] by blast
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1053
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1054
lemma split_list_last_prop_iff:
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1055
  "(\<exists>x \<in> set xs. P x) \<longleftrightarrow>
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1056
   (\<exists>ys x zs. xs = ys@x#zs \<and> P x \<and> (\<forall>z \<in> set zs. \<not> P z))"
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1057
by (metis split_list_last_prop [where P=P] in_set_conv_decomp)
26073
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1058
0e70d3bd2eb4 more lemmas
nipkow
parents: 25966
diff changeset
  1059
lemma finite_list: "finite A ==> EX xs. set xs = A"
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1060
  by (erule finite_induct)
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  1061
    (auto simp add: set.simps(2) [symmetric] simp del: set.simps(2))
13508
890d736b93a5 Frederic Blanqui's new "guard" examples
paulson
parents: 13480
diff changeset
  1062
14388
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  1063
lemma card_length: "card (set xs) \<le> length xs"
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  1064
by (induct xs) (auto simp add: card_insert_if)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1065
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1066
lemma set_minus_filter_out:
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1067
  "set xs - {y} = set (filter (\<lambda>x. \<not> (x = y)) xs)"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1068
  by (induct xs) auto
15168
33a08cfc3ae5 new functions for sets of lists
paulson
parents: 15140
diff changeset
  1069
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  1070
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  1071
subsubsection {* @{text filter} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1072
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1073
lemma filter_append [simp]: "filter P (xs @ ys) = filter P xs @ filter P ys"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1074
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1075
15305
0bd9eedaa301 added lemmas
nipkow
parents: 15304
diff changeset
  1076
lemma rev_filter: "rev (filter P xs) = filter P (rev xs)"
0bd9eedaa301 added lemmas
nipkow
parents: 15304
diff changeset
  1077
by (induct xs) simp_all
0bd9eedaa301 added lemmas
nipkow
parents: 15304
diff changeset
  1078
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1079
lemma filter_filter [simp]: "filter P (filter Q xs) = filter (\<lambda>x. Q x \<and> P x) xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1080
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1081
16998
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1082
lemma length_filter_le [simp]: "length (filter P xs) \<le> length xs"
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1083
by (induct xs) (auto simp add: le_SucI)
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1084
18423
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1085
lemma sum_length_filter_compl:
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1086
  "length(filter P xs) + length(filter (%x. ~P x) xs) = length xs"
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1087
by(induct xs) simp_all
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1088
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1089
lemma filter_True [simp]: "\<forall>x \<in> set xs. P x ==> filter P xs = xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1090
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1091
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1092
lemma filter_False [simp]: "\<forall>x \<in> set xs. \<not> P x ==> filter P xs = []"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1093
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1094
16998
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1095
lemma filter_empty_conv: "(filter P xs = []) = (\<forall>x\<in>set xs. \<not> P x)" 
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  1096
by (induct xs) simp_all
16998
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1097
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1098
lemma filter_id_conv: "(filter P xs = xs) = (\<forall>x\<in>set xs. P x)"
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1099
apply (induct xs)
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1100
 apply auto
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1101
apply(cut_tac P=P and xs=xs in length_filter_le)
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1102
apply simp
e0050191e2d1 Added filter lemma
nipkow
parents: 16973
diff changeset
  1103
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1104
16965
46697fa536ab added map_filter lemmas
nipkow
parents: 16770
diff changeset
  1105
lemma filter_map:
46697fa536ab added map_filter lemmas
nipkow
parents: 16770
diff changeset
  1106
  "filter P (map f xs) = map f (filter (P o f) xs)"
46697fa536ab added map_filter lemmas
nipkow
parents: 16770
diff changeset
  1107
by (induct xs) simp_all
46697fa536ab added map_filter lemmas
nipkow
parents: 16770
diff changeset
  1108
46697fa536ab added map_filter lemmas
nipkow
parents: 16770
diff changeset
  1109
lemma length_filter_map[simp]:
46697fa536ab added map_filter lemmas
nipkow
parents: 16770
diff changeset
  1110
  "length (filter P (map f xs)) = length(filter (P o f) xs)"
46697fa536ab added map_filter lemmas
nipkow
parents: 16770
diff changeset
  1111
by (simp add:filter_map)
46697fa536ab added map_filter lemmas
nipkow
parents: 16770
diff changeset
  1112
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1113
lemma filter_is_subset [simp]: "set (filter P xs) \<le> set xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1114
by auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1115
15246
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1116
lemma length_filter_less:
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1117
  "\<lbrakk> x : set xs; ~ P x \<rbrakk> \<Longrightarrow> length(filter P xs) < length xs"
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1118
proof (induct xs)
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1119
  case Nil thus ?case by simp
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1120
next
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1121
  case (Cons x xs) thus ?case
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1122
    apply (auto split:split_if_asm)
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1123
    using length_filter_le[of P xs] apply arith
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1124
  done
0984a2c2868b added and renamed
nipkow
parents: 15245
diff changeset
  1125
qed
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1126
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1127
lemma length_filter_conv_card:
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1128
 "length(filter p xs) = card{i. i < length xs & p(xs!i)}"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1129
proof (induct xs)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1130
  case Nil thus ?case by simp
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1131
next
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1132
  case (Cons x xs)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1133
  let ?S = "{i. i < length xs & p(xs!i)}"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1134
  have fin: "finite ?S" by(fast intro: bounded_nat_set_is_finite)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1135
  show ?case (is "?l = card ?S'")
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1136
  proof (cases)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1137
    assume "p x"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1138
    hence eq: "?S' = insert 0 (Suc ` ?S)"
25162
ad4d5365d9d8 went back to >0
nipkow
parents: 25157
diff changeset
  1139
      by(auto simp: image_def split:nat.split dest:gr0_implies_Suc)
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1140
    have "length (filter p (x # xs)) = Suc(card ?S)"
23388
77645da0db85 tuned proofs: avoid implicit prems;
wenzelm
parents: 23279
diff changeset
  1141
      using Cons `p x` by simp
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1142
    also have "\<dots> = Suc(card(Suc ` ?S))" using fin
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1143
      by (simp add: card_image inj_Suc)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1144
    also have "\<dots> = card ?S'" using eq fin
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1145
      by (simp add:card_insert_if) (simp add:image_def)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1146
    finally show ?thesis .
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1147
  next
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1148
    assume "\<not> p x"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1149
    hence eq: "?S' = Suc ` ?S"
25162
ad4d5365d9d8 went back to >0
nipkow
parents: 25157
diff changeset
  1150
      by(auto simp add: image_def split:nat.split elim:lessE)
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1151
    have "length (filter p (x # xs)) = card ?S"
23388
77645da0db85 tuned proofs: avoid implicit prems;
wenzelm
parents: 23279
diff changeset
  1152
      using Cons `\<not> p x` by simp
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1153
    also have "\<dots> = card(Suc ` ?S)" using fin
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1154
      by (simp add: card_image inj_Suc)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1155
    also have "\<dots> = card ?S'" using eq fin
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1156
      by (simp add:card_insert_if)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1157
    finally show ?thesis .
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1158
  qed
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1159
qed
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1160
17629
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1161
lemma Cons_eq_filterD:
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1162
 "x#xs = filter P ys \<Longrightarrow>
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1163
  \<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs"
19585
70a1ce3b23ae removed 'concl is' patterns;
wenzelm
parents: 19487
diff changeset
  1164
  (is "_ \<Longrightarrow> \<exists>us vs. ?P ys us vs")
17629
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1165
proof(induct ys)
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1166
  case Nil thus ?case by simp
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1167
next
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1168
  case (Cons y ys)
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1169
  show ?case (is "\<exists>x. ?Q x")
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1170
  proof cases
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1171
    assume Py: "P y"
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1172
    show ?thesis
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1173
    proof cases
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1174
      assume "x = y"
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1175
      with Py Cons.prems have "?Q []" by simp
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1176
      then show ?thesis ..
17629
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1177
    next
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1178
      assume "x \<noteq> y"
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1179
      with Py Cons.prems show ?thesis by simp
17629
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1180
    qed
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1181
  next
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1182
    assume "\<not> P y"
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1183
    with Cons obtain us vs where "?P (y#ys) (y#us) vs" by fastsimp
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1184
    then have "?Q (y#us)" by simp
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1185
    then show ?thesis ..
17629
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1186
  qed
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1187
qed
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1188
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1189
lemma filter_eq_ConsD:
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1190
 "filter P ys = x#xs \<Longrightarrow>
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1191
  \<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs"
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1192
by(rule Cons_eq_filterD) simp
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1193
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1194
lemma filter_eq_Cons_iff:
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1195
 "(filter P ys = x#xs) =
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1196
  (\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)"
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1197
by(auto dest:filter_eq_ConsD)
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1198
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1199
lemma Cons_eq_filter_iff:
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1200
 "(x#xs = filter P ys) =
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1201
  (\<exists>us vs. ys = us @ x # vs \<and> (\<forall>u\<in>set us. \<not> P u) \<and> P x \<and> xs = filter P vs)"
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1202
by(auto dest:Cons_eq_filterD)
f8ea8068c6d9 a few new filter lemmas
nipkow
parents: 17589
diff changeset
  1203
19770
be5c23ebe1eb HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents: 19623
diff changeset
  1204
lemma filter_cong[fundef_cong, recdef_cong]:
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1205
 "xs = ys \<Longrightarrow> (\<And>x. x \<in> set ys \<Longrightarrow> P x = Q x) \<Longrightarrow> filter P xs = filter Q ys"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1206
apply simp
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1207
apply(erule thin_rl)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1208
by (induct ys) simp_all
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1209
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1210
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1211
subsubsection {* List partitioning *}
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1212
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1213
primrec partition :: "('a \<Rightarrow> bool) \<Rightarrow>'a list \<Rightarrow> 'a list \<times> 'a list" where
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1214
  "partition P [] = ([], [])"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1215
  | "partition P (x # xs) = 
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1216
      (let (yes, no) = partition P xs
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1217
      in if P x then (x # yes, no) else (yes, x # no))"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1218
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1219
lemma partition_filter1:
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1220
    "fst (partition P xs) = filter P xs"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1221
by (induct xs) (auto simp add: Let_def split_def)
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1222
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1223
lemma partition_filter2:
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1224
    "snd (partition P xs) = filter (Not o P) xs"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1225
by (induct xs) (auto simp add: Let_def split_def)
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1226
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1227
lemma partition_P:
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1228
  assumes "partition P xs = (yes, no)"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1229
  shows "(\<forall>p \<in> set yes.  P p) \<and> (\<forall>p  \<in> set no. \<not> P p)"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1230
proof -
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1231
  from assms have "yes = fst (partition P xs)" and "no = snd (partition P xs)"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1232
    by simp_all
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1233
  then show ?thesis by (simp_all add: partition_filter1 partition_filter2)
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1234
qed
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1235
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1236
lemma partition_set:
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1237
  assumes "partition P xs = (yes, no)"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1238
  shows "set yes \<union> set no = set xs"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1239
proof -
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1240
  from assms have "yes = fst (partition P xs)" and "no = snd (partition P xs)"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1241
    by simp_all
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1242
  then show ?thesis by (auto simp add: partition_filter1 partition_filter2) 
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1243
qed
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1244
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1245
lemma partition_filter_conv[simp]:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1246
  "partition f xs = (filter f xs,filter (Not o f) xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1247
unfolding partition_filter2[symmetric]
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1248
unfolding partition_filter1[symmetric] by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1249
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1250
declare partition.simps[simp del]
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  1251
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  1252
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  1253
subsubsection {* @{text concat} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1254
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1255
lemma concat_append [simp]: "concat (xs @ ys) = concat xs @ concat ys"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1256
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1257
18447
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
  1258
lemma concat_eq_Nil_conv [simp]: "(concat xss = []) = (\<forall>xs \<in> set xss. xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1259
by (induct xss) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1260
18447
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
  1261
lemma Nil_eq_concat_conv [simp]: "([] = concat xss) = (\<forall>xs \<in> set xss. xs = [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1262
by (induct xss) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1263
24308
700e745994c1 removed set_concat_map and improved set_concat
nipkow
parents: 24286
diff changeset
  1264
lemma set_concat [simp]: "set (concat xs) = (UN x:set xs. set x)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1265
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1266
24476
f7ad9fbbeeaa turned list comprehension translations into ML to optimize base case
nipkow
parents: 24471
diff changeset
  1267
lemma concat_map_singleton[simp]: "concat(map (%x. [f x]) xs) = map f xs"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  1268
by (induct xs) auto
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  1269
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1270
lemma map_concat: "map f (concat xs) = concat (map (map f) xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1271
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1272
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1273
lemma filter_concat: "filter p (concat xs) = concat (map (filter p) xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1274
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1275
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1276
lemma rev_concat: "rev (concat xs) = concat (map rev (rev xs))"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1277
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1278
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1279
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  1280
subsubsection {* @{text nth} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1281
29827
c82b3e8a4daf code theorems for nth, list_update
haftmann
parents: 29822
diff changeset
  1282
lemma nth_Cons_0 [simp, code]: "(x # xs)!0 = x"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1283
by auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1284
29827
c82b3e8a4daf code theorems for nth, list_update
haftmann
parents: 29822
diff changeset
  1285
lemma nth_Cons_Suc [simp, code]: "(x # xs)!(Suc n) = xs!n"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1286
by auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1287
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1288
declare nth.simps [simp del]
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1289
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1290
lemma nth_append:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1291
  "(xs @ ys)!n = (if n < length xs then xs!n else ys!(n - length xs))"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1292
apply (induct xs arbitrary: n, simp)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1293
apply (case_tac n, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1294
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1295
14402
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  1296
lemma nth_append_length [simp]: "(xs @ x # ys) ! length xs = x"
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1297
by (induct xs) auto
14402
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  1298
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  1299
lemma nth_append_length_plus[simp]: "(xs @ ys) ! (length xs + n) = ys ! n"
25221
5ded95dda5df append/member: more light-weight way to declare authentic syntax;
wenzelm
parents: 25215
diff changeset
  1300
by (induct xs) auto
14402
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  1301
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1302
lemma nth_map [simp]: "n < length xs ==> (map f xs)!n = f(xs!n)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1303
apply (induct xs arbitrary: n, simp)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1304
apply (case_tac n, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1305
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1306
18423
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1307
lemma hd_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd xs = xs!0"
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1308
by(cases xs) simp_all
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1309
18049
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  1310
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  1311
lemma list_eq_iff_nth_eq:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1312
 "(xs = ys) = (length xs = length ys \<and> (ALL i<length xs. xs!i = ys!i))"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1313
apply(induct xs arbitrary: ys)
24632
779fc4fcbf8b metis now available in PreList
paulson
parents: 24617
diff changeset
  1314
 apply force
18049
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  1315
apply(case_tac ys)
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  1316
 apply simp
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  1317
apply(simp add:nth_Cons split:nat.split)apply blast
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  1318
done
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  1319
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1320
lemma set_conv_nth: "set xs = {xs!i | i. i < length xs}"
15251
bb6f072c8d10 converted some induct_tac to induct
paulson
parents: 15246
diff changeset
  1321
apply (induct xs, simp, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1322
apply safe
24632
779fc4fcbf8b metis now available in PreList
paulson
parents: 24617
diff changeset
  1323
apply (metis nat_case_0 nth.simps zero_less_Suc)
779fc4fcbf8b metis now available in PreList
paulson
parents: 24617
diff changeset
  1324
apply (metis less_Suc_eq_0_disj nth_Cons_Suc)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1325
apply (case_tac i, simp)
24632
779fc4fcbf8b metis now available in PreList
paulson
parents: 24617
diff changeset
  1326
apply (metis diff_Suc_Suc nat_case_Suc nth.simps zero_less_diff)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1327
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1328
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1329
lemma in_set_conv_nth: "(x \<in> set xs) = (\<exists>i < length xs. xs!i = x)"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1330
by(auto simp:set_conv_nth)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1331
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1332
lemma list_ball_nth: "[| n < length xs; !x : set xs. P x|] ==> P(xs!n)"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1333
by (auto simp add: set_conv_nth)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1334
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1335
lemma nth_mem [simp]: "n < length xs ==> xs!n : set xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1336
by (auto simp add: set_conv_nth)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1337
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1338
lemma all_nth_imp_all_set:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1339
"[| !i < length xs. P(xs!i); x : set xs|] ==> P x"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1340
by (auto simp add: set_conv_nth)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1341
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1342
lemma all_set_conv_all_nth:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1343
"(\<forall>x \<in> set xs. P x) = (\<forall>i. i < length xs --> P (xs ! i))"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1344
by (auto simp add: set_conv_nth)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1345
25296
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1346
lemma rev_nth:
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1347
  "n < size xs \<Longrightarrow> rev xs ! n = xs ! (length xs - Suc n)"
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1348
proof (induct xs arbitrary: n)
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1349
  case Nil thus ?case by simp
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1350
next
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1351
  case (Cons x xs)
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1352
  hence n: "n < Suc (length xs)" by simp
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1353
  moreover
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1354
  { assume "n < length xs"
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1355
    with n obtain n' where "length xs - n = Suc n'"
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1356
      by (cases "length xs - n", auto)
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1357
    moreover
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1358
    then have "length xs - Suc n = n'" by simp
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1359
    ultimately
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1360
    have "xs ! (length xs - Suc n) = (x # xs) ! (length xs - n)" by simp
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1361
  }
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1362
  ultimately
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1363
  show ?case by (clarsimp simp add: Cons nth_append)
c187b7422156 rev_nth
kleing
parents: 25287
diff changeset
  1364
qed
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1365
31159
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1366
lemma Skolem_list_nth:
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1367
  "(ALL i<k. EX x. P i x) = (EX xs. size xs = k & (ALL i<k. P i (xs!i)))"
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1368
  (is "_ = (EX xs. ?P k xs)")
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1369
proof(induct k)
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1370
  case 0 show ?case by simp
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1371
next
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1372
  case (Suc k)
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1373
  show ?case (is "?L = ?R" is "_ = (EX xs. ?P' xs)")
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1374
  proof
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1375
    assume "?R" thus "?L" using Suc by auto
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1376
  next
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1377
    assume "?L"
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1378
    with Suc obtain x xs where "?P k xs & P k x" by (metis less_Suc_eq)
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1379
    hence "?P'(xs@[x])" by(simp add:nth_append less_Suc_eq)
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1380
    thus "?R" ..
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1381
  qed
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1382
qed
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1383
bac0d673b6d6 new lemma
nipkow
parents: 31154
diff changeset
  1384
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  1385
subsubsection {* @{text list_update} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1386
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1387
lemma length_list_update [simp]: "length(xs[i:=x]) = length xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1388
by (induct xs arbitrary: i) (auto split: nat.split)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1389
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1390
lemma nth_list_update:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1391
"i < length xs==> (xs[i:=x])!j = (if i = j then x else xs!j)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1392
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1393
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1394
lemma nth_list_update_eq [simp]: "i < length xs ==> (xs[i:=x])!i = x"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1395
by (simp add: nth_list_update)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1396
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1397
lemma nth_list_update_neq [simp]: "i \<noteq> j ==> xs[i:=x]!j = xs!j"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1398
by (induct xs arbitrary: i j) (auto simp add: nth_Cons split: nat.split)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1399
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1400
lemma list_update_id[simp]: "xs[i := xs!i] = xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1401
by (induct xs arbitrary: i) (simp_all split:nat.splits)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1402
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1403
lemma list_update_beyond[simp]: "length xs \<le> i \<Longrightarrow> xs[i:=x] = xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1404
apply (induct xs arbitrary: i)
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1405
 apply simp
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1406
apply (case_tac i)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1407
apply simp_all
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1408
done
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1409
31077
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1410
lemma list_update_nonempty[simp]: "xs[k:=x] = [] \<longleftrightarrow> xs=[]"
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1411
by(metis length_0_conv length_list_update)
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1412
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1413
lemma list_update_same_conv:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1414
"i < length xs ==> (xs[i := x] = xs) = (xs!i = x)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1415
by (induct xs arbitrary: i) (auto split: nat.split)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1416
14187
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1417
lemma list_update_append1:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1418
 "i < size xs \<Longrightarrow> (xs @ ys)[i:=x] = xs[i:=x] @ ys"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1419
apply (induct xs arbitrary: i, simp)
14187
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1420
apply(simp split:nat.split)
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1421
done
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1422
15868
9634b3f9d910 more about list_update
kleing
parents: 15693
diff changeset
  1423
lemma list_update_append:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1424
  "(xs @ ys) [n:= x] = 
15868
9634b3f9d910 more about list_update
kleing
parents: 15693
diff changeset
  1425
  (if n < length xs then xs[n:= x] @ ys else xs @ (ys [n-length xs:= x]))"
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1426
by (induct xs arbitrary: n) (auto split:nat.splits)
15868
9634b3f9d910 more about list_update
kleing
parents: 15693
diff changeset
  1427
14402
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  1428
lemma list_update_length [simp]:
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  1429
 "(xs @ x # ys)[length xs := y] = (xs @ y # ys)"
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  1430
by (induct xs, auto)
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  1431
31264
2662d1cdc51f more lemmas
nipkow
parents: 31258
diff changeset
  1432
lemma map_update: "map f (xs[k:= y]) = (map f xs)[k := f y]"
2662d1cdc51f more lemmas
nipkow
parents: 31258
diff changeset
  1433
by(induct xs arbitrary: k)(auto split:nat.splits)
2662d1cdc51f more lemmas
nipkow
parents: 31258
diff changeset
  1434
2662d1cdc51f more lemmas
nipkow
parents: 31258
diff changeset
  1435
lemma rev_update:
2662d1cdc51f more lemmas
nipkow
parents: 31258
diff changeset
  1436
  "k < length xs \<Longrightarrow> rev (xs[k:= y]) = (rev xs)[length xs - k - 1 := y]"
2662d1cdc51f more lemmas
nipkow
parents: 31258
diff changeset
  1437
by (induct xs arbitrary: k) (auto simp: list_update_append split:nat.splits)
2662d1cdc51f more lemmas
nipkow
parents: 31258
diff changeset
  1438
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1439
lemma update_zip:
31080
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  1440
  "(zip xs ys)[i:=xy] = zip (xs[i:=fst xy]) (ys[i:=snd xy])"
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1441
by (induct ys arbitrary: i xy xs) (auto, case_tac xs, auto split: nat.split)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1442
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1443
lemma set_update_subset_insert: "set(xs[i:=x]) <= insert x (set xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1444
by (induct xs arbitrary: i) (auto split: nat.split)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1445
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1446
lemma set_update_subsetI: "[| set xs <= A; x:A |] ==> set(xs[i := x]) <= A"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1447
by (blast dest!: set_update_subset_insert [THEN subsetD])
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1448
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1449
lemma set_update_memI: "n < length xs \<Longrightarrow> x \<in> set (xs[n := x])"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1450
by (induct xs arbitrary: n) (auto split:nat.splits)
15868
9634b3f9d910 more about list_update
kleing
parents: 15693
diff changeset
  1451
31077
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1452
lemma list_update_overwrite[simp]:
24796
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1453
  "xs [i := x, i := y] = xs [i := y]"
31077
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1454
apply (induct xs arbitrary: i) apply simp
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1455
apply (case_tac i, simp_all)
24796
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1456
done
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1457
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1458
lemma list_update_swap:
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1459
  "i \<noteq> i' \<Longrightarrow> xs [i := x, i' := x'] = xs [i' := x', i := x]"
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1460
apply (induct xs arbitrary: i i')
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1461
apply simp
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1462
apply (case_tac i, case_tac i')
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1463
apply auto
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1464
apply (case_tac i')
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1465
apply auto
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1466
done
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1467
29827
c82b3e8a4daf code theorems for nth, list_update
haftmann
parents: 29822
diff changeset
  1468
lemma list_update_code [code]:
c82b3e8a4daf code theorems for nth, list_update
haftmann
parents: 29822
diff changeset
  1469
  "[][i := y] = []"
c82b3e8a4daf code theorems for nth, list_update
haftmann
parents: 29822
diff changeset
  1470
  "(x # xs)[0 := y] = y # xs"
c82b3e8a4daf code theorems for nth, list_update
haftmann
parents: 29822
diff changeset
  1471
  "(x # xs)[Suc i := y] = x # xs[i := y]"
c82b3e8a4daf code theorems for nth, list_update
haftmann
parents: 29822
diff changeset
  1472
  by simp_all
c82b3e8a4daf code theorems for nth, list_update
haftmann
parents: 29822
diff changeset
  1473
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1474
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  1475
subsubsection {* @{text last} and @{text butlast} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1476
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1477
lemma last_snoc [simp]: "last (xs @ [x]) = x"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1478
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1479
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1480
lemma butlast_snoc [simp]: "butlast (xs @ [x]) = xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1481
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1482
14302
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1483
lemma last_ConsL: "xs = [] \<Longrightarrow> last(x#xs) = x"
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1484
by(simp add:last.simps)
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1485
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1486
lemma last_ConsR: "xs \<noteq> [] \<Longrightarrow> last(x#xs) = last xs"
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1487
by(simp add:last.simps)
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1488
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1489
lemma last_append: "last(xs @ ys) = (if ys = [] then last xs else last ys)"
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1490
by (induct xs) (auto)
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1491
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1492
lemma last_appendL[simp]: "ys = [] \<Longrightarrow> last(xs @ ys) = last xs"
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1493
by(simp add:last_append)
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1494
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1495
lemma last_appendR[simp]: "ys \<noteq> [] \<Longrightarrow> last(xs @ ys) = last ys"
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1496
by(simp add:last_append)
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  1497
17762
478869f444ca new hd/rev/last lemmas
nipkow
parents: 17724
diff changeset
  1498
lemma hd_rev: "xs \<noteq> [] \<Longrightarrow> hd(rev xs) = last xs"
478869f444ca new hd/rev/last lemmas
nipkow
parents: 17724
diff changeset
  1499
by(rule rev_exhaust[of xs]) simp_all
478869f444ca new hd/rev/last lemmas
nipkow
parents: 17724
diff changeset
  1500
478869f444ca new hd/rev/last lemmas
nipkow
parents: 17724
diff changeset
  1501
lemma last_rev: "xs \<noteq> [] \<Longrightarrow> last(rev xs) = hd xs"
478869f444ca new hd/rev/last lemmas
nipkow
parents: 17724
diff changeset
  1502
by(cases xs) simp_all
478869f444ca new hd/rev/last lemmas
nipkow
parents: 17724
diff changeset
  1503
17765
e3cd31bc2e40 added last in set lemma
nipkow
parents: 17762
diff changeset
  1504
lemma last_in_set[simp]: "as \<noteq> [] \<Longrightarrow> last as \<in> set as"
e3cd31bc2e40 added last in set lemma
nipkow
parents: 17762
diff changeset
  1505
by (induct as) auto
17762
478869f444ca new hd/rev/last lemmas
nipkow
parents: 17724
diff changeset
  1506
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1507
lemma length_butlast [simp]: "length (butlast xs) = length xs - 1"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1508
by (induct xs rule: rev_induct) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1509
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1510
lemma butlast_append:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1511
  "butlast (xs @ ys) = (if ys = [] then butlast xs else xs @ butlast ys)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1512
by (induct xs arbitrary: ys) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1513
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1514
lemma append_butlast_last_id [simp]:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1515
"xs \<noteq> [] ==> butlast xs @ [last xs] = xs"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1516
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1517
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1518
lemma in_set_butlastD: "x : set (butlast xs) ==> x : set xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1519
by (induct xs) (auto split: split_if_asm)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1520
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1521
lemma in_set_butlast_appendI:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1522
"x : set (butlast xs) | x : set (butlast ys) ==> x : set (butlast (xs @ ys))"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1523
by (auto dest: in_set_butlastD simp add: butlast_append)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1524
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1525
lemma last_drop[simp]: "n < length xs \<Longrightarrow> last (drop n xs) = last xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1526
apply (induct xs arbitrary: n)
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1527
 apply simp
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1528
apply (auto split:nat.split)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1529
done
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1530
30128
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1531
lemma last_conv_nth: "xs\<noteq>[] \<Longrightarrow> last xs = xs!(length xs - 1)"
17589
58eeffd73be1 renamed rules to iprover
nipkow
parents: 17501
diff changeset
  1532
by(induct xs)(auto simp:neq_Nil_conv)
58eeffd73be1 renamed rules to iprover
nipkow
parents: 17501
diff changeset
  1533
30128
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1534
lemma butlast_conv_take: "butlast xs = take (length xs - 1) xs"
26584
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1535
by (induct xs, simp, case_tac xs, simp_all)
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1536
31077
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1537
lemma last_list_update:
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1538
  "xs \<noteq> [] \<Longrightarrow> last(xs[k:=x]) = (if k = size xs - 1 then x else last xs)"
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1539
by (auto simp: last_conv_nth)
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1540
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1541
lemma butlast_list_update:
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1542
  "butlast(xs[k:=x]) =
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1543
 (if k = size xs - 1 then butlast xs else (butlast xs)[k:=x])"
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1544
apply(cases xs rule:rev_cases)
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1545
apply simp
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1546
apply(simp add:list_update_append split:nat.splits)
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1547
done
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1548
36851
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  1549
lemma last_map:
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  1550
  "xs \<noteq> [] \<Longrightarrow> last (map f xs) = f (last xs)"
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  1551
  by (cases xs rule: rev_cases) simp_all
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  1552
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  1553
lemma map_butlast:
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  1554
  "map f (butlast xs) = butlast (map f xs)"
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  1555
  by (induct xs) simp_all
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  1556
24796
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1557
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  1558
subsubsection {* @{text take} and @{text drop} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1559
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1560
lemma take_0 [simp]: "take 0 xs = []"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1561
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1562
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1563
lemma drop_0 [simp]: "drop 0 xs = xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1564
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1565
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1566
lemma take_Suc_Cons [simp]: "take (Suc n) (x # xs) = x # take n xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1567
by simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1568
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1569
lemma drop_Suc_Cons [simp]: "drop (Suc n) (x # xs) = drop n xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1570
by simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1571
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1572
declare take_Cons [simp del] and drop_Cons [simp del]
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1573
30128
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1574
lemma take_1_Cons [simp]: "take 1 (x # xs) = [x]"
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1575
  unfolding One_nat_def by simp
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1576
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1577
lemma drop_1_Cons [simp]: "drop 1 (x # xs) = xs"
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1578
  unfolding One_nat_def by simp
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1579
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1580
lemma take_Suc: "xs ~= [] ==> take (Suc n) xs = hd xs # take n (tl xs)"
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1581
by(clarsimp simp add:neq_Nil_conv)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1582
14187
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1583
lemma drop_Suc: "drop (Suc n) xs = drop n (tl xs)"
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1584
by(cases xs, simp_all)
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1585
26584
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1586
lemma take_tl: "take n (tl xs) = tl (take (Suc n) xs)"
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1587
by (induct xs arbitrary: n) simp_all
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1588
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1589
lemma drop_tl: "drop n (tl xs) = tl(drop n xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1590
by(induct xs arbitrary: n, simp_all add:drop_Cons drop_Suc split:nat.split)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1591
26584
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1592
lemma tl_take: "tl (take n xs) = take (n - 1) (tl xs)"
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1593
by (cases n, simp, cases xs, auto)
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1594
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1595
lemma tl_drop: "tl (drop n xs) = drop n (tl xs)"
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1596
by (simp only: drop_tl)
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1597
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1598
lemma nth_via_drop: "drop n xs = y#ys \<Longrightarrow> xs!n = y"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1599
apply (induct xs arbitrary: n, simp)
14187
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1600
apply(simp add:drop_Cons nth_Cons split:nat.splits)
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1601
done
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1602
13913
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1603
lemma take_Suc_conv_app_nth:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1604
  "i < length xs \<Longrightarrow> take (Suc i) xs = take i xs @ [xs!i]"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1605
apply (induct xs arbitrary: i, simp)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1606
apply (case_tac i, auto)
13913
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1607
done
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1608
14591
7be4d5dadf15 lemma drop_Suc_conv_tl added.
mehta
parents: 14589
diff changeset
  1609
lemma drop_Suc_conv_tl:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1610
  "i < length xs \<Longrightarrow> (xs!i) # (drop (Suc i) xs) = drop i xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1611
apply (induct xs arbitrary: i, simp)
14591
7be4d5dadf15 lemma drop_Suc_conv_tl added.
mehta
parents: 14589
diff changeset
  1612
apply (case_tac i, auto)
7be4d5dadf15 lemma drop_Suc_conv_tl added.
mehta
parents: 14589
diff changeset
  1613
done
7be4d5dadf15 lemma drop_Suc_conv_tl added.
mehta
parents: 14589
diff changeset
  1614
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1615
lemma length_take [simp]: "length (take n xs) = min (length xs) n"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1616
by (induct n arbitrary: xs) (auto, case_tac xs, auto)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1617
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1618
lemma length_drop [simp]: "length (drop n xs) = (length xs - n)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1619
by (induct n arbitrary: xs) (auto, case_tac xs, auto)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1620
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1621
lemma take_all [simp]: "length xs <= n ==> take n xs = xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1622
by (induct n arbitrary: xs) (auto, case_tac xs, auto)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1623
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1624
lemma drop_all [simp]: "length xs <= n ==> drop n xs = []"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1625
by (induct n arbitrary: xs) (auto, case_tac xs, auto)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1626
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1627
lemma take_append [simp]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1628
  "take n (xs @ ys) = (take n xs @ take (n - length xs) ys)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1629
by (induct n arbitrary: xs) (auto, case_tac xs, auto)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1630
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1631
lemma drop_append [simp]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1632
  "drop n (xs @ ys) = drop n xs @ drop (n - length xs) ys"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1633
by (induct n arbitrary: xs) (auto, case_tac xs, auto)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1634
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1635
lemma take_take [simp]: "take n (take m xs) = take (min n m) xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1636
apply (induct m arbitrary: xs n, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1637
apply (case_tac xs, auto)
15236
f289e8ba2bb3 Proofs needed to be updated because induction now preserves name of
nipkow
parents: 15176
diff changeset
  1638
apply (case_tac n, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1639
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1640
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1641
lemma drop_drop [simp]: "drop n (drop m xs) = drop (n + m) xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1642
apply (induct m arbitrary: xs, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1643
apply (case_tac xs, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1644
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1645
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1646
lemma take_drop: "take n (drop m xs) = drop m (take (n + m) xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1647
apply (induct m arbitrary: xs n, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1648
apply (case_tac xs, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1649
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1650
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1651
lemma drop_take: "drop n (take m xs) = take (m-n) (drop n xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1652
apply(induct xs arbitrary: m n)
14802
e05116289ff9 added drop_take:thm
nipkow
parents: 14770
diff changeset
  1653
 apply simp
e05116289ff9 added drop_take:thm
nipkow
parents: 14770
diff changeset
  1654
apply(simp add: take_Cons drop_Cons split:nat.split)
e05116289ff9 added drop_take:thm
nipkow
parents: 14770
diff changeset
  1655
done
e05116289ff9 added drop_take:thm
nipkow
parents: 14770
diff changeset
  1656
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1657
lemma append_take_drop_id [simp]: "take n xs @ drop n xs = xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1658
apply (induct n arbitrary: xs, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1659
apply (case_tac xs, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1660
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1661
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1662
lemma take_eq_Nil[simp]: "(take n xs = []) = (n = 0 \<or> xs = [])"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1663
apply(induct xs arbitrary: n)
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1664
 apply simp
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1665
apply(simp add:take_Cons split:nat.split)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1666
done
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1667
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1668
lemma drop_eq_Nil[simp]: "(drop n xs = []) = (length xs <= n)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1669
apply(induct xs arbitrary: n)
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1670
apply simp
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1671
apply(simp add:drop_Cons split:nat.split)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1672
done
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1673
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1674
lemma take_map: "take n (map f xs) = map f (take n xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1675
apply (induct n arbitrary: xs, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1676
apply (case_tac xs, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1677
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1678
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1679
lemma drop_map: "drop n (map f xs) = map f (drop n xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1680
apply (induct n arbitrary: xs, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1681
apply (case_tac xs, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1682
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1683
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1684
lemma rev_take: "rev (take i xs) = drop (length xs - i) (rev xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1685
apply (induct xs arbitrary: i, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1686
apply (case_tac i, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1687
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1688
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1689
lemma rev_drop: "rev (drop i xs) = take (length xs - i) (rev xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1690
apply (induct xs arbitrary: i, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1691
apply (case_tac i, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1692
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1693
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1694
lemma nth_take [simp]: "i < n ==> (take n xs)!i = xs!i"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1695
apply (induct xs arbitrary: i n, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1696
apply (case_tac n, blast)
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1697
apply (case_tac i, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1698
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1699
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1700
lemma nth_drop [simp]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1701
  "n + i <= length xs ==> (drop n xs)!i = xs!(n + i)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1702
apply (induct n arbitrary: xs i, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1703
apply (case_tac xs, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1704
done
3507
157be29ad5ba Improved length = size translation.
nipkow
parents: 3465
diff changeset
  1705
26584
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1706
lemma butlast_take:
30128
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1707
  "n <= length xs ==> butlast (take n xs) = take (n - 1) xs"
26584
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1708
by (simp add: butlast_conv_take min_max.inf_absorb1 min_max.inf_absorb2)
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1709
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1710
lemma butlast_drop: "butlast (drop n xs) = drop n (butlast xs)"
30128
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1711
by (simp add: butlast_conv_take drop_take add_ac)
26584
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1712
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1713
lemma take_butlast: "n < length xs ==> take n (butlast xs) = take n xs"
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1714
by (simp add: butlast_conv_take min_max.inf_absorb1)
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1715
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1716
lemma drop_butlast: "drop n (butlast xs) = butlast (drop n xs)"
30128
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  1717
by (simp add: butlast_conv_take drop_take add_ac)
26584
46f3b89b2445 move lemmas from Word/BinBoolList.thy to List.thy
huffman
parents: 26480
diff changeset
  1718
18423
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1719
lemma hd_drop_conv_nth: "\<lbrakk> xs \<noteq> []; n < length xs \<rbrakk> \<Longrightarrow> hd(drop n xs) = xs!n"
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1720
by(simp add: hd_conv_nth)
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1721
35248
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1722
lemma set_take_subset_set_take:
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1723
  "m <= n \<Longrightarrow> set(take m xs) <= set(take n xs)"
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1724
by(induct xs arbitrary: m n)(auto simp:take_Cons split:nat.split)
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1725
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1726
lemma set_take_subset: "set(take n xs) \<subseteq> set xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1727
by(induct xs arbitrary: n)(auto simp:take_Cons split:nat.split)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1728
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1729
lemma set_drop_subset: "set(drop n xs) \<subseteq> set xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1730
by(induct xs arbitrary: n)(auto simp:drop_Cons split:nat.split)
14025
d9b155757dc8 *** empty log message ***
nipkow
parents: 13913
diff changeset
  1731
35248
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1732
lemma set_drop_subset_set_drop:
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1733
  "m >= n \<Longrightarrow> set(drop m xs) <= set(drop n xs)"
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1734
apply(induct xs arbitrary: m n)
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1735
apply(auto simp:drop_Cons split:nat.split)
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1736
apply (metis set_drop_subset subset_iff)
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1737
done
e64950874224 added lemma
nipkow
parents: 35217
diff changeset
  1738
14187
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1739
lemma in_set_takeD: "x : set(take n xs) \<Longrightarrow> x : set xs"
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1740
using set_take_subset by fast
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1741
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1742
lemma in_set_dropD: "x : set(drop n xs) \<Longrightarrow> x : set xs"
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1743
using set_drop_subset by fast
26dfcd0ac436 Added new theorems
nipkow
parents: 14111
diff changeset
  1744
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1745
lemma append_eq_conv_conj:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1746
  "(xs @ ys = zs) = (xs = take (length xs) zs \<and> ys = drop (length xs) zs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1747
apply (induct xs arbitrary: zs, simp, clarsimp)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  1748
apply (case_tac zs, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1749
done
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1750
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1751
lemma take_add: 
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1752
  "i+j \<le> length(xs) \<Longrightarrow> take (i+j) xs = take i xs @ take j (drop i xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1753
apply (induct xs arbitrary: i, auto) 
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1754
apply (case_tac i, simp_all)
14050
826037db30cd new theorem
paulson
parents: 14025
diff changeset
  1755
done
826037db30cd new theorem
paulson
parents: 14025
diff changeset
  1756
14300
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
  1757
lemma append_eq_append_conv_if:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1758
 "(xs\<^isub>1 @ xs\<^isub>2 = ys\<^isub>1 @ ys\<^isub>2) =
14300
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
  1759
  (if size xs\<^isub>1 \<le> size ys\<^isub>1
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
  1760
   then xs\<^isub>1 = take (size xs\<^isub>1) ys\<^isub>1 \<and> xs\<^isub>2 = drop (size xs\<^isub>1) ys\<^isub>1 @ ys\<^isub>2
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
  1761
   else take (size ys\<^isub>1) xs\<^isub>1 = ys\<^isub>1 \<and> drop (size ys\<^isub>1) xs\<^isub>1 @ xs\<^isub>2 = ys\<^isub>2)"
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1762
apply(induct xs\<^isub>1 arbitrary: ys\<^isub>1)
14300
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
  1763
 apply simp
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
  1764
apply(case_tac ys\<^isub>1)
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
  1765
apply simp_all
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
  1766
done
bf8b8c9425c3 *** empty log message ***
nipkow
parents: 14247
diff changeset
  1767
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1768
lemma take_hd_drop:
30079
293b896b9c25 make proofs work whether or not One_nat_def is a simp rule; replace 1 with Suc 0 in the rhs of some simp rules
huffman
parents: 30008
diff changeset
  1769
  "n < length xs \<Longrightarrow> take n xs @ [hd (drop n xs)] = take (Suc n) xs"
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  1770
apply(induct xs arbitrary: n)
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1771
apply simp
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1772
apply(simp add:drop_Cons split:nat.split)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1773
done
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  1774
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1775
lemma id_take_nth_drop:
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1776
 "i < length xs \<Longrightarrow> xs = take i xs @ xs!i # drop (Suc i) xs" 
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1777
proof -
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1778
  assume si: "i < length xs"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1779
  hence "xs = take (Suc i) xs @ drop (Suc i) xs" by auto
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1780
  moreover
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1781
  from si have "take (Suc i) xs = take i xs @ [xs!i]"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1782
    apply (rule_tac take_Suc_conv_app_nth) by arith
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1783
  ultimately show ?thesis by auto
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1784
qed
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1785
  
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1786
lemma upd_conv_take_nth_drop:
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1787
 "i < length xs \<Longrightarrow> xs[i:=a] = take i xs @ a # drop (Suc i) xs"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1788
proof -
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1789
  assume i: "i < length xs"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1790
  have "xs[i:=a] = (take i xs @ xs!i # drop (Suc i) xs)[i:=a]"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1791
    by(rule arg_cong[OF id_take_nth_drop[OF i]])
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1792
  also have "\<dots> = take i xs @ a # drop (Suc i) xs"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1793
    using i by (simp add: list_update_append)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1794
  finally show ?thesis .
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1795
qed
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1796
24796
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1797
lemma nth_drop':
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1798
  "i < length xs \<Longrightarrow> xs ! i # drop (Suc i) xs = drop i xs"
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1799
apply (induct i arbitrary: xs)
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1800
apply (simp add: neq_Nil_conv)
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1801
apply (erule exE)+
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1802
apply simp
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1803
apply (case_tac xs)
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1804
apply simp_all
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1805
done
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  1806
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1807
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  1808
subsubsection {* @{text takeWhile} and @{text dropWhile} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1809
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1810
lemma length_takeWhile_le: "length (takeWhile P xs) \<le> length xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1811
  by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1812
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1813
lemma takeWhile_dropWhile_id [simp]: "takeWhile P xs @ dropWhile P xs = xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1814
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1815
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1816
lemma takeWhile_append1 [simp]:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1817
"[| x:set xs; ~P(x)|] ==> takeWhile P (xs @ ys) = takeWhile P xs"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1818
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1819
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1820
lemma takeWhile_append2 [simp]:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1821
"(!!x. x : set xs ==> P x) ==> takeWhile P (xs @ ys) = xs @ takeWhile P ys"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1822
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1823
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1824
lemma takeWhile_tail: "\<not> P x ==> takeWhile P (xs @ (x#l)) = takeWhile P xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1825
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1826
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1827
lemma takeWhile_nth: "j < length (takeWhile P xs) \<Longrightarrow> takeWhile P xs ! j = xs ! j"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1828
apply (subst (3) takeWhile_dropWhile_id[symmetric]) unfolding nth_append by auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1829
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1830
lemma dropWhile_nth: "j < length (dropWhile P xs) \<Longrightarrow> dropWhile P xs ! j = xs ! (j + length (takeWhile P xs))"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1831
apply (subst (3) takeWhile_dropWhile_id[symmetric]) unfolding nth_append by auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1832
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1833
lemma length_dropWhile_le: "length (dropWhile P xs) \<le> length xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1834
by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1835
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1836
lemma dropWhile_append1 [simp]:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1837
"[| x : set xs; ~P(x)|] ==> dropWhile P (xs @ ys) = (dropWhile P xs)@ys"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1838
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1839
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1840
lemma dropWhile_append2 [simp]:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1841
"(!!x. x:set xs ==> P(x)) ==> dropWhile P (xs @ ys) = dropWhile P ys"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1842
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1843
23971
e6d505d5b03d renamed lemma "set_take_whileD" to "set_takeWhileD"
krauss
parents: 23740
diff changeset
  1844
lemma set_takeWhileD: "x : set (takeWhile P xs) ==> x : set xs \<and> P x"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1845
by (induct xs) (auto split: split_if_asm)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1846
13913
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1847
lemma takeWhile_eq_all_conv[simp]:
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1848
 "(takeWhile P xs = xs) = (\<forall>x \<in> set xs. P x)"
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1849
by(induct xs, auto)
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1850
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1851
lemma dropWhile_eq_Nil_conv[simp]:
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1852
 "(dropWhile P xs = []) = (\<forall>x \<in> set xs. P x)"
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1853
by(induct xs, auto)
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1854
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1855
lemma dropWhile_eq_Cons_conv:
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1856
 "(dropWhile P xs = y#ys) = (xs = takeWhile P xs @ y # ys & \<not> P y)"
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1857
by(induct xs, auto)
b3ed67af04b8 Added take/dropWhile thms
nipkow
parents: 13883
diff changeset
  1858
31077
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1859
lemma distinct_takeWhile[simp]: "distinct xs ==> distinct (takeWhile P xs)"
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1860
by (induct xs) (auto dest: set_takeWhileD)
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1861
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1862
lemma distinct_dropWhile[simp]: "distinct xs ==> distinct (dropWhile P xs)"
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1863
by (induct xs) auto
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1864
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1865
lemma takeWhile_map: "takeWhile P (map f xs) = map f (takeWhile (P \<circ> f) xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1866
by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1867
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1868
lemma dropWhile_map: "dropWhile P (map f xs) = map f (dropWhile (P \<circ> f) xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1869
by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1870
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1871
lemma takeWhile_eq_take: "takeWhile P xs = take (length (takeWhile P xs)) xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1872
by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1873
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1874
lemma dropWhile_eq_drop: "dropWhile P xs = drop (length (takeWhile P xs)) xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1875
by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1876
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1877
lemma hd_dropWhile:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1878
  "dropWhile P xs \<noteq> [] \<Longrightarrow> \<not> P (hd (dropWhile P xs))"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1879
using assms by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1880
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1881
lemma takeWhile_eq_filter:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1882
  assumes "\<And> x. x \<in> set (dropWhile P xs) \<Longrightarrow> \<not> P x"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1883
  shows "takeWhile P xs = filter P xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1884
proof -
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1885
  have A: "filter P xs = filter P (takeWhile P xs @ dropWhile P xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1886
    by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1887
  have B: "filter P (dropWhile P xs) = []"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1888
    unfolding filter_empty_conv using assms by blast
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1889
  have "filter P xs = takeWhile P xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1890
    unfolding A filter_append B
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1891
    by (auto simp add: filter_id_conv dest: set_takeWhileD)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1892
  thus ?thesis ..
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1893
qed
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1894
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1895
lemma takeWhile_eq_take_P_nth:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1896
  "\<lbrakk> \<And> i. \<lbrakk> i < n ; i < length xs \<rbrakk> \<Longrightarrow> P (xs ! i) ; n < length xs \<Longrightarrow> \<not> P (xs ! n) \<rbrakk> \<Longrightarrow>
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1897
  takeWhile P xs = take n xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1898
proof (induct xs arbitrary: n)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1899
  case (Cons x xs)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1900
  thus ?case
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1901
  proof (cases n)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1902
    case (Suc n') note this[simp]
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1903
    have "P x" using Cons.prems(1)[of 0] by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1904
    moreover have "takeWhile P xs = take n' xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1905
    proof (rule Cons.hyps)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1906
      case goal1 thus "P (xs ! i)" using Cons.prems(1)[of "Suc i"] by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1907
    next case goal2 thus ?case using Cons by auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1908
    qed
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1909
    ultimately show ?thesis by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1910
   qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1911
qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1912
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1913
lemma nth_length_takeWhile:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1914
  "length (takeWhile P xs) < length xs \<Longrightarrow> \<not> P (xs ! length (takeWhile P xs))"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1915
by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1916
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1917
lemma length_takeWhile_less_P_nth:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1918
  assumes all: "\<And> i. i < j \<Longrightarrow> P (xs ! i)" and "j \<le> length xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1919
  shows "j \<le> length (takeWhile P xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1920
proof (rule classical)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1921
  assume "\<not> ?thesis"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1922
  hence "length (takeWhile P xs) < length xs" using assms by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1923
  thus ?thesis using all `\<not> ?thesis` nth_length_takeWhile[of P xs] by auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  1924
qed
31077
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  1925
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1926
text{* The following two lemmmas could be generalized to an arbitrary
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1927
property. *}
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1928
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1929
lemma takeWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow>
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1930
 takeWhile (\<lambda>y. y \<noteq> x) (rev xs) = rev (tl (dropWhile (\<lambda>y. y \<noteq> x) xs))"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1931
by(induct xs) (auto simp: takeWhile_tail[where l="[]"])
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1932
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1933
lemma dropWhile_neq_rev: "\<lbrakk>distinct xs; x \<in> set xs\<rbrakk> \<Longrightarrow>
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1934
  dropWhile (\<lambda>y. y \<noteq> x) (rev xs) = x # rev (takeWhile (\<lambda>y. y \<noteq> x) xs)"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1935
apply(induct xs)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1936
 apply simp
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1937
apply auto
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1938
apply(subst dropWhile_append2)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1939
apply auto
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1940
done
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  1941
18423
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1942
lemma takeWhile_not_last:
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1943
 "\<lbrakk> xs \<noteq> []; distinct xs\<rbrakk> \<Longrightarrow> takeWhile (\<lambda>y. y \<noteq> last xs) xs = butlast xs"
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1944
apply(induct xs)
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1945
 apply simp
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1946
apply(case_tac xs)
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1947
apply(auto)
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1948
done
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  1949
19770
be5c23ebe1eb HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents: 19623
diff changeset
  1950
lemma takeWhile_cong [fundef_cong, recdef_cong]:
18336
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  1951
  "[| l = k; !!x. x : set l ==> P x = Q x |] 
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  1952
  ==> takeWhile P l = takeWhile Q k"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  1953
by (induct k arbitrary: l) (simp_all)
18336
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  1954
19770
be5c23ebe1eb HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents: 19623
diff changeset
  1955
lemma dropWhile_cong [fundef_cong, recdef_cong]:
18336
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  1956
  "[| l = k; !!x. x : set l ==> P x = Q x |] 
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  1957
  ==> dropWhile P l = dropWhile Q k"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  1958
by (induct k arbitrary: l, simp_all)
18336
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  1959
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1960
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  1961
subsubsection {* @{text zip} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1962
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1963
lemma zip_Nil [simp]: "zip [] ys = []"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1964
by (induct ys) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1965
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1966
lemma zip_Cons_Cons [simp]: "zip (x # xs) (y # ys) = (x, y) # zip xs ys"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  1967
by simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1968
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1969
declare zip_Cons [simp del]
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1970
36198
ead2db2be11a more convenient equations for zip
haftmann
parents: 35828
diff changeset
  1971
lemma [code]:
ead2db2be11a more convenient equations for zip
haftmann
parents: 35828
diff changeset
  1972
  "zip [] ys = []"
ead2db2be11a more convenient equations for zip
haftmann
parents: 35828
diff changeset
  1973
  "zip xs [] = []"
ead2db2be11a more convenient equations for zip
haftmann
parents: 35828
diff changeset
  1974
  "zip (x # xs) (y # ys) = (x, y) # zip xs ys"
ead2db2be11a more convenient equations for zip
haftmann
parents: 35828
diff changeset
  1975
  by (fact zip_Nil zip.simps(1) zip_Cons_Cons)+
ead2db2be11a more convenient equations for zip
haftmann
parents: 35828
diff changeset
  1976
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1977
lemma zip_Cons1:
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1978
 "zip (x#xs) ys = (case ys of [] \<Rightarrow> [] | y#ys \<Rightarrow> (x,y)#zip xs ys)"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1979
by(auto split:list.split)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  1980
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  1981
lemma length_zip [simp]:
22493
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  1982
"length (zip xs ys) = min (length xs) (length ys)"
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  1983
by (induct xs ys rule:list_induct2') auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  1984
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1985
lemma zip_obtain_same_length:
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1986
  assumes "\<And>zs ws n. length zs = length ws \<Longrightarrow> n = min (length xs) (length ys)
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1987
    \<Longrightarrow> zs = take n xs \<Longrightarrow> ws = take n ys \<Longrightarrow> P (zip zs ws)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1988
  shows "P (zip xs ys)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1989
proof -
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1990
  let ?n = "min (length xs) (length ys)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1991
  have "P (zip (take ?n xs) (take ?n ys))"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1992
    by (rule assms) simp_all
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1993
  moreover have "zip xs ys = zip (take ?n xs) (take ?n ys)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1994
  proof (induct xs arbitrary: ys)
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1995
    case Nil then show ?case by simp
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1996
  next
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1997
    case (Cons x xs) then show ?case by (cases ys) simp_all
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1998
  qed
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  1999
  ultimately show ?thesis by simp
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2000
qed
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2001
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2002
lemma zip_append1:
22493
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2003
"zip (xs @ ys) zs =
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2004
zip xs (take (length xs) zs) @ zip ys (drop (length xs) zs)"
22493
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2005
by (induct xs zs rule:list_induct2') auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2006
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2007
lemma zip_append2:
22493
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2008
"zip xs (ys @ zs) =
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2009
zip (take (length ys) xs) ys @ zip (drop (length ys) xs) zs"
22493
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2010
by (induct xs ys rule:list_induct2') auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2011
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2012
lemma zip_append [simp]:
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2013
 "[| length xs = length us; length ys = length vs |] ==>
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2014
zip (xs@ys) (us@vs) = zip xs us @ zip ys vs"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2015
by (simp add: zip_append1)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2016
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2017
lemma zip_rev:
14247
cb32eb89bddd *** empty log message ***
nipkow
parents: 14208
diff changeset
  2018
"length xs = length ys ==> zip (rev xs) (rev ys) = rev (zip xs ys)"
cb32eb89bddd *** empty log message ***
nipkow
parents: 14208
diff changeset
  2019
by (induct rule:list_induct2, simp_all)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2020
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2021
lemma zip_map_map:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2022
  "zip (map f xs) (map g ys) = map (\<lambda> (x, y). (f x, g y)) (zip xs ys)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2023
proof (induct xs arbitrary: ys)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2024
  case (Cons x xs) note Cons_x_xs = Cons.hyps
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2025
  show ?case
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2026
  proof (cases ys)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2027
    case (Cons y ys')
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2028
    show ?thesis unfolding Cons using Cons_x_xs by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2029
  qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2030
qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2031
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2032
lemma zip_map1:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2033
  "zip (map f xs) ys = map (\<lambda>(x, y). (f x, y)) (zip xs ys)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2034
using zip_map_map[of f xs "\<lambda>x. x" ys] by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2035
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2036
lemma zip_map2:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2037
  "zip xs (map f ys) = map (\<lambda>(x, y). (x, f y)) (zip xs ys)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2038
using zip_map_map[of "\<lambda>x. x" xs f ys] by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2039
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2040
lemma map_zip_map:
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2041
  "map f (zip (map g xs) ys) = map (%(x,y). f(g x, y)) (zip xs ys)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2042
unfolding zip_map1 by auto
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2043
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2044
lemma map_zip_map2:
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2045
  "map f (zip xs (map g ys)) = map (%(x,y). f(x, g y)) (zip xs ys)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2046
unfolding zip_map2 by auto
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2047
31080
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  2048
text{* Courtesy of Andreas Lochbihler: *}
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  2049
lemma zip_same_conv_map: "zip xs xs = map (\<lambda>x. (x, x)) xs"
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  2050
by(induct xs) auto
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  2051
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2052
lemma nth_zip [simp]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2053
"[| i < length xs; i < length ys|] ==> (zip xs ys)!i = (xs!i, ys!i)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2054
apply (induct ys arbitrary: i xs, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2055
apply (case_tac xs)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2056
 apply (simp_all add: nth.simps split: nat.split)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2057
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2058
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2059
lemma set_zip:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2060
"set (zip xs ys) = {(xs!i, ys!i) | i. i < min (length xs) (length ys)}"
31080
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  2061
by(simp add: set_conv_nth cong: rev_conj_cong)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2062
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2063
lemma zip_same: "((a,b) \<in> set (zip xs xs)) = (a \<in> set xs \<and> a = b)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2064
by(induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2065
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2066
lemma zip_update:
31080
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  2067
  "zip (xs[i:=x]) (ys[i:=y]) = (zip xs ys)[i:=(x,y)]"
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  2068
by(rule sym, simp add: update_zip)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2069
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2070
lemma zip_replicate [simp]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2071
  "zip (replicate i x) (replicate j y) = replicate (min i j) (x,y)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2072
apply (induct i arbitrary: j, auto)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  2073
apply (case_tac j, auto)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2074
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2075
19487
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2076
lemma take_zip:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2077
  "take n (zip xs ys) = zip (take n xs) (take n ys)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2078
apply (induct n arbitrary: xs ys)
19487
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2079
 apply simp
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2080
apply (case_tac xs, simp)
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2081
apply (case_tac ys, simp_all)
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2082
done
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2083
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2084
lemma drop_zip:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2085
  "drop n (zip xs ys) = zip (drop n xs) (drop n ys)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2086
apply (induct n arbitrary: xs ys)
19487
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2087
 apply simp
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2088
apply (case_tac xs, simp)
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2089
apply (case_tac ys, simp_all)
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2090
done
d5e79a41bce0 added zip/take/drop lemmas
nipkow
parents: 19390
diff changeset
  2091
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2092
lemma zip_takeWhile_fst: "zip (takeWhile P xs) ys = takeWhile (P \<circ> fst) (zip xs ys)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2093
proof (induct xs arbitrary: ys)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2094
  case (Cons x xs) thus ?case by (cases ys) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2095
qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2096
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2097
lemma zip_takeWhile_snd: "zip xs (takeWhile P ys) = takeWhile (P \<circ> snd) (zip xs ys)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2098
proof (induct xs arbitrary: ys)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2099
  case (Cons x xs) thus ?case by (cases ys) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2100
qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2101
22493
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2102
lemma set_zip_leftD:
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2103
  "(x,y)\<in> set (zip xs ys) \<Longrightarrow> x \<in> set xs"
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2104
by (induct xs ys rule:list_induct2') auto
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2105
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2106
lemma set_zip_rightD:
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2107
  "(x,y)\<in> set (zip xs ys) \<Longrightarrow> y \<in> set ys"
db930e490fe5 added another rule for simultaneous induction, and lemmas for zip
krauss
parents: 22422
diff changeset
  2108
by (induct xs ys rule:list_induct2') auto
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2109
23983
79dc793bec43 Added lemmas
nipkow
parents: 23971
diff changeset
  2110
lemma in_set_zipE:
79dc793bec43 Added lemmas
nipkow
parents: 23971
diff changeset
  2111
  "(x,y) : set(zip xs ys) \<Longrightarrow> (\<lbrakk> x : set xs; y : set ys \<rbrakk> \<Longrightarrow> R) \<Longrightarrow> R"
79dc793bec43 Added lemmas
nipkow
parents: 23971
diff changeset
  2112
by(blast dest: set_zip_leftD set_zip_rightD)
79dc793bec43 Added lemmas
nipkow
parents: 23971
diff changeset
  2113
29829
9acb915a62fa code theorems for nth, list_update
haftmann
parents: 29827
diff changeset
  2114
lemma zip_map_fst_snd:
9acb915a62fa code theorems for nth, list_update
haftmann
parents: 29827
diff changeset
  2115
  "zip (map fst zs) (map snd zs) = zs"
9acb915a62fa code theorems for nth, list_update
haftmann
parents: 29827
diff changeset
  2116
  by (induct zs) simp_all
9acb915a62fa code theorems for nth, list_update
haftmann
parents: 29827
diff changeset
  2117
9acb915a62fa code theorems for nth, list_update
haftmann
parents: 29827
diff changeset
  2118
lemma zip_eq_conv:
9acb915a62fa code theorems for nth, list_update
haftmann
parents: 29827
diff changeset
  2119
  "length xs = length ys \<Longrightarrow> zip xs ys = zs \<longleftrightarrow> map fst zs = xs \<and> map snd zs = ys"
9acb915a62fa code theorems for nth, list_update
haftmann
parents: 29827
diff changeset
  2120
  by (auto simp add: zip_map_fst_snd)
9acb915a62fa code theorems for nth, list_update
haftmann
parents: 29827
diff changeset
  2121
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2122
lemma distinct_zipI1:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2123
  "distinct xs \<Longrightarrow> distinct (zip xs ys)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2124
proof (induct xs arbitrary: ys)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2125
  case (Cons x xs)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2126
  show ?case
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2127
  proof (cases ys)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2128
    case (Cons y ys')
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2129
    have "(x, y) \<notin> set (zip xs ys')"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2130
      using Cons.prems by (auto simp: set_zip)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2131
    thus ?thesis
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2132
      unfolding Cons zip_Cons_Cons distinct.simps
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2133
      using Cons.hyps Cons.prems by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2134
  qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2135
qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2136
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2137
lemma distinct_zipI2:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2138
  "distinct xs \<Longrightarrow> distinct (zip xs ys)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2139
proof (induct xs arbitrary: ys)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2140
  case (Cons x xs)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2141
  show ?case
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2142
  proof (cases ys)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2143
    case (Cons y ys')
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2144
     have "(x, y) \<notin> set (zip xs ys')"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2145
      using Cons.prems by (auto simp: set_zip)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2146
    thus ?thesis
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2147
      unfolding Cons zip_Cons_Cons distinct.simps
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2148
      using Cons.hyps Cons.prems by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2149
  qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2150
qed simp
29829
9acb915a62fa code theorems for nth, list_update
haftmann
parents: 29827
diff changeset
  2151
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  2152
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  2153
subsubsection {* @{text list_all2} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2154
14316
91b897b9a2dc added some [intro?] and [trans] for list_all2 lemmas
kleing
parents: 14302
diff changeset
  2155
lemma list_all2_lengthD [intro?]: 
91b897b9a2dc added some [intro?] and [trans] for list_all2 lemmas
kleing
parents: 14302
diff changeset
  2156
  "list_all2 P xs ys ==> length xs = length ys"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2157
by (simp add: list_all2_def)
19607
07eeb832f28d introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents: 19585
diff changeset
  2158
19787
b949911ecff5 improved code lemmas
haftmann
parents: 19770
diff changeset
  2159
lemma list_all2_Nil [iff, code]: "list_all2 P [] ys = (ys = [])"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2160
by (simp add: list_all2_def)
19607
07eeb832f28d introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents: 19585
diff changeset
  2161
19787
b949911ecff5 improved code lemmas
haftmann
parents: 19770
diff changeset
  2162
lemma list_all2_Nil2 [iff, code]: "list_all2 P xs [] = (xs = [])"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2163
by (simp add: list_all2_def)
19607
07eeb832f28d introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents: 19585
diff changeset
  2164
07eeb832f28d introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents: 19585
diff changeset
  2165
lemma list_all2_Cons [iff, code]:
07eeb832f28d introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents: 19585
diff changeset
  2166
  "list_all2 P (x # xs) (y # ys) = (P x y \<and> list_all2 P xs ys)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2167
by (auto simp add: list_all2_def)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2168
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2169
lemma list_all2_Cons1:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2170
"list_all2 P (x # xs) ys = (\<exists>z zs. ys = z # zs \<and> P x z \<and> list_all2 P xs zs)"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2171
by (cases ys) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2172
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2173
lemma list_all2_Cons2:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2174
"list_all2 P xs (y # ys) = (\<exists>z zs. xs = z # zs \<and> P z y \<and> list_all2 P zs ys)"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2175
by (cases xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2176
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2177
lemma list_all2_rev [iff]:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2178
"list_all2 P (rev xs) (rev ys) = list_all2 P xs ys"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2179
by (simp add: list_all2_def zip_rev cong: conj_cong)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2180
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2181
lemma list_all2_rev1:
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2182
"list_all2 P (rev xs) ys = list_all2 P xs (rev ys)"
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2183
by (subst list_all2_rev [symmetric]) simp
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2184
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2185
lemma list_all2_append1:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2186
"list_all2 P (xs @ ys) zs =
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2187
(EX us vs. zs = us @ vs \<and> length us = length xs \<and> length vs = length ys \<and>
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2188
list_all2 P xs us \<and> list_all2 P ys vs)"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2189
apply (simp add: list_all2_def zip_append1)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2190
apply (rule iffI)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2191
 apply (rule_tac x = "take (length xs) zs" in exI)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2192
 apply (rule_tac x = "drop (length xs) zs" in exI)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  2193
 apply (force split: nat_diff_split simp add: min_def, clarify)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2194
apply (simp add: ball_Un)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2195
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2196
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2197
lemma list_all2_append2:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2198
"list_all2 P xs (ys @ zs) =
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2199
(EX us vs. xs = us @ vs \<and> length us = length ys \<and> length vs = length zs \<and>
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2200
list_all2 P us ys \<and> list_all2 P vs zs)"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2201
apply (simp add: list_all2_def zip_append2)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2202
apply (rule iffI)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2203
 apply (rule_tac x = "take (length ys) xs" in exI)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2204
 apply (rule_tac x = "drop (length ys) xs" in exI)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  2205
 apply (force split: nat_diff_split simp add: min_def, clarify)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2206
apply (simp add: ball_Un)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2207
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2208
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2209
lemma list_all2_append:
14247
cb32eb89bddd *** empty log message ***
nipkow
parents: 14208
diff changeset
  2210
  "length xs = length ys \<Longrightarrow>
cb32eb89bddd *** empty log message ***
nipkow
parents: 14208
diff changeset
  2211
  list_all2 P (xs@us) (ys@vs) = (list_all2 P xs ys \<and> list_all2 P us vs)"
cb32eb89bddd *** empty log message ***
nipkow
parents: 14208
diff changeset
  2212
by (induct rule:list_induct2, simp_all)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2213
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2214
lemma list_all2_appendI [intro?, trans]:
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2215
  "\<lbrakk> list_all2 P a b; list_all2 P c d \<rbrakk> \<Longrightarrow> list_all2 P (a@c) (b@d)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2216
by (simp add: list_all2_append list_all2_lengthD)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2217
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2218
lemma list_all2_conv_all_nth:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2219
"list_all2 P xs ys =
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2220
(length xs = length ys \<and> (\<forall>i < length xs. P (xs!i) (ys!i)))"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2221
by (force simp add: list_all2_def set_zip)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2222
13883
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2223
lemma list_all2_trans:
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2224
  assumes tr: "!!a b c. P1 a b ==> P2 b c ==> P3 a c"
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2225
  shows "!!bs cs. list_all2 P1 as bs ==> list_all2 P2 bs cs ==> list_all2 P3 as cs"
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2226
        (is "!!bs cs. PROP ?Q as bs cs")
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2227
proof (induct as)
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2228
  fix x xs bs assume I1: "!!bs cs. PROP ?Q xs bs cs"
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2229
  show "!!cs. PROP ?Q (x # xs) bs cs"
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2230
  proof (induct bs)
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2231
    fix y ys cs assume I2: "!!cs. PROP ?Q (x # xs) ys cs"
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2232
    show "PROP ?Q (x # xs) (y # ys) cs"
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2233
      by (induct cs) (auto intro: tr I1 I2)
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2234
  qed simp
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2235
qed simp
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2236
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2237
lemma list_all2_all_nthI [intro?]:
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2238
  "length a = length b \<Longrightarrow> (\<And>n. n < length a \<Longrightarrow> P (a!n) (b!n)) \<Longrightarrow> list_all2 P a b"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2239
by (simp add: list_all2_conv_all_nth)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2240
14395
cc96cc06abf9 new theorem
paulson
parents: 14388
diff changeset
  2241
lemma list_all2I:
cc96cc06abf9 new theorem
paulson
parents: 14388
diff changeset
  2242
  "\<forall>x \<in> set (zip a b). split P x \<Longrightarrow> length a = length b \<Longrightarrow> list_all2 P a b"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2243
by (simp add: list_all2_def)
14395
cc96cc06abf9 new theorem
paulson
parents: 14388
diff changeset
  2244
14328
fd063037fdf5 list_all2_nthD no good as [intro?]
kleing
parents: 14327
diff changeset
  2245
lemma list_all2_nthD:
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2246
  "\<lbrakk> list_all2 P xs ys; p < size xs \<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2247
by (simp add: list_all2_conv_all_nth)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2248
14302
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  2249
lemma list_all2_nthD2:
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  2250
  "\<lbrakk>list_all2 P xs ys; p < size ys\<rbrakk> \<Longrightarrow> P (xs!p) (ys!p)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2251
by (frule list_all2_lengthD) (auto intro: list_all2_nthD)
14302
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  2252
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2253
lemma list_all2_map1: 
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2254
  "list_all2 P (map f as) bs = list_all2 (\<lambda>x y. P (f x) y) as bs"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2255
by (simp add: list_all2_conv_all_nth)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2256
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2257
lemma list_all2_map2: 
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2258
  "list_all2 P as (map f bs) = list_all2 (\<lambda>x y. P x (f y)) as bs"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2259
by (auto simp add: list_all2_conv_all_nth)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2260
14316
91b897b9a2dc added some [intro?] and [trans] for list_all2 lemmas
kleing
parents: 14302
diff changeset
  2261
lemma list_all2_refl [intro?]:
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2262
  "(\<And>x. P x x) \<Longrightarrow> list_all2 P xs xs"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2263
by (simp add: list_all2_conv_all_nth)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2264
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2265
lemma list_all2_update_cong:
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2266
  "\<lbrakk> i<size xs; list_all2 P xs ys; P x y \<rbrakk> \<Longrightarrow> list_all2 P (xs[i:=x]) (ys[i:=y])"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2267
by (simp add: list_all2_conv_all_nth nth_list_update)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2268
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2269
lemma list_all2_update_cong2:
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2270
  "\<lbrakk>list_all2 P xs ys; P x y; i < length ys\<rbrakk> \<Longrightarrow> list_all2 P (xs[i:=x]) (ys[i:=y])"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2271
by (simp add: list_all2_lengthD list_all2_update_cong)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2272
14302
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  2273
lemma list_all2_takeI [simp,intro?]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2274
  "list_all2 P xs ys \<Longrightarrow> list_all2 P (take n xs) (take n ys)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2275
apply (induct xs arbitrary: n ys)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2276
 apply simp
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2277
apply (clarsimp simp add: list_all2_Cons1)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2278
apply (case_tac n)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2279
apply auto
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2280
done
14302
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  2281
6c24235e8d5d *** empty log message ***
nipkow
parents: 14300
diff changeset
  2282
lemma list_all2_dropI [simp,intro?]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2283
  "list_all2 P as bs \<Longrightarrow> list_all2 P (drop n as) (drop n bs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2284
apply (induct as arbitrary: n bs, simp)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2285
apply (clarsimp simp add: list_all2_Cons1)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2286
apply (case_tac n, simp, simp)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2287
done
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2288
14327
9cd4dea593e3 list_all2_mono should not be [trans]
kleing
parents: 14316
diff changeset
  2289
lemma list_all2_mono [intro?]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2290
  "list_all2 P xs ys \<Longrightarrow> (\<And>xs ys. P xs ys \<Longrightarrow> Q xs ys) \<Longrightarrow> list_all2 Q xs ys"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2291
apply (induct xs arbitrary: ys, simp)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2292
apply (case_tac ys, auto)
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2293
done
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2294
22551
e52f5400e331 paraphrasing equality
haftmann
parents: 22539
diff changeset
  2295
lemma list_all2_eq:
e52f5400e331 paraphrasing equality
haftmann
parents: 22539
diff changeset
  2296
  "xs = ys \<longleftrightarrow> list_all2 (op =) xs ys"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2297
by (induct xs ys rule: list_induct2') auto
22551
e52f5400e331 paraphrasing equality
haftmann
parents: 22539
diff changeset
  2298
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2299
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  2300
subsubsection {* @{text foldl} and @{text foldr} *}
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2301
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2302
lemma foldl_append [simp]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2303
  "foldl f a (xs @ ys) = foldl f (foldl f a xs) ys"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2304
by (induct xs arbitrary: a) auto
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2305
14402
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  2306
lemma foldr_append[simp]: "foldr f (xs @ ys) a = foldr f xs (foldr f ys a)"
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  2307
by (induct xs) auto
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  2308
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2309
lemma foldr_map: "foldr g (map f xs) a = foldr (g o f) xs a"
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2310
by(induct xs) simp_all
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2311
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2312
text{* For efficient code generation: avoid intermediate list. *}
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  2313
lemma foldl_map[code_unfold]:
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2314
  "foldl g a (map f xs) = foldl (%a x. g a (f x)) a xs"
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2315
by(induct xs arbitrary:a) simp_all
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2316
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2317
lemma foldl_apply:
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2318
  assumes "\<And>x. x \<in> set xs \<Longrightarrow> f x \<circ> h = h \<circ> g x"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2319
  shows "foldl (\<lambda>s x. f x s) (h s) xs = h (foldl (\<lambda>s x. g x s) s xs)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2320
  by (rule sym, insert assms, induct xs arbitrary: s) (simp_all add: expand_fun_eq)
31930
3107b9af1fb3 lemma foldl_apply_inv
haftmann
parents: 31784
diff changeset
  2321
19770
be5c23ebe1eb HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents: 19623
diff changeset
  2322
lemma foldl_cong [fundef_cong, recdef_cong]:
18336
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  2323
  "[| a = b; l = k; !!a x. x : set l ==> f a x = g a x |] 
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  2324
  ==> foldl f a l = foldl g b k"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2325
by (induct k arbitrary: a b l) simp_all
18336
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  2326
19770
be5c23ebe1eb HOL/Tools/function_package: Added support for mutual recursive definitions.
krauss
parents: 19623
diff changeset
  2327
lemma foldr_cong [fundef_cong, recdef_cong]:
18336
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  2328
  "[| a = b; l = k; !!a x. x : set l ==> f x a = g x a |] 
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  2329
  ==> foldr f l a = foldr g k b"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2330
by (induct k arbitrary: a b l) simp_all
18336
1a2e30b37ed3 Added recdef congruence rules for bounded quantifiers and commonly used
krauss
parents: 18049
diff changeset
  2331
35195
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2332
lemma foldl_fun_comm:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2333
  assumes "\<And>x y s. f (f s x) y = f (f s y) x"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2334
  shows "f (foldl f s xs) x = foldl f (f s x) xs"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2335
  by (induct xs arbitrary: s)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2336
    (simp_all add: assms)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2337
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2338
lemma (in semigroup_add) foldl_assoc:
25062
af5ef0d4d655 global class syntax
haftmann
parents: 24902
diff changeset
  2339
shows "foldl op+ (x+y) zs = x + (foldl op+ y zs)"
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2340
by (induct zs arbitrary: y) (simp_all add:add_assoc)
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2341
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2342
lemma (in monoid_add) foldl_absorb0:
25062
af5ef0d4d655 global class syntax
haftmann
parents: 24902
diff changeset
  2343
shows "x + (foldl op+ 0 zs) = foldl op+ x zs"
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2344
by (induct zs) (simp_all add:foldl_assoc)
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2345
35195
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2346
lemma foldl_rev:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2347
  assumes "\<And>x y s. f (f s x) y = f (f s y) x"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2348
  shows "foldl f s (rev xs) = foldl f s xs"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2349
proof (induct xs arbitrary: s)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2350
  case Nil then show ?case by simp
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2351
next
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2352
  case (Cons x xs) with assms show ?case by (simp add: foldl_fun_comm)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2353
qed
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2354
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2355
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2356
text{* The ``First Duality Theorem'' in Bird \& Wadler: *}
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2357
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2358
lemma foldl_foldr1_lemma:
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2359
 "foldl op + a xs = a + foldr op + xs (0\<Colon>'a::monoid_add)"
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2360
by (induct xs arbitrary: a) (auto simp:add_assoc)
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2361
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2362
corollary foldl_foldr1:
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2363
 "foldl op + 0 xs = foldr op + xs (0\<Colon>'a::monoid_add)"
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2364
by (simp add:foldl_foldr1_lemma)
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2365
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2366
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2367
text{* The ``Third Duality Theorem'' in Bird \& Wadler: *}
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2368
14402
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  2369
lemma foldr_foldl: "foldr f xs a = foldl (%x y. f y x) a (rev xs)"
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  2370
by (induct xs) auto
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  2371
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  2372
lemma foldl_foldr: "foldl f a xs = foldr (%x y. f y x) (rev xs) a"
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  2373
by (simp add: foldr_foldl [of "%x y. f y x" "rev xs"])
4201e1916482 moved lemmas from MicroJava/Comp/AuxLemmas.thy to List.thy
nipkow
parents: 14395
diff changeset
  2374
25062
af5ef0d4d655 global class syntax
haftmann
parents: 24902
diff changeset
  2375
lemma (in ab_semigroup_add) foldr_conv_foldl: "foldr op + xs a = foldl op + a xs"
24471
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2376
  by (induct xs, auto simp add: foldl_assoc add_commute)
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2377
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2378
text {*
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2379
Note: @{text "n \<le> foldl (op +) n ns"} looks simpler, but is more
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2380
difficult to use because it requires an additional transitivity step.
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2381
*}
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2382
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2383
lemma start_le_sum: "(m::nat) <= n ==> m <= foldl (op +) n ns"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2384
by (induct ns arbitrary: n) auto
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2385
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2386
lemma elem_le_sum: "(n::nat) : set ns ==> n <= foldl (op +) 0 ns"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2387
by (force intro: start_le_sum simp add: in_set_conv_decomp)
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2388
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2389
lemma sum_eq_0_conv [iff]:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2390
  "(foldl (op +) (m::nat) ns = 0) = (m = 0 \<and> (\<forall>n \<in> set ns. n = 0))"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2391
by (induct ns arbitrary: m) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2392
24471
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2393
lemma foldr_invariant: 
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2394
  "\<lbrakk>Q x ; \<forall> x\<in> set xs. P x; \<forall> x y. P x \<and> Q y \<longrightarrow> Q (f x y) \<rbrakk> \<Longrightarrow> Q (foldr f xs x)"
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2395
  by (induct xs, simp_all)
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2396
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2397
lemma foldl_invariant: 
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2398
  "\<lbrakk>Q x ; \<forall> x\<in> set xs. P x; \<forall> x y. P x \<and> Q y \<longrightarrow> Q (f y x) \<rbrakk> \<Longrightarrow> Q (foldl f x xs)"
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2399
  by (induct xs arbitrary: x, simp_all)
d7cf53c1085f removed unused theorems ; added lifting properties for foldr and foldl
chaieb
parents: 24461
diff changeset
  2400
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2401
lemma foldl_weak_invariant:
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2402
  assumes "P s"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2403
    and "\<And>s x. x \<in> set xs \<Longrightarrow> P s \<Longrightarrow> P (f s x)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2404
  shows "P (foldl f s xs)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2405
  using assms by (induct xs arbitrary: s) simp_all
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2406
31455
2754a0dadccc lemma about List.foldl and Finite_Set.fold
haftmann
parents: 31363
diff changeset
  2407
text {* @{const foldl} and @{const concat} *}
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2408
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2409
lemma foldl_conv_concat:
29782
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2410
  "foldl (op @) xs xss = xs @ concat xss"
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2411
proof (induct xss arbitrary: xs)
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2412
  case Nil show ?case by simp
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2413
next
35267
8dfd816713c6 moved remaning class operations from Algebras.thy to Groups.thy
haftmann
parents: 35217
diff changeset
  2414
  interpret monoid_add "op @" "[]" proof qed simp_all
29782
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2415
  case Cons then show ?case by (simp add: foldl_absorb0)
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2416
qed
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2417
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2418
lemma concat_conv_foldl: "concat xss = foldl (op @) [] xss"
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2419
  by (simp add: foldl_conv_concat)
02e76245e5af dropped global Nil/Append interpretation
haftmann
parents: 29626
diff changeset
  2420
31455
2754a0dadccc lemma about List.foldl and Finite_Set.fold
haftmann
parents: 31363
diff changeset
  2421
text {* @{const Finite_Set.fold} and @{const foldl} *}
2754a0dadccc lemma about List.foldl and Finite_Set.fold
haftmann
parents: 31363
diff changeset
  2422
35195
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2423
lemma (in fun_left_comm) fold_set_remdups:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2424
  "fold f y (set xs) = foldl (\<lambda>y x. f x y) y (remdups xs)"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2425
  by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_comm insert_absorb)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  2426
31455
2754a0dadccc lemma about List.foldl and Finite_Set.fold
haftmann
parents: 31363
diff changeset
  2427
lemma (in fun_left_comm_idem) fold_set:
2754a0dadccc lemma about List.foldl and Finite_Set.fold
haftmann
parents: 31363
diff changeset
  2428
  "fold f y (set xs) = foldl (\<lambda>y x. f x y) y xs"
2754a0dadccc lemma about List.foldl and Finite_Set.fold
haftmann
parents: 31363
diff changeset
  2429
  by (rule sym, induct xs arbitrary: y) (simp_all add: fold_fun_comm)
2754a0dadccc lemma about List.foldl and Finite_Set.fold
haftmann
parents: 31363
diff changeset
  2430
32681
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2431
lemma (in ab_semigroup_idem_mult) fold1_set:
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2432
  assumes "xs \<noteq> []"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2433
  shows "fold1 times (set xs) = foldl times (hd xs) (tl xs)"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2434
proof -
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2435
  interpret fun_left_comm_idem times by (fact fun_left_comm_idem)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2436
  from assms obtain y ys where xs: "xs = y # ys"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2437
    by (cases xs) auto
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2438
  show ?thesis
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2439
  proof (cases "set ys = {}")
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2440
    case True with xs show ?thesis by simp
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2441
  next
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2442
    case False
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2443
    then have "fold1 times (insert y (set ys)) = fold times y (set ys)"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2444
      by (simp only: finite_set fold1_eq_fold_idem)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2445
    with xs show ?thesis by (simp add: fold_set mult_commute)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2446
  qed
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2447
qed
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2448
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2449
lemma (in lattice) Inf_fin_set_fold [code_unfold]:
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2450
  "Inf_fin (set (x # xs)) = foldl inf x xs"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2451
proof -
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2452
  interpret ab_semigroup_idem_mult "inf :: 'a \<Rightarrow> 'a \<Rightarrow> 'a"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2453
    by (fact ab_semigroup_idem_mult_inf)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2454
  show ?thesis
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2455
    by (simp add: Inf_fin_def fold1_set del: set.simps)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2456
qed
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2457
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2458
lemma (in lattice) Sup_fin_set_fold [code_unfold]:
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2459
  "Sup_fin (set (x # xs)) = foldl sup x xs"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2460
proof -
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2461
  interpret ab_semigroup_idem_mult "sup :: 'a \<Rightarrow> 'a \<Rightarrow> 'a"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2462
    by (fact ab_semigroup_idem_mult_sup)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2463
  show ?thesis
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2464
    by (simp add: Sup_fin_def fold1_set del: set.simps)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2465
qed
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2466
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2467
lemma (in linorder) Min_fin_set_fold [code_unfold]:
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2468
  "Min (set (x # xs)) = foldl min x xs"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2469
proof -
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2470
  interpret ab_semigroup_idem_mult "min :: 'a \<Rightarrow> 'a \<Rightarrow> 'a"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2471
    by (fact ab_semigroup_idem_mult_min)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2472
  show ?thesis
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2473
    by (simp add: Min_def fold1_set del: set.simps)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2474
qed
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2475
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2476
lemma (in linorder) Max_fin_set_fold [code_unfold]:
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2477
  "Max (set (x # xs)) = foldl max x xs"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2478
proof -
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2479
  interpret ab_semigroup_idem_mult "max :: 'a \<Rightarrow> 'a \<Rightarrow> 'a"
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2480
    by (fact ab_semigroup_idem_mult_max)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2481
  show ?thesis
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2482
    by (simp add: Max_def fold1_set del: set.simps)
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2483
qed
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2484
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2485
lemma (in complete_lattice) Inf_set_fold [code_unfold]:
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2486
  "Inf (set xs) = foldl inf top xs"
34007
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2487
proof -
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2488
  interpret fun_left_comm_idem "inf :: 'a \<Rightarrow> 'a \<Rightarrow> 'a"
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2489
    by (fact fun_left_comm_idem_inf)
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2490
  show ?thesis by (simp add: Inf_fold_inf fold_set inf_commute)
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2491
qed
32681
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2492
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2493
lemma (in complete_lattice) Sup_set_fold [code_unfold]:
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  2494
  "Sup (set xs) = foldl sup bot xs"
34007
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2495
proof -
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2496
  interpret fun_left_comm_idem "sup :: 'a \<Rightarrow> 'a \<Rightarrow> 'a"
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2497
    by (fact fun_left_comm_idem_sup)
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2498
  show ?thesis by (simp add: Sup_fold_sup fold_set sup_commute)
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2499
qed
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2500
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2501
lemma (in complete_lattice) INFI_set_fold:
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2502
  "INFI (set xs) f = foldl (\<lambda>y x. inf (f x) y) top xs"
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2503
  unfolding INFI_def set_map [symmetric] Inf_set_fold foldl_map
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2504
    by (simp add: inf_commute)
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2505
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2506
lemma (in complete_lattice) SUPR_set_fold:
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2507
  "SUPR (set xs) f = foldl (\<lambda>y x. sup (f x) y) bot xs"
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2508
  unfolding SUPR_def set_map [symmetric] Sup_set_fold foldl_map
aea892559fc5 tuned lattices theory fragements; generlized some lemmas from sets to lattices
haftmann
parents: 33972
diff changeset
  2509
    by (simp add: sup_commute)
31455
2754a0dadccc lemma about List.foldl and Finite_Set.fold
haftmann
parents: 31363
diff changeset
  2510
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  2511
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2512
subsubsection {* List summation: @{const listsum} and @{text"\<Sum>"}*}
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2513
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2514
lemma listsum_append [simp]: "listsum (xs @ ys) = listsum xs + listsum ys"
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2515
by (induct xs) (simp_all add:add_assoc)
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2516
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2517
lemma listsum_rev [simp]:
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2518
  fixes xs :: "'a\<Colon>comm_monoid_add list"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2519
  shows "listsum (rev xs) = listsum xs"
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2520
by (induct xs) (simp_all add:add_ac)
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2521
31022
a438b4516dd3 added listsum lemmas
nipkow
parents: 30971
diff changeset
  2522
lemma listsum_map_remove1:
a438b4516dd3 added listsum lemmas
nipkow
parents: 30971
diff changeset
  2523
fixes f :: "'a \<Rightarrow> ('b::comm_monoid_add)"
a438b4516dd3 added listsum lemmas
nipkow
parents: 30971
diff changeset
  2524
shows "x : set xs \<Longrightarrow> listsum(map f xs) = f x + listsum(map f (remove1 x xs))"
a438b4516dd3 added listsum lemmas
nipkow
parents: 30971
diff changeset
  2525
by (induct xs)(auto simp add:add_ac)
a438b4516dd3 added listsum lemmas
nipkow
parents: 30971
diff changeset
  2526
a438b4516dd3 added listsum lemmas
nipkow
parents: 30971
diff changeset
  2527
lemma list_size_conv_listsum:
a438b4516dd3 added listsum lemmas
nipkow
parents: 30971
diff changeset
  2528
  "list_size f xs = listsum (map f xs) + size xs"
a438b4516dd3 added listsum lemmas
nipkow
parents: 30971
diff changeset
  2529
by(induct xs) auto
a438b4516dd3 added listsum lemmas
nipkow
parents: 30971
diff changeset
  2530
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2531
lemma listsum_foldr: "listsum xs = foldr (op +) xs 0"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2532
by (induct xs) auto
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2533
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2534
lemma length_concat: "length (concat xss) = listsum (map length xss)"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2535
by (induct xss) simp_all
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2536
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2537
lemma listsum_map_filter:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2538
  fixes f :: "'a \<Rightarrow> 'b \<Colon> comm_monoid_add"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2539
  assumes "\<And> x. \<lbrakk> x \<in> set xs ; \<not> P x \<rbrakk> \<Longrightarrow> f x = 0"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2540
  shows "listsum (map f (filter P xs)) = listsum (map f xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2541
using assms by (induct xs) auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2542
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2543
text{* For efficient code generation ---
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2544
       @{const listsum} is not tail recursive but @{const foldl} is. *}
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  2545
lemma listsum[code_unfold]: "listsum xs = foldl (op +) 0 xs"
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2546
by(simp add:listsum_foldr foldl_foldr1)
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2547
31077
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  2548
lemma distinct_listsum_conv_Setsum:
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  2549
  "distinct xs \<Longrightarrow> listsum xs = Setsum(set xs)"
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  2550
by (induct xs) simp_all
28dd6fd3d184 more lemmas
nipkow
parents: 31055
diff changeset
  2551
36920
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2552
lemma listsum_eq_0_nat_iff_nat[simp]:
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2553
  "listsum ns = (0::nat) \<longleftrightarrow> (\<forall> n \<in> set ns. n = 0)"
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2554
by(simp add: listsum)
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2555
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2556
lemma elem_le_listsum_nat: "k<size ns \<Longrightarrow> ns!k <= listsum(ns::nat list)"
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2557
apply(induct ns arbitrary: k)
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2558
 apply simp
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2559
apply(fastsimp simp add:nth_Cons split: nat.split)
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2560
done
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2561
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2562
lemma listsum_update_nat: "k<size ns \<Longrightarrow>
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2563
  listsum (ns[k := (n::nat)]) = listsum ns + n - ns!k"
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2564
apply(induct ns arbitrary:k)
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2565
 apply (auto split:nat.split)
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2566
apply(drule elem_le_listsum_nat)
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2567
apply arith
62e4af74a70a added listsum lemmas
nipkow
parents: 36903
diff changeset
  2568
done
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  2569
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2570
text{* Some syntactic sugar for summing a function over a list: *}
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2571
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2572
syntax
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2573
  "_listsum" :: "pttrn => 'a list => 'b => 'b"    ("(3SUM _<-_. _)" [0, 51, 10] 10)
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2574
syntax (xsymbols)
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2575
  "_listsum" :: "pttrn => 'a list => 'b => 'b"    ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10)
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2576
syntax (HTML output)
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2577
  "_listsum" :: "pttrn => 'a list => 'b => 'b"    ("(3\<Sum>_\<leftarrow>_. _)" [0, 51, 10] 10)
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2578
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2579
translations -- {* Beware of argument permutation! *}
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  2580
  "SUM x<-xs. b" == "CONST listsum (CONST map (%x. b) xs)"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  2581
  "\<Sum>x\<leftarrow>xs. b" == "CONST listsum (CONST map (%x. b) xs)"
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2582
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2583
lemma listsum_triv: "(\<Sum>x\<leftarrow>xs. r) = of_nat (length xs) * r"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2584
  by (induct xs) (simp_all add: left_distrib)
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2585
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2586
lemma listsum_0 [simp]: "(\<Sum>x\<leftarrow>xs. 0) = 0"
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2587
  by (induct xs) (simp_all add: left_distrib)
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2588
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2589
text{* For non-Abelian groups @{text xs} needs to be reversed on one side: *}
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2590
lemma uminus_listsum_map:
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2591
  fixes f :: "'a \<Rightarrow> 'b\<Colon>ab_group_add"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2592
  shows "- listsum (map f xs) = (listsum (map (uminus o f) xs))"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  2593
by (induct xs) simp_all
23096
423ad2fe9f76 *** empty log message ***
nipkow
parents: 23060
diff changeset
  2594
31258
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2595
lemma listsum_addf:
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2596
  fixes f g :: "'a \<Rightarrow> 'b::comm_monoid_add"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2597
  shows "(\<Sum>x\<leftarrow>xs. f x + g x) = listsum (map f xs) + listsum (map g xs)"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2598
by (induct xs) (simp_all add: algebra_simps)
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2599
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2600
lemma listsum_subtractf:
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2601
  fixes f g :: "'a \<Rightarrow> 'b::ab_group_add"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2602
  shows "(\<Sum>x\<leftarrow>xs. f x - g x) = listsum (map f xs) - listsum (map g xs)"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2603
by (induct xs) simp_all
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2604
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2605
lemma listsum_const_mult:
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2606
  fixes f :: "'a \<Rightarrow> 'b::semiring_0"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2607
  shows "(\<Sum>x\<leftarrow>xs. c * f x) = c * (\<Sum>x\<leftarrow>xs. f x)"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2608
by (induct xs, simp_all add: algebra_simps)
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2609
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2610
lemma listsum_mult_const:
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2611
  fixes f :: "'a \<Rightarrow> 'b::semiring_0"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2612
  shows "(\<Sum>x\<leftarrow>xs. f x * c) = (\<Sum>x\<leftarrow>xs. f x) * c"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2613
by (induct xs, simp_all add: algebra_simps)
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2614
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2615
lemma listsum_abs:
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 34978
diff changeset
  2616
  fixes xs :: "'a::ordered_ab_group_add_abs list"
31258
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2617
  shows "\<bar>listsum xs\<bar> \<le> listsum (map abs xs)"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2618
by (induct xs, simp, simp add: order_trans [OF abs_triangle_ineq])
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2619
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2620
lemma listsum_mono:
35028
108662d50512 more consistent naming of type classes involving orderings (and lattices) -- c.f. NEWS
haftmann
parents: 34978
diff changeset
  2621
  fixes f g :: "'a \<Rightarrow> 'b::{comm_monoid_add, ordered_ab_semigroup_add}"
31258
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2622
  shows "(\<And>x. x \<in> set xs \<Longrightarrow> f x \<le> g x) \<Longrightarrow> (\<Sum>x\<leftarrow>xs. f x) \<le> (\<Sum>x\<leftarrow>xs. g x)"
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2623
by (induct xs, simp, simp add: add_mono)
43a418a41317 listsum lemmas
huffman
parents: 31201
diff changeset
  2624
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2625
24645
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  2626
subsubsection {* @{text upt} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2627
17090
603f23d71ada small mods to code lemmas
nipkow
parents: 17086
diff changeset
  2628
lemma upt_rec[code]: "[i..<j] = (if i<j then i#[Suc i..<j] else [])"
603f23d71ada small mods to code lemmas
nipkow
parents: 17086
diff changeset
  2629
-- {* simp does not terminate! *}
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2630
by (induct j) auto
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2631
32005
c369417be055 made upt/upto executable on nat/int by simp
nipkow
parents: 31998
diff changeset
  2632
lemmas upt_rec_number_of[simp] = upt_rec[of "number_of m" "number_of n", standard]
c369417be055 made upt/upto executable on nat/int by simp
nipkow
parents: 31998
diff changeset
  2633
15425
6356d2523f73 [ .. (] -> [ ..< ]
nipkow
parents: 15392
diff changeset
  2634
lemma upt_conv_Nil [simp]: "j <= i ==> [i..<j] = []"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2635
by (subst upt_rec) simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2636
15425
6356d2523f73 [ .. (] -> [ ..< ]
nipkow
parents: 15392
diff changeset
  2637
lemma upt_eq_Nil_conv[simp]: "([i..<j] = []) = (j = 0 \<or> j <= i)"
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  2638
by(induct j)simp_all
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  2639
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  2640
lemma upt_eq_Cons_conv:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2641
 "([i..<j] = x#xs) = (i < j & i = x & [i+1..<j] = xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2642
apply(induct j arbitrary: x xs)
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  2643
 apply simp
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  2644
apply(clarsimp simp add: append_eq_Cons_conv)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  2645
apply arith
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  2646
done
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  2647
15425
6356d2523f73 [ .. (] -> [ ..< ]
nipkow
parents: 15392
diff changeset
  2648
lemma upt_Suc_append: "i <= j ==> [i..<(Suc j)] = [i..<j]@[j]"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2649
-- {* Only needed if @{text upt_Suc} is deleted from the simpset. *}
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2650
by simp
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2651
15425
6356d2523f73 [ .. (] -> [ ..< ]
nipkow
parents: 15392
diff changeset
  2652
lemma upt_conv_Cons: "i < j ==> [i..<j] = i # [Suc i..<j]"
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  2653
  by (simp add: upt_rec)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2654
15425
6356d2523f73 [ .. (] -> [ ..< ]
nipkow
parents: 15392
diff changeset
  2655
lemma upt_add_eq_append: "i<=j ==> [i..<j+k] = [i..<j]@[j..<j+k]"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2656
-- {* LOOPS as a simprule, since @{text "j <= j"}. *}
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2657
by (induct k) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2658
15425
6356d2523f73 [ .. (] -> [ ..< ]
nipkow
parents: 15392
diff changeset
  2659
lemma length_upt [simp]: "length [i..<j] = j - i"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2660
by (induct j) (auto simp add: Suc_diff_le)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2661
15425
6356d2523f73 [ .. (] -> [ ..< ]
nipkow
parents: 15392
diff changeset
  2662
lemma nth_upt [simp]: "i + k < j ==> [i..<j] ! k = i + k"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2663
apply (induct j)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2664
apply (auto simp add: less_Suc_eq nth_append split: nat_diff_split)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2665
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2666
17906
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2667
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2668
lemma hd_upt[simp]: "i < j \<Longrightarrow> hd[i..<j] = i"
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2669
by(simp add:upt_conv_Cons)
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2670
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2671
lemma last_upt[simp]: "i < j \<Longrightarrow> last[i..<j] = j - 1"
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2672
apply(cases j)
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2673
 apply simp
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2674
by(simp add:upt_Suc_append)
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2675
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2676
lemma take_upt [simp]: "i+m <= n ==> take m [i..<n] = [i..<i+m]"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2677
apply (induct m arbitrary: i, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2678
apply (subst upt_rec)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2679
apply (rule sym)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2680
apply (subst upt_rec)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2681
apply (simp del: upt.simps)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2682
done
3507
157be29ad5ba Improved length = size translation.
nipkow
parents: 3465
diff changeset
  2683
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2684
lemma drop_upt[simp]: "drop m [i..<j] = [i+m..<j]"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2685
apply(induct j)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2686
apply auto
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2687
done
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2688
24645
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  2689
lemma map_Suc_upt: "map Suc [m..<n] = [Suc m..<Suc n]"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2690
by (induct n) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2691
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2692
lemma nth_map_upt: "i < n-m ==> (map f [m..<n]) ! i = f(m+i)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2693
apply (induct n m  arbitrary: i rule: diff_induct)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2694
prefer 3 apply (subst map_Suc_upt[symmetric])
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2695
apply (auto simp add: less_diff_conv nth_upt)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2696
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2697
13883
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2698
lemma nth_take_lemma:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2699
  "k <= length xs ==> k <= length ys ==>
13883
0451e0fb3f22 Re-structured some proofs in order to get rid of rule_format attribute.
berghofe
parents: 13863
diff changeset
  2700
     (!!i. i < k --> xs!i = ys!i) ==> take k xs = take k ys"
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2701
apply (atomize, induct k arbitrary: xs ys)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  2702
apply (simp_all add: less_Suc_eq_0_disj all_conj_distrib, clarify)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2703
txt {* Both lists must be non-empty *}
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  2704
apply (case_tac xs, simp)
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  2705
apply (case_tac ys, clarify)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2706
 apply (simp (no_asm_use))
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2707
apply clarify
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2708
txt {* prenexing's needed, not miniscoping *}
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2709
apply (simp (no_asm_use) add: all_simps [symmetric] del: all_simps)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2710
apply blast
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2711
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2712
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2713
lemma nth_equalityI:
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2714
 "[| length xs = length ys; ALL i < length xs. xs!i = ys!i |] ==> xs = ys"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2715
apply (frule nth_take_lemma [OF le_refl eq_imp_le])
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2716
apply (simp_all add: take_all)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2717
done
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2718
24796
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  2719
lemma map_nth:
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  2720
  "map (\<lambda>i. xs ! i) [0..<length xs] = xs"
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  2721
  by (rule nth_equalityI, auto)
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  2722
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2723
(* needs nth_equalityI *)
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2724
lemma list_all2_antisym:
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2725
  "\<lbrakk> (\<And>x y. \<lbrakk>P x y; Q y x\<rbrakk> \<Longrightarrow> x = y); list_all2 P xs ys; list_all2 Q ys xs \<rbrakk> 
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2726
  \<Longrightarrow> xs = ys"
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2727
  apply (simp add: list_all2_conv_all_nth) 
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  2728
  apply (rule nth_equalityI, blast, simp)
13863
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2729
  done
ec901a432ea1 more about list_all2
kleing
parents: 13737
diff changeset
  2730
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2731
lemma take_equalityI: "(\<forall>i. take i xs = take i ys) ==> xs = ys"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2732
-- {* The famous take-lemma. *}
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2733
apply (drule_tac x = "max (length xs) (length ys)" in spec)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2734
apply (simp add: le_max_iff_disj take_all)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2735
done
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2736
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2737
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2738
lemma take_Cons':
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2739
     "take n (x # xs) = (if n = 0 then [] else x # take (n - 1) xs)"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2740
by (cases n) simp_all
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2741
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2742
lemma drop_Cons':
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2743
     "drop n (x # xs) = (if n = 0 then x # xs else drop (n - 1) xs)"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2744
by (cases n) simp_all
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2745
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2746
lemma nth_Cons': "(x # xs)!n = (if n = 0 then x else xs!(n - 1))"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2747
by (cases n) simp_all
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2748
18622
4524643feecc theorems need names
paulson
parents: 18490
diff changeset
  2749
lemmas take_Cons_number_of = take_Cons'[of "number_of v",standard]
4524643feecc theorems need names
paulson
parents: 18490
diff changeset
  2750
lemmas drop_Cons_number_of = drop_Cons'[of "number_of v",standard]
4524643feecc theorems need names
paulson
parents: 18490
diff changeset
  2751
lemmas nth_Cons_number_of = nth_Cons'[of _ _ "number_of v",standard]
4524643feecc theorems need names
paulson
parents: 18490
diff changeset
  2752
4524643feecc theorems need names
paulson
parents: 18490
diff changeset
  2753
declare take_Cons_number_of [simp] 
4524643feecc theorems need names
paulson
parents: 18490
diff changeset
  2754
        drop_Cons_number_of [simp] 
4524643feecc theorems need names
paulson
parents: 18490
diff changeset
  2755
        nth_Cons_number_of [simp] 
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2756
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  2757
32415
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2758
subsubsection {* @{text upto}: interval-list on @{typ int} *}
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2759
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2760
(* FIXME make upto tail recursive? *)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2761
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2762
function upto :: "int \<Rightarrow> int \<Rightarrow> int list" ("(1[_../_])") where
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2763
"upto i j = (if i \<le> j then i # [i+1..j] else [])"
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2764
by auto
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2765
termination
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2766
by(relation "measure(%(i::int,j). nat(j - i + 1))") auto
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2767
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2768
declare upto.simps[code, simp del]
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2769
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2770
lemmas upto_rec_number_of[simp] =
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2771
  upto.simps[of "number_of m" "number_of n", standard]
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2772
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2773
lemma upto_empty[simp]: "j < i \<Longrightarrow> [i..j] = []"
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2774
by(simp add: upto.simps)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2775
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2776
lemma set_upto[simp]: "set[i..j] = {i..j}"
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2777
apply(induct i j rule:upto.induct)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2778
apply(simp add: upto.simps simp_from_to)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2779
done
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2780
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2781
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  2782
subsubsection {* @{text "distinct"} and @{text remdups} *}
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2783
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2784
lemma distinct_append [simp]:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2785
"distinct (xs @ ys) = (distinct xs \<and> distinct ys \<and> set xs \<inter> set ys = {})"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2786
by (induct xs) auto
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2787
15305
0bd9eedaa301 added lemmas
nipkow
parents: 15304
diff changeset
  2788
lemma distinct_rev[simp]: "distinct(rev xs) = distinct xs"
0bd9eedaa301 added lemmas
nipkow
parents: 15304
diff changeset
  2789
by(induct xs) auto
0bd9eedaa301 added lemmas
nipkow
parents: 15304
diff changeset
  2790
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2791
lemma set_remdups [simp]: "set (remdups xs) = set xs"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2792
by (induct xs) (auto simp add: insert_absorb)
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2793
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2794
lemma distinct_remdups [iff]: "distinct (remdups xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2795
by (induct xs) auto
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2796
25287
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2797
lemma distinct_remdups_id: "distinct xs ==> remdups xs = xs"
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2798
by (induct xs, auto)
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2799
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  2800
lemma remdups_id_iff_distinct [simp]: "remdups xs = xs \<longleftrightarrow> distinct xs"
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  2801
by (metis distinct_remdups distinct_remdups_id)
25287
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2802
24566
2bfa0215904c added lemma
nipkow
parents: 24526
diff changeset
  2803
lemma finite_distinct_list: "finite A \<Longrightarrow> EX xs. set xs = A & distinct xs"
24632
779fc4fcbf8b metis now available in PreList
paulson
parents: 24617
diff changeset
  2804
by (metis distinct_remdups finite_list set_remdups)
24566
2bfa0215904c added lemma
nipkow
parents: 24526
diff changeset
  2805
15072
4861bf6af0b4 new material courtesy of Norbert Voelker
paulson
parents: 15064
diff changeset
  2806
lemma remdups_eq_nil_iff [simp]: "(remdups x = []) = (x = [])"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2807
by (induct x, auto) 
15072
4861bf6af0b4 new material courtesy of Norbert Voelker
paulson
parents: 15064
diff changeset
  2808
4861bf6af0b4 new material courtesy of Norbert Voelker
paulson
parents: 15064
diff changeset
  2809
lemma remdups_eq_nil_right_iff [simp]: "([] = remdups x) = (x = [])"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2810
by (induct x, auto)
15072
4861bf6af0b4 new material courtesy of Norbert Voelker
paulson
parents: 15064
diff changeset
  2811
15245
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2812
lemma length_remdups_leq[iff]: "length(remdups xs) <= length xs"
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2813
by (induct xs) auto
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2814
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2815
lemma length_remdups_eq[iff]:
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2816
  "(length (remdups xs) = length xs) = (remdups xs = xs)"
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2817
apply(induct xs)
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2818
 apply auto
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2819
apply(subgoal_tac "length (remdups xs) <= length xs")
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2820
 apply arith
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2821
apply(rule length_remdups_leq)
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2822
done
5a21d9a8f14b Added a few lemmas
nipkow
parents: 15236
diff changeset
  2823
33945
8493ed132fed added remdups_filter lemma
nipkow
parents: 33640
diff changeset
  2824
lemma remdups_filter: "remdups(filter P xs) = filter P (remdups xs)"
8493ed132fed added remdups_filter lemma
nipkow
parents: 33640
diff changeset
  2825
apply(induct xs)
8493ed132fed added remdups_filter lemma
nipkow
parents: 33640
diff changeset
  2826
apply auto
8493ed132fed added remdups_filter lemma
nipkow
parents: 33640
diff changeset
  2827
done
18490
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2828
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2829
lemma distinct_map:
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2830
  "distinct(map f xs) = (distinct xs & inj_on f (set xs))"
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2831
by (induct xs) auto
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2832
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2833
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2834
lemma distinct_filter [simp]: "distinct xs ==> distinct (filter P xs)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2835
by (induct xs) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2836
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2837
lemma distinct_upt[simp]: "distinct[i..<j]"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2838
by (induct j) auto
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2839
32415
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2840
lemma distinct_upto[simp]: "distinct[i..j]"
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2841
apply(induct i j rule:upto.induct)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2842
apply(subst upto.simps)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2843
apply(simp)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2844
done
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  2845
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2846
lemma distinct_take[simp]: "distinct xs \<Longrightarrow> distinct (take i xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2847
apply(induct xs arbitrary: i)
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2848
 apply simp
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2849
apply (case_tac i)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2850
 apply simp_all
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2851
apply(blast dest:in_set_takeD)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2852
done
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2853
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2854
lemma distinct_drop[simp]: "distinct xs \<Longrightarrow> distinct (drop i xs)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  2855
apply(induct xs arbitrary: i)
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2856
 apply simp
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2857
apply (case_tac i)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2858
 apply simp_all
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2859
done
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2860
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2861
lemma distinct_list_update:
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2862
assumes d: "distinct xs" and a: "a \<notin> set xs - {xs!i}"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2863
shows "distinct (xs[i:=a])"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2864
proof (cases "i < length xs")
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2865
  case True
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2866
  with a have "a \<notin> set (take i xs @ xs ! i # drop (Suc i) xs) - {xs!i}"
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2867
    apply (drule_tac id_take_nth_drop) by simp
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2868
  with d True show ?thesis
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2869
    apply (simp add: upd_conv_take_nth_drop)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2870
    apply (drule subst [OF id_take_nth_drop]) apply assumption
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2871
    apply simp apply (cases "a = xs!i") apply simp by blast
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2872
next
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2873
  case False with d show ?thesis by auto
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2874
qed
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2875
31363
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  2876
lemma distinct_concat:
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  2877
  assumes "distinct xs"
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  2878
  and "\<And> ys. ys \<in> set xs \<Longrightarrow> distinct ys"
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  2879
  and "\<And> ys zs. \<lbrakk> ys \<in> set xs ; zs \<in> set xs ; ys \<noteq> zs \<rbrakk> \<Longrightarrow> set ys \<inter> set zs = {}"
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  2880
  shows "distinct (concat xs)"
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  2881
  using assms by (induct xs) auto
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2882
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2883
text {* It is best to avoid this indexed version of distinct, but
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2884
sometimes it is useful. *}
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2885
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  2886
lemma distinct_conv_nth:
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  2887
"distinct xs = (\<forall>i < size xs. \<forall>j < size xs. i \<noteq> j --> xs!i \<noteq> xs!j)"
15251
bb6f072c8d10 converted some induct_tac to induct
paulson
parents: 15246
diff changeset
  2888
apply (induct xs, simp, simp)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  2889
apply (rule iffI, clarsimp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2890
 apply (case_tac i)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  2891
apply (case_tac j, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2892
apply (simp add: set_conv_nth)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2893
 apply (case_tac j)
24648
1e8053a6d725 metis too slow
paulson
parents: 24645
diff changeset
  2894
apply (clarsimp simp add: set_conv_nth, simp) 
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2895
apply (rule conjI)
24648
1e8053a6d725 metis too slow
paulson
parents: 24645
diff changeset
  2896
(*TOO SLOW
24632
779fc4fcbf8b metis now available in PreList
paulson
parents: 24617
diff changeset
  2897
apply (metis Zero_neq_Suc gr0_conv_Suc in_set_conv_nth lessI less_trans_Suc nth_Cons' nth_Cons_Suc)
24648
1e8053a6d725 metis too slow
paulson
parents: 24645
diff changeset
  2898
*)
1e8053a6d725 metis too slow
paulson
parents: 24645
diff changeset
  2899
 apply (clarsimp simp add: set_conv_nth)
1e8053a6d725 metis too slow
paulson
parents: 24645
diff changeset
  2900
 apply (erule_tac x = 0 in allE, simp)
1e8053a6d725 metis too slow
paulson
parents: 24645
diff changeset
  2901
 apply (erule_tac x = "Suc i" in allE, simp, clarsimp)
25130
d91391a8705b avoid very slow metis invocation;
wenzelm
parents: 25112
diff changeset
  2902
(*TOO SLOW
24632
779fc4fcbf8b metis now available in PreList
paulson
parents: 24617
diff changeset
  2903
apply (metis Suc_Suc_eq lessI less_trans_Suc nth_Cons_Suc)
25130
d91391a8705b avoid very slow metis invocation;
wenzelm
parents: 25112
diff changeset
  2904
*)
d91391a8705b avoid very slow metis invocation;
wenzelm
parents: 25112
diff changeset
  2905
apply (erule_tac x = "Suc i" in allE, simp)
d91391a8705b avoid very slow metis invocation;
wenzelm
parents: 25112
diff changeset
  2906
apply (erule_tac x = "Suc j" in allE, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  2907
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  2908
18490
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2909
lemma nth_eq_iff_index_eq:
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2910
 "\<lbrakk> distinct xs; i < length xs; j < length xs \<rbrakk> \<Longrightarrow> (xs!i = xs!j) = (i = j)"
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2911
by(auto simp: distinct_conv_nth)
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2912
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  2913
lemma distinct_card: "distinct xs ==> card (set xs) = size xs"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  2914
by (induct xs) auto
14388
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2915
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  2916
lemma card_distinct: "card (set xs) = size xs ==> distinct xs"
14388
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2917
proof (induct xs)
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2918
  case Nil thus ?case by simp
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2919
next
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2920
  case (Cons x xs)
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2921
  show ?case
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2922
  proof (cases "x \<in> set xs")
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2923
    case False with Cons show ?thesis by simp
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2924
  next
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2925
    case True with Cons.prems
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2926
    have "card (set xs) = Suc (length xs)" 
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2927
      by (simp add: card_insert_if split: split_if_asm)
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2928
    moreover have "card (set xs) \<le> length xs" by (rule card_length)
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2929
    ultimately have False by simp
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2930
    thus ?thesis ..
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2931
  qed
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2932
qed
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  2933
25287
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2934
lemma not_distinct_decomp: "~ distinct ws ==> EX xs ys zs y. ws = xs@[y]@ys@[y]@zs"
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2935
apply (induct n == "length ws" arbitrary:ws) apply simp
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2936
apply(case_tac ws) apply simp
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2937
apply (simp split:split_if_asm)
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2938
apply (metis Cons_eq_appendI eq_Nil_appendI split_list)
094dab519ff5 added lemmas
nipkow
parents: 25277
diff changeset
  2939
done
18490
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2940
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2941
lemma length_remdups_concat:
434e34392c40 new lemmas
nipkow
parents: 18451
diff changeset
  2942
 "length(remdups(concat xss)) = card(\<Union>xs \<in> set xss. set xs)"
24308
700e745994c1 removed set_concat_map and improved set_concat
nipkow
parents: 24286
diff changeset
  2943
by(simp add: set_concat distinct_card[symmetric])
17906
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2944
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2945
lemma length_remdups_card_conv: "length(remdups xs) = card(set xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2946
proof -
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2947
  have xs: "concat[xs] = xs" by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2948
  from length_remdups_concat[of "[xs]"] show ?thesis unfolding xs by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  2949
qed
17906
719364f5179b added 2 lemmas
nipkow
parents: 17877
diff changeset
  2950
36275
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  2951
lemma remdups_remdups:
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  2952
  "remdups (remdups xs) = remdups xs"
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  2953
  by (induct xs) simp_all
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  2954
36851
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  2955
lemma distinct_butlast:
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  2956
  assumes "xs \<noteq> []" and "distinct xs"
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  2957
  shows "distinct (butlast xs)"
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  2958
proof -
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  2959
  from `xs \<noteq> []` obtain ys y where "xs = ys @ [y]" by (cases xs rule: rev_cases) auto
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  2960
  with `distinct xs` show ?thesis by simp
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  2961
qed
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  2962
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  2963
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2964
subsubsection {* @{const insert} *}
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2965
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2966
lemma in_set_insert [simp]:
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2967
  "x \<in> set xs \<Longrightarrow> List.insert x xs = xs"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2968
  by (simp add: List.insert_def)
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2969
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2970
lemma not_in_set_insert [simp]:
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2971
  "x \<notin> set xs \<Longrightarrow> List.insert x xs = x # xs"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2972
  by (simp add: List.insert_def)
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2973
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2974
lemma insert_Nil [simp]:
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2975
  "List.insert x [] = [x]"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2976
  by simp
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2977
35295
397295fa8387 lemma distinct_insert
haftmann
parents: 35248
diff changeset
  2978
lemma set_insert [simp]:
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2979
  "set (List.insert x xs) = insert x (set xs)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2980
  by (auto simp add: List.insert_def)
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  2981
35295
397295fa8387 lemma distinct_insert
haftmann
parents: 35248
diff changeset
  2982
lemma distinct_insert [simp]:
397295fa8387 lemma distinct_insert
haftmann
parents: 35248
diff changeset
  2983
  "distinct xs \<Longrightarrow> distinct (List.insert x xs)"
397295fa8387 lemma distinct_insert
haftmann
parents: 35248
diff changeset
  2984
  by (simp add: List.insert_def)
397295fa8387 lemma distinct_insert
haftmann
parents: 35248
diff changeset
  2985
36275
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  2986
lemma insert_remdups:
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  2987
  "List.insert x (remdups xs) = remdups (List.insert x xs)"
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  2988
  by (simp add: List.insert_def)
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  2989
37107
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2990
lemma distinct_induct [consumes 1, case_names Nil insert]:
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2991
  assumes "distinct xs"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2992
  assumes "P []"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2993
  assumes insert: "\<And>x xs. distinct xs \<Longrightarrow> x \<notin> set xs
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2994
    \<Longrightarrow> P xs \<Longrightarrow> P (List.insert x xs)"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2995
  shows "P xs"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2996
using `distinct xs` proof (induct xs)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2997
  case Nil from `P []` show ?case .
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2998
next
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  2999
  case (Cons x xs)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3000
  then have "distinct xs" and "x \<notin> set xs" and "P xs" by simp_all
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3001
  with insert have "P (List.insert x xs)" .
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3002
  with `x \<notin> set xs` show ?case by simp
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3003
qed
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3004
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3005
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  3006
subsubsection {* @{text remove1} *}
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3007
18049
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3008
lemma remove1_append:
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3009
  "remove1 x (xs @ ys) =
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3010
  (if x \<in> set xs then remove1 x xs @ ys else xs @ remove1 x ys)"
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3011
by (induct xs) auto
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3012
36903
489c1fbbb028 Multiset: renamed, added and tuned lemmas;
nipkow
parents: 36851
diff changeset
  3013
lemma remove1_commute: "remove1 x (remove1 y zs) = remove1 y (remove1 x zs)"
489c1fbbb028 Multiset: renamed, added and tuned lemmas;
nipkow
parents: 36851
diff changeset
  3014
by (induct zs) auto
489c1fbbb028 Multiset: renamed, added and tuned lemmas;
nipkow
parents: 36851
diff changeset
  3015
23479
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3016
lemma in_set_remove1[simp]:
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3017
  "a \<noteq> b \<Longrightarrow> a : set(remove1 b xs) = (a : set xs)"
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3018
apply (induct xs)
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3019
apply auto
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3020
done
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3021
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3022
lemma set_remove1_subset: "set(remove1 x xs) <= set xs"
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3023
apply(induct xs)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3024
 apply simp
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3025
apply simp
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3026
apply blast
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3027
done
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3028
17724
e969fc0a4925 simprules need names
paulson
parents: 17629
diff changeset
  3029
lemma set_remove1_eq [simp]: "distinct xs ==> set(remove1 x xs) = set xs - {x}"
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3030
apply(induct xs)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3031
 apply simp
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3032
apply simp
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3033
apply blast
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3034
done
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3035
23479
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3036
lemma length_remove1:
30128
365ee7319b86 revert some Suc 0 lemmas back to their original forms; added some simp rules for (1::nat)
huffman
parents: 30079
diff changeset
  3037
  "length(remove1 x xs) = (if x : set xs then length xs - 1 else length xs)"
23479
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3038
apply (induct xs)
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3039
 apply (auto dest!:length_pos_if_in_set)
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3040
done
10adbdcdc65b new lemmas
nipkow
parents: 23388
diff changeset
  3041
18049
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3042
lemma remove1_filter_not[simp]:
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3043
  "\<not> P x \<Longrightarrow> remove1 x (filter P xs) = filter P xs"
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3044
by(induct xs) auto
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3045
15110
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3046
lemma notin_set_remove1[simp]: "x ~: set xs ==> x ~: set(remove1 y xs)"
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3047
apply(insert set_remove1_subset)
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3048
apply fast
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3049
done
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3050
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3051
lemma distinct_remove1[simp]: "distinct xs ==> distinct(remove1 x xs)"
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3052
by (induct xs) simp_all
78b5636eabc7 Added a number of new thms and the new function remove1
nipkow
parents: 15072
diff changeset
  3053
36275
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  3054
lemma remove1_remdups:
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  3055
  "distinct xs \<Longrightarrow> remove1 x (remdups xs) = remdups (remove1 x xs)"
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  3056
  by (induct xs) simp_all
c6ca9e258269 lemmas concerning remdups
haftmann
parents: 36199
diff changeset
  3057
37107
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3058
lemma remove1_idem:
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3059
  assumes "x \<notin> set xs"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3060
  shows "remove1 x xs = xs"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3061
  using assms by (induct xs) simp_all
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3062
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3063
27693
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3064
subsubsection {* @{text removeAll} *}
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3065
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3066
lemma removeAll_filter_not_eq:
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3067
  "removeAll x = filter (\<lambda>y. x \<noteq> y)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3068
proof
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3069
  fix xs
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3070
  show "removeAll x xs = filter (\<lambda>y. x \<noteq> y) xs"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3071
    by (induct xs) auto
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3072
qed
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3073
27693
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3074
lemma removeAll_append[simp]:
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3075
  "removeAll x (xs @ ys) = removeAll x xs @ removeAll x ys"
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3076
by (induct xs) auto
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3077
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3078
lemma set_removeAll[simp]: "set(removeAll x xs) = set xs - {x}"
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3079
by (induct xs) auto
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3080
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3081
lemma removeAll_id[simp]: "x \<notin> set xs \<Longrightarrow> removeAll x xs = xs"
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3082
by (induct xs) auto
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3083
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3084
(* Needs count:: 'a \<Rightarrow> a' list \<Rightarrow> nat
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3085
lemma length_removeAll:
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3086
  "length(removeAll x xs) = length xs - count x xs"
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3087
*)
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3088
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3089
lemma removeAll_filter_not[simp]:
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3090
  "\<not> P x \<Longrightarrow> removeAll x (filter P xs) = filter P xs"
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3091
by(induct xs) auto
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3092
34978
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3093
lemma distinct_removeAll:
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3094
  "distinct xs \<Longrightarrow> distinct (removeAll x xs)"
874150ddd50a canonical insert operation; generalized lemma foldl_apply_inv to foldl_apply
haftmann
parents: 34942
diff changeset
  3095
  by (simp add: removeAll_filter_not_eq)
27693
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3096
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3097
lemma distinct_remove1_removeAll:
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3098
  "distinct xs ==> remove1 x xs = removeAll x xs"
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3099
by (induct xs) simp_all
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3100
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3101
lemma map_removeAll_inj_on: "inj_on f (insert x (set xs)) \<Longrightarrow>
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3102
  map f (removeAll x xs) = removeAll (f x) (map f xs)"
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3103
by (induct xs) (simp_all add:inj_on_def)
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3104
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3105
lemma map_removeAll_inj: "inj f \<Longrightarrow>
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3106
  map f (removeAll x xs) = removeAll (f x) (map f xs)"
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3107
by(metis map_removeAll_inj_on subset_inj_on subset_UNIV)
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3108
73253a4e3ee2 added removeAll
nipkow
parents: 27381
diff changeset
  3109
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  3110
subsubsection {* @{text replicate} *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3111
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3112
lemma length_replicate [simp]: "length (replicate n x) = n"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3113
by (induct n) auto
13124
6e1decd8a7a9 new thm distinct_conv_nth
nipkow
parents: 13122
diff changeset
  3114
36622
e393a91f86df Generalize swap_inj_on; add simps for Times; add Ex_list_of_length, log_inj; Added missing locale edges for linordered semiring with 1.
hoelzl
parents: 36275
diff changeset
  3115
lemma Ex_list_of_length: "\<exists>xs. length xs = n"
e393a91f86df Generalize swap_inj_on; add simps for Times; add Ex_list_of_length, log_inj; Added missing locale edges for linordered semiring with 1.
hoelzl
parents: 36275
diff changeset
  3116
by (rule exI[of _ "replicate n undefined"]) simp
e393a91f86df Generalize swap_inj_on; add simps for Times; add Ex_list_of_length, log_inj; Added missing locale edges for linordered semiring with 1.
hoelzl
parents: 36275
diff changeset
  3117
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3118
lemma map_replicate [simp]: "map f (replicate n x) = replicate n (f x)"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3119
by (induct n) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3120
31363
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  3121
lemma map_replicate_const:
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  3122
  "map (\<lambda> x. k) lst = replicate (length lst) k"
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  3123
  by (induct lst) auto
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  3124
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3125
lemma replicate_app_Cons_same:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3126
"(replicate n x) @ (x # xs) = x # replicate n x @ xs"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3127
by (induct n) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3128
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3129
lemma rev_replicate [simp]: "rev (replicate n x) = replicate n x"
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  3130
apply (induct n, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3131
apply (simp add: replicate_app_Cons_same)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3132
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3133
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3134
lemma replicate_add: "replicate (n + m) x = replicate n x @ replicate m x"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3135
by (induct n) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3136
16397
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3137
text{* Courtesy of Matthias Daum: *}
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3138
lemma append_replicate_commute:
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3139
  "replicate n x @ replicate k x = replicate k x @ replicate n x"
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3140
apply (simp add: replicate_add [THEN sym])
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3141
apply (simp add: add_commute)
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3142
done
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3143
31080
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  3144
text{* Courtesy of Andreas Lochbihler: *}
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  3145
lemma filter_replicate:
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  3146
  "filter P (replicate n x) = (if P x then replicate n x else [])"
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  3147
by(induct n) auto
21ffc770ebc0 lemmas by Andreas Lochbihler
nipkow
parents: 31077
diff changeset
  3148
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3149
lemma hd_replicate [simp]: "n \<noteq> 0 ==> hd (replicate n x) = x"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3150
by (induct n) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3151
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3152
lemma tl_replicate [simp]: "n \<noteq> 0 ==> tl (replicate n x) = replicate (n - 1) x"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3153
by (induct n) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3154
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3155
lemma last_replicate [simp]: "n \<noteq> 0 ==> last (replicate n x) = x"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3156
by (atomize (full), induct n) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3157
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3158
lemma nth_replicate[simp]: "i < n ==> (replicate n x)!i = x"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3159
apply (induct n arbitrary: i, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3160
apply (simp add: nth_Cons split: nat.split)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3161
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3162
16397
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3163
text{* Courtesy of Matthias Daum (2 lemmas): *}
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3164
lemma take_replicate[simp]: "take i (replicate k x) = replicate (min i k) x"
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3165
apply (case_tac "k \<le> i")
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3166
 apply  (simp add: min_def)
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3167
apply (drule not_leE)
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3168
apply (simp add: min_def)
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3169
apply (subgoal_tac "replicate k x = replicate i x @ replicate (k - i) x")
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3170
 apply  simp
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3171
apply (simp add: replicate_add [symmetric])
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3172
done
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3173
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3174
lemma drop_replicate[simp]: "drop i (replicate k x) = replicate (k-i) x"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3175
apply (induct k arbitrary: i)
16397
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3176
 apply simp
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3177
apply clarsimp
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3178
apply (case_tac i)
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3179
 apply simp
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3180
apply clarsimp
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3181
done
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3182
c047008f88d4 added lemmas
nipkow
parents: 15870
diff changeset
  3183
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3184
lemma set_replicate_Suc: "set (replicate (Suc n) x) = {x}"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3185
by (induct n) auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3186
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3187
lemma set_replicate [simp]: "n \<noteq> 0 ==> set (replicate n x) = {x}"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3188
by (fast dest!: not0_implies_Suc intro!: set_replicate_Suc)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3189
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3190
lemma set_replicate_conv_if: "set (replicate n x) = (if n = 0 then {} else {x})"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3191
by auto
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3192
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3193
lemma in_set_replicateD: "x : set (replicate n y) ==> x = y"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3194
by (simp add: set_replicate_conv_if split: split_if_asm)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3195
24796
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  3196
lemma replicate_append_same:
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  3197
  "replicate i x @ [x] = x # replicate i x"
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  3198
  by (induct i) simp_all
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  3199
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  3200
lemma map_replicate_trivial:
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  3201
  "map (\<lambda>i. x) [0..<i] = replicate i x"
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  3202
  by (induct i) (simp_all add: replicate_append_same)
529e458f84d2 added some lemmas
haftmann
parents: 24748
diff changeset
  3203
31363
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  3204
lemma concat_replicate_trivial[simp]:
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  3205
  "concat (replicate i []) = []"
7493b571b37d Added theorems about distinct & concat, map & replicate and concat & replicate
hoelzl
parents: 31264
diff changeset
  3206
  by (induct i) (auto simp add: map_replicate_const)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3207
28642
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3208
lemma replicate_empty[simp]: "(replicate n x = []) \<longleftrightarrow> n=0"
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3209
by (induct n) auto
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3210
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3211
lemma empty_replicate[simp]: "([] = replicate n x) \<longleftrightarrow> n=0"
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3212
by (induct n) auto
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3213
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3214
lemma replicate_eq_replicate[simp]:
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3215
  "(replicate m x = replicate n y) \<longleftrightarrow> (m=n & (m\<noteq>0 \<longrightarrow> x=y))"
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3216
apply(induct m arbitrary: n)
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3217
 apply simp
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3218
apply(induct_tac n)
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3219
apply auto
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3220
done
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3221
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3222
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  3223
subsubsection{*@{text rotate1} and @{text rotate}*}
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3224
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3225
lemma rotate_simps[simp]: "rotate1 [] = [] \<and> rotate1 (x#xs) = xs @ [x]"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3226
by(simp add:rotate1_def)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3227
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3228
lemma rotate0[simp]: "rotate 0 = id"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3229
by(simp add:rotate_def)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3230
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3231
lemma rotate_Suc[simp]: "rotate (Suc n) xs = rotate1(rotate n xs)"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3232
by(simp add:rotate_def)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3233
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3234
lemma rotate_add:
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3235
  "rotate (m+n) = rotate m o rotate n"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3236
by(simp add:rotate_def funpow_add)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3237
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3238
lemma rotate_rotate: "rotate m (rotate n xs) = rotate (m+n) xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3239
by(simp add:rotate_add)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3240
18049
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3241
lemma rotate1_rotate_swap: "rotate1 (rotate n xs) = rotate n (rotate1 xs)"
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3242
by(simp add:rotate_def funpow_swap1)
156bba334c12 A few new lemmas
nipkow
parents: 17956
diff changeset
  3243
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3244
lemma rotate1_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate1 xs = xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3245
by(cases xs) simp_all
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3246
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3247
lemma rotate_length01[simp]: "length xs <= 1 \<Longrightarrow> rotate n xs = xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3248
apply(induct n)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3249
 apply simp
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3250
apply (simp add:rotate_def)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3251
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3252
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3253
lemma rotate1_hd_tl: "xs \<noteq> [] \<Longrightarrow> rotate1 xs = tl xs @ [hd xs]"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3254
by(simp add:rotate1_def split:list.split)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3255
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3256
lemma rotate_drop_take:
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3257
  "rotate n xs = drop (n mod length xs) xs @ take (n mod length xs) xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3258
apply(induct n)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3259
 apply simp
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3260
apply(simp add:rotate_def)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3261
apply(cases "xs = []")
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3262
 apply (simp)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3263
apply(case_tac "n mod length xs = 0")
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3264
 apply(simp add:mod_Suc)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3265
 apply(simp add: rotate1_hd_tl drop_Suc take_Suc)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3266
apply(simp add:mod_Suc rotate1_hd_tl drop_Suc[symmetric] drop_tl[symmetric]
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3267
                take_hd_drop linorder_not_le)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3268
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3269
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3270
lemma rotate_conv_mod: "rotate n xs = rotate (n mod length xs) xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3271
by(simp add:rotate_drop_take)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3272
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3273
lemma rotate_id[simp]: "n mod length xs = 0 \<Longrightarrow> rotate n xs = xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3274
by(simp add:rotate_drop_take)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3275
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3276
lemma length_rotate1[simp]: "length(rotate1 xs) = length xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3277
by(simp add:rotate1_def split:list.split)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3278
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3279
lemma length_rotate[simp]: "length(rotate n xs) = length xs"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3280
by (induct n arbitrary: xs) (simp_all add:rotate_def)
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3281
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3282
lemma distinct1_rotate[simp]: "distinct(rotate1 xs) = distinct xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3283
by(simp add:rotate1_def split:list.split) blast
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3284
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3285
lemma distinct_rotate[simp]: "distinct(rotate n xs) = distinct xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3286
by (induct n) (simp_all add:rotate_def)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3287
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3288
lemma rotate_map: "rotate n (map f xs) = map f (rotate n xs)"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3289
by(simp add:rotate_drop_take take_map drop_map)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3290
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3291
lemma set_rotate1[simp]: "set(rotate1 xs) = set xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3292
by(simp add:rotate1_def split:list.split)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3293
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3294
lemma set_rotate[simp]: "set(rotate n xs) = set xs"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3295
by (induct n) (simp_all add:rotate_def)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3296
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3297
lemma rotate1_is_Nil_conv[simp]: "(rotate1 xs = []) = (xs = [])"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3298
by(simp add:rotate1_def split:list.split)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3299
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3300
lemma rotate_is_Nil_conv[simp]: "(rotate n xs = []) = (xs = [])"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  3301
by (induct n) (simp_all add:rotate_def)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3302
15439
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3303
lemma rotate_rev:
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3304
  "rotate n (rev xs) = rev(rotate (length xs - (n mod length xs)) xs)"
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3305
apply(simp add:rotate_drop_take rev_drop rev_take)
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3306
apply(cases "length xs = 0")
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3307
 apply simp
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3308
apply(cases "n mod length xs = 0")
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3309
 apply simp
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3310
apply(simp add:rotate_drop_take rev_drop rev_take)
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3311
done
71c0f98e31f1 made diff_less a simp rule
nipkow
parents: 15426
diff changeset
  3312
18423
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  3313
lemma hd_rotate_conv_nth: "xs \<noteq> [] \<Longrightarrow> hd(rotate n xs) = xs!(n mod length xs)"
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  3314
apply(simp add:rotate_drop_take hd_append hd_drop_conv_nth hd_conv_nth)
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  3315
apply(subgoal_tac "length xs \<noteq> 0")
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  3316
 prefer 2 apply simp
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  3317
using mod_less_divisor[of "length xs" n] by arith
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  3318
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3319
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  3320
subsubsection {* @{text sublist} --- a generalization of @{text nth} to sets *}
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3321
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3322
lemma sublist_empty [simp]: "sublist xs {} = []"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3323
by (auto simp add: sublist_def)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3324
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3325
lemma sublist_nil [simp]: "sublist [] A = []"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3326
by (auto simp add: sublist_def)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3327
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3328
lemma length_sublist:
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3329
  "length(sublist xs I) = card{i. i < length xs \<and> i : I}"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3330
by(simp add: sublist_def length_filter_conv_card cong:conj_cong)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3331
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3332
lemma sublist_shift_lemma_Suc:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3333
  "map fst (filter (%p. P(Suc(snd p))) (zip xs is)) =
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3334
   map fst (filter (%p. P(snd p)) (zip xs (map Suc is)))"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3335
apply(induct xs arbitrary: "is")
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3336
 apply simp
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3337
apply (case_tac "is")
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3338
 apply simp
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3339
apply simp
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3340
done
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3341
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3342
lemma sublist_shift_lemma:
23279
e39dd93161d9 tuned list comprehension, changed filter syntax from : to <-
nipkow
parents: 23246
diff changeset
  3343
     "map fst [p<-zip xs [i..<i + length xs] . snd p : A] =
e39dd93161d9 tuned list comprehension, changed filter syntax from : to <-
nipkow
parents: 23246
diff changeset
  3344
      map fst [p<-zip xs [0..<length xs] . snd p + i : A]"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3345
by (induct xs rule: rev_induct) (simp_all add: add_commute)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3346
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3347
lemma sublist_append:
15168
33a08cfc3ae5 new functions for sets of lists
paulson
parents: 15140
diff changeset
  3348
     "sublist (l @ l') A = sublist l A @ sublist l' {j. j + length l : A}"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3349
apply (unfold sublist_def)
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  3350
apply (induct l' rule: rev_induct, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3351
apply (simp add: upt_add_eq_append[of 0] zip_append sublist_shift_lemma)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3352
apply (simp add: add_commute)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3353
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3354
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3355
lemma sublist_Cons:
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3356
"sublist (x # l) A = (if 0:A then [x] else []) @ sublist l {j. Suc j : A}"
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3357
apply (induct l rule: rev_induct)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3358
 apply (simp add: sublist_def)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3359
apply (simp del: append_Cons add: append_Cons[symmetric] sublist_append)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3360
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3361
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3362
lemma set_sublist: "set(sublist xs I) = {xs!i|i. i<size xs \<and> i \<in> I}"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3363
apply(induct xs arbitrary: I)
25162
ad4d5365d9d8 went back to >0
nipkow
parents: 25157
diff changeset
  3364
apply(auto simp: sublist_Cons nth_Cons split:nat.split dest!: gr0_implies_Suc)
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3365
done
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3366
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3367
lemma set_sublist_subset: "set(sublist xs I) \<subseteq> set xs"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3368
by(auto simp add:set_sublist)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3369
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3370
lemma notin_set_sublistI[simp]: "x \<notin> set xs \<Longrightarrow> x \<notin> set(sublist xs I)"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3371
by(auto simp add:set_sublist)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3372
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3373
lemma in_set_sublistD: "x \<in> set(sublist xs I) \<Longrightarrow> x \<in> set xs"
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3374
by(auto simp add:set_sublist)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3375
13142
1ebd8ed5a1a0 tuned document;
wenzelm
parents: 13124
diff changeset
  3376
lemma sublist_singleton [simp]: "sublist [x] A = (if 0 : A then [x] else [])"
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3377
by (simp add: sublist_Cons)
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3378
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3379
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3380
lemma distinct_sublistI[simp]: "distinct xs \<Longrightarrow> distinct(sublist xs I)"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3381
apply(induct xs arbitrary: I)
15281
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3382
 apply simp
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3383
apply(auto simp add:sublist_Cons)
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3384
done
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3385
bd4611956c7b More lemmas
nipkow
parents: 15251
diff changeset
  3386
15045
d59f7e2e18d3 Moved to new m<..<n syntax for set intervals.
nipkow
parents: 14981
diff changeset
  3387
lemma sublist_upt_eq_take [simp]: "sublist l {..<n} = take n l"
14208
144f45277d5a misc tidying
paulson
parents: 14187
diff changeset
  3388
apply (induct l rule: rev_induct, simp)
13145
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3389
apply (simp split: nat_diff_split add: sublist_append)
59bc43b51aa2 *** empty log message ***
nipkow
parents: 13142
diff changeset
  3390
done
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3391
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3392
lemma filter_in_sublist:
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3393
 "distinct xs \<Longrightarrow> filter (%x. x \<in> set(sublist xs s)) xs = sublist xs s"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3394
proof (induct xs arbitrary: s)
17501
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  3395
  case Nil thus ?case by simp
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  3396
next
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  3397
  case (Cons a xs)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  3398
  moreover hence "!x. x: set xs \<longrightarrow> x \<noteq> a" by auto
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  3399
  ultimately show ?case by(simp add: sublist_Cons cong:filter_cong)
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  3400
qed
acbebb72e85a added a number of lemmas
nipkow
parents: 17090
diff changeset
  3401
13114
f2b00262bdfc converted;
wenzelm
parents: 12887
diff changeset
  3402
19390
6c7383f80ad1 Added function "splice"
nipkow
parents: 19363
diff changeset
  3403
subsubsection {* @{const splice} *}
6c7383f80ad1 Added function "splice"
nipkow
parents: 19363
diff changeset
  3404
19607
07eeb832f28d introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents: 19585
diff changeset
  3405
lemma splice_Nil2 [simp, code]:
19390
6c7383f80ad1 Added function "splice"
nipkow
parents: 19363
diff changeset
  3406
 "splice xs [] = xs"
6c7383f80ad1 Added function "splice"
nipkow
parents: 19363
diff changeset
  3407
by (cases xs) simp_all
6c7383f80ad1 Added function "splice"
nipkow
parents: 19363
diff changeset
  3408
19607
07eeb832f28d introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents: 19585
diff changeset
  3409
lemma splice_Cons_Cons [simp, code]:
19390
6c7383f80ad1 Added function "splice"
nipkow
parents: 19363
diff changeset
  3410
 "splice (x#xs) (y#ys) = x # y # splice xs ys"
6c7383f80ad1 Added function "splice"
nipkow
parents: 19363
diff changeset
  3411
by simp
6c7383f80ad1 Added function "splice"
nipkow
parents: 19363
diff changeset
  3412
19607
07eeb832f28d introduced characters for code generator; some improved code lemmas for some list functions
haftmann
parents: 19585
diff changeset
  3413
declare splice.simps(2) [simp del, code del]
19390
6c7383f80ad1 Added function "splice"
nipkow
parents: 19363
diff changeset
  3414
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3415
lemma length_splice[simp]: "length(splice xs ys) = length xs + length ys"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  3416
apply(induct xs arbitrary: ys) apply simp
22793
dc13dfd588b2 new lemma splice_length
nipkow
parents: 22633
diff changeset
  3417
apply(case_tac ys)
dc13dfd588b2 new lemma splice_length
nipkow
parents: 22633
diff changeset
  3418
 apply auto
dc13dfd588b2 new lemma splice_length
nipkow
parents: 22633
diff changeset
  3419
done
dc13dfd588b2 new lemma splice_length
nipkow
parents: 22633
diff changeset
  3420
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  3421
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  3422
subsubsection {* Transpose *}
34933
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3423
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3424
function transpose where
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3425
"transpose []             = []" |
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3426
"transpose ([]     # xss) = transpose xss" |
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3427
"transpose ((x#xs) # xss) =
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3428
  (x # [h. (h#t) \<leftarrow> xss]) # transpose (xs # [t. (h#t) \<leftarrow> xss])"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3429
by pat_completeness auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3430
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3431
lemma transpose_aux_filter_head:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3432
  "concat (map (list_case [] (\<lambda>h t. [h])) xss) =
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3433
  map (\<lambda>xs. hd xs) [ys\<leftarrow>xss . ys \<noteq> []]"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3434
  by (induct xss) (auto split: list.split)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3435
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3436
lemma transpose_aux_filter_tail:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3437
  "concat (map (list_case [] (\<lambda>h t. [t])) xss) =
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3438
  map (\<lambda>xs. tl xs) [ys\<leftarrow>xss . ys \<noteq> []]"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3439
  by (induct xss) (auto split: list.split)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3440
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3441
lemma transpose_aux_max:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3442
  "max (Suc (length xs)) (foldr (\<lambda>xs. max (length xs)) xss 0) =
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3443
  Suc (max (length xs) (foldr (\<lambda>x. max (length x - Suc 0)) [ys\<leftarrow>xss . ys\<noteq>[]] 0))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3444
  (is "max _ ?foldB = Suc (max _ ?foldA)")
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3445
proof (cases "[ys\<leftarrow>xss . ys\<noteq>[]] = []")
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3446
  case True
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3447
  hence "foldr (\<lambda>xs. max (length xs)) xss 0 = 0"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3448
  proof (induct xss)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3449
    case (Cons x xs)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3450
    moreover hence "x = []" by (cases x) auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3451
    ultimately show ?case by auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3452
  qed simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3453
  thus ?thesis using True by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3454
next
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3455
  case False
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3456
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3457
  have foldA: "?foldA = foldr (\<lambda>x. max (length x)) [ys\<leftarrow>xss . ys \<noteq> []] 0 - 1"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3458
    by (induct xss) auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3459
  have foldB: "?foldB = foldr (\<lambda>x. max (length x)) [ys\<leftarrow>xss . ys \<noteq> []] 0"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3460
    by (induct xss) auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3461
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3462
  have "0 < ?foldB"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3463
  proof -
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3464
    from False
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3465
    obtain z zs where zs: "[ys\<leftarrow>xss . ys \<noteq> []] = z#zs" by (auto simp: neq_Nil_conv)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3466
    hence "z \<in> set ([ys\<leftarrow>xss . ys \<noteq> []])" by auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3467
    hence "z \<noteq> []" by auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3468
    thus ?thesis
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3469
      unfolding foldB zs
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3470
      by (auto simp: max_def intro: less_le_trans)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3471
  qed
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3472
  thus ?thesis
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3473
    unfolding foldA foldB max_Suc_Suc[symmetric]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3474
    by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3475
qed
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3476
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3477
termination transpose
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3478
  by (relation "measure (\<lambda>xs. foldr (\<lambda>xs. max (length xs)) xs 0 + length xs)")
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3479
     (auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max less_Suc_eq_le)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3480
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3481
lemma transpose_empty: "(transpose xs = []) \<longleftrightarrow> (\<forall>x \<in> set xs. x = [])"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3482
  by (induct rule: transpose.induct) simp_all
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3483
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3484
lemma length_transpose:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3485
  fixes xs :: "'a list list"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3486
  shows "length (transpose xs) = foldr (\<lambda>xs. max (length xs)) xs 0"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3487
  by (induct rule: transpose.induct)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3488
    (auto simp: transpose_aux_filter_tail foldr_map comp_def transpose_aux_max
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3489
                max_Suc_Suc[symmetric] simp del: max_Suc_Suc)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3490
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3491
lemma nth_transpose:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3492
  fixes xs :: "'a list list"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3493
  assumes "i < length (transpose xs)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3494
  shows "transpose xs ! i = map (\<lambda>xs. xs ! i) [ys \<leftarrow> xs. i < length ys]"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3495
using assms proof (induct arbitrary: i rule: transpose.induct)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3496
  case (3 x xs xss)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3497
  def XS == "(x # xs) # xss"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3498
  hence [simp]: "XS \<noteq> []" by auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3499
  thus ?case
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3500
  proof (cases i)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3501
    case 0
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3502
    thus ?thesis by (simp add: transpose_aux_filter_head hd_conv_nth)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3503
  next
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3504
    case (Suc j)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3505
    have *: "\<And>xss. xs # map tl xss = map tl ((x#xs)#xss)" by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3506
    have **: "\<And>xss. (x#xs) # filter (\<lambda>ys. ys \<noteq> []) xss = filter (\<lambda>ys. ys \<noteq> []) ((x#xs)#xss)" by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3507
    { fix x have "Suc j < length x \<longleftrightarrow> x \<noteq> [] \<and> j < length x - Suc 0"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3508
      by (cases x) simp_all
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3509
    } note *** = this
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3510
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3511
    have j_less: "j < length (transpose (xs # concat (map (list_case [] (\<lambda>h t. [t])) xss)))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3512
      using "3.prems" by (simp add: transpose_aux_filter_tail length_transpose Suc)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3513
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3514
    show ?thesis
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3515
      unfolding transpose.simps `i = Suc j` nth_Cons_Suc "3.hyps"[OF j_less]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3516
      apply (auto simp: transpose_aux_filter_tail filter_map comp_def length_transpose * ** *** XS_def[symmetric])
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3517
      apply (rule_tac y=x in list.exhaust)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3518
      by auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3519
  qed
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3520
qed simp_all
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3521
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3522
lemma transpose_map_map:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3523
  "transpose (map (map f) xs) = map (map f) (transpose xs)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3524
proof (rule nth_equalityI, safe)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3525
  have [simp]: "length (transpose (map (map f) xs)) = length (transpose xs)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3526
    by (simp add: length_transpose foldr_map comp_def)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3527
  show "length (transpose (map (map f) xs)) = length (map (map f) (transpose xs))" by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3528
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3529
  fix i assume "i < length (transpose (map (map f) xs))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3530
  thus "transpose (map (map f) xs) ! i = map (map f) (transpose xs) ! i"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3531
    by (simp add: nth_transpose filter_map comp_def)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3532
qed
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3533
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  3534
31557
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3535
subsubsection {* (In)finiteness *}
28642
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3536
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3537
lemma finite_maxlen:
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3538
  "finite (M::'a list set) ==> EX n. ALL s:M. size s < n"
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3539
proof (induct rule: finite.induct)
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3540
  case emptyI show ?case by simp
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3541
next
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3542
  case (insertI M xs)
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3543
  then obtain n where "\<forall>s\<in>M. length s < n" by blast
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3544
  hence "ALL s:insert xs M. size s < max n (size xs) + 1" by auto
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3545
  thus ?case ..
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3546
qed
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3547
31557
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3548
lemma finite_lists_length_eq:
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3549
assumes "finite A"
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3550
shows "finite {xs. set xs \<subseteq> A \<and> length xs = n}" (is "finite (?S n)")
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3551
proof(induct n)
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3552
  case 0 show ?case by simp
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3553
next
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3554
  case (Suc n)
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3555
  have "?S (Suc n) = (\<Union>x\<in>A. (\<lambda>xs. x#xs) ` ?S n)"
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3556
    by (auto simp:length_Suc_conv)
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3557
  then show ?case using `finite A`
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3558
    by (auto intro: finite_imageI Suc) (* FIXME metis? *)
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3559
qed
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3560
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3561
lemma finite_lists_length_le:
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3562
  assumes "finite A" shows "finite {xs. set xs \<subseteq> A \<and> length xs \<le> n}"
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3563
 (is "finite ?S")
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3564
proof-
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3565
  have "?S = (\<Union>n\<in>{0..n}. {xs. set xs \<subseteq> A \<and> length xs = n})" by auto
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3566
  thus ?thesis by (auto intro: finite_lists_length_eq[OF `finite A`])
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3567
qed
4e36f2f17c63 two finiteness lemmas by Robert Himmelmann
nipkow
parents: 31455
diff changeset
  3568
28642
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3569
lemma infinite_UNIV_listI: "~ finite(UNIV::'a list set)"
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3570
apply(rule notI)
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3571
apply(drule finite_maxlen)
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3572
apply (metis UNIV_I length_replicate less_not_refl)
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3573
done
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3574
658b598d8af4 added lemmas
nipkow
parents: 28562
diff changeset
  3575
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  3576
subsection {* Sorting *}
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3577
24617
bc484b2671fd sorting
nipkow
parents: 24616
diff changeset
  3578
text{* Currently it is not shown that @{const sort} returns a
bc484b2671fd sorting
nipkow
parents: 24616
diff changeset
  3579
permutation of its input because the nicest proof is via multisets,
bc484b2671fd sorting
nipkow
parents: 24616
diff changeset
  3580
which are not yet available. Alternatively one could define a function
bc484b2671fd sorting
nipkow
parents: 24616
diff changeset
  3581
that counts the number of occurrences of an element in a list and use
bc484b2671fd sorting
nipkow
parents: 24616
diff changeset
  3582
that instead of multisets to state the correctness property. *}
bc484b2671fd sorting
nipkow
parents: 24616
diff changeset
  3583
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3584
context linorder
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3585
begin
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3586
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3587
lemma length_insert[simp] : "length (insort_key f x xs) = Suc (length xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3588
by (induct xs, auto)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3589
35195
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3590
lemma insort_left_comm:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3591
  "insort x (insort y xs) = insort y (insort x xs)"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3592
  by (induct xs) auto
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3593
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3594
lemma fun_left_comm_insort:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3595
  "fun_left_comm insort"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3596
proof
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3597
qed (fact insort_left_comm)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3598
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3599
lemma sort_key_simps [simp]:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3600
  "sort_key f [] = []"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3601
  "sort_key f (x#xs) = insort_key f x (sort_key f xs)"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3602
  by (simp_all add: sort_key_def)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3603
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3604
lemma sort_foldl_insort:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3605
  "sort xs = foldl (\<lambda>ys x. insort x ys) [] xs"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3606
  by (simp add: sort_key_def foldr_foldl foldl_rev insort_left_comm)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  3607
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3608
lemma length_sort[simp]: "length (sort_key f xs) = length xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3609
by (induct xs, auto)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3610
25062
af5ef0d4d655 global class syntax
haftmann
parents: 24902
diff changeset
  3611
lemma sorted_Cons: "sorted (x#xs) = (sorted xs & (ALL y:set xs. x <= y))"
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3612
apply(induct xs arbitrary: x) apply simp
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3613
by simp (blast intro: order_trans)
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3614
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3615
lemma sorted_append:
25062
af5ef0d4d655 global class syntax
haftmann
parents: 24902
diff changeset
  3616
  "sorted (xs@ys) = (sorted xs & sorted ys & (\<forall>x \<in> set xs. \<forall>y \<in> set ys. x\<le>y))"
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3617
by (induct xs) (auto simp add:sorted_Cons)
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3618
31201
3dde56615750 new lemma
nipkow
parents: 31159
diff changeset
  3619
lemma sorted_nth_mono:
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3620
  "sorted xs \<Longrightarrow> i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> xs!i \<le> xs!j"
31201
3dde56615750 new lemma
nipkow
parents: 31159
diff changeset
  3621
by (induct xs arbitrary: i j) (auto simp:nth_Cons' sorted_Cons)
3dde56615750 new lemma
nipkow
parents: 31159
diff changeset
  3622
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3623
lemma sorted_rev_nth_mono:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3624
  "sorted (rev xs) \<Longrightarrow> i \<le> j \<Longrightarrow> j < length xs \<Longrightarrow> xs!j \<le> xs!i"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3625
using sorted_nth_mono[ of "rev xs" "length xs - j - 1" "length xs - i - 1"]
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3626
      rev_nth[of "length xs - i - 1" "xs"] rev_nth[of "length xs - j - 1" "xs"]
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3627
by auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3628
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3629
lemma sorted_nth_monoI:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3630
  "(\<And> i j. \<lbrakk> i \<le> j ; j < length xs \<rbrakk> \<Longrightarrow> xs ! i \<le> xs ! j) \<Longrightarrow> sorted xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3631
proof (induct xs)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3632
  case (Cons x xs)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3633
  have "sorted xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3634
  proof (rule Cons.hyps)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3635
    fix i j assume "i \<le> j" and "j < length xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3636
    with Cons.prems[of "Suc i" "Suc j"]
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3637
    show "xs ! i \<le> xs ! j" by auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3638
  qed
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3639
  moreover
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3640
  {
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3641
    fix y assume "y \<in> set xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3642
    then obtain j where "j < length xs" and "xs ! j = y"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3643
      unfolding in_set_conv_nth by blast
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3644
    with Cons.prems[of 0 "Suc j"]
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3645
    have "x \<le> y"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3646
      by auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3647
  }
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3648
  ultimately
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3649
  show ?case
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3650
    unfolding sorted_Cons by auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3651
qed simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3652
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3653
lemma sorted_equals_nth_mono:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3654
  "sorted xs = (\<forall>j < length xs. \<forall>i \<le> j. xs ! i \<le> xs ! j)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3655
by (auto intro: sorted_nth_monoI sorted_nth_mono)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3656
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3657
lemma set_insort: "set(insort_key f x xs) = insert x (set xs)"
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3658
by (induct xs) auto
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3659
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3660
lemma set_sort[simp]: "set(sort_key f xs) = set xs"
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3661
by (induct xs) (simp_all add:set_insort)
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3662
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3663
lemma distinct_insort: "distinct (insort_key f x xs) = (x \<notin> set xs \<and> distinct xs)"
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3664
by(induct xs)(auto simp:set_insort)
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3665
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3666
lemma distinct_sort[simp]: "distinct (sort_key f xs) = distinct xs"
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3667
by(induct xs)(simp_all add:distinct_insort set_sort)
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3668
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3669
lemma sorted_insort_key: "sorted (map f (insort_key f x xs)) = sorted (map f xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3670
by(induct xs)(auto simp:sorted_Cons set_insort)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3671
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3672
lemma sorted_insort: "sorted (insort x xs) = sorted xs"
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3673
using sorted_insort_key[where f="\<lambda>x. x"] by simp
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3674
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3675
theorem sorted_sort_key[simp]: "sorted (map f (sort_key f xs))"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3676
by(induct xs)(auto simp:sorted_insort_key)
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3677
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3678
theorem sorted_sort[simp]: "sorted (sort xs)"
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3679
by(induct xs)(auto simp:sorted_insort)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3680
36851
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3681
lemma sorted_butlast:
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3682
  assumes "xs \<noteq> []" and "sorted xs"
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3683
  shows "sorted (butlast xs)"
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3684
proof -
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3685
  from `xs \<noteq> []` obtain ys y where "xs = ys @ [y]" by (cases xs rule: rev_cases) auto
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3686
  with `sorted xs` show ?thesis by (simp add: sorted_append)
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3687
qed
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3688
  
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3689
lemma insort_not_Nil [simp]:
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3690
  "insort_key f a xs \<noteq> []"
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3691
  by (induct xs) simp_all
5135adb33157 added lemmas concerning last, butlast, insort
haftmann
parents: 36622
diff changeset
  3692
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3693
lemma insort_is_Cons: "\<forall>x\<in>set xs. f a \<le> f x \<Longrightarrow> insort_key f a xs = a # xs"
26143
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3694
by (cases xs) auto
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3695
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3696
lemma sorted_remove1: "sorted xs \<Longrightarrow> sorted (remove1 a xs)"
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3697
by(induct xs)(auto simp add: sorted_Cons)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3698
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3699
lemma insort_key_remove1: "\<lbrakk> a \<in> set xs; sorted (map f xs) ; inj_on f (set xs) \<rbrakk>
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3700
  \<Longrightarrow> insort_key f a (remove1 a xs) = xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3701
proof (induct xs)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3702
  case (Cons x xs)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3703
  thus ?case
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3704
  proof (cases "x = a")
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3705
    case False
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3706
    hence "f x \<noteq> f a" using Cons.prems by auto
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3707
    hence "f x < f a" using Cons.prems by (auto simp: sorted_Cons)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3708
    thus ?thesis using Cons by (auto simp: sorted_Cons insort_is_Cons)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3709
  qed (auto simp: sorted_Cons insort_is_Cons)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3710
qed simp
26143
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3711
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3712
lemma insort_remove1: "\<lbrakk> a \<in> set xs; sorted xs \<rbrakk> \<Longrightarrow> insort a (remove1 a xs) = xs"
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3713
using insort_key_remove1[where f="\<lambda>x. x"] by simp
26143
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3714
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3715
lemma sorted_remdups[simp]:
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3716
  "sorted l \<Longrightarrow> sorted (remdups l)"
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3717
by (induct l) (auto simp: sorted_Cons)
314c0bcb7df7 Added useful general lemmas from the work with the HeapMonad
bulwahn
parents: 26073
diff changeset
  3718
24645
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3719
lemma sorted_distinct_set_unique:
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3720
assumes "sorted xs" "distinct xs" "sorted ys" "distinct ys" "set xs = set ys"
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3721
shows "xs = ys"
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3722
proof -
26734
a92057c1ee21 dropped some metis calls
haftmann
parents: 26584
diff changeset
  3723
  from assms have 1: "length xs = length ys" by (auto dest!: distinct_card)
24645
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3724
  from assms show ?thesis
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3725
  proof(induct rule:list_induct2[OF 1])
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3726
    case 1 show ?case by simp
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3727
  next
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3728
    case 2 thus ?case by (simp add:sorted_Cons)
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3729
       (metis Diff_insert_absorb antisym insertE insert_iff)
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3730
  qed
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3731
qed
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3732
35603
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3733
lemma map_sorted_distinct_set_unique:
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3734
  assumes "inj_on f (set xs \<union> set ys)"
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3735
  assumes "sorted (map f xs)" "distinct (map f xs)"
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3736
    "sorted (map f ys)" "distinct (map f ys)"
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3737
  assumes "set xs = set ys"
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3738
  shows "xs = ys"
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3739
proof -
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3740
  from assms have "map f xs = map f ys"
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3741
    by (simp add: sorted_distinct_set_unique)
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3742
  moreover with `inj_on f (set xs \<union> set ys)` show "xs = ys"
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3743
    by (blast intro: map_inj_on)
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3744
qed
c0db094d0d80 moved lemma map_sorted_distinct_set_unique
haftmann
parents: 35510
diff changeset
  3745
24645
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3746
lemma finite_sorted_distinct_unique:
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3747
shows "finite A \<Longrightarrow> EX! xs. set xs = A & sorted xs & distinct xs"
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3748
apply(drule finite_distinct_list)
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3749
apply clarify
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3750
apply(rule_tac a="sort xs" in ex1I)
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3751
apply (auto simp: sorted_distinct_set_unique)
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3752
done
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  3753
29626
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3754
lemma sorted_take:
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3755
  "sorted xs \<Longrightarrow> sorted (take n xs)"
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3756
proof (induct xs arbitrary: n rule: sorted.induct)
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3757
  case 1 show ?case by simp
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3758
next
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3759
  case 2 show ?case by (cases n) simp_all
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3760
next
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3761
  case (3 x y xs)
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3762
  then have "x \<le> y" by simp
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3763
  show ?case proof (cases n)
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3764
    case 0 then show ?thesis by simp
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3765
  next
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3766
    case (Suc m) 
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3767
    with 3 have "sorted (take m (y # xs))" by simp
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3768
    with Suc  `x \<le> y` show ?thesis by (cases m) simp_all
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3769
  qed
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3770
qed
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3771
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3772
lemma sorted_drop:
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3773
  "sorted xs \<Longrightarrow> sorted (drop n xs)"
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3774
proof (induct xs arbitrary: n rule: sorted.induct)
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3775
  case 1 show ?case by simp
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3776
next
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3777
  case 2 show ?case by (cases n) simp_all
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3778
next
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3779
  case 3 then show ?case by (cases n) simp_all
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3780
qed
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3781
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3782
lemma sorted_dropWhile: "sorted xs \<Longrightarrow> sorted (dropWhile P xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3783
  unfolding dropWhile_eq_drop by (rule sorted_drop)
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3784
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3785
lemma sorted_takeWhile: "sorted xs \<Longrightarrow> sorted (takeWhile P xs)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  3786
  apply (subst takeWhile_eq_take) by (rule sorted_take)
29626
6f8aada233c1 sorted_take, sorted_drop
haftmann
parents: 29509
diff changeset
  3787
34933
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3788
lemma sorted_filter:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3789
  "sorted (map f xs) \<Longrightarrow> sorted (map f (filter P xs))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3790
  by (induct xs) (simp_all add: sorted_Cons)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3791
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3792
lemma foldr_max_sorted:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3793
  assumes "sorted (rev xs)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3794
  shows "foldr max xs y = (if xs = [] then y else max (xs ! 0) y)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3795
using assms proof (induct xs)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3796
  case (Cons x xs)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3797
  moreover hence "sorted (rev xs)" using sorted_append by auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3798
  ultimately show ?case
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3799
    by (cases xs, auto simp add: sorted_append max_def)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3800
qed simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3801
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3802
lemma filter_equals_takeWhile_sorted_rev:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3803
  assumes sorted: "sorted (rev (map f xs))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3804
  shows "[x \<leftarrow> xs. t < f x] = takeWhile (\<lambda> x. t < f x) xs"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3805
    (is "filter ?P xs = ?tW")
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3806
proof (rule takeWhile_eq_filter[symmetric])
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3807
  let "?dW" = "dropWhile ?P xs"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3808
  fix x assume "x \<in> set ?dW"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3809
  then obtain i where i: "i < length ?dW" and nth_i: "x = ?dW ! i"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3810
    unfolding in_set_conv_nth by auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3811
  hence "length ?tW + i < length (?tW @ ?dW)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3812
    unfolding length_append by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3813
  hence i': "length (map f ?tW) + i < length (map f xs)" by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3814
  have "(map f ?tW @ map f ?dW) ! (length (map f ?tW) + i) \<le>
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3815
        (map f ?tW @ map f ?dW) ! (length (map f ?tW) + 0)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3816
    using sorted_rev_nth_mono[OF sorted _ i', of "length ?tW"]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3817
    unfolding map_append[symmetric] by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3818
  hence "f x \<le> f (?dW ! 0)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3819
    unfolding nth_append_length_plus nth_i
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3820
    using i preorder_class.le_less_trans[OF le0 i] by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3821
  also have "... \<le> t"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3822
    using hd_dropWhile[of "?P" xs] le0[THEN preorder_class.le_less_trans, OF i]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3823
    using hd_conv_nth[of "?dW"] by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3824
  finally show "\<not> t < f x" by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3825
qed
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3826
35608
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3827
lemma set_insort_insert:
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3828
  "set (insort_insert x xs) = insert x (set xs)"
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3829
  by (auto simp add: insort_insert_def set_insort)
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3830
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3831
lemma distinct_insort_insert:
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3832
  assumes "distinct xs"
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3833
  shows "distinct (insort_insert x xs)"
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3834
  using assms by (induct xs) (auto simp add: insort_insert_def set_insort)
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3835
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3836
lemma sorted_insort_insert:
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3837
  assumes "sorted xs"
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3838
  shows "sorted (insort_insert x xs)"
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3839
  using assms by (simp add: insort_insert_def sorted_insort)
db4045d1406e added insort_insert
haftmann
parents: 35603
diff changeset
  3840
37107
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3841
lemma filter_insort_key_triv:
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3842
  "\<not> P x \<Longrightarrow> filter P (insort_key f x xs) = filter P xs"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3843
  by (induct xs) simp_all
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3844
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3845
lemma filter_insort_key:
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3846
  "sorted (map f xs) \<Longrightarrow> P x \<Longrightarrow> filter P (insort_key f x xs) = insort_key f x (filter P xs)"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3847
  using assms by (induct xs)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3848
    (auto simp add: sorted_Cons, subst insort_is_Cons, auto)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3849
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3850
lemma filter_sort_key:
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3851
  "filter P (sort_key f xs) = sort_key f (filter P xs)"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3852
  by (induct xs) (simp_all add: filter_insort_key_triv filter_insort_key)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3853
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3854
lemma sorted_same [simp]:
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3855
  "sorted [x\<leftarrow>xs. x = f xs]"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3856
proof (induct xs arbitrary: f)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3857
  case Nil then show ?case by simp
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3858
next
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3859
  case (Cons x xs)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3860
  then have "sorted [y\<leftarrow>xs . y = (\<lambda>xs. x) xs]" .
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3861
  moreover from Cons have "sorted [y\<leftarrow>xs . y = (f \<circ> Cons x) xs]" .
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3862
  ultimately show ?case by (simp_all add: sorted_Cons)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3863
qed
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3864
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3865
lemma remove1_insort [simp]:
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3866
  "remove1 x (insort x xs) = xs"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3867
  by (induct xs) simp_all
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  3868
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3869
end
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  3870
25277
95128fcdd7e8 added lemmas
nipkow
parents: 25221
diff changeset
  3871
lemma sorted_upt[simp]: "sorted[i..<j]"
95128fcdd7e8 added lemmas
nipkow
parents: 25221
diff changeset
  3872
by (induct j) (simp_all add:sorted_append)
95128fcdd7e8 added lemmas
nipkow
parents: 25221
diff changeset
  3873
32415
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  3874
lemma sorted_upto[simp]: "sorted[i..j]"
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  3875
apply(induct i j rule:upto.induct)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  3876
apply(subst upto.simps)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  3877
apply(simp add:sorted_Cons)
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  3878
done
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  3879
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  3880
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  3881
subsubsection {* @{const transpose} on sorted lists *}
34933
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3882
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3883
lemma sorted_transpose[simp]:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3884
  shows "sorted (rev (map length (transpose xs)))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3885
  by (auto simp: sorted_equals_nth_mono rev_nth nth_transpose
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3886
    length_filter_conv_card intro: card_mono)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3887
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3888
lemma transpose_max_length:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3889
  "foldr (\<lambda>xs. max (length xs)) (transpose xs) 0 = length [x \<leftarrow> xs. x \<noteq> []]"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3890
  (is "?L = ?R")
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3891
proof (cases "transpose xs = []")
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3892
  case False
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3893
  have "?L = foldr max (map length (transpose xs)) 0"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3894
    by (simp add: foldr_map comp_def)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3895
  also have "... = length (transpose xs ! 0)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3896
    using False sorted_transpose by (simp add: foldr_max_sorted)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3897
  finally show ?thesis
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3898
    using False by (simp add: nth_transpose)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3899
next
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3900
  case True
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3901
  hence "[x \<leftarrow> xs. x \<noteq> []] = []"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3902
    by (auto intro!: filter_False simp: transpose_empty)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3903
  thus ?thesis by (simp add: transpose_empty True)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3904
qed
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3905
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3906
lemma length_transpose_sorted:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3907
  fixes xs :: "'a list list"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3908
  assumes sorted: "sorted (rev (map length xs))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3909
  shows "length (transpose xs) = (if xs = [] then 0 else length (xs ! 0))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3910
proof (cases "xs = []")
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3911
  case False
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3912
  thus ?thesis
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3913
    using foldr_max_sorted[OF sorted] False
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3914
    unfolding length_transpose foldr_map comp_def
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3915
    by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3916
qed simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3917
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3918
lemma nth_nth_transpose_sorted[simp]:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3919
  fixes xs :: "'a list list"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3920
  assumes sorted: "sorted (rev (map length xs))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3921
  and i: "i < length (transpose xs)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3922
  and j: "j < length [ys \<leftarrow> xs. i < length ys]"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3923
  shows "transpose xs ! i ! j = xs ! j  ! i"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3924
  using j filter_equals_takeWhile_sorted_rev[OF sorted, of i]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3925
    nth_transpose[OF i] nth_map[OF j]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3926
  by (simp add: takeWhile_nth)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3927
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3928
lemma transpose_column_length:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3929
  fixes xs :: "'a list list"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3930
  assumes sorted: "sorted (rev (map length xs))" and "i < length xs"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3931
  shows "length (filter (\<lambda>ys. i < length ys) (transpose xs)) = length (xs ! i)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3932
proof -
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3933
  have "xs \<noteq> []" using `i < length xs` by auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3934
  note filter_equals_takeWhile_sorted_rev[OF sorted, simp]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3935
  { fix j assume "j \<le> i"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3936
    note sorted_rev_nth_mono[OF sorted, of j i, simplified, OF this `i < length xs`]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3937
  } note sortedE = this[consumes 1]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3938
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3939
  have "{j. j < length (transpose xs) \<and> i < length (transpose xs ! j)}
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3940
    = {..< length (xs ! i)}"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3941
  proof safe
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3942
    fix j
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3943
    assume "j < length (transpose xs)" and "i < length (transpose xs ! j)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3944
    with this(2) nth_transpose[OF this(1)]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3945
    have "i < length (takeWhile (\<lambda>ys. j < length ys) xs)" by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3946
    from nth_mem[OF this] takeWhile_nth[OF this]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3947
    show "j < length (xs ! i)" by (auto dest: set_takeWhileD)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3948
  next
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3949
    fix j assume "j < length (xs ! i)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3950
    thus "j < length (transpose xs)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3951
      using foldr_max_sorted[OF sorted] `xs \<noteq> []` sortedE[OF le0]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3952
      by (auto simp: length_transpose comp_def foldr_map)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3953
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3954
    have "Suc i \<le> length (takeWhile (\<lambda>ys. j < length ys) xs)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3955
      using `i < length xs` `j < length (xs ! i)` less_Suc_eq_le
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3956
      by (auto intro!: length_takeWhile_less_P_nth dest!: sortedE)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3957
    with nth_transpose[OF `j < length (transpose xs)`]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3958
    show "i < length (transpose xs ! j)" by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3959
  qed
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3960
  thus ?thesis by (simp add: length_filter_conv_card)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3961
qed
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3962
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3963
lemma transpose_column:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3964
  fixes xs :: "'a list list"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3965
  assumes sorted: "sorted (rev (map length xs))" and "i < length xs"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3966
  shows "map (\<lambda>ys. ys ! i) (filter (\<lambda>ys. i < length ys) (transpose xs))
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3967
    = xs ! i" (is "?R = _")
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3968
proof (rule nth_equalityI, safe)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3969
  show length: "length ?R = length (xs ! i)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3970
    using transpose_column_length[OF assms] by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3971
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3972
  fix j assume j: "j < length ?R"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3973
  note * = less_le_trans[OF this, unfolded length_map, OF length_filter_le]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3974
  from j have j_less: "j < length (xs ! i)" using length by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3975
  have i_less_tW: "Suc i \<le> length (takeWhile (\<lambda>ys. Suc j \<le> length ys) xs)"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3976
  proof (rule length_takeWhile_less_P_nth)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3977
    show "Suc i \<le> length xs" using `i < length xs` by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3978
    fix k assume "k < Suc i"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3979
    hence "k \<le> i" by auto
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3980
    with sorted_rev_nth_mono[OF sorted this] `i < length xs`
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3981
    have "length (xs ! i) \<le> length (xs ! k)" by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3982
    thus "Suc j \<le> length (xs ! k)" using j_less by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3983
  qed
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3984
  have i_less_filter: "i < length [ys\<leftarrow>xs . j < length ys]"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3985
    unfolding filter_equals_takeWhile_sorted_rev[OF sorted, of j]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3986
    using i_less_tW by (simp_all add: Suc_le_eq)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3987
  from j show "?R ! j = xs ! i ! j"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3988
    unfolding filter_equals_takeWhile_sorted_rev[OF sorted_transpose, of i]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3989
    by (simp add: takeWhile_nth nth_nth_transpose_sorted[OF sorted * i_less_filter])
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3990
qed
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3991
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3992
lemma transpose_transpose:
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3993
  fixes xs :: "'a list list"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3994
  assumes sorted: "sorted (rev (map length xs))"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3995
  shows "transpose (transpose xs) = takeWhile (\<lambda>x. x \<noteq> []) xs" (is "?L = ?R")
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3996
proof -
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3997
  have len: "length ?L = length ?R"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3998
    unfolding length_transpose transpose_max_length
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  3999
    using filter_equals_takeWhile_sorted_rev[OF sorted, of 0]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4000
    by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4001
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4002
  { fix i assume "i < length ?R"
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4003
    with less_le_trans[OF _ length_takeWhile_le[of _ xs]]
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4004
    have "i < length xs" by simp
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4005
  } note * = this
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4006
  show ?thesis
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4007
    by (rule nth_equalityI)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4008
       (simp_all add: len nth_transpose transpose_column[OF sorted] * takeWhile_nth)
0652d00305be Add transpose to the List-theory.
hoelzl
parents: 34917
diff changeset
  4009
qed
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  4010
34934
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4011
theorem transpose_rectangle:
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4012
  assumes "xs = [] \<Longrightarrow> n = 0"
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4013
  assumes rect: "\<And> i. i < length xs \<Longrightarrow> length (xs ! i) = n"
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4014
  shows "transpose xs = map (\<lambda> i. map (\<lambda> j. xs ! j ! i) [0..<length xs]) [0..<n]"
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4015
    (is "?trans = ?map")
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4016
proof (rule nth_equalityI)
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4017
  have "sorted (rev (map length xs))"
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4018
    by (auto simp: rev_nth rect intro!: sorted_nth_monoI)
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4019
  from foldr_max_sorted[OF this] assms
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4020
  show len: "length ?trans = length ?map"
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4021
    by (simp_all add: length_transpose foldr_map comp_def)
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4022
  moreover
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4023
  { fix i assume "i < n" hence "[ys\<leftarrow>xs . i < length ys] = xs"
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4024
      using rect by (auto simp: in_set_conv_nth intro!: filter_True) }
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4025
  ultimately show "\<forall>i < length ?trans. ?trans ! i = ?map ! i"
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4026
    by (auto simp: nth_transpose intro: nth_equalityI)
440605046777 Added transpose_rectangle, when the input list is rectangular.
hoelzl
parents: 34933
diff changeset
  4027
qed
24616
fac3dd4ade83 sorting
nipkow
parents: 24566
diff changeset
  4028
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  4029
25069
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4030
subsubsection {* @{text sorted_list_of_set} *}
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4031
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4032
text{* This function maps (finite) linearly ordered sets to sorted
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4033
lists. Warning: in most cases it is not a good idea to convert from
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4034
sets to lists but one should convert in the other direction (via
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4035
@{const set}). *}
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4036
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4037
context linorder
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4038
begin
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4039
35195
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4040
definition sorted_list_of_set :: "'a set \<Rightarrow> 'a list" where
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4041
  "sorted_list_of_set = Finite_Set.fold insort []"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4042
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4043
lemma sorted_list_of_set_empty [simp]:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4044
  "sorted_list_of_set {} = []"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4045
  by (simp add: sorted_list_of_set_def)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4046
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4047
lemma sorted_list_of_set_insert [simp]:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4048
  assumes "finite A"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4049
  shows "sorted_list_of_set (insert x A) = insort x (sorted_list_of_set (A - {x}))"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4050
proof -
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4051
  interpret fun_left_comm insort by (fact fun_left_comm_insort)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4052
  with assms show ?thesis by (simp add: sorted_list_of_set_def fold_insert_remove)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4053
qed
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4054
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4055
lemma sorted_list_of_set [simp]:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4056
  "finite A \<Longrightarrow> set (sorted_list_of_set A) = A \<and> sorted (sorted_list_of_set A) 
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4057
    \<and> distinct (sorted_list_of_set A)"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4058
  by (induct A rule: finite_induct) (simp_all add: set_insort sorted_insort distinct_insort)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4059
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4060
lemma sorted_list_of_set_sort_remdups:
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4061
  "sorted_list_of_set (set xs) = sort (remdups xs)"
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4062
proof -
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4063
  interpret fun_left_comm insort by (fact fun_left_comm_insort)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4064
  show ?thesis by (simp add: sort_foldl_insort sorted_list_of_set_def fold_set_remdups)
5163c2d00904 more lemmas about sort(_key)
haftmann
parents: 35115
diff changeset
  4065
qed
25069
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4066
37107
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4067
lemma sorted_list_of_set_remove:
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4068
  assumes "finite A"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4069
  shows "sorted_list_of_set (A - {x}) = remove1 x (sorted_list_of_set A)"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4070
proof (cases "x \<in> A")
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4071
  case False with assms have "x \<notin> set (sorted_list_of_set A)" by simp
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4072
  with False show ?thesis by (simp add: remove1_idem)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4073
next
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4074
  case True then obtain B where A: "A = insert x B" by (rule Set.set_insert)
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4075
  with assms show ?thesis by simp
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4076
qed
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4077
25069
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4078
end
081189141a6e added sorted_list_of_set
nipkow
parents: 25062
diff changeset
  4079
37107
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4080
lemma sorted_list_of_set_range [simp]:
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4081
  "sorted_list_of_set {m..<n} = [m..<n]"
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4082
  by (rule sorted_distinct_set_unique) simp_all
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4083
1535aa1c943a more lemmas
haftmann
parents: 37020
diff changeset
  4084
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  4085
15392
290bc97038c7 First step in reorganizing Finite_Set
nipkow
parents: 15307
diff changeset
  4086
subsubsection {* @{text lists}: the list-forming operator over sets *}
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4087
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4088
inductive_set
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4089
  lists :: "'a set => 'a list set"
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4090
  for A :: "'a set"
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4091
where
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4092
    Nil [intro!]: "[]: lists A"
35828
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
  4093
  | Cons [intro!,no_atp]: "[| a: A; l: lists A|] ==> a#l : lists A"
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
  4094
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
  4095
inductive_cases listsE [elim!,no_atp]: "x#l : lists A"
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
  4096
inductive_cases listspE [elim!,no_atp]: "listsp A (x # l)"
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4097
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4098
lemma listsp_mono [mono]: "A \<le> B ==> listsp A \<le> listsp B"
34064
eee04bbbae7e avoid dependency on implicit dest rule predicate1D in proofs
haftmann
parents: 34007
diff changeset
  4099
by (rule predicate1I, erule listsp.induct, (blast dest: predicate1D)+)
26795
a27607030a1c - Explicitely applied predicate1I in a few proofs, because it is no longer
berghofe
parents: 26771
diff changeset
  4100
a27607030a1c - Explicitely applied predicate1I in a few proofs, because it is no longer
berghofe
parents: 26771
diff changeset
  4101
lemmas lists_mono = listsp_mono [to_set pred_subset_eq]
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4102
22422
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4103
lemma listsp_infI:
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4104
  assumes l: "listsp A l" shows "listsp B l ==> listsp (inf A B) l" using l
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4105
by induct blast+
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4106
22422
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4107
lemmas lists_IntI = listsp_infI [to_set]
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4108
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4109
lemma listsp_inf_eq [simp]: "listsp (inf A B) = inf (listsp A) (listsp B)"
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4110
proof (rule mono_inf [where f=listsp, THEN order_antisym])
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4111
  show "mono listsp" by (simp add: mono_def listsp_mono)
26795
a27607030a1c - Explicitely applied predicate1I in a few proofs, because it is no longer
berghofe
parents: 26771
diff changeset
  4112
  show "inf (listsp A) (listsp B) \<le> listsp (inf A B)" by (blast intro!: listsp_infI predicate1I)
14388
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  4113
qed
04f04408b99b lemmas about card (set xs)
kleing
parents: 14343
diff changeset
  4114
22422
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4115
lemmas listsp_conj_eq [simp] = listsp_inf_eq [simplified inf_fun_eq inf_bool_eq]
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4116
26795
a27607030a1c - Explicitely applied predicate1I in a few proofs, because it is no longer
berghofe
parents: 26771
diff changeset
  4117
lemmas lists_Int_eq [simp] = listsp_inf_eq [to_set pred_equals_eq]
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4118
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4119
lemma append_in_listsp_conv [iff]:
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4120
     "(listsp A (xs @ ys)) = (listsp A xs \<and> listsp A ys)"
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4121
by (induct xs) auto
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4122
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4123
lemmas append_in_lists_conv [iff] = append_in_listsp_conv [to_set]
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4124
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4125
lemma in_listsp_conv_set: "(listsp A xs) = (\<forall>x \<in> set xs. A x)"
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4126
-- {* eliminate @{text listsp} in favour of @{text set} *}
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4127
by (induct xs) auto
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4128
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4129
lemmas in_lists_conv_set = in_listsp_conv_set [to_set]
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4130
35828
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
  4131
lemma in_listspD [dest!,no_atp]: "listsp A xs ==> \<forall>x\<in>set xs. A x"
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4132
by (rule in_listsp_conv_set [THEN iffD1])
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4133
35828
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
  4134
lemmas in_listsD [dest!,no_atp] = in_listspD [to_set]
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
  4135
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
  4136
lemma in_listspI [intro!,no_atp]: "\<forall>x\<in>set xs. A x ==> listsp A xs"
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4137
by (rule in_listsp_conv_set [THEN iffD2])
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4138
35828
46cfc4b8112e now use "Named_Thms" for "noatp", and renamed "noatp" to "no_atp"
blanchet
parents: 35827
diff changeset
  4139
lemmas in_listsI [intro!,no_atp] = in_listspI [to_set]
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4140
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4141
lemma lists_UNIV [simp]: "lists UNIV = UNIV"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4142
by auto
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4143
17086
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4144
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  4145
subsubsection {* Inductive definition for membership *}
17086
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4146
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4147
inductive ListMem :: "'a \<Rightarrow> 'a list \<Rightarrow> bool"
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4148
where
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4149
    elem:  "ListMem x (x # xs)"
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4150
  | insert:  "ListMem x xs \<Longrightarrow> ListMem x (y # xs)"
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4151
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4152
lemma ListMem_iff: "(ListMem x xs) = (x \<in> set xs)"
17086
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4153
apply (rule iffI)
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4154
 apply (induct set: ListMem)
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4155
  apply auto
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4156
apply (induct xs)
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4157
 apply (auto intro: ListMem.intros)
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4158
done
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4159
0eb0c9259dd7 added quite a few functions for code generation
nipkow
parents: 16998
diff changeset
  4160
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  4161
subsubsection {* Lists as Cartesian products *}
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4162
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4163
text{*@{text"set_Cons A Xs"}: the set of lists with head drawn from
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4164
@{term A} and tail drawn from @{term Xs}.*}
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4165
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4166
definition
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4167
  set_Cons :: "'a set \<Rightarrow> 'a list set \<Rightarrow> 'a list set" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4168
  [code del]: "set_Cons A XS = {z. \<exists>x xs. z = x # xs \<and> x \<in> A \<and> xs \<in> XS}"
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4169
17724
e969fc0a4925 simprules need names
paulson
parents: 17629
diff changeset
  4170
lemma set_Cons_sing_Nil [simp]: "set_Cons A {[]} = (%x. [x])`A"
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4171
by (auto simp add: set_Cons_def)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4172
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4173
text{*Yields the set of lists, all of the same length as the argument and
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4174
with elements drawn from the corresponding element of the argument.*}
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4175
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4176
primrec
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4177
  listset :: "'a set list \<Rightarrow> 'a list set" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4178
     "listset [] = {[]}"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4179
  |  "listset (A # As) = set_Cons A (listset As)"
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4180
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4181
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  4182
subsection {* Relations on Lists *}
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4183
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4184
subsubsection {* Length Lexicographic Ordering *}
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4185
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4186
text{*These orderings preserve well-foundedness: shorter lists 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4187
  precede longer lists. These ordering are not used in dictionaries.*}
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4188
        
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4189
primrec -- {*The lexicographic ordering for lists of the specified length*}
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4190
  lexn :: "('a \<times> 'a) set \<Rightarrow> nat \<Rightarrow> ('a list \<times> 'a list) set" where
37408
f51ff37811bf declare lexn.simps [code del]
haftmann
parents: 37289
diff changeset
  4191
    [code del]: "lexn r 0 = {}"
f51ff37811bf declare lexn.simps [code del]
haftmann
parents: 37289
diff changeset
  4192
  | [code del]: "lexn r (Suc n) = (prod_fun (%(x, xs). x#xs) (%(x, xs). x#xs) ` (r <*lex*> lexn r n)) Int
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4193
      {(xs, ys). length xs = Suc n \<and> length ys = Suc n}"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4194
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4195
definition
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4196
  lex :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4197
  [code del]: "lex r = (\<Union>n. lexn r n)" -- {*Holds only between lists of the same length*}
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4198
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4199
definition
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4200
  lenlex :: "('a \<times> 'a) set => ('a list \<times> 'a list) set" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4201
  [code del]: "lenlex r = inv_image (less_than <*lex*> lex r) (\<lambda>xs. (length xs, xs))"
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4202
        -- {*Compares lists by their length and then lexicographically*}
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4203
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4204
lemma wf_lexn: "wf r ==> wf (lexn r n)"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4205
apply (induct n, simp, simp)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4206
apply(rule wf_subset)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4207
 prefer 2 apply (rule Int_lower1)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4208
apply(rule wf_prod_fun_image)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4209
 prefer 2 apply (rule inj_onI, auto)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4210
done
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4211
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4212
lemma lexn_length:
24526
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  4213
  "(xs, ys) : lexn r n ==> length xs = n \<and> length ys = n"
7fa202789bf6 tuned lemma; replaced !! by arbitrary
nipkow
parents: 24476
diff changeset
  4214
by (induct n arbitrary: xs ys) auto
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4215
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4216
lemma wf_lex [intro!]: "wf r ==> wf (lex r)"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4217
apply (unfold lex_def)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4218
apply (rule wf_UN)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4219
apply (blast intro: wf_lexn, clarify)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4220
apply (rename_tac m n)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4221
apply (subgoal_tac "m \<noteq> n")
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4222
 prefer 2 apply blast
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4223
apply (blast dest: lexn_length not_sym)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4224
done
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4225
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4226
lemma lexn_conv:
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4227
  "lexn r n =
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4228
    {(xs,ys). length xs = n \<and> length ys = n \<and>
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4229
    (\<exists>xys x y xs' ys'. xs= xys @ x#xs' \<and> ys= xys @ y # ys' \<and> (x, y):r)}"
18423
d7859164447f new lemmas
nipkow
parents: 18336
diff changeset
  4230
apply (induct n, simp)
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4231
apply (simp add: image_Collect lex_prod_def, safe, blast)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4232
 apply (rule_tac x = "ab # xys" in exI, simp)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4233
apply (case_tac xys, simp_all, blast)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4234
done
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4235
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4236
lemma lex_conv:
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4237
  "lex r =
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4238
    {(xs,ys). length xs = length ys \<and>
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4239
    (\<exists>xys x y xs' ys'. xs = xys @ x # xs' \<and> ys = xys @ y # ys' \<and> (x, y):r)}"
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4240
by (force simp add: lex_def lexn_conv)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4241
15693
3a67e61c6e96 tuned Map, renamed lex stuff in List.
nipkow
parents: 15656
diff changeset
  4242
lemma wf_lenlex [intro!]: "wf r ==> wf (lenlex r)"
3a67e61c6e96 tuned Map, renamed lex stuff in List.
nipkow
parents: 15656
diff changeset
  4243
by (unfold lenlex_def) blast
3a67e61c6e96 tuned Map, renamed lex stuff in List.
nipkow
parents: 15656
diff changeset
  4244
3a67e61c6e96 tuned Map, renamed lex stuff in List.
nipkow
parents: 15656
diff changeset
  4245
lemma lenlex_conv:
3a67e61c6e96 tuned Map, renamed lex stuff in List.
nipkow
parents: 15656
diff changeset
  4246
    "lenlex r = {(xs,ys). length xs < length ys |
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4247
                 length xs = length ys \<and> (xs, ys) : lex r}"
30198
922f944f03b2 name changes
nipkow
parents: 30128
diff changeset
  4248
by (simp add: lenlex_def Id_on_def lex_prod_def inv_image_def)
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4249
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4250
lemma Nil_notin_lex [iff]: "([], ys) \<notin> lex r"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4251
by (simp add: lex_conv)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4252
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4253
lemma Nil2_notin_lex [iff]: "(xs, []) \<notin> lex r"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4254
by (simp add:lex_conv)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4255
18447
da548623916a removed or modified some instances of [iff]
paulson
parents: 18423
diff changeset
  4256
lemma Cons_in_lex [simp]:
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4257
    "((x # xs, y # ys) : lex r) =
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4258
      ((x, y) : r \<and> length xs = length ys | x = y \<and> (xs, ys) : lex r)"
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4259
apply (simp add: lex_conv)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4260
apply (rule iffI)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4261
 prefer 2 apply (blast intro: Cons_eq_appendI, clarify)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4262
apply (case_tac xys, simp, simp)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4263
apply blast
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4264
done
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4265
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4266
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4267
subsubsection {* Lexicographic Ordering *}
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4268
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4269
text {* Classical lexicographic ordering on lists, ie. "a" < "ab" < "b".
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4270
    This ordering does \emph{not} preserve well-foundedness.
17090
603f23d71ada small mods to code lemmas
nipkow
parents: 17086
diff changeset
  4271
     Author: N. Voelker, March 2005. *} 
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4272
34941
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4273
definition
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4274
  lexord :: "('a \<times> 'a) set \<Rightarrow> ('a list \<times> 'a list) set" where
156925dd67af dropped some old primrecs and some constdefs
haftmann
parents: 34886
diff changeset
  4275
  [code del]: "lexord r = {(x,y ). \<exists> a v. y = x @ a # v \<or>
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4276
            (\<exists> u a b v w. (a,b) \<in> r \<and> x = u @ (a # v) \<and> y = u @ (b # w))}"
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4277
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4278
lemma lexord_Nil_left[simp]:  "([],y) \<in> lexord r = (\<exists> a x. y = a # x)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4279
by (unfold lexord_def, induct_tac y, auto) 
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4280
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4281
lemma lexord_Nil_right[simp]: "(x,[]) \<notin> lexord r"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4282
by (unfold lexord_def, induct_tac x, auto)
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4283
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4284
lemma lexord_cons_cons[simp]:
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4285
     "((a # x, b # y) \<in> lexord r) = ((a,b)\<in> r | (a = b & (x,y)\<in> lexord r))"
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4286
  apply (unfold lexord_def, safe, simp_all)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4287
  apply (case_tac u, simp, simp)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4288
  apply (case_tac u, simp, clarsimp, blast, blast, clarsimp)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4289
  apply (erule_tac x="b # u" in allE)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4290
  by force
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4291
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4292
lemmas lexord_simps = lexord_Nil_left lexord_Nil_right lexord_cons_cons
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4293
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4294
lemma lexord_append_rightI: "\<exists> b z. y = b # z \<Longrightarrow> (x, x @ y) \<in> lexord r"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4295
by (induct_tac x, auto)  
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4296
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4297
lemma lexord_append_left_rightI:
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4298
     "(a,b) \<in> r \<Longrightarrow> (u @ a # x, u @ b # y) \<in> lexord r"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4299
by (induct_tac u, auto)
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4300
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4301
lemma lexord_append_leftI: " (u,v) \<in> lexord r \<Longrightarrow> (x @ u, x @ v) \<in> lexord r"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4302
by (induct x, auto)
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4303
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4304
lemma lexord_append_leftD:
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4305
     "\<lbrakk> (x @ u, x @ v) \<in> lexord r; (! a. (a,a) \<notin> r) \<rbrakk> \<Longrightarrow> (u,v) \<in> lexord r"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4306
by (erule rev_mp, induct_tac x, auto)
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4307
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4308
lemma lexord_take_index_conv: 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4309
   "((x,y) : lexord r) = 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4310
    ((length x < length y \<and> take (length x) y = x) \<or> 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4311
     (\<exists>i. i < min(length x)(length y) & take i x = take i y & (x!i,y!i) \<in> r))"
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4312
  apply (unfold lexord_def Let_def, clarsimp) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4313
  apply (rule_tac f = "(% a b. a \<or> b)" in arg_cong2)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4314
  apply auto 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4315
  apply (rule_tac x="hd (drop (length x) y)" in exI)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4316
  apply (rule_tac x="tl (drop (length x) y)" in exI)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4317
  apply (erule subst, simp add: min_def) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4318
  apply (rule_tac x ="length u" in exI, simp) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4319
  apply (rule_tac x ="take i x" in exI) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4320
  apply (rule_tac x ="x ! i" in exI) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4321
  apply (rule_tac x ="y ! i" in exI, safe) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4322
  apply (rule_tac x="drop (Suc i) x" in exI)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4323
  apply (drule sym, simp add: drop_Suc_conv_tl) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4324
  apply (rule_tac x="drop (Suc i) y" in exI)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4325
  by (simp add: drop_Suc_conv_tl) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4326
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4327
-- {* lexord is extension of partial ordering List.lex *} 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4328
lemma lexord_lex: " (x,y) \<in> lex r = ((x,y) \<in> lexord r \<and> length x = length y)"
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4329
  apply (rule_tac x = y in spec) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4330
  apply (induct_tac x, clarsimp) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4331
  by (clarify, case_tac x, simp, force)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4332
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4333
lemma lexord_irreflexive: "(! x. (x,x) \<notin> r) \<Longrightarrow> (y,y) \<notin> lexord r"
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4334
  by (induct y, auto)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4335
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4336
lemma lexord_trans: 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4337
    "\<lbrakk> (x, y) \<in> lexord r; (y, z) \<in> lexord r; trans r \<rbrakk> \<Longrightarrow> (x, z) \<in> lexord r"
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4338
   apply (erule rev_mp)+
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4339
   apply (rule_tac x = x in spec) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4340
  apply (rule_tac x = z in spec) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4341
  apply ( induct_tac y, simp, clarify)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4342
  apply (case_tac xa, erule ssubst) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4343
  apply (erule allE, erule allE) -- {* avoid simp recursion *} 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4344
  apply (case_tac x, simp, simp) 
24632
779fc4fcbf8b metis now available in PreList
paulson
parents: 24617
diff changeset
  4345
  apply (case_tac x, erule allE, erule allE, simp)
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4346
  apply (erule_tac x = listb in allE) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4347
  apply (erule_tac x = lista in allE, simp)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4348
  apply (unfold trans_def)
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4349
  by blast
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4350
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4351
lemma lexord_transI:  "trans r \<Longrightarrow> trans (lexord r)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4352
by (rule transI, drule lexord_trans, blast) 
15656
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4353
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4354
lemma lexord_linear: "(! a b. (a,b)\<in> r | a = b | (b,a) \<in> r) \<Longrightarrow> (x,y) : lexord r | x = y | (y,x) : lexord r"
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4355
  apply (rule_tac x = y in spec) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4356
  apply (induct_tac x, rule allI) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4357
  apply (case_tac x, simp, simp) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4358
  apply (rule allI, case_tac x, simp, simp) 
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4359
  by blast
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4360
988f91b9c4ef lexicographic order by Norbert Voelker
paulson
parents: 15570
diff changeset
  4361
21103
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4362
subsection {* Lexicographic combination of measure functions *}
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4363
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4364
text {* These are useful for termination proofs *}
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4365
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4366
definition
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4367
  "measures fs = inv_image (lex less_than) (%a. map (%f. f a) fs)"
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4368
21106
51599a81b308 Added "recdef_wf" and "simp" attribute to "wf_measures"
krauss
parents: 21103
diff changeset
  4369
lemma wf_measures[recdef_wf, simp]: "wf (measures fs)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4370
unfolding measures_def
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4371
by blast
21103
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4372
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4373
lemma in_measures[simp]: 
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4374
  "(x, y) \<in> measures [] = False"
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4375
  "(x, y) \<in> measures (f # fs)
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4376
         = (f x < f y \<or> (f x = f y \<and> (x, y) \<in> measures fs))"  
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4377
unfolding measures_def
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4378
by auto
21103
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4379
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4380
lemma measures_less: "f x < f y ==> (x, y) \<in> measures (f#fs)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4381
by simp
21103
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4382
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4383
lemma measures_lesseq: "f x <= f y ==> (x, y) \<in> measures fs ==> (x, y) \<in> measures (f#fs)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4384
by auto
21103
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4385
367b4ad7c7cc Added "measures" combinator for lexicographic combinations of multiple measures.
krauss
parents: 21079
diff changeset
  4386
35115
446c5063e4fd modernized translations;
wenzelm
parents: 35028
diff changeset
  4387
subsubsection {* Lifting a Relation on List Elements to the Lists *}
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4388
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4389
inductive_set
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4390
  listrel :: "('a * 'a)set => ('a list * 'a list)set"
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4391
  for r :: "('a * 'a)set"
22262
96ba62dff413 Adapted to new inductive definition package.
berghofe
parents: 22143
diff changeset
  4392
where
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4393
    Nil:  "([],[]) \<in> listrel r"
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4394
  | Cons: "[| (x,y) \<in> r; (xs,ys) \<in> listrel r |] ==> (x#xs, y#ys) \<in> listrel r"
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4395
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4396
inductive_cases listrel_Nil1 [elim!]: "([],xs) \<in> listrel r"
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4397
inductive_cases listrel_Nil2 [elim!]: "(xs,[]) \<in> listrel r"
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4398
inductive_cases listrel_Cons1 [elim!]: "(y#ys,xs) \<in> listrel r"
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4399
inductive_cases listrel_Cons2 [elim!]: "(xs,y#ys) \<in> listrel r"
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4400
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4401
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4402
lemma listrel_mono: "r \<subseteq> s \<Longrightarrow> listrel r \<subseteq> listrel s"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4403
apply clarify  
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4404
apply (erule listrel.induct)
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4405
apply (blast intro: listrel.intros)+
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4406
done
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4407
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4408
lemma listrel_subset: "r \<subseteq> A \<times> A \<Longrightarrow> listrel r \<subseteq> lists A \<times> lists A"
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4409
apply clarify 
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4410
apply (erule listrel.induct, auto) 
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4411
done
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4412
30198
922f944f03b2 name changes
nipkow
parents: 30128
diff changeset
  4413
lemma listrel_refl_on: "refl_on A r \<Longrightarrow> refl_on (lists A) (listrel r)" 
922f944f03b2 name changes
nipkow
parents: 30128
diff changeset
  4414
apply (simp add: refl_on_def listrel_subset Ball_def)
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4415
apply (rule allI) 
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4416
apply (induct_tac x) 
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4417
apply (auto intro: listrel.intros)
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4418
done
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4419
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4420
lemma listrel_sym: "sym r \<Longrightarrow> sym (listrel r)" 
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4421
apply (auto simp add: sym_def)
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4422
apply (erule listrel.induct) 
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4423
apply (blast intro: listrel.intros)+
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4424
done
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4425
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4426
lemma listrel_trans: "trans r \<Longrightarrow> trans (listrel r)" 
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4427
apply (simp add: trans_def)
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4428
apply (intro allI) 
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4429
apply (rule impI) 
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4430
apply (erule listrel.induct) 
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4431
apply (blast intro: listrel.intros)+
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4432
done
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4433
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4434
theorem equiv_listrel: "equiv A r \<Longrightarrow> equiv (lists A) (listrel r)"
30198
922f944f03b2 name changes
nipkow
parents: 30128
diff changeset
  4435
by (simp add: equiv_def listrel_refl_on listrel_sym listrel_trans) 
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4436
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4437
lemma listrel_Nil [simp]: "listrel r `` {[]} = {[]}"
23740
d7f18c837ce7 Adapted to new package for inductive sets.
berghofe
parents: 23554
diff changeset
  4438
by (blast intro: listrel.intros)
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4439
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4440
lemma listrel_Cons:
33318
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4441
     "listrel r `` {x#xs} = set_Cons (r``{x}) (listrel r `` {xs})"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4442
by (auto simp add: set_Cons_def intro: listrel.intros)
15302
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4443
a643fcbc3468 Restructured List and added "rotate"
nipkow
parents: 15281
diff changeset
  4444
26749
397a1aeede7d * New attribute "termination_simp": Simp rules for termination proofs
krauss
parents: 26734
diff changeset
  4445
subsection {* Size function *}
397a1aeede7d * New attribute "termination_simp": Simp rules for termination proofs
krauss
parents: 26734
diff changeset
  4446
26875
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4447
lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (list_size f)"
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4448
by (rule is_measure_trivial)
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4449
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4450
lemma [measure_function]: "is_measure f \<Longrightarrow> is_measure (option_size f)"
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4451
by (rule is_measure_trivial)
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4452
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4453
lemma list_size_estimation[termination_simp]: 
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4454
  "x \<in> set xs \<Longrightarrow> y < f x \<Longrightarrow> y < list_size f xs"
26749
397a1aeede7d * New attribute "termination_simp": Simp rules for termination proofs
krauss
parents: 26734
diff changeset
  4455
by (induct xs) auto
397a1aeede7d * New attribute "termination_simp": Simp rules for termination proofs
krauss
parents: 26734
diff changeset
  4456
26875
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4457
lemma list_size_estimation'[termination_simp]: 
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4458
  "x \<in> set xs \<Longrightarrow> y \<le> f x \<Longrightarrow> y \<le> list_size f xs"
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4459
by (induct xs) auto
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4460
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4461
lemma list_size_map[simp]: "list_size f (map g xs) = list_size (f o g) xs"
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4462
by (induct xs) auto
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4463
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4464
lemma list_size_pointwise[termination_simp]: 
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4465
  "(\<And>x. x \<in> set xs \<Longrightarrow> f x < g x) \<Longrightarrow> list_size f xs \<le> list_size g xs"
e18574413bc4 Measure functions can now be declared via special rules, allowing for a
krauss
parents: 26795
diff changeset
  4466
by (induct xs) force+
26749
397a1aeede7d * New attribute "termination_simp": Simp rules for termination proofs
krauss
parents: 26734
diff changeset
  4467
31048
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4468
33318
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4469
subsection {* Transfer *}
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4470
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4471
definition
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4472
  embed_list :: "nat list \<Rightarrow> int list"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4473
where
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4474
  "embed_list l = map int l"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4475
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4476
definition
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4477
  nat_list :: "int list \<Rightarrow> bool"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4478
where
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4479
  "nat_list l = nat_set (set l)"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4480
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4481
definition
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4482
  return_list :: "int list \<Rightarrow> nat list"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4483
where
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4484
  "return_list l = map nat l"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4485
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4486
lemma transfer_nat_int_list_return_embed: "nat_list l \<longrightarrow>
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4487
    embed_list (return_list l) = l"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4488
  unfolding embed_list_def return_list_def nat_list_def nat_set_def
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4489
  apply (induct l)
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4490
  apply auto
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4491
done
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4492
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4493
lemma transfer_nat_int_list_functions:
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4494
  "l @ m = return_list (embed_list l @ embed_list m)"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4495
  "[] = return_list []"
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4496
  unfolding return_list_def embed_list_def
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4497
  apply auto
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4498
  apply (induct l, auto)
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4499
  apply (induct m, auto)
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4500
done
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4501
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4502
(*
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4503
lemma transfer_nat_int_fold1: "fold f l x =
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4504
    fold (%x. f (nat x)) (embed_list l) x";
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4505
*)
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4506
ddd97d9dfbfb moved Nat_Transfer before Divides; distributed Nat_Transfer setup accordingly
haftmann
parents: 32960
diff changeset
  4507
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4508
subsection {* Code generator *}
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4509
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4510
subsubsection {* Setup *}
15064
4f3102b50197 - Moved code generator setup for lists from Main.thy to List.thy
berghofe
parents: 15045
diff changeset
  4511
31055
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4512
use "Tools/list_code.ML"
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4513
31048
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4514
code_type list
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4515
  (SML "_ list")
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4516
  (OCaml "_ list")
34886
873c31d9f10d some syntax setup for Scala
haftmann
parents: 34064
diff changeset
  4517
  (Haskell "![(_)]")
873c31d9f10d some syntax setup for Scala
haftmann
parents: 34064
diff changeset
  4518
  (Scala "List[(_)]")
31048
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4519
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4520
code_const Nil
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4521
  (SML "[]")
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4522
  (OCaml "[]")
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4523
  (Haskell "[]")
34886
873c31d9f10d some syntax setup for Scala
haftmann
parents: 34064
diff changeset
  4524
  (Scala "Nil")
31048
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4525
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4526
code_instance list :: eq
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4527
  (Haskell -)
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4528
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4529
code_const "eq_class.eq \<Colon> 'a\<Colon>eq list \<Rightarrow> 'a list \<Rightarrow> bool"
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4530
  (Haskell infixl 4 "==")
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4531
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4532
code_reserved SML
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4533
  list
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4534
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4535
code_reserved OCaml
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4536
  list
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4537
16770
1f1b1fae30e4 Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents: 16634
diff changeset
  4538
types_code
1f1b1fae30e4 Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents: 16634
diff changeset
  4539
  "list" ("_ list")
1f1b1fae30e4 Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents: 16634
diff changeset
  4540
attach (term_of) {*
21760
78248dda3a90 fixed term_of_list;
wenzelm
parents: 21754
diff changeset
  4541
fun term_of_list f T = HOLogic.mk_list T o map f;
16770
1f1b1fae30e4 Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents: 16634
diff changeset
  4542
*}
1f1b1fae30e4 Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents: 16634
diff changeset
  4543
attach (test) {*
25885
6fbc3f54f819 New interface for test data generators.
berghofe
parents: 25591
diff changeset
  4544
fun gen_list' aG aT i j = frequency
6fbc3f54f819 New interface for test data generators.
berghofe
parents: 25591
diff changeset
  4545
  [(i, fn () =>
6fbc3f54f819 New interface for test data generators.
berghofe
parents: 25591
diff changeset
  4546
      let
6fbc3f54f819 New interface for test data generators.
berghofe
parents: 25591
diff changeset
  4547
        val (x, t) = aG j;
6fbc3f54f819 New interface for test data generators.
berghofe
parents: 25591
diff changeset
  4548
        val (xs, ts) = gen_list' aG aT (i-1) j
6fbc3f54f819 New interface for test data generators.
berghofe
parents: 25591
diff changeset
  4549
      in (x :: xs, fn () => HOLogic.cons_const aT $ t () $ ts ()) end),
6fbc3f54f819 New interface for test data generators.
berghofe
parents: 25591
diff changeset
  4550
   (1, fn () => ([], fn () => HOLogic.nil_const aT))] ()
6fbc3f54f819 New interface for test data generators.
berghofe
parents: 25591
diff changeset
  4551
and gen_list aG aT i = gen_list' aG aT i i;
16770
1f1b1fae30e4 Auxiliary functions to be used in generated code are now defined using "attach".
berghofe
parents: 16634
diff changeset
  4552
*}
31048
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4553
ac146fc38b51 refined HOL string theories and corresponding ML fragments
haftmann
parents: 31022
diff changeset
  4554
consts_code Cons ("(_ ::/ _)")
20588
c847c56edf0c added operational equality
haftmann
parents: 20503
diff changeset
  4555
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20439
diff changeset
  4556
setup {*
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20439
diff changeset
  4557
let
31055
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4558
  fun list_codegen thy defs dep thyname b t gr =
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4559
    let
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4560
      val ts = HOLogic.dest_list t;
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4561
      val (_, gr') = Codegen.invoke_tycodegen thy defs dep thyname false
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4562
        (fastype_of t) gr;
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4563
      val (ps, gr'') = fold_map
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4564
        (Codegen.invoke_codegen thy defs dep thyname false) ts gr'
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4565
    in SOME (Pretty.list "[" "]" ps, gr'') end handle TERM _ => NONE;
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4566
in
34886
873c31d9f10d some syntax setup for Scala
haftmann
parents: 34064
diff changeset
  4567
  fold (List_Code.add_literal_list) ["SML", "OCaml", "Haskell", "Scala"]
31055
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4568
  #> Codegen.add_codegen "list_codegen" list_codegen
2cf6efca6c71 proper structures for list and string code generation stuff
haftmann
parents: 31048
diff changeset
  4569
end
20453
855f07fabd76 final syntax for some Isar code generator keywords
haftmann
parents: 20439
diff changeset
  4570
*}
15064
4f3102b50197 - Moved code generator setup for lists from Main.thy to List.thy
berghofe
parents: 15045
diff changeset
  4571
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4572
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4573
subsubsection {* Generation of efficient code *}
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4574
37020
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4575
definition member :: "'a list \<Rightarrow> 'a \<Rightarrow> bool" where
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4576
  mem_iff [code_post]: "member xs x \<longleftrightarrow> x \<in> set xs"
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4577
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4578
primrec
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4579
  null:: "'a list \<Rightarrow> bool"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4580
where
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4581
  "null [] = True"
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4582
  | "null (x#xs) = False"
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4583
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4584
primrec
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4585
  list_inter :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4586
where
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4587
  "list_inter [] bs = []"
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4588
  | "list_inter (a#as) bs =
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4589
     (if a \<in> set bs then a # list_inter as bs else list_inter as bs)"
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4590
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4591
primrec
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4592
  list_all :: "('a \<Rightarrow> bool) \<Rightarrow> ('a list \<Rightarrow> bool)"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4593
where
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4594
  "list_all P [] = True"
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4595
  | "list_all P (x#xs) = (P x \<and> list_all P xs)"
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4596
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4597
primrec
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4598
  list_ex :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4599
where
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4600
  "list_ex P [] = False"
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4601
  | "list_ex P (x#xs) = (P x \<or> list_ex P xs)"
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4602
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4603
primrec
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4604
  filtermap :: "('a \<Rightarrow> 'b option) \<Rightarrow> 'a list \<Rightarrow> 'b list"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4605
where
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4606
  "filtermap f [] = []"
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4607
  | "filtermap f (x#xs) =
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4608
     (case f x of None \<Rightarrow> filtermap f xs
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4609
      | Some y \<Rightarrow> y # filtermap f xs)"
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4610
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4611
primrec
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4612
  map_filter :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> 'b list"
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4613
where
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4614
  "map_filter f P [] = []"
26442
57fb6a8b099e restructuring; explicit case names for rule list_induct2
haftmann
parents: 26300
diff changeset
  4615
  | "map_filter f P (x#xs) =
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4616
     (if P x then f x # map_filter f P xs else map_filter f P xs)"
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4617
28789
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4618
primrec
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4619
  length_unique :: "'a list \<Rightarrow> nat"
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4620
where
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4621
  "length_unique [] = 0"
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4622
  | "length_unique (x#xs) =
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4623
      (if x \<in> set xs then length_unique xs else Suc (length_unique xs))"
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4624
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4625
primrec
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4626
  concat_map :: "('a => 'b list) => 'a list => 'b list"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4627
where
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4628
  "concat_map f [] = []"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4629
  | "concat_map f (x#xs) = f x @ concat_map f xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4630
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4631
text {*
37020
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4632
  Only use @{text member} for generating executable code.  Otherwise use
21754
6316163ae934 moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents: 21548
diff changeset
  4633
  @{prop "x : set xs"} instead --- it is much easier to reason about.
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4634
  The same is true for @{const list_all} and @{const list_ex}: write
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4635
  @{text "\<forall>x\<in>set xs"} and @{text "\<exists>x\<in>set xs"} instead because the HOL
21754
6316163ae934 moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents: 21548
diff changeset
  4636
  quantifiers are aleady known to the automatic provers. In fact, the
6316163ae934 moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents: 21548
diff changeset
  4637
  declarations in the code subsection make sure that @{text "\<in>"},
6316163ae934 moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents: 21548
diff changeset
  4638
  @{text "\<forall>x\<in>set xs"} and @{text "\<exists>x\<in>set xs"} are implemented
6316163ae934 moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents: 21548
diff changeset
  4639
  efficiently.
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4640
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4641
  Efficient emptyness check is implemented by @{const null}.
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4642
23060
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4643
  The functions @{const filtermap} and @{const map_filter} are just
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4644
  there to generate efficient code. Do not use
21754
6316163ae934 moved char/string syntax to Tools/string_syntax.ML;
wenzelm
parents: 21548
diff changeset
  4645
  them for modelling and proving.
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4646
*}
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4647
23060
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4648
lemma rev_foldl_cons [code]:
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4649
  "rev xs = foldl (\<lambda>xs x. x # xs) [] xs"
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4650
proof (induct xs)
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4651
  case Nil then show ?case by simp
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4652
next
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4653
  case Cons
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4654
  {
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4655
    fix x xs ys
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4656
    have "foldl (\<lambda>xs x. x # xs) ys xs @ [x]
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4657
      = foldl (\<lambda>xs x. x # xs) (ys @ [x]) xs"
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4658
    by (induct xs arbitrary: ys) auto
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4659
  }
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4660
  note aux = this
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4661
  show ?case by (induct xs) (auto simp add: Cons aux)
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4662
qed
0c0b03d0ec7e improved code for rev
haftmann
parents: 23029
diff changeset
  4663
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4664
lemmas in_set_code [code_unfold] = mem_iff [symmetric]
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4665
37020
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4666
lemma member_simps [simp, code]:
37123
9cce71cd4bf0 more convenient order of code equations
haftmann
parents: 37107
diff changeset
  4667
  "member (x # xs) y \<longleftrightarrow> x = y \<or> member xs y"
37020
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4668
  "member [] y \<longleftrightarrow> False"
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4669
  by (auto simp add: mem_iff)
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4670
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4671
lemma member_set:
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4672
  "member = set"
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4673
  by (simp add: expand_fun_eq mem_iff mem_def)
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4674
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4675
abbreviation (input) mem :: "'a \<Rightarrow> 'a list \<Rightarrow> bool" (infixl "mem" 55) where
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4676
  "x mem xs \<equiv> member xs x" -- "for backward compatibility"
6c699a8e6927 turned old-style mem into an input abbreviation
haftmann
parents: 36920
diff changeset
  4677
31154
f919b8e67413 preprocessing must consider eq
haftmann
parents: 31080
diff changeset
  4678
lemma empty_null:
22422
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4679
  "xs = [] \<longleftrightarrow> null xs"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4680
by (cases xs) simp_all
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4681
32069
6d28bbd33e2c prefer code_inline over code_unfold; use code_unfold_post where appropriate
haftmann
parents: 31998
diff changeset
  4682
lemma [code_unfold]:
31154
f919b8e67413 preprocessing must consider eq
haftmann
parents: 31080
diff changeset
  4683
  "eq_class.eq xs [] \<longleftrightarrow> null xs"
f919b8e67413 preprocessing must consider eq
haftmann
parents: 31080
diff changeset
  4684
by (simp add: eq empty_null)
f919b8e67413 preprocessing must consider eq
haftmann
parents: 31080
diff changeset
  4685
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4686
lemmas null_empty [code_post] =
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4687
  empty_null [symmetric]
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4688
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4689
lemma list_inter_conv:
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4690
  "set (list_inter xs ys) = set xs \<inter> set ys"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4691
by (induct xs) auto
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4692
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4693
lemma list_all_iff [code_post]:
22422
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4694
  "list_all P xs \<longleftrightarrow> (\<forall>x \<in> set xs. P x)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4695
by (induct xs) auto
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4696
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4697
lemmas list_ball_code [code_unfold] = list_all_iff [symmetric]
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4698
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4699
lemma list_all_append [simp]:
22422
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4700
  "list_all P (xs @ ys) \<longleftrightarrow> (list_all P xs \<and> list_all P ys)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4701
by (induct xs) auto
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4702
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4703
lemma list_all_rev [simp]:
22422
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4704
  "list_all P (rev xs) \<longleftrightarrow> list_all P xs"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4705
by (simp add: list_all_iff)
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4706
22506
c78f1d924bfe two further properties about lists
haftmann
parents: 22493
diff changeset
  4707
lemma list_all_length:
c78f1d924bfe two further properties about lists
haftmann
parents: 22493
diff changeset
  4708
  "list_all P xs \<longleftrightarrow> (\<forall>n < length xs. P (xs ! n))"
c78f1d924bfe two further properties about lists
haftmann
parents: 22493
diff changeset
  4709
  unfolding list_all_iff by (auto intro: all_nth_imp_all_set)
c78f1d924bfe two further properties about lists
haftmann
parents: 22493
diff changeset
  4710
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4711
lemma list_ex_iff [code_post]:
22422
ee19cdb07528 stepping towards uniform lattice theory development in HOL
haftmann
parents: 22262
diff changeset
  4712
  "list_ex P xs \<longleftrightarrow> (\<exists>x \<in> set xs. P x)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4713
by (induct xs) simp_all
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4714
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4715
lemmas list_bex_code [code_unfold] =
22799
ed7d53db2170 moved code generation pretty integers and characters to separate theories
haftmann
parents: 22793
diff changeset
  4716
  list_ex_iff [symmetric]
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4717
22506
c78f1d924bfe two further properties about lists
haftmann
parents: 22493
diff changeset
  4718
lemma list_ex_length:
c78f1d924bfe two further properties about lists
haftmann
parents: 22493
diff changeset
  4719
  "list_ex P xs \<longleftrightarrow> (\<exists>n < length xs. P (xs ! n))"
c78f1d924bfe two further properties about lists
haftmann
parents: 22493
diff changeset
  4720
  unfolding list_ex_iff set_conv_nth by auto
c78f1d924bfe two further properties about lists
haftmann
parents: 22493
diff changeset
  4721
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4722
lemma filtermap_conv:
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4723
   "filtermap f xs = map (\<lambda>x. the (f x)) (filter (\<lambda>x. f x \<noteq> None) xs)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4724
by (induct xs) (simp_all split: option.split) 
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4725
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4726
lemma map_filter_conv [simp]:
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4727
  "map_filter f P xs = map f (filter P xs)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4728
by (induct xs) auto
21061
580dfc999ef6 added normal post setup; cleaned up "execution" constants
haftmann
parents: 21046
diff changeset
  4729
32069
6d28bbd33e2c prefer code_inline over code_unfold; use code_unfold_post where appropriate
haftmann
parents: 31998
diff changeset
  4730
lemma length_remdups_length_unique [code_unfold]:
28789
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4731
  "length (remdups xs) = length_unique xs"
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4732
by (induct xs) simp_all
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4733
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4734
lemma concat_map_code[code_unfold]:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4735
  "concat(map f xs) = concat_map f xs"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4736
by (induct xs) simp_all
28789
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4737
32681
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  4738
declare INFI_def [code_unfold]
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  4739
declare SUPR_def [code_unfold]
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  4740
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  4741
declare set_map [symmetric, code_unfold]
adeac3cbb659 lemma relating fold1 and foldl; code_unfold rules for Inf_fin, Sup_fin, Min, Max, Inf, Sup
haftmann
parents: 32422
diff changeset
  4742
36176
3fe7e97ccca8 replaced generic 'hide' command by more conventional 'hide_class', 'hide_type', 'hide_const', 'hide_fact' -- frees some popular keywords;
wenzelm
parents: 36154
diff changeset
  4743
hide_const (open) length_unique
28789
5a404273ea8f added length_unique operation for code generation
haftmann
parents: 28708
diff changeset
  4744
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  4745
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  4746
text {* Code for bounded quantification and summation over nats. *}
21891
b4e4ea3db161 added code lemmas for quantification over bounded nats
haftmann
parents: 21871
diff changeset
  4747
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4748
lemma atMost_upto [code_unfold]:
28072
a45e8c872dc1 It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents: 28068
diff changeset
  4749
  "{..n} = set [0..<Suc n]"
a45e8c872dc1 It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents: 28068
diff changeset
  4750
by auto
a45e8c872dc1 It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents: 28068
diff changeset
  4751
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4752
lemma atLeast_upt [code_unfold]:
28072
a45e8c872dc1 It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents: 28068
diff changeset
  4753
  "{..<n} = set [0..<n]"
a45e8c872dc1 It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents: 28068
diff changeset
  4754
by auto
a45e8c872dc1 It appears that the code generator (Stefan's) needs some laws that appear superfluous: {..n} = set ...
nipkow
parents: 28068
diff changeset
  4755
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4756
lemma greaterThanLessThan_upt [code_unfold]:
21891
b4e4ea3db161 added code lemmas for quantification over bounded nats
haftmann
parents: 21871
diff changeset
  4757
  "{n<..<m} = set [Suc n..<m]"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4758
by auto
22799
ed7d53db2170 moved code generation pretty integers and characters to separate theories
haftmann
parents: 22793
diff changeset
  4759
32417
e87d9c78910c tuned code generation for lists
nipkow
parents: 32415
diff changeset
  4760
lemmas atLeastLessThan_upt [code_unfold] = set_upt [symmetric]
22799
ed7d53db2170 moved code generation pretty integers and characters to separate theories
haftmann
parents: 22793
diff changeset
  4761
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4762
lemma greaterThanAtMost_upt [code_unfold]:
24645
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  4763
  "{n<..m} = set [Suc n..<Suc m]"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4764
by auto
22799
ed7d53db2170 moved code generation pretty integers and characters to separate theories
haftmann
parents: 22793
diff changeset
  4765
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4766
lemma atLeastAtMost_upt [code_unfold]:
24645
1af302128da2 Generalized [_.._] from nat to linear orders
nipkow
parents: 24640
diff changeset
  4767
  "{n..m} = set [n..<Suc m]"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4768
by auto
22799
ed7d53db2170 moved code generation pretty integers and characters to separate theories
haftmann
parents: 22793
diff changeset
  4769
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4770
lemma all_nat_less_eq [code_unfold]:
21891
b4e4ea3db161 added code lemmas for quantification over bounded nats
haftmann
parents: 21871
diff changeset
  4771
  "(\<forall>m<n\<Colon>nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..<n}. P m)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4772
by auto
22799
ed7d53db2170 moved code generation pretty integers and characters to separate theories
haftmann
parents: 22793
diff changeset
  4773
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4774
lemma ex_nat_less_eq [code_unfold]:
21891
b4e4ea3db161 added code lemmas for quantification over bounded nats
haftmann
parents: 21871
diff changeset
  4775
  "(\<exists>m<n\<Colon>nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..<n}. P m)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4776
by auto
22799
ed7d53db2170 moved code generation pretty integers and characters to separate theories
haftmann
parents: 22793
diff changeset
  4777
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4778
lemma all_nat_less [code_unfold]:
21891
b4e4ea3db161 added code lemmas for quantification over bounded nats
haftmann
parents: 21871
diff changeset
  4779
  "(\<forall>m\<le>n\<Colon>nat. P m) \<longleftrightarrow> (\<forall>m \<in> {0..n}. P m)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4780
by auto
22799
ed7d53db2170 moved code generation pretty integers and characters to separate theories
haftmann
parents: 22793
diff changeset
  4781
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4782
lemma ex_nat_less [code_unfold]:
21891
b4e4ea3db161 added code lemmas for quantification over bounded nats
haftmann
parents: 21871
diff changeset
  4783
  "(\<exists>m\<le>n\<Colon>nat. P m) \<longleftrightarrow> (\<exists>m \<in> {0..n}. P m)"
24349
0dd8782fb02d Final mods for list comprehension
nipkow
parents: 24335
diff changeset
  4784
by auto
22799
ed7d53db2170 moved code generation pretty integers and characters to separate theories
haftmann
parents: 22793
diff changeset
  4785
27715
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4786
lemma setsum_set_distinct_conv_listsum:
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4787
  "distinct xs \<Longrightarrow> setsum f (set xs) = listsum (map f xs)"
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4788
by (induct xs) simp_all
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4789
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4790
lemma setsum_set_upt_conv_listsum [code_unfold]:
27715
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4791
  "setsum f (set [m..<n]) = listsum (map f [m..<n])"
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4792
by (rule setsum_set_distinct_conv_listsum) simp
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4793
33639
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4794
text {* General equivalence between @{const listsum} and @{const setsum} *}
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4795
lemma listsum_setsum_nth:
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4796
  "listsum xs = (\<Sum> i = 0 ..< length xs. xs ! i)"
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4797
using setsum_set_upt_conv_listsum[of "op ! xs" 0 "length xs"]
603320b93668 New list theorems; added map_map to simpset, this is the prefered direction; allow sorting by a key
hoelzl
parents: 33593
diff changeset
  4798
by (simp add: map_nth)
27715
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4799
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4800
text {* Code for summation over ints. *}
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4801
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4802
lemma greaterThanLessThan_upto [code_unfold]:
27715
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4803
  "{i<..<j::int} = set [i+1..j - 1]"
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4804
by auto
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4805
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4806
lemma atLeastLessThan_upto [code_unfold]:
27715
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4807
  "{i..<j::int} = set [i..j - 1]"
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4808
by auto
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4809
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4810
lemma greaterThanAtMost_upto [code_unfold]:
27715
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4811
  "{i<..j::int} = set [i+1..j]"
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4812
by auto
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4813
32415
1dddf2f64266 got rid of complicated class finite_intvl_succ and defined "upto" directly on int, the only instance of the class.
nipkow
parents: 32078
diff changeset
  4814
lemmas atLeastAtMost_upto [code_unfold] = set_upto[symmetric]
27715
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4815
31998
2c7a24f74db9 code attributes use common underscore convention
haftmann
parents: 31930
diff changeset
  4816
lemma setsum_set_upto_conv_listsum [code_unfold]:
27715
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4817
  "setsum f (set [i..j::int]) = listsum (map f [i..j])"
087db5aacac3 made setsum executable on int.
nipkow
parents: 27693
diff changeset
  4818
by (rule setsum_set_distinct_conv_listsum) simp
24449
2f05cb7fed85 added (code) lemmas for setsum and foldl
nipkow
parents: 24349
diff changeset
  4819
32422
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4820
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4821
text {* Optimized code for @{text"\<forall>i\<in>{a..b::int}"} and @{text"\<forall>n:{a..<b::nat}"}
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4822
and similiarly for @{text"\<exists>"}. *}
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4823
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4824
function all_from_to_nat :: "(nat \<Rightarrow> bool) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4825
"all_from_to_nat P i j =
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4826
 (if i < j then if P i then all_from_to_nat P (i+1) j else False
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4827
  else True)"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4828
by auto
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4829
termination
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4830
by (relation "measure(%(P,i,j). j - i)") auto
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4831
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4832
declare all_from_to_nat.simps[simp del]
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4833
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4834
lemma all_from_to_nat_iff_ball:
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4835
  "all_from_to_nat P i j = (ALL n : {i ..< j}. P n)"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4836
proof(induct P i j rule:all_from_to_nat.induct)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4837
  case (1 P i j)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4838
  let ?yes = "i < j & P i"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4839
  show ?case
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4840
  proof (cases)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4841
    assume ?yes
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4842
    hence "all_from_to_nat P i j = (P i & all_from_to_nat P (i+1) j)"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4843
      by(simp add: all_from_to_nat.simps)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4844
    also have "... = (P i & (ALL n : {i+1 ..< j}. P n))" using `?yes` 1 by simp
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4845
    also have "... = (ALL n : {i ..< j}. P n)" (is "?L = ?R")
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4846
    proof
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4847
      assume L: ?L
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4848
      show ?R
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4849
      proof clarify
32960
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4850
        fix n assume n: "n : {i..<j}"
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4851
        show "P n"
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4852
        proof cases
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4853
          assume "n = i" thus "P n" using L by simp
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4854
        next
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4855
          assume "n ~= i"
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4856
          hence "i+1 <= n" using n by auto
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4857
          thus "P n" using L n by simp
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4858
        qed
32422
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4859
      qed
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4860
    next
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4861
      assume R: ?R thus ?L using `?yes` 1 by auto
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4862
    qed
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4863
    finally show ?thesis .
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4864
  next
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4865
    assume "~?yes" thus ?thesis by(auto simp add: all_from_to_nat.simps)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4866
  qed
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4867
qed
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4868
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4869
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4870
lemma list_all_iff_all_from_to_nat[code_unfold]:
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4871
  "list_all P [i..<j] = all_from_to_nat P i j"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4872
by(simp add: all_from_to_nat_iff_ball list_all_iff)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4873
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4874
lemma list_ex_iff_not_all_from_to_not_nat[code_unfold]:
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4875
  "list_ex P [i..<j] = (~all_from_to_nat (%x. ~P x) i j)"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4876
by(simp add: all_from_to_nat_iff_ball list_ex_iff)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4877
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4878
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4879
function all_from_to_int :: "(int \<Rightarrow> bool) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4880
"all_from_to_int P i j =
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4881
 (if i <= j then if P i then all_from_to_int P (i+1) j else False
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4882
  else True)"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4883
by auto
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4884
termination
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4885
by (relation "measure(%(P,i,j). nat(j - i + 1))") auto
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4886
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4887
declare all_from_to_int.simps[simp del]
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4888
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4889
lemma all_from_to_int_iff_ball:
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4890
  "all_from_to_int P i j = (ALL n : {i .. j}. P n)"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4891
proof(induct P i j rule:all_from_to_int.induct)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4892
  case (1 P i j)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4893
  let ?yes = "i <= j & P i"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4894
  show ?case
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4895
  proof (cases)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4896
    assume ?yes
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4897
    hence "all_from_to_int P i j = (P i & all_from_to_int P (i+1) j)"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4898
      by(simp add: all_from_to_int.simps)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4899
    also have "... = (P i & (ALL n : {i+1 .. j}. P n))" using `?yes` 1 by simp
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4900
    also have "... = (ALL n : {i .. j}. P n)" (is "?L = ?R")
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4901
    proof
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4902
      assume L: ?L
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4903
      show ?R
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4904
      proof clarify
32960
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4905
        fix n assume n: "n : {i..j}"
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4906
        show "P n"
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4907
        proof cases
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4908
          assume "n = i" thus "P n" using L by simp
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4909
        next
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4910
          assume "n ~= i"
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4911
          hence "i+1 <= n" using n by auto
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4912
          thus "P n" using L n by simp
69916a850301 eliminated hard tabulators, guessing at each author's individual tab-width;
wenzelm
parents: 32681
diff changeset
  4913
        qed
32422
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4914
      qed
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4915
    next
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4916
      assume R: ?R thus ?L using `?yes` 1 by auto
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4917
    qed
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4918
    finally show ?thesis .
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4919
  next
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4920
    assume "~?yes" thus ?thesis by(auto simp add: all_from_to_int.simps)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4921
  qed
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4922
qed
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4923
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4924
lemma list_all_iff_all_from_to_int[code_unfold]:
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4925
  "list_all P [i..j] = all_from_to_int P i j"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4926
by(simp add: all_from_to_int_iff_ball list_all_iff)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4927
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4928
lemma list_ex_iff_not_all_from_to_not_int[code_unfold]:
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4929
  "list_ex P [i..j] = (~ all_from_to_int (%x. ~P x) i j)"
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4930
by(simp add: all_from_to_int_iff_ball list_ex_iff)
46fc4d4ff4c0 code generator: quantifiers over {_.._::int} and {_..<_::nat}
nipkow
parents: 32417
diff changeset
  4931
37424
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4932
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4933
subsubsection {* Use convenient predefined operations *}
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4934
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4935
code_const "op @"
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4936
  (SML infixr 7 "@")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4937
  (OCaml infixr 6 "@")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4938
  (Haskell infixr 5 "++")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4939
  (Scala infixl 7 "++")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4940
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4941
code_const map
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4942
  (Haskell "map")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4943
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4944
code_const filter
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4945
  (Haskell "filter")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4946
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4947
code_const concat
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4948
  (Haskell "concat")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4949
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4950
code_const rev
37451
3058c918e7a3 rev is reverse in Haskell
haftmann
parents: 37424
diff changeset
  4951
  (Haskell "reverse")
37424
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4952
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4953
code_const zip
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4954
  (Haskell "zip")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4955
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4956
code_const takeWhile
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4957
  (Haskell "takeWhile")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4958
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4959
code_const dropWhile
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4960
  (Haskell "dropWhile")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4961
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4962
code_const hd
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4963
  (Haskell "head")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4964
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4965
code_const last
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4966
  (Haskell "last")
ed431cc99f17 use various predefined Haskell operations when generating code
haftmann
parents: 37408
diff changeset
  4967
23388
77645da0db85 tuned proofs: avoid implicit prems;
wenzelm
parents: 23279
diff changeset
  4968
end