```section ‹Invariants for Tarjan's Algorithm›
imports
"../DFS_Framework"
"../Invars/DFS_Invars_SCC"
begin

context param_DFS_defs begin

definition
"lowlink_path s v p w ≡ path E v p w ∧ p ≠ []
∧ (last p, w) ∈ cross_edges s ∪ back_edges s
∧ (length p > 1 ⟶
p!1 ∈ dom (finished s)
∧ (∀k < length p - 1. (p!k, p!Suc k) ∈ tree_edges s))"

definition
"lowlink_set s v ≡ {w ∈ dom (discovered s).
v = w
∨ (v,w) ∈ E⇧+ ∧ (w,v) ∈ E⇧+
∧ (∃p. lowlink_path s v p w)}"

context begin interpretation timing_syntax .
end

end

context DFS_invar begin

assumes "lowlink_path s v p w"
and "w ∈ dom (discovered s)"
and "(v,w) ∈ E⇧*" "(w,v) ∈ E⇧*"
shows "w ∈ lowlink_set s v"
proof (cases "v = w")
next
case False with assms have "(v,w) ∈ E⇧+" "(w,v) ∈ E⇧+" by (metis rtrancl_eq_or_trancl)+
qed

"lowlink_set s v ⊆ dom (discovered s)"
by blast

by (metis finite_subset)

assumes "v ∈ dom (discovered s)"
shows "lowlink_set s v ≠ {}"
using assms by auto

assumes "(v,w) ∈ cross_edges s ∪ back_edges s"
shows "lowlink_path s v [v] w"
using assms cross_edges_ssE back_edges_ssE

assumes "lowlink_path s v (x#xs) w"
and "xs ≠ []"
shows "∃u. lowlink_path s u xs w"
proof -
from assms have path: "path E v (x#xs) w"
and cb: "(last xs, w) ∈ cross_edges s ∪ back_edges s"
and f: "(x#xs)!1 ∈ dom (finished s)"
and t: "(∀k < length xs. ((x#xs)!k, (x#xs)!Suc k) ∈ tree_edges s)"
by auto

from path obtain u where "path E u xs w" by (auto simp add: path_simps)
moreover note cb ‹xs ≠ []›
moreover { fix k define k' where "k' = Suc k"
assume "k < length xs - 1"
with k'_def have "k' < length xs" by simp
with t have "((x#xs)!k', (x#xs)!Suc k') ∈ tree_edges s" by simp
hence "(xs!k,xs!Suc k) ∈ tree_edges s" by (simp add: k'_def nth_Cons')
} note t' = this
moreover {
assume *: "length xs > 1"
from f have "xs!0 ∈ dom (finished s)" by auto
moreover from t'[of 0] * have "(xs!0,xs!1) ∈ tree_edges s" by simp
ultimately have "xs!1 ∈ dom (finished s)" using tree_edge_impl_parenthesis by metis
}

thus ?thesis ..
qed

assumes p: "lowlink_path s v p w"
and j: "j < length p"
and k: "k < j"
shows "(p!k, p!j) ∈ (tree_edges s)⇧+"
proof -
thus ?thesis using p j k
proof (induction arbitrary: v j k rule: list_nonempty_induct)
case single thus ?case by auto
next
case (cons x xs)
define j' where "j' = j - 1"
with cons have j'_le: "j' < length xs" and "k ≤ j'"  and j: "j = Suc j'" by auto

from cons lowlink_path_Cons obtain u where p: "lowlink_path s u xs w" by blast

show ?case
proof (cases "k=0")
case True
from cons have "⋀k. k < length (x#xs) - 1 ⟹ ((x#xs)!k,(x#xs)!Suc k) ∈ tree_edges s"
by auto
moreover from True cons have "k < length (x#xs) - 1" by auto
ultimately have *: "((x#xs)!k,(x#xs)!Suc k) ∈ tree_edges s" by metis

show ?thesis
proof (cases "j' = 0")
case True with * j ‹k=0› show ?thesis by simp
next
case False with True have "j' > k" by simp
with cons.IH[OF p j'_le] have "(xs!k, xs!j') ∈ (tree_edges s)⇧+" .
with j have "((x#xs)!Suc k, (x#xs)!j) ∈ (tree_edges s)⇧+" by simp
with * show ?thesis by (metis trancl_into_trancl2)
qed
next
case False
define k' where "k' = k - 1"
with False ‹k ≤ j'› have "k' < j'" and k: "k = Suc k'" by simp_all
with cons.IH[OF p j'_le] have "(xs!k', xs!j') ∈ (tree_edges s)⇧+" by metis
hence "((x#xs)!Suc k', (x#xs)!Suc j') ∈ (tree_edges s)⇧+" by simp
with k j show ?thesis by simp
qed
qed
qed

assumes p: "lowlink_path s v p w"
and j: "j < length p" "j > 0"
shows "p!j ∈ dom (finished s)"
proof -
from j have "length p > 1" by simp
with p have f: "p!1 ∈ dom (finished s)" by (simp add: lowlink_path_def)
thus ?thesis
proof (cases "j=1")
case False with j have "j > 1" by simp
with assms lowlink_path_in_tree[where k=1] have "(p!1,p!j) ∈ (tree_edges s)⇧+" by simp
with f tree_path_impl_parenthesis show ?thesis by simp
qed simp
qed

assumes p: "lowlink_path s v p w"
and tree_edges: "(u,v) ∈ (tree_edges s)⇧+"
and fin: "u ∈ dom (finished s) ∨ (stack s ≠ [] ∧ u = hd (stack s))"
shows "∃p. lowlink_path s u p w"
proof -

from tree_edges trancl_is_path obtain tp where
tp: "path (tree_edges s) u tp v" "tp ≠ []"
by metis

from tree_path_impl_parenthesis assms hd_stack_tree_path_finished have
v_fin: "v ∈ dom (finished s)" by blast

from p have "p!0 = hd p" by (simp add: hd_conv_nth)
with p have p_0: "p!0 = v" by (auto simp add: path_hd)

let ?p = "tp @ p"

{
from tp path_mono[OF tree_edges_ssE] have "path E u tp v" by simp
also from p have "path E v p w" by simp
finally have "path E u ?p w" .
}

moreover from p have "?p ≠ []" by simp

moreover
from p have "(last ?p, w) ∈ cross_edges s ∪ back_edges s" by simp

moreover {
assume "length ?p > 1"

have "?p ! 1 ∈ dom (finished s)"
proof (cases "length tp > 1")
case True hence tp1: "?p ! 1 = tp ! 1" by (simp add: nth_append)
from tp True have "(tp ! 0, tp ! 1) ∈ (tree_edges s)⇧+"
by (auto simp add: path_nth_conv nth_append elim: allE[where x=0])
also from True have "tp ! 0 = hd tp" by (simp add: hd_conv_nth)
also from tp have "hd tp = u" by (simp add: path_hd)
finally have "tp ! 1 ∈ dom (finished s)"
using tree_path_impl_parenthesis fin hd_stack_tree_path_finished by blast
thus ?thesis by (subst tp1)
next
case False with tp have "length tp = 1" by (cases tp) auto
with p_0 have "?p ! 1 = v" by (simp add: nth_append)
thus ?thesis by (simp add: v_fin)
qed

also have "∀k < length ?p - 1. (?p!k, ?p!Suc k) ∈ tree_edges s"
proof (safe)
fix k
assume A: "k < length ?p - 1"
show "(?p!k, ?p!Suc k) ∈ tree_edges s"
proof (cases "k < length tp")
case True hence k: "?p ! k = tp ! k" by (simp add: nth_append)
show ?thesis
proof (cases "Suc k < length tp")
case True hence "?p ! Suc k = tp ! Suc k" by (simp add: nth_append)
moreover from True tp have "(tp ! k, tp ! Suc k) ∈ tree_edges s"
by (auto simp add: path_nth_conv nth_append
elim: allE[where x=k])
ultimately show ?thesis using k by simp
next
case False with True have *: "Suc k = length tp" by simp
with tp True have "(tp ! k, v) ∈ tree_edges s"
by (auto simp add: path_nth_conv nth_append
elim: allE[where x=k])
also from * p_0 have "v = ?p ! Suc k" by (simp add: nth_append)
finally show ?thesis by (simp add: k)
qed
next
case False hence *: "Suc k - length tp = Suc (k - length tp)" by simp
define k' where "k' = k - length tp"
with False * have k': "?p ! k = p ! k'" "?p ! Suc k = p ! Suc k'"
from k'_def False A have "k' < length p - 1" by simp
with p have "(p!k', p!Suc k') ∈ tree_edges s" by simp (* p is lowlink_path *)
with k' show ?thesis by simp
qed
qed

also (conjI) note calculation
}

ultimately have "lowlink_path s u ?p w" by simp
thus ?thesis ..
qed

assumes "(u,v) ∈ (tree_edges s)⇧+"
and "u ∈ dom (finished s) ∨ (stack s ≠ [] ∧ u = hd (stack s))"
and "(v,w) ∈ cross_edges s ∪ back_edges s"
shows "∃p. lowlink_path s u p w"
proof -
with assms lowlink_path_tree_prepend show ?thesis by simp
qed

assumes "edges s `` {v} = {}"
shows "¬lowlink_path s v p w"
proof
assume p: "lowlink_path s v p w"

from p have "hd p = v" by (auto simp add: lowlink_path_def path_hd)
with hd_conv_nth[OF ‹p≠[]›] have v: "p!0 = v" by simp

show False
proof (cases "length p > 1")
case True with p have "(p!0,p!1) ∈ tree_edges s" by (simp add: lowlink_path_def)
with v assms show False by auto
next
case False with ‹p≠[]› have "length p = 1" by (cases p) auto
hence "last p = v" by (simp add: last_conv_nth v)
with assms show False by auto
qed
qed

context begin interpretation timing_syntax .

assumes "v ∈ dom (discovered s)"
shows "LowLink s v ≤ δ s v"
using assms
by clarsimp

assumes "LowLink s v < x"
and "v ∈ dom (discovered s)"
obtains w where "δ s w < x" "w ∈ lowlink_set s v"
proof -
let ?L = "δ s ` lowlink_set s v"

note assms
moreover from lowlink_set_finite have "finite ?L" by auto
moreover from lowlink_set_not_empty assms have "?L ≠ {}" by auto
ultimately show ?thesis using that by (auto simp: Min_less_iff)
qed

assumes "y ∈ lowlink_set s v"
and "δ s y < δ s v"
shows "LowLink s v < δ s v"
proof -
let ?L = "δ s ` lowlink_set s v"

from assms have "δ s y ∈ ?L" by simp
moreover hence "?L ≠ {}" by auto
moreover from lowlink_set_finite have "finite ?L" by auto
ultimately show ?thesis
by (metis Min_less_iff assms(2))
qed

assumes "DFS_invar G param s'"
assumes sub_m: "discovered s ⊆⇩m discovered s'"
and w_disc: "w ∈ dom (discovered s)"
and X: "⋀x. ⟦x ∈ X; x ∈ lowlink_set s' w⟧ ⟹ δ s' x ≥ LowLink s w"
proof (rule ccontr)
interpret s': DFS_invar where s=s' by fact

from lowlink_set_discovered sub sub_m w_disc have
sub': "δ s ` lowlink_set s w ⊆ δ s' ` lowlink_set s' w"
and  w_disc': "w ∈ dom (discovered s')"
and  eq: "⋀ll. ll ∈ lowlink_set s w ⟹ δ s' ll = δ s ll"
by (force simp: map_le_def)+

then obtain ll where ll: "ll ∈ lowlink_set s' w" and ll_le: "δ s' ll < LowLink s w"
with rev_sub have "ll ∈ lowlink_set s w ∨ ll ∈ X" by auto
hence "LowLink s w ≤ δ s' ll"
proof
assume "ll ∈ lowlink_set s w" with lowlink_set_finite eq show ?thesis by force
next
assume "ll ∈ X" with ll show ?thesis by (metis X)
qed
with ll_le show False by simp
qed

assumes "v ∈ dom (finished s) ∨ (stack s ≠ [] ∧ v = hd (stack s) ∧ pending s `` {v} = {})"
shows "LowLink s v = δ s v ⟷ scc_root s v (scc_of E v)"
proof
let ?scc = "scc_of E v"
assume scc: "scc_root s v ?scc"
show "LowLink s v = δ s v"
proof (rule ccontr)
assume A: "LowLink s v ≠ δ s v"

from assms finished_discovered stack_discovered hd_in_set have disc: "v ∈ dom (discovered s)" by blast
with assms LowLink_le_disc A have "LowLink s v < δ s v" by force
with disc obtain w where
w: "δ s w < δ s v" "w ∈ lowlink_set s v"
with lowlink_set_discovered have wdisc: "w ∈ dom (discovered s)" by auto

from w have "(v,w) ∈ E⇧*" "(w,v) ∈ E⇧*" by (auto simp add: lowlink_set_def)
moreover have "is_scc E ?scc" "v ∈ ?scc" by simp_all
ultimately have "w ∈ ?scc" by (metis is_scc_closed)
with wdisc scc_root_disc_le[OF scc] have "δ s v ≤ δ s w" by simp
with w show False by auto
qed
next
assume LL: "LowLink s v = δ s v"

from assms finished_discovered stack_discovered hd_in_set have
v_disc: "v ∈ dom (discovered s)" by blast

from assms finished_no_pending have
v_no_p: "pending s `` {v} = {}" by blast

let ?scc = "scc_of E v"
have is_scc: "is_scc E ?scc" by simp

{
fix r
assume "r ≠ v"
and "r ∈ ?scc" "r ∈ dom (discovered s)"

have "v ∈ ?scc" by simp
with ‹r ∈ ?scc› is_scc have "(v,r) ∈ (Restr E ?scc)⇧*"

hence "(v,r) ∈ (tree_edges s)⇧+" using ‹r≠v›
proof (induction rule: rtrancl_induct)
case (step y z) hence "(v,z) ∈ (Restr E ?scc)⇧*"
by (metis rtrancl_into_rtrancl)
hence "(v,z) ∈ E⇧*" by (metis Restr_rtrancl_mono)

from step have "(z,v) ∈ E⇧*" by (simp add: is_scc_connected[OF is_scc])

{
assume z_disc: "z ∈ dom (discovered s)"
and "∃p. lowlink_path s v p z"
with ‹(z,v)∈E⇧*› ‹(v,z)∈E⇧*› have ll: "z ∈ lowlink_set s v"
have "δ s v < δ s z"
proof (rule ccontr)
presume "δ s v ≥ δ s z" with ‹z≠v› v_disc z_disc disc_unequal have "δ s z < δ s v" by fastforce
with ll have "LowLink s v < δ s v" by (metis LowLink_lessI)
with LL show False by simp
qed simp
} note δz = this

show ?case
proof (cases "y=v")
case True note [simp] = this
with step v_no_p v_disc no_pending_imp_succ_discovered have
z_disc: "z ∈ dom (discovered s)" by blast

from step edges_covered v_no_p v_disc have "(v,z) ∈ edges s" by auto
thus ?thesis
proof (rule edgesE_CB)
assume "(v,z) ∈ tree_edges s" thus ?thesis ..
next
assume CB: "(v,z) ∈ cross_edges s ∪ back_edges s"
hence "lowlink_path s v [v] z"
with δz[OF z_disc] no_pending_succ_impl_path_in_tree v_disc v_no_p step show ?thesis
by auto
qed
next
case False with step.IH have T: "(v,y) ∈ (tree_edges s)⇧+" .
with tree_path_impl_parenthesis assms hd_stack_tree_path_finished tree_path_disc have
y_fin: "y ∈ dom (finished s)"
and y_δ : "δ s v < δ s y" by blast+
with step have z_disc: "z ∈ dom (discovered s)"
using finished_imp_succ_discovered
by auto

from step edges_covered finished_no_pending[of y] y_fin finished_discovered have
"(y,z) ∈ edges s"
by fast
thus ?thesis
proof (rule edgesE_CB)
assume "(y,z) ∈ tree_edges s" with T show ?thesis ..
next
assume CB: "(y,z) ∈ cross_edges s ∪ back_edges s"
"∃p. lowlink_path s v p z" by blast
with δz z_disc have δz: "δ s v < δ s z" by simp

show ?thesis
proof (cases "v ∈ dom (finished s)")
case True with tree_path_impl_parenthesis T have y_f: "φ s y < φ s v" by blast

from CB show ?thesis
proof
assume C: "(y,z) ∈ cross_edges s"
with cross_edges_finished_decr y_fin y_f have "φ s z < φ s v"
by force
moreover note δz
moreover from C cross_edges_target_finished have
"z ∈ dom (finished s)" by simp
ultimately show ?thesis
using parenthesis_impl_tree_path[OF True] by metis
next
assume B: "(y,z) ∈ back_edges s"
with back_edge_disc_lt_fin y_fin y_f have "δ s z < φ s v"
by force
moreover note δz z_disc
ultimately have "z ∈ dom (finished s)" "φ s z < φ s v"
using parenthesis_contained[OF True] by simp_all
with δz show ?thesis
using parenthesis_impl_tree_path[OF True] by metis
qed
next
case False ― ‹‹v ∉ dom (finished s)››
with assms have st: "stack s ≠ []" "v = hd (stack s)" "pending s `` {v} = {}" by blast+

have "z ∈ dom (finished s)"
proof (rule ccontr)
assume "z ∉ dom (finished s)"
with z_disc have "z ∈ set (stack s)" by (simp add: stack_set_def)
with ‹z≠v› st have "z ∈ set (tl (stack s))" by (cases "stack s") auto
with st tl_lt_stack_hd_discover δz show False by force
qed
with δz parenthesis_impl_tree_path_not_finished v_disc False show ?thesis by simp
qed
qed
qed
qed simp
hence "r ∈ (tree_edges s)⇧* `` {v}" by auto
}
hence "?scc ∩ dom (discovered s) ⊆ (tree_edges s)⇧* `` {v}"
by fastforce
thus "scc_root s v ?scc" by (auto intro!: scc_rootI v_disc)
qed
end end
end
```