Source file contact_map.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
(**
* contact_map.ml
* openkappa
* Jérôme Feret & Ly Kim Quyen, project Antique, INRIA Paris
*
* Creation: 2017, the 23rd of June
* Last modification: Time-stamp: <Jul 05 2017>
*
* Compute strongly connected component in contact map
*
* Copyright 2010,2011,2012,2013,2014,2015,2016 Institut National de Recherche
* en Informatique et en Automatique.
* All rights reserved. This file is distributed
* under the terms of the GNU Library General Public License *)
type t = (Mods.IntSet.t * Mods.Int2Set.t) array array
let to_yojson a =
let intls_to_json a =
`List (Mods.IntSet.fold (fun b acc -> `Int b :: acc) a [])
in
let pairls_to_json a =
`List
(Mods.Int2Set.fold
(fun (b, c) acc -> `List [ `Int b; `Int c ] :: acc)
a [])
in
let array_to_json a =
`List
(Array.fold_left
(fun acc (a, b) -> `List [ intls_to_json a; pairls_to_json b ] :: acc)
[] a)
in
`List (Array.fold_left (fun acc t -> array_to_json t :: acc) [] a)
let of_yojson (a : Yojson.Basic.t) =
let intls_of_json a =
List.fold_left
(fun acc -> function
| `Int b -> Mods.IntSet.add b acc
| x -> raise (Yojson.Basic.Util.Type_error ("bla1", x)))
Mods.IntSet.empty a
in
let pairls_of_json a =
List.fold_left
(fun acc -> function
| `List [ `Int b; `Int c ] -> Mods.Int2Set.add (b, c) acc
| x -> raise (Yojson.Basic.Util.Type_error ("bla2", x)))
Mods.Int2Set.empty a
in
let array_of_json = function
| `List ls ->
(match ls with
| [ `List a; `List b ] -> intls_of_json a, pairls_of_json b
| _ -> raise Not_found)
| x -> raise (Yojson.Basic.Util.Type_error ("bla3", x))
in
match a with
| `List array1 ->
Tools.array_map_of_list
(function
| `List array2 -> Tools.array_map_of_list array_of_json array2
| x -> raise (Yojson.Basic.Util.Type_error ("bla4", x)))
array1
| x -> raise (Yojson.Basic.Util.Type_error ("Not a correct contact map", x))
let print_kappa ~noCounters sigs f c =
Format.fprintf f "@[<v>%a@]"
(Pp.array Pp.space (fun ag f intf ->
if (not (Signature.is_counter_agent sigs ag)) || noCounters then
Format.fprintf f "@[<hv 2>%%agent:@ %a(@[%a@])@]"
(Signature.print_agent sigs)
ag
(Pp.array Pp.space (fun s f (is, ls) ->
if Signature.site_is_counter sigs ag s && not noCounters then
Format.fprintf f "@[%a%a@]"
(Signature.print_site sigs ag)
s
(Signature.print_counter sigs ag)
s
else
Format.fprintf f "@[%a%t%t@]"
(Signature.print_site sigs ag)
s
(fun f ->
if not (Mods.IntSet.is_empty is) then
Format.fprintf f "{@[%a@]}"
(Pp.set Mods.IntSet.elements Pp.space
(Signature.print_internal_state sigs ag s))
is)
(fun f ->
if not (Mods.Int2Set.is_empty ls) then
Format.fprintf f "@,[@[%a@]]"
(Pp.set Mods.Int2Set.elements Pp.space
(fun f (ad, sd) ->
Format.fprintf f "%a.%a"
(Signature.print_site sigs ad)
sd
(Signature.print_agent sigs)
ad))
ls)))
intf))
c
let cut_at i s' l =
let rec aux_cut_at o = function
| [] -> None
| (((j, s), _) as h) :: t ->
if i = j then
if s >= s' then
None
else
Some (h :: o)
else
aux_cut_at (h :: o) t
in
aux_cut_at [] l
let get_cycles contact_map =
let rec dfs ((known, out) as acc) path i last_s =
if Mods.IntSet.mem i known then (
match cut_at i last_s path with
| None -> acc
| Some x -> known, x :: out
) else (
let known' = Mods.IntSet.add i known in
Tools.array_fold_lefti
(fun s acc (_, l) ->
if s = last_s then
acc
else
Mods.Int2Set.fold
(fun ((ty, s') as x) acc -> dfs acc (((i, s), x) :: path) ty s')
l acc)
(known', out) contact_map.(i)
)
in
let rec scan ((known, out) as acc) i =
if i < 0 then
out
else
scan
(if Mods.IntSet.mem i known then
acc
else
dfs acc [] i (-1))
(pred i)
in
scan (Mods.IntSet.empty, []) (Array.length contact_map - 1)
let print_cycles sigs form contact_map =
let o = get_cycles contact_map in
Pp.list Pp.space
(Pp.list Pp.empty (fun f ((ag, s), (ag', s')) ->
Format.fprintf f "%a.%a-%a."
(Signature.print_agent sigs)
ag
(Signature.print_site sigs ag)
s
(Signature.print_site sigs ag')
s'))
form o