commit ff5e7cf58e45d46a6b6bd5ac67549a007df2e01c Author: Collin J. Doering Date: Fri Apr 4 02:22:17 2014 -0400 Initial commit Signed-off-by: Collin J. Doering diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b25c15b --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +*~ diff --git a/Arduino/rdm.pde b/Arduino/rdm.pde new file mode 100644 index 0000000..a52017c --- /dev/null +++ b/Arduino/rdm.pde @@ -0,0 +1,30 @@ +/** + * (C) Copyright Collin Doering @!@YEAR@!@ + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . +*/ + +/** + * File: rdm.pde + * Author: Collin J. Doering + * Date: Jan 23, 2014 + */ + +void setup() { + // run once at power on +} + +void loop() { + // run over and over until power off +} diff --git a/Assembly/rdm.asm b/Assembly/rdm.asm new file mode 100644 index 0000000..bf289a1 --- /dev/null +++ b/Assembly/rdm.asm @@ -0,0 +1,18 @@ +;; (C) Copyright Collin Doering 2011 +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; File: rdm.asm +;; Author: Collin J. Doering +;; Date: Mar 22, 2012 diff --git a/C/test.c b/C/test.c new file mode 100644 index 0000000..dbdac49 --- /dev/null +++ b/C/test.c @@ -0,0 +1,26 @@ +/** + * (C) Copyright Collin Doering 2012 + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . +*/ + +/** + * File: test.c + * Author: Collin J. Doering + * Date: Jun 27, 2012 + */ + +int main () { + return 0; +} diff --git a/Clojure/rdm.clj b/Clojure/rdm.clj new file mode 100644 index 0000000..957a110 --- /dev/null +++ b/Clojure/rdm.clj @@ -0,0 +1,13 @@ +;; File: rdm.clj +;; Author: Collin J. Doering +;; Description: A rdm file for playing around with + +(map (fn [x] (* x x)) '(0 1 2 3 4 5)) + +;; Example factorial function with accumulator (tail call) +(defn factorial + ([n] + (factorial n 1)) + ([n acc] + (if (= n 0) acc + (recur (dec n) (* acc n))))) diff --git a/Coffee-Script/rdm.coffee b/Coffee-Script/rdm.coffee new file mode 100644 index 0000000..66be63f --- /dev/null +++ b/Coffee-Script/rdm.coffee @@ -0,0 +1,18 @@ +square = (x) -> x * x +cube = (x) -> x * x * x + +map = (f, xs) -> f x for x in xs + +map square, [1..10] + +foldr = (f, i, xs) -> + result = i + for x in xs + result = f x, result + result + +foldr ((a, b) -> a + b), 0, [1..10] + +factorial = (n) -> foldr ((a, b) -> a * b), 1, [1..n] + +factorial n for n in [1..10] diff --git a/Erlang/rdm.erl b/Erlang/rdm.erl new file mode 100644 index 0000000..70cfc0b --- /dev/null +++ b/Erlang/rdm.erl @@ -0,0 +1,20 @@ +% (C) Copyright Collin Doering 2012 +% +% This program is free software: you can redistribute it and/or modify +% it under the terms of the GNU General Public License as published by +% the Free Software Foundation, either version 3 of the License, or +% (at your option) any later version. +% +% This program is distributed in the hope that it will be useful, +% but WITHOUT ANY WARRANTY; without even the implied warranty of +% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +% GNU General Public License for more details. +% +% You should have received a copy of the GNU General Public License +% along with this program. If not, see . + +% File: rdm.erl +% Author: Collin J. Doering +% Date: Jun 27, 2012 + +% setup emacs for erlang (don't really know it tho) diff --git a/Haskell/BinaryTree.hs b/Haskell/BinaryTree.hs new file mode 100644 index 0000000..0b53e3b --- /dev/null +++ b/Haskell/BinaryTree.hs @@ -0,0 +1,78 @@ +-- File: BinaryTree.hs +-- Date: Oct 28, 2011 +-- Author: Collin J. Doering +-- Descpription: + +module BinaryTree + ( + Tree, + search, + balanced, + node, + leaf + ) where + +-- A Tree reprents a binary tree +data Tree a = Empty + | Node a (Tree a) (Tree a) + deriving (Show, Eq) + +instance Ord a => Ord (Tree a) where + _ >= Empty = True + (Node x _ _) >= (Node y _ _) = x >= y + + _ <= Empty = True + (Node x _ _) <= (Node y _ _) = x <= y + + _ < Empty = False + (Node x _ _) < (Node y _ _) = x < y + + _ > Empty = True + (Node x _ _) > (Node y _ _) = x > y + +instance Functor Tree where + fmap _ Empty = Empty + fmap f (Node x ls rs) = Node (f x) (fmap f ls) (fmap f rs) + +leaf :: a -> Tree a +leaf x = Node x Empty Empty + +-- node a b c = Node a b c where the ording defined by binary trees is enforced +node :: Ord a => a -> Tree a -> Tree a -> Tree a +node i Empty Empty = leaf i +node i nd@(Node x _ _) md@(Node y _ _) + | x <= i && y >= i = Node i nd md + | otherwise = Empty + +balanced :: Ord a => Tree a -> Bool +balanced Empty = True +balanced x@(Node _ ls rs) = let y = x >= ls && x <= rs in + y `seq` (y && balanced ls && balanced rs) + +-- after further thinking decided not to implement a lookup +-- function because of how pointless it would be; reasons +-- being that the lookup would be O(n^2) vs O(n) that +-- association lists provide. Considered implementing a +-- searchP :: Ord a => (a -> Bool) -> Tree a -> Maybe a +-- but again could be only implemented in O(n^2) and is +-- pretty much the same idea as lookupTree +--lookupTree :: Ord a => (a -> Bool) -> Tree a -> Maybe a + +depth :: Tree a -> Int +depth Empty = 0 +depth (Node _ ls rs) = 1 + max (depth ls) (depth rs) + +put :: Ord a => a -> Tree a -> Tree a +put i Empty = leaf i +put i (Node x ls rs) + | i > x = Node x ls (put i rs) + | i < x = Node x (put i ls) rs + | otherwise = Node x (Node i ls Empty) rs + +-- Assumes a proper binary tree; thatis balanced node = True +search :: Ord a => a -> Tree a -> Bool +search _ Empty = False +search i (Node x ls rs) + | i > x = search i rs + | i < x = search i ls + | otherwise = True diff --git a/Haskell/EchoClient b/Haskell/EchoClient new file mode 100755 index 0000000..43eaabd Binary files /dev/null and b/Haskell/EchoClient differ diff --git a/Haskell/EchoClient.hs b/Haskell/EchoClient.hs new file mode 100644 index 0000000..69ceff3 --- /dev/null +++ b/Haskell/EchoClient.hs @@ -0,0 +1,32 @@ +-- (C) Copyright Collin Doering 2011 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: EchoClient.hs +-- Author: Collin J. Doering +-- Date: Nov 3, 2011 + +import Network +import System.IO + +main = withSocketsDo $ do + h <- connectTo "localhost" (PortNumber 3556) + putStrLn "Enter a string to for the server to echo (press C-d when done): " + str <- getContents + hPutStrLn h str + hFlush h + putStrLn "Sent the given message to the echo server.." + res <- hGetLine h + putStrLn ("Server responded: \"" ++ res ++ "\"") + hClose h diff --git a/Haskell/EchoServer.hs b/Haskell/EchoServer.hs new file mode 100644 index 0000000..b91843a --- /dev/null +++ b/Haskell/EchoServer.hs @@ -0,0 +1,52 @@ +-- (C) Copyright Collin Doering 2011 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: EchoServer.hs +-- Author: Collin J. Doering +-- Date: Nov 3, 2011 + +import Network +import System.IO +import Control.Concurrent + +handleRequest :: Handle -> HostName -> PortNumber -> IO () +handleRequest handle host port = do + putStrLn $ "Recieved connection from " ++ host ++ " on port " ++ show port + response <- hGetLine handle + putStrLn $ "Recieved data \"" ++ response ++ "\" from client; echoing.." + hPutStrLn handle response + hClose handle + +listenRec :: Socket -> IO () +listenRec s = do + (handle, host, port) <- accept s + forkIO $ handleRequest handle host port + listenRec s + +main :: IO () +main = withSocketsDo $ do + socket <- listenOn (PortNumber 3556) + putStrLn "EchoServer started on port 3556" + listenRec socket + +-- main = withSocketsDo $ do +-- sock <- listenOn (PortNumber 3556) +-- (h,host,port) <- accept sock +-- putStrLn ("Recieved connection from " ++ host ++ " on port " ++ show(port)) +-- res <- hGetLine h +-- putStrLn ("Recieved data " ++ res ++ " from client; echoing..") +-- hPutStrLn h res +-- hClose h +-- sClose sock diff --git a/Haskell/Expressions.hs b/Haskell/Expressions.hs new file mode 100644 index 0000000..70c5a42 --- /dev/null +++ b/Haskell/Expressions.hs @@ -0,0 +1,41 @@ +-- (C) Copyright Collin Doering 2011 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: Expressions.hs +-- Author: Collin J. Doering +-- Date: Nov 11, 2011 + +type Symbol = Char + +data Expr a = Const a + | Add (Expr a) (Expr a) + | Mult (Expr a) (Expr a) + | Pow (Expr a) (Expr a) + | Var Symbol + deriving (Show) + +-- this has to be done with a parser.. + +-- simplifyExpr :: Num a => Expr a -> Expr a +-- simplifyExpr (Const a) = Const a +-- simplifyExpr (Add x y) = addExpr x y +-- simplifyExpr (Mult x y) = multExpr x y +-- simplifyExpr (Pow x y) = powExpr x y +-- simplifyExpr (Var x) = Var x +-- where addExpr (Const x) (Const y) = Const (x + y) +-- addExpr x y = Add (simplifyExpr x) (simplifyExpr y) +-- multExpr (Const x) (Const y) = Const (x * y) +-- multExpr (Const x) (Var y) = .. +-- dead end..stuck..don't know how to do this :( diff --git a/Haskell/InfixExpressions.hs b/Haskell/InfixExpressions.hs new file mode 100644 index 0000000..45178be --- /dev/null +++ b/Haskell/InfixExpressions.hs @@ -0,0 +1,74 @@ +-- (C) Copyright Collin Doering 2012 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: InfixExpressions.hs +-- Author: Collin J. Doering +-- Date: Jul 7, 2012 + +module Main where + +import Control.Monad +import Text.ParserCombinators.Parsec +import Data.Char (digitToInt) + +data Expression = Expr Char Expression Expression + | Number Integer + +instance Show Expression where + show expr = show $ evalInfixExpr expr + +evalInfixExpr :: Expression -> Integer +evalInfixExpr (Number a) = a +evalInfixExpr (Expr op a b) = case op of + '+' -> (evalInfixExpr a) + (evalInfixExpr b) + '-' -> (evalInfixExpr a) - (evalInfixExpr b) + '*' -> (evalInfixExpr a) * (evalInfixExpr b) +-- '/' -> (evalInfixExpr a) / (evalInfixExpr b) + +parseInfixExpr :: Parser Expression +parseInfixExpr = do x <- (parseBracketedInfixExpr <|> parseNumber + "number or expression") + spaces + c <- oneOf "+-*") + y <- (parseBracketedInfixExpr <|> parseNumber + "number or expression") + (try newline >> (return $ Expr c x y)) + <|> liftM (Expr c x) (parseBracketedInfixExpr <|> parseNumber) + +parseNumber :: Parser Expression +parseNumber = do spaces + x <- many1 digit + return $ Number (read x :: Integer) + +parseOperator :: Parse Expression +parseOperator = do spaces + c <- oneOf "+-*" + case c of + '*' -> liftM (Expr '*' + +parseBracketedInfixExpr :: Parser Expression +parseBracketedInfixExpr = do try spaces + char '(' + try spaces + x <- try parseInfixExpr <|> parseNumber + try spaces + char ')' + return x + +main :: IO () +main = do ln <- getLine + case parse parseInfixExpr "infix expr" ln of + Left err -> error "Parser Error!" + Right val -> putStrLn $ show val \ No newline at end of file diff --git a/Haskell/PostFixExpressions.hs b/Haskell/PostFixExpressions.hs new file mode 100644 index 0000000..1c75753 --- /dev/null +++ b/Haskell/PostFixExpressions.hs @@ -0,0 +1,120 @@ +-- (C) Copyright Collin Doering 2012 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: PostFixExpressions.hs +-- Author: Collin J. Doering +-- Date: Jul 8, 2012 + +import Control.Monad +import Data.Monoid +import Text.ParserCombinators.Parsec + +data Expression a = Number a + | Operator Char (a -> a -> a) + +instance Show a => Show (Expression a) where + show (Number a) = show a + show (Operator c _) = show c + +data Stack a = Stack [Expression a] + +instance Show a => Show (Stack a) where + show (Stack [x]) = show x + show (Stack (x:xs)) = show x ++ " " ++ show (Stack xs) + +-- takes a properly formatted Stack to compute the value of the postfix expression +eval :: (Stack a) -> a +eval (Stack xs) = evaluate xs [] + +evaluate :: [Expression a] -> [Expression a] -> a +evaluate [] [(Number acc)] = acc +evaluate [] _ = error "Cannot evaluate, leftover operator!" +evaluate [(Number a)] [] = a +evaluate [(Operator _ _)] [] = error "Cannot evaluate, leftover operator!" +evaluate (x@(Number _):xs) acc = evaluate xs (acc ++ [x]) +evaluate (x@(Operator c f):xs) ((Number a):(Number b):ys) = evaluate xs $ (Number (f b a)):ys +evaluate ((Operator _ _):xs) _ = error "Cannot evaluate, leftover operator!" + +parseNumber :: Parser (Expression Float) +parseNumber = try parseFloat + <|> parseInt + +parseInt :: Parser (Expression Float) +parseInt = do x <- many1 digit + return $ Number (read x :: Float) + +parseFloat :: Parser (Expression Float) +parseFloat = do x <- many1 digit + char '.' + y <- many1 digit + return $ Number (read (x ++ "." ++ y) :: Float) + +parseOperator :: Parser (Expression Float) +parseOperator = do c <- oneOf "+-*/^" + case c of + '+' -> return $ Operator '+' (+) + '-' -> return $ Operator '-' (-) + '*' -> return $ Operator '*' (*) + '/' -> return $ Operator '/' (/) + '^' -> return $ Operator '^' (**) + otherwise -> error $ "Unknown operator \'" ++ [c] ++ "\'" + +parsePostfixExpr :: Parser (Stack Float) +parsePostfixExpr = do a <- parseNumber + spaces + b <- parseNumber + spaces + xs <- sepBy (parseNumber <|> parseOperator) spaces + return $ Stack $ a:b:xs + +-- instance Monoid (Expression a) where +-- mempty = Number [] + +-- mappend (Number xs) (Number ys) = Number $ xs ++ ys +-- mappend (Value x) (Number ys) = Number $ x:ys +-- mappend (Number xs) (Value y) = Number $ y:xs +-- mappend (Value x) (Value y) = Number $ [x,y] + +-- sepBy2 p sep = p >>= \x -> do xs <- many1 p +-- return $ x:xs + +-- parseNumber :: Parser (Expression Float) +-- parseNumber = do x <- many1 digit +-- (try $ char '.' >> do y <- many1 digit +-- return $ Value (read (x ++ y) :: Float)) +-- <|> (return $ Value (read x :: Float)) + +-- --parseManyNumbers :: Parser +-- --parseManyNumbers st = liftM mconcat $ sepBy2 parseNumber spaces st + +-- --parseOperator :: (Expression a) -> Parser (Expression a) +-- parseOperator st = do op <- oneOf "+-*/" +-- return $ mappend (Value $ apply op (stk !! 1) (stk !! 0)) $ Number $ drop 2 stk +-- where numberStk (Number xs) = xs +-- numberStk (Value x) = [x] +-- stk = numberStk st +-- apply '*' a b = a * b +-- apply '/' a b = a / b +-- apply '+' a b = a + b +-- apply '-' a b = a - b + +-- -- parsePostfixExpr :: Parser (Expression a) +-- -- parsePostfixExpr = do xs <- parseManyNumbers mempty +-- -- ys <- parseOperator xs +-- -- many (parseManyNumbers ys <|> parseOperator ys) + +-- -- many1 (parseManyNumbers +-- -- >>= parseOperator) <|> eof + diff --git a/Haskell/Quine/Quin2 b/Haskell/Quine/Quin2 new file mode 100755 index 0000000..3c1c959 Binary files /dev/null and b/Haskell/Quine/Quin2 differ diff --git a/Haskell/Quine/Quine b/Haskell/Quine/Quine new file mode 100755 index 0000000..c4f35ba Binary files /dev/null and b/Haskell/Quine/Quine differ diff --git a/Haskell/Quine/Quine.hi b/Haskell/Quine/Quine.hi new file mode 100644 index 0000000..591adf3 Binary files /dev/null and b/Haskell/Quine/Quine.hi differ diff --git a/Haskell/Quine/Quine.hs b/Haskell/Quine/Quine.hs new file mode 100644 index 0000000..87803f3 --- /dev/null +++ b/Haskell/Quine/Quine.hs @@ -0,0 +1,44 @@ +-- (C) Copyright Collin Doering 2013 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: Quine.hs +-- Author: Collin J. Doering +-- Date: Apr 14, 2013 + +import Data.List (intercalate) + +header = [ "-- (C) Copyright Collin Doering 2013" + , "-- " + , "-- This program is free software: you can redistribute it and/or modify" + , "-- it under the terms of the GNU General Public License as published by" + , "-- the Free Software Foundation, either version 3 of the License, or" + , "-- (at your option) any later version." + , "-- " + , "-- This program is distributed in the hope that it will be useful," + , "-- but WITHOUT ANY WARRANTY; without even the implied warranty of" + , "-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the" + , "-- GNU General Public License for more details." + , "-- " + , "-- You should have received a copy of the GNU General Public License" + , "-- along with this program. If not, see ." + , "" + , "-- File: haskell-quine.hs" + , "-- Author: Collin J. Doering " + , "-- Date: Apr 14, 2013" + , "" + , "import Data.List (intercalate)"] + +dta = "main = putStrLn $ intercalate \"\\n\" header ++ \"\\n\\nheader = \" ++ \"[ \\\"\" ++ intercalate \"\\\"\\n , \\\"\" header ++ \"\\\"]\" ++ \"\\n\\ndta = \" ++ show dta ++ \"\\n\" ++ dta" +main = putStrLn $ intercalate "\n" header ++ "\n\nheader = " ++ "[ \"" ++ intercalate "\"\n , \"" header ++ "\"]" ++ "\n\ndta = " ++ show dta ++ "\n" ++ dta diff --git a/Haskell/Quine/Quine.o b/Haskell/Quine/Quine.o new file mode 100644 index 0000000..8396de7 Binary files /dev/null and b/Haskell/Quine/Quine.o differ diff --git a/Haskell/Quine/haskell-quine-small b/Haskell/Quine/haskell-quine-small new file mode 100755 index 0000000..411f374 Binary files /dev/null and b/Haskell/Quine/haskell-quine-small differ diff --git a/Haskell/Quine/haskell-quine-small.hi b/Haskell/Quine/haskell-quine-small.hi new file mode 100644 index 0000000..3172696 Binary files /dev/null and b/Haskell/Quine/haskell-quine-small.hi differ diff --git a/Haskell/Quine/haskell-quine-small.hs b/Haskell/Quine/haskell-quine-small.hs new file mode 100644 index 0000000..27beb81 --- /dev/null +++ b/Haskell/Quine/haskell-quine-small.hs @@ -0,0 +1,2 @@ +a = "main = putStrLn $ \"a = \" ++ show a ++ \"\\n\" ++ a" +main = putStrLn $ "a = " ++ show a ++ "\n" ++ a diff --git a/Haskell/Quine/haskell-quine-small.o b/Haskell/Quine/haskell-quine-small.o new file mode 100644 index 0000000..034639d Binary files /dev/null and b/Haskell/Quine/haskell-quine-small.o differ diff --git a/Haskell/StringParse.hs b/Haskell/StringParse.hs new file mode 100644 index 0000000..a00238b --- /dev/null +++ b/Haskell/StringParse.hs @@ -0,0 +1,67 @@ +-- File: StringParse.hs +-- Date: Oct 26, 2011 +-- Author: Collin J. Doering +-- Description: This is a test file in haskell implementing a simple base monadic parser + +import Monad + +-- parser as layed out by Programming in Haskell +newtype Parser a = Parser (String -> [(a, String)]) + +-- Parser as layed out by RealWorldHaskell +-- import qualified Data.ByteString.Lazy as L +-- data ParseState = ParseState { +-- string :: String +-- offset :: Integer +-- } + +-- newtype Parser a = Parser { +-- runParse :: ParseState -> Either String (a, ParseState) +-- } + +instance Monad Parser where + return v = Parser (\inp -> [(v,inp)]) + p >>= q = Parser (\inp -> case parse p inp of + [] -> [] + [(v,out)] -> parse (q v) out) + +instance MonadPlus Parser where + mzero = Parser (\inp -> []) + mplus p q = Parser (\inp -> case parse p inp of + [] -> parse q inp + [(v,out)] -> [(v,out)]) + +failure :: Parser a +failure = Parser (\xs -> []) + +item :: Parser Char +item = Parser (\inp -> case inp of + [] -> [] + (x:xs) -> [(x,xs)]) + +parseWhile :: (a -> Bool) -> Parser a -> Parser a +parseWhile f (Parser p) = Parser $ \inp -> do + x <- item + if f x then parse p else failure + +identity :: Parser Char +identity = Parser $ \inp -> [] + +parse :: Parser a -> String -> [(a,String)] +parse (Parser p) inp = p inp + +p :: Parser (Char, Char) +p = do + x <- item + item + y <- item + return (x,y) + +takeOneLeaveOne :: Parser Char +takeOneLeaveOne = do + x <- item + item + return x + +--takeEveryOther :: Parser String + \ No newline at end of file diff --git a/Haskell/echoclient b/Haskell/echoclient new file mode 100755 index 0000000..64daa68 Binary files /dev/null and b/Haskell/echoclient differ diff --git a/Haskell/echoserve b/Haskell/echoserve new file mode 100755 index 0000000..4e01a7b Binary files /dev/null and b/Haskell/echoserve differ diff --git a/Haskell/helloworld.hs b/Haskell/helloworld.hs new file mode 100644 index 0000000..9e90119 --- /dev/null +++ b/Haskell/helloworld.hs @@ -0,0 +1,26 @@ +-- File: helloworld.hs +-- Author: Collin J. Doering +-- Date: May 31, 2012 +-- Description: Example code from O'Reilly Yesod book + +{-# LANGUAGE TypeFamilies, QuasiQuotes, MultiParamTypeClasses, + TemplateHaskell, OverloadedStrings #-} +import Yesod + +data HelloWorld = HelloWorld + +mkYesod "HelloWorld" [parseRoutes| +/ HomeR GET +|] + +instance Yesod HelloWorld + +getHomeR :: Handler RepHtml +getHomeR = defaultLayout [whamlet| +

this is a test paragraph. And here is some variable interpolation:
+#{testvar} +|] + where testvar = "here is a var!" :: String + +main :: IO () +main = warpDebug 3000 HelloWorld diff --git a/Haskell/lin-alg/Matrix.hs b/Haskell/lin-alg/Matrix.hs new file mode 100644 index 0000000..2d70724 --- /dev/null +++ b/Haskell/lin-alg/Matrix.hs @@ -0,0 +1,121 @@ +-- (C) Copyright Collin Doering 2014 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: Matrix.hs +-- Author: Collin J. Doering +-- Date: Feb 5, 2014 + +-- Inspired by Coursera class "Coding the Matrix" + +-- | This modules represents a Matrix +module Matrix where + +import Vector +import qualified Data.Map.Strict as M +import Data.Maybe (fromMaybe,fromJust) + +-- | A data structure that represents a Matrix +data Matrix a = Matrix { unmatrix :: M.Map Integer (Vector a) } + +instance Show a => Show (Matrix a) where + show (Matrix m) = M.foldr (\x y -> drop 7 (show x) ++ "\n" ++ y) "" m + +instance Functor Matrix where + fmap f (Matrix m) = Matrix $ M.foldrWithKey (\k v y -> M.insert k (fmap f v) y) M.empty m + +-- | +matrixFromList :: Num a => [[a]] -> Matrix a +matrixFromList xs = Matrix $ foldr (\(k,v) y -> if length v == dim then + M.insert k (fromList v) y + else error "Error! The rows of the matrix must be the same length.") M.empty $ zip [1..] xs + where dim = length . head $ xs + +-- | +matrixElemAt :: Num a => Integer -> Integer -> Matrix a -> Maybe a +matrixElemAt i j (Matrix m) + | i >= 1 && + j >= 1 && + i <= toInteger (M.size m) = M.lookup j (unvector $ fromJust $ M.lookup i m) + | otherwise = Nothing + +-- | +-- columnVector :: Num a => Integer -> Matrix a -> Vector a +columnVector j m@(Matrix m') + | j <= snd (matrixSize m) = Vector $ M.foldrWithKey (\k x y -> M.insert k (fromJust $ M.lookup j (unvector x)) y) M.empty m' + | otherwise = error "Internal Error" + +-- matrixSize :: Num a => Matrix a -> (Integer,Integer) +matrixSize (Matrix m) = (toInteger $ M.size m, toInteger $ M.size $ unvector $ fromJust $ M.lookup 1 m) + +-- | +-- binOpMatrix :: Num a => ((Int,Int) -> (Int,Int) -> Bool) -> (a -> a -> a) -> Matrix a -> Matrix a -> Matrix a +binOpMatrix p e f (Matrix m1) (Matrix m2) + | p (fromMaybe (error "Internal Error") $ M.lookup 1 m1, M.size m1) + (fromMaybe (error "Internal Error") $ M.lookup 1 m2, M.size m2) = undefined + | otherwise = error e + +-- | +transposeMatrix :: Num a => Matrix a -> Matrix a +-- transposeMatrix m@(Matrix m1) = Matrix $ M.foldrWithKey (\k _ y -> M.insert k (columnVector k m) y) M.empty m1 +transposeMatrix m@(Matrix m') = let (_,j) = matrixSize m + in Matrix $ foldr (\k y -> M.insert k (columnVector k m) y) M.empty [1..j] + +-- | +scalarMultMatrix :: Num a => a -> Matrix a -> Matrix a +scalarMultMatrix a m = fmap (scalarMultVector a) m + +-- | +-- multMatrix :: Num a => Matrix a -> Matrix a -> Matrix a +multMatrix (Matrix m1) n@(Matrix m2) + | (M.size . unvector $ + fromMaybe (error "Error! Cannot multiply matrices with given dimension.") $ + M.lookup 1 m1) == M.size m2 = Matrix $ + M.foldrWithKey (\k x y -> M.insert k (Vector $ + M.foldrWithKey (\k' x' y' -> M.insert k' (dotVector x x') y') M.empty (unmatrix $ transposeMatrix n)) y) M.empty m1 + | otherwise = error "Internal Error" + +-- multMatrix m@(Matrix m') n@(Matrix n') = let mSize = matrixSize m +-- nSize = matrixSize m +-- canMult (_,a) (b,_) = a == b + + +-- multMatrix = binOpMatrix (\(_,a) (b,_) -> a == b) (\(Matri + +-- | +crossProductMatrix :: Num a => Matrix a -> Matrix a -> Matrix a +crossProductMatrix = undefined + +-- | +addMatrix :: Num a => Matrix a -> Matrix a -> Matrix a +addMatrix = undefined +-- addMatrix = binOpMatrix (\(a,b) (c,d) -> a == c && b == d) "Error! Cannot add matrices with different dimensions." (+) + +(<+>) :: Num a => Matrix a -> Matrix a -> Matrix a +(<+>) = addMatrix + +-- | +subMatrix :: Num a => Matrix a -> Matrix a -> Matrix a +subMatrix = undefined + +(<->) :: Num a => Matrix a -> Matrix a -> Matrix a +(<->) = subMatrix + +-- | +rowEchelonForm :: Num a => Matrix a -> Matrix a +rowEchelonForm = undefined + +-- | +reducedRowEchelonForm :: Num a => Matrix a -> Matrix a +reducedRowEchelonForm = undefined diff --git a/Haskell/lin-alg/Test.hs b/Haskell/lin-alg/Test.hs new file mode 100644 index 0000000..4c5eada --- /dev/null +++ b/Haskell/lin-alg/Test.hs @@ -0,0 +1,23 @@ +-- (C) Copyright Collin Doering 2014 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: Test.hs +-- Author: Collin J. Doering +-- Date: Feb 5, 2014 + +import Vector +import Matrix +import Test.QuickCheck + diff --git a/Haskell/lin-alg/Vector.hs b/Haskell/lin-alg/Vector.hs new file mode 100644 index 0000000..f006df4 --- /dev/null +++ b/Haskell/lin-alg/Vector.hs @@ -0,0 +1,86 @@ +-- (C) Copyright Collin Doering 2014 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: Vector.hs +-- Author: Collin J. Doering +-- Date: Feb 5, 2014 + +-- Inspired by Coursera class "Coding the Matrix" + +-- | This Module represents Vectors +module Vector where + +import Data.Foldable +import qualified Data.Map.Strict as M +import Data.Maybe (fromMaybe,fromJust) + +-- | Vector +data Vector a = Vector { unvector :: M.Map Integer a } + +instance Show a => Show (Vector a) where + show (Vector a) = "Vector " ++ M.foldr (\x y -> show x ++ " " ++ y) "" a + +instance Functor Vector where + fmap f (Vector v) = Vector $ M.map f v + +instance Foldable Vector where + foldr f i (Vector v) = M.foldr f i v + +-- class Field a => Vector a where +-- (+) = udnefined +-- (-) = undefined +-- (*) = undefined + +-- The Num class doesn't exactly fit for Vectors +-- instance Num a => Num (Vector a) where +-- (+) = addVector +-- (-) = subVector +-- (*) = scalarMultVector +-- negate v = fmap (*(-1)) v +-- abs v = undefined +-- fromInteger a = fromList [a] + +-- | Returns the dimension of the given Vector +dimension :: Num a => Vector a -> Integer +dimension (Vector v) = toInteger . M.size $ v + +-- | Given a list, returns it represented as a Vector +fromList :: Num a => [a] -> Vector a +fromList xs = Vector $ M.fromList $ zip [1..] xs + +-- | +scalarMultVector :: Num a => a -> Vector a -> Vector a +scalarMultVector a (Vector v) = Vector $ M.map (a*) v + +-- | +binOpVector :: Num a => (Int -> Int -> Bool) -> String -> (a -> a -> a) -> Vector a -> Vector a -> Vector a +binOpVector p e f (Vector v1) (Vector v2) + | p (M.size v1) (M.size v2) = Vector $ M.foldrWithKey (\k x y -> M.insert k (f x (fromMaybe (error "Internal error!") $ M.lookup k v2)) y) M.empty v1 + | otherwise = error e + +-- | Add two given Vectors +addVector :: Num a => Vector a -> Vector a -> Vector a +addVector = binOpVector (==) "Error! Can only add vectors of the same dimension." (+) + +-- | Subtract two given Vectors +subVector :: Num a => Vector a -> Vector a -> Vector a +subVector = binOpVector (==) "Error! Can only subtract vectors of the same dimension." (-) + +-- | Apply the dot product to two given vectors +dotVector :: Num a => Vector a -> Vector a -> a +dotVector x@(Vector v1) y@(Vector v2) = M.foldr (+) 0 $ unvector $ binOpVector (==) "Error! Can only perform dot product on Vectors of equal size." (*) x y + +(<.>) :: Num a => Vector a -> Vector a -> a +(<.>) = dotVector diff --git a/Haskell/polynomials.hs b/Haskell/polynomials.hs new file mode 100644 index 0000000..ffb9928 --- /dev/null +++ b/Haskell/polynomials.hs @@ -0,0 +1,31 @@ +-- (C) Copyright Collin Doering 2011 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: polynomials.hs +-- Author: Collin J. Doering +-- Date: Aug 7, 2011 + +data Floating a = Poly a + | PolyL [a] + deriving (Eq, Show) + +data Posn2D x y = Posn2D Double Double + deriving (Eq, Show, Ord) + +instance Ord Posn2D where + (>) (Posn2D x1 y1) (Posn2D x2 y2) = distFromOrigin x1 y1 > distFromOrigin x2 y2 + where distFromOrigin a b = sqrt (a**2 + b**2) + +--addPolynomial :: Polynomial a -> Polynomial a -> Polynomial a diff --git a/Haskell/rdm.hs b/Haskell/rdm.hs new file mode 100644 index 0000000..45ad967 --- /dev/null +++ b/Haskell/rdm.hs @@ -0,0 +1,420 @@ +{-# LANGUAGE ExistentialQuantification #-} + +-- File: rdm.hs +-- Date: 02/10/2010 +-- Author: Collin J. Doering +-- Description: Random source file to experiment while learning haskell + +import System.IO +import Data.List +import Data.Foldable (foldr') +import Data.Function +import System.Posix.User +import Control.Monad + +-- Given a item and a list finds the index's (if any) where the item exist in the list +fp :: a -> [a] -> [Int] +fp y xs = fst $ fp' xs ([],0) + where fp' [] acc = acc + fp' (x:xs) (zs,i) + | x == y = fp' xs (i:zs, i + 1) + | otherwise = fp' xs (zs, i + 1) + +betterFp :: a -> [a] -> [Int] +betterFp y = fst . foldr (\a (xs,i) -> if y == a then (i:xs,i+1) else (xs,i+1)) ([],0) + +nameSpam :: IO () +nameSpam s = putStrLn $ fst $ foldr (\x (a, i) -> (take i (repeat x) ++ a, i - 1)) ("", length s) s + +printTriangle :: Char -> Int -> IO () +printTriangle c i = pTriangle c 1 + where pTriangle c j + | j > i = return () + | otherwise = putStrLn (take j (repeat c)) >> + pTriangle c (j + 1) + +printTriangle' :: Char -> Int -> IO () +printTriangle' _ 0 = return () +printTriangle' c i = putStrLn (take i (repeat c)) >> printTriangle' c (i - 1) + +printTriangle'' :: Char -> Integer -> IO () +printTriangle'' c n = putStrLn $ foldr' (\i a -> (take i $ repeat c) ++ "\n" ++ a) "" [1..n] + +factorial :: Integer -> Integer +factorial x = if x <= 1 then 1 + else x * factorial (x - 1) + +-- The factorial function using fix points +factorial' = fix (\f x -> if x <= 1 then 1 else x * f(x - 1)) + +factorial'' = fix (\f acc x -> if x <= 1 then acc else f (acc * x) (x - 1)) 1 + +factorial1 :: Integer -> Integer +factorial1 0 = 1 +factorial1 xs = xs * factorial1 (xs - 1) + +squareList :: [Double] -> [Double] +squareList lst = if null lst then [] + else (square (head lst)):(squareList (tail lst)) + where square x = x * x + +squareList1 :: [Double] -> [Double] +squareList1 [] = [] +squareList1 (x:xs) = (square x):(squareList1 xs) + where square x = x * x + +squareList2 = map (\x -> x * x) + +fib :: Integer -> Integer +fib 0 = 0 +fib 1 = 1 +fib x = fib (x-1) + fib (x-2) + +-- Playing with datatypes +data Posn = Posn2D { x :: Int, y :: Int } + | Posn3D { x :: Int, y :: Int, z :: Int } + deriving (Show, Eq, Ord) + +-- Real World Haskell Exercises +data List a = Cons a (List a) + | Nil + deriving (Show) + +listToBIL :: List a -> [a] +listToBIL (Cons a xs) = a:(listToBIL xs) +listToBIL Nil = [] + +myLength :: [a] -> Integer +myLength [] = 0 +myLength x = 1 + myLength (drop 1 x) + +myLength1 :: [a] -> Integer +myLength1 lst = let myLength1Help [] acc = acc + myLength1Help (_:xs) acc = myLength1Help xs (acc + 1) + in myLength1Help lst 0 + +myLength2 :: [a] -> Int +myLength2 lst = myLength2' lst 0 + where myLength2' [] a = a + myLength2' (_:xs) a = myLength2' xs (a + 1) + +meanOfList :: [Double] -> Double +meanOfList lst = meanSum lst 0 0 + where meanSum [] s l + | l /= 0 = s / l + | otherwise = 0 + meanSum (x:xs) s l = meanSum xs (s + x) (l + 1) + +listToPalindrome :: [a] -> [a] +listToPalindrome [] = [] +listToPalindrome x = x ++ reverse x + +isPalindrome :: (Eq a) => [a] -> Bool +isPalindrome x + | mod len 2 == 0 && take (div len 2) x == reverse (drop (div len 2) x) = True + | otherwise = False + where len = length x + +foldrmap :: (a -> b) -> [a] -> [b] +foldrmap fn = foldr (\x y -> (fn x):y) [] +--foldrmap fn = foldr ((:) . fn) [] + +foldrcopy :: [a] -> [a] +foldrcopy = foldr (:) [] + +foldrappend :: [a] -> [a] -> [a] +foldrappend a b = foldr (:) b a + +foldrlength :: [a] -> Int +foldrlength = foldr (\x y -> y + 1) 0 + +foldrsum :: (Num a) => [a] -> a +foldrsum = foldr (+) 0 + +--myfoldr fn init lst = myFoldrHelper ... + +myMap :: (a -> b) -> [a] -> [b] +myMap f xs = [f x | x <- xs] + +myMap1 :: (a -> b) -> [a] -> [b] +myMap1 _ [] = [] +myMap1 f (x:xs) = f x : myMap1 f xs + +mapWithFilter :: (a -> b) -> (a -> Bool) -> [a] -> [b] +mapWithFilter f p xs = [f x | x <- xs, p x] + +mapWithFilter1 :: (a -> b) -> (a -> Bool) -> [a] -> [b] +mapWithFilter1 _ _ [] = [] +mapWithFilter1 f p (x:xs) + | p x = f x : mapWithFilter1 f p xs + | otherwise = mapWithFilter1 f p xs + +mapWithFilter2 :: (a -> b) -> (a -> Bool) -> [a] -> [b] +mapWithFilter2 f p = map f . filter p + +-- A neat little closure +myFlip :: (a -> b -> c) -> b -> a -> c +myFlip f = \a b -> f b a + +compose :: (a -> b) -> (c -> a) -> (c -> b) +compose f g = \x -> f(g(x)) + +disemvowel :: String -> String +disemvowel = unwords . filter p . words + where p = flip elem "AaEeIiOoUu" . head + +-- questions from http://www.haskell.org/haskellwiki/Hitchhikers_guide_to_Haskell +greeter = do + putStrLn "Hello there! May i ask your name?" + name <- getLine + if name == "no" + then putStrLn "Well, sorry i asked..goodbye!" + else putStrLn ("Well hello there " ++ name ++ ", it's nice to meet you!") + +-- The above greeter "de-sugared" +greeter2 :: IO () +greeter2 = putStrLn "Hello there! May i ask your name?" + >> getLine + >>= \name -> if name == "no" + then putStrLn "Well, sorry i asked..goodbye!" + else putStrLn ("Well hello there " ++ name ++ ", it's nice to meet you!") + +safeHead :: [a] -> Maybe a +safeHead [] = Nothing +safeHead (x:xs) = Just x + +myTail :: [a] -> [a] +myTail [] = [] +myTail (_:xs) = xs + +-- Old version..why not make it for all monads? +-- myLiftM :: (a -> b) -> IO a -> IO b +-- myLiftM f a = a >>= \x -> return (f x) + +{- Here is a generic version of myLiftM, which has the same behavior as liftM. + Though the standard library chose to use do notation rather then the monadic + bind function (>>=), they are actually the same once the do notation is + de-sugared. Finally, notice the only thing that got changed here was the type + signature. +-} +myLiftM :: Monad m => (a -> b) -> m a -> m b +myLiftM f a = a >>= \x -> return (f x) + +--nthDigit :: Integer -> Integer -> Integer +--nthDigit n i = floor(10 * (f - floor(f))) +-- where f = n/10^(i+1) + +-- Implementation of a Maybe like type +data Perhaps a = PNone + | PJust a + deriving (Eq,Ord,Show) + +instance Functor Perhaps where + fmap _ PNone = PNone + fmap f (PJust x) = PJust (f x) + +instance Monad Perhaps where + (PJust a) >>= f = f a + PNone >>= _ = PNone + + return a = PJust a + +instance MonadPlus Perhaps where + mzero = PNone + + mplus (PJust a) _ = PJust a + mplus PNone (PJust a) = PJust a + mplus _ _ = PNone + +-- Simple Binary Tree type +data Tree a = Empty + | Node a (Tree a) (Tree a) + deriving (Show, Eq) + +instance Ord m => Ord (Tree m) where + _ >= Empty = True + (Node a _ _) >= (Node b _ _) = a >= b + _ >= _ = False + + _ <= Empty = True + (Node a _ _) <= (Node b _ _) = a <= b + _ <= _ = False + +leaf :: a -> Tree a +leaf x = Node x Empty Empty + +balanced :: Ord a => Tree a -> Bool +balanced Empty = True +balanced nd@(Node _ ls rs) = nd >= ls && nd <= rs && balanced ls && balanced rs + +depth :: Tree a -> Int +depth Empty = 0 +depth (Node _ ls rs) = 1 + max (depth ls) (depth rs) + +-- A parser type +type Parser a = String -> [(a,String)] + +-- Questions from Book "Programming in Haskell" +-- Excercises 5.8 + +-- Given an even list returns a pair of its halves +halve :: [a] -> ([a],[a]) +halve xs + | length xs `mod` 2 == 0 = (take halfLen xs, drop halfLen xs) + | otherwise = ([],[]) + where halfLen = (length xs `div` 2) + +safeTailA :: [a] -> [a] +safeTailA xs = if null xs then [] else tail xs + +safeTailB :: [a] -> [a] +safeTailB xs + | null xs = [] + | otherwise = tail xs + +safeTailC :: [a] -> [a] +safeTailC [] = [] +safeTailC (x:xs) = xs + +-- Did a version using the Maybe type for entertainment +safeTail :: [a] -> Maybe [a] +safeTail [] = Nothing +safeTail (x:xs) = Just xs + +myReplicate :: Int -> a -> [a] +myReplicate i e = [x | _ <- [1..i], x <- [e]] + +pythagoreans :: Int -> [(Int,Int,Int)] +pythagoreans i = [(x,y,z) | x <- [1..i], y <- [1..i], z <- [1..i], x^2 + y^2 == z^2] + +scalarProduct :: [Int] -> [Int] -> Int +scalarProduct xs ys = sum [x * y | (x,y) <- zip xs ys] + +-- Excercise 7.8 +toPowerOf :: Int -> Int -> Int +x `toPowerOf` 0 = 1 +x `toPowerOf` n = x * (x `toPowerOf` (n-1)) + +myAnd :: [Bool] -> Bool +myAnd [] = True +myAnd (x:xs) + | x = myAnd xs + | otherwise = False + +myAndFoldr :: [Bool] -> Bool +myAndFoldr = foldr (&&) True + +myConcat :: [[a]] -> [a] +myConcat [] = [] +myConcat (x:xs) = x ++ myConcat xs + +myReplicateR :: Int -> a -> [a] +myReplicateR 0 _ = [] +myReplicateR n e = e : myReplicateR (n-1) e + +nthElem :: [a] -> Int -> a +nthElem (x:xs) 0 = x +nthElem (x:xs) n = nthElem xs (n-1) +nthElem [] _ = undefined + +nthElemSafe :: [a] -> Int -> Maybe a +nthElemSafe (x:xs) 0 = Just x +nthElemSafe (x:xs) n = nthElemSafe xs (n-1) +nthElemSafe [] _ = Nothing + +myElem :: Eq a => a -> [a] -> Bool +myElem _ [] = False +myElem e (x:xs) + | e == x = True + | otherwise = myElem e xs + +merge :: Ord a => [a] -> [a] -> [a] +merge [] [] = [] +merge [] ys = ys +merge xs [] = xs +merge (x:xs) (y:ys) + | x < y = x:merge xs (y:ys) + | x == y = x:y:merge xs ys + | otherwise = y:merge (x:xs) ys + +msort :: Ord a => [a] -> [a] +msort [] = [] +msort [x] = [x] +msort xs = merge (msort (take halflen xs)) (msort (drop halflen xs)) + where halflen = length xs `div` 2 + +-- Other random functions + +increasing :: Ord a => [a] -> Bool +increasing [] = False +increasing (x:xs) = inc xs x True + where inc [] _ bl = True + inc (_:_) _ False = False + inc (x:xs) a True = inc xs x (a < x) + +-- Could implement the error handling for the empty list case below +-- using Maybe instead of error resulting in a type: +-- mymax :: Ord a => [a] -> Maybe a +mymax :: Ord a => [a] -> a +mymax [] = error "A empty list has no maximum" +mymax (x:xs) = aux xs x + where aux [] y = y + aux (x:xs) y + | x > y = aux xs x + | otherwise = aux xs y + +-- A seemingly nicer implementation of mymax above +mymax2 :: Ord a => [a] -> Maybe a +mymax2 [] = Nothing +mymax2 (x:xs) = Just $ foldr' lrgr x xs + where lrgr a b + | a > b = a + | otherwise = b + +flatten :: [[a]] -> [a] +flatten [] = [] +flatten (x:xs) = x ++ flatten xs + +-- Note: the definition below is the same as: flatten' = foldr (++) [] +flatten' :: [[a]] -> [a] +flatten' xss = flat xss [] + where flat [] acc = acc + flat (y:ys) acc = let nacc = acc ++ y + in nacc `seq` flat ys nacc + +-- Implementation of the square root function using fixed points *doesn't work* +sqrt' x = fix (\f y -> if ((y * y) - x) / x <= 0.0001 then y else y / x) x + +-- Learning from https://en.wikibooks.org/wiki/Haskell/Existentially_quantified_types +data ShowBox = forall s. Show s => SB s + +instance Show ShowBox where + show (SB a) = show a + +type HList = [ShowBox] + +heterogeniusList :: HList +heterogeniusList = [SB 1, SB ['a'..'c'], SB 'd', SB 3] + +-- How do i pattern match on (SB a) when a would be a list of depth n +-- Is it possible to restrict ShowBox to only hold non-list values? +-- flattenHList :: HList -> HList +-- flattenHList [] = [] +-- flattenHList (x:xs) = + +-- Questions from the haskell wiki +-- url: http://www.haskell.org/haskellwiki/99_questions/1_to_10 + +-- 1 +myLast :: [a] -> a +myLast lst = lst !! (len - 1) + where len = length lst + +myLast2 :: [a] -> a +myLast2 [] = error "No last element!" +myLast2 (x:[]) = x +myLast2 (x:xs) = myLast2 xs + +-- Blank main function (can test things here) +main :: IO () +main = undefined diff --git a/Java/Rdm.java b/Java/Rdm.java new file mode 100644 index 0000000..91a9953 --- /dev/null +++ b/Java/Rdm.java @@ -0,0 +1,13 @@ +/** + * File: rdm.java + * Author: Collin J. Doering + * Date: Jul 5, 2011 + * Description: File to play around with java; although much less useless in comparison to + * more scripting type languages that have a REPL/interpretter for obvious reasons + */ + +class Rdm { + public static void main(String[] args) { + System.out.println("Hello there..wow has it been a long time since i've seen you java.."); + } +} diff --git a/Lisp/primes.lisp b/Lisp/primes.lisp new file mode 100644 index 0000000..8e5705b --- /dev/null +++ b/Lisp/primes.lisp @@ -0,0 +1,831 @@ +;;; -*- Package: USER; Mode: LISP; Syntax: Common-lisp -*- +;;(in-package "USER") + +;; Author: Jason Eisner , December 1993 +;; +;; Use this code at your own risk; please give appropriate credit. +;; See primes.pdf for explanation and discussion. +;; +;; Because Common Lisp has bignum support built in, it is a handy +;; language for experimenting with very large prime numbers. + +;;; ***************** +;;; User macros to reload this file. +;;; ***************** + +(defparameter *workfile* "~/.scratch/primes") + +(defmacro L (&optional (filename *workfile*)) + `(load ,filename)) + +(defmacro CL (&optional (filename *workfile*)) + `(progn (compile-file ,filename) + (load ,filename))) + + +;;; *************************** +;;; Useful macros & operations. +;;; *************************** + +;; Logical implication. + +(defmacro implies (antecedent consequent) + `(or (not ,antecedent) ,consequent)) + + +;; Accesses the nth value (counting from 0) +;; of a form that returns multiple values. +;; +;; This macro is supposed to be built into Common +;; Lisp, but it was left out of this implementation. + +;;(defmacro nth-value (n form) +;; `(nth ,n (multiple-value-list ,form))) + + +;;; ***************************** +;;; Basic mathematical operations +;;; ***************************** + +(defmacro divides (a b) ; returns T if a | b, NIL otherwise + `(zerop (mod ,b ,a))) + +(defun square (x) (* x x)) + +;; returns a list of bits constituting the binary expansion of n, +;; from most to least significant. T indicates a 1 bit, NIL a 0 +;; bit. Example: (binary-expansion 11) ==> (T NIL T T). + +(defun binary-expansion (n) + (loop with answer = nil + + if (evenp n) do (push nil answer) + else do (push t answer) and do (decf n) + do (setf n (/ n 2)) + + until (zerop n) + finally (return answer))) + + +;; Quickly finds b^e (mod m). + +(defun exptmod (b e m) + (if (zerop e) 1 + (mod (if (evenp e) + (square (exptmod b (/ e 2) m)) + (* b (exptmod b (1- e) m))) + m))) + + +;; A bit faster than exptmod. It's recursive rather than iterative, and +;; the caller must provide a precomputed binary expansion of the exponent. +;; +;; (This is advantageous because we may have to reuse the same exponent +;; many times.) + +(defun exptmod-fast (b binary-e m) + + (loop with prod = 1 + for bit in binary-e + do (setf prod (square prod)) + if bit do (setf prod (* b prod)) + do (setf prod (mod prod m)) + finally (return prod))) + + +;; Integer part of the cube root---avoids floating-point goofups. +;; (See remarks at pi-Meissel.) + +(defun icuberoot (n) + (floor (expt (+ 0.5 n) 1/3))) + + +;; Integration by the trapezoidal rule. + +(defun integrate (fn lower upper dx) + + ;; correct dx so that we have a whole # of intervals + (let* ((n (round (/ (abs (- upper lower)) dx))) + (dx (/ (- upper lower) n))) + (* dx (+ (loop for i from 1 to (- n 1) + for x from (+ lower dx) by dx + sum (funcall fn x)) + (* 1/2 (funcall fn lower)) + (* 1/2 (funcall fn upper)))))) + + +;;; ***************** +;;; Primality Testing +;;; ***************** + +;; Almost (but not quite) the stupidest primality test conceivable. + +(defun prime?-slow (n) + (loop for i from 2 to (isqrt n) + never (divides i n))) + + +;; Returns a list of all primes in [2,n], in increasing order. +;; Uses the stupid method prime?-slow to test numbers individually. +;; Doesn't amortize the work at all. + +(defun primes-tested-slow (n) + (loop for i from 2 to n + when (prime?-slow i) + collect i)) + +(defun pi-tested-slow (n) + (length (primes-tested-slow n))) + + +;; Returns an array holding the primes in [2,n], in increasing order. +;; +;; The array has a fill pointer which registers its "active +;; length." The active elements of the array are taken to be 0 +;; up to but not including the fill pointer. (The built-in length +;; function respects fill pointers.) +;; +;; An unproved theorem from Part II Number Theory says that +;; pi(n) is about n/log(n). We initially allow for 1.2 times this +;; many elements, but we use an adjustable array that will automatically +;; get bigger if necessary. +;; +;; Notes: +;; 1. Takes no square roots. (a significant linear speedup) +;; 2. Stops as soon as it knows a candidate is composite +;; (divides by primes in the order 2, 3, 5, ... sqrt(candidate)). + +(defun primes-tested (n) + (let ((primes (make-array (floor (* 1.2 (/ n (log n)))) + :fill-pointer 0 ; no primes in array yet + :adjustable t)) ; can get more space if necessary + (n-divisors 0) ; number of primes being used as divisors + (i-biggest-testable 0)) ; largest integer testable using only + ; the first n-divisors primes as divisors + + (loop for i from 2 to n + + ;; First be very careful about the case where we're not sure + ;; we have enough divisors to test i for primality. + ;; + ;; We can certainly test integers up to p^2 by using only + ;; primes up to p. + ;; + ;; Indeed, we can do slightly better most of the time: + ;; we can test integers up to q^2-1, where q is the least + ;; prime exceeding p. (if one has been found!) + ;; + ;; The array holds all primes in [2,i-1], which is + ;; always enough to test i ... so if n-divisors = (length primes), + ;; we can proceed with a clear conscience, even if + ;; i > i-biggest-testable. + + do (if (and (> i i-biggest-testable) + (< n-divisors (length primes))) + (progn (incf n-divisors) + (setf i-biggest-testable + (if (< n-divisors (length primes)) + (1- (square (svref primes n-divisors))) + (square (svref primes (1- n-divisors))))))) + + ;; Now see if i is a prime, and if so, add it to the array. + + (if (loop for index from 0 to (1- n-divisors) + never (divides (svref primes index) i)) ;; stops ASAP + (vector-push-extend i primes))) + + primes)) + + + +;; Finds pi(n) by using primes-tested. +;; +;; We only use primes-tested to generate the primes up to sqrt(n). +;; (We must test larger numbers for primality, of course, but we don't need +;; to store them!) + +(defun pi-tested (n) + (let* ((sqrt[n] (max 2 (isqrt n))) + (divisors (primes-tested sqrt[n]))) + (+ (length divisors) + (loop for i from (1+ sqrt[n]) to n + count (loop for index from 0 to (1- (length divisors)) + never (divides (svref divisors index) i)))))) + + + +;;; ******************************* +;;; Probabilistic primality testing +;;; ******************************* + +(defvar max-error-prob) +(defvar spot-checks) +(setf max-error-prob 1E-10) +(setf spot-checks (ceiling (- (/ (log max-error-prob) (log 4))))) + +(defun Fermat-pseudoprime? (n base) + (= 1 (exptmod base (1- n) n))) + + +;; A fast version: the caller must supply the binary-expansion of n-1. + +(defmacro Fermat-pseudoprime?-fast (n base binary-e) + `(= 1 (exptmod-fast ,base ,binary-e ,n))) + + +;; Test whether n is a strong pseudoprime to the given base. +;; n-1 = t*(2^s), for t odd. +;; binary-t is the binary-expansion of t. + +(defun strong-pseudoprime? (n base binary-t s) ;; where n-1 = t*(2^s) + (let ((base^t (exptmod-fast base binary-t n))) + (or (= 1 base^t) + (loop with prod = base^t + for r from 0 to (1- s) + thereis (= (1- n) prod) + do (setf prod (mod (square prod) n)))))) + + +;; Pick an integer from [1, n) that is coprime to n. + +(defun random-base (n) + (loop with base + do (setf base (1+ (random (1- n)))) + until (= 1 (gcd base n)) + finally (return base))) + + +;; The Miller-Rabin test. Relies on the fact that if n is prime, +;; it is an strong pseudoprime to every base in [1, n), whereas if +;; it's composite, it is a strong pseudoprime to at most 1/4 of these +;; bases. +;; +;; We do enough random spot checks to bring the probability of an +;; error below max-error-prob. + +(defun prime?-probably (n) + (loop with tee = (1- n) + with s = 0 + with binary-t + initially (loop while (evenp tee) + do (setf tee (/ tee 2)) + do (incf s)) ;; now n-1 = 2^s * t with t odd + initially (setf binary-t (binary-expansion tee)) + for i from 1 to spot-checks + always (strong-pseudoprime? n (random-base n) binary-t s))) + + +;; Perfect testing of large primes, if the Generalized Riemann Hypothesis is true. +;; We only have to test against bases up to log n. + +(defun prime?-GRH (n) + + (loop with tee = (1- n) + with s = 0 + with binary-t + initially (loop while (evenp tee) + do (setf tee (/ tee 2)) + do (incf s)) ;; now n-1 = 2^s * t with t odd + initially (setf binary-t (binary-expansion tee)) + for base from 1 to (floor (log n)) + when (= 1 (gcd base n)) + always (strong-pseudoprime? n base binary-t s))) + + +(defun pi-tested-probably (n) + (loop for i from 2 to n + count (prime?-probably i))) + + +(defun pi-tested-GRH (n) + (loop for i from 2 to n + count (prime?-probably i))) + + +;; First prime after n. To speed this up, we can look +;; in an arithmetic progression starting at n -- for example, +;; at the odd numbers after n. + +(defun next-prime (n &optional (step 1)) + (assert (= (gcd n step) 1)) + (loop for i from n by step + when (prime?-probably i) + do (return i))) + + +;;; **************** +;;; Sieving Methods. +;;; **************** + +;; Sieve the numbers from 1 to n, and return the resulting primes in a list. +;; +;; As a second value, we return an array with elements from 1 to n; the +;; primes are the elements with non-nil entries. + +(defun primes-sieved (n) + (loop with sieve = (make-array (1+ n) :initial-element T) + ; all elements initially flagged prime + with divisor = 2 + while (<= (square divisor) n) ; for all prime divisors < sqrt(n) + + ;; Strike out multiples of the divisor. + do (loop for i from (+ divisor divisor) to n by divisor + do (setf (svref sieve i) nil)) + + ;; Find the next non-prime divisor, if any. + do (loop do (incf divisor) + until (or (svref sieve divisor) (> divisor n))) + + ;; At the end, collect up the remaining primes and return them. + ;; Return the sieve itself as a second value. + + finally (setf (svref sieve 0) nil ; these aren't primes either + (svref sieve 1) nil) + (return (values (loop for i from 2 to n + when (svref sieve i) + collect i) + sieve)))) + +(defun pi-sieved (n) + (length (primes-sieved n))) + + +(defmacro link (i j) + `(setf (svref next ,i) ,j + (svref prev ,j) ,i)) + + +;; A LINEAR algorithm. +;; +;; We keep a doubly linked list of the integers that might be +;; prime. As multiples are struck out, they're removed from +;; this list. +;; +;; The list is implemented as a pair of arrays, prev and next. +;; If i is an integer on the list, and 1 <= k <= sqrt(n), then +;; +;; Prev[i] = the next smallest list element (or 1 if none such) +;; Next[i] = the next largest list element (or n+1 if none such) +;; S[k] = the largest list element <= n/k +;; Sinv[i] = {k: S(k) = i} (stored as a list) +;; +;; Note: 2 is always the smallest list element; S[1] is always the largest +;; list element. Either fact would enable us to enumerate the primes in +;; the sieve (we don't currently). + +(defun pi-sieved-linear (n) + (loop with list-size = (1- n) ;; all nos. in [2,n] are initially thought prime + + with sqrt-n = (isqrt n) + with prev = (make-array (+ n 2)) + with next = (make-array (+ n 2)) + with Sinv = (make-array (+ n 1)) + with S = (make-array (+ sqrt-n 1)) + + initially (loop for i from 1 to n ; set up linked list + do (link i (1+ i))) + (loop for k from 1 to sqrt-n ; set up S and Sinv + for S[k] = (floor (/ n k)) + do (setf (svref S k) S[k]) + (push k (svref Sinv S[k]))) + + with divisor = 2 + while (<= divisor sqrt-n) ; for all prime divisors <= sqrt(n) + + ;; Multiplier starts at S[divisor] -- the biggest potential prime that, + ;; when multiplied by divisor, still yields a number <= n. + + do (loop with multiplier = (svref S divisor) + while (>= multiplier divisor) ; needn't go smaller + for composite = (* multiplier divisor) + for predecessor = (svref prev composite) + for successor = (svref next composite) + + ;; now strike out the composite number. + + do (link predecessor successor) + (decf list-size) + (loop for k in (svref Sinv composite) + do (setf (svref S k) predecessor) + (push k (svref Sinv predecessor))) + + ;; move on to the next multiplier. + + do (setf multiplier (svref prev multiplier))) + + do (setf divisor (svref next divisor)) + + finally (return list-size))) + + +;; A variant of pi-sieved-linear, where we start with +;; all multiples of 2 and 3 already struck out. +;; +;; This optimization doesn't change the complexity of +;; the algorithm -- it just saves some cycles, by +;; eliminating two passes and by shortening the +;; initialization of the arrays. + +(defun pi-sieved-linear-fast (n) + (loop with list-size = (+ 1 + (- n (floor (/ n 2)) (floor (/ n 3))) + (floor (/ n 6))) + + with sqrt-n = (isqrt n) + with prev = (make-array (+ n 7)) + with next = (make-array (+ n 7)) + with Sinv = (make-array (+ n 1)) + with S = (make-array (+ sqrt-n 1)) + + initially (link 2 3) + (link 3 5) + (link 5 7) + (loop with i = 7 + while (<= i n) + for j = (+ i 6) + + do (link i (+ i 4)) + (link (+ i 4) j) + + do (setf i j)) + (loop for k from 1 to sqrt-n ; set up S and Sinv + for S[k] = (floor (/ n k)) ; might not be in the list + do (loop until (svref prev S[k]) + do (decf S[k])) + (setf (svref S k) S[k]) + (push k (svref Sinv S[k]))) + + with divisor = 5 + + ;; ** From here on, the code is exactly the same as in pi-sieved-linear. ** + + while (<= divisor sqrt-n) ; for all prime divisors <= sqrt(n) + + ;; Multiplier starts at S[divisor] -- the biggest potential prime that, + ;; when multiplied by divisor, still yields a number <= n. + + do (loop with multiplier = (svref S divisor) + while (>= multiplier divisor) ; needn't go smaller + for composite = (* multiplier divisor) + for predecessor = (svref prev composite) + for successor = (svref next composite) + + ;; now strike out the composite number. + + do (link predecessor successor) + (decf list-size) + (loop for k in (svref Sinv composite) + do (setf (svref S k) predecessor) + (push k (svref Sinv predecessor))) + + ;; move on to the next multiplier. + + do (setf multiplier (svref prev multiplier))) + + do (setf divisor (svref next divisor)) + + finally (return list-size))) + + +;;; ****************** +;;; Legendre's formula +;;; ****************** + +;; Computes phi(n, a), i.e., the number of integers in [1,n] +;; not divisible by any of the first a primes. +;; Primelist is a list of the first a primes, in REVERSE order. + +(defun phi (n a primelist) + (cond ((zerop a) (floor n)) + ((< n 1) 0) + (t (- (phi n (1- a) (rest primelist)) + (phi (/ n (first primelist)) (1- a) (rest primelist)))))) + + +;; Legendre's formula. + +(defun pi-Legendre (n) + (let* ((sqrt[n] (isqrt n)) + (pr (primes-sieved sqrt[n])) + (a (length pr))) + (+ a -1 (phi n a (reverse pr))))) + + + +;; Returns an array holding the values of phi(t, k) for ALL 0 <= t <= m, +;; where m is the product of the first k primes. +;; +;; The first k primes must be provided. We use a sieving method to +;; determine the values efficiently, more or less as suggested in Riesel. + +(defun phi-array (m primes) + (let ((sieve (make-array (1+ m) :initial-element t))) + + ;; Cross out the integers that are divisible by at least one + ;; of the given primes. + + (loop for p in primes + do (loop for i from 0 to m by p + do (setf (svref sieve i) nil))) + + ;; Now change the entries of the sieve from logical flags to + ;; numbers: at each entry, we count the number of previous entries + ;; that are indivisible by all the primes, i.e., still have t entries. + + (loop for i from 0 to m + count (svref sieve i) into phi + do (setf (svref sieve i) phi)) + + ;; Return the result. + + sieve)) + + +(defvar *k* nil) ;; Value of k from our last call to pi-Legendre-fast +(defvar *phi-array* nil) ;; The phi-array we built then -- we may be able to + ;; reuse it! +(defvar *m* nil) ;; The value of m we used then + + +;; Set the above global variables to be appropriate to a new +;; value of k. If the value of k hasn't changed, leave the +;; old values alone (they're still appropriate.) + +(defun initialize-phi-array (k) + (unless (eq k *k*) + (let ((primes (loop ;; the first k primes (k is very small) + for i from 2 + when (prime?-slow i) + collect i + and count T into count + until (= count k)))) + (setf *k* k + *m* (apply #'* primes) + *phi-array* (phi-array *m* primes)))) + (values)) + + +;; Given a phi-array of the correct form, computes phi quickly. +;; (See documentation at phi-array.) +;; +;; The optimization as described in the project handout uses +;; the Euler phi function of m. Since we know m's factors, this +;; would be easy to find. However, since it's exactly phi(m,k), +;; it was just as convenient to compute it as part of the phi-array. + +(defun phi-fast (n a primelist &optional (k *k*) (m *m*) (phi-array *phi-array*)) + + (cond ((= a k) + (multiple-value-bind (s tee) (floor n m) ;; so n = s*m + t, 0 <= t < m + (+ (* s (svref phi-array m)) + (svref phi-array tee)))) + + ((zerop a) ;; another termination condition, in case we're + (floor n)) ;; initially called with (a < k) + + ((< n 1) 0) + + (t + (- (phi-fast n (1- a) (rest primelist) + k m phi-array) + (phi-fast (floor n (first primelist)) (1- a) (rest primelist)))))) + + +(defun pi-Legendre-fast (n &optional (k 6)) ;; k=0 gives vanilla pi-Legendre + (let* ((sqrt[n] (isqrt n)) + (primes (primes-sieved sqrt[n])) + (a (length primes))) + + ;; Recompute the global variables unless they're appropriate from the last call. + + (initialize-phi-array k) + (+ a -1 (phi-fast n a (reverse primes))))) + + +;;; ***************** +;;; Meissel's formula +;;; ***************** + +;; By scanning through a sieve, in linear time, creates an array +;; of length n with a very special form: +;; If n is prime, the nth element is pi(n). +;; If n is not prime, the nth element is a negative value giving +;; the previous prime -- or 0 if none. + +(defun pi-array (n) + (loop with array = (nth-value 1 (primes-sieved n)) + with current-pi = 0 + with last-prime = 0 + for i from 0 to n + if (svref array i) + do (incf current-pi) + (setf (svref array i) current-pi + last-prime i ) + else + do (setf (svref array i) (- last-prime)) + finally (return array))) + + +;; Finds pi(n) by looking in a pi-array. + +(defun lookup-pi (n pi-array) + (let ((entry (svref pi-array n))) + (if (> entry 0) + entry + (svref pi-array (- entry))))) + + +;; Finds the greatest prime <= n, by looking +;; in a pi-array. Returns 0 if none such. + +(defun lookup-prime-floor (n pi-array) + (let ((entry (svref pi-array n))) + (if (> entry 0) n (- entry)))) + + +;; Computes pi from Meissel's formula. +;; +;; Here pi-array has the form produced by the pi-array routine above. +;; It must have length AT LEAST sqrt(x). +;; +;; Important: We use an icuberoot function I've defined +;; to get the integer part of the cube root. (This is analagous +;; to isqrt.) If we don't do this, our answer is occasionally +;; off by one. For example, pi(343) would be miscomputed, because +;; this computer thinks the cube root of 343 is 6.999999999999999. +;; So would any pi(n) that is computed in terms of pi(343). + +(defun pi-Meissel (x &optional (pi-array (pi-array (isqrt x)))) + (if (<= x 1) + 0 + (let* ((cuberoot (icuberoot x)) + (sqrt (isqrt x)) + (c (lookup-pi cuberoot pi-array)) + (b (lookup-pi sqrt pi-array))) + (initialize-phi-array 6) ;; this call usually does nothing + (+ (phi-fast x c + (loop ; find the first c primes, in reverse order + with p = (lookup-prime-floor cuberoot pi-array) + until (zerop p) + collect p + do (setf p (lookup-prime-floor (1- p) pi-array)))) + (* 1/2 (+ b c -2) (- b c -1)) + (- (loop with p = (lookup-prime-floor sqrt pi-array) + while (> p cuberoot) + sum (pi-Meissel (floor x p) pi-array) + do (setf p (lookup-prime-floor (1- p) pi-array)))))))) + + +;;; ******************* +;;; Approximating pi(x) +;;; ******************* + +;; Computes Li(x) from its formal definition. + +(defun Li-integrand-slow (s) (/ (log s))) +(defun Li-slow (x &optional (ds 1.0)) + (+ 1.045 (integrate #'Li-integrand-slow 2 x ds))) + + +;; Faster computation using a change of variable -- in the integration +;; above, we're using narrow intervals on an integrand that gets flatter +;; and flatter. + +(defun Li-integrand (u) (/ (exp u) u)) + +(defun Li (x &optional (du 0.001)) + (+ 1.045 (integrate #'Li-integrand (log 2) (log x) du))) + + +;; The approximation to pi(x) given by the prime number theorem. + +(defun log-approx (n) + (/ n (log n))) + + +;;; *********************** +;;; Tabulating our results. +;;; *********************** + +;; Calls the given function on n = 10, 20, 30, ... 90, 100, 200, ... +;; up to upperbound (if supplied), throwing away any results. +;; +;; We use this to print a table. + +(defun drive-tabulation (function &optional upperbound (factor 10)) + (loop with interval = factor + with arg = interval + while (implies upperbound (<= arg upperbound)) + for total-calls from 0 + do (funcall function arg) + (if (and (divides (1- factor) total-calls) + (> total-calls 0)) + (setf interval (* interval factor))) + (incf arg interval)) + (values)) + + +;; Calls all the functions on the argument, and collect the results +;; into a list. + +(defun eval-fns (fns arg) + (loop for fn in fns + collect (funcall fn arg))) + + +;; Prints the print names of the list elements as column headers, splitting +;; them as readably as possible across several lines if necessary. + +(defun print-headers (headers) + (loop with done? = nil + with names = (loop for object in headers + collect (string-capitalize (format nil "~A" object))) + for print = (loop initially (setf done? t) + for i from 0 to (1- (length names)) + for name = (elt names i) + for length = (length name) + for cut-point = (if (<= length 10) + length + (1+ (or (position #\- name :end 10 :from-end t) + 9))) + for print-part = (subseq name 0 cut-point) + for remaining = (subseq name cut-point) ;; to end + + collect print-part + do (setf (elt names i) remaining) + (when (string/= remaining "") + (setf done? nil))) + + do (print-table-line " " print) + until done?) + (values)) + + +;; Prints the list as a table line. + +(defun print-table-line (row-label list) + (format t "~&~A~{~,12T~A~}" row-label list)) + + +;; Tabulates the values of a function for 10, 20, 30, ... 90, 100, 200, ... +;; Here fns may be either a single function or a list of functions. +;; Their print names will be used as the headers, unless a list of other +;; headers (strings) is provided as a keyword argument. +;; +;; There are some other optional keyword arguments. The multiplicative factor +;; may be specified, and so may an upper bound that says how far to tabulate. +;; Finally, if the list upperbounds has an nth element, it serves as a +;; further upperbound on the nth function. + +(defun tabulate (fns &key upperbounds + (upperbound (when upperbounds + (apply #'max upperbounds))) + (factor 10) + headers) + + ;; If there's only a single function, make it a list of one function. + ;; (Careful, because some function specifiers look like lists.) + + (unless (and (listp fns) + (not (eq (car fns) 'function)) + (not (eq (car fns) 'lambda))) + (setf fns (list fns))) + + (print-headers (or headers fns)) + + (drive-tabulation + #'(lambda (arg) + (print-table-line arg + (loop for fn in fns + for i from 0 + for upperbound = (nth i upperbounds) + when (implies upperbound (<= arg upperbound)) + collect (funcall fn arg) + else collect " "))) + upperbound factor)) + + +;; Tabulates all our methods as far as appropriate. + +(defun tabulate-pi-methods () + (tabulate '(pi-tested-slow pi-tested pi-tested-probably pi-tested-GRH pi-sieved + pi-sieved-linear pi-sieved-linear-fast pi-Legendre pi-Legendre-fast pi-Meissel) +:upperbounds '( 100000 100000 10000 10000 500000 + 100000 100000 1000000 10000000 10000000))) + + +;; Tabulates approximations to pi. + +(defun tabulate-approximations () + (print-headers '(" pi" " x/log x" " li" " log-ratio" + " li-ratio" " log-diff" " li-diff")) + (drive-tabulation + #'(lambda (n) + (format t "~&~A~{~,12T~11,3F~}" n + (let ((pi-true (pi-Meissel n)) + (pi-log (log-approx n)) + (pi-li (Li n))) + (list pi-true pi-log pi-li (/ pi-true pi-log) + (/ pi-true pi-li) (- pi-true pi-log) (- pi-true pi-li))))) + 10000000)) + diff --git a/Lisp/rdm.lisp b/Lisp/rdm.lisp new file mode 100644 index 0000000..8a69221 --- /dev/null +++ b/Lisp/rdm.lisp @@ -0,0 +1,76 @@ +;; File: rdm.lisp +;; Date: 28/08/2010 +;; Author: Collin J. Doering n 0) (pow x (- n 1) (* acc x))) +;; ((< n 0) (pow x (+ n 1) (* acc (/ 1 x)))))) + +(defun pow (x n) + (labels ((pow-helper (x n acc) + (cond ((= n 0) acc) + ((> n 0) (pow-helper x (- n 1) (* acc x))) + ((< n 0) (pow-helper x (+ n 1) (* acc (/ 1 x))))))) + (pow-helper x n 1))) + +(defun bad-factorial (x) + (cond ((<= x 0) 1) + (T (* x (bad-factorial (- x 1)))))) + +(defun fib (n) + (let ((fib-dot-lst nil)) + (labels ((gen-fib (n x) + (cond ((> x n) (car fib-dot-lst)) + ((= x 0) (setf fib-dot-lst (cons 0 nil)) + (gen-fib n (+ x 1))) + ((= x 1) (setf fib-dot-lst (cons 1 0)) + (gen-fib n (+ x 1))) + (t (let* ((fst (car fib-dot-lst)) + (scd (cdr fib-dot-lst)) + (fibx (+ fst scd))) + (setf fib-dot-lst (cons fibx fst)) + (gen-fib n (+ x 1))))))) + (gen-fib n 0)))) + +(defun my-cat (pathd) + (with-open-file (pathd-in pathd) + (loop for line = (read-line pathd-in nil) + while line do (format t "~a~%" line)))) + +(defun average-list (lst &optional (acc 0) (len 0)) + (cond ((null lst) (if (> len 0) (/ acc len))) + (T (average-list (rest lst) (+ acc (first lst)) (1+ len))))) + +(defun interval (a b) + (labels ((interval-helper (a b &optional (acc nil)) + (if (< b a) acc (interval-helper (+ a 1) b (cons a acc))))) + (reverse (interval-helper a b)))) + +;; broken.. needs complete rewrite +;; (defun prime-seive (a b primes) +;; (let ((a-to-b (interval a b))) +;; (labels ((prime-seive-helper (inter primes &optional (acc nil)) +;; (if inter +;; (loop for p in primes +;; if (divides p (car inter)) +;; do (format t "~a -|- ~a~%" p (car inter)) +;; finally (prime-seive-helper (cdr inter) primes (cons (car inter) acc))) +;; acc))) +;; (prime-seive-helper a-to-b primes)))) diff --git a/Lua/rdm.lua b/Lua/rdm.lua new file mode 100644 index 0000000..92a1486 --- /dev/null +++ b/Lua/rdm.lua @@ -0,0 +1,22 @@ +-- (C) Copyright Collin Doering 2012 +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. +-- +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. +-- +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- File: rdm.lua +-- Author: Collin J. Doering +-- Date: Jun 27, 2012 + +function square(x) + return x * x; +end diff --git a/PHP/rdm.php b/PHP/rdm.php new file mode 100644 index 0000000..ec8711e --- /dev/null +++ b/PHP/rdm.php @@ -0,0 +1,28 @@ +/** + * (C) Copyright Collin Doering 2012 + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . +*/ + +/** + * File: rdm.php + * Author: Collin J. Doering + * Date: Jun 27, 2012 + */ + +function square (x) { + return x * x; +} + + \ No newline at end of file diff --git a/Python/rdm.py b/Python/rdm.py new file mode 100644 index 0000000..6894375 --- /dev/null +++ b/Python/rdm.py @@ -0,0 +1,31 @@ +# (C) Copyright Collin Doering 2011 +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# File: rdm.py +# Author: Collin J. Doering +# Date: Jul 7, 2011def factorial (n): + +# Only works for python 2.6.x since in python 3 print is a function +def factorial (n): + if n < 0: + print("Sorry can't take the factorial of a number n < 0!") + return + elif n == 1: + return 1; + else: + for i in range (2, n): + ret *= i + return ret + diff --git a/Racket/helloworld.s b/Racket/helloworld.s new file mode 100644 index 0000000..25d1ddb --- /dev/null +++ b/Racket/helloworld.s @@ -0,0 +1,26 @@ + .file "helloworld.c" + .section .rodata +.LC0: + .string "Hello World!" + .text + .globl main + .type main, @function +main: +.LFB0: + .cfi_startproc + pushq %rbp + .cfi_def_cfa_offset 16 + .cfi_offset 6, -16 + movq %rsp, %rbp + .cfi_def_cfa_register 6 + movl $.LC0, %edi + call puts + movl $0, %eax + popq %rbp + .cfi_def_cfa 7, 8 + ret + .cfi_endproc +.LFE0: + .size main, .-main + .ident "GCC: (GNU) 4.6.3" + .section .note.GNU-stack,"",@progbits diff --git a/Racket/post-fix-expressions.rkt b/Racket/post-fix-expressions.rkt new file mode 100644 index 0000000..0cb8d5b --- /dev/null +++ b/Racket/post-fix-expressions.rkt @@ -0,0 +1,48 @@ +#lang racket + +;; (C) Copyright Collin Doering 2012 +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; File: post-fix-expressions.rkt +;; Author: Collin J. Doering +;; Date: Jul 8, 2012 + +(define (parse-expr-list xs) + (cond [(empty? xs) (printf "~n")] + + [else (printf "~a~n" (eval-expr (string->list (first xs)))) + (parse-expr-list (rest xs))])) + +(define (eval-expr xs) + (define (eval-expr-H xs ys) + (cond [(and (empty? xs) (empty? ys)) (error 'invalid-expr)] + [(and (empty? xs) (equal (length ys) 1)) (first ys)] + [(number? (first xs)) (eval-expr-H (rest xs) (cons (char->integer (first xs)) ys))] + [(char? )]))) + +(define str-tb-eval(make-parameter '())) + +(define runtime-options + (command-line + #:program "Postfix expression evaluator" + #:once-any + [("-s" "--string") str "Pass in one or more strings to be evaluated" + (str-tb-eval (cons (str-tb-eval)))])) + +(parse-command-line "postfix-exprs" (current-command-line-arguments) runtime-options) + +(if (empty? (str-tb-eval)) + (parse-expr-list (str-tb-eval)) + (eval-expr-interactive)) diff --git a/Racket/rdm-typed.rkt b/Racket/rdm-typed.rkt new file mode 100644 index 0000000..993f575 --- /dev/null +++ b/Racket/rdm-typed.rkt @@ -0,0 +1,28 @@ +#lang typed/racket + +;; (C) Copyright Collin Doering 2013 +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; File: rdm-typed.rkt +;; Author: Collin J. Doering +;; Date: Jul 2, 2013 + +(: factorial : Integer -> Integer) +(define (factorial n) + (: factorial-helper : Integer Integer -> Integer) + (define (factorial-helper n acc) + (cond [(<= n 1) acc] + [else (factorial-helper (- n 1) (* acc n))])) + (factorial-helper n 1)) diff --git a/Racket/rdm.rkt b/Racket/rdm.rkt new file mode 100644 index 0000000..818c0e3 --- /dev/null +++ b/Racket/rdm.rkt @@ -0,0 +1,297 @@ +#lang racket + +;; File: rdm.rkt +;; Date: Oct 25, 2010 +;; Author: Collin J. Doering =0] -> int[>=0] +;; Purpose: returns the factorial of the given positive (or zero) integer +;; Examples/Tests: + +(define (factorial n) + (define (factorial-helper n acc) + (cond [(<= n 1) acc] + [else (factorial-helper (- n 1) (* acc n))])) + (if (integer? n) + (factorial-helper n 1) + (error "Expects argument to be an integer!"))) + +(define factorial! + (letrec ([fact-helper (lambda (n acc) + (if (<= n 1) acc (fact-helper (- n 1) (* acc n))))] + [fact! (lambda (n) + (fact-helper n 1))]) + fact!)) + +(define (factorial-close [n 0]) + (letrec ([acc 1] + [x 1] + [fac-c (lambda () + (cond [(> x n) (set! n (+ n 1)) acc] + [else (set! acc (* x acc)) + (set! x (+ x 1)) + (fac-c)]))]) + fac-c)) + +(define (sum-digits n [base 10]) + (letrec ([sum-digits-helper + (lambda (n acc) + (cond [(zero? (floor (/ n base))) (+ acc (remainder n base))] + [else (sum-digits-helper (floor (/ n base)) (+ acc (remainder n base)))]))]) + (sum-digits-helper n 0))) + +;; fibinocci sequences +;; Very slow...big-O anaylsis of O(2^n) (not 100% sure tho) +(define (fib n) + (cond [(<= n 0) 0] + [(= n 1) 1] + [else (+ (fib (- n 1)) (fib (- n 2)))])) + +;; fibinocci sequence...but implemented smart ;) haven't looked at the big-O analysis yet +(define (fast-fib n) + (letrec ([fib-lst empty] + [gen-fib (lambda (n x) + (cond [(> x n) (first fib-lst)] + [(= x 0) (set! fib-lst (cons 0 empty)) + (gen-fib n (+ x 1))] + [(= x 1) (set! fib-lst (cons 1 fib-lst)) + (gen-fib n (+ x 1))] + [else (let ([fibx (+ (first fib-lst) (second fib-lst))]) + (set! fib-lst (cons fibx fib-lst)) + (gen-fib n (+ x 1)))]))]) + (gen-fib n 0))) + +;; another fibinocci sequence function but with significantly improved memory performance :D (TODO: big-O analysis) +(define (fast-mem-fib n) + (letrec ([fib-dot-lst empty] + [gen-fib (lambda (n x) + (cond [(> x n) (car fib-dot-lst)] + [(= x 0) (set! fib-dot-lst (cons 0 empty)) + (gen-fib n (+ x 1))] + [(= x 1) (set! fib-dot-lst (cons 1 0)) + (gen-fib n (+ x 1))] + [else (let* ([fst (car fib-dot-lst)] + [scd (cdr fib-dot-lst)] + [fibx (+ fst scd)]) + (set! fib-dot-lst (cons fibx fst)) + (gen-fib n (+ x 1)))]))]) + (gen-fib n 0))) + +;; fibinocci closure..pretty much the same as fast-mem-fib but returns a gen-fib like function that takes +;; no paramters but instead encapsulates the values for n and x thus creating a fibinocci closure starting at n +(define (fibc [n 0]) + (letrec ([fib-dot-lst empty] + [x 0] + [gen-fib-c (lambda () + (cond [(> x n) (set! n (+ n 1)) + (car fib-dot-lst)] + [(= x 0) (set! fib-dot-lst (cons 0 empty)) + (set! x (+ x 1)) + (gen-fib-c)] + [(= x 1) (set! fib-dot-lst (cons 1 0)) + (set! x (+ x 1)) + (gen-fib-c)] + [else (let* ([fst (car fib-dot-lst)] + [scd (cdr fib-dot-lst)] + [fibx (+ fst scd)]) + (set! fib-dot-lst (cons fibx fst)) + (set! x (+ x 1)) + (gen-fib-c))]))]) + gen-fib-c)) + +;; pow num num -> num +;; Purpose: given two real numbers x and n returns x^n +;; Examples/Tests: + +(define (pow x n) + (define (pow-helper x n acc) + (cond [(= n 0) acc] + [(> n 0) (pow-helper x (- n 1) (* acc x))] + [(< n 0) (pow-helper x (+ n 1) (* acc (/ 1 x)))])) + (pow-helper x n 1)) + +;; Expandtion of the below macro: +;; (define (natural-number? n) +;; (if (and (interger? n) (>= n 0) #t #f))) + +(define natural-number? + (lambda (n) + (if (and (integer? n) (>= n 0)) #t #f))) + +(define average-num + (lambda lst + (/ (apply + lst) (length lst)))) + +(define (average-list lst) + (define (sum-list lst acc) + (cond [(empty? lst) acc] + [else (sum-list (rest lst) (+ acc (first lst)))])) + (/ (sum-list lst 0) (length lst))) + +;; increasing common interval +(define (icd-interval i j d) + (define (icd-interval-helper i j d acc) + (cond [(> i j) acc] + [else (icd-interval-helper (+ i d) j d (cons i acc))])) + (if (> i j) + (error "i > j for a increasing common interval list to be generated!") + (reverse (icd-interval-helper i j d empty)))) + +;; interval num num -> listof(num) +;; Purpose: Given two +(define (interval i j) + (define (interval-helper i j acc) + (cond [(> i j) acc] + [else (interval-helper (+ i 1) j (cons i acc))])) + (reverse (interval-helper i j empty))) + +;; common poduct interval +(define (cp-interval i j m) + (map (lambda (x) (if (= x 0) x (* m x))) (interval i j))) + +;; letrec is cool :P +;; (letrec [(fact! (lambda (n) (if (<= n 1) 1 (* n (fact! (- n 1))))))] +;; (fact! 5)) + +;; take a looksi at racket/tcp and racket/ssl + +(define (client) + (let-values ([(s-in s-out) (tcp-connect "localhost" 1342)]) + (let ([read-and-display + (lambda (in-port) + (let ([responce (read in-port)]) + (display responce) + (newline)))]) + (read-and-display s-in) + (write (read-line (current-input-port) 'return-linefeed) s-out) + (close-output-port s-out) + (read-and-display s-in) + (close-input-port s-in)))) + +;; server +(define listener (tcp-listen 1342)) +(let echo-server () + (define-values (in out) (tcp-accept listener)) + (thread (lambda () + (copy-port in out) + (close-output-port out))) + (echo-server)) + +;; server (Version 2) +(define listener (tcp-listen 1342)) +(define (server) + (let-values ([(in out) (tcp-accept listener)]) + (thread (lambda () + (copy-port in out) + (close-output-port out)))) + (server)) + +(define (read-it-all f-in [acc ""]) + (let ([line (read-line f-in)]) + (if (eof-object? line) (begin acc (close-input-port f-in)) (read-it-all f-in (string-append acc line "\n"))))) + +;; takes a lowercase char and returns it shifted by 13 characters +(define (rot-char char) + (cond [(or (char-symbolic? char) (char-numeric? char) (char-whitespace? char)) char] + [(< (char->integer char) 109) (integer->char (modulo (+ (char->integer char) 13) 122))] + [else (integer->char (+ 96 (modulo (+ (char->integer char) 13) 122)))])) + +(define (rot13 str) + (letrec ([rot13-helper (lambda (lst acc) + (cond [(empty? lst) acc] + [(char-upper-case? (first lst)) (rot13-helper (rest lst) (cons (char-upcase (rot-char (char-downcase (first lst)))) acc))] + [else (rot13-helper (rest lst) (cons (rot-char (first lst)) acc))]))]) + (list->string (reverse (rot13-helper (string->list str) empty))))) + +;; a much better written rot13 which takes advantage of testing intervals +(define (best-rot13 str) + (letrec + ;; add-to-char char int -> char + ;; Purpose: takes the unicode value of the given char and adds n evauluating to the char the additions represents + ([add-to-char (lambda (char n) + (integer->char (+ n (char->integer char))))] + ;; best-rot listof(char) (or listof(char) acc) -> listof(char) + ;; Purpose: Given a list of characters returns the rot13 representation + [best-rot + (lambda (lst acc) + (cond [(empty? lst) acc] + [(<= 65 (char->integer (first lst)) 77) (best-rot (rest lst) (cons (add-to-char (first lst) 13) acc))] + [(<= 78 (char->integer (first lst)) 90) (best-rot (rest lst) (cons (add-to-char (first lst) -13) acc))] + [(<= 97 (char->integer (first lst)) 109) (best-rot (rest lst) (cons (add-to-char (first lst) 13) acc))] + [(<= 110 (char->integer (first lst)) 122) (best-rot (rest lst) (cons (add-to-char (first lst) -13) acc))] + [else (best-rot (rest lst) (cons (first lst) acc))]))]) + (list->string (reverse (best-rot (string->list str) empty))))) + +;; map defined in terms of foldr +(define (foldr-map fn lst) + (foldr (lambda (x y) (cons (fn x) y)) empty lst)) + +(define (foldr-copy lst) + (foldr cons empty lst)) + +(define (compose fn1 fn2) + (lambda (x) (fn1 (fn2 x)))) + +(define (foldr-append lst1 lst2) + (foldr cons lst2 lst1)) + +(define (foldr-length lst) + (foldr (lambda (x y) (+ y 1)) 0 lst)) + +(define (foldr-sum lst) + (foldr + 0 lst)) + +;; broken..needs to know the number of digits of the number n +(define (nth-digit n i) + (let ([f (/ n (expt 10 (+ i 1)))]) + (floor (* 10 (- f (floor f)))))) + +(define (merge xs ys) + (cond [(and (empty? xs) (empty? ys)) empty] + [(empty? xs) ys] + [(empty? ys) xs] + [(< (first xs) (first ys)) (cons (first xs) (merge (rest xs) ys))] + [(equal? (first xs) (first ys)) + (cons (first xs) (cons (first ys) (merge (rest xs) (rest ys))))] + [else (cons (first ys) (merge xs (rest ys)))])) + + +(define (merge-sort xs) + (cond [(empty? xs) empty] + [(empty? (rest xs)) xs] + [else (merge (merge-sort (take xs (quotient (length xs) 2))) + (merge-sort (drop xs (quotient (length xs) 2))))])) + +(define (append-all a b) + (cond [(and (list? a) (list? b)) (append a b)] + [(list? a) (append a (list b))] + [(list? b) (cons a b)] + [else (list a b)])) + +(define (my-append xs ys) + (cond [(empty? xs) ys] + [else (cons (first xs) (my-append (rest xs) ys))])) + +(define (my-append2 xs ys) + (define (my-append2-h sx acc) + (cond [(empty? sx) acc] + [else (my-append2-h (rest sx) (cons (first sx) acc))])) + (my-append2-h (reverse xs) ys)) + +(define (my-append3 xs ys) + (foldr cons ys xs)) + +;; TODO: do the big-oh analysis of the flatten functions below +(define (my-flatten xs) + (cond [(empty? xs) '()] + [(list? (first xs)) (append (my-flatten (first xs)) (my-flatten (rest xs)))] + [else (cons (first xs) (my-flatten (rest xs)))])) + +(define (my-flatten2 xs) + (define (my-flatten2-h xs acc) + (cond [(empty? xs) acc] + [(list? (first xs)) + (my-flatten2-h (rest xs) (append (my-flatten2-h (first xs) '()) acc))] + [else (my-flatten2-h (rest xs) (cons (first xs) acc))])) + (reverse (my-flatten2-h xs '()))) diff --git a/Racket/test.s b/Racket/test.s new file mode 100644 index 0000000..51b5d3e --- /dev/null +++ b/Racket/test.s @@ -0,0 +1,21 @@ + .file "test.c" + .text + .globl main + .type main, @function +main: +.LFB0: + .cfi_startproc + pushq %rbp + .cfi_def_cfa_offset 16 + .cfi_offset 6, -16 + movq %rsp, %rbp + .cfi_def_cfa_register 6 + movl $0, %eax + popq %rbp + .cfi_def_cfa 7, 8 + ret + .cfi_endproc +.LFE0: + .size main, .-main + .ident "GCC: (GNU) 4.7.1" + .section .note.GNU-stack,"",@progbits diff --git a/Ruby/rdm.rb b/Ruby/rdm.rb new file mode 100644 index 0000000..01ca160 --- /dev/null +++ b/Ruby/rdm.rb @@ -0,0 +1,16 @@ +# File: rdm.rb +# Date: 02/10/2010 +# Author: Collin J. Doering +# Description: Random source file to experiment while learning ruby + +class Point + attr_accessor :x, :y + + def initialize(x=0,y=0) + @x, @y = x, y + end + + def self.add(p1,p2) + Point.new(p1.x + p2.x, p1.y + p2.y) + end + end diff --git a/SML/rdm.ml b/SML/rdm.ml new file mode 100644 index 0000000..28d2cb6 --- /dev/null +++ b/SML/rdm.ml @@ -0,0 +1,25 @@ +(* + * (C) Copyright Collin Doering 2012 + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) + +(* + * File: rdm.ml + * Author: Collin J. Doering + * Date: Jun 27, 2012 + *) + +(* simple hello world example *) +print_endline "Hello World!" diff --git a/SML/rdm.sml b/SML/rdm.sml new file mode 100644 index 0000000..dfc0198 --- /dev/null +++ b/SML/rdm.sml @@ -0,0 +1,107 @@ +(* (C) Copyright Collin Doering 2013 + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + + * File: rdm.sml + * Author: Collin J. Doering + * Date: Jan 30, 2013 + *) + +(* int -> int option *) +fun factorial (n : int) = + let + (* int * int -> int option *) + fun fact (n : int, acc : int) = + if n > 0 then fact(n - 1, n * acc) else acc + in + if n < 0 then NONE else SOME (fact(n,1)) + end + +(* int * int -> int option *) +fun expodentiate (base : int, exp : int) = + let + (* int * int -> int *) + fun expodentiateh (exp : int, acc : int) = + if exp = 0 then acc else expodentiateh(exp - 1, base * acc) + in + if exp < 0 then NONE + else if base = 0 then SOME 0 + else SOME (expodentiateh(exp, 1)) + end + +(* ('a * 'b -> 'b) * 'b * 'a list -> 'b *) +fun myfoldr (f, i, xs) = + if null xs then i else f(hd xs, myfoldr(f, i, tl xs)) + + +fun mymap f [] = [] + | mymap f (x::xs) = f(x)::mymap f xs + +(* de-sugared version of the above function mymap *) +fun mymap' f = + fn xs => case xs of + [] => [] + | x::xs => f(x)::(mymap' f xs) + +(* ('a -> 'b) * 'a list -> 'b list *) +fun mymap2 f xs = + let fun aux [] acc = acc + | aux (x::xs) acc = aux xs (f(x)::acc) + in + rev (aux xs []) + end + +datatype ThreeNums = ONE | TWO | THREE + +(* ThreeNums -> Int *) +fun evalthreenum ONE = 1 + | evalthreenum TWO = 2 + | evalthreenum THREE = 3 + +(* a few cool functions having to do with currying *) + +(* ('a * 'b -> 'c) -> 'a -> 'b -> 'c *) +fun curry f a b = f(a,b) +(* de-sugared: fun curry f = fn a => fn b => f(a.b) *) + +(* ('a -> 'b -> 'c) -> ('a * 'b -> 'c) *) +fun uncurry f (a,b) = f a b +(* de-sugared: fun uncurry f = fn (a,b) => f a b *) + +(* A list datatype *) +datatype 'a List = Nil + | Cons of 'a * 'a List + +fun list2nativelist Nil = [] + | list2nativelist (Cons(x,xs)) = x::(list2nativelist xs) + +datatype 'a BTree = Empty + | Node of 'a * 'a BTree * 'a BTree + +fun leaf a = Node(a,Empty,Empty) + +(* 'a BTree -> 'a -> 'a BTree *) +fun insert a Empty = leaf a + | insert a (Node(b,Empty,Empty)) = if a = b + then leaf b + else if a < b + then Node(b,leaf a,Empty) + else Node(b,Empty,leaf a) + | insert a (Node(b,rhs,lhs)) = if a = b + then Node(b,rhs,lhs) + else if a < b + then Node(b,insert a rhs,lhs) + else Node(b,rhs,insert a lhs) + +val tr = Node(2,leaf 1,leaf 3) diff --git a/Scala/rdm.scala b/Scala/rdm.scala new file mode 100644 index 0000000..d004738 --- /dev/null +++ b/Scala/rdm.scala @@ -0,0 +1,87 @@ +package ca.rekahsoft.rdm + +/** + * (C) Copyright Collin Doering @!@YEAR@!@ + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . +*/ + +/** + * File: rdm.scala + * Author: Collin J. Doering + * Date: Jun 20, 2013 + */ + +def and(x: Boolean, y: => Boolean): Boolean = if (x) y else false + +def or(x: Boolean, y: => Boolean): Boolean = if (x) true else y + +def factorial(n: Int): Int = { + def fact(x: Int, acc: Int): Int = if (x <= 1) acc else fact(x - 1, x * acc) + fact(n,1) +} + +// An implementation of a list (covariant) +trait List[+T] { + def isEmpty: Boolean + def head: T + def tail: List[T] +} + +class Cons[T](val head: T, var tail: List[T]) extends List[T]{ + def isEmpty = false +} + +object Nil extends List[Nothing] { + def isEmpty: Boolean = true + def head: Nothing = throw new Error("Nil.head") + def tail: Nothing = throw new Error("Nil.head") +} + +// An implementation of Natural numbers +abstract class Nat { + def isZero: Boolean + def pred: Nat + def + (x: Nat): Nat + def - (x: Nat): Nat +} + +class Succ(n: Nat) extends Nat { + def isZero = false + def pred = n + def succ: Nat = new Succ(this) + def + (x: Nat) = new Succ(n + x) + def - (x: Nat) = if (x.isZero) this else n - x.pred +} + +object Zero extends Nat { + def isZero = true + def pred = throw new Error("Zero.pred") + def succ: Nat = new Succ(this) + def + (x: Nat) = x + def - (x: Nat) = if (x.isZero) this else throw new Error("negative number") +} + +/* Note: the above use of var is shortform: + * class Test[T](var x: T) + * is transformed to: + * class Test[T](x: T) { + * var x = x + * } + */ + +// Implement a BST +trait BTree[T] { +} + diff --git a/Scheme/rdm.scm b/Scheme/rdm.scm new file mode 100644 index 0000000..8df66b1 --- /dev/null +++ b/Scheme/rdm.scm @@ -0,0 +1,21 @@ +;; (C) Copyright Collin Doering 2011 +;; +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;; File: rdm.scm +;; Author: Collin J. Doering +;; Date: Jun 27, 2011 + +(define (my-map fn lst) + (if (null? lst) '() (cons (fn (car lst)) (my-map fn (cdr lst))))) diff --git a/Shell/shell-quine.sh b/Shell/shell-quine.sh new file mode 100755 index 0000000..64cdd95 --- /dev/null +++ b/Shell/shell-quine.sh @@ -0,0 +1,7 @@ +#!/bin/sh +D="echo \"#!/bin/sh\"\necho \"D=\"\`echo -E \$D\`\"\necho -e \"\$D\"\n" +echo "#!/bin/sh" +echo "D=\"`echo -E $D`\"" +echo -e "$D" + +# still not working :(