Problem:
Score : 300 points

Problem Statement

Given is an integer sequence D_1,...,D_N of N elements. Find the number, modulo 998244353, of trees with N vertices numbered 1 to N that satisfy the following condition:

For every integer i from 1 to N, the distance between Vertex 1 and Vertex i is D_i.

Notes

A tree of N vertices is a connected undirected graph with N vertices and N-1 edges, and the distance between two vertices are the number of edges in the shortest path between them.

Two trees are considered different if and only if there are two vertices x and y such that there is an edge between x and y in one of those trees and not in the other.

Constraints

1 \leq N \leq 10^5

0 \leq D_i \leq N-1

Input

Input is given from Standard Input in the following format:

N
D_1 D_2 ... D_N

Output

Print the answer.

Sample Input 1

4
0 1 1 2

Sample Output 1

2

For example, a tree with edges (1,2), (1,3), and (2,4) satisfies the condition.

Sample Input 2

4
1 1 1 1

Sample Output 2

0

Sample Input 3

7
0 3 2 1 2 2 1

Sample Output 3

24

Solution in Haskell (GHC 7.10.3) (judge verdict: Runtime Error)

{-# LANGUAGE
  ScopedTypeVariables, BangPatterns, TupleSections, ExplicitForAll,
  LambdaCase, MultiWayIf, Unsafe, RecordWildCards, FlexibleContexts, CPP,
  NoMonomorphismRestriction, GADTs, PatternGuards, MagicHash, UnboxedTuples,
  RankNTypes, EmptyDataDecls, EmptyCase, ViewPatterns, PolyKinds,
  TypeFamilies, OverloadedStrings, FlexibleInstances, UndecidableInstances,
  DefaultSignatures, GeneralizedNewtypeDeriving, StandaloneDeriving,
  DeriveGeneric, DeriveFunctor, DeriveDataTypeable, DeriveFoldable,
  DeriveTraversable, DeriveDataTypeable, FlexibleInstances,
  MultiParamTypeClasses #-}
{-# OPTIONS_GHC -O2 #-}

import Prelude
import Data.Bits
import Data.List
import Data.Maybe
import Data.Tuple
import Data.Ord
import Data.Int
import Data.Word
import Data.Char
import Data.Ratio
import Data.Function
import Data.STRef
import Data.IORef
import Data.Monoid
import Data.Functor
import Data.Data
import Data.Typeable
import GHC.Generics
import System.IO
import Control.Arrow
import Control.Applicative
import Control.Monad
import Control.Monad.Primitive
import Control.Monad.State.Strict
import Control.Monad.ST
import Control.Monad.ST.Lazy (strictToLazyST, lazyToStrictST)
import qualified Control.Monad.ST.Lazy as STL
-- import Control.Monad.ST.Safe
import Control.DeepSeq
import Data.Coerce
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as BSL
import qualified Data.ByteString.Builder as BSB
import Data.IntMap (IntMap)
import qualified Data.IntMap.Strict as IMS
import qualified Data.IntMap.Lazy as IML
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import qualified Data.Sequence as Seq
import Data.Sequence (Seq)
import qualified Data.Array.IArray as A
import qualified Data.Array.MArray.Safe as A
import qualified Data.Array.MArray as A
import Data.Array (Array)
import Data.Array.Unboxed (UArray)
import Data.Array.IArray (IArray)
import Data.Array.MArray.Safe (MArray)
import Data.Array.IO.Safe (IOArray, IOUArray)
import Data.Array.ST.Safe (STArray, STUArray, runSTArray, runSTUArray)
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import qualified Data.Vector.Unboxed as VU
import qualified Data.Vector.Unboxed.Mutable as VUM
import qualified Data.Vector.Storable as VS
import qualified Data.Vector.Storable.Mutable as VSM
import qualified Data.Vector.Primitive as VP
import qualified Data.Vector.Primitive.Mutable as VPM
import qualified Data.Vector.Generic as VG
import qualified Data.Vector.Generic.Mutable as VGM
import qualified Data.Vector.Fusion.Bundle.Monadic as VFBM
import qualified Data.Vector.Fusion.Bundle as VFB
import qualified Data.Vector.Fusion.Stream.Monadic as VFSM
import qualified Data.Vector.Fusion.Bundle.Size as VFBS
import qualified Data.Vector.Fusion.Util as VFU
import qualified Data.Attoparsec.ByteString.Char8 as Atto
import Debug.Trace
import GHC.Exts (build, Int(..), Int#,
                 (+#), (*#), (-#), (<#), (>=#), (==#), quotRemInt#,
                 remInt#, uncheckedIShiftRL#, andI#, orI#,
                isTrue#)


main :: IO ()
main = do
  n <- readInt <$> getLine
  as_ <- getVecULn n $ rIntS
  bs_ <- getVecULn n $ rIntS
  (bs,as) <- fmap VU.unzip $ do
    bdl <- VU.unsafeThaw $ VU.zip bs_ as_
    vait_sort bdl
    VU.unsafeFreeze bdl
  putStrLn $ if query as bs then "Yes" else "No"
  return ()

query :: VU.Vector Int -> VU.Vector Int -> Bool
query as bs
  | VU.or $ VU.zipWith (>) asP bs = False
  | cycleMoreThan2 is = True
  | otherwise = VU.or $ VU.zipWith (<=) (VU.tail asP) bs 
  where
    (is,asP) = VU.unzip $ VU.create $ do
      asI <- VU.thaw $ VU.indexed as
      vait_sortBy (compare `on` swap) asI
      return asI

cycleMoreThan2 :: VU.Vector Int -> Bool
cycleMoreThan2 vec = go (VU.length vec - 1) (vec VU.! 0)
  where
    go !n 0 | n > 0 = True
            | otherwise = False
    go !n !i = go (n-1) (vec VU.! i)
  

{-
The code below is the modified version of what I borrowed from the modules
Data.Vector.Algorithms.Common/Optimal/Insertion/Heap/Intro
in the package vector-algorithms-0.8.0.1 on Hackage.

The copyright notice follows:

Copyright (c) 2015 Dan Doel
Copyright (c) 2015 Tim Baumann

All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:

1. Redistributions of source code must retain the above copyright
   notice, this list of conditions and the following disclaimer.

2. Redistributions in binary form must reproduce the above copyright
   notice, this list of conditions and the following disclaimer in the
   documentation and/or other materials provided with the distribution.

3. Neither the name of the author nor the names of his contributors
   may be used to endorse or promote products derived from this software
   without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

------------------------------------------------------------------------------

The code in Data.Array.Vector.Algorithms.Mutable.Optimal is adapted from a C
algorithm for the same purpose. The folowing is the copyright notice for said
C code:

Copyright (c) 2004 Paul Hsieh
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

    Redistributions of source code must retain the above copyright notice,
    this list of conditions and the following disclaimer.

    Redistributions in binary form must reproduce the above copyright notice,
    this list of conditions and the following disclaimer in the documentation
    and/or other materials provided with the distribution.

    Neither the name of sorttest nor the names of its contributors may be
    used to endorse or promote products derived from this software without
    specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.
-}
#define FILTER \
  | len < 2   = return ()\
  | len == 2  = vao_sort2ByOffset cmp a l\
  | len == 3  = vao_sort3ByOffset cmp a l\
  | len == 4  = vao_sort4ByOffset cmp a l
#define FILTERED FILTER | otherwise

-- | Sorts an entire array using the default ordering.
vait_sort :: (PrimMonad m, VGM.MVector v e, Ord e)
  => v (PrimState m) e -> m ()
vait_sort = vait_sortBy compare
{-# INLINABLE vait_sort #-}

-- | Sorts an entire array using a custom ordering.
vait_sortBy :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> m ()
vait_sortBy cmp a = vait_sortByBounds cmp a 0 (VGM.length a)
{-# INLINE vait_sortBy #-}

-- | Sorts a portion of an array [l,u) using a custom ordering
vait_sortByBounds
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ lower index, l
  -> Int -- ^ upper index, u
  -> m ()
vait_sortByBounds cmp a l u FILTERED
  = vait_introsort cmp a (vait_ilg len) l u
 where len = u - l
{-# INLINE vait_sortByBounds #-}

-- Internal version of the introsort loop which allows partial
-- sort functions to call with a specified bound on iterations.
vait_introsort :: (PrimMonad m, VGM.MVector v e)
   => Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
vait_introsort cmp a i l u = sort i l u >> vais_sortByBounds cmp a l u
 where
 sort 0 l u = vah_sortByBounds cmp a l u
 sort d l u
   | len < vait_threshold = return ()
   | otherwise = do
       vao_sort3ByIndex cmp a c l (u-1)
        -- sort the median into the lowest position
       p <- VGM.unsafeRead a l
       mid <- vait_partitionBy cmp a p (l+1) u
       VGM.unsafeSwap a l (mid - 1)
       sort (d-1) mid u
       sort (d-1) l   (mid - 1)
  where
    len = u - l
    c   = vac_midPoint u l
{-# INLINE vait_introsort #-}

-- | Moves the least k elements to the front of the array in
-- no particular order.
vait_select
  :: (PrimMonad m, VGM.MVector v e, Ord e)
  => v (PrimState m) e
  -> Int -- ^ number of elements to select, k
  -> m ()
vait_select = vait_selectBy compare
{-# INLINE vait_select #-}

-- | Moves the least k elements (as defined by the comparison) to
-- the front of the array in no particular order.
vait_selectBy
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to select, k
  -> m ()
vait_selectBy cmp a k = vait_selectByBounds cmp a k 0 (VGM.length a)
{-# INLINE vait_selectBy #-}

-- | Moves the least k elements in the interval [l,u) to the positions
-- [l,k+l) in no particular order.
vait_selectByBounds
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to select, k
  -> Int -- ^ lower bound, l
  -> Int -- ^ upper bound, u
  -> m ()
vait_selectByBounds cmp a k l u
  | l >= u    = return ()
  | otherwise = go (vait_ilg len) l (l + k) u
 where
 len = u - l
 go 0 l m u = vah_selectByBounds cmp a (m - l) l u
 go n l m u = do
   vao_sort3ByIndex cmp a c l (u-1)
   p <- VGM.unsafeRead a l
   mid <- vait_partitionBy cmp a p (l+1) u
   VGM.unsafeSwap a l (mid - 1)
   if | m > mid -> go (n-1) mid m u
      | m < mid - 1 -> go (n-1) l m (mid - 1)
      | otherwise -> return ()
  where c = vac_midPoint u l
{-# INLINE vait_selectByBounds #-}

-- | Moves the least k elements to the front of the array, sorted.
vait_partialSort
  :: (PrimMonad m, VGM.MVector v e, Ord e)
  => v (PrimState m) e
  -> Int -- ^ number of elements to sort, k
  -> m ()
vait_partialSort = vait_partialSortBy compare
{-# INLINE vait_partialSort #-}

-- | Moves the least k elements (as defined by the comparison) to
-- the front of the array, sorted.
vait_partialSortBy
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to sort, k
  -> m ()
vait_partialSortBy cmp a k
  = vait_partialSortByBounds cmp a k 0 (VGM.length a)
{-# INLINE vait_partialSortBy #-}

-- | Moves the least k elements in the interval [l,u) to the positions
-- [l,k+l), sorted.
vait_partialSortByBounds
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to sort, k
  -> Int -- ^ lower index, l
  -> Int -- ^ upper index, u
  -> m ()
vait_partialSortByBounds cmp a k l u
  | l >= u    = return ()
  | otherwise = go (vait_ilg len) l (l + k) u
 where
 isort = vait_introsort cmp a
 {-# INLINE [1] isort #-}
 len = u - l
 go 0 l m n = vah_partialSortByBounds cmp a (m - l) l u
 go n l m u
   | l == m    = return ()
   | otherwise = do
       vao_sort3ByIndex cmp a c l (u-1)
       p <- VGM.unsafeRead a l
       mid <- vait_partitionBy cmp a p (l+1) u
       VGM.unsafeSwap a l (mid - 1)
       case compare m mid of
         GT -> do isort (n-1) l (mid - 1)
                  go (n-1) mid m u
         EQ -> isort (n-1) l m
         LT -> go n l m (mid - 1)
  where c = vac_midPoint u l
{-# INLINE vait_partialSortByBounds #-}

vait_partitionBy :: forall m v e. (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> e -> Int -> Int -> m Int
vait_partitionBy cmp a = partUp
 where
 partUp :: e -> Int -> Int -> m Int
 partUp p l u
   | l < u = do
       e <- VGM.unsafeRead a l
       case cmp e p of
         LT -> partUp p (l+1) u
         _  -> partDown p l (u-1)
   | otherwise = return l

 partDown :: e -> Int -> Int -> m Int
 partDown p l u
   | l < u = do
       e <- VGM.unsafeRead a u
       case cmp p e of
         LT -> partDown p l (u-1)
         _  -> VGM.unsafeSwap a l u >> partUp p (l+1) u
   | otherwise = return l
{-# INLINE vait_partitionBy #-}

-- computes the number of recursive calls after which heapsort should
-- be invoked given the lower and upper indices of the array to be sorted
vait_ilg :: Int -> Int
vait_ilg !m = 2 * (finiteBitSize m - countLeadingZeros m - 1)

-- the size of array at which the introsort algorithm switches to insertion sort
vait_threshold :: Int
vait_threshold = 18
{-# INLINE vait_threshold #-}

-- | Sorts an entire array using the default ordering.
vah_sort :: (PrimMonad m, VGM.MVector v e, Ord e) => v (PrimState m) e -> m ()
vah_sort = vah_sortBy compare
{-# INLINABLE vah_sort #-}

-- | Sorts an entire array using a custom ordering.
vah_sortBy :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> m ()
vah_sortBy cmp a = vah_sortByBounds cmp a 0 (VGM.length a)
{-# INLINE vah_sortBy #-}

-- | Sorts a portion of an array [l,u) using a custom ordering
vah_sortByBounds
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ lower index, l
  -> Int -- ^ upper index, u
  -> m ()
vah_sortByBounds cmp a l u FILTERED
  = vah_heapify cmp a l u >> vah_sortHeap cmp a l (l+4) u
    >> vao_sort4ByOffset cmp a l
 where len = u - l
{-# INLINE vah_sortByBounds #-}

-- | Moves the lowest k elements to the front of the array.
-- The elements will be in no particular order.
vah_select
  :: (PrimMonad m, VGM.MVector v e, Ord e)
  => v (PrimState m) e
  -> Int -- ^ number of elements to select, k
  -> m ()
vah_select = vah_selectBy compare
{-# INLINE vah_select #-}

-- | Moves the lowest (as defined by the comparison) k elements
-- to the front of the array. The elements will be in no particular
-- order.
vah_selectBy
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to select, k
  -> m ()
vah_selectBy cmp a k = vah_selectByBounds cmp a k 0 (VGM.length a)
{-# INLINE vah_selectBy #-}

-- | Moves the 'lowest' k elements in the portion [l,u) of the
-- array into the positions [l,k+l). The elements will be in
-- no particular order.
vah_selectByBounds
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to select, k
  -> Int -- ^ lower index, l
  -> Int -- ^ upper index, u
  -> m ()
vah_selectByBounds cmp a k l u
  | l + k <= u = vah_heapify cmp a l (l + k) >> go l (l + k) (u - 1)
  | otherwise  = return ()
 where
 go l m u
   | u < m      = return ()
   | otherwise  = do
       el <- VGM.unsafeRead a l
       eu <- VGM.unsafeRead a u
       case cmp eu el of
         LT -> vah_popTo cmp a l m u
         _  -> return ()
       go l m (u - 1)
{-# INLINE vah_selectByBounds #-}

-- | Moves the lowest k elements to the front of the array, sorted.
--
-- The remaining values of the array will be in no particular order.
vah_partialSort
  :: (PrimMonad m, VGM.MVector v e, Ord e)
  => v (PrimState m) e
  -> Int -- ^ number of elements to sort, k
  -> m ()
vah_partialSort = vah_partialSortBy compare
{-# INLINE vah_partialSort #-}

-- | Moves the lowest k elements (as defined by the comparison) to
-- the front of the array, sorted.
--
-- The remaining values of the array will be in no particular order.
vah_partialSortBy
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to vah_sort, k
  -> m ()
vah_partialSortBy cmp a k = vah_partialSortByBounds cmp a k 0 (VGM.length a)
{-# INLINE vah_partialSortBy #-}

-- | Moves the lowest k elements in the portion [l,u) of the array
-- into positions [l,k+l), sorted.
--
-- The remaining values in [l,u) will be in no particular order. Values outside
-- the range [l,u) will be unaffected.
vah_partialSortByBounds
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ number of elements to vah_sort, k
  -> Int -- ^ lower index, l
  -> Int -- ^ upper index, u
  -> m ()
vah_partialSortByBounds cmp a k l u FILTER
  -- this potentially does more work than absolutely required,
  -- but using a heap to find the least 2 of 4 elements
  -- seems unlikely to be better than just sorting all of them
  -- with an optimal sort, and the latter is obviously index
  -- correct.
  | u <= l + k = vah_sortByBounds cmp a l u
  | otherwise  = do
      vah_selectByBounds cmp a k l u
      vah_sortHeap cmp a l (l + 4) (l + k)
      vao_sort4ByOffset cmp a l
 where
 len = u - l
{-# INLINE vah_partialSortByBounds #-}

-- | Constructs a heap in a portion of an array [l, u), using the values
--   therein.
--
-- Note: 'vah_heapify' is more efficient than constructing a heap by repeated
-- insertion. Repeated insertion has complexity O(n*log n) while 'vah_heapify'
-- is able to construct a heap in O(n), where n is the number of elements in
-- the heap.
vah_heapify
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ lower index, l
  -> Int -- ^ upper index, u
  -> m ()
vah_heapify cmp a l u = loop $ (len - 1) `shiftR` 2
  where
 len = u - l
 loop k
   | k < 0     = return ()
   | otherwise = VGM.unsafeRead a (l+k) >>= \e ->
                   vah_siftByOffset cmp a e l k len >> loop (k - 1)
{-# INLINE vah_heapify #-}

-- | Given a heap stored in a portion of an array [l,u), swaps the
-- top of the heap with the element at u and rebuilds the heap.
vah_pop
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ lower heap index, l
  -> Int -- ^ upper heap index, u
  -> m ()
vah_pop cmp a l u = vah_popTo cmp a l u u
{-# INLINE vah_pop #-}

-- | Given a heap stored in a portion of an array [l,u) swaps the top
-- of the heap with the element at position t, and rebuilds the heap.
vah_popTo
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ lower heap index, l
  -> Int -- ^ upper heap index, u
  -> Int -- ^ index to vah_pop to, t
  -> m ()
vah_popTo cmp a l u t = do
  al <- VGM.unsafeRead a l
  at <- VGM.unsafeRead a t
  VGM.unsafeWrite a t al
  vah_siftByOffset cmp a at l 0 (u - l)
{-# INLINE vah_popTo #-}

-- | Given a heap stored in a portion of an array [l,u), sorts the
-- highest values into [m,u). The elements in [l,m) are not in any
-- particular order.
vah_sortHeap
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ lower heap index, l
  -> Int -- ^ lower bound of final sorted portion, m
  -> Int -- ^ upper heap index, u
  -> m ()
vah_sortHeap cmp a l m u = loop (u-1) >> VGM.unsafeSwap a l m
 where
 loop k
   | m < k     = vah_pop cmp a l k >> loop (k-1)
   | otherwise = return ()
{-# INLINE vah_sortHeap #-}

-- | Given a heap stored in a portion of an array [l,u) and an element e,
-- inserts the element into the heap, resulting in a heap in [l,u].
--
-- Note: it is best to only use this operation when incremental construction of
-- a heap is required. 'vah_heapify' is capable of building a heap in O(n) time,
-- while repeated insertion takes O(n*log n) time.
vah_heapInsert
  :: (PrimMonad m, VGM.MVector v e)
  => Comparison e
  -> v (PrimState m) e
  -> Int -- ^ lower heap index, l
  -> Int -- ^ upper heap index, u
  -> e -- ^ element to be inserted, e
  -> m ()
vah_heapInsert cmp v l u e = sift (u - l)
 where
 sift k
   | k <= 0    = VGM.unsafeWrite v l e
   | otherwise = let pi = l + shiftR (k-1) 2
                  in VGM.unsafeRead v pi >>= \p -> case cmp p e of
                       LT -> VGM.unsafeWrite v (l + k) p >> sift pi
                       _  -> VGM.unsafeWrite v (l + k) e
{-# INLINE vah_heapInsert #-}

-- Rebuilds a heap with a hole in it from start downwards. Afterward,
-- the heap property should apply for [start + off, len + off). val
-- is the new value to be put in the hole.
vah_siftByOffset :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> e -> Int -> Int -> Int -> m ()
vah_siftByOffset cmp a val off start len = sift val start len
 where
 sift val root len
   | child < len = do
       (child', ac) <- vah_maximumChild cmp a off child len
       case cmp val ac of
         LT -> VGM.unsafeWrite a (root + off) ac
               >> sift val child' len
         _  -> VGM.unsafeWrite a (root + off) val
   | otherwise = VGM.unsafeWrite a (root + off) val
  where child = root `shiftL` 2 + 1
{-# INLINE vah_siftByOffset #-}

-- Finds the maximum child of a heap node, given the indx of the first child.
vah_maximumChild :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m (Int,  e)
vah_maximumChild cmp a off child1 len
  | child4 < len = do
      ac1 <- VGM.unsafeRead a (child1 + off)
      ac2 <- VGM.unsafeRead a (child2 + off)
      ac3 <- VGM.unsafeRead a (child3 + off)
      ac4 <- VGM.unsafeRead a (child4 + off)
      return $ case cmp ac1 ac2 of
        LT -> case cmp ac2 ac3 of
          LT -> case cmp ac3 ac4 of
            LT -> (child4, ac4)
            _  -> (child3, ac3)
          _  -> case cmp ac2 ac4 of
            LT -> (child4, ac4)
            _  -> (child2, ac2)
        _  -> case cmp ac1 ac3 of
          LT -> case cmp ac3 ac4 of
            LT -> (child4, ac4)
            _  -> (child3, ac3)
          _  -> case cmp ac1 ac4 of
            LT -> (child4, ac4)
            _  -> (child1, ac1)
  | child3 < len = do
      ac1 <- VGM.unsafeRead a (child1 + off)
      ac2 <- VGM.unsafeRead a (child2 + off)
      ac3 <- VGM.unsafeRead a (child3 + off)
      return $ case cmp ac1 ac2 of
        LT -> case cmp ac2 ac3 of
          LT -> (child3, ac3)
          _  -> (child2, ac2)
        _  -> case cmp ac1 ac3 of
          LT -> (child3, ac3)
          _  -> (child1, ac1)
  | child2 < len = do
      ac1 <- VGM.unsafeRead a (child1 + off)
      ac2 <- VGM.unsafeRead a (child2 + off)
      return $ case cmp ac1 ac2 of
        LT -> (child2, ac2)
        _  -> (child1, ac1)
  | otherwise    = do
      ac1 <- VGM.unsafeRead a (child1 + off); return (child1, ac1)
 where
 child2 = child1 + 1
 child3 = child1 + 2
 child4 = child1 + 3
{-# INLINE vah_maximumChild #-}

-- | Sorts an entire array using the default comparison for the type
vais_sort :: (PrimMonad m, VGM.MVector v e, Ord e) =>
  v (PrimState m) e -> m ()
vais_sort = vais_sortBy compare
{-# INLINABLE vais_sort #-}

-- | Sorts an entire array using a given comparison
vais_sortBy :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> m ()
vais_sortBy cmp a = vais_sortByBounds cmp a 0 (VGM.length a)
{-# INLINE vais_sortBy #-}

-- | Sorts the portion of an array delimited by [l,u)
vais_sortByBounds :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
vais_sortByBounds cmp a l u FILTERED
  = vao_sort4ByOffset cmp a l >> vais_sortByBounds' cmp a l (l + 4) u
 where len = u - l
{-# INLINE vais_sortByBounds #-}

-- | Sorts the portion of the array delimited by [l,u) under the assumption
-- that [l,m) is already sorted.
vais_sortByBounds' :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
vais_sortByBounds' cmp a l m u = sort m
 where
 sort i
   | i < u     = do
       v <- VGM.unsafeRead a i
       vais_insert cmp a l v i
       sort (i+1)
   | otherwise = return ()
{-# INLINE vais_sortByBounds' #-}

-- Given a sorted array in [l,u), inserts val into its proper position,
-- yielding a sorted [l,u]
vais_insert :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> e -> Int -> m ()
vais_insert cmp a l = loop
 where
 loop val j
   | j <= l    = VGM.unsafeWrite a l val
   | otherwise = do
       e <- VGM.unsafeRead a (j - 1)
       case cmp val e of
         LT -> VGM.unsafeWrite a j e >> loop val (j - 1)
         _  -> VGM.unsafeWrite a j val
{-# INLINE vais_insert #-}

#define vec_writes2(a,v,w)\
  (VGM.unsafeWrite a v >> VGM.unsafeWrite a w)
#define vec_writes3(a,v,w,x)\
  (VGM.unsafeWrite a v >> vec_writes2(a,w,x))
#define vec_writes4(a,v,w,x,y)\
  (VGM.unsafeWrite a v >> vec_writes3(a,w,x,y))

-- | Sorts the elements at the positions 'off' and 'off + 1' in the given
-- array using the comparison.
vao_sort2ByOffset :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> m ()
vao_sort2ByOffset cmp a off = vao_sort2ByIndex cmp a off (off + 1)
{-# INLINABLE vao_sort2ByOffset #-}


-- | Sorts the elements at the two given indices using the comparison. This
-- is essentially a compare-and-swap, although the first index is assumed to
-- be the 'lower' of the two.
vao_sort2ByIndex :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> Int -> m ()
vao_sort2ByIndex cmp a i j = do
  a0 <- VGM.unsafeRead a i
  a1 <- VGM.unsafeRead a j
  case cmp a0 a1 of
    GT -> vec_writes2(a,i a1,j a0)
    _  -> return ()
{-# INLINABLE vao_sort2ByIndex #-}

-- | Sorts the three elements starting at the given offset in the array.
vao_sort3ByOffset :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> m ()
vao_sort3ByOffset cmp a off = vao_sort3ByIndex cmp a off (off + 1) (off + 2)
{-# INLINABLE vao_sort3ByOffset #-}

-- | Sorts the elements at the three given indices. The indices are assumed
-- to be given from lowest to highest, so if 'l < m < u' then
-- 'vao_sort3ByIndex cmp a m l u' essentially sorts the median of three into the
-- lowest position in the array.
vao_sort3ByIndex :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> m ()
vao_sort3ByIndex cmp a i j k = do
  a0 <- VGM.unsafeRead a i
  a1 <- VGM.unsafeRead a j
  a2 <- VGM.unsafeRead a k
  case cmp a0 a1 of
    GT -> case cmp a0 a2 of
      GT -> case cmp a2 a1 of
        LT -> vec_writes2(a,i a2,{-j a1-}k a0)
        _  -> vec_writes3(a,i a1,j a2,k a0)
      _  -> vec_writes2(a,i a1,j a0{-k a2-})
    _  -> case cmp a1 a2 of
      GT -> case cmp a0 a2 of
        GT -> vec_writes3(a,i a2,j a0,k a1)
        _  -> vec_writes2(a,{-i a0-}j a2,k a1)
      _  -> return ()
{-# INLINABLE vao_sort3ByIndex #-}

-- | Sorts the four elements beginning at the offset.
vao_sort4ByOffset :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> m ()
vao_sort4ByOffset cmp a off
  = vao_sort4ByIndex cmp a off (off + 1) (off + 2) (off + 3)
{-# INLINABLE vao_sort4ByOffset #-}

-- The horror...

-- | Sorts the elements at the four given indices. Like the 2 and 3 element
-- versions, this assumes that the indices are given in increasing order, so
-- it can be used to sort medians into particular positions and so on.
vao_sort4ByIndex :: (PrimMonad m, VGM.MVector v e)
  => Comparison e -> v (PrimState m) e -> Int -> Int -> Int -> Int -> m ()
vao_sort4ByIndex cmp a i j k l = do
  a0 <- VGM.unsafeRead a i
  a1 <- VGM.unsafeRead a j
  a2 <- VGM.unsafeRead a k
  a3 <- VGM.unsafeRead a l
  case cmp a0 a1 of
    GT -> case cmp a0 a2 of
      GT -> case cmp a1 a2 of
        GT -> case cmp a1 a3 of
          GT -> case cmp a2 a3 of
            GT -> vec_writes4(a,i a3,j a2,k a1,l a0)
            _  -> vec_writes4(a,i a2,j a3,k a1,l a0)
          _  -> case cmp a0 a3 of
            GT -> vec_writes3(a,i a2,{-j a1-}k a3,l a0)
            _  -> vec_writes2(a,i a2,{-j a1-}k a0{-l a3-})
        _ -> case cmp a2 a3 of
          GT -> case cmp a1 a3 of
            GT -> vec_writes2(a,i a3,{-j a1;k a2-}l a0)
            _  -> vec_writes3(a,i a1,j a3,{-k a2-}l a0)
          _  -> case cmp a0 a3 of
            GT -> vec_writes4(a,i a1,j a2,k a3,l a0)
            _  -> vec_writes3(a,i a1,j a2,k a0{-l a3-})
      _  -> case cmp a0 a3 of
        GT -> case cmp a1 a3 of
          GT -> vec_writes3(a,i a3,{-j a1-}k a0,l a2)
          _  -> vec_writes4(a,i a1,j a3,k a0,l a2)
        _  -> case cmp a2 a3 of
          GT -> vec_writes4(a,i a1,j a0,k a3,l a2)
          _  -> vec_writes2(a,i a1,j a0{-k a2;l a3-})
    _  -> case cmp a1 a2 of
      GT -> case cmp a0 a2 of
        GT -> case cmp a0 a3 of
          GT -> case cmp a2 a3 of
            GT -> vec_writes4(a,i a3,j a2,k a0,l a1)
            _  -> vec_writes4(a,i a2,j a3,k a0,l a1)
          _  -> case cmp a1 a3 of
            GT -> vec_writes4(a,i a2,j a0,k a3,l a1)
            _  -> vec_writes3(a,i a2,j a0,k a1{-l a3-})
        _  -> case cmp a2 a3 of
          GT -> case cmp a0 a3 of
            GT -> vec_writes3(a,i a3,j a0,{-k a2-}l a1)
            _  -> vec_writes2(a,{-i a0-}j a3,{-k a2-}l a1)
          _  -> case cmp a1 a3 of
            GT -> vec_writes3(a,{-i a0-}j a2,k a3,l a1)
            _  -> vec_writes2(a,{-i a0-}j a2,k a1{-l a3-})
      _  -> case cmp a1 a3 of
        GT -> case cmp a0 a3 of
          GT -> vec_writes4(a,i a3,j a0,k a1,l a2)
          _  -> vec_writes3(a,{-i a0-}j a3,k a1,l a2)
        _  -> case cmp a2 a3 of
          GT -> vec_writes2(a,{-i a0;j a1-}k a3,l a2)
          _  -> return () {-i a0;j a1;k a2;l a3-}
{-# INLINABLE vao_sort4ByIndex #-}

-- | A type of comparisons between two values of a given type.
type Comparison e = e -> e -> Ordering

vac_midPoint :: Int -> Int -> Int
vac_midPoint a b =
  toInt $ (toWord a + toWord b) `div` 2
  where
    toWord :: Int -> Word
    toWord = fromIntegral

    toInt :: Word -> Int
    toInt = fromIntegral
{-# INLINE vac_midPoint #-}

#undef vec_writes2
#undef vec_writes3
#undef vec_writes4
#undef FILTERED
#undef FILTER

{- Borrowed code end -}


#define IL(f) {-# INLINE f #-}; f

class ShowAsBuilder a where
  showAsBuilder :: a -> BSB.Builder
  default showAsBuilder :: (Show a) => a -> BSB.Builder
  showAsBuilder = BSB.string8 . show

#define INS(t,f) instance ShowAsBuilder t where \
  { {-# INLINE showAsBuilder #-}; showAsBuilder=f }
INS(Int,BSB.intDec)
INS(Int8,BSB.int8Dec)
INS(Int16,BSB.int16Dec)
INS(Int32,BSB.int32Dec)
INS(Int64,BSB.int64Dec)
INS(Word,BSB.wordDec)
INS(Word8,BSB.word8Dec)
INS(Word16,BSB.word16Dec)
INS(Word32,BSB.word32Dec)
INS(Word64,BSB.word64Dec)
INS(Integer,BSB.integerDec)
INS(Float,BSB.floatDec)
INS(Double,BSB.doubleDec)
-- INS(String,BSB.string8) -- Inconsistent with Show
-- INS(BS.ByteString,BSB.byteString) -- Inconsistent with Show
-- INS(BSL.ByteString,BSB.lazyByteString) -- Inconsisitent with Show
#undef INS

-- Inconsistent with show
instance (ShowAsBuilder a, VG.Vector v a) => ShowAsBuilder (v a) where
  showAsBuilder = v2BSpcSep

{-# INLINE putBuilder #-}
putBuilder = BSB.hPutBuilder stdout

printVecInLines, printVecInSpcSepLn ::
  (VG.Vector v a, ShowAsBuilder a) => v a -> IO ()
{-# INLINE printVecInLines #-}
printVecInLines = putBuilder . v2BLines
{-# INLINE printVecInSpcSepLn #-}
printVecInSpcSepLn = putBuilder . v2BSpcSepLn

v2BSpcSepLn, v2BSpcSep, v2BConcat, v2BLines ::
  (VG.Vector v a, ShowAsBuilder a)
  => v a -> BSB.Builder
{-# INLINE v2BSpcSepLn #-}
v2BSpcSepLn = v2BSpcSepLnWith showAsBuilder
{-# INLINE v2BSpcSep #-}
v2BSpcSep = v2BSpcSepWith showAsBuilder
{-# INLINE v2BConcat #-}
v2BConcat = v2BConcatWith showAsBuilder
{-# INLINE v2BLines #-}
v2BLines = v2BLinesWith showAsBuilder


v2BSpcSepLnWith, v2BSpcSepWith, v2BConcatWith, v2BLinesWith ::
  (VG.Vector v a)
  => (a -> BSB.Builder) -- ^ show function
  -> v a -> BSB.Builder
{-# INLINE v2BSpcSepLnWith #-}
v2BSpcSepLnWith = v2BSpcSepPostfWith "\n"
{-# INLINE v2BSpcSepWith #-}
v2BSpcSepWith = v2BSpcSepPostfWith ""
{-# INLINE v2BConcatWith #-}
v2BConcatWith showFct = VG.foldr ((<>) . showFct) mempty
{-# INLINE v2BLinesWith #-}
v2BLinesWith showFct
  = VG.foldr (\ a -> (showFct a <>) . (BSB.char7 '\n' <>)) mempty


v2BSpcSepPostf :: (VG.Vector v a, ShowAsBuilder a)
  => BS.ByteString -- ^ postfix
  -> v a -> BSB.Builder
{-# INLINE v2BSpcSepPostf #-}
v2BSpcSepPostf = (`v2BSpcSepPostfWith` showAsBuilder)

v2BSpcSepPostfWith :: (VG.Vector v a)
  => BS.ByteString -- ^ postfix
  -> (a -> BSB.Builder) -- ^ show function
  -> v a -> BSB.Builder
{-# INLINE v2BSpcSepPostfWith #-}
v2BSpcSepPostfWith = vecToBuilder "" " "

{-# INLINE vecToBuilder #-}
vecToBuilder :: (VG.Vector v a)
  => BS.ByteString -- ^ prefix
  -> BS.ByteString -- ^ separator
  -> BS.ByteString -- ^ postfix
  -> (a -> BSB.Builder) -- ^ show function
  -> v a -> BSB.Builder
vecToBuilder !prefix !separator !postfix
  = vecToBuilder_ (BSB.byteString prefix)
                  (BSB.byteString separator)
                  (BSB.byteString postfix)


{-# INLINE vecToBuilder_ #-}
vecToBuilder_ :: (VG.Vector v a)
  => BSB.Builder -- ^ prefix
  -> BSB.Builder -- ^ separator
  -> BSB.Builder -- ^ postfix
  -> (a -> BSB.Builder) -- ^ show function
  -> v a -> BSB.Builder
vecToBuilder_ !prefix !separator !postfix showFct vec
  = prefix <> VG.foldr
    (\ a rest !prefx -> prefx <> (showFct a <> rest separator))
    (const postfix) vec mempty

IL(evalVals) :: [a] -> [a]
evalVals xs = build $ \c n -> foldr (c $!) n xs
IL(forceVals) :: (NFData a) => [a] -> [a]
forceVals xs = build $ \c n -> foldr (c $!!) n xs

getVecGLn :: (VG.Vector v a) =>
           Int -> StateT BS.ByteString Maybe a -> IO (v a)
getVecGLn n s = VG.unfoldrN n (runStateT s) <$> BS.getLine
{-# INLINE getVecGLn #-}
getVecGRest :: (VG.Vector v a) =>
            Int -> StateT BSL.ByteString Maybe a -> IO (v a)
getVecGRest n s = VG.unfoldrN n (runStateT s) <$> BSL.getContents
{-# INLINE getVecGRest #-}
getVecLn :: Int -> StateT BS.ByteString Maybe a -> IO (V.Vector a)
getVecLn = getVecGLn
{-# INLINE getVecLn #-}
getVecRest :: Int -> StateT BSL.ByteString Maybe a -> IO (V.Vector a)
getVecRest = getVecGRest
{-# INLINE getVecRest #-}
getVecULn :: (VU.Unbox a) =>
  Int -> StateT BS.ByteString Maybe a -> IO (VU.Vector a)
getVecULn = getVecGLn
{-# INLINE getVecULn #-}
getVecURest :: (VU.Unbox a) =>
  Int -> StateT BSL.ByteString Maybe a -> IO (VU.Vector a)
getVecURest = getVecGRest
{-# INLINE getVecURest #-}

rInt :: StateT BSL.ByteString Maybe Int
IL(rInt) = StateT $ BSL.readInt . BSL.dropWhile (<'!')
rIntS :: StateT BS.ByteString Maybe Int
IL(rIntS) = StateT $ BS.readInt . BS.dropWhile (<'!')

unlessM, whenM :: (Monad m) => m Bool -> m () -> m ()
IL(whenM) = (. flip when) . (>>=)
IL(unlessM) = (. flip unless) . (>>=)

IL(wrA) = A.writeArray
IL(rdA) = A.readArray
IL(mdA) = \arr f !i -> do
  ai <- rdA arr i
  let fai = f ai 
  wrA arr i fai
  return (ai,fai)
{-# INLINE mdA' #-}
mdA' = \arr f !i -> do
  !ai <- rdA arr i
  let !fai = f ai
  wrA arr i fai
  return (ai,fai)
IL(swapA) = \arr !i !j -> do
  ai <- rdA arr i
  wrA arr i =<< rdA arr j
  wrA arr j ai

#define D(f,r,d)\
  IL(f) :: Integral a=>a->d; f=fromIntegral;\
  IL(r) :: String->d; r=read
#define C(f,r,g,h,d) D(f,r,d);\
  g,h :: RealFrac a=>a->d; IL(g)=floor; IL(h)=ceiling
C(_toInteger_,readInteger,floorInteger,ceilInteger,Integer)
C(toInt,readInt,floorInt,ceilInt,Int)
C(toI8,readI8,floorI8,ceilI8,Int8)
C(toI16,readI16,floorI16,ceilI16,Int16)
C(toI32,readI32,floorI32,ceilI32,Int32)
C(toI64,readI64,floorI64,ceilI64,Int64)
C(toWord,readWord,floorWord,ceilWord,Word)
C(toW8,readW8,floorW8,ceilW8,Word8)
C(toW16,readW16,floorW16,ceilW16,Word16)
C(toW32,readW32,floorW32,ceilW32,Word32)
C(toW64,readW64,floorW64,ceilW64,Word64)
D(toDouble,readDouble,Double)
D(toFloat,readFloat,Float)
#undef D
#undef C

#define N(f,g,h,a,m)\
  IL(f) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> e -> m (a i e);\
  f=A.newArray;\
  IL(g) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> m (a i e);\
  g=A.newArray_;\
  IL(h) :: forall e i s. (C(a,m)A.Ix i) => (i,i) -> [e] -> m (a i e);\
  h=A.newListArray
#define C(a,m)
N(newIOA,newIOA_,newIOAL,IOArray,IO)
N(newSTA,newSTA_,newSTAL,STArray s,ST s)
#undef C
#define C(a,m) MArray (a) e (m), 
N(newIOUA,newIOUA_,newIOUAL,IOUArray,IO)
N(newSTUA,newSTUA_,newSTUAL,STUArray s,ST s)
#undef C
#undef N

#undef IL