426 lines
12 KiB
Markdown
426 lines
12 KiB
Markdown
---
|
|
title: A New Post
|
|
author: Collin J. Doering
|
|
date: 2013-12-18
|
|
description: An Article about nothing really
|
|
updated: 2013-12-07
|
|
tags: general, programming, linux
|
|
---
|
|
|
|
Run a manual sweep of anomalous airborne or electromagnetic readings. Radiation levels in our atmosphere have increased by 3,000 percent. Electromagnetic and subspace wave fronts approaching synchronization. What is the strength of the ship's deflector shields at maximum output? The wormhole's size and short period would make this a local phenomenon. Do you have sufficient data to compile a holographic simulation?
|
|
|
|
<!--more-->
|
|
Exceeding reaction chamber thermal limit. We have begun power-supply calibration. Force fields have been established on all turbo lifts and crawlways. Computer, run a level-two diagnostic on warp-drive systems. Antimatter containment positive. Warp drive within normal parameters. I read an ion trail characteristic of a freighter escape pod. The bomb had a molecular-decay detonator. Detecting some unusual fluctuations in subspace frequencies.
|
|
|
|
``` {.haskell .code-term .numberLines}
|
|
{-# 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
|
|
|
|
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
|
|
```
|