Last active
August 29, 2015 14:05
-
-
Save oakwhiz/5a0d298c023c6b3cdf31 to your computer and use it in GitHub Desktop.
thanks to lspitzner pointing out my simple mistake, this is now a fully working program that generates primes using a method described in GEB
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main where | |
import Data.List (nub, (\\)) | |
import Data.Maybe (mapMaybe, catMaybes) | |
import Control.Applicative | |
import Debug.Hood.Observe | |
data DoesNotDivide = DoesNotDivide Integer Integer deriving (Show,Ord,Eq) | |
data DivisorFree = DivisorFree Integer Integer deriving (Show,Ord,Eq) | |
data Prime = Prime Integer deriving (Show,Ord,Eq) | |
instance Observable DoesNotDivide where | |
observer x parent = observeOpaque (show x) x parent | |
instance Observable DivisorFree where | |
observer x parent = observeOpaque (show x) x parent | |
instance Observable Prime where | |
observer x parent = observeOpaque (show x) x parent | |
-- generating starting points | |
axiomSchema :: Integer -> Integer -> DoesNotDivide | |
axiomSchema x y = DoesNotDivide (x + y) x | |
-- If x doesn't divide into y, then x doesn't divide into x + y either | |
firstRule :: DoesNotDivide -> DoesNotDivide | |
firstRule (DoesNotDivide x y) = DoesNotDivide x (x + y) | |
-- really unsure if valid | |
firstRuleInverse :: DoesNotDivide -> DoesNotDivide | |
firstRuleInverse (DoesNotDivide x y) = DoesNotDivide x (x - y) | |
-- If x doesn't divide into y, and x is 2, then DivisorFree y 2 is a theorem | |
secondRule :: DoesNotDivide -> Maybe DivisorFree | |
secondRule (DoesNotDivide x y) | |
| x == 2 = Just (DivisorFree y 2) | |
| otherwise = Nothing | |
-- seems valid | |
secondRuleInverse :: DivisorFree -> DoesNotDivide | |
secondRuleInverse (DivisorFree x y) = DoesNotDivide y x | |
-- If there are two matching DivisorFree and DoesNotDivide theorems, then you get another DivisorFree theorem | |
thirdRule :: DivisorFree -> DoesNotDivide -> Maybe DivisorFree | |
thirdRule (DivisorFree x y) (DoesNotDivide z w) | |
| y == z - 1 && x == w = Just (DivisorFree w z) | |
| otherwise = Nothing | |
-- unsure if valid | |
thirdRuleInverse :: DivisorFree -> (DivisorFree, DoesNotDivide) | |
thirdRuleInverse (DivisorFree x y) = (DivisorFree x (y - 1), DoesNotDivide y x) | |
-- Some DivisorFree theorems are actually Prime | |
fourthRule :: DivisorFree -> Maybe Prime | |
fourthRule (DivisorFree x y) | |
| x - 1 == y = Just (Prime x) | |
| otherwise = Nothing | |
-- seems valid | |
fourthRuleInverse :: Prime -> DivisorFree | |
fourthRuleInverse (Prime x) = DivisorFree x (x - 1) | |
-- if x is not an element in y then append x to y | |
appendIfNew :: Eq a => a -> [a] -> [a] | |
appendIfNew x y = if x `notElem` y then y ++ [x] else y | |
-- similar to appendIfNew but for lists | |
-- first, eliminate duplicate elements in x | |
-- then eliminate elements in x that are also elements in y | |
-- then append what is left over to y | |
appendIfNew' :: Eq a => [a] -> [a] -> [a] | |
appendIfNew' x y = y ++ filter (`notElem` y) (nub x) | |
type Theorems = (Integer, [DoesNotDivide], [DivisorFree], [Prime]) | |
-- Given the known theorems, use the rules to establish new theorems. | |
evaluateRules :: Theorems -> Theorems | |
evaluateRules (i, x, y, z) = do | |
let x2 = (axiomSchema <$> [1..i] <*> [1..i] ) `appendIfNew'` x | |
let x3 = map firstRule x2 `appendIfNew'` x2 | |
let y2 = mapMaybe secondRule x3 `appendIfNew'` y | |
let y3 = catMaybes (thirdRule <$> y2 <*> x3) `appendIfNew'`y2 | |
let z2 = mapMaybe (observe "fourthRule" fourthRule) y3 `appendIfNew'` z | |
--using inverse rules, generate theorems in reverse | |
--let y4 = map fourthRuleInverse z2 `appendIfNew'` y3 | |
--let x4 = map secondRuleInverse y4 `appendIfNew'` x3 | |
(i + 1, x3, y3, z2) | |
-- Given an older and a newer set of theorems, return only the newly added theorems | |
deltaTheorems :: Theorems -> Theorems -> Theorems | |
deltaTheorems (i, x1, y1, z1) (_, x2, y2, z2) = (i, x2 \\ x1, y2 \\ y1 , z2 \\ z1) | |
-- make the theorems look nice | |
prettyPrint :: Theorems -> IO () | |
prettyPrint (i, x, y, z) = print (show i ++ " " ++ show x ++ " " ++ show y ++ " " ++ show z) | |
-- Examples: | |
-- scanPairs f [] == [] | |
-- scanPairs f [1] == [f 1 1] | |
-- scanPairs f [1, 2] == [f 1 2] | |
-- scanPairs f [1, 2, 3, 4, 5] == [f 1 2, f 2 3, f 3 4, f 4 5] | |
scanPairs :: (a -> a -> b) -> [a] -> [b] | |
scanPairs _ [] = [] | |
scanPairs f [x] = [f x x] | |
scanPairs f (x:xs) = f x (head xs) : scanPairs f xs | |
main :: IO() | |
main = runO $ foldr ((>>) . prettyPrint) (return ()) $ | |
(scanPairs deltaTheorems ((0,[],[],[]):(iterate evaluateRules (0, [DoesNotDivide 5 2], [], [Prime 2])))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment