Advertisement
Guest User

Untitled

a guest
Apr 28th, 2015
209
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.55 KB | None | 0 0
  1. import Control.Applicative ((<$>))
  2. import Text.Printf (printf)
  3.  
  4. type Solution = Maybe [Double]
  5.  
  6. gauss :: [[Double]] -> Solution
  7. gauss [[a, b]] = return [b / a]
  8. gauss (h@(x : xs) : t) = do
  9. let minor = transform h t
  10. if any isNull minor
  11. then Nothing
  12. else do
  13. solutions <- gauss minor
  14. return $ (xs ^*^ (solutions ++ [-1.0])) / (negate x) : solutions
  15.  
  16. isNull :: [Double] -> Bool
  17. isNull [x] = True
  18. isNull (x:xs) = if x == 0 then isNull xs else False
  19.  
  20. transform :: [Double] -> [[Double]] -> [[Double]]
  21. transform row = map $ elliminate row
  22. where
  23. elliminate :: [Double] -> [Double] -> [Double]
  24. elliminate (x : xs) (y : ys) =
  25. let factor = negate (y / x) in
  26. zipWith (+) (map (* factor) xs) ys
  27.  
  28. transpose :: Eq a => [[a]] -> [[a]]
  29. transpose xs
  30. | all (== []) xs = []
  31. | otherwise = let (col, rest) = multiHead xs in col : transpose rest
  32.  
  33. multiHead :: [[a]] -> ([a], [[a]])
  34. multiHead = let splitHead (x:xs) = (x, xs) in unzip . map splitHead
  35.  
  36. (^*^) :: Num a => [a] -> [a] -> a
  37. (^*^) xs ys = sum $ zipWith (*) xs ys
  38.  
  39. makeSystem :: [[Double]] -> [[Double]]
  40. makeSystem vs =
  41. let makeEq n = let e = vs !! n in map (^*^ e) vs in
  42. let l = length vs - 1 in
  43. map makeEq [0 .. l-1]
  44.  
  45. readNumList :: String -> [Double]
  46. readNumList = map read . words
  47.  
  48. printSolution :: [Double] -> IO ()
  49. printSolution = putStrLn . unwords . map (printf "%.8f")
  50.  
  51. main :: IO ()
  52. main = do
  53. [n, m] <- readNumList <$> getLine
  54. inp <- map readNumList <$> (sequence $ replicate (floor n) getLine)
  55. case gauss . makeSystem $ transpose inp of
  56. Just solutions -> printSolution solutions
  57. Nothing -> putStrLn "NO"
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement