陶哲轩也在用-人工智能数学验证+定理发明工具LEAN4 [经典数学篇1]从零开始证明3次方程的求根公式的充要条件(重制下) 反向拆解定理成可读性高的逐行策略模式,极大的提高定理的可读性。

例子改写后完整代码如下,数学库位置:/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
  • 2
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值