commit 469b5b2b3da791ea1660eaf8e35fd3ab238580fb Author: saundersp Date: Sun Jun 25 00:25:50 2023 +0200 Added files diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..539fcfd --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.hi +*.o +Main +Problems diff --git a/Main.hs b/Main.hs new file mode 100644 index 0000000..19b45f7 --- /dev/null +++ b/Main.hs @@ -0,0 +1,150 @@ +import Problems ( myLast, lastTwo, kth, myLength, rev, isPalindrome, flatten, NestedList(..), compress, pack, encode ) +--import Primes ( aspGetNextPrime, aspIsPrime, aspPrimes ) +import Data.Numbers.Primes ( isPrime, primes, primeFactors ) +import Math ( mandlebrot ) + +-- Unit testing +main :: IO() +main = do + testMisc + testProblems + testPrimes + mandlebrot + +testMisc :: IO() +testMisc = do + putStrLn ("A ranged list from 1 to 1 is " ++ show (range 1 1)) + putStrLn ("A ranged list from -2 to 7 is " ++ show (range (-2) 7)) + putStrLn ("A ranged list from 7 to -2 is " ++ show (range 7 (-2))) + + let tab = [2,1,10,6,3,8,1,1,6,3] :: [Int] + putStrLn ("The initial list is " ++ show tab) + putStrLn ("The unique list is " ++ show (nub tab)) + + putStrLn ("Is the initial list in ascending order ? " ++ show (isAsc tab)) + putStrLn ("Is 1..10 in ascending order ? " ++ show (isAsc (range 1 10))) + putStrLn ("Is 10..1 in ascending order ? " ++ show (isAsc (range 10 1))) + + putStrLn ("Is 3 is the list ? : " ++ show (isInList 3 tab)) + putStrLn ("Is 4 is the list ? : " ++ show (isInList 4 tab)) + putStrLn ("Is 5 is the list ? : " ++ show (isInList 5 tab)) + putStrLn ("Is 10 is the list ? : " ++ show (isInList 10 tab)) + + putStrLn ("The sorted list is " ++ show (sortList tab)) + + putStrLn ("The reverse sorted list is " ++ show (revSortList tab)) + + putStrLn ("FizzBuzz 50 " ++ show (fizzBuzz [0..50])) + + putStrLn ("Fionacci 10 " ++ show (fibonacci 10)) + putStrLn ("FionacciList 10 " ++ show (fibonnaciSequence 10)) + +testProblems:: IO() +testProblems = do + let assert :: (Eq a) => (Show a) => String -> a -> a -> String + assert n r e = "Problem " ++ n ++ (if r == e then " Success" else " Failed, expected " ++ show e ++ " but got " ++ show r) + + putStrLn (assert "1a" (myLast [1, 2, 3, 4]) (Just 4)) + putStrLn (assert "1b" (myLast ([] :: [Bool])) Nothing) + putStrLn (assert "1c" (myLast ['x', 'y', 'z']) (Just 'z')) + putStrLn (assert "2a" (lastTwo ['a', 'b', 'c', 'd']) (Just ('c', 'd'))) + putStrLn (assert "2b" (lastTwo ['a']) Nothing) + putStrLn (assert "3a" (kth ['a', 'b', 'c', 'd', 'e'] 2) (Just 'c')) + putStrLn (assert "3b" (kth ['a'] 2) Nothing) + putStrLn (assert "4a" (myLength ['a', 'b', 'c']) 3) + putStrLn (assert "4b" (myLength []) 0) + putStrLn (assert "4c" (myLength "Hello, world!") 13) + putStrLn (assert "5 " (rev ['a', 'b', 'c']) ['c', 'b', 'a']) + putStrLn (assert "6a" (isPalindrome ['x', 'a', 'm', 'a', 'x']) True) + putStrLn (assert "6b" (isPalindrome ['a', 'b']) False) + putStrLn (assert "7a" (flatten (Elem 5)) [5]) + putStrLn (assert "7b" (flatten (List [Elem 1, List [Elem 2, List [Elem 3, Elem 4], Elem 5]])) [1, 2, 3, 4, 5]) + putStrLn (assert "7c" (flatten (List [])) ([] :: [Int])) + putStrLn (assert "8 " (compress "aaabccaadeeee") "abcade") + putStrLn (assert "9 " (pack ['a', 'a', 'a', 'a', 'b', 'c', 'c', 'a', 'a', 'd', 'e', 'e', 'e', 'e']) ["aaaa", "b", "cc", "aa", "d", "eeee"]) + --putStrLn (assert "10" (encode "aaabccaadeeee") [(4, 'a'),(1, 'b'),(2, 'c'),(2, 'a'),(1, 'd'),(4, 'e')]) + +testPrimes:: IO() +testPrimes = do + putStrLn ("Is 2 prime ? " ++ show (isPrime 2)) + putStrLn ("Is 15 prime ? " ++ show (isPrime 15)) + putStrLn ("Is 17 prime ? " ++ show (isPrime 17)) + + --putStrLn ("ASP : Is 2 prime ? " ++ show (aspIsPrime 2)) + --putStrLn ("ASP : Is 15 prime ? " ++ show (aspIsPrime 15)) + --putStrLn ("ASP : Is 17 prime ? " ++ show (aspIsPrime 17)) + + putStrLn ("primeFactors 15 " ++ show (primeFactors 15)) + putStrLn ("primeFactors 45154 " ++ show (primeFactors 45154)) + + --putStrLn ("ASP : primeFactors 15 " ++ show (aspPrimeFactors 15)) + --putStrLn ("ASP : primeFactors 45154 " ++ show (aspPrimeFactors 45154)) + + putStrLn ("primes : " ++ show (take 15 primes)) + --putStrLn ("ASP : primes : " ++ show (take 15 aspPrimes)) + +-- Sorting a given list +sortList :: [Int] -> [Int] +sortList [] = [] +sortList (x:xs) = sortList ys ++ [x] ++ sortList zs + where + ys = [a | a <- xs, a < x] + zs = [a | a <- xs, a >= x] + +-- Reverse sorting a given list +revSortList :: [Int] -> [Int] +revSortList [] = [] +revSortList (x:xs) = revSortList ys ++ [x] ++ revSortList zs + where + ys = [a | a <- xs, a >= x] + zs = [a | a <- xs, a < x] + +-- Is a certain element in a given list ? +isInList :: (Eq a) => a -> [a] -> Bool +isInList _ [] = False +isInList e (x:xs) = (e == x) || isInList e xs + +-- Create a list between from a to b +range :: Int -> Int -> [Int] +range a b + | a == b = [b] + | a > b = rev (range b a) + | otherwise = [a..b] + +-- Remove all duplicates from a given list +nub :: (Eq a) => [a] -> [a] +nub [] = [] +-- Remove duplicates after (tail recursion) +nub (x:xs) = x : nub [a | a <- xs, a /= x] +-- Remove duplicates before (no tail recursion) +--nub (x:xs) = if x `elem` xs then nub xs else x : nub xs + +-- Is a given list in an ascending order ? +isAsc :: (Ord t) => [t] -> Bool +isAsc [] = True +isAsc [x] = True +isAsc (x:y:xs) = (x <= y) && isAsc (y:xs) + +-- FizzBuzz +fizzBuzz :: [Int] -> [[Char]] +fizzBuzz [] = [] +fizzBuzz (x:xs) = isFizzBuzz x : fizzBuzz xs + where + isFizzBuzz :: Int -> [Char] + isFizzBuzz x + | mod x 15 == 0 = "FizzBuzz" + | mod x 5 == 0 = "Buzz" + | mod x 3 == 0 = "Fizz" + | otherwise = show x + +-- Fibonnaci number at indice n +fibonacci :: Int -> Int +fibonacci 0 = 0 +fibonacci 1 = 1 +fibonacci n = fibonacci (n - 1) + fibonacci (n - 2) + +-- Fibonnaci sequence until indice n +fibonnaciSequence :: Int -> [Int] +fibonnaciSequence 0 = [0] +fibonnaciSequence 1 = [1] +fibonnaciSequence n = fibonnaciSequence (n - 1) ++ [fibonacci n] diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..2210eda --- /dev/null +++ b/Makefile @@ -0,0 +1,15 @@ +.PHONY: all Main debug start clean + +all: Main + +Main: Main.hs + @ghc -Wno-tabs Main.hs + +start: Main + @./Main + +debug: Main.hs + @ghc -Wno-tabs -keep-hc-files -keep-tmp-files $^ + +clean: + @rm *.hi Main *.o || true diff --git a/Math.hs b/Math.hs new file mode 100644 index 0000000..a74cf7f --- /dev/null +++ b/Math.hs @@ -0,0 +1,60 @@ +module Math ( mandlebrot ) where + +import Graphics.UI.GLUT +import Data.Complex + +iterations = 10 + +x // y = fromIntegral x / fromIntegral y + +-- Divides [a] into [[a], [a], ...] with each sublist of length n, +-- except the last sublist which has length <= n +chunkify n [] = [] +chunkify n xs = let (xs', rest) = splitAt n xs + in xs' : chunkify n rest + +-- Converts a coordinate in screen space to a vertex. +pix2vert (Size w h) (x, y) = Vertex2 ((3 // w * fromIntegral x) - 2.0) + ((2 // h * fromIntegral y) - 1.0) + +-- List of all the vertices that represent screen pixels. +vertices :: IO [Vertex2 GLfloat] +vertices = get windowSize >>= \(Size w h) -> return $ [pix2vert (Size w h) (x, y) | x <- [0..w-1], y <- [0..h-1]] + +-- Gets the color for a number of iterations. +getcolor :: Int -> Color3 Float +getcolor iter | iter == iterations = Color3 0 0 0 + | otherwise = Color3 (amt * 0.5) amt (amt * 0.5) + where amt = iter // iterations + +-- Returns the number of iterations <= the maximum iterations of the Mandlebrot set at the given vertex +mandel (Vertex2 r i) = length . takeWhile (\z -> magnitude z <= 2) . + take iterations $ iterate (\z -> z^2 + (r :+ i)) 0 + +-- plots one point. +drawVert v = do color . getcolor $ mandel v + vertex v + +-- draws all th vertices in slices (to update the display while drawing). +display' chunks = do mapM_ (\vs -> do renderPrimitive Points $ mapM_ drawVert vs + flush) chunks + displayCallback $= display + +display = do clear [ ColorBuffer ] + displayCallback $= (vertices >>= display' . chunkify 256) + get currentWindow >>= postRedisplay + +mandlebrot = do + getArgsAndInitialize + initialDisplayMode $= [ SingleBuffered, RGBMode ] + --initialWindowSize $= Size 1200 1024 + --initialWindowPosition $= Position 100 100 + createWindow "Mandlebrot" + clearColor $= Color4 0 0 0 0 + matrixMode $= Projection + loadIdentity + --ortho (-3) 1 (-1) 1 (-1) 1 + --ortho (-2) 1 (-1) 1 (-1) 1 + ortho (-3) 1 (-1) 1 (-1) 1 + displayCallback $= display + mainLoop diff --git a/Primes.hs b/Primes.hs new file mode 100644 index 0000000..18968ec --- /dev/null +++ b/Primes.hs @@ -0,0 +1,21 @@ +module Primes ( aspGetNextPrime, aspIsPrime, aspPrimes ) where +import Problems ( kth ) + +aspGetNextPrime :: Int -> Int +aspGetNextPrime 1 = 2 +aspGetNextPrime 2 = 3 +aspGetNextPrime n + | otherwise = aspGetNextPrime (n + 2) + +aspIsPrime :: Int -> Bool +aspIsPrime 1 = False +aspIsPrime n = mod n (aspGetNextPrime 1) == 0 +-- where +-- recMod + +--aspPrimeFactors :: Int -> [Int] +--aspPrimeFactors 1 = [1] + +--aspPrimes :: (Integral Int) => [Int] +aspPrimes = sieve [2..] + where sieve (x:xs) = [ x | x <- xs, x mod p == 0] diff --git a/Problems.hs b/Problems.hs new file mode 100644 index 0000000..e5ef983 --- /dev/null +++ b/Problems.hs @@ -0,0 +1,98 @@ +module Problems ( myLast, lastTwo, kth, myLength, rev, isPalindrome, flatten, NestedList(..), compress, pack, encode ) where +-- H99: Ninety-Nine Haskell Problems +-- https://wiki.haskell.org/H-99:_Ninety-Nine_Haskell_Problems + +-- Find the last element of a list. +myLast :: [t] -> Maybe t +myLast [] = Nothing +myLast [x] = Just x +myLast (x:xs) = myLast xs + +-- Find the last but one element of a list. +lastTwo :: [t] -> Maybe (t, t) +lastTwo [] = Nothing +lastTwo [x] = Nothing +lastTwo [x, y] = Just(x, y) +lastTwo (x:y:xs) = lastTwo xs + +-- Find the K'th element of a list. The first element in the list is number 1. +kth :: [t] -> Int -> Maybe t +kth [] _ = Nothing +kth (x:xs) n = if n == 0 then Just x else kth xs (n - 1) + +-- Find the number of elements of a list. +myLength :: [t] -> Int +myLength [] = 0 +--myLength (_:xs) = 1 + myLength xs +myLength (_:xs) = subMyLength xs 0 + 1 + where + subMyLength :: [t] -> Int -> Int + subMyLength [] n = n + subMyLength (_:ys) n = subMyLength ys (n + 1) + +-- Reverse a list +rev :: [t] -> [t] +rev [] = [] +rev (x:xs) = rev xs ++ [x] + +-- Palindrome +isPalindrome :: (Eq t) => [t] -> Bool +isPalindrome [] = True +--isPalindrome (x:xs) = (x == y) && equal_list xs ys +-- where +-- equal_list :: [t] -> [t] -> Bool +-- equal_list [] [] = True +-- equal_list (x1:x1s) (y1:y1s) = (x1 == y1) && equal_list x1s y1s +-- (y:ys) = rev (x:xs) +isPalindrome (x:xs) = (x == y) && (xs == ys) + where (y:ys) = rev (x:xs) + +-- Flatten a list +data NestedList a = Elem a | List [NestedList a] +flatten :: NestedList a -> [a] +flatten (List []) = [] +flatten (Elem a) = [a] +flatten (List (x:xs)) = flatten x ++ flatten (List xs) + +-- Eliminate consecutive duplicates of list elements. +-- compress :: (Eq t) => [t] -> [t] +-- compress [] = [] +-- compress [x] = [x] +-- compress (x:xs) = x : unique x xs +-- where +-- unique :: (Eq t) => t -> [t] -> [t] +-- unique _ [] = [] +-- unique x (y:ys) = if x == y then unique y ys else y : unique y ys + +compress :: (Eq t) => [t] -> [t] +compress (x:ys@(y:_)) = if x == y then compress ys else x : compress ys +compress x = x + +-- Pack consecutive duplicates of list elements into sublists. +-- If a list contains repeated elements they should be placed in separate sublists. +--pack :: (Eq t) => [t] -> [[t]] +--pack [] = [[]] +--pack [x] = [[x]] +--pack (x:y:xs) +-- | x == y = [x,y] : pack xs +-- | otherwise = [x] : [y] : pack xs + +pack :: (Eq t) => [t] -> [[t]] +pack [] = [] +pack (x:xs) = (x:first) : pack rest + where + getReps [] = ([], []) + getReps (y:ys) + | y == x = let (f, r) = getReps ys in (y:f, r) + | otherwise = ([], y:ys) + (first, rest) = getReps xs + +-- Run-length encoding of a list. +-- Use the result of problem P09 to implement the so-called run-length encoding data compression method. +-- Consecutive duplicates of elements are encoded as lists (N E) where N is the number of duplicates of the element E. +encode :: (Eq t) => [t] -> [(Int, t)] +encode [] = [] +-- encode (x:xs) = [(n,e) | ] +-- where +-- y:ys = pack (x:xs) +