Little Petya very much likes rectangles and especially squares. Recently he has received 8 points on the plane as a gift from his mother. The points are pairwise distinct. Petya decided to split them into two sets each containing 4 points so that the points from the first set lay at the vertexes of some square and the points from the second set lay at the vertexes of a rectangle. Each point of initial 8 should belong to exactly one set. It is acceptable for a rectangle from the second set was also a square. If there are several partitions, Petya will be satisfied by any of them. Help him find such partition. Note that the rectangle and the square from the partition should have non-zero areas. The sides of the figures do not have to be parallel to the coordinate axes, though it might be the case.

You are given 8 pairs of integers, a pair per line — the coordinates of the points Petya has. The absolute value of all coordinates does not exceed 104. It is guaranteed that no two points coincide.

Print in the first output line "YES" (without the quotes), if the desired partition exists. In the second line output 4 space-separated numbers — point indexes from the input, which lie at the vertexes of the square. The points are numbered starting from 1. The numbers can be printed in any order. In the third line print the indexes of points lying at the vertexes of a rectangle in the similar format. All printed numbers should be pairwise distinct. If the required partition does not exist, the first line should contain the word "NO" (without the quotes), after which no output is needed.

NotePay attention to the third example: the figures do not necessarily have to be parallel to the coordinate axes.

import Data.List

separate      a 0 = [([],a)]
separate     [] _ = []
separate (a:as) n =  [ (a : fst cs, snd cs) | cs <- separate as (n-1) ]
                  ++ [ (fst cs, a : snd cs) | cs <- separate as n ]

isRectangle ps is = x && y
   where ps' = map (ps!!) is
         [a,b,c,d] = sort ps'
         x = (b `sub` a) `dotPro` (c `sub` a) == 0
         y = a `add` d == b `add` c

isRhombus ps is = x == y
   where ps' = map (ps!!) is
         [a,b,c,d] = sort ps'
         x = size2 (b `sub` a)
         y = size2 (c `sub` a)

solve ps (x, y)  = isRectangle ps x
                && isRhombus ps x
                && isRectangle ps y

add (a,b) (c,d) = (a+c, b+d)
sub (a,b) (c,d) = (a-c, b-d)
dotPro (a,b) (c,d) = a*c + b*d
size2 (a,b) = a*a + b*b

printAns (Just x) = do
   putStrLn "YES"
   putStrLn (unwords . map (show . (+1)) $ fst x)
   putStrLn (unwords . map (show . (+1)) $ snd x)
printAns Nothing = putStrLn "NO"

main = do
   ps <- mapM (fmap ((\[x,y] -> (x,y)) . map read . words)) $ map (\_ -> getLine) [1..8] :: IO [(Int, Int)]
   printAns $ find (solve ps) (separate [0..7] 4)

-- vim: set expandtab:

import Control.Monad (liftM, when)
import Data.List ((\\), intercalate, nub, sort)
import Data.Maybe (listToMaybe)
import Prelude hiding (print)

type Point  =  (Int, Int)

n :: Int
n  =  8

parsePoint :: String -> Point
parsePoint s  =  case map read (words s) of
    [x, y]  ->  (x, y)

getSDists :: [Point] -> [Int]
getSDists ps  =  [sDist p1 p2 | p1 <- ps, p2 <- ps, p1 < p2]

sDist :: Point -> Point -> Int
sDist (x1, y1) (x2, y2)  =  sum $ map (^2) $ zipWith (-) [x1, y1] [x2, y2]

isFigure :: [Point] -> ([Int] -> Bool) -> Bool
isFigure ps check  =  check $ sort $ getSDists ps

isSquare :: [Point] -> Bool
isSquare ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d2 == d3 && d3 == d4 && d5 == d6 && d1 + d3 == d5

isRectangle :: [Point] -> Bool
isRectangle [p1, p2, p3, p4]
  =  a1 > 0 && a1 == a2
  && b1 > 0 && b1 == b2
  && c1 > 0 && c1 == c2
  && sum [a1, b1, c1]  -  2 * maximum [a1, b1, c1] == 0
  where
    a1  =  sDist p1 p2
    a2  =  sDist p3 p4
    b1  =  sDist p1 p3
    b2  =  sDist p2 p4
    c1  =  sDist p1 p4
    c2  =  sDist p2 p3

solve :: [Point] -> Maybe ([Int], [Int])
solve ps  =  listToMaybe $ do
    let ps'  =  zip [1..] ps
    sq  <-  [[p1, p2, p3, p4] | p1 <- ps', p2 <- ps', p3 <- ps', p4 <- ps', snd p1 < snd p2, snd p2 < snd p3, snd p3 < snd p4]
    let rc  =  ps' \\ sq
    if (isSquare (map snd sq) && isRectangle (map snd rc))
        then return (map fst sq, map fst rc)
        else fail ""

print :: Maybe ([Int], [Int]) -> IO ()
print Nothing  =  putStrLn "NO"
print (Just (as, bs))  =  putStrLn "YES" >> prints as >> prints bs
  where
    prints xs  =  putStrLn $ intercalate " " (map show xs)

main :: IO ()
main  =  do
    ps  <-  liftM (take n . map parsePoint . lines) getContents
    print $ solve ps

{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
{-# OPTIONS_GHC -O2 #-}

import Data.List
import Data.Maybe
import Data.Char
import Data.Array.IArray
import Data.Array.Unboxed (UArray)
import Data.Int
import Data.Ratio
import Data.Bits
import Data.Function
import Data.Ord
--import Control.Monad.State
import Control.Monad
import Control.Applicative
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map)
import qualified Data.Map as Map
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Sequence (Seq, (<|), (|>), (><), ViewL(..), ViewR(..))
import qualified Data.Sequence as Seq
import qualified Data.Foldable as F
import Data.Graph

parseInput = do
    replicateM 8 ((,) <$> readInt <*> readInt)
  where
    readInt = state $ fromJust . BS.readInt . BS.dropWhile isSpace
    readInteger = state $ fromJust . BS.readInteger . BS.dropWhile isSpace
    readString = state $ BS.span (not . isSpace) . BS.dropWhile isSpace
    readLine = state $ BS.span (not . isEoln) . BS.dropWhile isEoln
    isEoln ch = ch == '\r' || ch == '\n'

main = BS.putStr =<< solve . evalState parseInput <$> BS.getContents

makeLine lst = BS.unwords (map (BS.pack.show) lst)
solve pts = case listToMaybe lst of
    Nothing -> BS.pack "NO"
    Just order -> BS.unlines [ BS.pack "YES"
                             , makeLine (take 4 order)
                             , makeLine (drop 4 order)
                             ]
  where
    lst = [ order
          | (order, pts) <- unzip <$> permutations (zip [1..] pts)
          , checkRect (take 4 pts) && checkRect (drop 4 pts)
          , checkEq (take 4 pts)
          ]

-- a  b
-- d  c
checkRect [a, b, c, d] = and [ dot a b d == 0
                             , dot b a c == 0
                             , dot c b d == 0
                             , dot d a c == 0
                             ]

checkEq [a, b, c, d] = all (==head dists) dists
  where
    dists = [dist a b, dist b c, dist c d, dist d a]

dot (x0, y0) (x1, y1) (x2, y2) = (x1 - x0) * (x2 - x0) + (y1 - y0) * (y2 - y0)
dist (x1, y1) (x2, y2) = (x1 - x2)^2 + (y1 - y2)^2

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

class (Monad m) => MonadState s m | m -> s where
	get :: m s
	put :: s -> m ()

modify :: (MonadState s m) => (s -> s) -> m ()
modify f = do
	s <- get
	put (f s)

gets :: (MonadState s m) => (s -> a) -> m a
gets f = do
	s <- get
	return (f s)

newtype State s a = State { runState :: s -> (a, s) }

instance Functor (State s) where
	fmap f m = State $ \s -> let
		(a, s') = runState m s
		in (f a, s')

instance Applicative (State s) where
    pure = return
    (<*>) = ap

instance Monad (State s) where
	return a = State $ \s -> (a, s)
	m >>= k  = State $ \s -> let
		(a, s') = runState m s
		in runState (k a) s'

instance MonadState s (State s) where
	get   = State $ \s -> (s, s)
	put s = State $ \_ -> ((), s)

evalState :: State s a -> s -> a
evalState m s = fst (runState m s)

execState :: State s a -> s -> s
execState m s = snd (runState m s)

mapState :: ((a, s) -> (b, s)) -> State s a -> State s b
mapState f m = State $ f . runState m

withState :: (s -> s) -> State s a -> State s a
withState f m = State $ runState m . f

state = State

import List

type Point = (Int, Int)
type P4 = (Point, Point, Point, Point)
type P8 = (Point, Point, Point, Point, Point, Point, Point, Point)
type I4 = (Int, Int, Int, Int)

fromP4 :: P4 -> [Point]
fromP4 (p1, p2, p3, p4) = [p1, p2, p3, p4]

fromP8 :: P8 -> [Point]
fromP8 (p1, p2, p3, p4, p5, p6, p7, p8) = [p1, p2, p3, p4, p5, p6, p7, p8]

toP8 :: [Point] -> P8
toP8 [p1, p2, p3, p4, p5, p6, p7, p8] = (p1, p2, p3, p4, p5, p6, p7, p8)

fromI4 :: I4 -> [Int]
fromI4 (i1, i2, i3, i4) = [i1, i2, i3, i4]

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

distSquare :: (Point, Point) -> Int
distSquare ((x1, y1), (x2, y2)) = (x1 - x2)^2 + (y1 - y2)^2

getDistances :: P4 -> [Int]
getDistances p4 =
  map distSquare [(ps !! i, ps !! j) | i <- [0..3], j <- [0..3], i < j]
  where
    ps = fromP4 p4

checkSquare :: P4 -> Bool
checkSquare p4 =
  a1 > 0  &&  a1 == a4  &&  a5 == 2 * a1  &&  a5 == a6
  where
    [a1, a2, a3, a4, a5, a6] = sort (getDistances p4)

equalDistances :: ((Point, Point), (Point, Point)) -> Bool
equalDistances (ps1, ps2)  =  distSquare ps1 == distSquare ps2

checkParas :: P4 -> Bool
checkParas (p1, p2, p3, p4)
    = and (map equalDistances [((p1, p2), (p3, p4)), ((p1, p3), (p2, p4)), ((p1, p4), (p2, p3))])

checkRectangle :: P4 -> Bool
checkRectangle p4 =
  a1 > 0  &&  a1 == a2  &&  a3 == a4  &&  a5 == a1 + a3  &&  a5 == a6
  &&
  checkParas p4
  where
    [a1, a2, a3, a4, a5, a6] = sort (getDistances p4)

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

next :: Maybe I4 -> Maybe I4
next  Nothing             =  Nothing
next (Just (4, 5, 6, 7))  =  Nothing
next (Just (a, 5, 6, 7))  =  Just (a + 1, a + 2, a + 3, a + 4)
next (Just (a, b, 6, 7))  =  Just (a, b + 1, b + 2, b + 3)
next (Just (a, b, c, 7))  =  Just (a, b, c + 1, c + 2)
next (Just (a, b, c, d))  =  Just (a, b, c, d + 1)

firstSelection :: I4
firstSelection = (0, 1, 2, 3)

generateSelections :: [Maybe I4]
generateSelections = takeWhile (/= Nothing) (iterate next (Just firstSelection))

otherElements :: I4 -> I4
otherElements i4 = (j1, j2, j3, j4)
  where
    [j1, j2, j3, j4] = filter (\x -> not (elem x (fromI4 i4))) [0..7]

checkSelection :: P8 -> Maybe I4 -> Bool
checkSelection p8 (Just is) =
    checkSquare (ps !! i1, ps !! i2, ps !! i3, ps !! i4)
    &&
    checkRectangle (ps !! j1, ps !! j2, ps !! j3, ps !! j4)
  where
    ps = fromP8 p8
    (i1, i2, i3, i4) = is
    (j1, j2, j3, j4) = otherElements is

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

solve :: P8 -> Maybe I4
solve ps
  |  null solution  =  Nothing
  |  otherwise      =  head solution
  where
    solution = filter (checkSelection ps) generateSelections

printAns :: Maybe I4 -> IO ()
printAns Nothing   = putStrLn "NO"
printAns (Just i4) = do
    putStrLn "YES"
    sequence_ (map (\x -> putStr (show (xs !! x + 1) ++ " ")) [0..3])
    putStrLn ""
    sequence_ (map (\x -> putStr (show (ys !! x + 1) ++ " ")) [0..3])
    putStrLn ""
  where
    xs = fromI4 i4
    ys = fromI4 (otherElements i4)

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

parsePoint :: String -> Point
parsePoint line = (x, y)
  where
    [x, y] = map read (words line)

readPoint :: IO Point
readPoint = do
    getLine >>= return . parsePoint

readPoints :: IO P8
readPoints = do
    ps <- sequence (map (\x -> readPoint) [1..8])
    return (toP8 ps)

main :: IO ()
main = readPoints >>= printAns . solve

import Data.List

separate      a 0 = [([],a)]
separate     [] _ = []
separate (a:as) n =  [ (a : fst cs, snd cs) | cs <- separate as (n-1) ]
                  ++ [ (fst cs, a : snd cs) | cs <- separate as n ]

isRectangle ps is = x && y
   where ps' = map (ps!!) is
         [a,b,c,d] = sort ps'
         x = (b `sub` a) `dotPro` (c `sub` a) == 0
         y = a `add` d == b `add` c

isRectangle2 ps (x, y) = isRectangle ps x && isRectangle ps y

add (a,b) (c,d) = (a+c, b+d)
sub (a,b) (c,d) = (a-c, b-d)
dotPro (a,b) (c,d) = a*c + b*d

printAns (Just x) = do
   putStrLn "YES"
   putStrLn (unwords . map (show . (+1)) $ fst x)
   putStrLn (unwords . map (show . (+1)) $ snd x)
printAns Nothing = putStrLn "NO"

main = do
   ps <- mapM (fmap ((\[x,y] -> (x,y)) . map read . words)) $ map (\_ -> getLine) [1..8] :: IO [(Int, Int)]
   printAns $ find (isRectangle2 ps) (separate [0..7] 4)

-- vim: set expandtab:

import Control.Monad (liftM, when)
import Data.List ((\\), intercalate, nub, sort)
import Data.Maybe (listToMaybe)
import Prelude hiding (print)

type Point  =  (Int, Int)

n :: Int
n  =  8

parsePoint :: String -> Point
parsePoint s  =  case map read (words s) of
    [x, y]  ->  (x, y)

getSDists :: [Point] -> [Int]
getSDists ps  =  [sDist p1 p2 | p1 <- ps, p2 <- ps, p1 < p2]
  where
    sDist (x1, y1) (x2, y2)  =  sum $ map (^2) $ zipWith (-) [x1, y1] [x2, y2]

isFigure :: [Point] -> ([Int] -> Bool) -> Bool
isFigure ps check  =  check $ sort $ getSDists ps

isRectangle, isSquare :: [Point] -> Bool
isRectangle ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d3 == d4 && d5 == d6 && d1 + d3 == d5
isSquare    ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d2 == d3 && d3 == d4 && d5 == d6 && d1 + d3 == d5

solve :: [Point] -> Maybe ([Int], [Int])
solve ps  =  listToMaybe $ do
    let ps'  =  zip [1..] ps
    sq  <-  [[p1, p2, p3, p4] | p1 <- ps', p2 <- ps', p3 <- ps', p4 <- ps', snd p1 < snd p2, snd p2 < snd p3, snd p3 < snd p4]
    let rc  =  ps' \\ sq
    if (isSquare (map snd sq) && isRectangle (map snd rc))
        then return (map fst sq, map fst rc)
        else fail ""

print :: Maybe ([Int], [Int]) -> IO ()
print Nothing  =  putStrLn "NO"
print (Just (as, bs))  =  putStrLn "YES" >> prints as >> prints bs
  where
    prints xs  =  putStrLn $ intercalate " " (map show xs)

main :: IO ()
main  =  do
    ps  <-  liftM (take n . map parsePoint . lines) getContents
    print $ solve ps

import Control.Monad (liftM, when)
import Data.List ((\\), intercalate, nub, sort)
import Data.Maybe (listToMaybe)
import Prelude hiding (print)

type Point  =  (Int, Int)

n :: Int
n  =  8

parsePoint :: String -> Point
parsePoint s  =  case map read (words s) of
    [x, y]  ->  (x, y)

getSDists :: [Point] -> [Int]
getSDists ps  =  [sDist p1 p2 | p1 <- ps, p2 <- ps, p1 < p2]
  where
    sDist (x1, y1) (x2, y2)  =  sum $ map (^2) $ zipWith (-) [x1, y1] [x2, y2]

sortAndNub :: [Point] -> [Int]
sortAndNub  =  sort . nub . getSDists

isFigure :: [Point] -> ([Int] -> Bool) -> Bool
isFigure ps check  =  check $ sortAndNub ps

isRectangle, isSquare :: [Point] -> Bool
isRectangle ps  =  isFigure ps (\ds -> head ds > 0 && length ds <= 3)
isSquare    ps  =  isFigure ps (\ds -> head ds > 0 && length ds == 2)

solve :: [Point] -> Maybe ([Int], [Int])
solve ps  =  listToMaybe $ do
    let ps'  =  zip [1..] ps
    sq  <-  [[p1, p2, p3, p4] | p1 <- ps', p2 <- ps', p3 <- ps', p4 <- ps', snd p1 < snd p2, snd p2 < snd p3, snd p3 < snd p4]
    let rc  =  ps' \\ sq
    if (isSquare (map snd sq) && isRectangle (map snd rc))
        then return (map fst sq, map fst rc)
        else fail ""

print :: Maybe ([Int], [Int]) -> IO ()
print Nothing  =  putStrLn "NO"
print (Just (as, bs))  =  putStrLn "YES" >> prints as >> prints bs
  where
    prints xs  =  putStrLn $ intercalate " " (map show xs)

main :: IO ()
main  =  do
    ps  <-  liftM (take n . map parsePoint . lines) getContents
    print $ solve ps

import Control.Monad (liftM, when)
import Data.List ((\\), intercalate, nub, sort)
import Data.Maybe (listToMaybe)
import Prelude hiding (print)

type Point  =  (Int, Int)

n :: Int
n  =  8

parsePoint :: String -> Point
parsePoint s  =  case map read (words s) of
    [x, y]  ->  (x, y)

getSDists :: [Point] -> [Int]
getSDists ps  =  [sDist p1 p2 | p1 <- ps, p2 <- ps, p1 < p2]
  where
    sDist (x1, y1) (x2, y2)  =  sum $ map (^2) $ zipWith (-) [x1, y1] [x2, y2]

isFigure :: [Point] -> ([Int] -> Bool) -> Bool
isFigure ps check  =  check $ sort $ getSDists ps

isRectangle, isSquare :: [Point] -> Bool
isRectangle ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d3 == d4 && d5 == d6
isSquare    ps  =  isFigure ps check
  where
    check [d1, d2, d3, d4, d5, d6]  =  d1 > 0 && d1 == d2 && d2 == d3 && d3 == d4 && d5 == d6

solve :: [Point] -> Maybe ([Int], [Int])
solve ps  =  listToMaybe $ do
    let ps'  =  zip [1..] ps
    sq  <-  [[p1, p2, p3, p4] | p1 <- ps', p2 <- ps', p3 <- ps', p4 <- ps', snd p1 < snd p2, snd p2 < snd p3, snd p3 < snd p4]
    let rc  =  ps' \\ sq
    if (isSquare (map snd sq) && isRectangle (map snd rc))
        then return (map fst sq, map fst rc)
        else fail ""

print :: Maybe ([Int], [Int]) -> IO ()
print Nothing  =  putStrLn "NO"
print (Just (as, bs))  =  putStrLn "YES" >> prints as >> prints bs
  where
    prints xs  =  putStrLn $ intercalate " " (map show xs)

main :: IO ()
main  =  do
    ps  <-  liftM (take n . map parsePoint . lines) getContents
    print $ solve ps

import List

type Point = (Int, Int)
type P4 = (Point, Point, Point, Point)
type P8 = (Point, Point, Point, Point, Point, Point, Point, Point)
type I4 = (Int, Int, Int, Int)

fromP4 :: P4 -> [Point]
fromP4 (p1, p2, p3, p4) = [p1, p2, p3, p4]

fromP8 :: P8 -> [Point]
fromP8 (p1, p2, p3, p4, p5, p6, p7, p8) = [p1, p2, p3, p4, p5, p6, p7, p8]

toP8 :: [Point] -> P8
toP8 [p1, p2, p3, p4, p5, p6, p7, p8] = (p1, p2, p3, p4, p5, p6, p7, p8)

fromI4 :: I4 -> [Int]
fromI4 (i1, i2, i3, i4) = [i1, i2, i3, i4]

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

distSquare :: (Point, Point) -> Int
distSquare ((x1, y1), (x2, y2)) = (x1 - x2)^2 + (y1 - y2)^2

getDistances :: P4 -> [Int]
getDistances p4 =
  map distSquare [(ps !! i, ps !! j) | i <- [0..3], j <- [0..3], i < j]
  where
    ps = fromP4 p4

checkSquare :: P4 -> Bool
checkSquare p4 =
  a1 > 0  &&  a1 == a4  &&  a5 == 2 * a1  &&  a5 == a6
  where
    [a1, a2, a3, a4, a5, a6] = sort (getDistances p4)

checkRectangle :: P4 -> Bool
checkRectangle p4 =
  a1 > 0  &&  a1 == a2  &&  a3 == a4  &&  a5 == a1 + a3  &&  a5 == a6
  where
    [a1, a2, a3, a4, a5, a6] = sort (getDistances p4)

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

next :: Maybe I4 -> Maybe I4
next  Nothing             =  Nothing
next (Just (4, 5, 6, 7))  =  Nothing
next (Just (a, 5, 6, 7))  =  Just (a + 1, a + 2, a + 3, a + 4)
next (Just (a, b, 6, 7))  =  Just (a, b + 1, b + 2, b + 3)
next (Just (a, b, c, 7))  =  Just (a, b, c + 1, c + 2)
next (Just (a, b, c, d))  =  Just (a, b, c, d + 1)

firstSelection :: I4
firstSelection = (0, 1, 2, 3)

generateSelections :: [Maybe I4]
generateSelections = takeWhile (/= Nothing) (iterate next (Just firstSelection))

otherElements :: I4 -> I4
otherElements i4 = (j1, j2, j3, j4)
  where
    [j1, j2, j3, j4] = filter (\x -> not (elem x (fromI4 i4))) [0..7]

checkSelection :: P8 -> Maybe I4 -> Bool
checkSelection p8 (Just is) =
    checkSquare (ps !! i1, ps !! i2, ps !! i3, ps !! i4)
    &&
    checkRectangle (ps !! j1, ps !! j2, ps !! j3, ps !! j4)
  where
    ps = fromP8 p8
    (i1, i2, i3, i4) = is
    (j1, j2, j3, j4) = otherElements is

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

solve :: P8 -> Maybe I4
solve ps
  |  null solution  =  Nothing
  |  otherwise      =  head solution
  where
    solution = filter (checkSelection ps) generateSelections

printAns :: Maybe I4 -> IO ()
printAns Nothing   = putStrLn "NO"
printAns (Just i4) = do
    putStrLn "YES"
    sequence_ (map (\x -> putStr (show (xs !! x + 1) ++ " ")) [0..3])
    putStrLn ""
    sequence_ (map (\x -> putStr (show (ys !! x + 1) ++ " ")) [0..3])
    putStrLn ""
  where
    xs = fromI4 i4
    ys = fromI4 (otherElements i4)

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

parsePoint :: String -> Point
parsePoint line = (x, y)
  where
    [x, y] = map read (words line)

readPoint :: IO Point
readPoint = do
    getLine >>= return . parsePoint

readPoints :: IO P8
readPoints = do
    ps <- sequence (map (\x -> readPoint) [1..8])
    return (toP8 ps)

main :: IO ()
main = readPoints >>= printAns . solve


ATMs of a well-known bank of a small country are arranged so that they can not give any amount of money requested by the user. Due to the limited size of the bill dispenser (the device that is directly giving money from an ATM) and some peculiarities of the ATM structure, you can get at most k bills from it, and the bills may be of at most two distinct denominations.For example, if a country uses bills with denominations 10, 50, 100, 500, 1000 and 5000 burles, then at k = 20 such ATM can give sums 100 000 burles and 96 000 burles, but it cannot give sums 99 000 and 101 000 burles.Let's suppose that the country uses bills of n distinct denominations, and the ATM that you are using has an unlimited number of bills of each type. You know that during the day you will need to withdraw a certain amount of cash q times. You know that when the ATM has multiple ways to give money, it chooses the one which requires the minimum number of bills, or displays an error message if it cannot be done. Determine the result of each of the q of requests for cash withdrawal.

The first line contains two integers n, k (1 ≤ n ≤ 5000, 1 ≤ k ≤ 20). The next line contains n space-separated integers ai (1 ≤ ai ≤ 107) — the denominations of the bills that are used in the country. Numbers ai follow in the strictly increasing order. The next line contains integer q (1 ≤ q ≤ 20) — the number of requests for cash withdrawal that you will make. The next q lines contain numbers xi (1 ≤ xi ≤ 2·108) — the sums of money in burles that you are going to withdraw from the ATM.

For each request for cash withdrawal print on a single line the minimum number of bills it can be done, or print  - 1, if it is impossible to get the corresponding sum.

import qualified Data.Map as M
main = interact $ unlines . map show . f . lines
f (nk:a:nq:q) = g k m la (map (\(x,y) -> x*y) l) (map read q)
  where m = foldl (\m' (x,y) -> M.insertWith' min (x*y) x m') (M.singleton 0 0) l
        l = concatMap (\x -> map (\y -> (x,y)) la) [1..k]
        la = map read $ words a
        k = read . last $ words nk
g k m a l = map (\x -> z . minimum $ zipWith (+) v (h $ map ((-)x) l))
  where v = h l
        h = map (t . flip M.lookup m)
        t Nothing = k+1
        t (Just x) = x
        z x | x > k = -1 | True = x


There are quite a lot of ways to have fun with inflatable balloons. For example, you can fill them with water and see what happens.Grigory and Andrew have the same opinion. So, once upon a time, they went to the shop and bought $$$n$$$ packets with inflatable balloons, where $$$i$$$-th of them has exactly $$$a_i$$$ balloons inside.They want to divide the balloons among themselves. In addition, there are several conditions to hold:  Do not rip the packets (both Grigory and Andrew should get unbroken packets);  Distribute all packets (every packet should be given to someone);  Give both Grigory and Andrew at least one packet;  To provide more fun, the total number of balloons in Grigory's packets should not be equal to the total number of balloons in Andrew's packets. Help them to divide the balloons or determine that it's impossible under these conditions.

The first line of input contains a single integer $$$n$$$ ($$$1 \le n \le 10$$$) — the number of packets with balloons. The second line contains $$$n$$$ integers: $$$a_1$$$, $$$a_2$$$, $$$\ldots$$$, $$$a_n$$$ ($$$1 \le a_i \le 1000$$$) — the number of balloons inside the corresponding packet.

If it's impossible to divide the balloons satisfying the conditions above, print $$$-1$$$. Otherwise, print an integer $$$k$$$ — the number of packets to give to Grigory followed by $$$k$$$ distinct integers from $$$1$$$ to $$$n$$$ — the indices of those. The order of packets doesn't matter. If there are multiple ways to divide balloons, output any of them.

NoteIn the first test Grigory gets $$$3$$$ balloons in total while Andrey gets $$$1$$$.In the second test there's only one way to divide the packets which leads to equal numbers of balloons.In the third test one of the boys won't get a packet at all.

main = do
	nn <- getLine
	let n = read nn :: Int
	aa <- getLine
	let a = map read $ words aa :: [Int]
	if n==1 || (n==2 && (a !! 0) == (a !! 1))
		then putStrLn "-1"
		else do
			if (a !! 0) == (sum $ tail a)
				then putStrLn "2\n1 2"
				else putStrLn "1\n1"


The Bad Luck Island is inhabited by three kinds of species: r rocks, s scissors and p papers. At some moments of time two random individuals meet (all pairs of individuals can meet equiprobably), and if they belong to different species, then one individual kills the other one: a rock kills scissors, scissors kill paper, and paper kills a rock. Your task is to determine for each species what is the probability that this species will be the only one to inhabit this island after a long enough period of time.

The single line contains three integers r, s and p (1 ≤ r, s, p ≤ 100) — the original number of individuals in the species of rock, scissors and paper, respectively.

Print three space-separated real numbers: the probabilities, at which the rocks, the scissors and the paper will be the only surviving species, respectively. The answer will be considered correct if the relative or absolute error of each number doesn't exceed 10 - 9.

{-# OPTIONS_GHC -O2 -optc-O2 -funbox-strict-fields #-}
module Main where
import qualified Data.ByteString.Char8 as B
import Data.Array
import Text.Printf

readInt = maybe undefined fst . B.readInt
readInts = fmap readInt . B.words

data RSP = R | S | P

solve r s p = (sum [tbl!(i, 0, 0) | i <- [1..r]], sum [tbl!(0, j, 0) | j <- [1..s]], sum [tbl!(0, 0, k) | k <- [1..p]])
  where
    bnd = ((0, 0, 0), (r + 1, s + 1, p + 1))
    tbl = listArray bnd $ map go $ range bnd :: Array (Int, Int, Int) Double
    prob t cr cs cp
      | n == 0 = 0
      | otherwise = tbl!(cr, cs, cp) * case t of
          R -> fromIntegral (cr * cp) / n
          S -> fromIntegral (cs * cr) / n
          P -> fromIntegral (cs * cp) / n
      where n = fromIntegral $ cr * cs + cs * cp + cp * cr

    go (cr, cs, cp)
      | cr > r || cs > s || cp > p = 0
      | cr == r && cs == s && cp == p = 1
      | otherwise = prob R (cr + 1) cs cp + prob S cr (cs + 1) cp + prob P cr cs (cp + 1)

main = do
  [r, s, p] <- fmap readInts B.getLine
  let (a, b, c) = solve r s p
  printf "%.11f %.11f %.11f" a b c


Vasya is pressing the keys on the keyboard reluctantly, squeezing out his ideas on the classical epos depicted in Homer's Odysseus... How can he explain to his literature teacher that he isn't going to become a writer? In fact, he is going to become a programmer. So, he would take great pleasure in writing a program, but none — in writing a composition.As Vasya was fishing for a sentence in the dark pond of his imagination, he suddenly wondered: what is the least number of times he should push a key to shift the cursor from one position to another one?Let's describe his question more formally: to type a text, Vasya is using the text editor. He has already written n lines, the i-th line contains ai characters (including spaces). If some line contains k characters, then this line overall contains (k + 1) positions where the cursor can stand: before some character or after all characters (at the end of the line). Thus, the cursor's position is determined by a pair of integers (r, c), where r is the number of the line and c is the cursor's position in the line (the positions are indexed starting from one from the beginning of the line).Vasya doesn't use the mouse to move the cursor. He uses keys "Up", "Down", "Right" and "Left". When he pushes each of these keys, the cursor shifts in the needed direction. Let's assume that before the corresponding key is pressed, the cursor was located in the position (r, c), then Vasya pushed key: "Up": if the cursor was located in the first line (r = 1), then it does not move. Otherwise, it moves to the previous line (with number r - 1), to the same position. At that, if the previous line was short, that is, the cursor couldn't occupy position c there, the cursor moves to the last position of the line with number r - 1; "Down": if the cursor was located in the last line (r = n), then it does not move. Otherwise, it moves to the next line (with number r + 1), to the same position. At that, if the next line was short, that is, the cursor couldn't occupy position c there, the cursor moves to the last position of the line with number r + 1; "Right": if the cursor can move to the right in this line (c < ar + 1), then it moves to the right (to position c + 1). Otherwise, it is located at the end of the line and doesn't move anywhere when Vasya presses the "Right" key; "Left": if the cursor can move to the left in this line (c > 1), then it moves to the left (to position c - 1). Otherwise, it is located at the beginning of the line and doesn't move anywhere when Vasya presses the "Left" key.You've got the number of lines in the text file and the number of characters, written in each line of this file. Find the least number of times Vasya should push the keys, described above, to shift the cursor from position (r1, c1) to position (r2, c2).

The first line of the input contains an integer n (1 ≤ n ≤ 100) — the number of lines in the file. The second line contains n integers a1, a2, ..., an (0 ≤ ai ≤ 105), separated by single spaces. The third line contains four integers r1, c1, r2, c2 (1 ≤ r1, r2 ≤ n, 1 ≤ c1 ≤ ar1 + 1, 1 ≤ c2 ≤ ar2 + 1).

Print a single integer — the minimum number of times Vasya should push a key to move the cursor from position (r1, c1) to position (r2, c2).

NoteIn the first sample the editor contains four lines. Let's represent the cursor's possible positions in the line as numbers. Letter s represents the cursor's initial position, letter t represents the last one. Then all possible positions of the cursor in the text editor are described by the following table.12312123s5671t345One of the possible answers in the given sample is: "Left", "Down", "Left".

{-# OPTIONS_GHC -O2 -funbox-strict-fields #-}
{-# LANGUAGE BangPatterns #-}

import Control.Applicative
import Control.Monad
import System.IO
import Data.Array.Base
import Data.Array.IO (IOUArray)
import qualified Data.ByteString.Char8 as B
import Data.Maybe

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

data Pos = P !Int !Int

main = do
  hin  <- openFile "input.txt"  ReadMode
  hout <- openFile "output.txt" WriteMode

  n <- read <$> hGetLine hin :: IO Int
  arr <- listArray (0,n).(0:).map readInt.B.words <$> B.hGetLine hin :: IO (UArray Int Int)
  [r1,c1,r2,c2] <- map read.words <$> hGetLine hin

  memo <- newArray (0,(100+1)*100000) 1000000000 :: IO (IOUArray Int Int)

  let get (P r c) = unsafeRead memo (r*100000+c)
      put (P r c) val = unsafeWrite memo (r*100000+c) val

  let moveUp (P 1 c) = P 1 c
      moveUp (P r c) = P (r-1) $ min c $ unsafeAt arr (r-1) + 1
      moveDown (P r c)
        | r==n = P r c
        | otherwise = P (r+1) $ min c $ unsafeAt arr (r+1) + 1
      moveRight (P r c) = P r $ min (c+1) $ unsafeAt arr r + 1
      moveLeft (P r c) = P r $ max (c-1) 1
      neighbors (P r c) = map ($ (P r c)) [moveUp,moveDown,moveRight,moveLeft]

  let bfs queue = unless (isEmpty queue) $ do
        let (P r c,Q fs rs) = deq queue
        if r==r2 && c==c2
           then get (P r2 c2) >>= hPrint hout
           else do
             dv <- get (P r c)
             nexts <- fmap catMaybes.forM (neighbors (P r c)) $ \(P nr nc) -> do
               olddnv <- get (P nr nc)
               let !newdnv = dv + 1
               if newdnv < olddnv
                  then do
                    put (P nr nc) newdnv
                    return $ Just (P nr nc)
                  else return Nothing
             bfs $ Q fs (nexts++rs)

  put (P r1 c1) 0
  bfs $ Q [(P r1 c1)] []

  hClose hin
  hClose hout

data Queue = Q [Pos] [Pos]

isEmpty (Q [] []) = True
isEmpty _ = False

deq (Q (f:fs) rs) = (f,Q fs rs)
deq (Q _ rs) = deq (Q (reverse rs) [])

import Control.Applicative
import Control.Monad
import System.IO
import Data.Array.Base
import qualified Data.ByteString.Char8 as B

readInt :: B.ByteString -> Int
readInt bs = case B.readInt bs of Just (n,_) -> n

main = do

  hin  <- openFile "input.txt"  ReadMode
  hout <- openFile "output.txt" WriteMode

  n <- read <$> hGetLine hin :: IO Int

  arr <- listArray (0,n).(0:).map readInt.B.words <$> B.hGetLine hin
  [r1,c1,r2,c2] <- map read.words <$> hGetLine hin

  hPrint hout $ solve [r1,c1,r2,c2] n arr

  hClose hin
  hClose hout

solve :: [Int] -> Int -> UArray Int Int -> Int
solve [r1,c1,r2,c2] n arr = minimum $ map calc $ reverse upper ++ lower
   where
     moveUp (1,c) = (1,c)
     moveUp (r,c) = (r-1,min c $ unsafeAt arr (r-1) + 1)
     moveDown (r,c)
       | r==n = (r,c)
       | otherwise = (r+1,min c $ unsafeAt arr (r+1) + 1)
     (_:upper) = take r1.zip[0..] $ iterate moveUp (r1,c1)
     lower = take (n-r1+1).zip[0..] $ iterate moveDown (r1,c1)
     calc (cost,(r,c)) = cost + abs (r2-r) + abs (c2-c)


Even if you just leave them be, they will fall to pieces all by themselves. So, someone has to protect them, right?You find yourself playing with Teucer again in the city of Liyue. As you take the eccentric little kid around, you notice something interesting about the structure of the city.Liyue can be represented as a directed graph containing $$$n$$$ nodes. Nodes are labeled from $$$1$$$ to $$$n$$$. There is a directed edge from node $$$a$$$ to node $$$b$$$ if and only if $$$a < b$$$.A path between nodes $$$a$$$ and $$$b$$$ is defined as a sequence of edges such that you can start at $$$a$$$, travel along all of these edges in the corresponding direction, and end at $$$b$$$. The length of a path is defined by the number of edges. A rainbow path of length $$$x$$$ is defined as a path in the graph such that there exists at least 2 distinct colors among the set of $$$x$$$ edges.Teucer's favorite number is $$$k$$$. You are curious about the following scenario: If you were to label each edge with a color, what is the minimum number of colors needed to ensure that all paths of length $$$k$$$ or longer are rainbow paths?Teucer wants to surprise his older brother with a map of Liyue. He also wants to know a valid coloring of edges that uses the minimum number of colors. Please help him with this task!

The only line of input contains two integers $$$n$$$ and $$$k$$$ ($$$2 \leq k < n \leq 1000$$$).

On the first line, output $$$c$$$, the minimum colors you need to satisfy the above requirements. On the second line, print a valid edge coloring as an array of $$$\frac{n(n-1)}{2}$$$ integers ranging from $$$1$$$ to $$$c$$$. Exactly $$$c$$$ distinct colors should exist in the construction. Print the edges in increasing order by the start node first, then by the second node. For example, if $$$n=4$$$, the edge colors will correspond to this order of edges: ($$$1$$$, $$$2$$$), ($$$1$$$, $$$3$$$), ($$$1$$$, $$$4$$$), ($$$2$$$, $$$3$$$), ($$$2$$$, $$$4$$$), ($$$3$$$, $$$4$$$)

NoteThe corresponding construction for the first test case looks like this:    It is impossible to satisfy the constraints with less than $$$2$$$ colors.The corresponding construction for the second test case looks like this:    One can show there exists no construction using less than $$$3$$$ colors.

{-# LANGUAGE BangPatterns #-}
import qualified Data.ByteString.Lazy.Char8 as P
import Data.ByteString.Builder
import qualified Data.ByteString.Builder.Prim as Prim
import System.IO
import Control.Monad.Trans.State

import Data.List
import Control.Monad

splits :: Int -> (Int, Int) -> [(Int, Int)]
splits k (i, j) = let
  w = j - i
  (q, r) = divMod w k
  steps = replicate r (q + 1) ++ repeat q
  vals = take (k+1) $ scanl' (+) i steps
  in  zip vals (tail vals)

solve :: Int -> Int -> (Int, Int) -> [((Int, Int), Int)]
solve !k !v (i, j)
  | j - i < 2 = []
  | otherwise = let
      w = splits k (i, j)
      in  concatMap (solve k (v + 1)) w ++ do
      (x1, x2) <- w
      (y1, y2) <- w
      guard $ x1 < y1
      x <- [x1 + 1 .. x2]
      y <- [y1 + 1 .. y2]
      pure ((x, y), v)

mainFun :: SO
mainFun = do
  ~[n, k] <- getInts 2
  let
    ans = map snd $ sort $ solve k 1 (0, n)
  pure $ putInts [maximum ans] <> putInts ans

type SP = State [P.ByteString]
type SO = SP Builder

getNext :: Int -> SP [P.ByteString]
getNext = state . splitAt

getInts :: Int -> SP [Int]
getInts k = do
  vs <- getNext k
  pure [v | Just (v, _) <- map P.readInt vs]

putInts :: [Int] -> Builder
putInts vs = let
  sepPrim = (,) ' ' Prim.>$<
    Prim.liftFixedToBounded Prim.char7 Prim.>*< Prim.intDec
  in  case  vs  of
  [] -> char7 '\n'
  x : xs -> intDec x <> Prim.primMapListBounded sepPrim xs <> char7 '\n'

main :: IO ()
main = do
  hSetBuffering stdout NoBuffering
  inp <- P.getContents
  let  outp = evalState mainFun $ P.words inp
  P.putStr $ toLazyByteString outp