aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--challenge-165/alexander-pankoff/haskell/Plot.hs170
-rw-r--r--challenge-165/alexander-pankoff/haskell/ch-1.hs19
-rw-r--r--challenge-165/alexander-pankoff/haskell/ch-2.hs51
3 files changed, 240 insertions, 0 deletions
diff --git a/challenge-165/alexander-pankoff/haskell/Plot.hs b/challenge-165/alexander-pankoff/haskell/Plot.hs
new file mode 100644
index 0000000000..16669b37ee
--- /dev/null
+++ b/challenge-165/alexander-pankoff/haskell/Plot.hs
@@ -0,0 +1,170 @@
+{-# LANGUAGE DeriveFunctor #-}
+
+module Plot
+ ( Plot,
+ Line (..),
+ Point (..),
+ emptyPlot,
+ addLine,
+ parsePlot,
+ plotLines,
+ plotPoints,
+ ToXML (..),
+ )
+where
+
+import Data.Char (ord)
+
+class ToXML a where
+ toXML :: a -> String
+
+data Plot = MkPlot
+ { plotLines :: [Line],
+ plotPoints :: [Point]
+ }
+ deriving (Show, Eq)
+
+instance Semigroup Plot where
+ a <> b =
+ MkPlot
+ { plotLines = plotLines a <> plotLines b,
+ plotPoints = plotPoints a <> plotPoints b
+ }
+
+instance Monoid Plot where
+ mempty = MkPlot [] []
+ mappend = (<>)
+
+instance ToXML Plot where
+ toXML (MkPlot lines points) =
+ let xmlLines = map toXML lines
+ xmlPoints = map toXML points
+ in unlines $
+ [ "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?>",
+ "<!DOCTYPE svg PUBLIC \"-//W3C//DTD SVG 1.0//EN\" \"http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd\">",
+ "<svg height=\"300\" width=\"400\" xmlns=\"http://www.w3.org/2000/svg\" xmlns:svg=\"http://www.w3.org/2000/svg\" xmlns:xlink=\"http://www.w3.org/1999/xlink\">",
+ "<g id=\"lines\" stroke=\"#369\" stroke-width=\"4\">"
+ ]
+ ++ xmlLines
+ ++ [ "</g>",
+ "<g fill=\"#f73\" id=\"points\">"
+ ]
+ ++ xmlPoints
+ ++ [ "</g>",
+ "</svg>"
+ ]
+
+emptyPlot :: Plot
+emptyPlot = MkPlot [] []
+
+addLine :: Line -> Plot -> Plot
+addLine l p = p {plotLines = l : plotLines p}
+
+data Point = Point
+ { x :: Double,
+ y :: Double
+ }
+ deriving (Show, Eq)
+
+instance ToXML Point where
+ toXML (Point x y) = "<circle cx=\"" ++ show x ++ "\" cy=\"" ++ show y ++ "\" r=\"3\" />"
+
+data Line = Line
+ { start :: Point,
+ end :: Point
+ }
+ deriving (Show, Eq)
+
+instance ToXML Line where
+ toXML (Line (Point x1 y1) (Point x2 y2)) =
+ concat
+ [ "<line x1=\"",
+ show x1,
+ "\" x2=\"",
+ show x2,
+ "\" y1=\"",
+ show y1,
+ "\" y2=\"",
+ show y2,
+ "\" />"
+ ]
+
+-- Parsing
+
+newtype Parser a = Parser {runParser :: String -> Either ParseError (String, a)} deriving (Functor)
+
+executeParser :: Parser a -> String -> Either ParseError a
+executeParser p = fmap snd . runParser p
+
+instance Applicative Parser where
+ pure x = Parser $ \s -> return (s, x)
+ ab <*> a = Parser $ \s -> do
+ (s', ab') <- runParser ab s
+ (s'', a') <- runParser a s'
+ return (s'', ab' a')
+
+instance Monad Parser where
+ return = pure
+ pa >>= apb = Parser $ \s -> do
+ runParser pa s >>= uncurry (flip (runParser . apb))
+
+data ParseError = InvalidInput
+ deriving (Show, Eq)
+
+(<|>) :: Parser a -> Parser a -> Parser a
+a <|> b = Parser $ \s ->
+ either (const $ runParser b s) return $ runParser a s
+
+eof :: Parser ()
+eof = Parser $ \s -> if null s then return (s, ()) else Left InvalidInput
+
+-- Parsing
+
+parsePlot :: [String] -> Either ParseError Plot
+parsePlot =
+ foldl
+ ( \acc cur -> do
+ p <- executeParser parseInputLine cur
+ (<> p) <$> acc
+ )
+ (Right emptyPlot)
+
+parseInputLine :: Parser Plot
+parseInputLine =
+ ( (lineParser >>= \l -> return $ emptyPlot {plotLines = [l]})
+ <|> (pointParser >>= \p -> return $ emptyPlot {plotPoints = [p]})
+ )
+ <* eof
+
+lineParser :: Parser Line
+lineParser = Line <$> (pointParser <* commaParser) <*> pointParser
+
+pointParser :: Parser Point
+pointParser = Point <$> (fromIntegral <$> (intParser <* commaParser)) <*> (fromIntegral <$> intParser)
+
+intParser :: Parser Integer
+intParser = Parser $ \s ->
+ if null s
+ then Left InvalidInput
+ else go 0 s
+ where
+ go acc "" = return ("", acc)
+ go acc s@(x : xs) =
+ maybe
+ (return (s, acc))
+ (\n -> go (acc * 10 + fromIntegral n) xs)
+ $ digitToInt x
+
+-- see challenge 162 ch-1.hs
+digitToInt :: Char -> Maybe Int
+digitToInt c =
+ let digit = ord c - ord '0'
+ in if 0 <= digit && digit <= 9
+ then return digit
+ else Nothing
+
+commaParser :: Parser ()
+commaParser = Parser $ \s ->
+ if not (null s) && head s == ','
+ then return (tail s, ())
+ else Left InvalidInput \ No newline at end of file
diff --git a/challenge-165/alexander-pankoff/haskell/ch-1.hs b/challenge-165/alexander-pankoff/haskell/ch-1.hs
new file mode 100644
index 0000000000..cf6221003a
--- /dev/null
+++ b/challenge-165/alexander-pankoff/haskell/ch-1.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE DeriveFunctor #-}
+
+module Main where
+
+import Data.Char (ord)
+import Plot
+import System.Exit (exitFailure)
+import System.IO (hPutStrLn, stderr)
+
+main :: IO ()
+main = do
+ inputLines <- lines <$> getContents
+ either
+ (\err -> putErrLn (show err) >> exitFailure)
+ (putStr . toXML)
+ (parsePlot inputLines)
+
+putErrLn :: String -> IO ()
+putErrLn = hPutStrLn stderr \ No newline at end of file
diff --git a/challenge-165/alexander-pankoff/haskell/ch-2.hs b/challenge-165/alexander-pankoff/haskell/ch-2.hs
new file mode 100644
index 0000000000..16cd38aeaf
--- /dev/null
+++ b/challenge-165/alexander-pankoff/haskell/ch-2.hs
@@ -0,0 +1,51 @@
+module Main where
+
+import Plot (Line (..), Plot (plotPoints), Point (Point, x), ToXML (toXML), addLine, parsePlot)
+import System.Exit (exitFailure)
+import System.IO (hPutStrLn, stderr)
+
+pointInput :: String
+pointInput = "333,129 39,189 140,156 292,134 393,52 160,166 362,122 13,193 341,104 320,113 109,177 203,152 343,100 225,110 23,186 282,102 284,98 205,133 297,114 292,126 339,112 327,79 253,136 61,169 128,176 346,72 316,103 124,162 65,181 159,137 212,116 337,86 215,136 153,137 390,104 100,180 76,188 77,181 69,195 92,186 275,96 250,147 34,174 213,134 186,129 189,154 361,82 363,89"
+
+main :: IO ()
+main = do
+ either
+ (\err -> putErrLn (show err) >> exitFailure)
+ (putStr . toXML . addLineOfBestFit)
+ (parsePlot $ words pointInput)
+
+putErrLn :: String -> IO ()
+putErrLn = hPutStrLn stderr
+
+-- Line of Best Fit
+
+addLineOfBestFit :: Plot -> Plot
+addLineOfBestFit p =
+ addLine (bestFittingLine $ plotPoints p) p
+
+bestFittingLine :: [Point] -> Line
+bestFittingLine ps =
+ let lineEq = leastSquaresRegression ps
+ (minX, maxX) = minmax $ map x ps
+ in Line
+ (Point minX $ lineEq minX)
+ (Point maxX $ lineEq maxX)
+
+leastSquaresRegression :: [Point] -> LineEq
+leastSquaresRegression ps =
+ let n = fromIntegral $ length ps
+ (sx, sy, sxs, sxy) =
+ foldl
+ ( \(sx, sy, sxs, sxy) (Point x y) ->
+ (sx + x, sy + y, sxs + x ^ 2, sxy + x * y)
+ )
+ (0, 0, 0, 0)
+ ps
+ m = (n * sxy - sx * sy) / (n * sxs - sx ^ 2)
+ b = (sy - (m * sx)) / n
+ in \x -> m * x + b
+
+type LineEq = Double -> Double
+
+minmax :: Ord a => [a] -> (a, a)
+minmax = (,) <$> minimum <*> maximum \ No newline at end of file
generated by cgit (git 2.34.1) at 2026-04-06 01:12:09 +0000