{-# OPTIONS --cubical-compatible --safe #-}
open import Algebra.Bundles using (Monoid)
open import Data.Nat.Base as ℕ using (ℕ; zero; suc)
open import Relation.Binary.Core using (_Preserves_⟶_; _Preserves₂_⟶_⟶_)
open import Relation.Binary.PropositionalEquality.Core as ≡ using (_≡_)
module Algebra.Properties.Monoid.Mult.TCOptimised
{a ℓ} (M : Monoid a ℓ) where
open Monoid M renaming
( _∙_ to _+_
; ∙-cong to +-cong
; ∙-congˡ to +-congˡ
; ∙-congʳ to +-congʳ
; identityˡ to +-identityˡ
; identityʳ to +-identityʳ
; assoc to +-assoc
; ε to 0#
)
open import Algebra.Properties.Monoid.Mult M as U
using () renaming (_×_ to _×ᵤ_)
open import Relation.Binary.Reasoning.Setoid setoid
open import Algebra.Definitions.RawMonoid rawMonoid public
using () renaming (_×′_ to _×_)
1+× : ∀ n x → suc n × x ≈ x + n × x
1+× 0 x = sym (+-identityʳ x)
1+× 1 x = refl
1+× (suc n@(suc _)) x = begin
(suc n × x) + x ≈⟨ +-congʳ (1+× n x) ⟩
(x + n × x) + x ≈⟨ +-assoc x (n × x) x ⟩
x + (n × x + x) ∎
×ᵤ≈× : ∀ n x → n ×ᵤ x ≈ n × x
×ᵤ≈× 0 x = refl
×ᵤ≈× (suc n) x = begin
x + n ×ᵤ x ≈⟨ +-congˡ (×ᵤ≈× n x) ⟩
x + n × x ≈⟨ 1+× n x ⟨
suc n × x ∎
×-homo-+ : ∀ c m n → (m ℕ.+ n) × c ≈ m × c + n × c
×-homo-+ c m n = begin
(m ℕ.+ n) × c ≈⟨ ×ᵤ≈× (m ℕ.+ n) c ⟨
(m ℕ.+ n) ×ᵤ c ≈⟨ U.×-homo-+ c m n ⟩
m ×ᵤ c + n ×ᵤ c ≈⟨ +-cong (×ᵤ≈× m c) (×ᵤ≈× n c) ⟩
m × c + n × c ∎
×-congʳ : ∀ n → (n ×_) Preserves _≈_ ⟶ _≈_
×-congʳ 0 x≈y = refl
×-congʳ 1 x≈y = x≈y
×-congʳ (suc n@(suc _)) x≈y = +-cong (×-congʳ n x≈y) x≈y
×-cong : _×_ Preserves₂ _≡_ ⟶ _≈_ ⟶ _≈_
×-cong {n} ≡.refl x≈y = ×-congʳ n x≈y
×-assocˡ : ∀ x m n → m × (n × x) ≈ (m ℕ.* n) × x
×-assocˡ x m n = begin
m × (n × x) ≈⟨ ×-congʳ m (×ᵤ≈× n x) ⟨
m × (n ×ᵤ x) ≈⟨ ×ᵤ≈× m (n ×ᵤ x) ⟨
m ×ᵤ (n ×ᵤ x) ≈⟨ U.×-assocˡ x m n ⟩
(m ℕ.* n) ×ᵤ x ≈⟨ ×ᵤ≈× (m ℕ.* n) x ⟩
(m ℕ.* n) × x ∎