Last active
May 18, 2020 02:00
-
-
Save harfangk/ef87e47c82630b3e597f4a68afa9d538 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| import qualified Data.List as List | |
| import qualified Data.Map as Map | |
| import qualified Data.IntMap.Strict as IntMap | |
| import qualified Data.Sequence as Seq | |
| import qualified Data.Array as Array | |
| import qualified Data.Maybe as Maybe | |
| import qualified Control.Monad.ST as ST | |
| import qualified Control.Monad as CM | |
| import qualified Data.PQueue.Prio.Min as MinHeap | |
| main :: IO () | |
| main = do | |
| g1File <- readFile "./src/Course4/g3.txt" | |
| let g1Data@(g1Vc, _, _) = parseData g1File | |
| g1Result = bellmanFord (buildAdjacencyListByHead g1Data) g1Vc 1 | |
| print g1Result | |
| parseData :: String -> (Int, Int, [(Int, Int, Double)]) | |
| parseData s = | |
| (vertexCount, edgeCount, edges) | |
| where | |
| fileLines = lines s | |
| (vertexCount, edgeCount) = parseMetaData . head $ fileLines | |
| edges = List.map parseEdge . tail $ fileLines | |
| parseMetaData :: String -> (Int, Int) | |
| parseMetaData line = | |
| case List.map read . words $ line of | |
| [x,y] -> (x, y) | |
| _ -> error "Invalid data format" | |
| parseEdge :: String -> (Int, Int, Double) | |
| parseEdge line = | |
| case words line of | |
| (edgeTail:edgeHead:weight:_) -> (read edgeTail, read edgeHead, read weight) | |
| _ -> error "Invalid data format" | |
| buildAdjacencyListByHead :: (Fractional a, Ord a) => (Int, Int, [(Int, Int, a)]) -> IntMap.IntMap [(Int, a)] | |
| buildAdjacencyListByHead (vertexCount, _, edges) = | |
| List.foldl' (\acc (t, h, w) -> IntMap.update (\edges' -> Just ((t,w):edges')) h acc) initialMap $ edges | |
| where | |
| initialMap = IntMap.fromList (List.zip [1..vertexCount] (List.repeat [])) | |
| bellmanFord :: IntMap.IntMap [(Int, Double)] -> Int -> Int -> Either String (Array.Array Int Double) | |
| bellmanFord g vertexCount s = | |
| if hasNegativeCycle then | |
| Left "Bellman-Ford algorithm halted: negative cycle found" | |
| else | |
| Right resultArray | |
| where | |
| memo = Array.array ((0,1), (vertexCount - 1, vertexCount)) [generator (x,y) | x <- [0..(vertexCount - 1)], y <- [1..vertexCount]] | |
| generator pair@(i,v) = | |
| if i == 0 then | |
| if v == s then | |
| (pair, 0) | |
| else | |
| (pair, 1/0) | |
| else | |
| (pair, findMin pair) | |
| findMin (i,v) = min ({-# SCC accessMemo #-} (Array.!) memo (i-1,v)) ({-# SCC foldl' #-} List.foldl' (\acc (t,w) -> {-# SCC foldStep #-} min acc ((Array.!) memo (i-1,t) + w)) (1/0) ({-# SCC accessGraph #-} (IntMap.!) g v)) | |
| resultList = map (\((_,v), d) -> (v,d)) . filter (\((i,_), _) -> i == vertexCount - 1 ) . Array.assocs $ memo | |
| resultArray = Array.array (1, vertexCount) resultList | |
| hasNegativeCycle = any (\(v, d) -> any (\(t, w) -> d > resultArray Array.! t + w) (g IntMap.! v)) resultList |
Ailrun
commented
May 17, 2020
•
#include <fstream>
#include <iostream>
#include <tuple>
#include <unordered_map>
#include <vector>
using vertex = int;
using weight = double;
using edge = std::tuple<vertex, vertex, double>;
using edge_from = std::pair<vertex, double>;
using graph = std::unordered_map<vertex, std::vector<edge_from>>;
using result = std::vector<edge_from>;
void parse_graph(unsigned long &vc, unsigned long &ec, graph &g);
void parse_data(unsigned long &vc, unsigned long &ec, std::vector<edge> &es);
void convert_data(const std::vector<edge> &es, graph &g);
int bellman_ford(const vertex source,const graph &g, result &r);
void print_result(const result &r);
int main(void)
{
std::ios_base::sync_with_stdio(false);
graph g;
unsigned long vc, ec;
result r;
parse_graph(vc, ec, g);
auto error = bellman_ford(1, g, r);
if (error)
{
std::cout << "Left " << "\"Bellman-Ford algorithm halted: negative cycle found\"" << std::endl;
}
else
{
std::cout << "Right (array (1,1000) ";
print_result(r);
std::cout << ")" << std::endl;
}
return 0;
}
void parse_graph(unsigned long &vc, unsigned long &ec, graph &g)
{
std::vector<edge> es;
parse_data(vc, ec, es);
convert_data(es, g);
}
void parse_data(unsigned long &vc, unsigned long &ec, std::vector<edge> &es)
{
std::ifstream data_file("data.txt");
data_file >> vc >> ec;
es.reserve(ec);
for (auto i = 0ul; i < ec; i++)
{
edge e;
data_file >> std::get<0>(e) >> std::get<1>(e) >> std::get<2>(e);
es.push_back(e);
}
}
void convert_data(const std::vector<edge> &es, graph &g)
{
for (auto [f, t, e] : es)
{
g[t].push_back(edge_from(f, e));
}
}
int bellman_ford(const vertex s, const graph &g, result &r)
{
const auto vc = g.size();
r.resize(vc, edge_from(-1, std::numeric_limits<double>::infinity()));
std::get<0>(r[s - 1]) = s;
std::get<1>(r[s - 1]) = 0.0;
for (auto i = 1ul; i < vc; i++)
{
for (auto [t, efs] : g)
{
auto &rt = r[t - 1];
for (auto [f, w] : efs)
{
auto &rf = r[f - 1];
if (std::get<1>(rf) + w < std::get<1>(rt))
{
std::get<0>(rt) = f;
std::get<1>(rt) = std::get<1>(rf) + w;
}
}
}
}
for (auto [t, efs] : g)
{
for (auto [f, w] : efs)
{
if (std::get<1>(r[f - 1]) + w < std::get<1>(r[t - 1]))
{
return 1;
}
}
}
return 0;
}
void print_result(const result &r)
{
std::cout.setf(std::ios::fixed, std::ios::floatfield);
auto prev = std::cout.precision(1);
std::cout << "[";
auto s = r.size();
std::cout << "(" << 1 << "," << std::get<1>(r[0]) << ")";
for (auto i = 1ul; i < s; i ++)
{
std::cout << "," << "(" << i + 1 << ",";
std::cout << std::get<1>(r[i]);
std::cout << ")";
}
std::cout << "]";
std::cout.precision(prev);
std::cout.unsetf(std::ios::floatfield);
}
{-# LANGUAGE FlexibleContexts #-}
module Main where
-- import Debug.Trace
import Control.Monad
import Data.Array (Array)
import Data.Coerce
import Data.Maybe
import Data.Semigroup
import System.IO
import qualified Data.Array.IArray as IArray
import qualified Data.Array.ST.Safe as STArray
import qualified Data.ByteString.Char8 as BS
import qualified Data.IntMap.Strict as IntMap
import qualified Data.List as List
main :: IO ()
main = do
(g1Vc, _, g1Edges) <- parseData "./data.txt"
let g1 = buildAdjacencyListByHead g1Vc g1Edges
let g1Result = bellmanFord g1 g1Vc 1
print g1Result
parseData :: FilePath -> IO (Int, Int, [(Int, Int, Double)])
parseData fp = withFile fp ReadMode $ \h -> do
(vertexCount, edgeCount) <- getMetaData h
edges <- replicateM edgeCount (getEdge h)
pure (vertexCount, edgeCount, edges)
where
getMetaData h = parseMetaData <$> BS.hGetLine h
parseMetaData line = fromJust $ do
(x, line') <- BS.readInt line
(y, line'') <- BS.readInt (dropSpace line')
if BS.null (dropSpace line'')
then pure (x, y)
else error "Invalid data format"
getEdge h = parseEdge <$> BS.hGetLine h
parseEdge line = fromJust $ do
(edgeTail, line') <- BS.readInt line
(edgeHead, line'') <- BS.readInt (dropSpace line')
(weight, line''') <- BS.readInteger (dropSpace line'')
if BS.null (dropSpace line''')
then pure (edgeTail, edgeHead, fromInteger weight)
else error "Invalid data format"
dropSpace = BS.dropWhile (== ' ')
buildAdjacencyListByHead :: (Fractional a, Ord a) => Int -> [(Int, Int, a)] -> Array Int [(Int, a)]
buildAdjacencyListByHead vertexCount =
IArray.listArray (1, vertexCount)
. IntMap.elems
. List.foldl' (\acc (f, t, w) -> IntMap.adjust ((f, w) :) t acc) initialMap
where
initialMap = IntMap.fromAscList (List.zip [1 .. vertexCount] (List.repeat []))
bellmanFord :: Array Int [(Int, Double)] -> Int -> Int -> Either String (Array Int Double)
bellmanFord g vC s =
if hasNegativeCycle then
Left "Bellman-Ford algorithm halted: negative cycle found"
else
Right resultArray
where
calculated = STArray.runSTUArray $ do
array <- STArray.newArray (1, vC) (1 / 0)
STArray.writeArray array s 0
go array 1 1
where
go array stage v
| v > vC =
if stage < vC
then go array (stage + 1) 1
else pure array
| otherwise = do
forM_ (g IArray.! v) $ coreCmp array v
go array stage (v + 1)
coreCmp array v (f, w) = do
vW <- STArray.readArray array v
fW <- STArray.readArray array f
STArray.writeArray array v (min (fW + w) vW)
{-# INLINE coreCmp #-}
resultList = IArray.elems calculated
resultArray = IArray.listArray (1, vC) resultList
getResultOf = (resultArray IArray.!)
{-# INLINE getResultOf #-}
hasNegativeCycle =
coerce
. foldMap (\(t, efs) -> foldMap (\(f, w) -> coerce (getResultOf f + w < getResultOf t) :: Any) efs)
$ IArray.assocs g
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment