theory IICF_Indexed_Array_List
imports
  "HOL-Library.Rewrite"
  "../Intf/IICF_List"
  "List-Index.List_Index"
  IICF_Array
  IICF_MS_Array_List
begin

  (* TODO: Move *)

  abbreviation "snatb_rel N \<equiv> b_rel snat_rel (\<lambda>x. x<N)"
  abbreviation "snatb_rel' TYPE('l::len2) N \<equiv> b_rel (snat_rel' TYPE('l)) (\<lambda>x. x<N)"
  abbreviation "snatb_assn N \<equiv> b_assn snat_assn (\<lambda>x. x<N)"
  abbreviation "snatb_assn' TYPE('l::len2) N \<equiv> (snatb_assn N :: _ \<Rightarrow> 'l word \<Rightarrow> _)"

  (* TODO: Move *)
  lemma R_comp_brel_id_conv[fcomp_norm_simps]: "R O b_rel Id P = b_rel R P" by auto

  (* TODO: Move, clean up proof *)
  lemma snat_rel_range: "Range (snat_rel' TYPE('l)) = {0..<max_snat LENGTH('l::len2)}"
    apply (auto simp: Range_iff snat_rel_def snat.rel_def in_br_conv)
    subgoal for x
      apply (rule exI[where x="word_of_int (int x)"])
      apply (auto simp: max_snat_def snat_invar_def)
      subgoal
        by (metis One_nat_def snat_eq_unat(1) snat_in_bounds_aux unat_of_nat_eq word_of_nat)
      subgoal
        by (metis One_nat_def Word_Lemmas.of_nat_power diff_less len_gt_0 max_unat_def n_less_equal_power_2 not_msb_from_less power_0 word_of_nat)
      done
    done

  (* TODO: Move *)
  lemma in_snat_nbn_conv: "(a,b)\<in>(R O nbn_rel N) \<longleftrightarrow> (a,b)\<in>R \<and> b<N" by auto

  lemma range_comp_nbn_conv: "Range (R O nbn_rel N) = Range R \<inter> {0..<N}"
    by (auto 0 3 simp: b_rel_def)

  (*
  lemma range_snatb_conv: "Range (snatb_rel' TYPE('l) N) = {0..<N} \<inter> Range (snat_rel' TYPE('l::len2))"
    unfolding snatb_rel_def
    by (auto simp: range_comp_nbn_conv)

  lemma in_snatb_rel_bound: "(a,b)\<in>snatb_rel N \<Longrightarrow> b<N"
    by (simp add: in_snat_nbn_conv snatb_rel_def)
  *)

  text \<open>We implement distinct lists of natural numbers in the range @{text "{0..<N}"}
    by a length counter and two arrays of size @{text N}.
    The first array stores the list, and the second array stores the positions of
    the elements in the list, or @{text N} if the element is not in the list.

    This allows for an efficient index query.

    The implementation is done in two steps:
      First, we use a list and a fixed size list for the index mapping.
      Second, we refine the lists to arrays.
 \<close>

  type_synonym aial = "nat list \<times> nat option list"

  locale ial_invar = fixes
         maxsize :: nat
    and  l :: "nat list"
    and qp :: "nat option list"
    assumes maxsize_eq[simp]: "maxsize = length qp"
    assumes l_distinct[simp]: "distinct l"
    assumes l_set: "set l \<subseteq> {0..<length qp}"
    assumes qp_def: "\<forall>k<length qp. qp!k = (if k\<in>set l then Some (List_Index.index l k) else None)"
  begin
    lemma l_len: "length l \<le> length qp"
    proof -
      from card_mono[OF _ l_set] have "card (set l) \<le> length qp" by auto
      with distinct_card[OF l_distinct] show ?thesis by simp
    qed

    lemma idx_len[simp]: "i<length l \<Longrightarrow> l!i < length qp"
      using l_set
      by (metis atLeastLessThan_iff nth_mem psubsetD psubsetI)

    lemma l_set_simp[simp]: "k\<in>set l \<Longrightarrow> k < length qp"
      by (auto dest: set_mp[OF l_set])

    lemma qpk_idx: "k<length qp \<Longrightarrow> qp ! k \<noteq> None \<longleftrightarrow> k \<in> set l"
    proof (rule iffI)
      assume A: "k<length qp"
      {
        assume "qp!k \<noteq> None"
        with spec[OF qp_def, of k] A show "k\<in>set l"
          by (auto split: if_split_asm)
      }
      {
        assume "k\<in>set l"
        thus "qp!k\<noteq>None"
          using qp_def by (auto split: if_split_asm) []
      }
    qed

    lemma lqpk[simp]: "k \<in> set l \<Longrightarrow> l ! (the (qp ! k)) = k"
      using spec[OF qp_def, of k] by auto

    lemma "\<lbrakk>i<length l; j<length l; l!i=l!j\<rbrakk> \<Longrightarrow> i=j"
      by (simp add: nth_eq_iff_index_eq)

    lemmas index_swap[simp] = index_swap_if_distinct[folded swap_def, OF l_distinct]

    lemma swap_invar:
      assumes "i<length l" "j<length l"
      shows "ial_invar (length qp) (swap l i j) (qp[l ! j := Some i, l ! i := Some j])"
      using assms
      apply unfold_locales
      apply auto []
      apply auto []
      apply auto []
      apply (auto simp: simp: nth_list_update nth_eq_iff_index_eq index_nth_id) []
      using qp_def apply auto [2]
      done

  end

  definition "ial_rel1 maxsize \<equiv> br fst (uncurry (ial_invar maxsize))"

  definition op_ial_empty_sz :: "nat \<Rightarrow> 'a list"
    where [simp]: "op_ial_empty_sz ms \<equiv> op_list_empty"

  definition "aial_empty N \<equiv> do {
    let l = op_marl_empty N;
    let qp = op_array_custom_replicate N None;
    RETURN (l,qp)
  }"

  lemma aial_empty_refine: "(aial_empty N,RETURN op_list_empty) \<in> \<langle>ial_rel1 N\<rangle>nres_rel"
    unfolding aial_empty_def
    apply (refine_vcg nres_relI)
    apply (clarsimp simp: ial_rel1_def br_def)
    apply unfold_locales
    apply auto
    done

  definition "aial_swap \<equiv> \<lambda>(l,qp) i j. do {
    vi \<leftarrow> mop_list_get l i;
    vj \<leftarrow> mop_list_get l j;
    l \<leftarrow> mop_list_set l i vj;
    l \<leftarrow> mop_list_set l j vi;
    qp \<leftarrow> mop_list_set qp vj (Some i);
    qp \<leftarrow> mop_list_set qp vi (Some j);
    RETURN (l,qp)
  }"

  lemma in_ial_rel1_conv:
    "((pq, qp), l) \<in> ial_rel1 ms \<longleftrightarrow> pq=l \<and> ial_invar ms l qp"
    by (auto simp: ial_rel1_def in_br_conv)

  lemma aial_swap_refine:
    "(aial_swap,mop_list_swap) \<in> ial_rel1 maxsize \<rightarrow> nat_rel \<rightarrow> nat_rel \<rightarrow> \<langle>ial_rel1 maxsize\<rangle>nres_rel"
  proof (intro fun_relI nres_relI; clarsimp simp: in_ial_rel1_conv; refine_vcg; clarsimp)
    fix l qp i j
    assume [simp]: "i<length l" "j<length l" and "ial_invar maxsize l qp"
    then interpret ial_invar maxsize l qp by simp

    show "aial_swap (l, qp) i j \<le> SPEC (\<lambda>c. (c, swap l i j) \<in> ial_rel1 maxsize)"
      unfolding aial_swap_def
      apply refine_vcg
      apply (auto simp add: in_ial_rel1_conv swap_def[symmetric] swap_invar)
      done
  qed

  definition aial_length :: "aial \<Rightarrow> nat nres"
    where "aial_length \<equiv> \<lambda>(l,_). RETURN (op_list_length l)"

  lemma aial_length_refine: "(aial_length, mop_list_length) \<in> ial_rel1 maxsize \<rightarrow> \<langle>nbn_rel (maxsize+1)\<rangle>nres_rel"
    apply (intro fun_relI nres_relI)
    unfolding ial_rel1_def in_br_conv aial_length_def ial_invar_def
    apply (auto split: if_splits)
    by (meson ial_invar.intro ial_invar.l_len le_imp_less_Suc)

  definition aial_index :: "aial \<Rightarrow> nat \<Rightarrow> nat nres" where
    "aial_index \<equiv> \<lambda>(l,qp) k. do {
      ASSERT (k\<in>set l);
      i \<leftarrow> mop_list_get qp k;
      ASSERT (i\<noteq>None);
      RETURN (the i)
    }"

  lemma aial_index_refine:
    "(uncurry aial_index, uncurry mop_list_index) \<in>
      [\<lambda>(l,k). k\<in>set l]\<^sub>f ial_rel1 maxsize \<times>\<^sub>r nat_rel \<rightarrow> \<langle>nat_rel\<rangle>nres_rel"
    apply (intro fun_relI nres_relI frefI)
    unfolding ial_rel1_def
  proof (clarsimp simp:  in_br_conv)
    fix l qp k
    assume "ial_invar maxsize l qp"
    then interpret ial_invar maxsize l qp .

    assume "k\<in>set l"
    then show "aial_index (l,qp) k \<le> RETURN (index l k)"
      unfolding aial_index_def
      apply (refine_vcg)
      by (auto simp: qp_def)
  qed

  definition aial_butlast :: "aial \<Rightarrow> aial nres" where
    "aial_butlast \<equiv> \<lambda>(l,qp). do {
      ASSERT (l\<noteq>[]);
      len \<leftarrow> mop_list_length l;
      k \<leftarrow> mop_list_get l (len - 1);
      l \<leftarrow> mop_list_butlast l;
      qp \<leftarrow> mop_list_set qp k None;
      RETURN (l,qp)
    }"

  lemma aial_butlast_refine: "(aial_butlast, mop_list_butlast) \<in> ial_rel1 maxsize \<rightarrow> \<langle>ial_rel1 maxsize\<rangle>nres_rel"
    apply (intro fun_relI nres_relI)
    unfolding ial_rel1_def
  proof (clarsimp simp: in_br_conv simp del: mop_list_butlast_alt)
    fix l qp
    assume "ial_invar maxsize l qp"
    then interpret ial_invar maxsize l qp .

    {
      assume A: "l\<noteq>[]"
      have "ial_invar (length qp) (butlast l) (qp[l ! (length l - Suc 0) := None])"
        apply standard
        apply clarsimp_all
        apply (auto simp: distinct_butlast) []
        using l_set apply (auto dest: in_set_butlastD) []
        using qp_def A l_distinct
        apply (auto simp: nth_list_update neq_Nil_rev_conv index_append simp del: l_distinct)
        done
    } note aux1=this

    show "aial_butlast (l, qp) \<le> \<Down> (br fst (uncurry (ial_invar maxsize))) (mop_list_butlast l)"
      unfolding aial_butlast_def mop_list_butlast_alt
      apply refine_vcg
      apply (clarsimp_all simp: in_br_conv aux1)
      done
  qed

  definition aial_append :: "aial \<Rightarrow> nat \<Rightarrow> aial nres" where
    "aial_append \<equiv> \<lambda>(l,qp) k. do {
      ASSERT (k<length qp \<and> k\<notin>set l \<and> length l < length qp);
      len \<leftarrow> mop_list_length l;
      l \<leftarrow> mop_list_append l k;
      qp \<leftarrow> mop_list_set qp k (Some len);
      RETURN (l,qp)
    }"

  lemma aial_append_refine:
    "(uncurry aial_append,uncurry mop_list_append) \<in>
      [\<lambda>(l,k). k<maxsize \<and> k\<notin>set l]\<^sub>f ial_rel1 maxsize \<times>\<^sub>r nat_rel \<rightarrow> \<langle>ial_rel1 maxsize\<rangle>nres_rel"
    apply (intro frefI nres_relI)
    unfolding ial_rel1_def
  proof (clarsimp simp: in_br_conv)
    fix l qp k
    assume KLM: "k<maxsize" and KNL: "k\<notin>set l"
    assume "ial_invar maxsize l qp"
    then interpret ial_invar maxsize l qp .

    from KLM have KLL: "k<length qp" by simp

    note distinct_card[OF l_distinct, symmetric]
    also from KNL l_set have "set l \<subseteq> {0..<k} \<union> {Suc k..<length qp}"
      by (auto simp: nat_less_le)
    from card_mono[OF _ this] have "card (set l) \<le> card \<dots>"
      by simp
    also note card_Un_le
    also have "card {0..<k} + card {Suc k..<length qp} = k + (length qp - Suc k)"
      by simp
    also have "\<dots> < length qp" using KLL by simp
    finally have LLEN: "length l < length qp" .

    have aux1[simp]: "ial_invar (length qp) (l @ [k]) (qp[k := Some (length l)])"
      apply standard
      apply (clarsimp_all simp: KNL KLL)
      using KLL apply (auto simp: Suc_le_eq LLEN) []
      apply (auto simp: index_append KNL nth_list_update')
      apply (simp add: qp_def)
      apply (simp add: qp_def)
      done

    show "aial_append (l, qp) k \<le> \<Down> (br fst (uncurry (ial_invar maxsize))) (RETURN (l@[k]))"
      unfolding aial_append_def mop_list_append_def
      apply refine_vcg
      apply (clarsimp_all simp: in_br_conv KLL KNL LLEN)
      done
  qed

  definition aial_get :: "aial \<Rightarrow> nat \<Rightarrow> nat nres" where
    "aial_get \<equiv> \<lambda>(l,qp) i. mop_list_get l i"

  lemma aial_get_refine: "(aial_get,mop_list_get) \<in> ial_rel1 maxsize \<rightarrow> nat_rel \<rightarrow> \<langle>nat_rel\<rangle>nres_rel"
    apply (intro fun_relI nres_relI)
    unfolding aial_get_def ial_rel1_def mop_list_get_def in_br_conv
    apply refine_vcg
    apply clarsimp_all
    done

  definition aial_contains :: "nat \<Rightarrow> aial \<Rightarrow> bool nres" where
    "aial_contains \<equiv> \<lambda>k (l,qp). do {
      ASSERT (k<length qp);
      i \<leftarrow> mop_list_get qp k;
      RETURN (i\<noteq>None)
    }"

  lemma aial_contains_refine: "(uncurry aial_contains,uncurry mop_list_contains)
    \<in> [\<lambda>(k,_). k<maxsize]\<^sub>f (nat_rel \<times>\<^sub>r ial_rel1 maxsize) \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
    apply (intro frefI nres_relI)
    unfolding ial_rel1_def
  proof (clarsimp simp: in_br_conv)
    fix l qp k
    assume A: "k<maxsize"
    assume "ial_invar maxsize l qp"
    then interpret ial_invar maxsize l qp .

    show "aial_contains k (l, qp) \<le> RETURN (k\<in>set l)"
      unfolding aial_contains_def
      apply refine_vcg
      using A
      by (auto simp: l_len qp_def split: if_split_asm)

  qed

  type_synonym 'l ial = "('l,'l word) marl \<times> 'l word ptr"

  context
    fixes M :: nat
    defines "M \<equiv> max_snat (LENGTH ('l::len2))"
  begin

    abbreviation "ial2_assn N
      \<equiv> marl_assn' TYPE('l) (snat_assn' TYPE('l)) N \<times>\<^sub>a array_assn (snat_option_assn' TYPE('l))"

    private abbreviation (input) "idx_assn \<equiv> snat_assn' TYPE('l)"

    definition ial_assn :: "_ \<Rightarrow> _ \<Rightarrow> 'l ial \<Rightarrow> _" where "ial_assn N \<equiv> hr_comp (hr_comp (ial2_assn N) (ial_rel1 N)) (\<langle>nbn_rel N\<rangle>list_rel)"
    lemmas [fcomp_norm_unfold] = ial_assn_def[symmetric]

    abbreviation "ial_assn' TYPE('l) N \<equiv> ial_assn N"

    find_theorems SYNTH_TERM

    sepref_definition ial_empty_impl [llvm_code]
      is aial_empty :: "idx_assn\<^sup>k \<rightarrow>\<^sub>a\<^sub>d ial2_assn"
      unfolding aial_empty_def
      supply [simp] = snat_rel_imp_less_max_snat
      by sepref

    definition [simp]: "ial_empty_aux (N::nat) \<equiv> op_list_empty"
    sepref_decl_op ial_empty: ial_empty_aux :: "nat_rel \<rightarrow> \<langle>A\<rangle>list_rel" .
    lemma ial_fold_custom_empty:
      "[] = op_ial_empty N"
      "op_list_empty = op_ial_empty N"
      "mop_list_empty = mop_ial_empty N"
      by auto

    lemma aial_empty_refine':
      "(aial_empty, RETURN o op_ial_empty) \<in> nat_rel \<rightarrow>\<^sub>f\<^sub>d (\<lambda>N. \<langle>ial_rel1 N\<rangle>nres_rel)"
      apply (rule frefI)
      using aial_empty_refine
      by auto

    sepref_decl_impl ial_empty_impl.refine[FCOMP aial_empty_refine'] .

    sepref_definition ial_swap_impl [llvm_code] is "uncurry2 aial_swap" :: "(ial2_assn N)\<^sup>d*\<^sub>aidx_assn\<^sup>k*\<^sub>aidx_assn\<^sup>k \<rightarrow>\<^sub>a ial2_assn N"
      unfolding aial_swap_def
      by sepref
    sepref_decl_impl (ismop) ial_swap_impl.refine[FCOMP aial_swap_refine, of N N for N] uses mop_list_swap.fref[where A="nbn_rel N"] .

    sepref_definition ial_length_impl [llvm_inline] is "aial_length" :: "(ial2_assn N)\<^sup>k \<rightarrow>\<^sub>a idx_assn"
      unfolding aial_length_def
      by sepref
    sepref_decl_impl (ismop) ial_length_impl.refine[FCOMP aial_length_refine, of N N for N] uses mop_list_length.fref[where A="nbn_rel N"] .

    sepref_definition ial_index_impl [llvm_inline] is "uncurry aial_index" :: "(ial2_assn N)\<^sup>k *\<^sub>a idx_assn\<^sup>k \<rightarrow>\<^sub>a idx_assn"
      unfolding aial_index_def
      by sepref

    context
      (*notes snatb_rel_def[symmetric, fcomp_norm_unfold] *)
    begin
      sepref_decl_impl (ismop) ial_index_impl.refine[FCOMP aial_index_refine, of N N for N]
      uses mop_list_index.fref[where A="nbn_rel N"]
      .
    end

    sepref_definition ial_butlast_impl [llvm_code] is "aial_butlast" :: "(ial2_assn N)\<^sup>d \<rightarrow>\<^sub>a ial2_assn N"
      unfolding aial_butlast_def
      apply (annot_snat_const "TYPE('l)")
      by sepref
    sepref_decl_impl (ismop) ial_butlast_impl.refine[FCOMP aial_butlast_refine, of N N for N]
      uses mop_list_butlast.fref[where A="nbn_rel N"] .

    private lemma aial_append_impl_aux: "((l, qp), l') \<in> ial_rel1 maxsize \<Longrightarrow> l'=l \<and> maxsize = length qp"
      unfolding ial_rel1_def
      by (clarsimp simp: in_br_conv ial_invar.maxsize_eq[symmetric])

    sepref_definition ial_append_impl [llvm_code] is "uncurry aial_append" :: "[\<lambda>(lqp,_). lqp\<in>Domain (ial_rel1 N)]\<^sub>a (ial2_assn N)\<^sup>d *\<^sub>a idx_assn\<^sup>k \<rightarrow> ial2_assn N"
      unfolding aial_append_def
      supply [dest!] = aial_append_impl_aux
      by sepref

    lemmas ial_append_impl_refine_aux = ial_append_impl.refine[of N, FCOMP aial_append_refine[of N]] for N

    private lemma append_fref': "(uncurry mop_list_append, uncurry mop_list_append) \<in> \<langle>nbn_rel N\<rangle>list_rel \<times>\<^sub>r nbn_rel N \<rightarrow>\<^sub>f \<langle>\<langle>nbn_rel N\<rangle>list_rel\<rangle>nres_rel"
      by (rule mop_list_append.fref)

    (* TODO: Move *)
    lemma right_unique_inv[relator_props]: "IS_LEFT_UNIQUE R \<Longrightarrow> IS_RIGHT_UNIQUE (R\<inverse>)"
      by (simp add: IS_LEFT_UNIQUE_def)
    lemma left_unique_inv[relator_props]: "IS_RIGHT_UNIQUE R \<Longrightarrow> IS_LEFT_UNIQUE (R\<inverse>)"
      by (simp add: IS_LEFT_UNIQUE_def)

    lemma left_unique_id[relator_props]: "IS_LEFT_UNIQUE Id" by (auto simp: IS_LEFT_UNIQUE_def)

    context
      (*notes [fcomp_norm_unfold] = snatb_rel_def[symmetric]*)
    begin
      sepref_decl_impl (ismop) ial_append_impl_refine_aux[where N = N] uses append_fref'[where N=N]
        apply parametricity
        apply simp
        apply simp
        by tagged_solver+

      sepref_definition ial_get_impl [llvm_inline] is "uncurry aial_get" :: "(ial2_assn N)\<^sup>k *\<^sub>a idx_assn\<^sup>k \<rightarrow>\<^sub>a idx_assn"
        unfolding aial_get_def by sepref

      sepref_decl_impl (ismop) ial_get: ial_get_impl.refine[FCOMP aial_get_refine, of N N for N]
        uses mop_list_get.fref[where A="nbn_rel N"] .

      sepref_definition ial_contains_impl [llvm_code] is "uncurry aial_contains" :: "idx_assn\<^sup>k *\<^sub>a (ial2_assn N)\<^sup>k \<rightarrow>\<^sub>a bool1_assn"
        unfolding aial_contains_def
        by sepref

      private lemma list_contains_fref':
        "(uncurry mop_list_contains, uncurry mop_list_contains) \<in> nbn_rel N \<times>\<^sub>r \<langle>nbn_rel N\<rangle>list_rel \<rightarrow>\<^sub>f \<langle>bool_rel\<rangle>nres_rel"
        apply (rule mop_list_contains.fref)
        by tagged_solver+

      sepref_decl_impl (ismop) ial_contains_impl.refine[FCOMP aial_contains_refine, of N N]
        uses list_contains_fref'[where N=N]
        apply parametricity
        unfolding IS_BELOW_ID_def by auto

    end
  end

  schematic_goal [sepref_frame_free_rules]: "MK_FREE (ial_assn N) (?fr)"
    unfolding ial_assn_def
    by sepref_dbg_side

end


theory Worklist
imports "HOL-Library.While_Combinator" RTranCl Quasi_Order
begin

definition
  worklist_aux :: "('s \<Rightarrow> 'a \<Rightarrow> 'a list) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> 's)
    \<Rightarrow> 'a list * 's \<Rightarrow> ('a list * 's)option"
where
"worklist_aux succs f =
 while_option
   (\<lambda>(ws,s). ws \<noteq> [])
   (\<lambda>(ws,s). case ws of x#ws' \<Rightarrow> (succs s x @ ws', f x s))"

definition worklist :: "('s \<Rightarrow> 'a \<Rightarrow> 'a list) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> 's)
    \<Rightarrow> 'a list \<Rightarrow> 's \<Rightarrow> 's option" where
"worklist succs f ws s =
  (case worklist_aux succs f (ws,s) of
     None \<Rightarrow> None | Some(ws,s) \<Rightarrow> Some s)"

lemma worklist_aux_Nil: "worklist_aux succs f ([],s) = Some([],s)"
by(simp add: worklist_aux_def while_option_unfold)

lemma worklist_aux_Cons:
 "worklist_aux succs f (x#ws',s) = worklist_aux succs f (succs s x @ ws', f x s)"
by(simp add: worklist_aux_def while_option_unfold)

lemma worklist_aux_unfold[code]:
 "worklist_aux succs f (ws,s) =
 (case ws of [] \<Rightarrow> Some([],s)
  | x#ws' \<Rightarrow> worklist_aux succs f (succs s x @ ws', f x s))"
by(simp add: worklist_aux_Nil worklist_aux_Cons split: list.split)

definition
  worklist_tree_aux :: "('a \<Rightarrow> 'a list) \<Rightarrow> ('a \<Rightarrow> 's \<Rightarrow> 's)
    \<Rightarrow> 'a list * 's \<Rightarrow> ('a list * 's)option"
where
"worklist_tree_aux succs = worklist_aux (\<lambda>s. succs)"

lemma worklist_tree_aux_unfold[code]:
"worklist_tree_aux succs f (ws,s) =
 (case ws of [] \<Rightarrow> Some([],s) |
  x#ws' \<Rightarrow> worklist_tree_aux succs f (succs x @ ws', f x s))"
by(simp add: worklist_tree_aux_def worklist_aux_Nil worklist_aux_Cons split: list.split)

abbreviation Rel :: "('a \<Rightarrow> 'a list) \<Rightarrow> ('a * 'a)set" where
"Rel f == {(x,y). y : set(f x)}"

lemma Image_Rel_set:
  "(Rel succs)\<^sup>* `` set(succs x) = (Rel succs)\<^sup>+ `` {x}"
by(auto simp add: trancl_unfold_left)

lemma RTranCl_conv:
  "g [succs]\<rightarrow>* h \<longleftrightarrow> (g,h) : ((Rel succs)\<^sup>*)" (is "?L = ?R")
proof-
  have "?L \<Longrightarrow> ?R"
    apply(erule RTranCl_induct)
    apply blast
    apply (auto elim: rtrancl_into_rtrancl)
    done
  moreover
  have "?R \<Longrightarrow> ?L"
    apply(erule converse_rtrancl_induct)
    apply(rule RTranCl.refl)
    apply (auto elim: RTranCl.succs)
    done
  ultimately show ?thesis by blast
qed

lemma worklist_end_empty:
  "worklist_aux succs f (ws,s) = Some(ws',s') \<Longrightarrow> ws' = []"
unfolding worklist_aux_def
by (drule while_option_stop) simp

theorem worklist_tree_aux_Some_foldl:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
shows "\<exists>rs. set rs = ((Rel succs)\<^sup>*) `` (set ws) \<and>
              s' = foldl (\<lambda>s x. f x s) s rs"
proof -
  let ?b = "\<lambda>(ws,s). ws \<noteq> []"
  let ?c = "\<lambda>(ws,s). case ws of x#ws' \<Rightarrow> (succs x @ ws', f x s)"
  let ?Q = "\<lambda>ws' s' done.
    s' = foldl (\<lambda>x s. f s x) s done \<and>
      ((Rel succs)\<^sup>*) `` (set ws) =
          set done \<union> ((Rel succs)\<^sup>*) `` set ws'"
  let ?P = "\<lambda>(ws,s). \<exists>done. ?Q ws s done"
  have 0: "while_option ?b ?c (ws,s) = Some(ws',s')"
    using assms by(simp add: worklist_tree_aux_def worklist_aux_def)
  from while_option_stop[OF 0] have "ws' = []" by simp
  have init: "?P (ws,s)"
    apply auto
    apply(rule_tac x = "[]" in exI)
    apply simp
    done
  { fix ws s
    assume "?P (ws,s)"
    then obtain "done" where "?Q ws s done" by blast
    assume "?b(ws,s)"
    then obtain x ws' where "ws = x # ws'" by(auto simp: neq_Nil_conv)
    then have "?Q (succs x @ ws') (f x s) (done @ [x])"
      using \<open>?Q ws s done\<close>
      apply simp
      apply(erule thin_rl)+
      apply (auto simp add: Image_Un Image_Rel_set)
      apply (blast elim: rtranclE intro: rtrancl_into_trancl1)
      done
    hence "?P(?c(ws,s))" using \<open>ws=x#ws'\<close>
      by(simp only: split_conv list.cases) blast
  }
  then have "?P(ws',s')"
    using while_option_rule[where P="?P", OF _ 0 init]
    by auto
  then show ?thesis using \<open>ws'=[]\<close> by auto
qed

definition "worklist_tree succs f ws s =
  (case worklist_tree_aux succs f (ws,s) of
     None \<Rightarrow> None | Some(ws,s) \<Rightarrow> Some s)"

theorem worklist_tree_Some_foldl:
  "worklist_tree succs f ws s = Some s' \<Longrightarrow>
   \<exists>rs. set rs = ((Rel succs)\<^sup>*) `` (set ws) \<and>
              s' = foldl (\<lambda>s x. f x s) s rs"
by(simp add: worklist_tree_def worklist_tree_aux_Some_foldl split:option.splits prod.splits)

lemma invariant_succs:
assumes "invariant I succs"
and "\<forall>x\<in>S. I x"
shows "\<forall>x \<in> (Rel succs)\<^sup>* `` S. I x"
proof-
  { fix x y have "(x,y) : (Rel succs)\<^sup>* \<Longrightarrow> I x \<Longrightarrow> I y"
    proof(induct rule:rtrancl_induct)
      case base thus ?case .
    next
      case step with assms(1) show ?case by(auto simp:invariant_def)
    qed
  } with assms(2) show ?thesis by blast
qed

lemma worklist_tree_aux_rule:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
and "invariant I succs"
and "\<forall>x \<in> set ws. I x"
and "\<And>s. P [] s s"
and "\<And>r x ws s. I x \<Longrightarrow> \<forall>x \<in> set ws. I x \<Longrightarrow> P ws (f x s) r \<Longrightarrow> P (x#ws) s r"
shows "\<exists>rs. set rs = ((Rel succs)\<^sup>* ) `` (set ws) \<and> P rs s s'"
proof-
  let ?R = "(Rel succs)\<^sup>* `` set ws"
  from worklist_tree_aux_Some_foldl[OF assms(1)] obtain rs where
    rs: "set rs = ?R" "s' = foldl (\<lambda>s x. f x s) s rs" by blast
  { fix xs have "(\<forall>x \<in> set xs. I x) \<Longrightarrow> P xs s (foldl (\<lambda>s x. f x s) s xs)"
    proof(induct xs arbitrary: s)
      case Nil show ?case using assms(4) by simp
    next
      case Cons thus ?case using assms(5) by simp
    qed
  }
  with invariant_succs[OF assms(2,3)] show ?thesis by (metis rs)
qed

lemma worklist_tree_aux_rule2:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
and "invariant I succs"
and "\<forall>x \<in> set ws. I x"
and "S s" and "\<And>x s. I x \<Longrightarrow> S s \<Longrightarrow> S(f x s)"
and "\<And>s. P [] s s"
and "\<And>r x ws s. I x \<Longrightarrow> \<forall>x \<in> set ws. I x \<Longrightarrow> S s
  \<Longrightarrow> P ws (f x s) r \<Longrightarrow> P (x#ws) s r"
shows "\<exists>rs. set rs = ((Rel succs)\<^sup>*) `` (set ws) \<and> P rs s s'"
proof-
  let ?R = "(Rel succs)\<^sup>* `` set ws"
  from worklist_tree_aux_Some_foldl[OF assms(1)] obtain rs where
    rs: "set rs = ?R" "s' = foldl (\<lambda>s x. f x s) s rs" by blast
  { fix xs have "(\<forall>x \<in> set xs. I x) \<Longrightarrow> S s \<Longrightarrow> P xs s (foldl (\<lambda>s x. f x s) s xs)"
    proof(induct xs arbitrary: s)
      case Nil show ?case using assms(6) by simp
    next
      case Cons thus ?case using assms(5,7) by simp
    qed
  }
  with invariant_succs[OF assms(2,3)] assms(4) show ?thesis by (metis rs)
qed

lemma worklist_tree_rule:
assumes "worklist_tree succs f ws s = Some(s')"
and "invariant I succs"
and "\<forall>x \<in> set ws. I x"
and "\<And>s. P [] s s"
and "\<And>r x ws s. I x \<Longrightarrow> \<forall>x \<in> set ws. I x \<Longrightarrow> P ws (f x s) r \<Longrightarrow> P (x#ws) s r"
shows "\<exists>rs. set rs = ((Rel succs)\<^sup>*) `` (set ws) \<and> P rs s s'"
proof-
  obtain ws' where "worklist_tree_aux succs f (ws,s) = Some(ws',s')" using assms(1)
    by(simp add: worklist_tree_def split: option.split_asm prod.split_asm)
  from worklist_tree_aux_rule[where P=P,OF this assms(2-5)] show ?thesis by blast
qed

lemma worklist_tree_rule2:
assumes "worklist_tree succs f ws s = Some(s')"
and "invariant I succs"
and "\<forall>x \<in> set ws. I x"
and "S s" and "\<And>x s. I x \<Longrightarrow> S s \<Longrightarrow> S(f x s)"
and "\<And>s. P [] s s"
and "\<And>r x ws s. I x \<Longrightarrow> \<forall>x \<in> set ws. I x \<Longrightarrow> S s
  \<Longrightarrow> P ws (f x s) r \<Longrightarrow> P (x#ws) s r"
shows "\<exists>rs. set rs = ((Rel succs)\<^sup>*) `` (set ws) \<and> P rs s s'"
proof-
  obtain ws' where "worklist_tree_aux succs f (ws,s) = Some(ws',s')" using assms(1)
    by(simp add: worklist_tree_def split: option.split_asm prod.split_asm)
  from worklist_tree_aux_rule2[where P=P and S=S,OF this assms(2-7)]
  show ?thesis by blast
qed

lemma worklist_tree_aux_state_inv:
assumes "worklist_tree_aux succs f (ws,s) = Some(ws',s')"
and "I s"
and "\<And>x s. I s \<Longrightarrow> I(f x s)"
shows "I s'"
proof-
  from worklist_tree_aux_rule[where P="\<lambda>ws s s'. I s \<longrightarrow> I s'" and I="\<lambda>x. True",
    OF assms(1)] assms(2-3)
  show ?thesis by(auto simp: invariant_def)
qed

lemma worklist_tree_state_inv:
  "worklist_tree succs f ws s = Some(s')
   \<Longrightarrow> I s \<Longrightarrow> (\<And>x s. I s \<Longrightarrow> I(f x s)) \<Longrightarrow> I s'"
unfolding worklist_tree_def
by(auto intro: worklist_tree_aux_state_inv split: option.splits)

locale set_modulo = quasi_order +
fixes empty :: "'s"
and insert_mod :: "'a \<Rightarrow> 's \<Rightarrow> 's"
and set_of :: "'s \<Rightarrow> 'a set"
and I :: "'a \<Rightarrow> bool"
and S :: "'s \<Rightarrow> bool"
assumes set_of_empty: "set_of empty = {}"
and set_of_insert_mod: "I x \<Longrightarrow> S s \<and> (\<forall>x \<in> set_of s. I x)
  \<Longrightarrow>
  set_of(insert_mod x s) = insert x (set_of s) \<or>
  (\<exists>y \<in> set_of s. x \<preceq> y) \<and> set_of (insert_mod x s) = set_of s"
and S_empty: "S empty"
and S_insert_mod: "S s \<Longrightarrow> S (insert_mod x s)"
begin

definition insert_mod2 :: "('b \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'b \<Rightarrow> 's \<Rightarrow> 's" where
"insert_mod2 P f x s = (if P x then insert_mod (f x) s else s)"

definition "SI s = (S s \<and> (\<forall>x \<in> set_of s. I x))"

lemma SI_empty: "SI empty"
by(simp add: SI_def S_empty set_of_empty)

lemma SI_insert_mod:
  "I x \<Longrightarrow> SI s \<Longrightarrow> SI (insert_mod x s)"
apply(simp add: SI_def S_insert_mod)
by (metis insertE set_of_insert_mod)

lemma SI_insert_mod2: "(\<And>x. inv0 x \<Longrightarrow> I (f x)) \<Longrightarrow>
  inv0 x \<Longrightarrow> SI s \<Longrightarrow> SI (insert_mod2 P f x s)"
by (metis insert_mod2_def SI_insert_mod)

definition worklist_tree_coll_aux ::
  "('b \<Rightarrow> 'b list) \<Rightarrow> ('b \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'b list \<Rightarrow> 's \<Rightarrow> 's option"
where
"worklist_tree_coll_aux succs P f = worklist_tree succs (insert_mod2 P f)"

definition worklist_tree_coll ::
  "('b \<Rightarrow> 'b list) \<Rightarrow> ('b \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'b list \<Rightarrow> 's option"
where
"worklist_tree_coll succs P f ws = worklist_tree_coll_aux succs P f ws empty"

lemma worklist_tree_coll_aux_equiv:
assumes "worklist_tree_coll_aux succs P f ws s = Some s'"
and "invariant inv0 succs"
and "\<forall>x \<in> set ws. inv0 x"
and "\<And>x. inv0 x \<Longrightarrow> I(f x)"
and "SI s"
shows "set_of s' =\<^sub>\<preceq>
  f ` {x : (Rel succs)\<^sup>* `` (set ws). P x} \<union> set_of s"
apply(insert assms(1))
unfolding worklist_tree_coll_aux_def
apply(drule worklist_tree_rule2[where I = inv0 and S = SI and
  P = "\<lambda>ws s s'. SI s \<longrightarrow> set_of s' =\<^sub>\<preceq> f ` {x : set ws. P x} \<union> set_of s",
  OF _ assms(2,3,5)])
   apply(simp add: SI_insert_mod2 assms(4))
  apply(clarsimp)
 apply(clarsimp simp add: insert_mod2_def split: if_split_asm)
  apply(frule assms(4))
  apply(frule SI_def[THEN iffD1])
  apply(frule (1) set_of_insert_mod)
  apply (simp add: SI_insert_mod)
  apply(erule disjE)
   prefer 2
   apply(rule seteq_qle_trans)
    apply assumption
   apply (simp add: "defs")
   apply blast
  apply(rule seteq_qle_trans)
   apply assumption
  apply (simp add: "defs")
  apply blast
 apply(rule seteq_qle_trans)
  apply assumption
 apply (simp add: "defs")
 apply blast
using assms(5)
apply auto
done

lemma worklist_tree_coll_equiv:
  "worklist_tree_coll succs P f ws = Some s' \<Longrightarrow> invariant inv0 succs
   \<Longrightarrow> \<forall>x \<in> set ws. inv0 x \<Longrightarrow> (\<And>x. inv0 x \<Longrightarrow> I(f x))
   \<Longrightarrow> set_of s' =\<^sub>\<preceq> f ` {x : (Rel succs)\<^sup>* `` (set ws). P x}"
unfolding worklist_tree_coll_def
apply(drule (2) worklist_tree_coll_aux_equiv)
apply(auto simp: set_of_empty SI_empty)
done

lemma worklist_tree_coll_aux_subseteq:
  "worklist_tree_coll_aux succs P f ws t\<^sub>0 = Some t \<Longrightarrow>
  invariant inv0 succs \<Longrightarrow>  \<forall>g \<in> set ws. inv0 g \<Longrightarrow>
  (\<And>x. inv0 x \<Longrightarrow> I(f x)) \<Longrightarrow> SI t\<^sub>0 \<Longrightarrow>
  set_of t \<subseteq> set_of t\<^sub>0 \<union> f ` {h : (Rel succs)\<^sup>* `` set ws. P h}"
unfolding worklist_tree_coll_aux_def
apply(drule worklist_tree_rule2[where I = inv0 and S = SI and P =
  "\<lambda>ws t t'. set_of t' \<subseteq> set_of t \<union> f ` {g \<in> set ws. P g}"])
      apply assumption
     apply assumption
    apply assumption
   apply(simp add: SI_insert_mod2)
  apply clarsimp
 apply (clarsimp simp: insert_mod2_def split: if_split_asm)
  using set_of_insert_mod
  apply(simp add: SI_def image_def)
  apply(blast)
 apply blast
apply blast
done

lemma worklist_tree_coll_subseteq:
  "worklist_tree_coll succs P f ws = Some t \<Longrightarrow>
  invariant inv0 succs \<Longrightarrow> \<forall>g \<in> set ws. inv0 g \<Longrightarrow>
  (\<And>x. inv0 x \<Longrightarrow> I(f x)) \<Longrightarrow>
  set_of t \<subseteq> f ` {h : (Rel succs)\<^sup>* `` set ws. P h}"
unfolding worklist_tree_coll_def
apply(drule (1) worklist_tree_coll_aux_subseteq)
apply(auto simp: set_of_empty SI_empty)
done

lemma worklist_tree_coll_inv:
  "worklist_tree_coll succs P f ws = Some s \<Longrightarrow> S s"
unfolding worklist_tree_coll_def worklist_tree_coll_aux_def
apply(drule worklist_tree_state_inv[where I = S])
apply (auto simp: S_empty insert_mod2_def S_insert_mod)
done

end

end


(*  Title:      Atoms
    Authors:    Brian Huffman, Christian Urban

    Instantiations of concrete atoms
*)

theory Atoms
imports Nominal2_Base
begin

section {* @{const nat_of} is an example of a function
  without finite support *}

lemma not_fresh_nat_of:
  shows "\<not> a \<sharp> nat_of"
unfolding fresh_def supp_def
proof (clarsimp)
  assume "finite {b. (a \<rightleftharpoons> b) \<bullet> nat_of \<noteq> nat_of}"
  hence "finite ({a} \<union> {b. (a \<rightleftharpoons> b) \<bullet> nat_of \<noteq> nat_of})"
    by simp
  then obtain b where
    b1: "b \<noteq> a" and
    b2: "sort_of b = sort_of a" and
    b3: "(a \<rightleftharpoons> b) \<bullet> nat_of = nat_of"
    by (rule obtain_atom) auto
  have "nat_of a = (a \<rightleftharpoons> b) \<bullet> (nat_of a)" by (simp add: permute_nat_def)
  also have "\<dots> = ((a \<rightleftharpoons> b) \<bullet> nat_of) ((a \<rightleftharpoons> b) \<bullet> a)" by (simp add: permute_fun_app_eq)
  also have "\<dots> = nat_of ((a \<rightleftharpoons> b) \<bullet> a)" using b3 by simp
  also have "\<dots> = nat_of b" using b2 by simp
  finally have "nat_of a = nat_of b" by simp
  with b2 have "a = b" by (simp add: atom_components_eq_iff)
  with b1 show "False" by simp
qed

lemma supp_nat_of:
  shows "supp nat_of = UNIV"
  using not_fresh_nat_of [unfolded fresh_def] by auto

section {* Manual instantiation of class @{text at}. *}

typedef name = "{a. sort_of a = Sort ''name'' []}"
by (rule exists_eq_simple_sort)

instantiation name :: at
begin

definition
  "p \<bullet> a = Abs_name (p \<bullet> Rep_name a)"

definition
  "atom a = Rep_name a"

instance
apply (rule at_class)
apply (rule type_definition_name)
apply (rule atom_name_def)
apply (rule permute_name_def)
done

end

lemma sort_of_atom_name:
  shows "sort_of (atom (a::name)) = Sort ''name'' []"
  by (simp add: atom_name_def Rep_name[simplified])

text {* Custom syntax for concrete atoms of type at *}

term "a:::name"

section {* Automatic instantiation of class @{text at}. *}

atom_decl name2

lemma
  "sort_of (atom (a::name2)) \<noteq> sort_of (atom (b::name))"
by (simp add: sort_of_atom_name)

text {* example swappings *}
lemma
  fixes a b::"atom"
  assumes "sort_of a = sort_of b"
  shows "(a \<rightleftharpoons> b) \<bullet> (a, b) = (b, a)"
using assms
by simp

lemma
  fixes a b::"name2"
  shows "(a \<leftrightarrow> b) \<bullet> (a, b) = (b, a)"
by simp

section {* An example for multiple-sort atoms *}

datatype ty =
  TVar string
| Fun ty ty ("_ \<rightarrow> _")

primrec
  sort_of_ty::"ty \<Rightarrow> atom_sort"
where
  "sort_of_ty (TVar s) = Sort ''TVar'' [Sort s []]"
| "sort_of_ty (Fun ty1 ty2) = Sort ''Fun'' [sort_of_ty ty1, sort_of_ty ty2]"

lemma sort_of_ty_eq_iff:
  shows "sort_of_ty x = sort_of_ty y \<longleftrightarrow> x = y"
apply(induct x arbitrary: y)
apply(case_tac [!] y)
apply(simp_all)
done

declare sort_of_ty.simps [simp del]

typedef var = "{a. sort_of a \<in> range sort_of_ty}"
  by (rule_tac x="Atom (sort_of_ty x) y" in exI, simp)

instantiation var :: at_base
begin

definition
  "p \<bullet> a = Abs_var (p \<bullet> Rep_var a)"

definition
  "atom a = Rep_var a"

instance
apply (rule at_base_class)
apply (rule type_definition_var)
apply (rule atom_var_def)
apply (rule permute_var_def)
done

end

text {* Constructor for variables. *}

definition
  Var :: "nat \<Rightarrow> ty \<Rightarrow> var"
where
  "Var x t = Abs_var (Atom (sort_of_ty t) x)"

lemma Var_eq_iff [simp]:
  shows "Var x s = Var y t \<longleftrightarrow> x = y \<and> s = t"
  unfolding Var_def
  by (auto simp add: Abs_var_inject sort_of_ty_eq_iff)

lemma sort_of_atom_var [simp]:
  "sort_of (atom (Var n ty)) = sort_of_ty ty"
  unfolding atom_var_def Var_def
  by (simp add: Abs_var_inverse)

lemma
  assumes "\<alpha> \<noteq> \<beta>"
  shows "(Var x \<alpha> \<leftrightarrow> Var y \<alpha>) \<bullet> (Var x \<alpha>, Var x \<beta>) = (Var y \<alpha>, Var x \<beta>)"
  using assms by simp

text {* Projecting out the type component of a variable. *}

definition
  ty_of :: "var \<Rightarrow> ty"
where
  "ty_of x = inv sort_of_ty (sort_of (atom x))"

text {*
  Functions @{term Var}/@{term ty_of} satisfy many of the same
  properties as @{term Atom}/@{term sort_of}.
*}

lemma ty_of_Var [simp]:
  shows "ty_of (Var x t) = t"
  unfolding ty_of_def
  unfolding sort_of_atom_var
  apply (rule inv_f_f)
  apply (simp add: inj_on_def sort_of_ty_eq_iff)
  done

lemma ty_of_permute [simp]:
  shows "ty_of (p \<bullet> x) = ty_of x"
  unfolding ty_of_def
  unfolding atom_eqvt [symmetric]
  by (simp only: sort_of_permute)

section {* Tests with subtyping and automatic coercions *}

declare [[coercion_enabled]]

atom_decl var1
atom_decl var2

declare [[coercion "atom::var1\<Rightarrow>atom"]]

declare [[coercion "atom::var2\<Rightarrow>atom"]]

lemma
  fixes a::"var1" and b::"var2"
  shows "a \<sharp> t \<and> b \<sharp> t"
oops

(* does not yet work: it needs image as
   coercion map *)

lemma
  fixes as::"var1 set"
  shows "atom ` as \<sharp>* t"

oops

end


(* Author: Andreas Lochbihler, ETH Zurich *)

theory MFMC_Finite imports
  EdmondsKarp_Maxflow.EdmondsKarp_Termination_Abstract
  "HOL-Library.While_Combinator"
begin

section \<open>Existence of maximum flows and minimal cuts in finite graphs\<close>

text \<open>This theory derives the existencs of a maximal flow or a minimal cut for finite graphs
from the termination proof of the Edmonds-Karp algorithm.\<close>

context Graph begin

lemma outgoing_outside: "x \<notin> V \<Longrightarrow> outgoing x = {}"
  by(auto simp add: outgoing_def V_def)

lemma incoming_outside: "x \<notin> V \<Longrightarrow> incoming x = {}"
  by(auto simp add: incoming_def V_def)

end

context NFlow begin

lemma conservation: "\<lbrakk> x \<noteq> s; x \<noteq> t \<rbrakk> \<Longrightarrow> sum f (incoming x) = sum f (outgoing x)"
  by(cases "x \<in> V")(auto simp add: conservation_const outgoing_outside incoming_outside)

lemma augmenting_path_imp_shortest:
  "isAugmentingPath p \<Longrightarrow> \<exists>p. Graph.isShortestPath cf s p t"
  using Graph.obtain_shortest_path unfolding isAugmentingPath_def
  by (fastforce simp: Graph.isSimplePath_def Graph.connected_def)

lemma shortest_is_augmenting:
  "Graph.isShortestPath cf s p t \<Longrightarrow> isAugmentingPath p"
  unfolding isAugmentingPath_def using Graph.shortestPath_is_simple
  by (fastforce)

definition "augment_with_path p \<equiv> augment (augmentingFlow p)"

end

context Network begin

definition "shortest_augmenting_path f = (SOME p. Graph.isShortestPath (residualGraph c f) s p t)"

lemma shortest_augmenting_path:
  assumes "NFlow c s t f"
  and "\<exists>p. NPreflow.isAugmentingPath c s t f p"
  shows "Graph.isShortestPath (residualGraph c f) s (shortest_augmenting_path f) t"
  using assms unfolding shortest_augmenting_path_def
  by clarify(rule someI_ex, rule NFlow.augmenting_path_imp_shortest)

definition max_flow where
  "max_flow = while
     (\<lambda>f. \<exists>p. NPreflow.isAugmentingPath c s t f p)
     (\<lambda>f. NFlow.augment_with_path c f (shortest_augmenting_path f)) (\<lambda>_. 0)"

lemma max_flow:
  "NFlow c s t max_flow" (is ?thesis1)
  "\<not> (\<exists>p. NPreflow.isAugmentingPath c s t max_flow p)" (is ?thesis2)
proof -
  have "NFlow c s t (\<lambda>_. 0)"
    by unfold_locales(simp_all add: cap_non_negative)
  moreover have "NFlow c s t (NFlow.augment_with_path c f (shortest_augmenting_path f))"
    if "NFlow c s t f" and "\<exists>p. NPreflow.isAugmentingPath c s t f p" for f
  proof -
    interpret NFlow c s t f using that(1) .
    interpret F: Flow c s t "NFlow.augment c f (NPreflow.augmentingFlow c f (shortest_augmenting_path f))"
      by(intro augment_flow_presv augFlow_resFlow shortest_is_augmenting shortest_augmenting_path[OF that])
    show ?thesis using that
      by(simp add: NFlow.augment_with_path_def)(unfold_locales)
  qed
  ultimately have "NFlow c s t max_flow \<and> \<not> (\<exists>p. NPreflow.isAugmentingPath c s t max_flow p)"
    unfolding max_flow_def
    by(rule while_rule[where P="NFlow c s t" and r="measure (\<lambda>f. ek_analysis_defs.ekMeasure (residualGraph c f) s t)"])
      (auto intro: shortest_augmenting_path NFlow.shortest_path_decr_ek_measure simp add: NFlow.augment_with_path_def)
  thus ?thesis1 ?thesis2 by simp_all
qed

end

end


section \<open>The Exchange\<close>

theory Exchange imports Event begin

subsection "Section 1"
inductive_set exchange :: "event list set" where
  Nil:  "[] \<in> exchange" |
  Request: "\<lbrakk>evs \<in> exchange\<rbrakk>
            \<Longrightarrow> \<lparr>Sender = A, Receiver = B, Message = Agent A\<rparr> # evs \<in> exchange" |
  Response:  "\<lbrakk>evs \<in> exchange;  Nonce NB \<notin> used evs;
          \<lparr>Sender = A, Receiver = B, Message = Agent A\<rparr> \<in> set evs\<rbrakk>
          \<Longrightarrow> \<lparr>Sender = B, Receiver = A, Message = Crypt (pubK A) (Nonce NB)\<rparr> # evs  \<in>  exchange"

subsection "Section 2"
abbreviation "e1 \<equiv> \<lparr>Sender = Friend 2, Receiver = Friend 8, Message = Agent (Friend 2)\<rparr>"
abbreviation "e2 \<equiv> \<lparr>Sender = Friend 8, Receiver = Friend 2, Message = Crypt (pubK (Friend 2)) (Nonce 5)\<rparr>"

abbreviation "ex1 \<equiv> [e2, e1]"

lemma e1: "[e1] \<in> exchange"
proof
  from exchange.Nil show "[] \<in> exchange" by simp
qed

lemma eventList1 : "ex1 \<in> exchange"
proof
  from e1 show "[e1] \<in> exchange" by simp
next
  show "Nonce 5 \<notin> used [e1]" by simp
next
  show "e1 \<in> set [e1]" by simp
qed

subsection "Section 3"

abbreviation "ex2 \<equiv> [e2, e1, e2, e1]"

inductive_cases r2: "e2 # evs \<in> exchange"

theorem "ex2 \<notin> exchange"
proof (rule ccontr)
  assume "\<not> ex2 \<notin> exchange"
  hence "ex2 \<in> exchange" by simp
  thus False
  proof (rule r2)
    assume "Nonce 5 \<notin> used [e1, e2, e1]"
    thus ?thesis by simp
  qed
qed

subsection "Section 4"

theorem spyKnowEnc:
  defines "msg \<equiv> Crypt (pubK (Friend 2)) (Nonce 5)"
  shows "msg \<in> analz (knows ex1)" using msg_def by simp

subsection "Section 5"

theorem spyNotAnalz:
  defines "msg \<equiv> Nonce 5"
  shows "msg \<notin> analz (knows ex1)" using msg_def by auto

subsection "Section 6"

theorem prikey:
assumes "A \<noteq> Spy"
shows "evs \<in> exchange \<Longrightarrow> Key (priK A) \<notin> analz (knows evs)"
proof (induction rule: exchange.induct)
  show "Key (priK A) \<notin> analz (knows [])" using assms by simp
next
  fix evs1 A' B
  assume "Key (priK A) \<notin> analz (knows evs1)"
  thus "Key (priK A) \<notin> analz (knows (\<lparr>Sender = A', Receiver = B, Message = Agent A'\<rparr> # evs1))" by simp
next
  fix evs2 A' B N
  assume "Key (priK A) \<notin> analz (knows evs2)"
  thus "Key (priK A) \<notin> analz (knows (\<lparr>Sender = B, Receiver = A', Message = Crypt (pubK A') (Nonce N)\<rparr> # evs2))" by simp
qed

subsection "Section 7"

inductive_set exchange1 :: "event list set" where
  Nil:  "[] \<in> exchange1" |
  Request: "\<lbrakk>evs \<in> exchange1\<rbrakk>
            \<Longrightarrow> \<lparr>Sender = A, Receiver = B, Message = Agent A\<rparr> # evs \<in> exchange1" |
  Response:  "\<lbrakk>evs \<in> exchange1;  Nonce NB \<notin> used evs;
          \<lparr>Sender = A, Receiver = B, Message = Agent A\<rparr> \<in> set evs\<rbrakk>
          \<Longrightarrow> \<lparr>Sender = B, Receiver = A, Message = Crypt (pubK A) (Nonce NB)\<rparr> # evs  \<in>  exchange1" |
  Fake: "\<lbrakk>evsf \<in> exchange1;  X \<in> synth (analz (knows evsf))\<rbrakk>
          \<Longrightarrow> \<lparr>Sender = Spy, Receiver = B, Message = X\<rparr> # evsf \<in> exchange1"

subsection "Section 8"

abbreviation "e3 \<equiv> \<lparr>Sender = Friend 2, Receiver = Spy, Message = Agent (Friend 2)\<rparr>"
abbreviation "e4 \<equiv> \<lparr>Sender = Spy, Receiver = Friend 8, Message = Agent (Spy)\<rparr>"
abbreviation "e5 \<equiv> \<lparr>Sender = Friend 8, Receiver = Spy, Message = Crypt (pubK (Spy)) (Nonce 5)\<rparr>"

abbreviation "ex3 \<equiv> [e5, e4, e3]"

(*Prove event list belongs to new event set*)
lemma e3 : "[e3] \<in> exchange1"
proof
  from exchange1.Nil show "[] \<in> exchange1" by simp
qed

lemma e3e4 : "[e4, e3] \<in> exchange1"
proof
  from e3 show "[e3] \<in> exchange1" by simp
next
  show "Agent Spy \<in> synth (analz (knows [e3]))" by auto
qed

lemma eventList3 : "ex3 \<in> exchange1"
proof
  from e3e4 show "[e4, e3] \<in> exchange1" by simp
next
  show "Nonce 5 \<notin> used [e4, e3]" by simp
next
  show "e4 \<in> set [e4, e3]" by simp
qed

(*Prove spy can learn nonce from event set*)
theorem spyKnowDec:
  defines "msg \<equiv> Nonce 5"
  shows "msg \<in> analz (knows ex3)" using msg_def by simp

subsection "Section 9"

inductive_set exchange2 :: "event list set" where
  Nil:  "[] \<in> exchange2" |
  Request: "\<lbrakk>evs \<in> exchange2\<rbrakk>
            \<Longrightarrow> \<lparr>Sender = A, Receiver = B, Message = Crypt (pubK B) (Agent A)\<rparr> # evs \<in> exchange2" |
  Response:  "\<lbrakk>evs \<in> exchange2;  Nonce NB \<notin> used evs;
          \<lparr>Sender = A, Receiver = B, Message = Crypt (pubK B) (Agent A)\<rparr> \<in> set evs\<rbrakk>
          \<Longrightarrow> \<lparr>Sender = B, Receiver = A, Message = Crypt (pubK A) (Nonce NB)\<rparr> # evs  \<in>  exchange2" |
  Fake: "\<lbrakk>evsf \<in> exchange2;  X \<in> synth (analz (knows evsf))\<rbrakk>
          \<Longrightarrow> \<lparr>Sender = Spy, Receiver = B, Message = X\<rparr> # evsf \<in> exchange2"

abbreviation "e6 \<equiv> \<lparr>Sender = Friend 2, Receiver = Friend 8, Message = Crypt (pubK (Friend 8)) (Agent (Friend 2))\<rparr>"
abbreviation "e7 \<equiv> \<lparr>Sender = Friend 8, Receiver = Friend 2, Message = Crypt (pubK (Friend 2)) (Nonce 5)\<rparr>"

abbreviation "ex4 \<equiv> [e7, e6]"

lemma e6 : "[e6] \<in> exchange2"
proof
  from exchange2.Nil show "[] \<in> exchange2" by simp
qed

lemma eventList4 : "ex4 \<in> exchange2"
proof
  from e6 show "[e6] \<in> exchange2" by simp
next
  show "Nonce 5 \<notin> used [e6]" by simp
next
  show "e6 \<in> set [e6]" by simp
qed

theorem spyNotAnalz1:
  defines "msg \<equiv> Nonce 5"
  shows "msg \<notin> analz (knows ex4)" using msg_def by auto

end


theory SAS_Plus_Strips_Nat
  imports "Verified_SAT_Based_AI_Planning.SAS_Plus_STRIPS" Primitives
begin

definition possible_assignments_for_list
  :: "('variable, 'domain) sas_plus_list_problem \<Rightarrow> 'variable \<Rightarrow> ('variable \<times> 'domain) list"
  where "possible_assignments_for_list \<Psi> v \<equiv> [(v, a). a \<leftarrow> the (map_list_find (range_ofl \<Psi>) v)]"

lemma sublist_possible_assignments_for:
"possible_assignments_for_list P v =
 possible_assignments_for (list_problem_to_problem P) v"
  apply (auto simp add: sub_map_list_find possible_assignments_for_list_def possible_assignments_for_def )
  done

fun map_prodWith :: " nat \<Rightarrow> nat \<Rightarrow>  nat" where
"map_prodWith v n = (if n = 0 then 0 else (prod_encode(v,hd_nat n)) ## map_prodWith v (tl_nat n)) "

fun map_prodWith_acc :: " nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>  nat" where
"map_prodWith_acc v acc n = (if n = 0 then acc else map_prodWith_acc v ((prod_encode(v,hd_nat n)) ## acc) (tl_nat n)) "

lemma map_prodWith_induct:
"map_prodWith_acc v acc n = map_acc (\<lambda>a. prod_encode (v,a)) acc n"
  apply(induct v acc n rule:map_prodWith_acc.induct)
  apply auto
  done

lemma submap_prodWith :
"map_prodWith v n = map_nat (\<lambda>a. prod_encode (v,a)) n"
  apply (induct v n rule:map_prodWith.induct)
  apply auto
  done

definition map_prodWith_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_prodWith_tail v n = reverse_nat (map_prodWith_acc v 0 n)"

lemma subtail_map_prodWith:
"map_prodWith_tail v n = map_prodWith v n"
  using map_prodWith_induct map_prodWith_tail_def submap_prodWith subtail_map by presburger

definition possible_assignments_for_nat
  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
  where "possible_assignments_for_nat P v \<equiv> map_prodWith v (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))"

definition possible_assignments_for_tail
  :: "nat \<Rightarrow> nat \<Rightarrow> nat"
  where "possible_assignments_for_tail P v \<equiv> map_prodWith_tail v (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) v))"

lemma subtail_possible_assignments_for:
"possible_assignments_for_tail P v = possible_assignments_for_nat P v"
  using possible_assignments_for_nat_def possible_assignments_for_tail_def subtail_map_prodWith by presburger

lemma vdlist_plus_simp:"vdlist_plus_encode = prod_encode o (\<lambda>(v,d). (var_encode v, list_encode (map dom_encode d)))"
  apply auto
  done

lemma subnat_possible_assignments_for_pre:
  assumes "v \<in> set (variables_ofl P)"
  assumes " v \<in> set (variables_ofl P ) \<Longrightarrow> map_list_find  (range_ofl P)  v \<noteq> None"
  shows
"possible_assignments_for_nat (list_problem_plus_encode P) (var_encode v)
= sas_plus_assignment_list_encode (possible_assignments_for_list P v)"
  using inj_var assms
  apply auto
  apply (auto simp only: possible_assignments_for_nat_def
submap_prodWith
              list_problem_plus_encode_def sub_nth nth.simps
sub_map_list_find_nat  inj_map_list_find[of var_encode]
            option_encode.simps the_nat.simps diff_Suc_1
 map_list_find_map  sub_map
possible_assignments_for_list_def
sas_plus_assignment_list_encode_def
vdlist_plus_simp simp flip:map_map
)
  apply (auto simp add:comp_def)
  done

lemma inv_possible_assignments_for:
  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
  assumes "v \<in> set (variables_ofl P)"
  shows "map_list_find  (range_ofl P)  v \<noteq> None"
proof -
  have "v \<in> set (sas_plus_problem.variables_of (list_problem_to_problem P))"
    using assms by auto
  hence "range_of (list_problem_to_problem P) v \<noteq> None" using assms apply (auto simp add:
    is_valid_problem_sas_plus_def )
    by (smt Ball_set_list_all)
  thus ?thesis by (auto simp add: sub_map_list_find)
qed

lemma subnat_possible_assignments_for:
  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
  assumes "v \<in> set (variables_ofl P)"
  shows "possible_assignments_for_nat (list_problem_plus_encode P) (var_encode v)
= sas_plus_assignment_list_encode (possible_assignments_for_list P v)"
  using  subnat_possible_assignments_for_pre inv_possible_assignments_for assms by fastforce

definition all_possible_assignments_for_list
  :: "('variable, 'domain) sas_plus_list_problem \<Rightarrow> ('variable \<times> 'domain) list"
  where "all_possible_assignments_for_list \<Psi>
    \<equiv> concat [possible_assignments_for_list \<Psi> v. v \<leftarrow> variables_ofl \<Psi>]"

lemma sublist_all_possible_assignments_for:
" all_possible_assignments_for_list P =
all_possible_assignments_for (list_problem_to_problem P)"
  apply (auto simp add: all_possible_assignments_for_list_def all_possible_assignments_for_def
  sublist_possible_assignments_for)
  done

fun map_possible_assignments_for :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_possible_assignments_for P n = (if n = 0 then 0 else (possible_assignments_for_nat P  (hd_nat n)) ## map_possible_assignments_for P (tl_nat n))"

fun map_possible_assignments_for_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_possible_assignments_for_acc  P acc n = (if n = 0 then acc else map_possible_assignments_for_acc P ((possible_assignments_for_tail P  (hd_nat n)) ## acc ) (tl_nat n))"

lemma map_possible_assignments_for_induct :
"map_possible_assignments_for_acc  P acc n  = map_acc (possible_assignments_for_nat P) acc n"
  apply(induct P acc n rule:map_possible_assignments_for_acc.induct)
  apply (auto simp add: subtail_possible_assignments_for)
  done

definition  map_possible_assignments_for_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_possible_assignments_for_tail P n = reverse_nat (map_possible_assignments_for_acc  P 0 n  ) "

lemma submap_possible_assignments_for:
"map_possible_assignments_for P n = map_nat (possible_assignments_for_nat P) n"
  apply(induct P n rule: map_possible_assignments_for.induct)
  apply auto
  done
lemma subtail_map_possible_assignments_for:
"map_possible_assignments_for_tail  P  n  = map_possible_assignments_for  P  n  "
  using map_possible_assignments_for_induct map_possible_assignments_for_tail_def
 submap_possible_assignments_for subtail_map by presburger

definition all_possible_assignments_for_nat::
   "nat \<Rightarrow> nat"
  where "all_possible_assignments_for_nat \<Psi>
    \<equiv> concat_nat (map_possible_assignments_for \<Psi> (nth_nat 0 \<Psi>))"

definition all_possible_assignments_for_tail::
   "nat \<Rightarrow> nat"
  where "all_possible_assignments_for_tail \<Psi>
    \<equiv> concat_tail (map_possible_assignments_for_tail \<Psi> (nth_nat 0 \<Psi>))"

lemma subtail_all_possible_assignments_for:
"all_possible_assignments_for_tail P = all_possible_assignments_for_nat P"
  using all_possible_assignments_for_nat_def all_possible_assignments_for_tail_def subtail_concat
 subtail_map_possible_assignments_for by presburger

lemma subnat_all_possible_assignments_for_map:
  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
  shows " map (\<lambda>x. possible_assignments_for_nat (list_problem_plus_encode P) (var_encode x))
         (variables_ofl P) =
 map sas_plus_assignment_list_encode (map (\<lambda>x. possible_assignments_for_list P x)  (variables_ofl P))"
  apply (induct "variables_ofl P")
   apply simp
  using assms apply (auto simp del: list_problem_to_problem.simps)
  apply (auto simp add:subnat_possible_assignments_for simp del: list_problem_to_problem.simps)
  done

lemma subnat_all_possible_assignments_for:
  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
  shows "all_possible_assignments_for_nat (list_problem_plus_encode P)
= sas_plus_assignment_list_encode (all_possible_assignments_for_list P)"
  using assms
  apply (auto simp only:all_possible_assignments_for_nat_def
 submap_possible_assignments_for
list_problem_plus_encode_def
            sub_nth nth.simps sas_plus_assignment_list_encode_def[of "all_possible_assignments_for_list P"] )
  apply (auto simp only: sub_map map_map comp_def all_possible_assignments_for_list_def
    subnat_all_possible_assignments_for_map
 simp flip:list_problem_plus_encode_def)
  apply (auto simp only: sas_plus_assignment_list_encode_def sub_concat map_concat simp flip: map_map comp_def[of _ "\<lambda>x. map sas_plus_assignment_encode (possible_assignments_for_list P x)"] )
  apply (auto simp only:map_map comp_def)
  done

definition state_to_strips_state_list
  :: "('variable, 'domain) sas_plus_list_problem
    \<Rightarrow> ('variable, 'domain) assignment list
    \<Rightarrow> (('variable, 'domain) assignment ,bool) assignment list"
  where "state_to_strips_state_list \<Psi> s
    \<equiv> let defined = filter (\<lambda>v. map_list_find s v \<noteq> None) (variables_ofl \<Psi>) in
      map (\<lambda>(v, a). ((v, a), the (map_list_find s v) = a))
        (concat [possible_assignments_for_list \<Psi> v. v \<leftarrow> defined])"

lemma sublist_state_to_strips_state:
"map_of (state_to_strips_state_list P s) =
state_to_strips_state (list_problem_to_problem P) (map_of s)"
  apply (auto simp add:state_to_strips_state_list_def sub_map_list_find
state_to_strips_state_def sublist_possible_assignments_for)
  done

declare map_list_find_nat.simps [simp del]
fun  map_find_eq:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_find_eq s n =
(if n = 0 then 0 else (prod_encode(hd_nat n, if the_nat (map_list_find_nat s (fst_nat (hd_nat n))) = snd_nat (hd_nat n) then 1 else 0)) ## map_find_eq s (tl_nat n))"

fun  map_find_eq_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_find_eq_acc s acc n =
(if n = 0 then acc else map_find_eq_acc s ((prod_encode(hd_nat n, if the_nat (map_list_find_nat s (fst_nat (hd_nat n))) = snd_nat (hd_nat n) then 1 else 0)) ## acc ) (tl_nat n))"

lemma map_find_eq_induct:
"map_find_eq_acc s acc n = map_acc  (\<lambda>va. prod_encode(va, if the_nat (map_list_find_nat s (fst_nat va)) = snd_nat va then 1 else 0)) acc n"
  apply(induct s acc n rule:map_find_eq_acc.induct)
  apply auto
  done

definition map_find_eq_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_find_eq_tail s n = reverse_nat (map_find_eq_acc s 0 n)"

lemma submap_find_eq:
"map_find_eq s n =  map_nat (\<lambda>va. prod_encode(va, if the_nat (map_list_find_nat s (fst_nat va)) = snd_nat va then 1 else 0)) n "
  apply (induct s n rule: map_find_eq.induct)
  apply (auto simp del:map_list_find_nat.simps)
  done

lemma subtail_map_find_eq :
"map_find_eq_tail s n = map_find_eq s n"
  using map_find_eq_induct map_find_eq_tail_def submap_find_eq subtail_map by presburger

fun filter_defined :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"filter_defined s n = (if n = 0 then 0 else if map_list_find_nat s (hd_nat n) \<noteq> 0 then (hd_nat n)##filter_defined s (tl_nat n) else filter_defined s (tl_nat n))"

fun filter_defined_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"filter_defined_acc s acc n = (if n = 0 then acc else if map_list_find_nat s (hd_nat n) \<noteq> 0 then filter_defined_acc s ((hd_nat n)##acc) (tl_nat n) else filter_defined_acc s acc (tl_nat n))"

lemma subfilter_defined :
"filter_defined s n = filter_nat (\<lambda>v. map_list_find_nat s v \<noteq> 0) n "
  apply (induct s n rule: filter_defined.induct)
  apply auto
  done

lemma filter_defined_induct:
"filter_defined_acc s acc n = filter_acc (\<lambda>v. map_list_find_nat s v \<noteq> 0) acc n"
  apply( induct s acc n rule:filter_defined_acc.induct)
  apply auto
  done

definition filter_defined_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"filter_defined_tail s n  = reverse_nat (filter_defined_acc s 0 n)"

lemma subtail_filter_defined :
"filter_defined_tail s n  = filter_defined s n  "
  using  filter_defined_tail_def filter_defined_induct subfilter_defined
subtail_filter  by presburger

definition state_to_strips_state_nat
  :: "nat \<Rightarrow>nat \<Rightarrow>nat"
  where "state_to_strips_state_nat \<Psi> s
    \<equiv> let defined = filter_defined s (nth_nat 0 \<Psi>) in
      map_find_eq s (concat_nat (map_possible_assignments_for \<Psi> defined))"

definition state_to_strips_state_tail
  :: "nat \<Rightarrow>nat \<Rightarrow>nat"
  where "state_to_strips_state_tail \<Psi> s
    \<equiv> let defined = filter_defined_tail s (nth_nat 0 \<Psi>) in
      map_find_eq_tail s (concat_tail (map_possible_assignments_for_tail \<Psi> defined))"

lemma subtail_state_to_strips_state:
"state_to_strips_state_tail \<Psi> s = state_to_strips_state_nat \<Psi> s"
  using state_to_strips_state_nat_def state_to_strips_state_tail_def subtail_concat
 subtail_filter_defined subtail_map_find_eq subtail_map_possible_assignments_for by presburger

lemma subnat_state_to_strips_state_map:
  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
shows
"map (\<lambda>x. possible_assignments_for_nat (list_problem_plus_encode P) (var_encode x))
           (filter (\<lambda>x. map_list_find s x \<noteq> None) (variables_ofl P))
= map  sas_plus_assignment_list_encode  ( map (possible_assignments_for_list P)
 (filter (\<lambda>x. map_list_find s x \<noteq> None) (variables_ofl P)) )"
  using assms apply (auto simp add: subnat_possible_assignments_for)
  done

lemma  possible_assignments_fst: "(x, b) \<in> set (possible_assignments_for_list P y) \<Longrightarrow> x = y"
  apply (auto simp add:possible_assignments_for_list_def)
  done

lemma subnat_state_to_strips_state:
  assumes "is_valid_problem_sas_plus (list_problem_to_problem P)"
  shows "state_to_strips_state_nat (list_problem_plus_encode P) (sas_plus_assignment_list_encode s)
= strips_assignment_list_encode (state_to_strips_state_list P s)"
  apply (auto simp only:state_to_strips_state_nat_def subfilter_defined
submap_possible_assignments_for
submap_find_eq list_problem_plus_encode_def sub_nth nth.simps)
  apply (auto simp only: simp flip: list_problem_plus_encode_def)
  apply (auto simp only:       sub_filter  sas_plus_assignment_list_encode_def sas_plus_simp sub_map_list_find_nat option_encode_0
                    filter_map
            simp flip: map_map )
  using inj_var  apply (auto simp only:comp_def  inj_map_list_find  map_list_find_map_none
subnat_possible_assignments_for Let_def sub_map map_map
)
  using assms apply(auto simp only:sub_map
state_to_strips_state_list_def
 sub_concat subnat_state_to_strips_state_map  sas_plus_list_simp simp flip:map_map map_concat)
  apply (auto simp only:map_map comp_def fst_sas_simp snd_sas_simp  inj_map_list_find
 strips_assignment_list_encode_def list_encode_eq Let_def
 )
  apply (induct "variables_ofl P")
   apply (auto simp del:list_problem_to_problem.simps)
  subgoal for a x y aa b ya
    apply (cases "map_list_find (map (\<lambda>(v, d). (v, dom_encode d)) s) aa")
    using possible_assignments_fst[of aa b P y]
     apply (auto simp add: map_list_find_map_none map_list_find_map dom_inj_simp
          simp del:list_problem_to_problem.simps)
    done
 subgoal for a x y aa b ya
    apply (cases "map_list_find (map (\<lambda>(v, d). (v, dom_encode d)) s) aa")
    using possible_assignments_fst[of aa b P y]
     apply (auto simp add: map_list_find_map_none map_list_find_map dom_inj_simp
          simp del:list_problem_to_problem.simps)
    done
  done

definition sasp_op_to_strips_list
  :: "('variable, 'domain) sas_plus_list_problem
    \<Rightarrow> ('variable, 'domain) sas_plus_operator
    \<Rightarrow> ('variable, 'domain) assignment strips_operator"
  ("\<phi>\<^sub>O _ _" 99)
  where "sasp_op_to_strips_list \<Psi> op \<equiv> let
      pre = precondition_of op
      ; add = effect_of op
      ; delete = concat (map (\<lambda>(v,a). map (\<lambda>a'. (v, a')) (filter ((\<noteq>) a) (the (map_list_find (range_ofl \<Psi> )v)))) (effect_of op))
    in STRIPS_Representation.operator_for pre add delete"

lemma sublist_sasp_op_to_strips:
"sasp_op_to_strips_list P op = sasp_op_to_strips (list_problem_to_problem P) op"
  apply (auto simp add:sasp_op_to_strips_list_def  sasp_op_to_strips_def sub_map_list_find)
  done

fun operator_for_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"operator_for_nat pre add delete = pre ## add ## delete ##0 "

definition operator_for_tail  :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"operator_for_tail pre add delete = operator_for_nat pre add delete "

lemma subtail_operator_for:
"operator_for_tail pre add delete = operator_for_nat pre add delete "
  using operator_for_tail_def by fastforce

lemma sub_operator_for : "operator_for_nat (sas_plus_assignment_list_encode pre) (sas_plus_assignment_list_encode add) (sas_plus_assignment_list_encode delete)
= strips_operator_encode (operator_for pre add delete)"
  apply (auto simp add: sub_cons cons0 simp del: list_encode.simps)
  done

fun filter_diff_snd :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"filter_diff_snd n xs = (if xs = 0 then 0 else if (hd_nat xs) \<noteq> snd_nat n then (hd_nat xs) ## filter_diff_snd n (tl_nat xs) else filter_diff_snd n (tl_nat xs))"

fun filter_diff_snd_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"filter_diff_snd_acc n acc xs = (if xs = 0 then acc else if (hd_nat xs) \<noteq> snd_nat n then filter_diff_snd_acc n  ((hd_nat xs) ## acc) (tl_nat xs) else filter_diff_snd_acc n acc (tl_nat xs))"

lemma filter_diff_snd_induct :
"filter_diff_snd_acc n acc xs = filter_acc ((\<noteq>) (snd_nat n)) acc xs"
  apply(induct n acc xs rule:filter_diff_snd_acc.induct)
  apply auto
  done

definition filter_diff_snd_tail :: "nat \<Rightarrow> nat \<Rightarrow>nat" where
"filter_diff_snd_tail n xs = reverse_nat (filter_diff_snd_acc n 0 xs)"

lemma subfilter_diff_snd :
"filter_diff_snd n xs = filter_nat ((\<noteq>) (snd_nat n)) xs"
  apply (induct n xs rule:filter_diff_snd.induct)
  apply (auto)
  done

lemma subtail_filter_diff_snd :
"filter_diff_snd_tail n xs = filter_diff_snd n xs "
  using filter_diff_snd_induct filter_diff_snd_tail_def subfilter_diff_snd
 subtail_filter by presburger

fun map_prod_fst :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_prod_fst n xs = (if xs = 0 then 0 else (prod_encode(fst_nat n,hd_nat xs)) ## map_prod_fst n (tl_nat xs))"

fun map_prod_fst_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_prod_fst_acc n acc xs = (if xs = 0 then acc else map_prod_fst_acc n ((prod_encode(fst_nat n,hd_nat xs)) ## acc) (tl_nat xs))"

lemma submap_prod_fst:
"map_prod_fst n xs =  map_nat (\<lambda>a'. prod_encode(fst_nat n, a')) xs"
  apply (induct n xs rule: map_prod_fst.induct)
  apply (auto)
  done

lemma map_prod_fst_induct:
"map_prod_fst_acc n acc xs = map_acc (\<lambda>a'. prod_encode(fst_nat n, a')) acc xs"
  apply(induct n acc xs rule: map_prod_fst_acc.induct)
  apply auto
  done

definition map_prod_fst_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_prod_fst_tail n xs = reverse_nat (map_prod_fst_acc n 0 xs)"

lemma subtail_map_prod_fst:
"map_prod_fst_tail n xs = map_prod_fst n xs"
  using map_prod_fst_induct map_prod_fst_tail_def submap_prod_fst subtail_map by presburger

fun map_sasp_op_to_strips:: "nat \<Rightarrow> nat \<Rightarrow> nat" where
" map_sasp_op_to_strips P xs = (if xs=0 then 0 else (
 map_prod_fst (hd_nat xs) (filter_diff_snd (hd_nat xs) (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (fst_nat (hd_nat xs))
)))) ##  map_sasp_op_to_strips P (tl_nat xs)) "

fun map_sasp_op_to_strips_acc:: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
" map_sasp_op_to_strips_acc P acc xs = (if xs=0 then acc else  map_sasp_op_to_strips_acc P ( (
 map_prod_fst (hd_nat xs) (filter_diff_snd (hd_nat xs) (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P) (fst_nat (hd_nat xs))
)))) ## acc) (tl_nat xs)) "

lemma map_sasp_op_to_strips_induct :
"map_sasp_op_to_strips_acc P acc xs = map_acc  (\<lambda>n. map_prod_fst n (filter_diff_snd n (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P ) (fst_nat n))))) acc xs"
  apply(induct P acc xs rule:map_sasp_op_to_strips_acc.induct)
  apply auto
  done

lemma submap_sasp_op_to_strips:
"map_sasp_op_to_strips P xs = map_nat (\<lambda>n. map_prod_fst n (filter_diff_snd n (the_nat (map_list_find_nat (nth_nat (Suc (Suc (Suc (Suc 0)))) P ) (fst_nat n))))) xs "
  apply (induct P xs rule: map_sasp_op_to_strips.induct)
  apply auto
  done

definition  map_sasp_op_to_strips_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"map_sasp_op_to_strips_tail P xs = reverse_nat (map_sasp_op_to_strips_acc  P 0 xs)"

lemma subtail_map_sasp_op_to_strips:
"map_sasp_op_to_strips_tail P xs = map_sasp_op_to_strips P xs"
  using map_sasp_op_to_strips_induct map_sasp_op_to_strips_tail_def submap_sasp_op_to_strips subtail_map by presburger

definition sasp_op_to_strips_nat
  :: "nat \<Rightarrow>nat \<Rightarrow> nat "
  where "sasp_op_to_strips_nat \<Psi> op \<equiv> let
      pre = nth_nat 0 op
      ; add = nth_nat (Suc 0)  op
      ; delete = concat_nat (map_sasp_op_to_strips \<Psi>  (nth_nat (Suc 0) op))
    in operator_for_nat pre add delete"

definition sasp_op_to_strips_tail
  :: "nat \<Rightarrow>nat \<Rightarrow> nat "
  where "sasp_op_to_strips_tail \<Psi> op \<equiv> let
      pre = nth_nat 0 op
      ; add = nth_nat (Suc 0)  op
      ; delete = concat_tail (map_sasp_op_to_strips_tail \<Psi>  (nth_nat (Suc 0) op))
    in operator_for_tail pre add delete"

lemma subtail_sasp_op_to_strips:
"sasp_op_to_strips_tail P op = sasp_op_to_strips_nat P op"
  using operator_for_tail_def sasp_op_to_strips_nat_def sasp_op_to_strips_tail_def subtail_concat
 subtail_map_sasp_op_to_strips by presburger

lemma subnat_sasp_op_to_strips_map:
  assumes "\<forall>(v,d)\<in> set (effect_of op). map_list_find (range_ofl P) v \<noteq> None"
  shows
"map (\<lambda>x. map_nat (\<lambda>a'. prod_encode (var_encode (fst x), a'))
                            (filter_nat ((\<noteq>) (dom_encode (snd x)))
                              (the_nat
                                (option_encode
                                  (map_list_find
                                    (map (\<lambda>(v, d).
                                             (var_encode v, list_encode (map dom_encode d)))
                                      (range_ofl P))
                                    (var_encode (fst x)))))))
                  (effect_of op) =
map (\<lambda>(v,d). map_nat (\<lambda>a'. prod_encode (var_encode v, a'))
                            (filter_nat ((\<noteq>) (dom_encode d))
                             (list_encode (map dom_encode (the (map_list_find (range_ofl P)  v))))))
                  (effect_of op)

"
  apply (induct "effect_of op")
  using inj_var
   apply  (auto simp del:map_nat.simps filter_nat.simps the_nat.simps )
  apply (auto simp only: inj_map_list_find[of var_encode])
  subgoal for a b x ax bx
    apply (cases "map_list_find (range_ofl P) ax")
    using assms apply
(auto simp add:  map_list_find_map_none   simp del:map_nat.simps filter_nat.simps the_nat.simps
)
    subgoal for y
    apply (auto simp add:  map_list_find_map)
      done
    done
  done

lemma subnat_sasp_op_to_strips_map2:
 "(\<lambda>(v, d).
                         list_encode
                          (map (\<lambda>a'. prod_encode (var_encode v, a'))
                            (filter ((\<noteq>) (dom_encode d))
                              (map dom_encode (the (map_list_find (range_ofl P) v))))))
= list_encode o (\<lambda>(v,d). map (\<lambda>a'. prod_encode (var_encode v, a'))
                            (filter ((\<noteq>) (dom_encode d))
                              (map dom_encode (the (map_list_find (range_ofl P) v)))))"
  apply (auto)
  done
lemma subnat_sasp_op_to_strips_map3:
"(\<lambda>(v, d).
                         map sas_plus_assignment_encode
                          (map (Pair v) (filter ((\<noteq>) d) (the (map_list_find (range_ofl P) v)))))
= map sas_plus_assignment_encode o (\<lambda>(v,d). map (Pair v) (filter ((\<noteq>) d) (the (map_list_find (range_ofl P) v))) )"
  apply auto
  done
lemma subnat_sasp_op_to_strips_inv:
  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"  "op \<in> set (operators_ofl P)"
  shows  "\<forall>(v,d)\<in> set (effect_of op). map_list_find (range_ofl P) v \<noteq> None"
  using assms
  apply (auto simp add: is_valid_problem_sas_plus_def is_valid_operator_sas_plus_def)
  by (smt case_prodD is_valid_operator_sas_plus_then(3) list_all_iff sas_plus_problem.select_convs(1) sub_map_list_find)

lemma subnat_sasp_op_to_strips_pre:
  assumes "\<forall>(v,d)\<in> set (effect_of op). map_list_find (range_ofl P) v \<noteq> None"
  shows   "sasp_op_to_strips_nat (list_problem_plus_encode P) (operator_plus_encode op)
=
strips_operator_encode (sasp_op_to_strips_list P op)"
  apply (auto simp only:sasp_op_to_strips_nat_def operator_plus_encode_def sub_nth nth.simps
subfilter_diff_snd  submap_sasp_op_to_strips  submap_prod_fst
list_problem_plus_encode_def sub_map_list_find_nat vdlist_plus_simp
sas_plus_assignment_list_encode_def sub_map

 simp flip: map_map )
  using inj_var apply (auto simp only: map_map comp_def fst_sas_simp snd_sas_simp

)
  using assms apply (auto simp only:subnat_sasp_op_to_strips_map sub_filter sub_map
subnat_sasp_op_to_strips_map2  sub_concat simp flip: map_map
)
  apply (auto simp only:filter_map comp_def dom_inj_simp map_map simp flip:
sas_plus_assignment_encode.simps)
  apply (auto simp only: simp flip: comp_def map_map)
  apply (auto simp only: comp_def)
  apply (auto simp only: subnat_sasp_op_to_strips_map3
sasp_op_to_strips_list_def
  Let_def sub_operator_for simp flip: map_map map_concat
sas_plus_assignment_list_encode_def
)
  done

lemma subnat_sasp_op_to_strips:
  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"  "op \<in> set (operators_ofl P)"
  shows   "sasp_op_to_strips_nat (list_problem_plus_encode P) (operator_plus_encode op)
=
strips_operator_encode (sasp_op_to_strips_list P op)"
  using assms  subnat_sasp_op_to_strips_pre  subnat_sasp_op_to_strips_inv by blast

definition problem_for_list
  :: "'variable list
  \<Rightarrow> 'variable strips_operator list
  \<Rightarrow> ('variable,bool) assignment list
  \<Rightarrow> ('variable,bool) assignment list
  \<Rightarrow> ('variable) strips_list_problem"
  where "problem_for_list vs ops I gs \<equiv> \<lparr>
    variables_of = vs
    , operators_of = ops
    , initial_of = I
    , goal_of = gs \<rparr>"

lemma sublist_problem_for :
"strips_list_problem_to_problem (problem_for_list vs ops I gs) =
problem_for vs ops (map_of I) (map_of gs)"
  apply (auto simp add:problem_for_list_def)
  done

definition sas_plus_problem_to_strips_problem_list
  :: "('variable, 'domain) sas_plus_list_problem \<Rightarrow> ('variable, 'domain) assignment strips_list_problem"
  ("\<phi> _ " 99)
  where "sas_plus_problem_to_strips_problem_list \<Psi> \<equiv> let
      vs =  concat (map (possible_assignments_for_list \<Psi>)(variables_ofl \<Psi>))
      ; ops = map (sasp_op_to_strips_list \<Psi>) (operators_ofl \<Psi>)
      ; I = state_to_strips_state_list \<Psi> (initial_ofl \<Psi>)
      ; G = state_to_strips_state_list \<Psi> (goal_ofl \<Psi>)
    in problem_for_list vs ops I G"

lemma sublist_sas_plus_problem_to_strips_problem:
"strips_list_problem_to_problem (sas_plus_problem_to_strips_problem_list P) =
sas_plus_problem_to_strips_problem (list_problem_to_problem P)"
  apply (auto simp only: Let_def
sublist_possible_assignments_for
sas_plus_problem_to_strips_problem_def
list_problem_to_problem.simps
sas_plus_list_problem.simps
sas_plus_problem.simps

  sas_plus_problem_to_strips_problem_list_def
sublist_problem_for sublist_sasp_op_to_strips sublist_state_to_strips_state )
  apply (auto simp add:sublist_sasp_op_to_strips sublist_possible_assignments_for simp flip: list_problem_to_problem.simps)
  apply (meson sublist_possible_assignments_for)
  done
definition problem_for_nat
  :: "nat
  \<Rightarrow> nat
  \<Rightarrow> nat
  \<Rightarrow> nat
  \<Rightarrow> nat"
  where "problem_for_nat vs ops I gs \<equiv> vs ## ops ## I ## gs ## 0 "

definition problem_for_tail:: "nat
  \<Rightarrow> nat
  \<Rightarrow> nat
  \<Rightarrow> nat
  \<Rightarrow> nat" where
"problem_for_tail vs ops I gs  = problem_for_nat vs ops I gs "

lemma subtail_problem_for:
"problem_for_tail vs ops I gs  = problem_for_nat vs ops I gs "
  using problem_for_tail_def by presburger

lemma subnat_problem_for:
"problem_for_nat (sas_plus_assignment_list_encode vs) (strips_operator_list_encode ops)
(strips_assignment_list_encode I) (strips_assignment_list_encode gs)
=
 strips_list_problem_encode(problem_for_list vs ops I gs)
 "
  apply (auto simp only: problem_for_nat_def sub_cons cons0 problem_for_list_def
strips_list_problem_encode.simps strips_list_problem.simps) done

fun maps_sasp_op_to_strips :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"maps_sasp_op_to_strips P xs = (if xs =0 then 0 else (sasp_op_to_strips_nat P (hd_nat xs))
## maps_sasp_op_to_strips P (tl_nat xs))"

fun maps_sasp_op_to_strips_acc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat" where
"maps_sasp_op_to_strips_acc P acc xs = (if xs =0 then acc else maps_sasp_op_to_strips_acc P ( (sasp_op_to_strips_tail P (hd_nat xs))
## acc) (tl_nat xs))"

lemma maps_sasp_op_to_strips_induct:
"maps_sasp_op_to_strips_acc P acc xs = map_acc (sasp_op_to_strips_nat P) acc xs"
  apply(induct P acc xs rule:maps_sasp_op_to_strips_acc.induct)
  apply (auto simp add:subtail_sasp_op_to_strips)
  done

definition maps_sasp_op_to_strips_tail :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"maps_sasp_op_to_strips_tail P xs = reverse_nat (maps_sasp_op_to_strips_acc P 0 xs)"

lemma sub_maps_sasp_op_to_strips:
"maps_sasp_op_to_strips P xs = map_nat (sasp_op_to_strips_nat P) xs"
  apply (induct P xs rule:maps_sasp_op_to_strips.induct)
  apply (auto)
  done

lemma subtail_maps_sasp_op_to_strips:
"maps_sasp_op_to_strips_tail P xs = maps_sasp_op_to_strips P xs"
  using maps_sasp_op_to_strips_induct maps_sasp_op_to_strips_tail_def
sub_maps_sasp_op_to_strips subtail_map by presburger

definition sas_plus_problem_to_strips_problem_nat
  :: "nat\<Rightarrow>nat"
  where "sas_plus_problem_to_strips_problem_nat \<Psi> \<equiv> let
      vs =  concat_nat (map_possible_assignments_for \<Psi>(nth_nat 0 \<Psi>))
      ; ops = maps_sasp_op_to_strips \<Psi> (nth_nat (Suc 0) \<Psi>)
      ; I = state_to_strips_state_nat \<Psi> (nth_nat (Suc (Suc 0)) \<Psi>)
      ; G = state_to_strips_state_nat \<Psi> (nth_nat (Suc (Suc (Suc 0))) \<Psi>)
    in problem_for_nat vs ops I G"

definition sas_plus_problem_to_strips_problem_tail
  :: "nat\<Rightarrow>nat"
  ("\<phi> _ " 99)
  where "sas_plus_problem_to_strips_problem_tail \<Psi> \<equiv> let
      vs =  concat_tail (map_possible_assignments_for_tail \<Psi>(nth_nat 0 \<Psi>))
      ; ops = maps_sasp_op_to_strips_tail \<Psi> (nth_nat (Suc 0) \<Psi>)
      ; I = state_to_strips_state_tail \<Psi> (nth_nat (Suc (Suc 0)) \<Psi>)
      ; G = state_to_strips_state_tail \<Psi> (nth_nat (Suc (Suc (Suc 0))) \<Psi>)
    in problem_for_tail vs ops I G"

lemma subtail_sas_plus_problem_to_strips_problem:
"sas_plus_problem_to_strips_problem_tail P =  sas_plus_problem_to_strips_problem_nat P "
  using problem_for_tail_def sas_plus_problem_to_strips_problem_nat_def
sas_plus_problem_to_strips_problem_tail_def subtail_concat subtail_map_possible_assignments_for
 subtail_maps_sasp_op_to_strips subtail_state_to_strips_state by presburger

lemma  subnat_sas_plus_problem_to_strips_problem_map:
  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"
  shows  "map (\<lambda>x. possible_assignments_for_nat (list_problem_plus_encode P)
                             (var_encode x))
                   (variables_ofl P)
  = map sas_plus_assignment_list_encode (map (possible_assignments_for_list P) (variables_ofl P))"
  using subnat_all_possible_assignments_for_map assms by blast

lemma  subnat_sas_plus_problem_to_strips_problem_map2:
  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"
  shows  "map (\<lambda>x. sasp_op_to_strips_nat (list_problem_plus_encode P)
                        (operator_plus_encode x))
              (operators_ofl P)
  = map strips_operator_encode (map (sasp_op_to_strips_list P) (operators_ofl P))"
  using assms subnat_sasp_op_to_strips
  by auto

lemma subnat_sas_plus_problem_to_strips_problem:
  assumes  "is_valid_problem_sas_plus (list_problem_to_problem P)"
  shows "sas_plus_problem_to_strips_problem_nat (list_problem_plus_encode P)
 =  strips_list_problem_encode (sas_plus_problem_to_strips_problem_list P)"
  apply (auto simp only: sas_plus_problem_to_strips_problem_nat_def
list_problem_plus_encode_def sub_nth nth.simps submap_possible_assignments_for
 sub_maps_sasp_op_to_strips
)
  using assms  apply (auto simp only: sub_map
              subnat_possible_assignments_for map_map comp_def
              subnat_sasp_op_to_strips
subnat_state_to_strips_state
 simp flip: list_problem_plus_encode_def)
  apply (auto simp only:subnat_sas_plus_problem_to_strips_problem_map sas_plus_list_simp
sub_concat
simp flip: map_map map_concat )
  apply (auto simp only:
 simp flip: sas_plus_assignment_list_encode_def)
  apply (auto simp only:  subnat_sas_plus_problem_to_strips_problem_map2 simp flip: strips_operator_list_encode_def)
  apply (auto simp only: Let_def  subnat_problem_for sas_plus_problem_to_strips_problem_list_def )
  done

end


theory mydemo
imports
  "AutoCorres"
begin

(* Parse the input file. *)
install_C_file  "mydemo.c"

find_theorems name: "body_def"

context mydemo begin

  thm f_body_def
  thm g_body_def

end

(* Abstract the input file. *)
autocorres [ts_force nondet = g] "mydemo.c"

(*   [ts_rules = nondet|pure|option] *)

context mydemo begin

  thm f'_def
  thm g'_def

  lemma "f' 3 = 0" by(simp add: f'_def)
  term ovalidNF

  thm whileLoop_add_inv[where M="\<lambda>(a, s). a"]
  term abs
  lemma returns0: "INT_MIN < a \<Longrightarrow> a < INT_MAX \<Longrightarrow>
        \<lbrace> \<lambda>s. True \<rbrace>
           g' a
        \<lbrace> \<lambda>r s. r=0 \<rbrace>!"
     unfolding g'_def
     apply(subst whileLoop_add_inv[where I="\<lambda>a s. INT_MIN < a \<and> a < INT_MAX" and M="\<lambda>(a,s). nat (abs a)"])
     apply(wp)
      by (auto simp add: INT_MIN_def INT_MAX_def)

end

end