Skip to content

Commit 8604837

Browse files
committed
Finish proof that connected components in u/d graphs are unique
Some additional lemmas along the way, and a lemma using uniqueness.
1 parent 5895b10 commit 8604837

File tree

1 file changed

+120
-30
lines changed

1 file changed

+120
-30
lines changed

examples/generic_graphs/fsgraphScript.sml

Lines changed: 120 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -1250,15 +1250,40 @@ Proof
12501250
metis_tac[]
12511251
QED
12521252

1253-
(*
1253+
Theorem connected_components_disconnected:
1254+
cc1 ∈ connected_components g ∧ cc2 ∈ connected_components g ∧ cc1 ≠ cc2 ∧
1255+
m ∈ nodes cc1 ∧ n ∈ nodes cc2 ⇒
1256+
¬reachable g m n
1257+
Proof
1258+
rpt strip_tac >>
1259+
‘m ∈ nodes g ∧ n ∈ nodes g’ by metis_tac[connected_component_nodes_SUBSET] >>
1260+
‘m ∈ nodes (component_of g m) ∧ n ∈ nodes (component_of g n)’
1261+
by simp[] >>
1262+
‘cc1 = component_of g m ∧ cc2 = component_of g n’
1263+
by metis_tac[every_node_has_unique_connected_component,
1264+
component_of_IN_connected_components] >> gvs[] >>
1265+
metis_tac[reachable_equal_components]
1266+
QED
1267+
1268+
Theorem connected_components_EQ_EMPTY[simp]:
1269+
connected_components g = ∅ ⇔ g = emptyG
1270+
Proof
1271+
simp[connected_components_def]
1272+
QED
1273+
1274+
Theorem connected_components_EMPTY[simp]:
1275+
connected_components emptyG = ∅
1276+
Proof
1277+
simp[connected_components_def]
1278+
QED
1279+
12541280
Theorem connected_components_unique:
12551281
FINITE A ∧ pairwise (λg1 g2. g1 ≠ g2 ⇒ DISJOINT(nodes g1) (nodes g2)) A ∧
12561282
(∀cc. cc ∈ A ⇒ connected cc ∧ cc ≠ emptyG) ∧ ITSET gUNION A emptyG = g ⇒
12571283
connected_components g = A
12581284
Proof
1259-
CCONTR_TAC >> gvs[] >> qabbrev_tac ‘g = ITSET gUNION A emptyG’ >>
1260-
‘∃cc. cc ∈ A ∧ cc ∉ connected_components g ∨
1261-
cc ∉ A ∧ cc ∈ connected_components g’ by metis_tac[EXTENSION]
1285+
rw[] >> qabbrev_tac ‘g = ITSET gUNION A emptyG’ >>
1286+
simp[EXTENSION, EQ_IMP_THM] >> qx_gen_tac ‘cc’ >> reverse $ rpt strip_tac
12621287
>- (‘∃n. n ∈ nodes cc’
12631288
by (CCONTR_TAC >> gvs[] >>
12641289
‘nodes cc = {}’ by simp[EXTENSION, Excl "nodes_EQ_EMPTY"] >>
@@ -1268,15 +1293,10 @@ Proof
12681293
‘∀e. e ∈ fsgedges cc ⇒ e ∈ fsgedges g’
12691294
by (simp[Abbr‘g’, fsgedges_ITSET_gUNION, PULL_EXISTS] >> metis_tac[]) >>
12701295
‘n ∈ nodes g’ by simp[] >>
1271-
‘∃cc1. cc1 ∈ connected_components g ∧ n ∈ nodes cc1’
1272-
by metis_tac[every_node_has_a_connected_component] >>
1273-
‘cc1 = component_of g n’
1274-
by (qpat_x_assum ‘cc1 ∈ connected_components g’ mp_tac >>
1275-
simp[connected_components_def, PULL_EXISTS,
1276-
component_of_EQUAL] >> rw[] >> gvs[] >>
1277-
metis_tac[reachable_SYM]) >>
1278-
‘cc1 ≠ cc’ by (strip_tac >> gvs[]) >>
1279-
gvs[] >> qpat_x_assum ‘component_of g n ≠ cc’ mp_tac >>
1296+
‘component_of g n ∈ connected_components g ∧ n ∈ nodes (component_of g n)’
1297+
by simp[connected_components_def, PULL_EXISTS,
1298+
component_of_EQUAL] >>
1299+
‘component_of g n = cc’ suffices_by metis_tac[] >>
12801300
simp[fsgraph_component_equality, EXTENSION] >> conj_asm1_tac >> rw[] >~
12811301
[‘reachable g m n ∧ m ∈ nodes g ⇔ m ∈ nodes cc’]
12821302
>- (reverse $ iff_tac
@@ -1323,25 +1343,95 @@ Proof
13231343
simp[Abbr‘g’, nodes_ITSET_gUNION, PULL_EXISTS] >> rpt strip_tac >>
13241344
first_assum $ irule_at (Pat ‘_ ∈ A’) >> rw[] >>
13251345
dxrule_all (iffLR pairwise_def) >> simp[] >> metis_tac[IN_DISJOINT]) >>
1326-
qpat_x_assum ‘cc ∉ A’ mp_tac >>
13271346
‘cc = cc1’ suffices_by simp[] >>
13281347
simp[fsgraph_component_equality] >>
1329-
‘nodes cc = nodes cc1’
1330-
by (irule SUBSET_ANTISYM >>
1331-
‘nodes cc1 ⊆ nodes cc’
1332-
by (simp[SUBSET_DEF] >> qx_gen_tac ‘m’ >> strip_tac >>
1333-
‘connected cc1’ by simp[] >>
1334-
pop_assum mp_tac >> simp[connected_def, NoAsms] >>
1335-
Cases_on ‘m = n ’ >> simp[] >> strip_tac >>
1336-
‘reachable cc1 m n’ by metis_tac[RTC_CASES_TC] >>
1337-
‘cc = component_of g n’
1338-
1339-
*)
1340-
1341-
1342-
1343-
1344-
1348+
‘n ∈ nodes (component_of g n)’ by simp[] >>
1349+
‘cc = component_of g n’
1350+
by metis_tac[every_node_has_unique_connected_component,
1351+
component_of_IN_connected_components] >>
1352+
gvs[nodes_component_of, fsgedges_component_of] >> conj_asm1_tac >~
1353+
[‘_ = nodes cc1’]
1354+
>- (simp[EXTENSION, EQ_IMP_THM] >> qx_gen_tac ‘m’ >> rpt strip_tac >~
1355+
[‘m ∈ nodes cc1 (* a *)’, ‘reachable g n m (* g *)’]
1356+
>- (‘connected cc1’ by simp[] >>
1357+
pop_assum mp_tac >> simp[connected_def, NoAsms] >>
1358+
Cases_on ‘m = n ’ >> simp[] >> strip_tac >>
1359+
‘reachable cc1 m n’ by metis_tac[RTC_CASES_TC] >>
1360+
simp[Abbr‘g’, nodes_ITSET_gUNION, PULL_EXISTS] >>
1361+
‘∀m n. adjacent cc1 m n ⇒ adjacent (ITSET gUNION A emptyG) m n’
1362+
suffices_by metis_tac[RTC_MONOTONE, reachable_SYM] >>
1363+
simp[PULL_EXISTS, adjacent_fsg, fsgedges_ITSET_gUNION] >>
1364+
metis_tac[]) >>
1365+
CCONTR_TAC >>
1366+
‘reachable g m n’ by simp[reachable_SYM] >>
1367+
drule_all_then strip_assume_tac reachable_passing_over_boundary >>
1368+
qpat_x_assum ‘_ ∈ fsgedges g’ mp_tac >>
1369+
simp[Abbr‘g’, fsgedges_ITSET_gUNION, PULL_FORALL] >>
1370+
qx_gen_tac ‘eset’ >> rename [‘{m0;n0} ∈ _’] >>
1371+
Cases_on ‘{m0;n0} ∈ eset’ >> simp[] >>
1372+
rpt strip_tac >> gvs[] >> rename [‘{m0;n0} ∈ fsgedges cc2’] >>
1373+
‘m0 ∈ nodes cc2 ∧ n0 ∈ nodes cc2’
1374+
by metis_tac[alledges_valid, INSERT2_lemma] >>
1375+
‘cc1 ≠ cc2’ by metis_tac[] >>
1376+
dxrule_all (iffLR pairwise_def) >> simp[] >>
1377+
metis_tac[IN_DISJOINT]) >>
1378+
pop_assum mp_tac >> ONCE_REWRITE_TAC [EXTENSION] >> simp[] >>
1379+
strip_tac >> qx_gen_tac ‘e’ >> iff_tac >> strip_tac >> gvs[] >~
1380+
[‘{a;b} ∈ fsgedges g’, ‘Abbrev(g = _)’]
1381+
>- (CCONTR_TAC >> qpat_x_assum ‘{a;b} ∈ fsgedges _’ mp_tac >>
1382+
simp[Abbr‘g’, fsgedges_ITSET_gUNION] >>
1383+
qx_gen_tac ‘B’ >> Cases_on ‘{a;b} ∈ B’ >> simp[] >>
1384+
rpt strip_tac >> gvs[] >> rename [‘{a;b} ∈ fsgedges cc2 (* a *)’] >>
1385+
‘a ∈ nodes cc2 ∧ b ∈ nodes cc2’
1386+
by metis_tac[alledges_valid, INSERT2_lemma] >>
1387+
dxrule_all (iffLR pairwise_def) >> simp[] >>
1388+
metis_tac[IN_DISJOINT]) >>
1389+
drule_then strip_assume_tac alledges_valid>> simp[] >>
1390+
irule_at Any EQ_REFL >> gvs[] >>
1391+
simp [Abbr‘g’, fsgedges_ITSET_gUNION] >> metis_tac[]
1392+
QED
1393+
1394+
Theorem connected_components_EQ_SING[simp]:
1395+
connected_components g1 = {g2} ⇔ g1 = g2 ∧ connected g2 ∧ g2 ≠ emptyG
1396+
Proof
1397+
iff_tac >> strip_tac >~
1398+
[‘connected_components g1 = {g2} (* a *)’]
1399+
>- (assume_tac (gUNION_connected_components |> Q.INST[‘g’ |-> ‘g1’]) >>
1400+
gvs[gUNION_LCOMM, COMMUTING_ITSET_RECURSES] >>
1401+
rpt strip_tac >~
1402+
[‘connected _’]
1403+
>- metis_tac[connected_components_are_connected, IN_INSERT] >>
1404+
gvs[]) >>
1405+
irule connected_components_unique >> gvs[pairwise_def]
1406+
QED
1407+
1408+
Theorem connected_components_addNode:
1409+
n ∉ nodes g ⇒
1410+
connected_components (fsgAddNode n g) =
1411+
fsgAddNode n emptyG INSERT connected_components g
1412+
Proof
1413+
strip_tac >> irule connected_components_unique >>
1414+
simp[DISJ_IMP_THM, FORALL_AND_THM, COMMUTING_ITSET_RECURSES, gUNION_LCOMM,
1415+
pairwise_def] >> rw[] >> simp[] >~
1416+
[‘connected cc’, ‘cc ∈ connected_components g’]
1417+
>- metis_tac[connected_components_are_connected] >~
1418+
[‘connected (fsgAddNode n emptyG)’]
1419+
>- simp[connected_def] >~
1420+
[‘cc ∈ connected_components g’, ‘cc ≠ emptyG’]
1421+
>- metis_tac[connected_components_nonempty] >~
1422+
[‘gUNION (fsgAddNode n emptyG) _ = _ ’]
1423+
>- (dep_rewrite.DEP_REWRITE_TAC[DELETE_NON_ELEMENT_RWT] >>
1424+
simp[gUNION_connected_components] >> strip_tac >~
1425+
[‘fsgAddNode n emptyG ∉ connected_components g’]
1426+
>- (strip_tac >> drule connected_component_nodes_SUBSET >>
1427+
simp[]) >>
1428+
simp[gUNION_def, fsgraph_component_equality] >>
1429+
SET_TAC[]) >>~-
1430+
([‘g1 ∈ connected_components g’, ‘n ∉ nodes g1’],
1431+
metis_tac[connected_component_nodes_SUBSET]) >>
1432+
simp[IN_DISJOINT] >> CCONTR_TAC >> gvs[] >>
1433+
drule_all connected_components_disconnected >> simp[]
1434+
QED
13451435

13461436
(* ----------------------------------------------------------------------
13471437
r-partite graphs and (in particular) bipartite graphs [2, p.17]

0 commit comments

Comments
 (0)