671
E a (a+a>a*a & (E b (E c (E d (A e (A f (f<a | (E g (E h (E i ((A j ((!(j=(f+f+h)*(f+f+h)+h | j=(f+f+a+i)*(f+f+a+i)+i) | j+a<e & (E k ((A l (!(l>a & (E m k=l*m)) | (E m l=e*m))) & (E l (E m (m<k & g=(e*l+(j+a))*k+m)))))) & (A k (!(E l (l=(j+k)*(j+k)+k+a & l<e & (E m ((A n (!(n>a & (E o m=n*o)) | (E o n=e*o))) & (E n (E o (o<m & g=(e*n+l)*m+o))))))) | j<a+a & k=a | (E l (E m ((E n (n=(l+m)*(l+m)+m+a & n<e & (E o ((A p (!(p>a & (E q o=p*q)) | (E q p=e*q))) & (E p (E q (q<o & g=(e*p+n)*o+q))))))) & j=l+a+a & k=j*j*m))))))) & (E j (E k (E l ((E m (m=(k+l)*(k+l)+l & (E n (n=(f+m)*(f+m)+m+a & n<e & (E o ((A p (!(p>a & (E q o=p*q)) | (E q p=e*q))) & (E p (E q (q<o & j=(e*p+n)*o+q))))))))) & (A m (A n (A o (!(E p (p=(n+o)*(n+o)+o & (E q (q=(m+p)*(m+p)+p+a & q<e & (E r ((A s (!(s>a & (E t r=s*t)) | (E t s=e*t))) & (E s (E t (t<r & j=(e*s+q)*r+t))))))))) | m<a & n=a & o=f | (E p (E q (E r (!(E s (s=(q+r)*(q+r)+r & (E t (t=(p+s)*(p+s)+s+a & t<e & (E u ((A v (!(v>a & (E w u=v*w)) | (E w v=e*w))) & (E v (E w (w<u & j=(e*v+t)*u+w))))))))) | m=p+a & n=(f+a)*q & o=f*r)))))))) & (E m (m=b*(h*f)*l & (E n (n=b*(h*f+h)*l & (E o (o=c*(k*f)*i & (E p (p=c*(k*f+k)*i & (E q (q=d*i*l & (m+o<q & n+p>q | m<p+q & n>o+q | o<n+q & p>m+q))))))))))))))))))))))))))
Làm thế nào nó hoạt động
Đầu tiên, nhân với các mẫu số chung có ý nghĩa của a và (π + e · a) để viết lại điều kiện như: tồn tại a, b, c ∈ (không phải tất cả bằng 0) với a · π + b · e = c hoặc a · π - b · e = c hoặc −a · π + b · e = c. Ba trường hợp là cần thiết để giải quyết các vấn đề dấu hiệu.
Sau đó, chúng ta sẽ cần viết lại phần này để nói về π và e thông qua các xấp xỉ hợp lý: đối với tất cả các xấp xỉ hợp lý π₀ <π <π₁ và e₀ <e <e₁, chúng ta có một · π₀ + b · e₀ <c <a · π₁ + b · e₁ hoặc a · π₀ - b · e₁ <c <a · π₁ + b · e₀ hoặc −a · π₁ + b · e₀ <c <−a · π₀ + b · e₁. (Lưu ý rằng bây giờ chúng tôi nhận được miễn phí các điều kiện không phải là không có điều kiện.
Bây giờ là đến phần khó. Làm thế nào để chúng ta có được những xấp xỉ hợp lý? Chúng tôi muốn sử dụng các công thức như
2/1 · 2/3 · 4/3 · 4/5 ⋯ (2 · k) / (2 · k + 1) <π / 2 <2/1 · 2/3 · 4/3 · 4/5 (2 · k) / (2 · k + 1) · (2 · k + 2) / (2 · k + 1),
((k + 1) / k) k <e <((k + 1) / k) k + 1 ,
nhưng không có cách rõ ràng để viết định nghĩa lặp của các sản phẩm này. Vì vậy, chúng tôi xây dựng một chút máy móc mà lần đầu tiên tôi mô tả trong bài Quora này . Định nghĩa:
chia (d, a): = b, a = d · b,
powerOfPrime (a, p): = ∀b, ((b> 1 và chia (b, a)) chia (p, b)),
được thỏa mãn iff a = 1, hoặc p = 1, hoặc p là số nguyên tố và a là một sức mạnh của nó. Sau đó
isDigit (a, s, p): = a <p và ∃b, (powerOfPrime (b, p) và ∃qr, (r <b và s = (p · q + a) · b + r))
được thỏa mãn iff a = 0 hoặc a là một chữ số của số cơ sở s. Điều này cho phép chúng tôi biểu diễn bất kỳ tập hữu hạn nào bằng cách sử dụng các chữ số của một số số cơ sở. Bây giờ chúng ta có thể dịch các phép tính lặp bằng cách viết, đại khái, tồn tại một tập hợp các trạng thái trung gian sao cho trạng thái cuối cùng nằm trong tập hợp và mọi trạng thái trong tập hợp là trạng thái ban đầu hoặc theo một bước từ một trạng thái khác trong trạng thái khác bộ.
Thông tin chi tiết có trong mã dưới đây.
{-# LANGUAGE ImplicitParams, TypeFamilies, Rank2Types #-}
-- Define an embedded domain-specific language for propositions.
infixr 2 :|
infixr 3 :&
infix 4 :=
infix 4 :>
infix 4 :<
infixl 6 :+
infixl 7 :*
data Nat v
= Var v
| Nat v :+ Nat v
| Nat v :* Nat v
instance Num (Nat v) where
(+) = (:+)
(*) = (:*)
abs = id
signum = error "signum Nat"
fromInteger = error "fromInteger Nat"
negate = error "negate Nat"
data Prop v
= Ex (v -> Prop v)
| Al (v -> Prop v)
| Nat v := Nat v
| Nat v :> Nat v
| Nat v :< Nat v
| Prop v :& Prop v
| Prop v :| Prop v
| Not (Prop v)
-- Display propositions in the given format.
allVars :: [String]
allVars = do
s <- "" : allVars
c <- ['a' .. 'z']
pure (s ++ [c])
showNat :: Int -> Nat String -> ShowS
showNat _ (Var v) = showString v
showNat prec (a :+ b) =
showParen (prec > 6) $ showNat 6 a . showString "+" . showNat 7 b
showNat prec (a :* b) =
showParen (prec > 7) $ showNat 7 a . showString "*" . showNat 8 b
showProp :: Int -> Prop String -> [String] -> ShowS
showProp prec (Ex p) (v:free) =
showParen (prec > 1) $ showString ("E " ++ v ++ " ") . showProp 4 (p v) free
showProp prec (Al p) (v:free) =
showParen (prec > 1) $ showString ("A " ++ v ++ " ") . showProp 4 (p v) free
showProp prec (a := b) _ =
showParen (prec > 4) $ showNat 5 a . showString "=" . showNat 5 b
showProp prec (a :> b) _ =
showParen (prec > 4) $ showNat 5 a . showString ">" . showNat 5 b
showProp prec (a :< b) _ =
showParen (prec > 4) $ showNat 5 a . showString "<" . showNat 5 b
showProp prec (p :& q) free =
showParen (prec > 3) $
showProp 4 p free . showString " & " . showProp 3 q free
showProp prec (p :| q) free =
showParen (prec > 2) $
showProp 3 p free . showString " | " . showProp 2 q free
showProp _ (Not p) free = showString "!" . showProp 9 p free
-- Compute the score.
scoreNat :: Nat v -> Int
scoreNat (Var _) = 1
scoreNat (a :+ b) = scoreNat a + 1 + scoreNat b
scoreNat (a :* b) = scoreNat a + 1 + scoreNat b
scoreProp :: Prop () -> Int
scoreProp (Ex p) = 2 + scoreProp (p ())
scoreProp (Al p) = 2 + scoreProp (p ())
scoreProp (p := q) = scoreNat p + 1 + scoreNat q
scoreProp (p :> q) = scoreNat p + 1 + scoreNat q
scoreProp (p :< q) = scoreNat p + 1 + scoreNat q
scoreProp (p :& q) = scoreProp p + 1 + scoreProp q
scoreProp (p :| q) = scoreProp p + 1 + scoreProp q
scoreProp (Not p) = 1 + scoreProp p
-- Convenience wrappers for n-ary exists and forall.
class OpenProp p where
type OpenPropV p
ex, al :: p -> Prop (OpenPropV p)
instance OpenProp (Prop v) where
type OpenPropV (Prop v) = v
ex = id
al = id
instance (OpenProp p, a ~ Nat (OpenPropV p)) => OpenProp (a -> p) where
type OpenPropV (a -> p) = OpenPropV p
ex p = Ex (ex . p . Var)
al p = Al (al . p . Var)
-- Utility for common subexpression elimination.
cse :: Int -> Nat v -> (Nat v -> Prop v) -> Prop v
cse uses x cont
| (scoreNat x - 1) * (uses - 1) > 6 = ex (\x' -> x' := x :& cont x')
| otherwise = cont x
-- p implies q.
infixl 1 ==>
p ==> q = Not p :| q
-- Define one as the unique n with n+n>n*n.
withOne ::
((?one :: Nat v) =>
Prop v)
-> Prop v
withOne p =
ex
(\one ->
let ?one = one
in one + one :> one * one :& p)
-- a is a multiple of d.
divides d a = ex (\b -> a := d * b)
-- a is a power of p (assuming p is prime).
powerOfPrime a p = al (\b -> b :> ?one :& divides b a ==> divides p b)
-- a is 0 or a digit of the base-p number s (assuming p is prime).
isDigit a s p =
cse 2 a $ \a ->
a :< p :&
ex
(\b -> powerOfPrime b p :& ex (\q r -> r :< b :& s := (p * q + a) * b + r))
-- An injection from ℕ² to ℕ, for representing tuples.
pair a b = (a + b) ^ 2 + b
-- πn₀/πd < π/4 < πn₁/πd, with both fractions approaching π/4 as k
-- increases:
-- πn₀ = 2²·4²·6²⋯(2·k)²·k
-- πn₁ = 2²·4²·6²⋯(2·k)²·(k + 1)
-- πd = 1²⋅3²·5²⋯(2·k + 1)²
πBound p k cont =
ex
(\s x πd ->
al
(\i ->
(i := pair (k + k) x :| i := pair (k + k + ?one) πd ==>
isDigit (i + ?one) s p) :&
al
(\a ->
isDigit (pair i a + ?one) s p ==>
((i :< ?one + ?one :& a := ?one) :|
ex
(\i' a' ->
isDigit (pair i' a' + ?one) s p :&
i := i' + ?one + ?one :& a := i ^ 2 * a')))) :&
let πn₀ = x * k
πn₁ = πn₀ + x
in cont πn₀ πn₁ πd)
-- en₀/ed < e < en₁/ed, with both fractions approaching e as k
-- increases:
-- en₀ = (k + 1)^k * k
-- en₁ = (k + 1)^(k + 1)
-- ed = k^(k + 1)
eBound p k cont =
ex
(\s x ed ->
cse 3 (pair x ed) (\y -> isDigit (pair k y + ?one) s p) :&
al
(\i a b ->
cse 3 (pair a b) (\y -> isDigit (pair i y + ?one) s p) ==>
(i :< ?one :& a := ?one :& b := k) :|
ex
(\i' a' b' ->
cse 3 (pair a' b') (\y -> isDigit (pair i' y + ?one) s p) ==>
i := i' + ?one :& a := (k + ?one) * a' :& b := k * b')) :&
let en₀ = x * k
en₁ = en₀ + x
in cont en₀ en₁ ed)
-- There exist a, b, c ∈ ℕ (not all zero) with a·π/4 + b·e = c or
-- a·π/4 = b·e + c or b·e = a·π/4 + c.
prop :: Prop v
prop =
withOne $
ex
(\a b c ->
al
(\p k ->
k :< ?one :|
(πBound p k $ \πn₀ πn₁ πd ->
eBound p k $ \en₀ en₁ ed ->
cse 3 (a * πn₀ * ed) $ \x₀ ->
cse 3 (a * πn₁ * ed) $ \x₁ ->
cse 3 (b * en₀ * πd) $ \y₀ ->
cse 3 (b * en₁ * πd) $ \y₁ ->
cse 6 (c * πd * ed) $ \z ->
(x₀ + y₀ :< z :& x₁ + y₁ :> z) :|
(x₀ :< y₁ + z :& x₁ :> y₀ + z) :|
(y₀ :< x₁ + z :& y₁ :> x₀ + z))))
main :: IO ()
main = do
print (scoreProp prop)
putStrLn (showProp 0 prop allVars "")
Hãy thử trực tuyến!