例子改写后完整代码如下,数学库位置:/lake-packages/mathlib/Mathlib/RingTheory/RootsOfUnity/Basic.lean
theorem My_nthRoots_one_eq_biUnion_primitiveRoots' {ζ : R} {n : ℕ+} (h : IsPrimitiveRoot ζ n) :
nthRootsFinset n R = (Nat.divisors ↑n).biUnion fun i => primitiveRoots i R
:= by
symm
apply Finset.eq_of_subset_of_card_le
· intro x
have h1:
(
(x ∈ Finset.biUnion (Nat.divisors ↑n) fun i ↦ primitiveRoots i R)
→
(x ∈ Multiset.toFinset (nthRoots (↑n) 1))
)
=
(
(x ∈ Finset.biUnion (Nat.divisors ↑n) fun i ↦ primitiveRoots i R)
→
(x ∈ (@Finset.mk R (nthRoots (↑n) 1) (_ :@Multiset.Nodup R (nthRoots (↑n) 1)) ) )
)
:= by
have h1_1 :=
(Eq.refl
(x ∈ Finset.biUnion (Nat.divisors ↑n) fun i ↦ primitiveRoots i R)
)
have h1_2 :=
(congrArg
(Membership.mem x)
(Multiset.toFinset_eq (nthRoots_nodup h)).symm
)
have h1_3 :=
(implies_congr
h1_1
h1_2
)
have h1_4 := id h1_3
exact h1_4
--
-- 引理的原命题:
--
have auxlemma_36 : ∀ {n m : ℕ}, (n ∈ Nat.divisors m) = (n ∣ m ∧ m ≠ 0)
:= by simp only [Nat.mem_divisors, Nat.isUnit_iff, ne_eq, forall_const]
have auxlemma_38 : ∀ (n : ℕ+), ( ((n:ℕ) = 0) = False)
:= by simp only [PNat.ne_zero, forall_const]
-- have auxlemma_38_n := auxlemma_38 n -- 最终符合的是长这样的,
-- have auxlemma_38_n : (¬(n : ℕ) = 0) = ¬False := by simp only [PNat.ne_zero,
-- not_false_eq_true] -- 不报错,但不是想要的
-- have test38: ∀ (n : ℕ+), (n = 0) = False -- 注意:这样写会报错:failed to synthesize instance
-- have test38 (n : ℕ+) : (n : ℕ) ≠ 0 := n.2.ne' -- 这样写不会
-- have test38 : ∀ (n : ℕ+), (n:ℕ) = 0 = False -- 这样也不会。总结就是:缺了条件,就报错failed to synthesize
have auxlemma_40 : (¬False) = True
:= by simp only
have auxlemma_37 : ∀ (p : Prop), (p ∧ True) = p
:= by simp only [and_true, forall_const]
have auxlemma_28
: ∀ {α : Type u_4} {a : α} {s : Multiset α} {nd : Multiset.Nodup s}, (@Membership.mem α (Finset α) instMembershipFinset a { val := s, nodup := nd } ) = (a ∈ s) -- invalid notion {} 是因为缺少一些前缀,信息不详细
:= by simp only [mem_mk, implies_true, forall_const]
-- (Multiset.toFinset_eq (nthRoots_nodup h)).symm
-- ∀ {α : Type u_4} {a : α} {s : Multiset α} {nd : Multiset.Nodup s}, (a ∈ { val := s, nodup := nd }) = (a ∈ s)
-- := by
have auxlemma_35: ∀ {R : Type u_4} [inst : CommRing R] [inst_2 : IsDomain R] {n : ℕ},
0 < n → ∀ {a x : R}, (x ∈ nthRoots n a) = (x ^ n = a)
:= by
simp only [eq_iff_iff]
exact fun {R} [CommRing R] [IsDomain R] {n} a {a_1 x} ↦ mem_nthRoots a
have auxlemma_39: ∀ (n : ℕ+), (0 < (n:ℕ )) = True
:= by simp only [PNat.pos, forall_const]
have auxlemma_41 : ∀ {α : Type} [inst : CanonicallyOrderedAddCommMonoid α] {a : α}, (a ≤ 0) = (a = 0)
:= by simp only [nonpos_iff_eq_zero, forall_const, implies_true]
--
-- 引理的适当改造使用:
--
-- 注意:分析print的时候,会发现有些参数可能是原证明中没出现的,要记下来,比如auxlemma_35'后面的"1 x"
-- have testaaa1 := (of_eq_true (auxlemma_39 n)) -- : 0 < ↑n
-- have testaaa2 := @auxlemma_35 R _ _ _ (of_eq_true (auxlemma_39 n)) -- : ∀ {a x : R}, (x ∈ nthRoots (↑n) a) = (x ^ ↑n = a)
have auxlemma_35'_39 := @auxlemma_35 R _ _ _ (of_eq_true (auxlemma_39 n)) 1 x-- 注意:typeclass instance problem is stuck: 用全参数@来解决,要自动推断的写个“_”即可
have auxlemma_28' := @auxlemma_28 R x (nthRoots (↑n) 1) (nthRoots_nodup h)
-- @Eq.trans -- 验证:不用
-- Prop -- 验证:不用
-- (x ∈ { val := nthRoots (↑n) 1, nodup := nthRoots_nodup h }) -- 验证:不用
-- (x ∈ nthRoots (↑n) 1) -- 验证:不用
-- (x ^ ↑n = 1) -- 验证:不用
-- «lake-packages».mathlib.Mathlib.RingTheory.RootsOfUnity.Basic._auxLemma.28 -- 验证:: (x ∈ { val := nthRoots (↑n) 1, nodup := (_ : Multiset.Nodup (nthRoots (↑n) 1)) }) = (x ∈ nthRoots (↑n) 1),就是已知的auxlemma_28'
-- («lake-packages».mathlib.Mathlib.RingTheory.RootsOfUnity.Basic._auxLemma.35 -- 验证: (x ∈ nthRoots (↑n) 1) = (x ^ ↑n = 1),也就是已知的auxlemma_35'_39
-- (of_eq_true («lake-packages».mathlib.Mathlib.RingTheory.RootsOfUnity.Basic._auxLemma.39 n)))
-- : (x ∈ { val := nthRoots (↑n) 1, nodup := (_ : Multiset.Nodup (nthRoots (↑n) 1)) }) = (x ^ ↑n = 1)
-- have testaaa3 := @Eq.trans Prop
-- (@Membership.mem R (Finset R) instMembershipFinset x { val := nthRoots (↑n) 1, nodup := @nthRoots_nodup R _ _ ζ (↑n) h }) -- 报错inst : inst全部替换成_即可
-- (x ∈ nthRoots (↑n) 1)
-- (@Eq R (@HPow.hPow R ℕ R instHPow x ↑n) 1 ) -- 报错就参照print信息写详细。
-- auxlemma_28'
-- auxlemma_35'_39
have auxlemma_34' : (x ∈ Finset.biUnion (Nat.divisors ↑n) fun i ↦ primitiveRoots i R) = ∃ a ∈ Nat.divisors ↑n, x ∈ primitiveRoots a R -- 全场mvp原来藏在这里。被并集包括则存在,存在则被并集包括。人类的直觉比较难到达。
:= by
simp only [mem_biUnion] -- 证明最好换一行,不然后面可能引用失败。
have h2: (x ∈ Finset.biUnion (Nat.divisors ↑n) fun i ↦ primitiveRoots i R) → x ∈ (@Finset.mk R (nthRoots (↑n) 1) (@nthRoots_nodup R _ _ ζ (↑n) h))
:= by
have h2_1:
((x ∈ Finset.biUnion (Nat.divisors ↑n) fun i ↦ primitiveRoots i R)
→
x ∈ (@Finset.mk R (nthRoots (↑n) 1) (@nthRoots_nodup R _ _ ζ (↑n) h)) )
=
((∃ a, a ∣ ↑n ∧ x ∈ primitiveRoots a R)
→
(@HPow.hPow R ℕ R instHPow x ↑n ) = 1)
:= by
have h2_1_1: (x ∈ Finset.biUnion (Nat.divisors ↑n) fun i ↦ primitiveRoots i R) = ∃ x_1, x_1 ∣ ↑n ∧ x ∈ primitiveRoots x_1 R
:= by
have h2_1_1_1: (∃ x_1 ∈ Nat.divisors ↑n, x ∈ primitiveRoots x_1 R) = ∃ x_1, x_1 ∣ ↑n ∧ x ∈ primitiveRoots x_1 R
:= by
have h2_1_1_1_1: (fun x_1 ↦ x_1 ∈ Nat.divisors ↑n ∧ x ∈ primitiveRoots x_1 R) = fun x_1 ↦ x_1 ∣ ↑n ∧ x ∈ primitiveRoots x_1 R
:= by
apply @_root_.funext ℕ (fun x ↦ Prop) (fun x_1 ↦ x_1 ∈ Nat.divisors ↑n ∧ x ∈ primitiveRoots x_1 R) (fun x_1 ↦ x_1 ∣ ↑n ∧ x ∈ primitiveRoots x_1 R)
intro a
have h2_1_1_1_1_1 : And (a ∈ Nat.divisors ↑n) = And (a ∣ ↑n)
:= by
have h2_1_1_1_1_1_1 : (a ∈ Nat.divisors ↑n) = (a ∣ ↑n)
:= by simp only [Nat.mem_divisors, Nat.isUnit_iff, ne_eq, PNat.ne_zero,
not_false_eq_true, and_true] -- 这是最后几行了,看到很简单,直接simp了。
-- exact @Eq.trans
-- Prop
-- (a ∈ Nat.divisors ↑n)
-- (a ∣ ↑n ∧ True)
-- (a ∣ ↑n)
-- (auxLemma_36.trans
-- (congrArg (And (a ∣ ↑n))
-- ((congrArg Not (auxLemma_38 n)).trans
-- auxLemma_40)))
-- (auxLemma_37 (a ∣ ↑n))
-- sorry
exact @congrArg
Prop
(Prop → Prop)
(a ∈ Nat.divisors ↑n)
(a ∣ ↑n)
And
h2_1_1_1_1_1_1
exact @congrFun
Prop
(fun b ↦ Prop)
(And (a ∈ Nat.divisors ↑n))
(And (a ∣ ↑n))
h2_1_1_1_1_1
(x ∈ primitiveRoots a R)
exact @congrArg
(ℕ → Prop)
Prop
(fun x_1 ↦ x_1 ∈ Nat.divisors ↑n ∧ x ∈ primitiveRoots x_1 R)
(fun x_1 ↦ x_1 ∣ ↑n ∧ x ∈ primitiveRoots x_1 R)
Exists
h2_1_1_1_1
exact @Eq.trans Prop
(x ∈ Finset.biUnion (Nat.divisors ↑n) fun i ↦ primitiveRoots i R)
(∃ a ∈ Nat.divisors ↑n, x ∈ primitiveRoots a R)
(∃ x_1, x_1 ∣ ↑n ∧ x ∈ primitiveRoots x_1 R)
auxlemma_34'
h2_1_1_1
have h2_1_2: (x ∈ ((@Finset.mk R (nthRoots (↑n) 1) (@nthRoots_nodup R _ _ ζ (↑n) h))) ) = (((@HPow.hPow R ℕ R instHPow x ↑n )) = 1)
:= by
exact @Eq.trans Prop (x ∈ (@Finset.mk R (nthRoots (↑n) 1) (@nthRoots_nodup R _ _ ζ (↑n) h))) (x ∈ nthRoots (↑n) 1) (((@HPow.hPow R ℕ R instHPow x ↑n ))= 1) auxlemma_28
(auxlemma_35
(of_eq_true (auxlemma_39 n)))
exact implies_congr h2_1_1 h2_1_2
have h2_2: (∃ a, a ∣ ↑n ∧ x ∈ primitiveRoots a R) → (@HPow.hPow R ℕ R instHPow x ↑n ) = 1 -- 精髓在这里,前面h2_1就是在扯淡一堆等价说法
:= by
intro a
have h2_2_1 := @Exists.casesOn ℕ (fun a ↦ a ∣ ↑n ∧ x ∈ primitiveRoots a R) (fun x_1 ↦ (@HPow.hPow R ℕ R instHPow x ↑n ) = 1) a
apply h2_2_1
intro a h
have h2_2_2 := @And.casesOn (@Dvd.dvd ℕ Nat.instDvdNat a ↑n) (x ∈ primitiveRoots a R) (fun x_1 ↦ (@HPow.hPow R ℕ R instHPow x ↑n ) = 1) h
apply h2_2_2
intro left ha
have h2_2_3 := @Exists.casesOn ℕ (fun c ↦ ↑n = a * c) (fun x_1 ↦ (@HPow.hPow R ℕ R instHPow x ↑n ) = 1) left
apply h2_2_3
intro d hd
have hazero:0 < a
:= by
exact PNat.pos_of_div_pos left
-- Mathlib.Tactic.Contrapose.mtr
-- (Eq.mpr (id (implies_congr (Mathlib.Tactic.PushNeg.not_lt_eq 0 a) (Eq.refl (↑n ≠ a * d))))
-- fun ha0 ↦
-- Eq.mpr
-- (id
-- (congrArg (Ne ↑n)
-- ((congrFun
-- (congrArg HMul.hMul
-- (id
-- (Eq.mp
-- auxlemma_41
-- ha0)))
-- d).trans
-- (zero_mul d))))
-- (PNat.ne_zero n))
-- hd
have h2_2_4: ((@HPow.hPow R ℕ R instHPow x ↑n ) = 1) = (x ^ (a * d) = 1) := @id (( ((@HPow.hPow R ℕ R instHPow x ↑n ) )= 1) = (x ^ (a * d) = 1)) (@Eq.ndrec ℕ (n) (fun _a ↦ (((@HPow.hPow R ℕ R instHPow x ↑n ))= 1) = (x ^ _a = 1)) (Eq.refl (((@HPow.hPow R ℕ R instHPow x ↑n )) = 1)) (a * d) hd )
let ha': IsPrimitiveRoot x a := by exact isPrimitiveRoot_of_mem_primitiveRoots ha
have h2_2_5 : x ^ (a * d) = 1
:= by
have h2_2_5_1 : (x ^ a) ^ d = 1
:= by
have h2_2_5_1_1 : ((x ^ a) ^ d = 1) = (1 ^ d = 1)
:= by
-- exact @Eq.ndrec R (x ^ a) (fun _a ↦ ((x ^ a) ^ d = 1) = (_a ^ d = 1)) (Eq.refl ((x ^ a) ^ d = 1)) 1
-- (Eq.mp (propext (@mem_primitiveRoots R a _ _ x hazero) ▸ Eq.refl (x ∈ primitiveRoots a R)) ha').pow_eq_one
sorry -- 傻瓜报错,同类还报错。
have h2_2_5_1_2 : 1 ^ d = 1
:= by
have h2_2_5_1_2_1:(1 ^ d = 1) = (1 = 1) :=
-- @id ((1 ^ d = 1) = (1 = 1)) (@Eq.ndrec R (1 ^ d) (fun _a ↦ (1 ^ d = 1) = (_a = 1)) (@Eq.refl Prop (1 ^ d = 1)) 1 (one_pow d) )
sorry -- 傻瓜报错,同类还报错。
have oneEqOne : (1 = 1) := rfl
exact @Eq.mpr _ _ h2_2_5_1_2_1 (oneEqOne)
have h2_2_5_1_3 := @Eq.mpr _ _ h2_2_5_1_1 h2_2_5_1_2
exact h2_2_5_1_3
exact @Eq.mpr (x ^ (a * d) = 1) ((x ^ a) ^ d = 1) (id (pow_mul x a d ▸ Eq.refl (x ^ (a * d) = 1))) h2_2_5_1
exact @Eq.mpr _ _ h2_2_4 h2_2_5
exact Eq.mpr h2_1 h2_2
have h3 := id (Eq.mpr h1 h2)
exact h3
· apply le_of_eq
rw [h.card_nthRootsFinset, Finset.card_biUnion] -- 这里拆成两个目标
· nth_rw 1 [← Nat.sum_totient n] -- 这个是主证明
refine' sum_congr rfl _ -- 遗留的_条件,在下一行开始证明:
simp only [Nat.mem_divisors]
rintro k ⟨⟨d, hd⟩, -⟩
rw [mul_comm] at hd
rw [(h.pow n.pos hd).card_primitiveRoots]
· intro i _ j _ hdiff -- 这个是拆开时遗留的补充条件证明,很有条理吧。
exact disjoint hdiff