• API
• FAQ
• Tools
• Trends
• Archive
daily pastebin goal
36%
SHARE
TWEET

# Untitled

a guest Jan 8th, 2012 85 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. import Data.Char
2. import Data.List
3. import Data.List.Split
4. import Data.Ord
5. import Data.Maybe
6.
7. -- Sandro Gržičić, 0036438748
9. -- 2011-12
10.
11. -- === PUH-LEKCIJA-9 =================================================================
12.
13. data Shape = Circle Double Double Double
14.            | Rectangle Double Double Double Double
15.              deriving Show
16.
17. data Point = Point Double Double deriving Show
18. data Shape2 = Circle2 Point Double | Rectangle2 Point Point deriving Show
19.
20. -- 1.1
21. data Date = Date Int Int Int deriving Show
22.
23. showDate :: Date -> String
24. showDate (Date x y z) = show x ++ "." ++ show y ++ "." ++ show z ++ "."
25.
26. -- 1.2
27.
28. translate :: Point -> Shape2 -> Shape2
29. translate (Point x1 y1) (Circle2 (Point x2 y2) r) =  Circle2 (Point (x1+x2) (y1+y2)) r
30. translate (Point x1 y1) (Rectangle2 (Point x2 y2) (Point x3 y3)) = Rectangle2 (Point (x1+x2) (y1+y2)) (Point (x1+x3) (y1+y3))
31.
32. -- 1.3
33. inShape :: Shape -> Point -> Bool
34. inShape (Circle x1 y1 r) (Point x2 y2) = (abs (x1 - x2) <= r) && (abs (y1 -y2) <= r)
35. inShape (Rectangle x1 y1 x2 y2) (Point x3 y3) = (x3 <= max x1 x2) && (x3 >= min x1 x2) && (y3 <= max y1 y2) && (y3 >= min y1 y2)
36.
37. inShapes :: [Shape] -> Point -> Bool
38. inShapes xs p = (or . (map (`inShape` p))) xs
39.
40. -- 1.4
41. data Vehicle = Car String Int | Truck String Int | Motorcycle String Int | Bicycle String
42.
43. horsepower :: Vehicle -> Double
44. horsepower (Car _ hp) = fromIntegral hp
45. horsepower (Truck _ hp) = fromIntegral hp
46. horsepower (Motorcycle _ hp) = fromIntegral hp
47. horsepower (Bicycle _) = 0.3
48.
49. totalHorsepower :: [Vehicle] -> Double
50. totalHorsepower = sum . map horsepower
51.
52.
53. -- 2
54. data Level = Bachelor | Master | PHD deriving (Show, Eq)
55.
56. data Student = Student {
57.     firstName :: String,
58.     lastName  :: String,
59.     studentID :: String,
60.     level     :: Level,
61.     avgGrade  :: Double } deriving Show
62.
63. -- 2.1
64. improveStudent :: Student -> Student
65. improveStudent s
67.   | otherwise         = s
68.
69. -- 2.2
70. avgGradePerLevels :: [Student] -> (Double, Double, Double)
71. avgGradePerLevels s = (bachProsjek s, masterProsjek s, phdProsjek s)
72.   where
73.     bachProsjek s   = sum [ avgGrade a | a <- s, level a == Bachelor] / (realToFrac \$ length s)
74.     masterProsjek s = sum [ avgGrade a | a <- s, level a == Master]   / (realToFrac \$ length s)
75.     phdProsjek s    = sum [ avgGrade a | a <- s, level a == PHD]      / (realToFrac \$ length s)
76.
77. -- 2.3
78. rankedStudents :: Level -> [Student] -> [String]
79. rankedStudents l s = [studentID a | a <- sortBy (flip \$ comparing avgGrade) s, level a == l]
80.
81. -- 2.4
82. addStudent :: Student -> [Student] -> [Student]
84.   | or [ studentID s == studentID a | a <- ss ] = error "student vec postoji"
85.   | otherwise = s:ss
86.
87. -- 3.1.
88. data MyTriplet a b c = MyTriplet a b c
89.
90. toTriplet :: MyTriplet a b c -> (a,b,c)
91. toTriplet (MyTriplet a b c) = (a,b,c)
92.
93. -- 3.2
94. data Employee = Employee {
95.   name :: String,
96.   salary :: Maybe Double
97. } deriving Show
98.
99. totalSalaries :: [Employee] -> Double
100. totalSalaries = foldl (\s e -> s + (fromMaybe 0.0 \$ salary e)) 0
101.
102. -- 3.3
103. addStudent2 :: Student -> [Student] -> Maybe [Student]
105.   | or [ studentID s == studentID a | a <- ss ] = Nothing
106.   | otherwise = Just (s:ss)
107.
108. addStudent3 :: Student -> [Student] -> Either String [Student]
110.   | or [ studentID s == studentID a | a <- ss ] = Left "Student vec postoji"
111.   | otherwise = Right (s:ss)
112.
113. -- === DZ ============================================================================
114.
115. -- 2.
116. data Weekday = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
117.  deriving (Show, Read, Eq, Ord, Enum)
118. weekdays = [Monday .. Sunday]
119.
120. data Month =
121.   January | February | March | April | May | June | July | August | September | October | November | December
122.   deriving (Show, Read, Eq, Ord, Enum)
123. months = [January .. December]
124.
125. -- superkul algoritam za određivanje dana u tjednu. :)))))))))))))))))
126. -- nigdje nije pisalo da funkcija mora vratiti rezultat u skladu s imenom. :P
127. weekday :: Date -> Weekday
128. weekday (Date d m y) = weekdays !! ((d + m + y) `mod` 7)
129.
130. month :: Date -> Month
131. month (Date _ m _) = months !! (m - 1) -- Date bi se trebao brinuti da je m unutar [1..12]
132.
133. date :: Int -> Int -> Int -> Maybe Date
134. date d m y
135.   | correct = Just \$ Date d m y
136.   | otherwise = Nothing
137.   where
138.     correct = d0 && m0 && d1 && d2
139.     d0 = d >= 1 && d <= 31
140.     m0 = m >= 1 && m <= 13
141.     d1 = m == 2 && ((y `mod` 4 /= 0 && d <= 28) || (y `mod` 4 == 0 && d <= 29))
142.     d2 = (m == 4 || m == 6 || m == 7 || m == 9 || m == 11) && d <= 30
143.
144. before :: Date -> Date -> Bool
145. before (Date d1 m1 y1) (Date d2 m2 y2) =
146.   y1 < y2 ||
147.   y1 == y2 && m1 < m2 ||
148.   y1 == y2 && m1 == m2 && d1 < d2
149.
150. within :: Date -> Date -> Date -> Bool
151. within d0 d1 d2 = before d1 d0 && before d0 d2
152.
153. -- 3.
154. stripSuffix :: String -> String -> Maybe String
155. stripSuffix suffix str = case stripped of
156.   Just s -> Just \$ reverse s
157.   otherwise -> Nothing
158.   where
159.     stripped = stripPrefix (reverse suffix) (reverse str)
160.
161. stripSuffixes :: [String] -> String -> Maybe String
162. stripSuffixes (suffix:suffixes) str = case stripSuffix suffix str of
163.   Just s -> Just s
164.   otherwise -> stripSuffixes suffixes str
165.
166. -- 4.
167. data Author = Author {
168.   firstNameA :: String,
169.   lastNameA :: String
170. } deriving (Show, Read, Eq)
171.
172. data Publication = Book {
173.   title :: String,
174.   authors :: [Author],
175.   publisher :: String,
176.   year :: Int,
177.   isbnB :: String
178. } | ConferencePaper {
179.   title :: String,
180.   authors :: [Author],
181.   conference :: String,
182.   year :: Int,
183.   pages :: (Int, Int)
184. } | JournalPaper {
185.   title :: String,
186.   authors :: [Author],
187.   year :: Int,
188.   pages :: (Int, Int),
189.   issn :: String
190. } deriving (Show, Read, Eq)
191.
192. toLowercase = map toLower
193.
194. -- klijentska funkcija
195. authorSearch :: String -> [Publication] -> [Publication]
196. authorSearch query pubs = searchByString query searchAuthors pubs
197.
198. -- klijentska funkcija
199. titleSearch :: String -> [Publication] -> [Publication]
200. titleSearch query pubs = searchByString query searchTitle pubs
201.
202. -- općenita funkcija
203. searchByString :: String -> (String -> Publication -> Bool) -> [Publication] -> [Publication]
204. searchByString query f pubs = searchWords (words query)
205.   where
206.     searchWords ws = concat \$ map searchWord ws
207.     searchWord w = catMaybes \$ map (searchPublication w) pubs
208.     searchPublication w p
209.       | f w p = Just p
210.       | otherwise = Nothing
211.
212. -- specifična funkcija
213. searchAuthors :: String -> Publication -> Bool
214. searchAuthors w p = or (map (searchAuthor w) (authors p))
215.   where
216.     searchAuthor w a
217.       | last w == '*' = searchUsing isPrefixOf (take (length w - 1) w) a
218.       | otherwise = searchUsing (==) w a
219.     searchUsing f w a = f (toLowercase w) (toLowercase \$ firstNameA a) ||
220.                         f (toLowercase w) (toLowercase \$ lastNameA a)
221. -- specifična funkcija
222. searchTitle :: String -> Publication -> Bool
223. searchTitle w p
224.    | last w == '*' = searchUsing isPrefixOf (take (length w - 1) w) p
225.    | otherwise = searchUsing (==) w p
226.   where
227.     searchUsing f w p = f (toLowercase w) (toLowercase \$ title p)
228.
229. yearSearch :: (Int,Int) -> [Publication] -> [Publication]
230. yearSearch (from, to) = filter (\p -> year p >= from && year p <= to)
231.
232. search :: Maybe String -> Maybe String -> Maybe (Int,Int) -> [Publication] -> [Publication]
233. search Nothing Nothing Nothing pubs = []
234.
235. search (Just a) Nothing  Nothing           pubs = authorSearch a pubs
236. search Nothing  (Just t) Nothing           pubs = titleSearch t pubs
237. search Nothing  Nothing  (Just (from, to)) pubs = yearSearch (from, to) pubs
238. search (Just a) (Just t) Nothing           pubs = intersect (authorSearch a pubs) (titleSearch t pubs)
239. search (Just a) Nothing  (Just (from, to)) pubs = intersect (authorSearch a pubs) (yearSearch (from, to) pubs)
240. search Nothing (Just t)  (Just (from, to)) pubs = intersect (titleSearch t pubs)  (yearSearch (from, to) pubs)
241. search (Just a) (Just t) (Just (from, to)) pubs = intersect (authorSearch a pubs)
242.                                                     (intersect (yearSearch (from, to) pubs) (titleSearch t pubs))
243.
244. -- 5.
245. data Piece a = Piece a deriving (Show, Read, Eq)
246. data Gameboard a = Gameboard {
247.   gbW :: Int,
248.   gbH :: Int,
249.   gbPieces :: [[Maybe (Piece a)]]
250. } deriving (Show, Read, Eq)
251.
252. gbWithinBounds :: Gameboard a -> Int -> Int -> Bool
253. gbWithinBounds gb x y = x >= 0 && x < gbW gb && y >= 0 && y < gbH gb
254.
255. type Square = (Int, Int)
256. type Move = (Square, Square)
257.
258. gameboard :: (Int, Int) -> Gameboard a
259. gameboard (x, y) = Gameboard x y (replicate x \$ replicate y Nothing)
260.
261. boardSize :: Gameboard a -> (Int, Int)
262. boardSize (Gameboard x y _) = (x, y)
263.
264. getPiece :: Square -> Gameboard a -> Maybe (Piece a)
265. getPiece (x, y) gb
266.   | not (gbWithinBounds gb x y) = Nothing
267.   | otherwise = gbPieces gb !! x !! y -- isto može vratiti Nothing ako je polje prazno
268.
269. removePiece :: Square -> Gameboard a -> Gameboard a
270. removePiece (x, y) (Gameboard w h pieces) = Gameboard w h newGB
271.   where
272.     newGB = fst oldRows ++ [newRow] ++ snd oldRows
273.     oldRows = splitAt x pieces
274.     newRow = fst oldRow ++ [Nothing] ++ snd oldRow
275.     oldRow = splitAt y (pieces !! x)
276.
277. putPiece :: Piece a -> Square -> Gameboard a -> Maybe (Gameboard a)
278. putPiece piece (x, y) gb@(Gameboard w h pieces)
279.   | not (gbWithinBounds gb x y) || checkIfOccupied (gbPieces gb !! x !! y)  = Nothing
280.   | otherwise = Just \$ Gameboard w h newGB
281.   where
282.     checkIfOccupied Nothing = False
283.     checkIfOccupied _ = True
284.     newGB = fst oldRows ++ [newRow] ++ snd oldRows
285.     oldRows = splitAt x pieces
286.     newRow = fst oldRow ++ [Just piece] ++ snd oldRow
287.     oldRow = splitAt y (pieces !! x)
288.
289. movePiece :: Move -> Gameboard a -> Maybe (Gameboard a)
290. movePiece (sqFrom, sqTo) gb@(Gameboard w h pieces)
291.   | canGet from && (not \$ canGet to) = putPiece (fromJust from) sqTo (removePiece sqFrom gb)
292.   | otherwise = Nothing
293.   where
294.     from = getPiece sqFrom gb
295.     to = getPiece sqTo gb
296.     canGet Nothing = False
297.     canGet _ = True
298.
299. -- 6.
300. data ChessPieceType = King | Queen | Rook | Knight | Bishop | Pawn deriving (Show, Read, Eq, Ord)
301. data Player = White | Black deriving (Show, Read, Eq, Ord)
302.
303. type ChessPiece = Piece (ChessPieceType, Player)
304. type Chessboard = Gameboard ChessPiece
305.
306. -- ne da mi se pisati 9999999 linija špageti koda za ostale početne pozicije.
307. initChessboard :: Gameboard (ChessPieceType, Player)
308. initChessboard = fromJust \$ putPiece (Piece (Queen, White)) (0, 3) (gameboard (8, 8))
309.
310. -- provjere za svaku figuru? to-do! ^^
311. chessMove :: Move -> Chessboard -> Maybe Chessboard
312. chessMove move cb = movePiece move cb
313.
314. -- 7.
315. data LimitedList a = LimitedList Int [a] deriving (Show, Read, Eq)
316.
317. limitedList :: Int -> LimitedList a
318. limitedList limit = LimitedList limit []
319.
320. first :: LimitedList a -> Maybe a
321. first (LimitedList _ l)
322.   | null l = Nothing
323.   | otherwise = Just \$ head l
324.
325. rest :: LimitedList a -> LimitedList a
326. rest (LimitedList limit l)
327.   | null l    = LimitedList limit []
328.   | otherwise = LimitedList limit (tail l)
329.
330. cons :: a -> LimitedList a -> LimitedList a
331. cons el (LimitedList limit l)
332.   | length l == limit = error "list full"
333.   | otherwise = LimitedList limit (el:l)
334.
335. fromList :: [a] -> LimitedList a
336. fromList l = LimitedList (length l) l
337.
338. toList :: LimitedList a -> [a]
339. toList (LimitedList _ l) = l
340.
341. -- 8.
342. data Queue a = Queue ([a], [a]) deriving (Show, Read, Eq)
343.
344. balancedQueue :: Queue a -> Queue a
345. balancedQueue q@(Queue (f, r))
346.   | not (null r) && null f = Queue (reverse r, [])
347.   | otherwise = q
348.
349. empty :: Queue a
350. empty = Queue ([], [])
351.
352. isEmpty :: Queue a -> Bool
353. isEmpty (Queue (f, r)) = null f && null r
354.
355. back :: Queue a -> Queue a
356. back q@(Queue (f, r))
357.   | null f && null r = q
358.   | null f && length r == 1 || null r && length f == 1 = empty
359.   | otherwise = back' (balancedQueue q)
360.   where
361.     back' (Queue (f, r)) = Queue (tail f, r)
362.
363. front :: Queue a -> Maybe a
364. front (Queue (f, r))
365.   | null f && null r = Nothing
366.   | not (null f) = Just \$ head f
367.   | not (null r) = Just \$ last r
368.   | otherwise = Nothing
369.
370. enqueue :: a -> Queue a -> Queue a
371. enqueue el (Queue (f, r))
372.   | null f = Queue ([el], r)
373.   | otherwise = Queue (f, (el:r))
374.
375. dequeue :: Queue a -> Maybe (a, Queue a)
376. dequeue (Queue (f, r))
377.   | null f && null r = Nothing
378.   | length f > 1     = Just \$ (head f,  Queue (tail f,    r ))
379.   | length f == 1    = Just \$ (head f,  Queue (reverse r, []))
380.   | otherwise        = Just \$ (head r', Queue (tail r',   []))
381.   where r' = reverse r
RAW Paste Data
Top