{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeAbstractions #-}
{-# OPTIONS_GHC -Wall -Werror -Wno-unused-matches #-}
module Documentation.SBV.Examples.KnuckleDragger.Sqrt2IsIrrational where
import Prelude hiding (even, odd)
import Data.SBV
import Data.SBV.Tools.KnuckleDragger
sqrt2IsIrrational :: IO Proof
sqrt2IsIrrational :: IO Proof
sqrt2IsIrrational = KD Proof -> IO Proof
forall a. KD a -> IO a
runKD (KD Proof -> IO Proof) -> KD Proof -> IO Proof
forall a b. (a -> b) -> a -> b
$ do
let even, odd :: SInteger -> SBool
even :: SInteger -> SBool
even = (Integer
2 Integer -> SInteger -> SBool
`sDivides`)
odd :: SInteger -> SBool
odd = SBool -> SBool
sNot (SBool -> SBool) -> (SInteger -> SBool) -> SInteger -> SBool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SInteger -> SBool
even
sq :: SInteger -> SInteger
sq :: SInteger -> SInteger
sq SInteger
x = SInteger
x SInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
* SInteger
x
oddSquaredIsOdd <- String
-> (Forall "a" Integer -> SBool)
-> (SInteger -> [SBool])
-> [Proof]
-> KD Proof
forall a.
Proposition a =>
String -> a -> (SInteger -> [SBool]) -> [Proof] -> KD Proof
forall steps step a.
(ChainLemma steps step, Proposition a) =>
String -> a -> steps -> [Proof] -> KD Proof
chainLemma String
"oddSquaredIsOdd"
(\(Forall @"a" SInteger
a) -> SInteger -> SBool
odd SInteger
a SBool -> SBool -> SBool
.=> SInteger -> SBool
odd (SInteger -> SInteger
sq SInteger
a))
(\SInteger
a -> let k :: SInteger
k = SInteger
a SInteger -> SInteger -> SInteger
forall a. SDivisible a => a -> a -> a
`sDiv` SInteger
2
in [ SInteger -> SBool
odd SInteger
a
, SInteger -> SInteger
sq SInteger
a SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger -> SInteger
sq (SInteger
2 SInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
* SInteger
k SInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
+ SInteger
1)
, SInteger
a SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
2 SInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
* SInteger
k SInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
+ SInteger
1
])
[]
squareEvenImpliesEven <- lemma "squareEvenImpliesEven"
(\(Forall @"a" SInteger
a) -> SInteger -> SBool
even (SInteger -> SInteger
sq SInteger
a) SBool -> SBool -> SBool
.=> SInteger -> SBool
even SInteger
a)
[oddSquaredIsOdd]
evenSquaredIsMult4 <- chainLemma "evenSquaredIsMult4"
(\(Forall @"a" SInteger
a) -> SInteger -> SBool
even SInteger
a SBool -> SBool -> SBool
.=> Integer
4 Integer -> SInteger -> SBool
`sDivides` SInteger -> SInteger
sq SInteger
a)
(\SInteger
a -> let k :: SInteger
k = SInteger
a SInteger -> SInteger -> SInteger
forall a. SDivisible a => a -> a -> a
`sDiv` SInteger
2
in [ SInteger -> SBool
even SInteger
a
, SInteger -> SInteger
sq SInteger
a SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger -> SInteger
sq (SInteger
k SInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
* SInteger
2)
])
[]
let coPrime :: SInteger -> SInteger -> SBool
coPrime SInteger
x SInteger
y = (Forall "z" Integer -> SBool) -> SBool
forall a. QuantifiedBool a => a -> SBool
quantifiedBool (\(Forall @"z" SInteger
z) -> (SInteger
x SInteger -> SInteger -> SInteger
`sEMod` SInteger
z SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
0 SBool -> SBool -> SBool
.&& SInteger
y SInteger -> SInteger -> SInteger
`sEMod` SInteger
z SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
0) SBool -> SBool -> SBool
.=> SInteger
z SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
1)
lemma "sqrt2IsIrrational"
(\(Forall @"a" SInteger
a) (Forall @"b" SInteger
b) -> ((SInteger -> SInteger
sq SInteger
a SInteger -> SInteger -> SBool
forall a. EqSymbolic a => a -> a -> SBool
.== SInteger
2 SInteger -> SInteger -> SInteger
forall a. Num a => a -> a -> a
* SInteger -> SInteger
sq SInteger
b) SBool -> SBool -> SBool
.=> SBool -> SBool
sNot (SInteger -> SInteger -> SBool
coPrime SInteger
a SInteger
b)))
[squareEvenImpliesEven, evenSquaredIsMult4]