53 lines
2 KiB
Text
53 lines
2 KiB
Text
-- Authors: Floris van Doorn
|
||
|
||
import .EM .smash_adjoint ..algebra.ring
|
||
|
||
open algebra eq EM is_equiv equiv is_trunc is_conn pointed trunc susp smash group nat
|
||
namespace EM
|
||
|
||
definition EM1product_adj {R : Ring} :
|
||
EM1 (AbGroup_of_Ring R) →* ppmap (EM1 (AbGroup_of_Ring R)) (EMadd1 (AbGroup_of_Ring R) 1) :=
|
||
begin
|
||
have is_trunc 1 (ppmap (EM1 (AbGroup_of_Ring R)) (EMadd1 (AbGroup_of_Ring R) 1)),
|
||
from is_trunc_pmap_of_is_conn _ _ _ _ _ _ (le.refl 2) !is_trunc_EMadd1,
|
||
fapply EM1_pmap,
|
||
{ intro r, refine pfunext _ _, exact !loop_EM2⁻¹ᵉ* ∘* EM1_functor (ring_right_action r), },
|
||
{ intro r r', exact sorry }
|
||
end
|
||
|
||
definition EMproduct_map {G H K : AbGroup} (φ : G → H →g K) (n m : ℕ) (g : G) :
|
||
EMadd1 H n →* EMadd1 K n :=
|
||
begin
|
||
fapply EMadd1_functor (φ g) n
|
||
end
|
||
|
||
definition EM0EMadd1product {G H K : AbGroup} (φ : G →g H →gg K) (n : ℕ) :
|
||
G →* EMadd1 H n →** EMadd1 K n :=
|
||
EMadd1_pfunctor H K n ∘* pmap_of_homomorphism φ
|
||
|
||
definition EMadd1product {G H K : AbGroup} (φ : G →g H →gg K) (n m : ℕ) :
|
||
EMadd1 G n →* EMadd1 H m →** EMadd1 K (m + succ n) :=
|
||
begin
|
||
assert H1 : is_trunc n.+1 (EMadd1 H m →** EMadd1 K (m + succ n)),
|
||
{ refine is_trunc_pmap_of_is_conn _ (m.-1) !is_conn_EMadd1 _ _ _ _ !is_trunc_EMadd1,
|
||
exact le_of_eq (trunc_index.of_nat_add_plus_two_of_nat m n)⁻¹ᵖ },
|
||
fapply EMadd1_pmap,
|
||
{ refine (loopn_ppmap_pequiv _ _ _)⁻¹ᵉ* ∘* ppcompose_left !loopn_EMadd1_add⁻¹ᵉ* ∘*
|
||
EM0EMadd1product φ m },
|
||
{ exact sorry }
|
||
end
|
||
|
||
definition EMproduct {G H K : AbGroup} (φ : G →g H →gg K) (n m : ℕ) :
|
||
EM G n →* EM H m →** EM K (m + n) :=
|
||
begin
|
||
cases n with n,
|
||
{ cases m with m,
|
||
{ exact pmap_of_homomorphism2 φ },
|
||
{ exact EM0EMadd1product φ m }},
|
||
{ cases m with m,
|
||
{ exact ppcompose_left (ptransport (EMadd1 K) (zero_add n)⁻¹) ∘*
|
||
pmap_swap_map (EM0EMadd1product (homomorphism_swap φ) n) },
|
||
{ exact ppcompose_left (ptransport (EMadd1 K) !succ_add⁻¹) ∘* EMadd1product φ n m }}
|
||
end
|
||
|
||
end EM
|