From d06bc5050997f2ef58e649d60a89a61190cc5085 Mon Sep 17 00:00:00 2001 From: Eduardo Cardenas Date: Fri, 16 Dec 2022 06:27:39 -0600 Subject: [PATCH 1/3] Haskell solutions --- solutions/haskell/median_sort.hs | 90 ++++++++++++++++ solutions/haskell/moons_and_umbrellas.hs | 130 +++++++++++++++++++++++ solutions/haskell/parenting.hs | 86 +++++++++++++++ solutions/haskell/reversort.hs | 77 ++++++++++++++ 4 files changed, 383 insertions(+) create mode 100644 solutions/haskell/median_sort.hs create mode 100644 solutions/haskell/moons_and_umbrellas.hs create mode 100644 solutions/haskell/parenting.hs create mode 100644 solutions/haskell/reversort.hs diff --git a/solutions/haskell/median_sort.hs b/solutions/haskell/median_sort.hs new file mode 100644 index 00000000..b74245d7 --- /dev/null +++ b/solutions/haskell/median_sort.hs @@ -0,0 +1,90 @@ +{- + The following code solves the Median Sort problem. + + To better understand the comments, read them from the bottom-most blocks and upwards, since + functions start at "main" and keep calling the previous ones. +-} + +import Data.List +import System.IO +import Control.Monad +import Data.Char + +-- This function just converts the solution list into string format so that it can be outputed as an answer. +str_gen :: [Int] -> String -> String +str_gen ls str | length ls == 1 = str ++ (show (head ls)) + | otherwise = str_gen (tail ls) (str ++ (show (head ls) ++ " ")) + +-- This function sends to the judge three numbers. Then, it receives one of those numbers back, indicating +-- that it is the median of the three in the solution we are seeking. +get_res :: [Int] -> IO String +get_res ls = do + putStrLn (str_gen ls "") + hFlush stdout + m <- getLine + return m + +-- This just generates a number for the get_i_j function. It was tedious to create it inside said function, +-- since the function has to check if thelength of the list is even or odd. +get_aux :: Int -> Int +get_aux len | len `mod` 3 == 0 = (len `div` 3) + | otherwise = (len `div` 3) + 1 + +-- This calculates the indexes that are approximately at 1/3 and 2/3 of the list. +get_i_j :: [Int] -> [Int] +get_i_j ls = [i,j] + where + aux = get_aux (length ls) + i = aux - 1 + j = (2 * aux) - 1 + +-- Here, we evaluate where the current new number (index) must be placed. +insert_ind :: Int -> Int -> Int -> Int -> Int -> [Int] -> [Int] -> [Int] -> IO () + -- First, if the median was the new number, and i and j are right next to each other, + -- then we can just place that number right there and keep going with the next number. +insert_ind n i j m ind prev ls aft | m == ind && j - i == 1 = solve n (ind+1) [] (prev ++ (take (i+1) ls) ++ [ind] ++ (drop j ls) ++ aft) [] + -- If there are more numbers between i and j, then we need to repeat the process with that + -- new sublist from i to j, inclusive. + | m == ind && j - i /= 1 = solve n ind (prev ++ (take i ls)) (drop i (take j ls)) ((drop j ls) ++ aft) + -- In case the median was the element at i, and i is actually the first element in the list, + -- then we can just place the new element at the very beginning and keep going with the next number. + | m == (ls !! i) && i == 0 = solve n (ind+1) [] (prev ++ [ind] ++ ls ++ aft) [] + -- If there are more numbers to the left of the i-th element, then we repeat the process with the new + -- sublist that goes from index 0 up until i, inclusive. + | m == (ls !! i) && i /= 0 = solve n ind prev (take (i+1) ls) ((drop (i+1) ls) ++ aft) + -- In case the median was the j-th element, and it is actually the last element, then we can just + -- append the new number at the end of the list and keep going with the next number. + | m == (ls !! j) && j == ((length ls)-1) = solve n (ind+1) [] (prev ++ ls ++ [ind] ++ aft) [] + -- If there were more numbers to the right of the j-th element, then we repeat the process with the + -- new sublist from j up until the end of the list, inclusive. + | m == (ls !! j) && j /= ((length ls)-1) = solve n ind (prev ++ (take j ls)) (drop j ls) aft + +-- This function checks if the answer is ready or, if not, repeats the insertion process with the next value. +solve :: Int -> Int -> [Int] -> [Int] -> [Int] -> IO () +solve n ind prev ls aft | ind > n = do + get_res ls + return () + | otherwise = do + -- Here we get the new i and J values of the current list. + let ij = get_i_j ls + i = ij !! 0 + j = ij !! 1 + -- Here we receive the input from the judge about which is the median. + -- We ask sending the values from our list at indexes i and j, as well + -- as the new index. + m <- get_res [(ls !! i), (ls !! j), ind] + insert_ind n i j (read m :: Int) ind prev ls aft + +-- The iterator will repeat the algorithm T times. +iterator t n | t == 0 = return () + | otherwise = do + -- We pass an initial form of the soultion as [1,2] and we begin with index 3 + -- looking for its position. + solve n 3 [] [1,2] [] + iterator (t-1) n + +-- First, we recieve T, N and Q. We ignore Q, since the algorithm never takes as many tries to find the solution. +main = do + hSetBuffering stdout NoBuffering + [t, n, q] <- fmap(map read.words)getLine + iterator t n diff --git a/solutions/haskell/moons_and_umbrellas.hs b/solutions/haskell/moons_and_umbrellas.hs new file mode 100644 index 00000000..32b63646 --- /dev/null +++ b/solutions/haskell/moons_and_umbrellas.hs @@ -0,0 +1,130 @@ +{- + The following code solves the Moons and Umbrellas problem. + + To better understand the comments, read them from the bottom-most blocks and upwards, since + functions start at "main" and keep calling the previous ones. +-} + +import Data.List +import System.IO +import Control.Monad +import Data.Char + +-- This function is called when encountering a ? and its previous and following characters are actually the same. +equals :: Integer -> Integer -> Integer -> Integer -> Char -> String -> [Integer] +equals x y contX contY prev str | prev == 'C' && x + y <= 0 = checker x y (contX+1) (contY+1) 'J' (tail str) + | prev == 'J' && x + y <= 0 = checker x y (contX+1) (contY+1) 'C' (tail str) + | prev == 'C' && x + y > 0 = checker x y contX contY 'C' (tail str) + | prev == 'J' && x + y > 0 = checker x y contX contY 'J' (tail str) + +-- Both sum_greater and sum_less deal with the possibilities in case of an initial sequence of only ?. One is used for when +-- the sum of X + Y is greater than 0, and the other onw for when it is less. +sum_greater :: Integer -> Integer -> Integer -> Integer -> Integer -> String -> [Integer] +sum_greater x y contX contY num str | x <= 0 && y > 0 && head (tail str) == 'C' = checker x y contX (contY+1) (head (tail str)) (tail (tail str)) + | x > 0 && y <= 0 && head (tail str) == 'J' = checker x y (contX+1) contY (head (tail str)) (tail (tail str)) + | otherwise = checker x y contX contY (head (tail str)) (tail (tail str)) + +sum_less :: Integer -> Integer -> Integer -> Integer -> Integer -> String -> [Integer] +sum_less x y contX contY num str | num `mod` 2 == 0 = checker x y (contX+(fromIntegral (num `div` 2))) (contY+(fromIntegral (num `div` 2))) (head (tail str)) (tail (tail str)) + | x <= 0 && y > 0 && head (tail str) == 'C' = checker x y (contX+(fromIntegral ((num-1) `div` 2))) (contY+(fromIntegral ((num-1) `div` 2))) (head (tail str)) (tail (tail str)) + | x <= 0 && y > 0 && head (tail str) == 'J' = checker x y (contX+(fromIntegral ((num+1) `div` 2))) (contY+(fromIntegral ((num-1) `div` 2))) (head (tail str)) (tail (tail str)) + | x > 0 && y <= 0 && head (tail str) == 'C' = checker x y (contX+(fromIntegral ((num-1) `div` 2))) (contY+(fromIntegral ((num+1) `div` 2))) (head (tail str)) (tail (tail str)) + | x > 0 && y <= 0 && head (tail str) == 'J' = checker x y (contX+(fromIntegral ((num-1) `div` 2))) (contY+(fromIntegral ((num-1) `div` 2))) (head (tail str)) (tail (tail str)) + | x <= 0 && y <= 0 && head (tail str) == 'C' = checker x y (contX+(fromIntegral ((num-1) `div` 2))) (contY+(fromIntegral ((num+1) `div` 2))) (head (tail str)) (tail (tail str)) + | x <= 0 && y <= 0 && head (tail str) == 'J' = checker x y (contX+(fromIntegral ((num+1) `div` 2))) (contY+(fromIntegral ((num-1) `div` 2))) (head (tail str)) (tail (tail str)) + +-- This function is called if ever the situation comes when the string has only ? characters. +all_blanks :: Integer -> Integer -> Integer -> Integer -> Integer -> String -> [Integer] +all_blanks x y contX contY num str | x > 0 && y > 0 = [contX, contY] + | x + y < 0 && num `mod` 2 /= 0 = [(contX+(fromIntegral (num `div` 2))), (contY+(fromIntegral (num `div` 2)))] + | x + y > 0 && x <= 0 && y > 0 = [(contX+1), contY] + | x + y > 0 && x > 0 && y <= 0 = [contX, (contY+1)] + | x <= 0 && num `mod` 2 == 0 && x < y = [(contX+(fromIntegral (num `div` 2))), (contY+(fromIntegral (num `div` 2))-1)] + | y <= 0 && num `mod` 2 == 0 && y < x = [(contX+(fromIntegral (num `div` 2))-1), (contY+(fromIntegral (num `div` 2)))] + + +-- This functin is called when the string actually begins with one or more ?. +first_different :: Integer -> Integer -> Integer -> Integer -> Integer -> String -> [Integer] +first_different x y contX contY num str | length str == 1 = all_blanks x y contX contY num str + | head (tail str) == '?' = first_different x y contX contY (num+1) (tail str) + -- Depending on if the sum of the pattern prices is negative or positive, differnet sequences + -- are convenient. + | x + y <= 0 = sum_less x y contX contY num str + | x + y > 0 = sum_greater x y contX contY num str + +-- This function is called when both the previous and the following character of a ? are different between them. +-- In this case, the possibilities are dealt with, depending on if X and/or Y are negativo or positive. +different :: Integer -> Integer -> Integer -> Integer -> Char -> String -> [Integer] +different x y contX contY prev str | head (tail str) == '?' && x > 0 && y > 0 = missing x y contX contY prev (tail str) + | prev == 'C' && x <= 0 = checker x y (contX+1) contY 'J' (tail str) + | prev == 'J' && y <= 0 = checker x y contX (contY+1) 'C' (tail str) + | prev == 'C' = checker x y (contX+1) contY 'J' (tail str) + | prev == 'J' = checker x y contX (contY+1) 'C' (tail str) + | prev == 'a' = first_different x y contX contY 1 str + +-- If the current character is a ?, then we check what is more convenient to treat it as: a C or a J. +missing :: Integer -> Integer -> Integer -> Integer -> Char -> String -> [Integer] + -- Depending on if X and/or Y are negative or positive, we place whatever gives the + -- artist more profit in that particular section of the string. +missing x y contX contY prev str | length str == 1 && x > 0 && y > 0 = [contX, contY] + | length str == 1 && prev == 'C' && x <= 0 = [contX+1, contY] + | length str == 1 && prev == 'J' && y <= 0 = [contX, contY+1] + | length str == 1 = [contX, contY] + | prev == (head (tail str)) = equals x y contX contY prev str + | prev /= (head (tail str)) = different x y contX contY prev str + | prev /= 'C' && prev /= 'J' && head (tail str) == 'C' && y <= 0 = checker x y contX contY 'J' (tail str) + | prev /= 'C' && prev /= 'J' && head (tail str) == 'J' && x <= 0 = checker x y contX contY 'C' (tail str) + | prev /= 'C' && prev /= 'J' && head (tail str) == 'C' && y > 0 = checker x y contX contY 'C' (tail str) + | prev /= 'C' && prev /= 'J' && head (tail str) == 'J' && x > 0 = checker x y contX contY 'J' (tail str) + +-- This function is mostly a counter for CJ or JC patterns. If it finds a ?, it calls for other functions that, depending +-- on the situation, increase one, both or none of the counters for CJ or JC patterns. +checker :: Integer -> Integer -> Integer -> Integer -> Char -> String -> [Integer] +checker x y contX contY prev str | actual == '?' = missing x y contX contY prev str + -- All these following cases are for when we are analyzing the last element of the string. + | length str == 1 && prev == 'J' && actual == 'C' = [contX, contY+1] + | length str == 1 && prev == 'C' && actual == 'J' = [contX+1, contY] + | length str == 1 && actual == '?' = different x y contX contY prev str + | length str == 1 = [contX, contY] + -- These cases simply increase a counter when finding a pattern. + | prev == 'J' && actual == 'C' = checker x y contX (contY+1) actual (tail str) + | prev == 'C' && actual == 'J' = checker x y (contX+1) contY actual (tail str) + | otherwise = checker x y contX contY actual (tail str) + where + actual = (head str) + + +-- The iterator function solves each case and then jumps to the next one. +iterator :: [String] -> Integer -> IO () +iterator inputCases index | length inputCases == 1 = appendFile "output.txt" ("Case #" ++ (show index) ++ ": " ++ (show total)) + | otherwise = do + appendFile "output.txt" ("Case #" ++ (show index) ++ ": " ++ (show total) ++ "\n") + iterator (tail inputCases) (index+1) + where + -- In case the first element of the string must be checked, this sends 'a' as a previous character + -- in the string. That way, when analyzing, we can distinguish if it is the first one. + prev = 'a' + -- Setting counters to 0. + contX = 0 + contY = 0 + thisCase = words (head inputCases) + -- We obtain the number of counts by calling the "checker" function and analyzing the given string. + counts = (checker (read (thisCase !! 0) :: Integer) (read (thisCase !! 1) :: Integer) contY contX prev (thisCase !! 2)) + total = (((counts !! 0) * (read (thisCase !! 0) :: Integer)) + ((counts !! 1) * (read (thisCase !! 1) :: Integer))) + + +-- The function receives the input as a text file whose path must be established here. It then reads how many +-- cases it must evaluate, their costs for X and Y and the strings to evaluate. +main = do + let list = [] + handleInput <- openFile "input.txt" ReadMode + contents <- hGetContents handleInput + let inputCases = lines contents + + iterator (tail inputCases) 1 + + hClose handleInput + + + + diff --git a/solutions/haskell/parenting.hs b/solutions/haskell/parenting.hs new file mode 100644 index 00000000..69f74b50 --- /dev/null +++ b/solutions/haskell/parenting.hs @@ -0,0 +1,86 @@ +{- + The following code solves the Parenting Partnering problem. + + To better understand the comments, read them from the bottom-most blocks and upwards, since + functions start at "main" and keep calling the previous ones. +-} + +import Data.List +import System.IO +import Control.Monad +import Data.Char +import Data.Function + + +-- This prepares the solution in the desired format to send as output. +str_gen :: String -> Int -> Int -> String +str_gen str ind t | ind == t = "Case #" ++ (show ind) ++ ": " ++ str + | ind /= t = "Case #" ++ (show ind) ++ ": " ++ str ++ "\n" + +-- This function places any output. +put_res :: String -> IO () +put_res str = do + putStrLn str + +-- This function recieves any imput. +get_res :: IO String +get_res = do + m <- getLine + return m + +-- This function delegates the current activity to someone, or sends "IMPOSSIBLE" if there is no available person. +delegate :: [[Int]] -> Int -> [Int] -> [Int] -> [Int] -> String -> IO String + -- If C is available, it delegates it to C, placing a "C" as next character in the solution. +delegate act ind prevC prevJ input str | (prevC !! 1) <= (input !! 0) = test act (ind+1) input prevJ (str ++ "C") + -- If J is available, it delegates it to J, placing a "J" as next character in the solution. + | (prevJ !! 1) <= (input !! 0) = test act (ind+1) prevC input (str ++ "J") + -- If nobody is available, then it is IMPOSSIBLE. + | otherwise = test act (ind+1) prevC prevJ ("IMPOSSIBLE") + +-- This function checks to see if a specific case has already been solved (or if it is impossible). If not, it analyzed the next activity +-- to see if it can be delegated to any available person, C or J. +test :: [[Int]] -> Int -> [Int] -> [Int] -> String -> IO String +test act ind prevC prevJ str | ind == (length act) || str == "IMPOSSIBLE" = do + return str + | otherwise = do + delegate act ind prevC prevJ (act !! ind) str + +-- This fucntion receives as input every activity to then save it in a list and return it. +get_act :: [[Int]] -> Int -> IO [[Int]] +get_act act n | n == 0 = do + return act + | otherwise = do + inp <- get_res + let ls = words inp + s = read (ls !! 0) :: Int + e = read (ls !! 1) :: Int + get_act (act ++ [[s,e]]) (n-1) + +-- This functions organizes the list of activites in ascending order by the starting time of each activity. +sorter :: [[Int]] -> [[Int]] +sorter act = sortBy (\e1 e2 -> compare (e1 !! 0) (e2 !! 0)) act + +-- This function iterates to solve each case that is sent. +iterator :: Int -> Int -> String -> IO () +iterator t ind res | ind > t = put_res res + | otherwise = do + -- we set the initial solution as an empty string. + let str = "" + -- We set the previous activity for both parents, C and J, as (0,0). + prevC = [0,0] + prevJ = [0,0] + -- We now receive how many activities we will be given as input. + n <- getLine + -- We then get all of those activities and save them on a list. + inputs <- get_act [] (read n :: Int) + -- We send those activities to see how to delegate them, or to see if it is impossible. + ls <- test (sorter inputs) 0 prevC prevJ str + -- Then we call the iterator to check the next case, or to send the final answer for all cases. + iterator t (ind+1) (res ++ str_gen ls ind t) + +-- First, we read the number of test cases (T). +main :: IO () +main = do + t <- readLn + iterator t 1 "" + diff --git a/solutions/haskell/reversort.hs b/solutions/haskell/reversort.hs new file mode 100644 index 00000000..c613537a --- /dev/null +++ b/solutions/haskell/reversort.hs @@ -0,0 +1,77 @@ +{- + The following code solves the Reversort Engineering problem. + + To better understand the comments, read them from the bottom-most blocks and upwards, since + functions start at "main" and keep calling the previous ones. +-} + +import Data.List +import System.IO +import Control.Monad +import Data.Char + +-- This function sets the solution to the desired output format. +str_gen :: [Integer] -> String -> String +str_gen res str | length res == 1 = str ++ (show (head res)) + | otherwise = str_gen (tail res) (str ++ (show (head res) ++ " ")) + +-- This function mutates the list so that it increments the cost in 1. +pusher :: [Integer] -> Integer -> [Integer] +pusher ls num = (rest ++ pushed ++ elem) -- 1 3 2 + where + elem = [head (drop (fromIntegral num) ls)] + pushed = tail (drop (fromIntegral num) ls) + rest = take (fromIntegral num) ls + + +-- This function mutates the solution for the minimum possible cost, incrementing its cost by 1 in each iteration. It iterates +-- the number of times needed for the cost to get to desired amount, and then outputs the mutated sequence. +c_finder :: Integer -> Integer -> Integer -> Integer -> Integer -> [Integer] -> [Integer] -> [Integer] -> [Integer] +c_finder n c i step stage ls prev aft | i == (no_steps + 1) = (prev ++ ls ++ aft) + | step > (n - stage) && (stage+1) `mod` 2 == 0 = c_finder n c i 1 (stage+1) (drop ((fromIntegral (stage-1)) `div` 2) (take ((fromIntegral n) - ((fromIntegral (stage+1)) `div` 2)) (prev ++ ls ++ aft))) (take ((fromIntegral (stage-1)) `div` 2) [2,4..]) (reverse (take ((fromIntegral (stage+1)) `div` 2) [1,3..])) + | step > (n - stage) && (stage+1) `mod` 2 /= 0 = c_finder n c i 1 (stage+1) (drop ((fromIntegral (stage-1)) `div` 2) (take ((fromIntegral n) - ((fromIntegral stage) `div` 2)) (prev ++ ls ++ aft))) (take ((fromIntegral (stage-1)) `div` 2) [2,4..]) (reverse (take ((fromIntegral stage) `div` 2) [1,3..])) + | otherwise = c_finder n c (i+1) (step+1) stage (pusher ls ((fromIntegral (length ls)) - step - 1)) prev aft + where + no_steps = c - n + 1 + + +-- This function checks if the solution can be given immediatley or if we must generate it. +sorter :: Integer -> Integer -> [Integer] + -- If the cost given is the minimum or maximum possible, the answer can be created manually immediately. +sorter n c | c < min_c || c > max_c = [-1] + | c == min_c = [1..n] + | c == max_c && n `mod` 2 == 0 = (take ((fromIntegral n) `div` 2) [2,4..]) ++ reverse ((take ((fromIntegral n) `div` 2) [1,3..])) + | c == max_c && n `mod` 2 /= 0 = (take ((fromIntegral (n-1)) `div` 2) [2,4..]) ++ reverse ((take ((fromIntegral (n+1)) `div` 2) [1,3..])) + -- However, if it is only in the possible range, then we need to generate it. + | otherwise = c_finder n c 1 1 1 [1..n] [] [] + where + min_c = n-1 + max_c = (n * (n+1)) `div` 2 + + +-- This function iterates over every case received, solving it or stating if it is impossible with the given cost C. +iterator :: [String] -> Integer -> IO () +iterator inputCases index | length inputCases == 1 && res /= [-1] = appendFile "output.txt" ("Case #" ++ (show index) ++ ": " ++ sol) + | length inputCases == 1 && res == [-1] = appendFile "output.txt" ("Case #" ++ (show index) ++ ": IMPOSSIBLE") + | res /= [-1] = do + appendFile "output.txt" ("Case #" ++ (show index) ++ ": " ++ sol ++ "\n") + iterator (tail inputCases) (index+1) + | res == [-1] = do + appendFile "output.txt" ("Case #" ++ (show index) ++ ": IMPOSSIBLE\n") + iterator (tail inputCases) (index+1) + where + thisCase = words (head inputCases) + res = sorter (read (thisCase !! 0) :: Integer) (read (thisCase !! 1) :: Integer) + sol = str_gen res "" + + +-- We first ask for all cases, reading the input text file. +main = do + let list = [] + handleInput <- openFile "input.txt" ReadMode + contents <- hGetContents handleInput + -- Every line from the file is a case we need analyze. + let inputCases = lines contents + -- We call the iterator, sending the index as 1 to start. + iterator (tail inputCases) 1 + hClose handleInput From ce34dd4409897576c08946472fcbcb5502534491 Mon Sep 17 00:00:00 2001 From: David Cardenas <52186152+davidcardd1@users.noreply.github.com> Date: Fri, 23 Dec 2022 16:42:31 -0600 Subject: [PATCH 2/3] Rename reversort.hs to reversort_engineering.hs --- solutions/haskell/{reversort.hs => reversort_engineering.hs} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename solutions/haskell/{reversort.hs => reversort_engineering.hs} (100%) diff --git a/solutions/haskell/reversort.hs b/solutions/haskell/reversort_engineering.hs similarity index 100% rename from solutions/haskell/reversort.hs rename to solutions/haskell/reversort_engineering.hs From 10f792cbd47d5ef28217f1901d2db5a8fa078a4a Mon Sep 17 00:00:00 2001 From: David Cardenas <52186152+davidcardd1@users.noreply.github.com> Date: Fri, 23 Dec 2022 16:43:05 -0600 Subject: [PATCH 3/3] Rename parenting.hs to parenting_partnering_returns.hs --- .../haskell/{parenting.hs => parenting_partnering_returns.hs} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename solutions/haskell/{parenting.hs => parenting_partnering_returns.hs} (100%) diff --git a/solutions/haskell/parenting.hs b/solutions/haskell/parenting_partnering_returns.hs similarity index 100% rename from solutions/haskell/parenting.hs rename to solutions/haskell/parenting_partnering_returns.hs