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"