summaryrefslogtreecommitdiff
path: root/src/Fractran
diff options
context:
space:
mode:
Diffstat (limited to 'src/Fractran')
-rw-r--r--src/Fractran/Example.hs46
-rw-r--r--src/Fractran/Interpreter.hs29
-rw-r--r--src/Fractran/Parser.hs68
-rw-r--r--src/Fractran/Test.hs53
4 files changed, 196 insertions, 0 deletions
diff --git a/src/Fractran/Example.hs b/src/Fractran/Example.hs
new file mode 100644
index 0000000..43d8cc8
--- /dev/null
+++ b/src/Fractran/Example.hs
@@ -0,0 +1,46 @@
+module Fractran.Example (
+ addition,
+ multiply,
+ prime2,
+ prime10short,
+ prime10) where
+
+
+import Fractran.Parser
+
+
+
+
+-- some simple fractran programs
+
+
+-- these ones need an initial input added of the appropriate form
+
+-- input: 2^a * 3^b
+-- output: 3^(a+b)
+addition :: [(Int,Int)]
+addition = [(3,2)]
+
+-- input: 2^a * 3^b
+-- output: 5^ab
+multiply :: [(Int,Int)]
+multiply = [(13,21), (385,13), (1,7), (3,11), (7,2), (1,3)]
+
+
+
+
+-- these ones are already in ready to interpret, FractranProgram form
+
+-- input: 2
+-- output: a sequence containing all prime powers of 2
+prime2 :: FractranProgram
+prime2 = FractranProgram [(17,91), (78,85), (19,51), (23,38), (29,33), (77,29), (95,23), (77,19), (1,17), (11,13), (13,11), (15,14), (15,2), (55,1)] 2
+
+-- input: 10
+-- output: a sequence containing all prime powers of 10
+prime10short :: FractranProgram
+prime10short = FractranProgram [(3,11), (847,45), (143,6), (7,3), (10,91), (3,7), (36,325), (1,2), (36,5)] 10
+
+prime10 :: FractranProgram
+prime10 = FractranProgram [(7,3), (99,98), (13,49), (39,35), (36,91), (10,143), (49,13), (7,11), (1,2), (91,1)] 10
+
diff --git a/src/Fractran/Interpreter.hs b/src/Fractran/Interpreter.hs
new file mode 100644
index 0000000..1393991
--- /dev/null
+++ b/src/Fractran/Interpreter.hs
@@ -0,0 +1,29 @@
+module Fractran.Interpreter (
+ fractran
+ ) where
+
+
+import Fractran.Parser
+
+
+
+
+fractran :: FractranProgram -> [Int]
+fractran program =
+ let prog = map (\(x,y) -> (fromIntegral x, fromIntegral y)) (fractions program)
+ f = (\p v -> if (p == [])
+ then []
+ else let (curX, curY) = head p
+ newV = v * curX / curY
+ in if (isInt newV)
+ then newV : (f prog newV)
+ else f (tail p) v)
+ result = map round (f prog (fromIntegral (initialValue program)))
+ in (initialValue program) : result
+
+
+
+isInt :: (RealFrac a) => a -> Bool
+isInt x =
+ x == fromInteger (round x)
+
diff --git a/src/Fractran/Parser.hs b/src/Fractran/Parser.hs
new file mode 100644
index 0000000..95aa954
--- /dev/null
+++ b/src/Fractran/Parser.hs
@@ -0,0 +1,68 @@
+module Fractran.Parser (
+ FractranProgram(..),
+
+ parseFractran
+ ) where
+
+
+import Control.Applicative( some )
+import Text.ParserCombinators.Parsec
+
+
+
+data FractranProgram = FractranProgram { fractions :: [(Int,Int)]
+ , initialValue :: Int }
+ deriving (Show, Eq)
+
+
+
+
+parseFractran :: String -> Either ParseError FractranProgram
+parseFractran = parse fractran "error"
+
+
+
+
+fractran = do
+ whiteSpace
+ value <- initVal
+ fractionList <- many intPair
+ eof
+ return (FractranProgram fractionList value)
+
+
+intPair = do
+ numerator <- wholeNumber
+ slash
+ denominator <- positiveNumber
+ whiteSpace
+ return (numerator,denominator)
+
+
+slash = char '/'
+ <?> "slash character"
+
+
+initVal = do
+ value <- wholeNumber
+ whiteSpace
+ return value
+
+
+wholeNumber = do
+ value <- some digit
+ return (read value)
+
+
+positiveNumber = do
+ firstDigit <- nonZeroDigit
+ rest <- many digit
+ return (read (firstDigit:rest))
+
+
+nonZeroDigit = oneOf "123456789"
+ <?> "non-zero digit"
+
+
+whiteSpace = many (oneOf "\t\n\r ")
+
diff --git a/src/Fractran/Test.hs b/src/Fractran/Test.hs
new file mode 100644
index 0000000..2b507b1
--- /dev/null
+++ b/src/Fractran/Test.hs
@@ -0,0 +1,53 @@
+module Fractran.Test (
+ parserTests,
+ interpreterTests,
+ tests
+ ) where
+
+
+import Test.HUnit
+import Text.Parsec.Error
+import Fractran.Parser
+import Fractran.Interpreter
+import Fractran.Example
+
+
+instance Eq Text.Parsec.Error.ParseError
+
+
+
+
+parser0 = (Right (FractranProgram [] 2)) ~=? (parseFractran "2")
+
+parser1 = (Right (FractranProgram [] 2)) ~=? (parseFractran "2\n")
+
+parser2 = (Right (FractranProgram [] 2)) ~=? (parseFractran "\n2")
+
+parser3 = (Right (FractranProgram [(1,2)] 2)) ~=? (parseFractran "2 1/2")
+
+parser4 = (Right (FractranProgram [(2,3)] 3)) ~=? (parseFractran "3\n \n2/3\n")
+
+
+
+interpreter0 = [108,162,243] ~=? (fractran (FractranProgram addition 108))
+
+interpreter1 = [2,15,825,725,1925,2275,425,390,330,290,770,910,170,156,132,116,308,364,68,4] ~=? (take 20 (fractran prime2))
+
+interpreter2 = [5] ~=? (fractran (FractranProgram addition 5))
+
+
+
+parserTests :: Test
+parserTests = TestList [parser0, parser1,parser2, parser3, parser4]
+
+
+
+interpreterTests :: Test
+interpreterTests = TestList [interpreter0, interpreter1, interpreter2]
+
+
+
+tests :: Test
+tests = case (parserTests, interpreterTests) of
+ (TestList a, TestList b) -> TestList (a ++ b)
+