Theory Puzzle

Up to index of Isabelle/HOL/Isar_examples

theory Puzzle
imports Main


header {* An old chestnut *}

theory Puzzle imports Main begin

text_raw {*
  \footnote{A question from ``Bundeswettbewerb Mathematik''.  Original
  pen-and-paper proof due to Herbert Ehler; Isabelle tactic script by
  Tobias Nipkow.}
*}

text {*
  \textbf{Problem.}  Given some function $f\colon \Nat \to \Nat$ such
  that $f \ap (f \ap n) < f \ap (\idt{Suc} \ap n)$ for all $n$.
  Demonstrate that $f$ is the identity.
*}

theorem
  assumes f_ax: "!!n. f (f n) < f (Suc n)"
  shows "f n = n"
proof (rule order_antisym)
  {
    fix n show "n ≤ f n"
    proof (induct k  "f n" arbitrary: n rule: less_induct)
      case (less k n)
      then have hyp: "!!m. f m < f n ==> m ≤ f m" by (simp only:)
      show "n ≤ f n"
      proof (cases n)
        case (Suc m)
        from f_ax have "f (f m) < f n" by (simp only: Suc)
        with hyp have "f m ≤ f (f m)" .
        also from f_ax have "… < f n" by (simp only: Suc)
        finally have "f m < f n" .
        with hyp have "m ≤ f m" .
        also note `… < f n`
        finally have "m < f n" .
        then have "n ≤ f n" by (simp only: Suc)
        then show ?thesis .
      next
        case 0
        then show ?thesis by simp
      qed
    qed
  } note ge = this

  {
    fix m n :: nat
    assume "m ≤ n"
    then have "f m ≤ f n"
    proof (induct n)
      case 0
      then have "m = 0" by simp
      then show ?case by simp
    next
      case (Suc n)
      from Suc.prems show "f m ≤ f (Suc n)"
      proof (rule le_SucE)
        assume "m ≤ n"
        with Suc.hyps have "f m ≤ f n" .
        also from ge f_ax have "… < f (Suc n)"
          by (rule le_less_trans)
        finally show ?thesis by simp
      next
        assume "m = Suc n"
        then show ?thesis by simp
      qed
    qed
  } note mono = this

  show "f n ≤ n"
  proof -
    have "¬ n < f n"
    proof
      assume "n < f n"
      then have "Suc n ≤ f n" by simp
      then have "f (Suc n) ≤ f (f n)" by (rule mono)
      also have "… < f (Suc n)" by (rule f_ax)
      finally have "… < …" . then show False ..
    qed
    then show ?thesis by simp
  qed
qed

end