header {* Motivating Examples *}
theory Stream_Examples
imports Stream_Lib
begin
section {* Sum *}
definition pls :: "stream => stream => stream" where
"pls xs ys = dtor_corec_J (λ(xs, ys). (head xs + head ys, Inr (tail xs, tail ys))) (xs, ys)"
lemma head_pls[simp]: "head (pls xs ys) = head xs + head ys"
unfolding pls_def J.dtor_corec map_pre_J_def BNF_Comp.id_bnf_comp_def by simp
lemma tail_pls[simp]: "tail (pls xs ys) = pls (tail xs) (tail ys)"
unfolding pls_def J.dtor_corec map_pre_J_def BNF_Comp.id_bnf_comp_def by simp
lemma pls_code[code]: "pls xs ys = SCons (head xs + head ys) (pls (tail xs) (tail ys))"
by (metis J.ctor_dtor prod.collapse head_pls tail_pls)
lemma pls_uniform: "pls xs ys = algρ1 (xs, ys)"
unfolding pls_def
apply (rule fun_cong[OF sym[OF J.dtor_corec_unique]])
unfolding algρ1
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def fun_eq_iff convol_def ρ1_def algρ1_def)
section {* Onetwo *}
definition onetwo :: stream where
"onetwo = corecUU0 (λ_. GUARD0 (1, SCONS0 (2, CONT0 ()))) ()"
lemma onetwo_code[code]: "onetwo = SCons 1 (SCons 2 onetwo)"
apply (subst onetwo_def)
unfolding corecUU0
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor eval0_leaf0'
o_eq_dest[OF eval0_gg0] o_eq_dest[OF gg0_natural] onetwo_def)
definition onetwo' :: stream where
"onetwo' = corecUU0 (λ_. SCONS0 (1, GUARD0 (2, CONT0 ()))) ()"
lemma onetwo'_code[code]: "onetwo' = SCons 1 (SCons 2 onetwo')"
apply (subst onetwo'_def)
unfolding corecUU0
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor eval0_leaf0'
o_eq_dest[OF eval0_gg0] o_eq_dest[OF gg0_natural] onetwo'_def)
definition stutter :: stream where
"stutter = corecUU1 (λ_. SCONS1 (1, GUARD1 (1, PLS1 (CONT1 (), CONT1 ())))) ()"
lemma stutter_code[code]: "stutter = SCons 1 (SCons 1 (pls stutter stutter))"
apply (subst stutter_def)
unfolding corecUU1 prod.case
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor eval1_leaf1'
eval1_\<oo>\<pp>1 algΛ1_Inr o_eq_dest[OF Abs_Σ1_natural]
o_eq_dest[OF eval1_gg1] o_eq_dest[OF gg1_natural] pls_uniform stutter_def)
section {* Shuffle product *}
definition prd :: "stream => stream => stream" where
"prd xs ys = corecUU1 (λ(xs, ys). GUARD1 (head xs * head ys,
PLS1 (CONT1 (xs, tail ys), CONT1 (tail xs, ys)))) (xs, ys)"
lemma head_prd[simp]: "head (prd xs ys) = head xs * head ys"
unfolding prd_def corecUU1
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor eval1_leaf1')
lemma tail_prd[simp]: "tail (prd xs ys) = pls (prd xs (tail ys)) (prd (tail xs) ys)"
apply (subst prd_def)
unfolding corecUU1 prod.case
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor eval1_leaf1'
eval1_\<oo>\<pp>1 algΛ1_Inr o_eq_dest[OF Abs_Σ1_natural] pls_uniform prd_def)
lemma prd_code[code]: "prd xs ys = SCons (head xs * head ys) (pls (prd xs (tail ys)) (prd (tail xs) ys))"
by (metis J.ctor_dtor prod.collapse head_prd tail_prd)
lemma prd_uniform: "prd xs ys = algρ2 (xs, ys)"
unfolding prd_def
apply (rule fun_cong[OF sym[OF corecUU1_unique]])
apply (rule iffD1[OF dtor_J_o_inj])
unfolding algρ2
apply (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def fun_eq_iff J.dtor_ctor
ρ2_def Let_def convol_def eval2_\<oo>\<pp>2 eval1_\<oo>\<pp>1 eval1_leaf1'
o_eq_dest[OF Abs_Σ1_natural] o_eq_dest[OF Abs_Σ2_natural] algΛ2_Inl algρ2_def)
done
abbreviation "scale n s ≡ prd (sconst n) s"
section {* Exponentiation *}
definition Exp :: "stream => stream" where
"Exp = corecUU2 (λxs. GUARD2 (exp (head xs), PRD2 (END2 (tail xs), CONT2 xs)))"
lemma head_Exp[simp]: "head (Exp xs) = exp (head xs)"
unfolding Exp_def corecUU2
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor eval2_leaf2')
lemma tail_Exp[simp]: "tail (Exp xs) = prd (tail xs) (Exp xs)"
apply (subst Exp_def)
unfolding corecUU2
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor eval2_leaf2'
eval2_\<oo>\<pp>2 algΛ2_Inr o_eq_dest[OF Abs_Σ2_natural] prd_uniform Exp_def)
lemma Exp_code[code]: "Exp xs = SCons (exp (head xs)) (prd (tail xs) (Exp xs))"
by (metis J.ctor_dtor prod.collapse head_Exp tail_Exp)
lemma Exp_uniform: "Exp xs = algρ3 (I xs)"
unfolding Exp_def
apply (rule fun_cong[OF sym[OF corecUU2_unique]])
apply (rule iffD1[OF dtor_J_o_inj])
unfolding algρ3 o_def[symmetric] o_assoc
apply (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def fun_eq_iff J.dtor_ctor
ρ3_def Let_def convol_def eval3_\<oo>\<pp>3 eval2_\<oo>\<pp>2 eval2_leaf2' eval3_leaf3'
o_eq_dest[OF Abs_Σ2_natural] o_eq_dest[OF Abs_Σ3_natural] algΛ3_Inl algρ3_def)
done
section {* Supremum *}
definition sup :: "stream fset => stream" where
"sup = dtor_corec_J (λF. (fMax (head |`| F), Inr (tail |`| F)))"
lemma head_sup[simp]: "head (sup F) = fMax (head |`| F)"
unfolding sup_def J.dtor_corec map_pre_J_def BNF_Comp.id_bnf_comp_def by simp
lemma tail_sup[simp]: "tail (sup F) = sup (tail |`| F)"
unfolding sup_def J.dtor_corec map_pre_J_def BNF_Comp.id_bnf_comp_def by simp
lemma sup_code[code]: "sup F = SCons (fMax (head |`| F)) (sup (tail |`| F))"
by (metis J.ctor_dtor prod.collapse head_sup tail_sup)
lemma sup_uniform: "sup F = algρ4 F"
unfolding sup_def
apply (rule fun_cong[OF sym[OF J.dtor_corec_unique]])
unfolding algρ4
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def fun_eq_iff convol_def ρ4_def algρ4_def o_def)
section {* Skewed product *}
definition prd' :: "stream => stream => stream" where
"prd' xs ys = corecUU5 (λ(xs, ys). GUARD5 (head xs * head ys,
PRD5 (CONT5 (xs, tail ys), PLS5 (END5 (tail xs), END5 ys)))) (xs, ys)"
lemma prd'_uniform: "prd' xs ys = algρ5 (xs, ys)"
unfolding prd'_def
apply (rule fun_cong[OF sym[OF corecUU5_unique]])
apply (rule iffD1[OF dtor_J_o_inj])
unfolding algρ5
apply (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def fun_eq_iff J.dtor_ctor
ρ5_def Let_def convol_def eval5_\<oo>\<pp>5 eval4_\<oo>\<pp>4 eval3_\<oo>\<pp>3 eval2_\<oo>\<pp>2 eval1_\<oo>\<pp>1 eval5_leaf5'
o_eq_dest[OF Abs_Σ1_natural] o_eq_dest[OF Abs_Σ2_natural] o_eq_dest[OF Abs_Σ3_natural]
o_eq_dest[OF Abs_Σ4_natural] o_eq_dest[OF Abs_Σ5_natural] algΛ5_Inl algρ5_def)
done
lemma head_prd'[simp]: "head (prd' xs ys) = head xs * head ys"
unfolding prd'_def corecUU5
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor eval5_leaf5')
lemma tail_prd'[simp]: "tail (prd' xs ys) = prd' (prd' xs (tail ys)) (pls (tail xs) ys)"
apply (subst prd'_def, subst (2) prd'_uniform)
unfolding corecUU5 prod.case
by (simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor
eval5_\<oo>\<pp>5 eval4_\<oo>\<pp>4 eval3_\<oo>\<pp>3 eval2_\<oo>\<pp>2 eval1_\<oo>\<pp>1 eval5_leaf5'
algΛ5_Inr algΛ5_Inl algΛ4_Inl algΛ3_Inl algΛ2_Inl algΛ1_Inr
o_eq_dest[OF Abs_Σ5_natural] o_eq_dest[OF Abs_Σ4_natural]
o_eq_dest[OF Abs_Σ3_natural] o_eq_dest[OF Abs_Σ2_natural] o_eq_dest[OF Abs_Σ1_natural]
pls_uniform prd'_def)
lemma prd'_code[code]:
"prd' xs ys = SCons (head xs * head ys) (prd' (prd' xs (tail ys)) (pls (tail xs) ys))"
by (metis J.ctor_dtor prod.collapse head_prd' tail_prd')
section {* Coinduction Up-To Congruence *}
lemma SCons_uniform: "SCons x s = eval0 (gg0 (x, leaf0 s))"
by (rule iffD1[OF J.dtor_inject])
(simp add: map_pre_J_def BNF_Comp.id_bnf_comp_def J.dtor_ctor o_eq_dest[OF eval0_gg0] eval0_leaf0')
lemma genCngdd0_SCons: "[|x1 = x2; genCngdd0 R xs1 xs2|] ==>
genCngdd0 R (SCons x1 xs1) (SCons x2 xs2)"
unfolding SCons_uniform
apply (rule genCngdd0_eval0)
apply (rule rel_funD[OF gg0_transfer])
unfolding rel_pre_J_def BNF_Comp.id_bnf_comp_def vimage2p_def
apply (rule rel_funD[OF rel_funD[OF Pair_transfer], rotated])
apply (erule rel_funD[OF leaf0_transfer])
apply assumption
done
lemma genCngdd0_genCngdd1: "genCngdd0 R xs ys ==> genCngdd1 R xs ys"
unfolding genCngdd0_def cngdd0_def cptdd0_def genCngdd1_def cngdd1_def cptdd1_def eval1_embL1[symmetric]
apply (intro allI impI)
apply (erule conjE)+
apply (drule spec)
apply (erule mp conjI)+
apply (erule rel_funD[OF rel_funD[OF comp_transfer]])
apply (rule embL1_transfer)
done
lemma genCngdd1_SCons: "[|x1 = x2; genCngdd1 R xs1 xs2|] ==>
genCngdd1 R (SCons x1 xs1) (SCons x2 xs2)"
apply (subst I1.idem_Cl[symmetric])
apply (rule genCngdd0_genCngdd1)
apply (rule genCngdd0_SCons)
apply auto
done
lemma genCngdd1_pls: "[|genCngdd1 R xs1 xs2; genCngdd1 R ys1 ys2|] ==>
genCngdd1 R (pls xs1 ys1) (pls xs2 ys2)"
unfolding pls_uniform algρ1_def o_apply
apply (rule genCngdd1_eval1)
apply (rule rel_funD[OF K1_as_ΣΣ1_transfer])
apply simp
done
lemma genCngdd1_genCngdd2: "genCngdd1 R xs ys ==> genCngdd2 R xs ys"
unfolding genCngdd1_def cngdd1_def cptdd1_def genCngdd2_def cngdd2_def cptdd2_def eval2_embL2[symmetric]
apply (intro allI impI)
apply (erule conjE)+
apply (drule spec)
apply (erule mp conjI)+
apply (erule rel_funD[OF rel_funD[OF comp_transfer]])
apply (rule embL2_transfer)
done
lemma genCngdd2_SCons: "[|x1 = x2; genCngdd2 R xs1 xs2|] ==>
genCngdd2 R (SCons x1 xs1) (SCons x2 xs2)"
apply (subst I2.idem_Cl[symmetric])
apply (rule genCngdd1_genCngdd2)
apply (rule genCngdd1_SCons)
apply auto
done
lemma genCngdd2_pls: "[|genCngdd2 R xs1 xs2; genCngdd2 R ys1 ys2|] ==>
genCngdd2 R (pls xs1 ys1) (pls xs2 ys2)"
apply (subst I2.idem_Cl[symmetric])
apply (rule genCngdd1_genCngdd2)
apply (rule genCngdd1_pls)
apply auto
done
lemma genCngdd2_prd: "[|genCngdd2 R xs1 xs2; genCngdd2 R ys1 ys2|] ==>
genCngdd2 R (prd xs1 ys1) (prd xs2 ys2)"
unfolding prd_uniform algρ2_def o_apply
apply (rule genCngdd2_eval2)
apply (rule rel_funD[OF K2_as_ΣΣ2_transfer])
apply simp
done
lemma genCngdd2_genCngdd3: "genCngdd2 R xs ys ==> genCngdd3 R xs ys"
unfolding genCngdd2_def cngdd2_def cptdd2_def genCngdd3_def cngdd3_def cptdd3_def eval3_embL3[symmetric]
apply (intro allI impI)
apply (erule conjE)+
apply (drule spec)
apply (erule mp conjI)+
apply (erule rel_funD[OF rel_funD[OF comp_transfer]])
apply (rule embL3_transfer)
done
lemma genCngdd3_SCons: "[|x1 = x2; genCngdd3 R xs1 xs2|] ==>
genCngdd3 R (SCons x1 xs1) (SCons x2 xs2)"
apply (subst I3.idem_Cl[symmetric])
apply (rule genCngdd2_genCngdd3)
apply (rule genCngdd2_SCons)
apply auto
done
lemma genCngdd3_pls: "[|genCngdd3 R xs1 xs2; genCngdd3 R ys1 ys2|] ==>
genCngdd3 R (pls xs1 ys1) (pls xs2 ys2)"
apply (subst I3.idem_Cl[symmetric])
apply (rule genCngdd2_genCngdd3)
apply (rule genCngdd2_pls)
apply auto
done
lemma genCngdd3_prd: "[|genCngdd3 R xs1 xs2; genCngdd3 R ys1 ys2|] ==>
genCngdd3 R (prd xs1 ys1) (prd xs2 ys2)"
apply (subst I3.idem_Cl[symmetric])
apply (rule genCngdd2_genCngdd3)
apply (rule genCngdd2_prd)
apply auto
done
lemma genCngdd3_Exp: "genCngdd3 R xs ys ==>
genCngdd3 R (Exp xs) (Exp ys)"
unfolding Exp_uniform algρ3_def o_apply
apply (rule genCngdd3_eval3)
apply (rule rel_funD[OF K3_as_ΣΣ3_transfer])
apply simp
done
lemma genCngdd3_genCngdd4: "genCngdd3 R xs ys ==> genCngdd4 R xs ys"
unfolding genCngdd3_def cngdd3_def cptdd3_def genCngdd4_def cngdd4_def cptdd4_def eval4_embL4[symmetric]
apply (intro allI impI)
apply (erule conjE)+
apply (drule spec)
apply (erule mp conjI)+
apply (erule rel_funD[OF rel_funD[OF comp_transfer]])
apply (rule embL4_transfer)
done
lemma genCngdd4_SCons: "[|x1 = x2; genCngdd4 R xs1 xs2|] ==>
genCngdd4 R (SCons x1 xs1) (SCons x2 xs2)"
apply (subst I4.idem_Cl[symmetric])
apply (rule genCngdd3_genCngdd4)
apply (rule genCngdd3_SCons)
apply auto
done
lemma genCngdd4_pls: "[|genCngdd4 R xs1 xs2; genCngdd4 R ys1 ys2|] ==>
genCngdd4 R (pls xs1 ys1) (pls xs2 ys2)"
apply (subst I4.idem_Cl[symmetric])
apply (rule genCngdd3_genCngdd4)
apply (rule genCngdd3_pls)
apply auto
done
lemma genCngdd4_prd: "[|genCngdd4 R xs1 xs2; genCngdd4 R ys1 ys2|] ==>
genCngdd4 R (prd xs1 ys1) (prd xs2 ys2)"
apply (subst I4.idem_Cl[symmetric])
apply (rule genCngdd3_genCngdd4)
apply (rule genCngdd3_prd)
apply auto
done
lemma genCngdd4_Exp: "genCngdd4 R xs ys ==>
genCngdd4 R (Exp xs) (Exp ys)"
apply (subst I4.idem_Cl[symmetric])
apply (rule genCngdd3_genCngdd4)
apply (rule genCngdd3_Exp)
apply auto
done
lemma genCngdd4_sup: "rel_fset (genCngdd4 R) xs ys ==>
genCngdd4 R (sup xs) (sup ys)"
unfolding sup_uniform algρ4_def o_apply
apply (rule genCngdd4_eval4)
apply (rule rel_funD[OF K4_as_ΣΣ4_transfer])
apply simp
done
lemma stream_coinduct[case_names Eq_stream, case_conclusion Eq_stream head tail]:
assumes "R s s'" "!!s s'. R s s' ==> head s = head s' ∧ R (tail s) (tail s')"
shows "s = s'"
using assms(1) proof (rule mp[OF J.dtor_coinduct, rotated], safe)
fix a b
assume "R a b"
from assms(2)[OF this] show "F_rel R (dtor_J a) (dtor_J b)"
by (cases "dtor_J a" "dtor_J b" rule: prod.exhaust[case_product prod.exhaust])
(auto simp: rel_pre_J_def vimage2p_def BNF_Comp.id_bnf_comp_def)
qed
lemma stream_coinduct0[case_names Eq_stream, case_conclusion Eq_stream head tail]:
assumes "R s s'" "!!s s'. R s s' ==> head s = head s' ∧ genCngdd0 R (tail s) (tail s')"
shows "s = s'"
using assms(1) proof (rule mp[OF coinductionU_genCngdd0, rotated], safe)
fix a b
assume "R a b"
from assms(2)[OF this] show "F_rel (genCngdd0 R) (dtor_J a) (dtor_J b)"
by (cases "dtor_J a" "dtor_J b" rule: prod.exhaust[case_product prod.exhaust])
(auto simp: rel_pre_J_def vimage2p_def BNF_Comp.id_bnf_comp_def)
qed
lemma stream_coinduct1[case_names Eq_stream, case_conclusion Eq_stream head tail]:
assumes "R s s'" "!!s s'. R s s' ==> head s = head s' ∧ genCngdd1 R (tail s) (tail s')"
shows "s = s'"
using assms(1) proof (rule mp[OF coinductionU_genCngdd1, rotated], safe)
fix a b
assume "R a b"
from assms(2)[OF this] show "F_rel (genCngdd1 R) (dtor_J a) (dtor_J b)"
by (cases "dtor_J a" "dtor_J b" rule: prod.exhaust[case_product prod.exhaust])
(auto simp: rel_pre_J_def vimage2p_def BNF_Comp.id_bnf_comp_def)
qed
lemma stream_coinduct2[case_names Eq_stream, case_conclusion Eq_stream head tail]:
assumes "R s s'" "!!s s'. R s s' ==> head s = head s' ∧ genCngdd2 R (tail s) (tail s')"
shows "s = s'"
using assms(1) proof (rule mp[OF coinductionU_genCngdd2, rotated], safe)
fix a b
assume "R a b"
from assms(2)[OF this] show "F_rel (genCngdd2 R) (dtor_J a) (dtor_J b)"
by (cases "dtor_J a" "dtor_J b" rule: prod.exhaust[case_product prod.exhaust])
(auto simp: rel_pre_J_def vimage2p_def BNF_Comp.id_bnf_comp_def)
qed
lemma stream_coinduct3[case_names Eq_stream, case_conclusion Eq_stream head tail]:
assumes "R s s'" "!!s s'. R s s' ==> head s = head s' ∧ genCngdd3 R (tail s) (tail s')"
shows "s = s'"
using assms(1) proof (rule mp[OF coinductionU_genCngdd3, rotated], safe)
fix a b
assume "R a b"
from assms(2)[OF this] show "F_rel (genCngdd3 R) (dtor_J a) (dtor_J b)"
by (cases "dtor_J a" "dtor_J b" rule: prod.exhaust[case_product prod.exhaust])
(auto simp: rel_pre_J_def vimage2p_def BNF_Comp.id_bnf_comp_def)
qed
lemma stream_coinduct4[case_names Eq_stream, case_conclusion Eq_stream head tail]:
assumes "R s s'" "!!s s'. R s s' ==> head s = head s' ∧ genCngdd4 R (tail s) (tail s')"
shows "s = s'"
using assms(1) proof (rule mp[OF coinductionU_genCngdd4, rotated], safe)
fix a b
assume "R a b"
from assms(2)[OF this] show "F_rel (genCngdd4 R) (dtor_J a) (dtor_J b)"
by (cases "dtor_J a" "dtor_J b" rule: prod.exhaust[case_product prod.exhaust])
(auto simp: rel_pre_J_def vimage2p_def BNF_Comp.id_bnf_comp_def)
qed
section {* Proofs by Coinduction Up-To Congruence *}
lemma pls_commute: "pls xs ys = pls ys xs"
by (coinduction arbitrary: xs ys rule: stream_coinduct) auto
lemma prd_commute: "prd xs ys = prd ys xs"
proof (coinduction arbitrary: xs ys rule: stream_coinduct1)
case Eq_stream
then show ?case unfolding tail_prd
by (subst pls_commute) (auto intro: genCngdd1_pls)
qed
lemma pls_assoc: "pls (pls xs ys) zs = pls xs (pls ys zs)"
by (coinduction arbitrary: xs ys zs rule: stream_coinduct) auto
lemma pls_commute_assoc: "pls xs (pls ys zs) = pls ys (pls xs zs)"
by (metis pls_assoc pls_commute)
lemmas pls_ac_simps = pls_assoc pls_commute pls_commute_assoc
lemma "onetwo = onetwo'"
by (coinduction rule: stream_coinduct0)
(auto simp: arg_cong[OF onetwo_code, of head] arg_cong[OF onetwo'_code, of head] J.dtor_ctor
arg_cong[OF onetwo_code, of tail] arg_cong[OF onetwo'_code, of tail] intro: genCngdd0_SCons)
lemma prd_distribL: "prd xs (pls ys zs) = pls (prd xs ys) (prd xs zs)"
proof (coinduction arbitrary: xs ys zs rule: stream_coinduct1)
case Eq_stream
have "!!a b c d. pls (pls a b) (pls c d) = pls (pls a c) (pls b d)" by (metis pls_assoc pls_commute)
then have ?tail by (auto intro!: genCngdd1_pls)
then show ?case by (simp add: algebra_simps)
qed
lemma prd_distribR: "prd (pls xs ys) zs = pls (prd xs zs) (prd ys zs)"
proof (coinduction arbitrary: xs ys zs rule: stream_coinduct1)
case Eq_stream
have "!!a b c d. pls (pls a b) (pls c d) = pls (pls a c) (pls b d)" by (metis pls_assoc pls_commute)
then have ?tail by (auto intro!: genCngdd1_pls)
then show ?case by (simp add: algebra_simps)
qed
lemma prd_assoc: "prd (prd xs ys) zs = prd xs (prd ys zs)"
proof (coinduction arbitrary: xs ys zs rule: stream_coinduct1)
case Eq_stream
have ?tail unfolding tail_prd pls_ac_simps prd_distribL prd_distribR by (auto intro!: genCngdd1_pls)
then show ?case by simp
qed
lemma prd_commute_assoc: "prd xs (prd ys zs) = prd ys (prd xs zs)"
by (metis prd_assoc prd_commute)
lemmas prd_ac_simps = prd_assoc prd_commute prd_commute_assoc
lemma sconst_0[simp]: "same 0 = sconst 0"
by (coinduction rule: stream_coinduct0) auto
lemma pls_sconst_0L[simp]: "pls (sconst 0) s = s"
by (coinduction arbitrary: s rule: stream_coinduct) auto
lemma pls_sconst_0R[simp]: "pls s (sconst 0) = s"
by (coinduction arbitrary: s rule: stream_coinduct) auto
lemma scale_0[simp]: "scale 0 s = sconst 0"
apply (coinduction arbitrary: s rule: stream_coinduct1)
apply simp
apply (subst (5) pls_sconst_0L[of "sconst 0", symmetric])
apply (rule genCngdd1_pls)
apply auto
done
lemma scale_Suc: "scale (Suc n) s = pls s (scale n s)"
by (coinduction arbitrary: s rule: stream_coinduct1) auto
lemma scale_add: "scale (m + n) s = pls (scale m s) (scale n s)"
by (induct m) (auto simp: scale_Suc pls_assoc)
lemma scale_mult: "scale (m * n) s = scale m (scale n s)"
by (induct m) (auto simp: scale_Suc scale_add)
lemma sup_empty: "sup {||} = sconst 0"
by (coinduction rule: stream_coinduct1) (auto simp: fMax_def)
lemma Exp_pls: "Exp (pls xs ys) = prd (Exp xs) (Exp ys)"
by (coinduction arbitrary: xs ys rule: stream_coinduct2)
(auto simp: exp_def power_add prd_distribR pls_commute prd_assoc prd_commute_assoc[of "Exp x" for x]
intro!: genCngdd2_pls genCngdd2_prd)
end