Upload implementation of Deque, Queue on Haskell

Author: csendevel

Deque.hs

@@ -0,0 +1,62 @@
+module Main where
+
+import Prelude hiding (head, tail, last, init)
+
+class Deque q where
+    empty   :: q a
+    isEmpty :: q a -> Bool
+
+    cons    :: a -> q a -> q a
+    head    :: q a -> a
+    tail    :: q a -> q a
+    
+    snoc    :: q a -> a -> q a
+    last    :: q a -> a
+    init    :: q a -> q a
+
+data BankersDeque a = BD Int [a] Int [a] deriving (Show)
+
+c = 3
+
+check lenf f lenr r =
+    if lenf > c*lenr + 1 then
+        let i  = (lenf + lenr) `div` 2
+            j  = lenf + lenr - i
+            f' = take i f
+            r' = r ++ reverse(drop i f)
+        in BD i f' j r'
+    else if lenr > c*lenf + 1 then
+            let j  = (lenf + lenr) `div` 2
+                i  = lenf + lenr - j
+                r' = take j r
+                f' = f ++ reverse(drop j r)
+            in BD i f' j r'
+        else BD lenf f lenr r
+
+instance Deque BankersDeque where
+    empty = BD 0 [] 0 []
+
+    isEmpty (BD lenf f    lenr r)      = (lenr+lenf == 0)
+    
+    --insert forward
+    cons x  (BD lenf f    lenr r)      = check(lenf + 1) (x:f) lenr r
+
+    head (BD lenf []      lenr r)      = error "empty deque"
+    head (BD lenf (x:f')  lenr r)      = x
+
+    tail (BD lenf []      lenr r)      = error "empty deque"
+    tail (BD lenf (x:f')  lenr r)      = check(lenf - 1) f' lenr r
+
+    --insert back
+    snoc (BD lenf f       lenr r) x    = check lenf f (lenr + 1) (x:r)
+
+    last (BD lenf f       lenr [])     = error "empty deque"
+    last (BD lenf f       lenr (x:r')) = x
+
+    --first elements
+    init (BD lenf f       lenr [])     = error "empty deque"
+    init (BD lenf f       lenr (x:r')) = check lenf f (lenr - 1) r'
+
+main :: IO ()
+main = let q = BD 4 [1, 2, 3, 4] 2 [3, 2]
+    in print $ last q

Examples.hs

@@ -0,0 +1,109 @@
+{-# LANGUAGE MultiWayIf #-}
+
+module Main where
+
+import Data.List
+import Data.Char
+
+{- multiline 
+    comment -}
+-- one line comment
+
+--MultiIf
+multiIf :: String -> String
+multiIf t = 
+    if  | t == "Hi" -> "HIII"
+        | t == "Bye" -> "Bye"
+        | otherwise -> " Hmmm"
+
+
+--compairing
+multiEx :: String -> String
+multiEx t  
+        | t == "Hi" = "HIII"
+        | t == "Bye" = "Bye"
+        | otherwise = " Hmmm"
+
+
+--pattern maching
+multiFunc :: String -> String
+multiFunc "HI" = "HELLO"
+multiFunc "Bo" = "BOOOO"
+multiFunc _ = "So good"
+--Rem: pattern mstching up -> down
+
+
+--case .. of
+alice :: String -> String
+alice pattern = 
+    case pattern of
+        "HI" -> "Hello, King"
+        _    -> "Emm...What?"
+
+
+--let it be in
+yourMark :: Int -> Int
+yourMark mark = 
+    let florinskiy_question = True
+        new_mark = 2
+    in 
+        if  | florinskiy_question -> new_mark
+            | otherwise -> mark
+
+
+--new types
+addToList :: String -> [String] -> [String]
+addToList str dict = str : dict
+
+
+--lambda functions
+ten ::[Double]->[Double]
+ten = map (\n->n*10)
+
+
+--your own operator
+(<+>) f g = \x -> f (g x)
+
+
+--composition (map) with lambda
+pretty :: [String] -> [String]
+pretty = map (stars . big)
+    where
+        big = map toUpper
+        stars = \x -> "* " ++ x ++ " *" 
+
+
+main :: IO ()
+main = 
+    print (multiIf "Hi")
+
+    --print (multiEx "wow")
+    
+    --print (multiFunc "a")
+
+    --print (alice "HI")
+
+    --print . yourMark $ 5
+
+    {-print ( "incredible" `addToList` hosts )
+        where hosts = ["amazing", "wow"]-}
+
+    --print . ten $ [1.2, 0.2, 0.99]
+
+    {-print (sq2 5) 
+        where sq2 = \x -> x * x-}
+
+    {-putStrLn ( head functions "Hi")
+        where 
+            functions = [   \x -> x ++ " Bro",
+                            \x -> x ++ " Sister"
+                        ]-}
+
+    --print <+> yourMark $ 5
+
+    --print . pretty $ ["c++", "haskell", "python"] 
+
+    {-let
+        fvalue = 3.14 / 2
+        coeffs = [fvalue]
+    in print $coeffs !! 0 -}

Haskell.ppt

@@ -0,0 +1,39 @@
+module Main where
+
+import  Prelude  hiding  (head,  tail)
+
+--typeclass (interface be like)
+class Queue q where
+    empty :: q a
+    isEmpty :: q a -> Bool
+    snoc :: q a -> a -> q a
+    head :: q a -> a
+    tail :: q a -> q a
+
+--your datatype       constructor arguments magic
+data BankersQueue a = BQ Int [a] Int [a] deriving (Show)
+
+check lenf f lenr r =
+    if lenr <= lenr
+        then BQ lenf f lenr r
+        else BQ (lenf + lenr) (f ++ reverse r) 0 []
+
+--typeclass implementation
+instance Queue BankersQueue where
+    empty =  BQ 0 [] 0 []
+    isEmpty (BQ lenf f     lenr r) = (lenf == 0)
+    
+    --insert new element
+    snoc    (BQ lenf f     lenr r) x = check lenf f (lenr + 1) (x:r)
+
+    head    (BQ lenf []    lenr r) = error "empty queue"
+    head    (BQ lenf (x:f) lenr r) = x
+
+    tail    (BQ lenf []    lenr r) = error "empty queue"
+    tail    (BQ lenf (x:f') lenr r) = check (lenf - 1) f' lenr r
+
+
+main :: IO ()
+main = let q = BQ 3 [2, 1, 3] 4 [4, 4, 4, 4]
+    in --print . head . tail $ snoc q 3
+        print $ snoc q 3