Ring structure induced by a bijection - isabelle

Question

Given a ring, together with a bijection to another set (n.b. set not type), it ought to be "trivial" to define the (unique) induced ring structure on the "other set" that makes the bijection an isomorphism. But my proof that tries to use this takes 101 lines (plus definitions and lemmas). Is there another approach using e.g. "lifting" that makes the whole thing fall out more easily?
Here's an example that could be filled in to do what I want:
theory InducedRing
imports "HOL-Algebra.QuotRing"
begin
lemma
assumes "ring ℛ" "bij_betw φ (carrier ℛ) S"
obtains 𝒮 where "ring 𝒮" and "carrier 𝒮 = S" and "φ ∈ ring_hom ℛ 𝒮"
sorry
end
Feel free to rewrite this to an equivalent or stronger statement (e.g., reverse the direction of \<phi> or even assume a pair of inverse bijections, make the hypotheses part of a locale definition, assert uniqueness of \<S>, change the names according to your own taste....)
The goal is to make the proof feel short and natural. I'm hoping there's a theorem somewhere in HOL-Algebra or another library that will make this easy, but sledgehammer was not able to find it for me -- at least, not with this version of the statement.

Answer 1

I do not think you will get around proofing the ring axioms, except if someone has already proven a similar lemma. I have no experience with HOL-Algebra, so maybe there is something nicer.
Luckily automation seems to handle them fairly well (except one, where auto needs a bit of help). I obtained the proofs by hitting the goal with auto and sledgehammering what was left to search for relevant lemmas to add to auto.
lemma
assumes "ring ℛ" "bij_betw φ (carrier ℛ) S"
obtains 𝒮 where "ring 𝒮" and "carrier 𝒮 = S" and "φ ∈ ring_hom ℛ 𝒮"
proof-
interpret ℛ: ring ℛ
using assms(1) .
(* Define the ring *)
let ?Z = "φ (zero ℛ)"
let ?O = "φ (one ℛ)"
let ?mult = "λx y . φ (inv_into (carrier ℛ) φ x ⊗⇘ℛ⇙ inv_into (carrier ℛ) φ y)"
let ?add = "λx y . φ (inv_into (carrier ℛ) φ x ⊕⇘ℛ⇙ inv_into (carrier ℛ) φ y)"
let ?𝒮 = "⦇ carrier = S, mult = ?mult , one = ?O, zero = ?Z, add = ?add,
… = (undefined :: 'd) ⦈ :: ('c, 'd) ring_scheme"
show thesis
proof(rule that[of ?𝒮])
(* The only part where auto needed some help *)
have helper: "∃y∈S. φ (inv_into (carrier ℛ) φ x ⊕⇘ℛ⇙ inv_into (carrier ℛ) φ y) = φ 𝟬⇘ℛ⇙"
if "x ∈ S" for x
using assms that by (intro bexI[where x="φ (⊖⇘ℛ⇙ (inv_into (carrier ℛ) φ x))"])
(auto intro: bij_betw_apply
simp add: ring.ring_simprules bij_betw_imp_inj_on bij_betw_imp_surj_on inv_into_into)
show "ring ?𝒮"
using assms by unfold_locales
(auto intro: bij_betw_apply simp add: ring.ring_simprules bij_betw_inv_into_right
bij_betw_imp_inj_on bij_betw_imp_surj_on inv_into_into Units_def helper)
next
show "carrier ?𝒮 = S"
by simp
next
from assms(2) show "φ ∈ ring_hom ℛ ?𝒮"
by (intro ring_hom_memI) (auto intro: bij_betw_apply simp add: bij_betw_inv_into_left)
qed
qed
In my proof (and yours as well) I explicitly give the definitions of the induced ring, which makes the obtains in the goal statement a bit pointless in my opinion. Similarly, the S can be computed from carrier ℛ. So why not have the concrete definitions available on the toplevel, similar to for example this:
abbreviation "bij_ring ℛ φ ≡ ⦇carrier = φ ` carrier ℛ,
mult = λx y . φ (inv_into (carrier ℛ) φ x ⊗⇘ℛ⇙ inv_into (carrier ℛ) φ y), one = φ (one ℛ),
zero = φ (zero ℛ), add = λx y . φ (inv_into (carrier ℛ) φ x ⊕⇘ℛ⇙ inv_into (carrier ℛ) φ y),
… = (undefined :: 'd) ⦈ :: ('c, 'd) ring_scheme"
lemma
assumes "ring ℛ" "bij_betw φ (carrier ℛ) (φ ` (carrier ℛ))"
shows "ring (bij_ring ℛ φ)" and "φ ∈ ring_hom ℛ (bij_ring ℛ φ)"
proof-
interpret ℛ: ring ℛ
using assms(1) .
(* Sadly it still needs help *)
from assms have helper: "∃x∈carrier ℛ. φ (y ⊕⇘ℛ⇙ x) = φ 𝟬⇘ℛ⇙"
if "y ∈ carrier ℛ" for y
using that by (metis ℛ.add.r_inv_ex)
from assms show "ring (bij_ring ℛ φ)"
by unfold_locales (auto simp add: bij_betw_inv_into_left
ℛ.add.m_assoc bij_betw_imp_inj_on ring.ring_simprules Units_def helper)
from assms(2) show "φ ∈ ring_hom ℛ (bij_ring ℛ φ)"
by (intro ring_hom_memI) (auto intro: bij_betw_apply simp add: bij_betw_inv_into_left)
qed
This also seems to simplify the proofs a bit. Sadly there is some duplication in the goal statement, but I cannot see a way to improve this now.

Answer 2

Here's my third attempt, using a neat lemma I discovered called ring_iso_imp_img_ring:
theory InducedRing
imports "HOL-Algebra.QuotRing"
begin
lemma induced_ring:
assumes ring_R: "ring ℛ" and phi_bij: "bij_betw φ (carrier ℛ) S"
obtains 𝒮 where "ring 𝒮" and "carrier 𝒮 = S" and "φ ∈ ring_hom ℛ 𝒮"
proof -
interpret R_: ring ℛ by (rule ring_R)
let ?R = "carrier ℛ"
define ψ where "ψ = the_inv_into ?R φ"
have [simp]: "r∈?R ⟹ ψ (φ r) = r" for r by (metis ψ_def phi_bij bij_betw_def the_inv_into_f_eq)
define S_add where [simp]: "S_add x' y' = φ (ψ x' ⊕⇘ℛ⇙ ψ y')" for x' y'
define S_zero where "S_zero = φ 𝟬⇘ℛ⇙"
define S_mult where [simp]: "S_mult x' y' = φ (ψ x' ⊗⇘ℛ⇙ ψ y')" for x' y'
define S_one where [simp]: "S_one = φ 𝟭⇘ℛ⇙"
define 𝒮 where "𝒮 = ⦇carrier = S, mult = S_mult, one = S_one, zero = S_zero, add = S_add,
… = m::'d⦈"
have φ_in_ring_hom: "φ ∈ ring_hom ℛ 𝒮"
proof (auto simp add: ring_hom_def 𝒮_def)
fix x assume x: "x ∈ ?R"
show "φ x ∈ S" using bij_betwE phi_bij x by auto
qed
have carrier_S: "carrier 𝒮 = S" by (simp add: 𝒮_def)
have φ_in_ring_iso: "φ ∈ ring_iso ℛ 𝒮"
using φ_in_ring_hom ring_iso_def phi_bij carrier_S by blast
have [simp]: "𝒮⦇zero := φ 𝟬⇘ℛ⇙⦈ = 𝒮"
apply (rule ring.equality, simp_all)
using S_zero_def 𝒮_def by auto
interpret 𝒮_: ring 𝒮 using R_.ring_iso_imp_img_ring[OF φ_in_ring_iso] by simp
show ?thesis using that[OF 𝒮_.is_ring carrier_S φ_in_ring_hom] .
qed
end
Previous version
Here's my second attempt. It's somewhat more streamlined than my first, but I'm still hoping someone can come up with a much simpler way to do this that does not require restating and verifying the ring axioms one-by-one (in some cases, multiple times).
theory InducedRing
imports "HOL-Algebra.Ring"
begin
lemma
assumes ring_R: "ring ℛ" and phi_bij: "bij_betw φ (carrier ℛ) S"
obtains 𝒮 where "ring 𝒮" and "carrier 𝒮 = S" and "φ ∈ ring_hom ℛ 𝒮"
proof -
interpret R_: ring ℛ by (rule ring_R)
let ?R = "carrier ℛ"
define ψ where "ψ = the_inv_into ?R φ"
have [simp]: "r∈?R ⟹ ψ (φ r) = r" for r by (metis ψ_def phi_bij bij_betw_def the_inv_into_f_eq)
have [simp]: "s∈ S ⟹ φ (ψ s) = s" for s by (metis ψ_def phi_bij f_the_inv_into_f_bij_betw)
define S_add where [simp]: "S_add x' y' = φ (ψ x' ⊕⇘ℛ⇙ ψ y')" for x' y'
then have S_add_closed: "⟦x'∈S; y'∈S⟧ ⟹ S_add x' y' ∈ S" for x' y'
by (metis R_.add.m_closed ψ_def bij_betwE bij_betw_the_inv_into phi_bij)
define S_zero where [simp]: "S_zero = φ 𝟬⇘ℛ⇙"
then have S_zero_closed: "S_zero ∈ S" using bij_betwE phi_bij by blast
define S_mult where [simp]: "S_mult x' y' = φ (ψ x' ⊗⇘ℛ⇙ ψ y')" for x' y'
then have S_mult_closed: "⟦x'∈S; y'∈S⟧ ⟹ S_mult x' y' ∈ S" for x' y'
by (metis R_.m_closed ψ_def bij_betwE bij_betw_the_inv_into phi_bij)
define S_one where [simp]: "S_one = φ 𝟭⇘ℛ⇙"
then have S_one_closed: "S_one ∈ S" using bij_betwE phi_bij by blast
define 𝒮 where "𝒮 = ⦇carrier = S, mult = S_mult, one = S_one, zero = S_zero, add = S_add,
… = m::'d⦈"
have φ_in_ring_hom: "φ ∈ ring_hom ℛ 𝒮"
proof (auto simp add: ring_hom_def 𝒮_def)
fix x assume x: "x ∈ ?R"
show "φ x ∈ S" using bij_betwE phi_bij x by auto
qed
have carrier_S: "carrier 𝒮 = S" by (simp add: 𝒮_def)
interpret 𝒮_: ring 𝒮
proof (unfold_locales, auto simp add: Units_def carrier_S)
show "𝟬⇘𝒮⇙ ∈ S" using S_zero_closed 𝒮_def by auto
show "𝟭⇘𝒮⇙ ∈ S" using S_one_closed 𝒮_def by auto
fix x' assume x': "x' ∈ S"
let ?x = "ψ x'"
have x: "?x ∈ ?R" "φ ?x = x'"
using x' apply (metis ψ_def bij_betw_apply bij_betw_the_inv_into phi_bij)
using x' by auto
show "𝟭⇘𝒮⇙ ⊗⇘𝒮⇙ x' = x'" "x' ⊗⇘𝒮⇙ 𝟭⇘𝒮⇙ = x'" "x' ⊕⇘𝒮⇙ 𝟬⇘𝒮⇙ = x'" "𝟬⇘𝒮⇙ ⊕⇘𝒮⇙ x' = x'"
using φ_in_ring_hom by (simp_all add: 𝒮_def x)
show "∃mx'∈S. mx' ⊕⇘𝒮⇙ x' = 𝟬⇘𝒮⇙ ∧ x' ⊕⇘𝒮⇙ mx' = 𝟬⇘𝒮⇙"
proof (rule, rule)
let ?mx' = "φ (⊖⇘ℛ⇙ ?x)"
show "?mx' ∈ S" using bij_betwE phi_bij x(1) by blast
show "?mx' ⊕⇘𝒮⇙ x' = 𝟬⇘𝒮⇙" "x' ⊕⇘𝒮⇙ ?mx' = 𝟬⇘𝒮⇙"
by (simp_all add: 𝒮_def R_.l_neg R_.r_neg x(1))
qed
fix y' assume y': "y' ∈ S"
let ?y = "ψ y'"
have y: "?y ∈ ?R" "φ ?y = y'"
using y' apply (metis ψ_def bij_betw_apply bij_betw_the_inv_into phi_bij)
using y' by auto
show "x' ⊗⇘𝒮⇙ y' ∈ S" using 𝒮_def S_mult_closed by (simp add: x' y')
show "x' ⊕⇘𝒮⇙ y' ∈ S" using 𝒮_def S_add_closed by (simp add: x' y')
show "x' ⊕⇘𝒮⇙ y' = y' ⊕⇘𝒮⇙ x'"
using φ_in_ring_hom by (simp add: R_.add.m_comm 𝒮_def x(1) y(1))
fix z' assume z': "z' ∈ S"
let ?z = "ψ z'"
have z: "?z ∈ ?R" "φ ?z = z'"
using z' apply (metis ψ_def bij_betw_apply bij_betw_the_inv_into phi_bij)
using z' by auto
show "(x' ⊕⇘𝒮⇙ y') ⊕⇘𝒮⇙ z' = x' ⊕⇘𝒮⇙ (y' ⊕⇘𝒮⇙ z')"
using φ_in_ring_hom 𝒮_def x(1) y(1) z(1) R_.add.m_assoc by simp
show "x' ⊗⇘𝒮⇙ y' ⊗⇘𝒮⇙ z' = x' ⊗⇘𝒮⇙ (y' ⊗⇘𝒮⇙ z')"
using φ_in_ring_hom 𝒮_def x(1) y(1) z(1) R_.m_assoc by simp
show "(x' ⊕⇘𝒮⇙ y') ⊗⇘𝒮⇙ z' = x' ⊗⇘𝒮⇙ z' ⊕⇘𝒮⇙ y' ⊗⇘𝒮⇙ z'"
using ring_hom_add[OF φ_in_ring_hom] ring_hom_mult[OF φ_in_ring_hom] x y z
R_.l_distr R_.add.m_closed R_.m_closed
by (smt (verit, ccfv_threshold))
show "z' ⊗⇘𝒮⇙ (x' ⊕⇘𝒮⇙ y') = z' ⊗⇘𝒮⇙ x' ⊕⇘𝒮⇙ z' ⊗⇘𝒮⇙ y'"
using ring_hom_add[OF φ_in_ring_hom] ring_hom_mult[OF φ_in_ring_hom] x y z
R_.r_distr R_.add.m_closed R_.m_closed
by (smt (verit, ccfv_threshold))
qed
show ?thesis using that[of 𝒮, OF 𝒮_.ring_axioms carrier_S φ_in_ring_hom] .
qed
end