@ -0,0 +1 @@ | |||
*~ |
@ -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 <http://www.gnu.org/licenses/>. | |||
*/ | |||
/** | |||
* 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 | |||
} |
@ -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 <http://www.gnu.org/licenses/>. | |||
;; File: rdm.asm | |||
;; Author: Collin J. Doering <rekahsoft@gmail.com> | |||
;; Date: Mar 22, 2012 |
@ -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 <http://www.gnu.org/licenses/>. | |||
*/ | |||
/** | |||
* File: test.c | |||
* Author: Collin J. Doering | |||
* Date: Jun 27, 2012 | |||
*/ | |||
int main () { | |||
return 0; | |||
} |
@ -0,0 +1,13 @@ | |||
;; File: rdm.clj | |||
;; Author: Collin J. Doering <rekahsoft@gmail.com> | |||
;; 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))))) |
@ -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] |
@ -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 <http://www.gnu.org/licenses/>. | |||
% File: rdm.erl | |||
% Author: Collin J. Doering <rekahsoft@gmail.com> | |||
% Date: Jun 27, 2012 | |||
% setup emacs for erlang (don't really know it tho) |
@ -0,0 +1,78 @@ | |||
-- File: BinaryTree.hs | |||
-- Date: Oct 28, 2011 | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 |
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: EchoClient.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 |
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: EchoServer.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 |
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: Expressions.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 :( |
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: InfixExpressions.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 |
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: PostFixExpressions.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 | |||
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: Quine.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 <http://www.gnu.org/licenses/>." | |||
, "" | |||
, "-- File: haskell-quine.hs" | |||
, "-- Author: Collin J. Doering <rekahsoft@gmail.com>" | |||
, "-- 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 |
@ -0,0 +1,2 @@ | |||
a = "main = putStrLn $ \"a = \" ++ show a ++ \"\\n\" ++ a" | |||
main = putStrLn $ "a = " ++ show a ++ "\n" ++ a |
@ -0,0 +1,67 @@ | |||
-- File: StringParse.hs | |||
-- Date: Oct 26, 2011 | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 | |||
@ -0,0 +1,26 @@ | |||
-- File: helloworld.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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| | |||
<p>this is a test paragraph. And here is some variable interpolation:<br/> | |||
#{testvar} | |||
|] | |||
where testvar = "here is a var!" :: String | |||
main :: IO () | |||
main = warpDebug 3000 HelloWorld |
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: Matrix.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 |
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: Test.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- Date: Feb 5, 2014 | |||
import Vector | |||
import Matrix | |||
import Test.QuickCheck | |||
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: Vector.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 |
@ -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 <http://www.gnu.org/licenses/>. | |||
-- File: polynomials.hs | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 |
@ -0,0 +1,420 @@ | |||
{-# LANGUAGE ExistentialQuantification #-} | |||
-- File: rdm.hs | |||
-- Date: 02/10/2010 | |||
-- Author: Collin J. Doering <rekahsoft@gmail.com> | |||
-- 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 |
@ -0,0 +1,13 @@ | |||
/** | |||
* File: rdm.java | |||
* Author: Collin J. Doering <rekahsoft@gmail.com> | |||
* 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.."); | |||
} | |||
} |
@ -0,0 +1,831 @@ | |||
;;; -*- Package: USER; Mode: LISP; Syntax: Common-lisp -*- | |||
;;(in-package "USER") | |||
;; Author: Jason Eisner <jason@cs.jhu.edu>, 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))) | |||