AlexFSmirnov

Untitled

May 20th, 2020
264
0
Never
1
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. flatten [] = []
  2. flatten (x : xs) = x ++ (flatten xs)
  3.  
  4. -- ### I/O ### ----------------------------------------------------------------
  5. -- reads first n lines from stdin and returns them in a list
  6. getLines :: (Ord t, Num t) => t -> IO [String]
  7. getLines n
  8.     | n <= 0 = return []
  9.     | otherwise = do
  10.         x <- getLine
  11.         xs <- getLines (n - 1)
  12.         return (x:xs)
  13.  
  14. -- transforms a list of lists to a printable matrix string
  15. vec_to_str [] = "\n"
  16. vec_to_str (x : xs) = (take 6 ((if x < 0 then "" else " ") ++ (show x) ++ [' ' | _ <- [1..]])) ++ "\t" ++ (vec_to_str xs)
  17. mat_to_str [] = ""
  18. mat_to_str (row : rows) = (vec_to_str row) ++ (mat_to_str rows)
  19.  
  20. -- given a string representing vector b, finds vector x s.t. Ax = b
  21. get_solution_string str_b lower upper swaps =
  22.     let b = map read (words str_b) :: [Double]
  23.         y = forward_sub 1 lower [] (apply_swaps b swaps)
  24.         x = backward_sub upper y
  25.     in "Ax = " ++ (show b) ++ "    =>    x = " ++ (show x) ++ "\n"
  26.  
  27. -- given a list of strings of vectors, returns a string of solutions
  28. get_all_solutions strings lower upper swaps =
  29.     flatten [get_solution_string b lower upper swaps | b <- strings]
  30. -- ######################################################################### --
  31.  
  32. -- ### Linear Algebra ### -----------------------------------------------------
  33. mul_vv [] [] = 0
  34. mul_vv (x : xs) (y : ys) = x * y + (mul_vv xs ys)
  35.  
  36. div_vc [] _ = []
  37. div_vc (x : xs) c = (x / c) : (div_vc xs c)
  38.  
  39. div_mc [] _ = []
  40. div_mc (row : rows) c = (div_vc row c) : (div_mc rows c)
  41.  
  42. outer_product [] _ = []
  43. outer_product (x : xs) ys = [x * y | y <- ys] : (outer_product xs ys)
  44.  
  45. sub_vv [] [] = []
  46. sub_vv (x : xs) (y : ys) = (x - y) : (sub_vv xs ys)
  47.  
  48. sub_mm [] [] = []
  49. sub_mm (row1 : mat1) (row2 : mat2) = (sub_vv row1 row2) : (sub_mm mat1 mat2)
  50. -- ######################################################################### --
  51.  
  52. -- ### Mics ### ----------------------------------------------------------------
  53. -- splits the matrix returning the first column and the rest of the matrix
  54. split [] = ([], [])
  55. split ((x : xs) : rows) =
  56.     let (col, mat) = split rows
  57.     in ((x : col), (xs : mat))
  58.  
  59. -- reverse of split
  60. merge [] [] = []
  61. merge (x : xs) (row : mat) = ((x : row) : (merge xs mat))
  62.  
  63. -- swaps two elements of list at positions i1, j1
  64. swap i1 j1 list =
  65.     if i1 == j1 then
  66.         list
  67.     else
  68.         let i = minimum [i1, j1]
  69.             j = maximum [i1, j1]
  70.             first = take i list
  71.             second = drop (i + 1) (take j list)
  72.             third = drop (j + 1) list
  73.         in first ++ [list !! j] ++ second ++ [list !! i] ++ third
  74.  
  75. apply_swaps list [] = list
  76. apply_swaps list ((i, j) : swaps) = apply_swaps (swap i j list) swaps
  77. -- ######################################################################### --
  78.  
  79. -- ### LUP decomposition ### ---------------------------------------------------
  80. -- returns the index of the maximum element in the list
  81. max_idx _ [] _ res = res
  82. max_idx i (x : xs) cur_max res =
  83.     if (abs x) > cur_max then
  84.         max_idx (i + 1) xs (abs x) i
  85.     else
  86.         max_idx (i + 1) xs cur_max res
  87.  
  88. -- pivots the matrix bringing the biggest element to the top left corner.
  89. -- returns the new matrix and the permutation represented as a lsit of swaps.
  90. pivot mat =
  91.     let (row, rest) = split mat
  92.         i = max_idx 0 row (-1) (-1)
  93.     in ((swap 0 i mat), (0, i))
  94.  
  95. add_1 [] = []
  96. add_1 ((i, j) : rest) = (((i + 1), (j + 1)) : (add_1 rest))
  97.  
  98. -- computes the LUP decomposition returning (L, U, P).
  99. lup_dec [[x]] = ([[1]], [[x]], [])
  100. lup_dec input_mat =
  101.     let (((a : row) : rows), q) = pivot input_mat
  102.         (col, mat) = split rows
  103.         schur = sub_mm mat (div_mc (outer_product col row) a)
  104.         (l1, u1, p1) = lup_dec schur
  105.         (swap_i, swap_j) = head p1
  106.         l_top = (1 : [0 | _ <- row])
  107.         u_left = (a : [0 | _ <- col])
  108.         l = (l_top : (merge (div_vc (apply_swaps col p1) a) l1))
  109.         u = merge u_left (row : u1)
  110.         p = (q : (add_1 p1))
  111.     in (l, u, p)
  112.     --in ((a : row) : rows, schur, [q])
  113. -- ######################################################################### --
  114.  
  115. -- ### Determinant ### --------------------------------------------------------
  116. determinant [] = 1
  117. determinant ((x : row) : upper) =
  118.     let (col, mat) = split upper
  119.     in x * (determinant mat)
  120. -- ######################################################################### --
  121.  
  122. -- ### Linear equations ### ---------------------------------------------------
  123. forward_sub _ [] xs _ = xs
  124. forward_sub i (row : lower) xs (b : bs) =
  125.     let prefix = mul_vv [x | (x, j) <- (zip row [1..(i - 1)])] xs
  126.         x = b - prefix
  127.     in forward_sub (i + 1) lower (xs ++ [x]) bs
  128.  
  129. backward_sub [[x]] [b] = [b / x]
  130. backward_sub ((x : row) : upper) (b : bs) =
  131.     let (col, mat) = split upper
  132.         xs = backward_sub mat bs
  133.         prefix = mul_vv row xs
  134.     in ((b - prefix) / x) : xs
  135. -- ######################################################################### --
  136.  
  137.  
  138. main :: IO()
  139. main = do
  140.     -- reading and parsing the size of the matrix
  141.     n_s <- getLine
  142.     let n = read n_s :: Integer
  143.  
  144.     -- reading rows of the matrix as a list of strings
  145.     rows <- getLines n
  146.  
  147.     -- transforming the list of strings to a double array of Integers
  148.     let mat = [row | row_s <- rows, let row = (map read (words row_s) :: [Double])]
  149.  
  150.     -- calculating the LU-decomposition
  151.     let (lower, upper, p) = lup_dec mat
  152.  
  153.     ---- calculating the determinant using the decomposed matrices
  154.     let det = determinant upper * (if ((length p) `div` 2) == 0 then 1 else -1)
  155.  
  156.     putStrLn $ "Input matrix: \n" ++ (mat_to_str mat) ++ "\n\n"
  157.     putStrLn $ "Unit-Lower Triangular: \n" ++ (mat_to_str lower) ++ "\n"
  158.     putStrLn $ "Upper Triangular: \n" ++ (mat_to_str upper) ++ "\n"
  159.     putStrLn $ "Permutations: " ++ (show p) ++ "\n"
  160.     putStrLn $ "Determinant: " ++ (show det) ++ "\n"
  161.  
  162.     -- reading the amount of queries for linear equation solutions
  163.     k_s <- getLine
  164.     let k = read k_s :: Integer
  165.  
  166.     -- reading queries as a list of strings
  167.     queries <- getLines k
  168.  
  169.     let solutions = get_all_solutions queries lower upper p
  170.  
  171.     putStrLn $ "\n\nSolutions: \n\n" ++ solutions
Comments
  • User was banned
Add Comment
Please, Sign In to add comment