Лабораторная №3 Haskell

import Data.List
import Data.Maybe
import Data.Char

--Задача №1

-- №1.1
data Product = Book {bookName :: String, bookAuthor :: String} | Videotape {videotapeName :: String} | CD {cdName :: String, cdSinger :: String, cdAmount :: Int} deriving (Show)

-- №1.2
getTitle :: Product -> String
getTitle Book {bookName = name} = name
getTitle Videotape {videotapeName = name} = name
getTitle CD {cdName = name} = name

-- №1.3
getTitles :: [Product] -> [String]
getTitles = map getTitle

-- №1.4

-- Первый способ:
bookAuthors1 :: [Product] -> [String]
bookAuthors1 [] = []
bookAuthors1 (Book {bookAuthor = author} : t) = author : bookAuthors1 t
bookAuthors1 (_ : t) = bookAuthors1 t

-- Второй способ:
bookAuthors2 :: [Product] -> [String]
bookAuthors2 = map (\Book {bookAuthor = author} -> author) . filter pr
    where pr Book {} = True
          pr _ = False

-- №1.5
lookupTitle :: String -> [Product] -> Maybe Product
lookupTitle name = find (\p -> getTitle p == name)

-- №1.6
lookupTitles :: [String] -> [Product] -> [Product]
lookupTitles names base = mapMaybe (`lookupTitle` base) names

-- Задача №2

data Suit = Clubs | Diamonds | Hearts | Spades deriving (Eq,Ord,Enum,Show)

data Rank = Two | Three | Four | Five | Six | Seven | Eight | Nine | Ten | Jack | Queen | King | Ace deriving (Eq,Ord,Enum,Show)

data Card = Card {rank :: Rank, suit :: Suit} deriving (Eq,Ord, Show)

-- №2.1
isMinor :: Card -> Bool
isMinor Card {rank = r} = not (r == Jack || r == Queen || r == King || r == Ace)

-- №2.2
sameSuit :: [Card] -> Bool
sameSuit cards = allClubs || allDiamonds || allHearts || allSpades
    where allClubs = all (\Card {suit = s} -> s == Clubs) cards
          allDiamonds = all (\Card {suit = s} -> s == Diamonds) cards
          allHearts = all (\Card {suit = s} -> s == Hearts) cards
          allSpades = all (\Card {suit = s} -> s == Spades) cards

-- №2.3
beats :: Card -> Card -> Bool
beats Card {rank = r1, suit = s1} Card {rank = r2, suit = s2} = (s1 == s2) && (value r1 > value r2)
    where value r
           | r == Two = 2
           | r == Three = 3
           | r == Four = 4
           | r == Five = 5
           | r == Six = 6
           | r == Seven = 7
           | r == Eight = 8
           | r == Nine = 9
           | r == Ten = 10
           | r == Jack = 11
           | r == Queen = 12
           | r == King = 13
           | r == Ace = 14

-- №2.4
beats2 :: Card -> Card -> Suit -> Bool
beats2 Card {rank = r1, suit = s1} Card {rank = r2, suit = s2} suit = (s1 == s2 || s1 == suit) && (value2 r1 s1 > value2 r2 s2)
    where value2 r s = if s == suit then value r + 14 else value r
          value r
           | r == Two = 2
           | r == Three = 3
           | r == Four = 4
           | r == Five = 5
           | r == Six = 6
           | r == Seven = 7
           | r == Eight = 8
           | r == Nine = 9
           | r == Ten = 10
           | r == Jack = 11
           | r == Queen = 12
           | r == King = 13
           | r == Ace = 14

-- №2.5
beatsList :: [Card] -> Card -> Suit -> [Card]
beatsList cards card suit = filter (\c -> beats2 c card suit) cards

-- №2.6
points :: [Card] -> [Int]
points cards = [s + 10*x | x <- [0..k]]
    where s = sum $ map value cards
          k = sum $ map isAce cards
          isAce Card {rank = r} = if r == Ace then 1 else 0
          value Card {rank = r}
           | r == Ace = 1
           | r == Two = 2
           | r == Three = 3
           | r == Four = 4
           | r == Five = 5
           | r == Six = 6
           | r == Seven = 7
           | r == Eight = 8
           | r == Nine = 9
           | otherwise = 10

--Задача №3

data Figure = Circle {o :: (Double, Double), r :: Double} | Rectangle {a :: (Double, Double), c :: (Double, Double)} | Triangle {a :: (Double, Double), b :: (Double, Double), c :: (Double, Double)} deriving (Show)

-- №3.1
area :: Figure -> Double
area Circle {r = r} = pi * r^2
area Rectangle {a = (xa, ya), c = (xc, yc)} = (xc - xa)*(ya - yc)
area Triangle {a = (xa, ya), b = (xb, yb), c = (xc, yc)} = 0.5 * abs( (xb - xa)*(yc - ya) - (yb - ya)*(xc - xa) )

-- №3.2
getRectangles :: [Figure] -> [Figure]
getRectangles = filter pr
    where pr Rectangle {} = True
          pr _ = False

-- №3.3
getBound :: Figure -> Figure
getBound Circle {o = (xo, yo), r = r} = Rectangle (xo - r, yo + r) (xo + r, yo - r)
getBound Rectangle {a = a, c = c} = Rectangle a c
getBound Triangle {a = (xa, ya), b = (xb, yb), c = (xc, yc)} = Rectangle (minimum [xa, xb, xc], maximum [ya, yb, yc]) (maximum [xa, xb, xc], minimum [ya, yb, yc])

-- №3.4
getBounds :: [Figure] -> [Figure]
getBounds = map getBound

-- №3.5
getFigure :: (Double, Double) -> [Figure] -> Maybe Figure
getFigure (x, y) = find pr
    where pr Rectangle {a = (xa, ya), c = (xc, yc)} = xa <= x && x <= xc && yc <= y && y <= ya
          pr figure = pr $ getBound figure

-- №3.6
move :: Figure -> (Double, Double) -> Figure
move Circle {o = (xo, yo), r = r} (x, y) = Circle {o = (x + xo, y + yo), r = r}
move Rectangle {a = (xa, ya), c = (xc, yc)} (x, y) = Rectangle {a = (x + xa, y + ya), c = (x + xc, y + yc)}
move Triangle {a = (xa, ya), b = (xb, yb), c = (xc, yc)} (x, y) = Triangle {a = (x + xa, y + ya), b = (x + xb, y + yb), c = (x + xc, y + yc)}

-- Задача №4

data Property = F {f :: Int, s :: Double, n :: Int} | R {f :: Int, n :: Int, sf :: Double, sr :: Double} | H {sh :: Double} deriving(Show)

-- №4.1
getHouses :: [(Property, Int)] -> [(Property, Int)]
getHouses = filter pr
    where pr (H {}, _) = True
          pr _ = False

-- №4.2
getByPrice :: Int -> [(Property, Int)] -> [(Property, Int)]
getByPrice price = filter (\(_, cost) -> cost < price)

-- №4.3
getByLevel :: Int -> [(Property, Int)] -> [(Property, Int)]
getByLevel fl = filter pr
    where pr (F {f = f}, _) = f == fl
          pr _ = False

-- №4.4
getExceptBounds :: [(Property, Int)] -> [(Property, Int)]
getExceptBounds = filter pr
    where pr (F {f = f, n = n}, _) = (f /= 1) && (f /= n)
          pr _ = False

data Tip = Flat | Room | House deriving(Eq)

data Requirement = Requirement {tip :: Tip, smin :: Double, pmax :: Int, floors :: [Int]}


query :: Requirement -> [(Property, Int)] -> [(Property, Int)]
query Requirement {tip = t, smin = smin, pmax = pmax, floors = floors} =
        case t of
            Flat -> filter pr1
            Room -> filter pr2
            House -> filter pr3
    where pr1 (F {f = f, s = s, n = n}, cost) = s >= smin && cost <= pmax && elem f floors
          pr1 _ = False
          pr2 (R {f = f, n = n, sf = sf, sr = sr}, cost) = sr >= smin && cost <= pmax && elem f floors
          pr2 _ = False
          pr3 (H {sh = sh}, cost) = sh >= smin && cost <= pmax
          pr3 _ = False

-- Задача №5

data Month = January | February | March | April | May | June | July | August | September | October | November | December deriving(Eq, Show)

data Edition = Book {author :: String, name :: String} | Magazine {name :: String, month :: Month, year :: Int} | News {name :: String, day :: Int, month :: Month, year :: Int} deriving(Show)

-- №5.1
isPeriodic :: Edition -> Bool
isPeriodic Book {} = False
isPeriodic _ = True

-- №5.2
getByTytle :: String -> [Edition] -> [Edition]
getByTytle name = filter pr
    where pr Book {name = n} = n == name
          pr Magazine {name = n} = n == name
          pr News {name = n} = n == name

-- №5.3
getByMonth :: Month -> Int -> [Edition] -> [Edition]
getByMonth month year = filter pr
    where pr Magazine {month = m, year = y} = m == month && y == year
          pr News {month = m, year = y} = m == month && y == year
          pr _ = False

-- №5.4
getByMonths :: [Month] -> Int -> [Edition] -> [Edition]
getByMonths months year = filter pr
    where pr Magazine {month = m, year = y} = m `elem` months && y == year
          pr News {month = m, year = y} = m `elem` months && y == year
          pr _ = False

-- №5.5
getAuthors :: [Edition] -> [String]
getAuthors = map (\Book {author = author} -> author) . filter pr
    where pr Book {} = True
          pr _ = False

-- Задача №6

data Tip = Integer | Float | String | Struct {members :: [(String, Tip)]} deriving(Eq, Show)

newtype Variable = Variable (String, Tip) deriving(Show)

-- №6.1
isStructured :: Variable -> Bool
isStructured (Variable (_, Struct {})) = True
isStructured _ = False

-- №6.2
getType :: String -> [Variable] -> Maybe Variable
getType name = find pr
    where pr (Variable (n, _)) = n == name

-- №6.3
getFields :: Variable -> Maybe [(String, Tip)]
getFields (Variable (_, Struct {members = m})) = Just m
getFields _ = Nothing

-- №6.4
getByType :: Tip -> [Variable] -> [Variable]
getByType tip = filter pr
    where pr (Variable (_, t)) = t == tip

-- №6.5
getByTypes :: [Tip] -> [Variable] -> [Variable]
getByTypes tips = filter pr
    where pr (Variable (_, t)) = t `elem` tips

-- Задача №7

data Operation = Delete | DeleteChar {symbol :: Char} | ReplaceChar {sym1 :: Char, sym2 :: Char} | AddChar {symbol :: Char}

-- №7.1
process :: Operation -> String -> String
process op s =
    case op of
        Delete -> []
        DeleteChar {symbol = sym} -> filter (/= sym) s
        ReplaceChar {sym1 = s1, sym2 = s2} -> map (\sym -> if sym == s1 then s2 else sym) s
        AddChar {symbol = sym} -> sym : s

-- №7.2
processAll :: String -> [Operation] -> String
processAll = foldl (flip process)

-- №7.3
deleteAll :: String -> String -> String
deleteAll s1 s2 = processAll s2 (fun s1)
    where fun [] = []
          fun (x : xs) = (DeleteChar {symbol = x}) : fun xs

-- Задача №8

data Note = Birthday {name :: String, day:: Int, month :: String} | Phone {name :: String, number :: String} | Meeting {day :: Int, month :: String, year :: Int, description :: String} deriving(Show)

base = [Birthday "Anton" 1 "January", Phone "Petya" "89034557534", Meeting 18 "April" 2021 "Olimpiada SGU", Phone "Anton" "89334556776"]

-- №8.1
getByName :: String -> [Note] -> (String, (Int, String))
getByName name notes = fun $ filter pr notes
    where fun [Birthday {name = name, day = d, month = m}, Phone {name = n, number = num}] = (num, (d, m))
          fun [Phone {name = n, number = num}, Birthday {name = name, day = d, month = m}] = (num, (d, m))
          fun _ = error "There are no inf about his birthday or his phone"
          pr Birthday {name = n} = n == name
          pr Phone {name = n} = n == name
          pr _ = False

-- №8.2
getByLetter :: Char -> [Note] -> [String]
getByLetter l = nub . map fun . filter pr
    where fun Birthday {name = n} = n
          fun Phone {name = n} = n
          pr Birthday {name = n} = head n == l
          pr Phone {name = n} = head n == l
          pr _ = False

-- №8.3
getAssignment :: Int -> String -> Int -> [Note] -> [String]
getAssignment d m y notes = phones `union` meets
    where phones = map f1 $ filter p1 notes
          f1 Phone {number = num} = num
          p1 Phone {name = n, number = num} = n `elem` names
          p1 _ = False
          names = map f2 $ filter p2 notes
          f2 Birthday {name = n} = n
          p2 Birthday {day = day, month = month} = (day == d) && (month == m)
          p2 _ = False
          meets = map f3 $ filter p3 notes
          f3 Meeting {description = d} = d
          p3 Meeting {day = day, month = month, year = year} = (day == d) && (month == m) && (year == y)
          p3 _ = False

-- Задача №9

data Keystroke = Symbol Char | Shift Char | CapsLock deriving(Show)

-- №9.1
getAlNum :: [Keystroke] -> [Keystroke]
getAlNum = filter pr
    where pr CapsLock = False
          pr _ = True

-- №9.2
getRaw :: [Keystroke] -> String
getRaw = map fun . getAlNum
    where fun (Symbol c) = c
          fun (Shift c) = c

-- №9.3
isCapsLocked :: [Keystroke] -> Bool
isCapsLocked keystrokes = sum (map fun keystrokes) `mod` 2 == 1
    where fun CapsLock = 1
          fun _ = 0

-- №9.4
getString :: [Keystroke] -> String
getString = helper False
    where helper pr [] = []
          helper pr (CapsLock : ks) = helper (not pr) ks
          helper pr (k : ks) = getSymbol pr k : helper pr ks
          getSymbol pr (Symbol c) = if pr then toUpper c else c
          getSymbol pr (Shift c) = if isAlpha c then if pr then c else toUpper c else shiftNum c
          shiftNum c =
              case c of
                  '1' -> '!'
                  '2' -> '@'
                  '3' -> '#'
                  '4' -> '$'
                  '5' -> '%'
                  '6' -> '^'
                  '7' -> '&'
                  '8' -> '*'
                  '9' -> '('
                  '0' -> ')'

-- Задача №10

data T = Lab {subject :: String, number :: Int} | CGT {subject :: String} | Referat {subject :: String, topic :: String} deriving(Show)

newtype Task = Task (T, Maybe Int) deriving(Show)

curriculum = [Task (Lab "Haskell" 2, Just 10), Task (Referat "Haskell" "IO", Nothing), Task (CGT "Haskell", Nothing), Task (Lab "Haskell" 1, Just 5), Task (Lab "Haskell" 1, Just 1), Task (Lab "Net" 3, Nothing), Task (Referat "Net" "Cisco", Just 5), Task (Lab "Net" 4, Just 10)]

-- №10.1
getByTytle :: String -> [Task] -> [Task]
getByTytle sub = filter pr
    where pr (Task (t, _)) =
            case t of
                Lab {subject = s} -> s == sub
                CGT {subject = s} -> s == sub
                Referat {subject = s} -> s == sub

-- №10.2
getReferats :: [Task] -> [String]
getReferats = map (\(Task (Referat {topic = t}, _)) -> t) . filter pr
    where pr (Task (Referat {}, _)) = True
          pr _ = False

-- №10.3
getRest :: [Task] -> [Task]
getRest = filter pr
    where pr (Task (_, Nothing)) = True
          pr _ = False

-- №10.4
getRestForWeek :: Int -> [Task] -> [Task]
getRestForWeek week = filter pr
    where pr (Task (_, Nothing)) = True
          pr (Task (_, Just w)) = w > week

-- №10.5
getPlot :: [Task] -> [(Int, Int)]
getPlot tasks = [(w, getTasksForWeek w tasks) | w <- weeks]
    where weeks = nub $ map fun1 $ filter pr tasks
          fun1 (Task (_, Just a)) = a
          pr (Task (_, Just a)) = True
          pr _ = False
          getTasksForWeek week tasks = sum $ map (`fun2` week) tasks
          fun2 (Task (_, Just a)) week = if a == week then 1 else 0
          fun2 _ _ = 0

http://learnyouahaskell.com