Problem:
Score : 600 points

Problem Statement

You are given a forest with N vertices and M edges. The vertices are numbered 0 through N-1.
The edges are given in the format (x_i,y_i), which means that Vertex x_i and y_i are connected by an edge.

Each vertex i has a value a_i.
You want to add edges in the given forest so that the forest becomes connected.
To add an edge, you choose two different vertices i and j, then span an edge between i and j.
This operation costs a_i + a_j dollars, and afterward neither Vertex i nor j can be selected again.

Find the minimum total cost required to make the forest connected, or print Impossible if it is impossible.

Constraints

1 ≤ N ≤ 100,000

0 ≤ M ≤ N-1

1 ≤ a_i ≤ 10^9

0 ≤ x_i,y_i ≤ N-1

The given graph is a forest.

All input values are integers.

Input

Input is given from Standard Input in the following format:

N M
a_0 a_1 .. a_{N-1}
x_1 y_1
x_2 y_2
:
x_M y_M

Output

Print the minimum total cost required to make the forest connected, or print Impossible if it is impossible.

Sample Input 1

7 5
1 2 3 4 5 6 7
3 0
4 0
1 2
1 3
5 6

Sample Output 1

7

If we connect vertices 0 and 5, the graph becomes connected, for the cost of 1 + 6 = 7 dollars.

Sample Input 2

5 0
3 1 4 1 5

Sample Output 2

Impossible

We can't make the graph connected.

Sample Input 3

1 0
5

Sample Output 3

0

The graph is already connected, so we do not need to add any edges.

Solution in Haskell (GHC 7.10.3) (judge verdict: Time Limit Exceeded)

import qualified Data.ByteString.Char8 as BC
import qualified Data.IntMap as M
import Data.Maybe (fromJust)
import Data.List
import Data.Array.IO
import Control.Monad

type Arr = IOUArray Int Int
type ArrB = IOUArray Int Bool
type Edge = (Int, Int)

main = do
  [n,m] <- map read . words <$> getLine :: IO [Int]
  a <- getIntListBC
  edge <- if m > 0
            then getInt2DListBC
            else return [] :: IO [[Int]]
  parent <- newListArray (-1, n-1) [-1..n-1] :: IO Arr
  writeArray parent (-1) 0
  children <- newArray (0, n-1) 0 :: IO Arr
  mark <- newArray (0, n-1) False :: IO ArrB
  let weight = sort $ zip a [0..n-1]
  unionFind parent edge
  foldM (count parent) children [0..n-1]
  l <- length . nub . tail <$> getElems parent
  c <- map (min (l-1)) <$> getElems children
  children' <- newListArray (0, n-1) c :: IO Arr
  weight' <- select parent children' mark l weight

  single <- subtract 1 . length . filter (==1) . map length . group . sort <$> getElems parent
  ans1 <- if l > 1 then readArray parent (-1) else return 0
  ans2 <- solve parent children' (l-2) weight'
  if single > (n - single) - (l - single - 1)*2
    then putStrLn "Impossible"
    else print $ ans1 + ans2

solve :: Arr -> Arr -> Int -> [(Int, Int)] -> IO Int
solve _ _ _ [] = return 0
solve _ _ 0 _ = return 0
solve parent children i ((w, v):s) = do
  p <- readArray parent v
  c <- readArray children p
  if c > 0
    then do
      dec children p
      ans <- solve parent children (i-1) s
      return $ w + ans
    else do
      solve parent children i s

select :: Arr -> Arr -> ArrB -> Int -> [(Int, Int)] -> IO [(Int, Int)]
select _      _        _    _ []          = return []
select parent children mark n ((w, v):ws) = do
  p <- readArray parent v
  used <- readArray mark p
  if used || n <= 0
    then do
      l <- select parent children mark n ws
      return $ (w, v):l
    else do
      dec children p
      writeArray mark p True
      s <- readArray parent (-1)
      writeArray parent (-1) $ s + w
      select parent children mark (n-1) ws

count :: Arr -> Arr -> Int -> IO Arr
count parent children v = do
  p <- getRepresentative parent v
  inc children p
  return children

inc :: Arr -> Int -> IO ()
inc arr i = do
  x <- readArray arr i
  writeArray arr i $ x + 1

dec :: Arr -> Int -> IO ()
dec arr i = do
  x <- readArray arr i
  writeArray arr i $ x - 1

unionFind :: Arr -> [[Int]] -> IO Arr
unionFind memo [] = return memo
unionFind memo ([i, j]:es) = do
  pI <- getRepresentative memo i
  pJ <- getRepresentative memo j
  if pI == pJ then unionFind memo es
              else do
                writeArray memo pI pJ
                unionFind memo es

getRepresentative :: Arr -> Int -> IO Int
getRepresentative memo i = do
  parent <- readArray memo i
  if i == parent
    then return i
    else do
      pp <- getRepresentative memo parent
      writeArray memo i pp
      return pp

bsToInt :: BC.ByteString -> Int
bsToInt = fst . fromJust . BC.readInt

getIntListBC :: IO [Int]
getIntListBC = map bsToInt . BC.words <$> BC.getLine

getInt2DListBC :: IO [[Int]]
getInt2DListBC = map (map bsToInt . BC.words) . BC.lines <$> BC.getContents