Theory WS1S_Prelim
section ‹WS1S Interpretations›
theory WS1S_Prelim
imports
FSet_More
Deriving.Compare_Instances
"List-Index.List_Index"
begin
hide_const (open) cut
definition "eval P x = (x |∈| P)"
definition "downshift P = (λx. x - Suc 0) |`| (P |-| {|0|})"
definition "upshift P = Suc |`| P"
definition "lift bs i P = (if bs ! i then finsert 0 (upshift P) else upshift P)"
definition "snoc n bs i P = (if bs ! i then finsert n P else P)"
definition "cut n P = ffilter (λi. i < n) P"
definition "len P = (if P = {||} then 0 else Suc (fMax P))"
datatype order = FO | SO
derive linorder order
instantiation order :: enum begin
definition "enum_order = [FO, SO]"
definition "enum_all_order P = (P FO ∧ P SO)"
definition "enum_ex_order P = (P FO ∨ P SO)"
lemmas enum_defs = enum_order_def enum_all_order_def enum_ex_order_def
instance proof qed (auto simp: enum_defs, (metis (full_types) order.exhaust)+)
end
typedef idx = "UNIV :: (nat × nat) set" by (rule UNIV_witness)
setup_lifting type_definition_idx
lift_definition SUC :: "order ⇒ idx ⇒ idx" is
"λord (m, n). case ord of FO ⇒ (Suc m, n) | SO ⇒ (m, Suc n)" .
lift_definition LESS :: "order ⇒ nat ⇒ idx ⇒ bool" is
"λord l (m, n). case ord of FO ⇒ l < m | SO ⇒ l < n" .
abbreviation "LEQ ord l idx ≡ LESS ord l (SUC ord idx)"
definition "MSB Is ≡
if ∀P ∈ set Is. P = {||} then 0 else Suc (Max (⋃P ∈ set Is. fset P))"
lemma MSB_Nil[simp]: "MSB [] = 0"
unfolding MSB_def by simp
lemma MSB_Cons[simp]: "MSB (I # Is) = max (if I = {||} then 0 else Suc (fMax I)) (MSB Is)"
unfolding MSB_def including fset.lifting
by transfer (auto simp: Max_Un list_all_iff Sup_bot_conv(2)[symmetric] simp del: Sup_bot_conv(2))
lemma MSB_append[simp]: "MSB (I1 @ I2) = max (MSB I1) (MSB I2)"
by (induct I1) auto
lemma MSB_insert_nth[simp]:
"MSB (insert_nth n P Is) = max (if P = {||} then 0 else Suc (fMax P)) (MSB Is)"
by (subst (2) append_take_drop_id[of n Is, symmetric])
(simp only: insert_nth_take_drop MSB_append MSB_Cons MSB_Nil)
lemma MSB_greater:
"⟦i < length Is; p |∈| Is ! i⟧ ⟹ p < MSB Is"
unfolding MSB_def by (fastforce simp: Bex_def in_set_conv_nth less_Suc_eq_le intro: Max_ge)
lemma MSB_mono: "set I1 ⊆ set I2 ⟹ MSB I1 ≤ MSB I2"
unfolding MSB_def including fset.lifting
by transfer (auto simp: list_all_iff intro!: Max_ge)
lemma MSB_map_index'_CONS[simp]:
"MSB (map_index' i (lift bs) Is) =
(if MSB Is = 0 ∧ (∀i ∈ {i ..< i + length Is}. ¬ bs ! i) then 0 else Suc (MSB Is))"
by (induct Is arbitrary: i)
(auto split: if_splits simp: mono_fMax_commute[where f = Suc, symmetric] mono_def
lift_def upshift_def,
metis atLeastLessThan_iff le_antisym not_less_eq_eq)
lemma MSB_map_index'_SNOC[simp]:
"MSB Is ≤ n ⟹ MSB (map_index' i (snoc n bs) Is) =
(if (∀i ∈ {i ..< i + length Is}. ¬ bs ! i) then MSB Is else Suc n)"
by (induct Is arbitrary: i)
(auto split: if_splits simp: mono_fMax_commute[where f = Suc, symmetric] mono_def
snoc_def, (metis atLeastLessThan_iff le_antisym not_less_eq_eq)+)
lemma MSB_replicate[simp]: "MSB (replicate n P) = (if P = {||} ∨ n = 0 then 0 else Suc (fMax P))"
by (induct n) auto
typedef interp =
"{(n :: nat, I1 :: nat fset list, I2 :: nat fset list) | n I1 I2. MSB (I1 @ I2) ≤ n}"
by auto
setup_lifting type_definition_interp
lift_definition assigns :: "nat ⇒ interp ⇒ order ⇒ nat fset" (‹_⇗_⇖_› [900, 999, 999] 999)
is "λn (_, I1, I2) ord. case ord of FO ⇒ if n < length I1 then I1 ! n else {||}
| SO ⇒ if n < length I2 then I2 ! n else {||}" .
lift_definition nvars :: "interp ⇒ idx" (‹#⇩V _› [1000] 900)
is "λ(_, I1, I2). (length I1, length I2)" .
lift_definition Length :: "interp ⇒ nat"
is "λ(n, _, _). n" .
lift_definition Extend :: "order ⇒ nat ⇒ interp ⇒ nat fset ⇒ interp"
is "λord i (n, I1, I2) P. case ord of
FO ⇒ (max n (if P = {||} then 0 else Suc (fMax P)), insert_nth i P I1, I2)
| SO ⇒ (max n (if P = {||} then 0 else Suc (fMax P)), I1, insert_nth i P I2)"
using MSB_mono by (auto simp del: insert_nth_take_drop split: order.splits)
lift_definition CONS :: "(bool list × bool list) ⇒ interp ⇒ interp"
is "λ(bs1, bs2) (n, I1, I2).
(Suc n, map_index (lift bs1) I1, map_index (lift bs2) I2)"
by auto
lift_definition SNOC :: "(bool list × bool list) ⇒ interp ⇒ interp"
is "λ(bs1, bs2) (n, I1, I2).
(Suc n, map_index (snoc n bs1) I1, map_index (snoc n bs2) I2)"
by (auto simp: Let_def)
type_synonym atom = "bool list × bool list"
lift_definition zero :: "idx ⇒ atom"
is "λ(m, n). (replicate m False, replicate n False)" .
definition "extend ord b ≡
λ(bs1, bs2). case ord of FO ⇒ (b # bs1, bs2) | SO ⇒ (bs1, b # bs2)"
lift_definition size_atom :: "bool list × bool list ⇒ idx"
is "λ(bs1, bs2). (length bs1, length bs2)" .
lift_definition σ :: "idx ⇒ atom list"
is "(λ(n, N). map (λbs. (take n bs, drop n bs)) (List.n_lists (n + N) [True, False]))" .
lemma fMin_fimage_Suc[simp]: "x |∈| A ⟹ fMin (Suc |`| A) = Suc (fMin A)"
by (rule fMin_eqI) (auto intro: fMin_in)
lemma fMin_eq_0[simp]: "0 |∈| A ⟹ fMin A = (0 :: nat)"
by (rule fMin_eqI) auto
lemma insert_nth_Cons[simp]:
"insert_nth i x (y # xs) = (case i of 0 ⇒ x # y # xs | Suc i ⇒ y # insert_nth i x xs)"
by (cases i) simp_all
lemma insert_nth_commute[simp]:
assumes "j ≤ i" "i ≤ length xs"
shows "insert_nth j y (insert_nth i x xs) = insert_nth (Suc i) x (insert_nth j y xs)"
using assms by (induct xs arbitrary: i j) (auto simp del: insert_nth_take_drop split: nat.splits)
lemma SUC_SUC[simp]: "SUC ord (SUC ord' idx) = SUC ord' (SUC ord idx)"
by transfer (auto split: order.splits)
lemma LESS_SUC[simp]:
"LESS ord 0 (SUC ord idx)"
"LESS ord (Suc l) (SUC ord idx) = LESS ord l idx"
"ord ≠ ord' ⟹ LESS ord l (SUC ord' idx) = LESS ord l idx"
"LESS ord l idx ⟹ LESS ord l (SUC ord' idx)"
by (transfer, force split: order.splits)+
lemma nvars_Extend[simp]:
"#⇩V (Extend ord i 𝔄 P) = SUC ord (#⇩V 𝔄)"
by (transfer, force split: order.splits)
lemma Length_Extend[simp]:
"Length (Extend k i 𝔄 P) = max (Length 𝔄) (if P = {||} then 0 else Suc (fMax P))"
unfolding max_def by (split if_splits, transfer) (force split: order.splits)
lemma assigns_Extend[simp]:
"LEQ ord i (#⇩V 𝔄) ⟹m⇗Extend ord i 𝔄 P⇖ord = (if m = i then P else (if m > i then m - Suc 0 else m)⇗𝔄⇖ord)"
"ord ≠ ord' ⟹ m⇗Extend ord i 𝔄 P⇖ord' = m⇗𝔄⇖ord'"
by (transfer, force simp: min_def nth_append split: order.splits)+
lemma Extend_commute_safe[simp]:
"⟦j ≤ i; LEQ ord i (#⇩V 𝔄)⟧ ⟹
Extend ord j (Extend ord i 𝔄 P1) P2 = Extend ord (Suc i) (Extend ord j 𝔄 P2) P1"
by (transfer,
force simp del: insert_nth_take_drop simp: replicate_add[symmetric] split: order.splits)
lemma Extend_commute_unsafe:
"ord ≠ ord' ⟹ Extend ord j (Extend ord' i 𝔄 P1) P2 = Extend ord' i (Extend ord j 𝔄 P2) P1"
by (transfer, force simp: replicate_add[symmetric] split: order.splits)
lemma Length_CONS[simp]:
"Length (CONS x 𝔄) = Suc (Length 𝔄)"
by (transfer, force split: order.splits)
lemma Length_SNOC[simp]:
"Length (SNOC x 𝔄) = Suc (Length 𝔄)"
by (transfer, force simp: Let_def split: order.splits)
lemma nvars_CONS[simp]:
"#⇩V (CONS x 𝔄) = #⇩V 𝔄"
by (transfer, force)
lemma nvars_SNOC[simp]:
"#⇩V (SNOC x 𝔄) = #⇩V 𝔄"
by (transfer, force simp: Let_def)
lemma assigns_CONS[simp]:
assumes "#⇩V 𝔄 = size_atom bs1_bs2"
shows "LESS ord x (#⇩V 𝔄) ⟹ x⇗CONS bs1_bs2 𝔄⇖ord =
(if case_prod case_order bs1_bs2 ord ! x then finsert 0 (upshift (x⇗𝔄⇖ord)) else upshift (x⇗𝔄⇖ord))"
by (insert assms, transfer) (auto simp: lift_def split: order.splits)
lemma assigns_SNOC[simp]:
assumes "#⇩V 𝔄 = size_atom bs1_bs2"
shows "LESS ord x (#⇩V 𝔄) ⟹ x⇗SNOC bs1_bs2 𝔄⇖ord =
(if case_prod case_order bs1_bs2 ord ! x then finsert (Length 𝔄) (x⇗𝔄⇖ord) else x⇗𝔄⇖ord)"
by (insert assms, transfer) (force simp: snoc_def Let_def split: order.splits)
lemma map_index'_eq_conv[simp]:
"map_index' i f xs = map_index' j g xs = (∀k < length xs. f (i + k) (xs ! k) = g (j + k) (xs ! k))"
proof (induct xs arbitrary: i j)
case Cons from Cons(1)[of "Suc i" "Suc j"] show ?case by (auto simp: nth_Cons split: nat.splits)
qed simp
lemma fMax_Diff_0[simp]: "Suc m |∈| P ⟹ fMax (P |-| {|0|}) = fMax P"
by (rule fMax_eqI) (auto intro: fMax_in dest: fMax_ge)
lemma Suc_fMax_pred_fimage[simp]:
assumes "Suc p |∈| P" "0 |∉| P"
shows "Suc (fMax ((λx. x - Suc 0) |`| P)) = fMax P"
using assms by (subst mono_fMax_commute[of Suc, unfolded mono_def, simplified]) (auto simp: o_def)
lemma Extend_CONS[simp]: "#⇩V 𝔄 = size_atom x ⟹ Extend ord 0 (CONS x 𝔄) P =
CONS (extend ord (eval P 0) x) (Extend ord 0 𝔄 (downshift P))"
by transfer (auto simp: extend_def o_def gr0_conv_Suc
mono_fMax_commute[of Suc, symmetric, unfolded mono_def, simplified]
lift_def upshift_def downshift_def eval_def
dest!: fsubset_fsingletonD split: order.splits)
lemma size_atom_extend[simp]:
"size_atom (extend ord b x) = SUC ord (size_atom x)"
unfolding extend_def by transfer (simp split: prod.splits order.splits)
lemma size_atom_zero[simp]:
"size_atom (zero idx) = idx"
unfolding extend_def by transfer (simp split: prod.splits order.splits)
lemma interp_eqI:
"⟦Length 𝔄 = Length 𝔅; #⇩V 𝔄 = #⇩V 𝔅; ⋀m k. LESS k m (#⇩V 𝔄) ⟹ m⇗𝔄⇖k = m⇗𝔅⇖k⟧ ⟹ 𝔄 = 𝔅"
by transfer (force split: order.splits intro!: nth_equalityI)
lemma Extend_SNOC_cut[unfolded eval_def cut_def Length_SNOC, simp]:
"⟦len P ≤ Length (SNOC x 𝔄); #⇩V 𝔄 = size_atom x⟧ ⟹
Extend ord 0 (SNOC x 𝔄) P =
SNOC (extend ord (if eval P (Length 𝔄) then True else False) x) (Extend ord 0 𝔄 (cut (Length 𝔄) P))"
by transfer (fastforce simp: extend_def len_def cut_def ffilter_eq_fempty_iff snoc_def eval_def
split: if_splits order.splits dest: fMax_ge fMax_boundedD intro: fMax_in)
lemma nth_replicate_simp: "replicate m x ! i = (if i < m then x else [] ! (i - m))"
by (induct m arbitrary: i) (auto simp: nth_Cons')
lemma MSB_eq_SucD: "MSB Is = Suc x ⟹ ∃P∈set Is. x |∈| P"
using Max_in[of "⋃x∈set Is. fset x"]
unfolding MSB_def by (force split: if_splits)
lemma append_replicate_inj:
assumes "xs ≠ [] ⟹ last xs ≠ x" and "ys ≠ [] ⟹ last ys ≠ x"
shows "xs @ replicate m x = ys @ replicate n x ⟷ (xs = ys ∧ m = n)"
proof safe
from assms have assms': "xs ≠ [] ⟹ rev xs ! 0 ≠ x" "ys ≠ [] ⟹ rev ys ! 0 ≠ x"
by (auto simp: hd_rev hd_conv_nth[symmetric])
assume *: "xs @ replicate m x = ys @ replicate n x"
then have "rev (xs @ replicate m x) = rev (ys @ replicate n x)" ..
then have "replicate m x @ rev xs = replicate n x @ rev ys" by simp
then have "take (max m n) (replicate m x @ rev xs) = take (max m n) (replicate n x @ rev ys)" by simp
then have "replicate m x @ take (max m n - m) (rev xs) =
replicate n x @ take (max m n - n) (rev ys)" by (auto simp: min_def max_def split: if_splits)
then have "(replicate m x @ take (max m n - m) (rev xs)) ! min m n =
(replicate n x @ take (max m n - n) (rev ys)) ! min m n" by simp
with arg_cong[OF *, of length, simplified] assms' show "m = n"
by (cases "xs = []" "ys = []" rule: bool.exhaust[case_product bool.exhaust])
(auto simp: min_def nth_append split: if_splits)
with * show "xs = ys" by auto
qed
lemma fin_lift[simp]: "m |∈| lift bs i (I ! i) ⟷ (case m of 0 ⇒ bs ! i | Suc m ⇒ m |∈| I ! i)"
unfolding lift_def upshift_def by (auto split: nat.splits)
lemma ex_Length_0[simp]:
"∃𝔄. Length 𝔄 = 0 ∧ #⇩V 𝔄 = idx"
by transfer (auto intro!: exI[of _ "replicate m {||}" for m])
lemma is_empty_inj[simp]: "⟦Length 𝔄 = 0; Length 𝔅 = 0; #⇩V 𝔄 = #⇩V 𝔅⟧ ⟹ 𝔄 = 𝔅"
by transfer (simp add: list_eq_iff_nth_eq split: prod.splits,
metis MSB_greater fMax_in less_nat_zero_code)
lemma set_σ_length_atom[simp]: "(x ∈ set (σ idx)) ⟷ idx = size_atom x"
by transfer (auto simp: set_n_lists enum_UNIV image_iff intro!: exI[of _ "I1 @ I2" for I1 I2])
lemma distinct_σ[simp]: "distinct (σ idx)"
by transfer (auto 0 4 simp: distinct_map distinct_n_lists set_n_lists inj_on_def
intro: iffD2[OF append_eq_append_conv]
box_equals[OF _ append_take_drop_id append_take_drop_id, of n _ n for n])
lemma fMin_less_Length[simp]: "x |∈| m1⇗𝔄⇖k ⟹ fMin (m1⇗𝔄⇖k) < Length 𝔄"
by transfer
(force elim: order.strict_trans2[OF MSB_greater, rotated -1] intro: fMin_in split: order.splits)
lemma fMax_less_Length[simp]: "x |∈| m1⇗𝔄⇖k ⟹ fMax (m1⇗𝔄⇖k) < Length 𝔄"
by transfer
(force elim: order.strict_trans2[OF MSB_greater, rotated -1] intro: fMax_in split: order.splits)
lemma min_Length_fMin[simp]: "x |∈| m1⇗𝔄⇖k ⟹ min (Length 𝔄) (fMin (m1⇗𝔄⇖k)) = fMin (m1⇗𝔄⇖k)"
using fMin_less_Length[of x m1 𝔄 k] unfolding fMin_def by auto
lemma max_Length_fMin[simp]: "x |∈| m1⇗𝔄⇖k ⟹ max (Length 𝔄) (fMin (m1⇗𝔄⇖k)) = Length 𝔄"
using fMin_less_Length[of x m1 𝔄 k] unfolding fMin_def by auto
lemma min_Length_fMax[simp]: "x |∈| m1⇗𝔄⇖k ⟹ min (Length 𝔄) (fMax (m1⇗𝔄⇖k)) = fMax (m1⇗𝔄⇖k)"
using fMax_less_Length[of x m1 𝔄 k] unfolding fMax_def by auto
lemma max_Length_fMax[simp]: "x |∈| m1⇗𝔄⇖k ⟹ max (Length 𝔄) (fMax (m1⇗𝔄⇖k)) = Length 𝔄"
using fMax_less_Length[of x m1 𝔄 k] unfolding fMax_def by auto
lemma assigns_less_Length[simp]: "x |∈| m1⇗𝔄⇖k ⟹ x < Length 𝔄"
by transfer (force dest: MSB_greater split: order.splits if_splits)
lemma Length_notin_assigns[simp]: "Length 𝔄 |∉| m⇗𝔄⇖k"
by (metis assigns_less_Length less_not_refl)
lemma nth_zero[simp]: "LESS ord m (#⇩V 𝔄) ⟹ ¬ case_prod case_order (zero (#⇩V 𝔄)) ord ! m"
by transfer (auto split: order.splits)
lemma in_fimage_Suc[simp]: "x |∈| Suc |`| A ⟷ (∃y. y |∈| A ∧ x = Suc y)"
by blast
lemma fimage_Suc_inj[simp]: "Suc |`| A = Suc |`| B ⟷ A = B"
by blast
lemma MSB_eq0_D: "MSB I = 0 ⟹ x < length I ⟹ I ! x = {||}"
unfolding MSB_def by (auto split: if_splits)
lemma Suc_in_fimage_Suc: "Suc x |∈| Suc |`| X ⟷ x |∈| X"
by auto
lemma Suc_in_fimage_Suc_o_Suc[simp]: "Suc x |∈| (Suc ∘ Suc) |`| X ⟷ x |∈| Suc |`| X"
by auto
lemma finsert_same_eq_iff[simp]: "finsert k X = finsert k Y ⟷ X |-| {|k|} = Y |-| {|k|}"
by auto
lemma fimage_Suc_o_Suc_eq_fimage_Suc_iff[simp]:
"((Suc ∘ Suc) |`| X = Suc |`| Y) ⟷ (Suc |`| X = Y)"
by (metis fimage_Suc_inj fset.map_comp)
lemma fMax_image_Suc[simp]: "x |∈| P ⟹ fMax (Suc |`| P) = Suc (fMax P)"
by (rule fMax_eqI) (metis Suc_le_mono fMax_ge fimageE, metis fimageI fempty_iff fMax_in)
lemma fimage_Suc_eq_singleton[simp]: "(fimage Suc Z = {|y|}) ⟷ (∃x. Z = {|x|} ∧ Suc x = y)"
by (cases y) auto
lemma len_downshift_helper:
"x |∈| P ⟹ Suc (fMax ((λx. x - Suc 0) |`| (P |-| {|0|}))) ≠ fMax P ⟹ xa |∈| P ⟹ xa = 0"
proof -
assume a1: "xa |∈| P"
assume a2: "Suc (fMax ((λx. x - Suc 0) |`| (P |-| {|0|}))) ≠ fMax P"
have "xa |∈| {|0|} ⟶ xa = 0" by fastforce
moreover
{ assume "xa |∉| {|0|}"
hence "0 |∉| P |-| {|0|} ∧ xa |∉| {|0|}" by blast
then obtain esk1⇩1 :: "nat ⇒ nat" where "xa = 0" using a1 a2 by (metis Suc_fMax_pred_fimage fMax_Diff_0 fminus_iff not0_implies_Suc) }
ultimately show "xa = 0" by blast
qed
lemma CONS_inj[simp]: "size_atom x = #⇩V 𝔄 ⟹ size_atom y = #⇩V 𝔄 ⟹ #⇩V 𝔄 = #⇩V 𝔅 ⟹
CONS x 𝔄 = CONS y 𝔅 ⟷ (x = y ∧ 𝔄 = 𝔅)"
by transfer (auto simp: list_eq_iff_nth_eq lift_def upshift_def split: if_splits; blast)
lemma Suc_minus1: "Suc (x - Suc 0) = (if x = 0 then Suc 0 else x)"
by auto
lemma fset_eq_empty_iff: "(fset X = {}) = (X = {||})"
by (metis bot_fset.rep_eq fset_inverse)
lemma fset_le_singleton_iff: "(fset X ⊆ {x}) = (X = {||} ∨ X = {|x|})"
by (metis finsert.rep_eq fset_eq_empty_iff fset_inject order_refl singleton_insert_inj_eq subset_singletonD)
lemma MSB_decreases:
"MSB I ≤ Suc m ⟹ MSB (map (λX. (λI1. I1 - Suc 0) |`| (X |-| {|0|})) I) ≤ m"
unfolding MSB_def
by (auto simp add: not_le less_Suc_eq_le fset_eq_empty_iff fset_le_singleton_iff
split: if_splits dest!: iffD1[OF Max_le_iff, rotated -1] iffD1[OF Max_ge_iff, rotated -1]; force)
lemma CONS_surj[dest]:
assumes "Length 𝔄 > 0"
shows "∃x 𝔅. 𝔄 = CONS x 𝔅 ∧ #⇩V 𝔅 = #⇩V 𝔄 ∧ size_atom x = #⇩V 𝔄"
proof -
have "MSB I1 ≤ Suc m ⟹ MSB I2 ≤ Suc m ⟹ ∃a b ab ba.
(∃I1. length ab = length I1 ∧ (∀i<length ab. ab ! i = I1 ! i) ∧
(∃I2. length ba = length I2 ∧ (∀i<length ba. ba ! i = I2 ! i) ∧
MSB I1 ≤ m ∧ MSB I2 ≤ m)) ∧
I1 = map_index (lift a) ab ∧
I2 = map_index (lift b) ba ∧
length ab = length I1 ∧
length ba = length I2 ∧
length a = length I1 ∧
length b = length I2"
for m I1 I2
by (auto simp: list_eq_iff_nth_eq lift_def upshift_def split: if_splits
intro!: exI[of _ "map (λX. 0 |∈| X) _"] exI[of _ "map (λX. (λx. x - Suc 0) |`| (X |-| {|0|})) _"],
auto simp: MSB_decreases upshift_def Suc_minus1 fimage_iff intro: rev_fBexI split: if_splits)
with assms show ?thesis
by transfer (auto simp: gr0_conv_Suc list_eq_iff_nth_eq)
qed
end