src/HOL/Corec_Examples/LFilter.thy
author wenzelm
Fri, 22 Jul 2016 11:00:43 +0200
changeset 63540 f8652d0534fa
parent 63167 0909deb8059b
child 66453 cc19f7ca2ed6
permissions -rw-r--r--
tuned proofs -- avoid unstructured calculation;
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
62694
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
     1
(*  Title:      HOL/Corec_Examples/LFilter.thy
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
     2
    Author:     Andreas Lochbihler, ETH Zuerich
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
     3
    Author:     Dmitriy Traytel, ETH Zuerich
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
     4
    Author:     Andrei Popescu, TU Muenchen
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
     5
    Copyright   2014, 2016
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
     6
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
     7
The filter function on lazy lists.
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
     8
*)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
     9
62726
5b2a7caa855b tuned examples
blanchet
parents: 62698
diff changeset
    10
section \<open>The Filter Function on Lazy Lists\<close>
62694
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    11
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    12
theory LFilter
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    13
imports "~~/src/HOL/Library/BNF_Corec"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    14
begin
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    15
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    16
codatatype (lset: 'a) llist =
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    17
  LNil
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    18
| LCons (lhd: 'a) (ltl: "'a llist")
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    19
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    20
corecursive lfilter where
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    21
  "lfilter P xs = (if \<forall>x \<in> lset xs. \<not> P x then
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    22
    LNil
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    23
    else if P (lhd xs) then
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    24
      LCons (lhd xs) (lfilter P (ltl xs))
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    25
    else
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    26
      lfilter P (ltl xs))"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    27
proof (relation "measure (\<lambda>(P, xs). LEAST n. P (lhd ((ltl ^^ n) xs)))", rule wf_measure, clarsimp)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    28
  fix P xs x
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    29
  assume "x \<in> lset xs" "P x" "\<not> P (lhd xs)"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    30
  from this(1,2) obtain a where "P (lhd ((ltl ^^ a) xs))"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    31
    by (atomize_elim, induct x xs rule: llist.set_induct)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    32
       (auto simp: funpow_Suc_right simp del: funpow.simps(2) intro: exI[of _ 0] exI[of _ "Suc i" for i])
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    33
  with \<open>\<not> P (lhd xs)\<close>
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    34
    have "(LEAST n. P (lhd ((ltl ^^ n) xs))) = Suc (LEAST n. P (lhd ((ltl ^^ Suc n) xs)))"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    35
    by (intro Least_Suc) auto
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    36
  then show "(LEAST n. P (lhd ((ltl ^^ n) (ltl xs)))) < (LEAST n. P (lhd ((ltl ^^ n) xs)))"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    37
    by (simp add: funpow_swap1[of ltl])
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    38
qed
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    39
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    40
lemma lfilter_LNil [simp]: "lfilter P LNil = LNil"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    41
  by(simp add: lfilter.code)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    42
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    43
lemma lnull_lfilter [simp]: "lfilter P xs = LNil \<longleftrightarrow> (\<forall>x \<in> lset xs. \<not> P x)"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    44
proof(rule iffI ballI)+
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    45
  show "\<not> P x" if "x \<in> lset xs" "lfilter P xs = LNil" for x using that
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    46
    by(induction rule: llist.set_induct)(subst (asm) lfilter.code; auto split: if_split_asm; fail)+
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    47
qed(simp add: lfilter.code)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    48
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    49
lemma lfilter_LCons [simp]: "lfilter P (LCons x xs) = (if P x then LCons x (lfilter P xs) else lfilter P xs)"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    50
  by(subst lfilter.code)(auto intro: sym)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    51
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    52
lemma llist_in_lfilter [simp]: "lset (lfilter P xs) = lset xs \<inter> {x. P x}"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    53
proof(intro set_eqI iffI)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    54
  show "x \<in> lset xs \<inter> {x. P x}" if "x \<in> lset (lfilter P xs)" for x using that
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    55
  proof(induction ys\<equiv>"lfilter P xs" arbitrary: xs rule: llist.set_induct)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    56
    case (LCons1 x xs ys)
62698
9d706e37ddab tuned whitespace
blanchet
parents: 62694
diff changeset
    57
    from this show ?case
62694
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    58
      apply(induction arg\<equiv>"(P, ys)" arbitrary: ys rule: lfilter.inner_induct)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    59
      subgoal by(subst (asm) (2) lfilter.code)(auto split: if_split_asm elim: llist.set_cases)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    60
      done
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    61
  next
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    62
    case (LCons2 xs y x ys)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    63
    from LCons2(3) LCons2(1) show ?case
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    64
      apply(induction arg\<equiv>"(P, ys)" arbitrary: ys rule: lfilter.inner_induct)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    65
      subgoal using LCons2(2) by(subst (asm) (2) lfilter.code)(auto split: if_split_asm elim: llist.set_cases)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    66
      done
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    67
  qed
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    68
  show "x \<in> lset (lfilter P xs)" if "x \<in> lset xs \<inter> {x. P x}" for x
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    69
    using that[THEN IntD1] that[THEN IntD2] by(induction) auto
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    70
qed
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    71
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    72
lemma lfilter_unique_weak:
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    73
  "(\<And>xs. f xs = (if \<forall>x \<in> lset xs. \<not> P x then LNil
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    74
    else if P (lhd xs) then LCons (lhd xs) (f (ltl xs))
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    75
    else lfilter P (ltl xs)))
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    76
   \<Longrightarrow> f = lfilter P"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    77
  by(corec_unique)(rule ext lfilter.code)+
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    78
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    79
lemma lfilter_unique:
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    80
  assumes "\<And>xs. f xs = (if \<forall>x\<in>lset xs. \<not> P x then LNil
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    81
    else if P (lhd xs) then LCons (lhd xs) (f (ltl xs))
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    82
    else f (ltl xs))"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    83
  shows "f = lfilter P"
63167
0909deb8059b isabelle update_cartouches -c -t;
wenzelm
parents: 62726
diff changeset
    84
\<comment> \<open>It seems as if we cannot use @{thm lfilter_unique_weak} for showing this as the induction and the coinduction must be nested\<close>
62694
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    85
proof(rule ext)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    86
  show "f xs = lfilter P xs" for xs
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    87
  proof(coinduction arbitrary: xs)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    88
    case (Eq_llist xs)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    89
    show ?case
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    90
      apply(induction arg\<equiv>"(P, xs)" arbitrary: xs rule: lfilter.inner_induct)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    91
      apply(subst (1 2 3 4) assms)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    92
      apply(subst (1 2 3 4) lfilter.code)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    93
      apply auto
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    94
      done
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    95
  qed
62698
9d706e37ddab tuned whitespace
blanchet
parents: 62694
diff changeset
    96
qed
62694
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    97
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    98
lemma lfilter_lfilter: "lfilter P \<circ> lfilter Q = lfilter (\<lambda>x. P x \<and> Q x)"
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
    99
  by(rule lfilter_unique)(auto elim: llist.set_cases)
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
   100
f50d7efc8fe3 added two 'corec' examples
blanchet
parents:
diff changeset
   101
end