05_graph.hsp

sample\algorithms\05_graph.hsp » Plain Format

;============================================================
;  アルゴリズム 21〜25: グラフ
;    21. Dijkstra (最短経路)
;    22. Bellman-Ford (負辺対応)
;    23. Floyd-Warshall (全点対最短路)
;    24. Union-Find + Kruskal (MST)
;    25. Topological Sort (Kahn)
;============================================================

#include "hsp3cl_net_64.as"

; ----- 21. Dijkstra (隣接行列版 O(V^2)) -----
#module
#deffunc dijkstra array _mat, int _n, int _src, array _dist, \
	local _i, local _u, local _min_d, local _INF, local _w, local _it
	_INF = 0x7FFFFFFF
	dim _dist, _n
	dim _done, _n
	repeat _n : _dist(cnt) = _INF : loop
	_dist(_src) = 0
	repeat _n
		_u = -1 : _min_d = _INF
		repeat _n
			_i = cnt
			if _done(_i) == 0 : if _dist(_i) < _min_d : _min_d = _dist(_i) : _u = _i
		loop
		if _u == -1 : break
		_done(_u) = 1
		repeat _n
			_i = cnt
			_w = _mat(_u * _n + _i)
			if _w > 0 : if _done(_i) == 0 : if _dist(_u) + _w < _dist(_i) : _dist(_i) = _dist(_u) + _w
		loop
	loop
	return
#global

; ----- 22. Bellman-Ford -----
#module
#deffunc bellman_ford array _u, array _v, array _w, int _m, int _n, int _src, array _dist, \
	local _i, local _j, local _INF
	_INF = 0x7FFFFFFF
	dim _dist, _n
	repeat _n : _dist(cnt) = _INF : loop
	_dist(_src) = 0
	repeat _n - 1
		repeat _m
			_j = cnt
			if _dist(_u(_j)) != _INF : if _dist(_u(_j)) + _w(_j) < _dist(_v(_j)) : _dist(_v(_j)) = _dist(_u(_j)) + _w(_j)
		loop
	loop
	return
#global

; ----- 23. Floyd-Warshall -----
#module
#deffunc floyd_warshall array _d, int _n, \
	local _k, local _i, local _j, local _INF, local _via
	_INF = 0x7FFFFFFF
	repeat _n
		_k = cnt
		repeat _n
			_i = cnt
			repeat _n
				_j = cnt
				if _d(_i * _n + _k) != _INF : if _d(_k * _n + _j) != _INF {
					_via = _d(_i * _n + _k) + _d(_k * _n + _j)
					if _via < _d(_i * _n + _j) : _d(_i * _n + _j) = _via
				}
			loop
		loop
	loop
	return
#global

; ----- 24. Union-Find + Kruskal -----
#module
#deffunc uf_init array _par, int _n, local _i
	dim _par, _n
	repeat _n : _par(cnt) = cnt : loop
	return

#defcfunc uf_find array _par, int _x, local _r, local _t, local _x2
	_r = _x
	repeat
		if _par(_r) == _r : break
		_r = _par(_r)
	loop
	_x2 = _x
	repeat
		if _par(_x2) == _r : break
		_t = _par(_x2) : _par(_x2) = _r : _x2 = _t
	loop
	return _r

#defcfunc uf_union array _par, int _x, int _y, local _a, local _b
	_a = uf_find(_par, _x) : _b = uf_find(_par, _y)
	if _a == _b : return 0
	_par(_a) = _b
	return 1

#deffunc kruskal array _w, array _u, array _v, int _m, int _n, var _total, var _picked, \
	local _i, local _j, local _idx, local _tmp, local _par_work
	dim _ord, _m
	repeat _m : _ord(cnt) = cnt : loop
	; selection sort by weight
	repeat _m - 1
		_i = cnt
		repeat _m - 1 - _i
			_j = _i + 1 + cnt
			if _w(_ord(_i)) > _w(_ord(_j)) : _tmp = _ord(_i) : _ord(_i) = _ord(_j) : _ord(_j) = _tmp
		loop
	loop
	uf_init _par_work, _n
	_total = 0
	_picked = 0
	repeat _m
		_idx = _ord(cnt)
		if uf_union(_par_work, _u(_idx), _v(_idx)) {
			_total += _w(_idx)
			_picked++
		}
	loop
	return
#global

; ----- 25. Topological Sort (Kahn 法) -----
#module
#deffunc topo_sort array _edges, int _m, int _n, array _order, var _ok, \
	local _i, local _front, local _rear, local _u, local _v, local _k
	dim _indeg, _n
	repeat _m
		_v = _edges(cnt * 2 + 1)
		_indeg(_v)++
	loop
	dim _order, _n
	dim _q, _n
	_front = 0 : _rear = 0
	repeat _n
		_i = cnt
		if _indeg(_i) == 0 : _q(_rear) = _i : _rear++
	loop
	_k = 0
	repeat
		if _front >= _rear : break
		_u = _q(_front) : _front++
		_order(_k) = _u : _k++
		repeat _m
			if _edges(cnt * 2) == _u {
				_v = _edges(cnt * 2 + 1)
				_indeg(_v)--
				if _indeg(_v) == 0 : _q(_rear) = _v : _rear++
			}
		loop
	loop
	_ok = (_k == _n)
	return
#global

; ===== デモ =====
	mes "=== Dijkstra ==="
	N = 4
	dim mat, N * N
	mat(0) = 0 : mat(1) = 5 : mat(2) = 0 : mat(3) = 1
	mat(4) = 0 : mat(5) = 0 : mat(6) = 2 : mat(7) = 0
	mat(8) = 0 : mat(9) = 0 : mat(10)= 0 : mat(11)= 0
	mat(12)= 0 : mat(13)= 0 : mat(14)= 3 : mat(15)= 0
	dijkstra mat, N, 0, dist
	repeat N : mes strf("dist[%d] = %d", cnt, dist(cnt)) : loop

	mes ""
	mes "=== Bellman-Ford (含負辺) ==="
	dim bu, 4 : bu = 0, 0, 1, 2
	dim bv, 4 : bv = 1, 2, 2, 3
	dim bw, 4 : bw = 4, 5, -3, 4
	bellman_ford bu, bv, bw, 4, 4, 0, bdist
	repeat 4 : mes strf("bdist[%d] = %d", cnt, bdist(cnt)) : loop

	mes ""
	mes "=== Floyd-Warshall ==="
	INF = 0x7FFFFFFF
	M = 3
	dim fm, M * M
	fm(0) = 0   : fm(1) = 3   : fm(2) = INF
	fm(3) = INF : fm(4) = 0   : fm(5) = 1
	fm(6) = 7   : fm(7) = INF : fm(8) = 0
	floyd_warshall fm, M
	repeat M
		mes strf("[%d]: %d %d %d", cnt, fm(cnt * 3), fm(cnt * 3 + 1), fm(cnt * 3 + 2))
	loop

	mes ""
	mes "=== Kruskal MST ==="
	KM = 5 : KN = 4
	dim kw, KM : kw = 1, 3, 4, 2, 5
	dim ku, KM : ku = 0, 0, 1, 2, 2
	dim kv, KM : kv = 1, 2, 2, 3, 1
	kruskal kw, ku, kv, KM, KN, total, picked
	mes strf("MST total = %d (picked %d edges)", total, picked)

	mes ""
	mes "=== Topological Sort ==="
	; 0->1, 0->2, 1->3, 2->3
	dim tedges, 8 : tedges = 0,1, 0,2, 1,3, 2,3
	topo_sort tedges, 4, 4, order, tok
	sdim tline, 64
	tline = "topo order: "
	repeat 4 : tline += "" + order(cnt) + " " : loop
	tline += "(ok=" + tok + ")"
	mes tline
	end 0