Browse Source

Initial commit

Signed-off-by: Collin J. Doering <rekahsoft@gmail.com>
master
Collin J. Doering 7 years ago
commit
ff5e7cf58e
49 changed files with 3027 additions and 0 deletions
  1. +1
    -0
      .gitignore
  2. +30
    -0
      Arduino/rdm.pde
  3. +18
    -0
      Assembly/rdm.asm
  4. +26
    -0
      C/test.c
  5. +13
    -0
      Clojure/rdm.clj
  6. +18
    -0
      Coffee-Script/rdm.coffee
  7. +20
    -0
      Erlang/rdm.erl
  8. +78
    -0
      Haskell/BinaryTree.hs
  9. BIN
      Haskell/EchoClient
  10. +32
    -0
      Haskell/EchoClient.hs
  11. +52
    -0
      Haskell/EchoServer.hs
  12. +41
    -0
      Haskell/Expressions.hs
  13. +74
    -0
      Haskell/InfixExpressions.hs
  14. +120
    -0
      Haskell/PostFixExpressions.hs
  15. BIN
      Haskell/Quine/Quin2
  16. BIN
      Haskell/Quine/Quine
  17. BIN
      Haskell/Quine/Quine.hi
  18. +44
    -0
      Haskell/Quine/Quine.hs
  19. BIN
      Haskell/Quine/Quine.o
  20. BIN
      Haskell/Quine/haskell-quine-small
  21. BIN
      Haskell/Quine/haskell-quine-small.hi
  22. +2
    -0
      Haskell/Quine/haskell-quine-small.hs
  23. BIN
      Haskell/Quine/haskell-quine-small.o
  24. +67
    -0
      Haskell/StringParse.hs
  25. BIN
      Haskell/echoclient
  26. BIN
      Haskell/echoserve
  27. +26
    -0
      Haskell/helloworld.hs
  28. +121
    -0
      Haskell/lin-alg/Matrix.hs
  29. +23
    -0
      Haskell/lin-alg/Test.hs
  30. +86
    -0
      Haskell/lin-alg/Vector.hs
  31. +31
    -0
      Haskell/polynomials.hs
  32. +420
    -0
      Haskell/rdm.hs
  33. +13
    -0
      Java/Rdm.java
  34. +831
    -0
      Lisp/primes.lisp
  35. +76
    -0
      Lisp/rdm.lisp
  36. +22
    -0
      Lua/rdm.lua
  37. +28
    -0
      PHP/rdm.php
  38. +31
    -0
      Python/rdm.py
  39. +26
    -0
      Racket/helloworld.s
  40. +48
    -0
      Racket/post-fix-expressions.rkt
  41. +28
    -0
      Racket/rdm-typed.rkt
  42. +297
    -0
      Racket/rdm.rkt
  43. +21
    -0
      Racket/test.s
  44. +16
    -0
      Ruby/rdm.rb
  45. +25
    -0
      SML/rdm.ml
  46. +107
    -0
      SML/rdm.sml
  47. +87
    -0
      Scala/rdm.scala
  48. +21
    -0
      Scheme/rdm.scm
  49. +7
    -0
      Shell/shell-quine.sh

+ 1
- 0
.gitignore View File

@ -0,0 +1 @@
*~

+ 30
- 0
Arduino/rdm.pde View File

@ -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
}

+ 18
- 0
Assembly/rdm.asm View File

@ -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

+ 26
- 0
C/test.c View File

@ -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;
}

+ 13
- 0
Clojure/rdm.clj View File

@ -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)))))

+ 18
- 0
Coffee-Script/rdm.coffee View File

@ -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]

+ 20
- 0
Erlang/rdm.erl View File

@ -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)

+ 78
- 0
Haskell/BinaryTree.hs View File

@ -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

BIN
Haskell/EchoClient View File


+ 32
- 0
Haskell/EchoClient.hs View File

@ -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

+ 52
- 0
Haskell/EchoServer.hs View File

@ -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

+ 41
- 0
Haskell/Expressions.hs View File

@ -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 :(

+ 74
- 0
Haskell/InfixExpressions.hs View File

@ -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

+ 120
- 0
Haskell/PostFixExpressions.hs View File

@ -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

BIN
Haskell/Quine/Quin2 View File


BIN
Haskell/Quine/Quine View File


BIN
Haskell/Quine/Quine.hi View File


+ 44
- 0
Haskell/Quine/Quine.hs View File

@ -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

BIN
Haskell/Quine/Quine.o View File


BIN
Haskell/Quine/haskell-quine-small View File


BIN
Haskell/Quine/haskell-quine-small.hi View File


+ 2
- 0
Haskell/Quine/haskell-quine-small.hs View File

@ -0,0 +1,2 @@
a = "main = putStrLn $ \"a = \" ++ show a ++ \"\\n\" ++ a"
main = putStrLn $ "a = " ++ show a ++ "\n" ++ a

BIN
Haskell/Quine/haskell-quine-small.o View File


+ 67
- 0
Haskell/StringParse.hs View File

@ -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

BIN
Haskell/echoclient View File


BIN
Haskell/echoserve View File


+ 26
- 0
Haskell/helloworld.hs View File

@ -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

+ 121
- 0
Haskell/lin-alg/Matrix.hs View File

@ -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

+ 23
- 0
Haskell/lin-alg/Test.hs View File

@ -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

+ 86
- 0
Haskell/lin-alg/Vector.hs View File

@ -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

+ 31
- 0
Haskell/polynomials.hs View File

@ -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

+ 420
- 0
Haskell/rdm.hs View File

@ -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

+ 13
- 0
Java/Rdm.java View File

@ -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..");
}
}

+ 831
- 0
Lisp/primes.lisp View File

@ -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)))