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))))))))))))))))))))))))))
Cómo funciona
Primero, multiplíquelo por los supuestos denominadores comunes de a y (π + e · a) para reescribir la condición como: existen a, b, c ∈ ℕ (no todos cero) con a · π + b · e = c o a · π - b · e = c o −a · π + b · e = c. Son necesarios tres casos para tratar los problemas de signos.
Luego, tendremos que reescribir esto para hablar sobre π y e mediante aproximaciones racionales: para todas las aproximaciones racionales π₀ <π <π₁ y e₀ <e <e₁, tenemos a · π₀ + b · e₀ <c <a · π₁ + b · e₁ o a · π₀ - b · e₁ <c <a · π₁ + b · e₀ o −a · π₁ + b · e₀ <c <−a · π₀ + b · e₁. (Tenga en cuenta que ahora obtenemos la condición "no todo cero" de forma gratuita).
Ahora para la parte difícil. ¿Cómo obtenemos estas aproximaciones racionales? Queremos usar fórmulas como
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 ,
pero no hay una forma obvia de escribir las definiciones iterativas de estos productos. Así que construimos un poco de maquinaria que describí por primera vez en esta publicación de Quora . Definir:
divide (d, a): = ∃b, a = d · b,
powerOfPrime (a, p): = ∀b, ((b> 1 y divide (b, a)) ⇒ divide (p, b)),
que se satisface si a = 1, o p = 1, o p es primo y a es una potencia de él. Luego
isDigit (a, s, p): = a <p y ∃b, (powerOfPrime (b, p) y ∃qr, (r <b y s = (p · q + a) · b + r))
se satisface si a = 0, o a es un dígito del número base-p s. Esto nos permite representar cualquier conjunto finito utilizando los dígitos de algún número base-p. Ahora podemos traducir cálculos iterativos al escribir, aproximadamente, existe un conjunto de estados intermedios de tal manera que el estado final está en el conjunto, y cada estado en el conjunto es el estado inicial o sigue en un paso desde algún otro estado en el conjunto.
Los detalles están en el código a continuación.
Generando código en Haskell
{-# 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 "")
Pruébalo en línea!