Submission #1533976

---

Source Code Expand

import Data.List

main = readLn >>=
  \n -> fmap (map (read :: String -> Int) . words) getLine >>=
  \ps -> putStrLn $ tail $ concatMap (\x -> ' ' : show x) $ solve n (zip ps (repeat 0))

solve :: Int -> [(Int,Int)] -> [Int]
solve _ [x,y] = [fst x, fst y]
solve n ps = x1 : y : solve n qs
  where
    (x1,x2) = oddMin ps
    y = (oddMin' x2 n . tail . dropWhile (\(k1, k2) -> k1 /= x1)) ps
    p1 = map (\(u,v) -> (u,v-1)) $ takeWhile (\(k1, k2) -> k1 /= x1) ps
    p2 = dropWhile (\(k1, k2) -> k1 /= x1) ps
    p2' = takeWhile (\(k1, k2) -> k1 /= y) (tail p2)
    p3 = map (\(u,v) -> (u,v+1)) $ dropWhile (\(k1, k2) -> k1 /= y) p2
    qs = if null p3 then p1 ++ p2' ++ p3 else p1 ++ p2' ++ (tail p3)

oddMin :: [(Int,Int)] -> (Int,Int)
oddMin xs = minimum $ f xs
  where f [] = []
        f [x] = [x]
        f (x1:x2:xs) = x1 : f xs

oddMin' :: Int -> Int -> [(Int,Int)] -> Int
oddMin' k n xs = foldr (\(a1,a2) b -> if a2 == k && a1 < b then a1 else b) n $ f xs
  where f [] = []
        f [x] = [x]
        f (x1:x2:xs) = x1 : f xs

Submission Info

Judge Result