Initial commit
Signed-off-by: Collin J. Doering <rekahsoft@gmail.com>
This commit is contained in:
commit
ff5e7cf58e
|
@ -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
|
Binary file not shown.
|
@ -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
|
||||||
|
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
@ -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
|
Binary file not shown.
Binary file not shown.
Binary file not shown.
|
@ -0,0 +1,2 @@
|
||||||
|
a = "main = putStrLn $ \"a = \" ++ show a ++ \"\\n\" ++ a"
|
||||||
|
main = putStrLn $ "a = " ++ show a ++ "\n" ++ a
|
Binary file not shown.
|
@ -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
|
||||||
|
|
Binary file not shown.
Binary file not shown.
|
@ -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)))
|
||||||
|
|
||||||
|
|
||||||
|
;; 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))
|
||||||
|
|
|
@ -0,0 +1,76 @@
|
||||||
|
;; File: rdm.lisp
|
||||||
|
;; Date: 28/08/2010
|
||||||
|
;; Author: Collin J. Doering <rekahsoft@gmail.com
|
||||||
|
;; Description: Random source file to experiment while learning common lisp
|
||||||
|
|
||||||
|
(defun factorial (x &optional (acc 1))
|
||||||
|
(cond ((<= x 1) acc)
|
||||||
|
(T (factorial (- x 1) (* acc x)))))
|
||||||
|
|
||||||
|
;; perhaps a nicer factorial function which instead of having
|
||||||
|
;; the accumulator as a optional variable accessable by the user
|
||||||
|
;; hides it internally using labels
|
||||||
|
(defun factorial1 (x)
|
||||||
|
(labels ((factorial1-helper (n acc)
|
||||||
|
(if (<= n 0)
|
||||||
|
acc
|
||||||
|
(factorial1-helper (- n 1) (* acc n)))))
|
||||||
|
(factorial1-helper x 1)))
|
||||||
|
|
||||||
|
;; Old version of pow depreciated becauseit failed to hide the accumulator
|
||||||
|
;; (defun pow (x n &optional (acc 1))
|
||||||
|
;; (cond ((= n 0) acc)
|
||||||
|
;; ((> 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))))
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
-- File: rdm.lua
|
||||||
|
-- Author: Collin J. Doering <rekahsoft@gmail.com>
|
||||||
|
-- Date: Jun 27, 2012
|
||||||
|
|
||||||
|
function square(x)
|
||||||
|
return x * x;
|
||||||
|
end
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/**
|
||||||
|
* File: rdm.php
|
||||||
|
* Author: Collin J. Doering
|
||||||
|
* Date: Jun 27, 2012
|
||||||
|
*/
|
||||||
|
|
||||||
|
function square (x) {
|
||||||
|
return x * x;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
|
@ -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: rdm.py
|
||||||
|
# Author: Collin J. Doering <rekahsoft@gmail.com>
|
||||||
|
# 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
|
||||||
|
|
|
@ -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
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;; File: post-fix-expressions.rkt
|
||||||
|
;; Author: Collin J. Doering <rekahsoft@gmail.com>
|
||||||
|
;; 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))
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;; File: rdm-typed.rkt
|
||||||
|
;; Author: Collin J. Doering <rekahsoft@gmail.com>
|
||||||
|
;; 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))
|
|
@ -0,0 +1,297 @@
|
||||||
|
#lang racket
|
||||||
|
|
||||||
|
;; File: rdm.rkt
|
||||||
|
;; Date: Oct 25, 2010
|
||||||
|
;; Author: Collin J. Doering <rekahsoft@gmail.com
|
||||||
|
;; Description: Random source file to experiment while learning racket (plt scheme)
|
||||||
|
|
||||||
|
;; factorial int[>=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 '())))
|
|
@ -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
|
|
@ -0,0 +1,16 @@
|
||||||
|
# File: rdm.rb
|
||||||
|
# Date: 02/10/2010
|
||||||
|
# Author: Collin J. Doering <rekahsoft@gmail.com>
|
||||||
|
# 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
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*
|
||||||
|
* File: rdm.ml
|
||||||
|
* Author: Collin J. Doering
|
||||||
|
* Date: Jun 27, 2012
|
||||||
|
*)
|
||||||
|
|
||||||
|
(* simple hello world example *)
|
||||||
|
print_endline "Hello World!"
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
* File: rdm.sml
|
||||||
|
* Author: Collin J. Doering <rekahsoft@gmail.com>
|
||||||
|
* 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)
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/**
|
||||||
|
* 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] {
|
||||||
|
}
|
||||||
|
|
|
@ -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 <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;; File: rdm.scm
|
||||||
|
;; Author: Collin J. Doering <rekahsoft@gmail.com>
|
||||||
|
;; Date: Jun 27, 2011
|
||||||
|
|
||||||
|
(define (my-map fn lst)
|
||||||
|
(if (null? lst) '() (cons (fn (car lst)) (my-map fn (cdr lst)))))
|
|
@ -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 :(
|
Loading…
Reference in New Issue