gistfile1.hs

{-# LANGUAGE BangPatterns #-}
module Main where

import Data.Functor
import Data.Maybe
import Data.Vector ((//), (!))
import Control.Monad
import qualified Data.Vector as V

import Debug.Trace

type Vertex = Int
data Edge = Edge Vertex Vertex Int
type Dist = Maybe Int
type Vec = V.Vector Dist

readEdge :: String -> Edge
readEdge s = let [v1, v2, w] = map read $ words s
              in Edge v1 v2 w

fwStep :: Int -> Vec -> Int -> Vec
fwStep nvert prev k = V.generate (nvert * nvert) (fwBestCost nvert prev k)

fwBestCost :: Int -> Vec -> Int -> Int -> Dist
fwBestCost nvert prev k idx
    | isNothing k1 = vprev `seq` vprev
    | isNothing k2 = vprev `seq` vprev
    | isNothing vprev = ksum `seq` ksum
    | otherwise = vprev `seq` ksum `seq` liftM2 min vprev ksum
    where
    mkidx v1 v2 = v1 * nvert + v2
    vprev = prev ! idx
    (i, j) = quotRem idx nvert
    k1 = prev ! mkidx i k
    k2 = prev ! mkidx k j
    ksum = liftM2 (+) k1 k2

fwLoop :: Int -> Int -> Vec -> Vec
fwLoop nvert k vec | nvert == k = vec
fwLoop nvert k !vec = fwLoop nvert (k + 1) $ fwStep nvert vec k

cmpdist :: Dist -> Dist -> Ordering
cmpdist Nothing _ = GT
cmpdist _ Nothing = LT
cmpdist (Just v1) (Just v2) = compare v1 v2

main :: IO()
main = do
    header:body <- lines <$> getContents
    let nvert = read $ head $ words header
    let idx = \v1 v2 -> (v1 - 1) * nvert + v2 - 1
    let edges = map readEdge body
    let zeros = V.replicate (nvert * nvert) Nothing
    let base = zeros // map (\(Edge v1 v2 w) -> (idx v1 v2, Just w)) edges //
                        map (\n -> (idx n n, Just 0)) [1 .. nvert]

    let s1 = fwLoop nvert 0 base
    let check = any (< 0) $ map (\n -> fromJust (s1 ! idx n n)) [1 .. nvert]
    if check then print "Cycle"
             else print $ V.minimumBy cmpdist s1