(* 
   note that IMP2 is not part of the Isabelle distribution,
   but of the "Archive of Formal Proofs (AFP)";
   
   so to run this theory, 
   - download the AFP from https://www.isa-afp.org
   - extract it, e.g., to ~/afp/2024
   - start Isabelle with 
    
     isabelle jedit -d ~/afp/2024/thys -l IMP2 Demo06.thy 

     this will precompile IMP2 once, and then load the demo.
*)
theory Demo06
  imports IMP2.IMP2
begin

fun fact_int :: "int \<Rightarrow> int" where
  "fact_int x = (if x < 0 then undefined else fact (nat x))" 

lemma nat_decr[simp]: "x > 0 \<Longrightarrow> nat x = Suc (nat (x - 1))" by auto

fun binom_int :: "int \<Rightarrow> int \<Rightarrow> int" where
  "binom_int n k = (if n \<ge> 0 \<and> k \<ge> 0 then int (nat n choose nat k) else undefined)" 

(* example with invariant that is not strong enough *)
procedure_spec (partial) fact_prog(x) 
  returns y 
  assumes \<open>x \<ge> 0\<close> 
    ensures "y = fact_int x\<^sub>0"
  defines \<open>
    y = 1;
    while (x > 0) 
      @invariant \<open>y * fact_int x = fact_int x\<^sub>0\<close>
    {
      y = y * x;
      x = x - 1
    }
  \<close>
  apply vcg
    apply simp
   apply simp
  oops (* we have to abort attempt *)


procedure_spec (partial) fact_prog(x) 
  returns y 
  assumes \<open>x \<ge> 0\<close> 
    ensures "y = fact_int x\<^sub>0"
  defines \<open>
    y = 1;
    while (x > 0) 
    @invariant \<open>y * fact_int x = fact_int x\<^sub>0 \<and> x \<ge> 0\<close>
    {
      y = y * x;
      x = x - 1
    }
  \<close>
  apply vcg
    apply simp
   apply simp
  apply simp
  done


procedure_spec (partial) binom_prog(n,k) 
  returns r
  assumes \<open>n \<ge> 0 \<and> k \<ge> 0 \<and> n \<ge> k\<close> 
    ensures "r = binom_int n\<^sub>0 k\<^sub>0"
  defines \<open>
    a = fact_prog(n);
    b = fact_prog(k);
    c = fact_prog (n - k);
    r = a / (b * c)
  \<close>
  apply vcg
  subgoal by simp (* precond fact *)
  subgoal by simp (* precond fact *)
  subgoal by simp (* precond fact *)
  subgoal for n k a b c unfolding binom_int.simps
    apply (subst binomial_fact')
    subgoal by linarith
    subgoal apply simp 
      by (metis div_mult2_eq int_eq_iff nat_diff_distrib' of_nat_fact zdiv_int zdiv_zmult2_eq)
    done
  done


definition S :: "(int \<Rightarrow> int) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> int" where
  "S a i j = sum a {i .. j}"

definition Inv1 :: "(int \<Rightarrow> int) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
  "Inv1 a s k = (\<forall> i j. 0 \<le> i \<longrightarrow> i \<le> j \<longrightarrow> j < k \<longrightarrow> s \<le> S a i j)" 

definition Inv2 :: "(int \<Rightarrow> int) \<Rightarrow> int \<Rightarrow> int \<Rightarrow> bool" where
  "Inv2 a t k = (\<forall> i. 0 \<le> i \<longrightarrow> i < k \<longrightarrow> t \<le> S a i (k - 1))" 

(* prepare algorithm: language does not have any built-in min-operation,
   so, we program it *)
procedure_spec min_alg (a,b) 
  returns a
  assumes \<open>True\<close> 
    ensures \<open>a = min a\<^sub>0 b\<^sub>0\<close> 
  defines \<open>if (b < a) {a = b}\<close>
  by vcg_cs

procedure_spec (partial) minsum_section(a,n) 
  returns s 
  assumes "n > 0" 
    ensures "Inv1 a\<^sub>0 s n\<^sub>0"
  defines \<open>
    k = 1;
    t = a[0];
    s = a[0];
    while (k \<noteq> n) 
    @invariant \<open>Inv1 a\<^sub>0 s k \<and> Inv2 a\<^sub>0 t k\<close>
    {
      t = min_alg (t + a[k], a[k]);
      s = min_alg (s, t);
      k = k + 1
    }
  \<close>
  apply vcg_cs
  subgoal for n n0 
  proof (auto simp add: Inv1_def Inv2_def S_def, goal_cases)
    case (1 i j)
    hence "i = 0" "j = 0" by linarith+
    thus ?case by auto
  next
    case (2 i)
    hence "i = 0" by linarith
    thus ?case by auto
  qed
  subgoal for a n k s t
  (* note that min_alg is already turned into min *) 
  proof goal_cases
    case 1
    {
      fix i
      assume "0 \<le> i" "i < k + 1" 
      have "min (t + a k) (a k) \<le> S a i k" 
      proof (cases "i < k")
        case True
        hence "{i..k} = {i .. k - 1} \<union> {k}" by auto
        hence "S a i k = S a i (k - 1) + a k" unfolding S_def by auto
        moreover from \<open>Inv2 a t k\<close> have "t \<le> S a i (k - 1)" 
          using True \<open>0 \<le> i\<close> unfolding Inv2_def by auto
        ultimately show ?thesis by auto
      next
        case False
        with \<open>i < k + 1\<close> have i: "i = k" by auto
        thus ?thesis unfolding S_def by auto
      qed
    }
    hence Inv2: "Inv2 a (min (t + a k) (a k)) (k + 1)" unfolding Inv2_def by auto
    {
      fix i j
      assume *: "0 \<le> i" "i \<le> j" "j < k + 1" 
      have "min s (min (t + a k) (a k)) \<le> S a i j" 
      proof (cases "j < k")
        case True
        with \<open>Inv1 a s k\<close>[unfolded Inv1_def, rule_format, OF *(1-2) True]
        show ?thesis by auto
      next
        case False
        with * have "j = k" by auto
        with Inv2[unfolded Inv2_def, rule_format, of i] * 
        show ?thesis by auto
      qed
    }
    hence Inv1: "Inv1 a (min s (min (t + a k) (a k))) (k + 1)" unfolding Inv1_def by auto
    from Inv1 Inv2 show ?thesis by auto
  qed
  done


procedure_spec (partial) fact_partial_prog(x) 
  returns y 
  assumes \<open>x \<ge> 0\<close> 
    ensures "y = fact_int x\<^sub>0"
  defines \<open>
    y = 1;
    z = 0;
    while (x \<noteq> z) 
    @invariant \<open>y = fact_int z \<and> 0 \<le> z\<close>
    {
      z = z + 1;
      y = y * z
    }
  \<close>
  apply vcg
    apply simp
   apply simp
  apply simp
  done

text \<open>Slight deviation to PV-lecture w.r.t. how termination is proved: 
  here we need to enlarge invariant for successful termination proof\<close>
procedure_spec fact_total_prog(x) 
  returns y 
  assumes \<open>x \<ge> 0\<close> 
    ensures "y = fact_int x\<^sub>0"
  defines \<open>
    y = 1;
    z = 0;
    while (x \<noteq> z) 
    @invariant \<open>y = fact_int z \<and> 0 \<le> z \<and> z \<le> x\<close>
    @variant \<open>x - z\<close>
    {
      z = z + 1;
      y = y * z
    }
  \<close>
  apply vcg
      apply simp
     apply simp
    apply simp
   apply simp
  apply simp
  done


end