2
\$\begingroup\$

The following asks for 2 sets of data (with corresponding x and y values), calculates a linear equation that matches the data as closely as possible, then allows you to "play around" with the equation by substituting x values.

import Data.Char

slope :: [Float] -> [Float] -> Float
slope xs ys
    | xN /= yN = error $ "x len: " ++ show xN ++ " y len: " ++ show yN
    | otherwise = (xN * (sum $ coorProds xs ys) - xSum * ySum) /
        (xN * (sum $ squares xs) - (xSum * xSum))
    where
        (xN,yN) = (fromIntegral $ length xs, fromIntegral $ length ys)
        (xSum,ySum) = (sum xs, sum ys)

intercept :: [Float] -> [Float] -> Float
intercept xs ys
    | xN /= yN = error $ "x len: " ++ show xN ++ " y len: " ++ show yN
    | otherwise = (ySum - (b * xSum)) / xN
    where
        b = slope xs ys
        (xN,yN) = (fromIntegral $ length xs, fromIntegral $ length ys)
        (xSum,ySum) = (sum xs, sum ys)

getEquation :: [Float] -> [Float] -> ((Float -> Float),Float,Float)
getEquation xs ys = (\x -> (inter + (b * x)) , inter, b)
    where
        inter = intercept xs ys
        b = slope xs ys

coorProds :: [Float] -> [Float] -> [Float]
coorProds xs ys = map (\(x,y) -> x * y) $ zip xs ys

squares :: [Float] -> [Float]
squares = map (\x -> x * x)

cutIntoPair :: String -> (String,String)
cutIntoPair = (\(x,y)-> (x,drop 1 y)) . break (== ' ')

isFloat :: String -> Bool
isFloat = all (\c -> isDigit c || c == '.')

toFloat :: String -> Float
toFloat s
    | isFloat s = read s :: Float
    | otherwise = error $ show s ++ " is not a number"

getPairs :: IO ([Float],[Float])
getPairs = do
    i <- getLine
    let (x,y) = cutIntoPair i
    if isFloat x
        then do
            (xs,ys) <- getPairs
            return ((toFloat x : xs), (toFloat y : ys))
        else return ([],[])

useEquation :: (Float -> Float) -> IO ()
useEquation e = do
    putStr "When x = "; x <- getLine
    putStrLn $ "y = " ++ (show $ e (toFloat x)) ++ "\n"
    useEquation e

showEquation :: Float -> Float -> String
showEquation i b = "y = " ++ show i ++ " + " ++ show b ++ "x"

main = do
    putStrLn $ "Enter x and y values seperated by a space\n\t" ++
        "Then type a non-number to continue"
    (xs,ys) <- getPairs
    let (linEq,i,b) = getEquation xs ys
    putStrLn $ showEquation i b
    putStrLn "Enter x values to get their calculated y values"
    useEquation linEq

I'm looking for general feedback, and suggestions regarding the following points:

  1. getEquation has a couple issues.

    • I was able to write it point-free when the function only returned the equation, but now that I'm wrapping everything in a tuple, so I can also return the calculated slope and intercept values (to show the equation later), it's not behaving as I expected. I tried writing it as a section, like (inter + (b *), but that attempts to apply + to the function (b*), which obviously results in a "No instance" error. My solution was to just wrap it in a lambda, but that's quite ugly, in my opinion.
    • Is there a better way of dealing with the need to have the slope and intercept after the function is "constructed" than passing them back with the equation? The optimal solution would the ability to extract them out of the function, but I'm pretty sure that's not possible.
  2. cutIntoPair looks ugly too. It splits a string at the first space, then returns the 2 parts. Break leaves the space in the second slot though, so to remove it, I resorted to passing the result to a lambda that leaves the first part of the tuple the same, but drops the first char of the second slot. I'd like to know if there is a cleaner way to go about this task.

  3. The slope and intercept functions are slightly messy, but I had to cram a lot of math into the space. Tips on how to format it neater would be appreciated.

To use it, type x and y values separated by a space, pressing enter between sets. When you're done entering, type a non-number, like so:

2 4
4 8
12 24
k
\$\endgroup\$
  • \$\begingroup\$ Regarding the paragraph I've removed, you can put it into a self-answer if no one else gets to it first. If someone did so anyway, then you would no longer be able to change the code in this post. \$\endgroup\$ – Jamal Sep 30 '14 at 20:27
  • \$\begingroup\$ Thanks. It's was a minor issue anyways. I only added it as an afterthought. \$\endgroup\$ – Carcigenicate Sep 30 '14 at 21:49
3
\$\begingroup\$

I'd structure your program in a slightly different way. First, instead of passing around two arrays of float, why don't you introduce a Point data structure and work with it? It would save you from checking that you get passed two array of the same length, which looks quite neat to me.

I think you could also consider introducing a Coefficients data structure to hold your pair of slope and intercept value. If you do that it will be much clearer what your function does.

Since you eventually want to have a function you can play with, you could create a toFunction :: Coefficients -> Float ->Float. In this way you decouple the computation of the coefficients that best fit with your data and the construction of the corresponding curve. This enables you to play not only with the curves you fit from data but also with curves you can define from their coefficients.

I think that a nicer way to compute the value could be by putting as much math as possible in some temporary variables you define in the where block. That could allow you to separate the high level computation you need to perform with all the other smaller steps required to compute some other intermediate results you need.

If you apply the changes I suggested you should come up with code similar to the following:

type Point = (Float, Float)
type Coefficients = (Float, Float)

toFunction :: Coefficients -> Float -> Float
toFunction (s, i) x = s * x + i

slope :: [Point] -> Float
slope [] = error "Empty list of points"
slope (_ : []) = error "Single point"
slope points = (n*sumCoorProds - (sumX*sumY))/ (n*sumSquares - (sumX*sumX))
  where
    n = fromIntegral $ length points
    (xs, ys) = unzip points
    sumCoorProds = sum $ map ( \(x, y) -> x * y ) points
    sumSquares   = sum $ map ( \(x) -> x * x ) xs
    sumX         = sum xs
    sumY         = sum ys

intercept :: [Point] -> Float
intercept points = (sumY - (s * sumX)) / n
      where
      (xs, ys) = unzip points
      n = fromIntegral $ length points
      s = slope points
      sumX = sum xs
      sumY = sum ys

getCoefficients :: [Point] -> Coefficients
getCoefficients points = (slope points, intercept points)
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.