Link to this code:
https://cses.fi/paste/b23bf94c9440505af9ce60/module Main where
solve :: Int -> Maybe (Int, [Int], Int, [Int])
solve n =
case n `mod` 4 of
0 -> Just (n `div` 2, [1, 3 .. n `div` 2] ++ [n `div` 2 + 2, n `div` 2 + 4 .. n]
,n `div` 2, [2, 4 .. n `div` 2] ++ [n `div` 2 + 1, n `div` 2 + 3 .. n])
3 -> do
let target = n * (n + 1) `div` 4
-- k * (k + 1) >= target * 2
-- k^2 + k - target*2 >= 0
--
-- k = (-1 + sqrt(1 + 8*target)) / 2
let k = ceiling ((-1 + sqrt (fromIntegral (1 + 8 * target) :: Double)) / 2) :: Int
let reached = k * (k + 1) `div` 2
let leaveout = reached - target
-- print (n, target, k, reached, leaveout)
if leaveout == 0
then Just (k, [1..k], n - k, [k+1 .. n])
else Just (k - 1, [1 .. leaveout-1] ++ [leaveout+1 .. k], n - k + 1, leaveout : [k+1 .. n])
_ -> Nothing
check :: Int -> Maybe ([Int], [Int]) -> Bool
check n (Just (l1, l2))
| let s = sum l1, s == sum l2, even (n * (n + 1) `div` 2), s == n * (n + 1) `div` 4 = True
| otherwise = False
check n Nothing
| even (n * (n + 1) `div` 2) = False
| otherwise = True
main :: IO ()
main = do
let prints = putStrLn . unwords . map show
n <- readLn
case solve n of
Just (n1, l1, n2, l2) -> do
putStrLn "YES"
print n1
prints l1
print n2
prints l2
Nothing -> putStrLn "NO"