1:- module(ifmap_demo, []). % [2013/07/28] 2:- use_module(pac('expand-pac')). 3:- use_pac(ifmap). 4:- use_pac(snippets). 5 6%:- expects_dialect(pac). 7term_expansion --> pac:expand_pac. 8:- use_module(pac(op)). 9 10 11% ?- ifmap:show_cla(cla([a,b],[1,2], [1-[a], 2-[b]])). 12%@ true. 13 14test_show_im :- 15 C1 = cla([1,3],[a], [a-[1,3]]), 16 C2 = cla([2,4], [b,c], [b-[2,4],c-[4]]), 17 FU = [a->b], 18 FD = [2->1, 4->3], 19 show_IM(C1, C2, FU, FD). 20 21show_IM(cla(A,B,C), cla(D,E,F), G, H):- 22 maplist(pred([X, X@[color = red]]), G, G0), 23 maplist(pred([X, X@[color = green]]), H, H0), 24 list_to_semicolon(G0, G1), 25 list_to_semicolon(H0, H1), 26 show_digraph( 27 subgraph(cluster_1, A;B;C); 28 subgraph(cluster_2, D;E;F); 29 G1; 30 H1 31 ). 32 33% 34list_to_semicolon([X], X). 35list_to_semicolon([X, Y|Z], X; Y0):- 36 list_to_semicolon([Y|Z], Y0). 37 38% ?- ifmap:build_adjoint(cla([1, 2, 3, 4, 5], [], [sweet-[3, 4], apple-[4], acid-[1, 2], orange-[2]]), cla([taro], [apple, orange, sweet, acid], [sweet-[taro]]), [apple-apple, orange-orange, sweet-sweet, acid-acid], [], _G2931, _G2932). 39 40test_ifmap(R):- classification_base(2, C2), 41 classification_base(3, C3), 42 C2 = cla(_, T, _), 43 maplist(pred([X, X-X]), T, TT), 44 extend_info_map(C3, C2, im(TT, []), R). 45 46test(R):- sample_theory(2, Theory), 47 theory_to_cla(Theory, Cla), 48 Cla= cla(_, Ts, _), 49 maplist(pred([X, X-X]), Ts, U), 50 classification_base(2, TargetCla), 51 extend_info_map(Cla, TargetCla, im(U,[]), R). 52 53% ?- ifmap:(sample_theory(1, Th), theory_to_cla_show(Th)). 54%@ Th = theory([ag, pa, ind, fs, eubd], [=>([], [ag, fs]), =>([ag, fs], []), =>([pa], [ag]), =>([ind], [ag]), =>([pa, ind], []), =>([eubd], [fs])]). 55% ?- trace, ifmap:(sample_theory(2, Th), theory_to_cla_show(Th)). 56 57theory_to_cla_show(Theory) :- once(theory_to_cla(Theory, Z)), once(show_cla(Z)). 58 59% 60tok(cla(X,_,_), X). 61typ(cla(_,X,_), X). 62sup(cla(_,_,X), X). 63 64% ?- ifmap: (sample_theory(1, A), theory_to_cla(A, B), build_info_map(B, B, X)). 65% ?- ifmap:test_preference(1, 1, R). 66% ?- ifmap:test_preference(2, 2, R). 67 68test_preference(I, J, R):- sample_theory(I, T_I), 69 classification_base(J, C_J), 70 theory_to_cla(T_I, C_I), 71 typ(C_I, P), 72 maplist(pred([X,X-X]), P, Id), 73% inverse_type_map(Id, C_I, C_J, R). 74 invertable_type_map(Id, C_I, C_J, R). 75 76% ERROR 77% ?- ifmap:(theory_to_cla(theory([a,b],[[a,b]=>[]]), R), cla_boolean_atoms(R, R0), show_cla(R0)). 78% ?- ifmap:(theory_to_cla(theory([a,b],[[a,b]=>[]]), R), cla_boolean_atoms(R, R0)). 79% ?- show_cla(cla([[1], [2], [3]], [[b, ~(a)], [~(b), a], [~(b), ~(a)]], [[~(b), a]-[2], [b, ~(a)]-[1], [~(b), ~(a)]-[3]])) . 80 81% 82print_cla(cla(X, Y, Z)):- nl, nl, 83 writeln(X), 84 writeln(Y), 85 writeln('*** support: '), 86 maplist(writeln, Z). 87 88% ãã´ãããªã®å ¥ã£ãã³ã¼ãã¼ã¨ãªã¬ã³ã¸ã¸ã¥ã¼ã¹ã®ã©ã¡ãã飲ã¿ããã§ããï¼ã 89% 90% http://www.rease.e.u-tokyo.ac.jp/read/jp/archive/essay/index.html 91% ãã´ãããªã®å ¥ã£ãã³ã¼ãã¼ã¨ãªã¬ã³ã¸ã¸ã¥ã¼ã¹ã®ã©ã¡ãã飲ã¿ããã§ããï¼ã 92% 表象ã·ã¹ãã (ï¼)ãï¼åå樹éºã»ä½è¤å´ï¼ 93 94% ?- ifmap:which_do_you_prefer([coffee, coffee_cockroach, orange_juice, orange_juice_cockroach]). 95 96%@ coffee: please. 97%@ coffee_cockroach: no thank you. 98%@ orange_juice: please. 99%@ orange_juice_cockroach: no thank you. 100 101which_do_you_prefer(Cla_names):- 102 sample_desire(0, Desire), 103 sample_theory(0, Theory), 104 maplist(pred([Desire, Theory], 105 ([Cla_name] :- 106 sample_observation(Cla_name, Observation), 107 once(representation_system(Observation, Desire, Theory, Im_O, Im_D)), 108%%% check logic !!! 109 ( is_function(Im_O),is_function(Im_D) 110 -> true 111 ; writeln("Does not form a representation system"), 112 fail 113 ), 114 ( is_preferred(Im_O, Im_D) 115 -> Message = 'please' 116 ; Message = 'no thank you' 117 ), 118 atomics_to_string([Cla_name, ':\t ', Message, '.'], M), 119 writeln(M) 120 )), 121 Cla_names). 122 123% which_do_you_prefer(Cla_names):- 124% sample_theory(theory0, Desire), 125% sample_theory(theory1, Theory), 126% maplist(pred([Desire, Theory], 127% ([Cla_name] :- 128% sample_observation(Cla_name, Observation), 129% once(representation_system(Observation, Desire, Theory, Im_O, Im_D)), 130% %%% check logic !!! 131% ( is_function(Im_O),is_function(Im_D) 132% -> true 133% ; writeln("Does not form a representation system"), 134% fail 135% ), 136% ( is_preferred(Im_O, Im_D) 137% -> Message = 'please' 138% ; Message = 'no thank you' 139% ), 140% atomics_to_string([Cla_name, ':\t ', Message, '.'], M), 141% writeln(M) 142% )), 143% Cla_names). 144 145%%%%%test 146% ?- ifmap: representation_system(cla([x],[],[]), theory([], []), theory([],[]), Im_O, Im_D). 147%@ Im_O = Im_D, Im_D = [p([], [])-p([], [])]. 148% ?- ifmap: representation_system(cla([],[],[]), theory([], []), theory([],[]), Im_O, Im_D). 149%@ **** false. **** 150% ?- ifmap: representation_system(cla([],[a],[]), theory([], []), theory([],[]), Im_O, Im_D). 151%@ false. 152% ?- ifmap: representation_system(cla([],[a],[]), theory([a], []), theory([],[]), Im_O, Im_D). 153%@ false. 154% ?- ifmap: representation_system(cla([1],[a],[a-[1]]), theory([a], [[]=>[a]]), theory([a],[[]=>[a]]), Im_O, Im_D). 155%@ Im_O = Im_D, Im_D = [p([a], [])-p([a], [])] . 156% ?- ifmap: representation_system(cla([1],[a],[a-[1]]), theory([a], [[]=>[a]]), theory([a],[[]=>[a]]), Im_O, Im_D). 157% ?- ifmap: representation_system(cla([1,2],[a],[a-[1]]), theory([a], [[]=>[a]]), theory([a],[[]=>[a]]), Im_O, Im_D). 158% ?- ifmap: representation_system(cla([1,2],[a],[a-[1]]), theory([a,b], [[]=>[a],[b]=>[]]), theory([a,b],[[b]=>[], []=>[a]]), Im_O, Im_D). 159% ?- ifmap: representation_system(cla([1],[a],[a-[1]]), theory([a,b], [[]=>[a],[b]=>[]]), theory([a,b],[[b]=>[], []=>[a]]), Im_O, Im_D). 160% ?- ifmap: representation_system(cla([1],[a,b],[a-[1]]), theory([a,b], [[]=>[a],[b]=>[]]), theory([a,b],[[b]=>[], []=>[a]]), Im_O, Im_D). 161%@ Im_O = Im_D, Im_D = [p([a], [])-p([a], [])] . 162% ?- ifmap: representation_system(cla([1],[a,b],[a-[1],b-[1]]), theory([a,b], [[]=>[a],[b]=>[]]), theory([a,b],[[b]=>[], []=>[a]]), Im_O, Im_D). 163 164% ?- ifmap:theory_to_cla(theory([x,y], [=>([], [x,y])]), R). 165% ?- ifmap:(sample_observation(-1, O), sample_desire(-1, D), sample_theory(-1, Th), representation_system(O, D, Th, Im_O, Im_D)). 166% ?- spy(invertable_atom_set), ifmap:(sample_observation(0, O), sample_desire(0, D), sample_theory(0, Th), representation_system(O, D, Th, Im_O, Im_D)). 167 168% ?- trace, spy(invertable_atom_set), ifmap:(sample_observation(0, O), sample_desire(0, D), sample_theory(0, Th), representation_system( 169% ?- ifmap:(sample_observation(0, O), sample_desire(0, D), sample_theory(0, Th), representation_system(O, Th, Th, Im_O, Im_D)). 170% ?- trace, ifmap:(sample_observation(0, O), sample_desire(0, D), sample_theory(0, Th), representation_system(O, D, Th, Im_O, Im_D)). 171% ?- trace, ifmap:(sample_observation(0, O), sample_desire(0, D), sample_theory(0-0, Th), representation_system(O, D, Th, Im_O, Im_D)). 172% ?- ifmap:(sample_theory(0, Th), theory_to_cla(Th, Cla), cla(_,Ts,_)=Cla, zip(Ts, Ts, Id), invertable_type_map(Id, Cla, Cla, R), maplist(pred([X-X]), R)). 173% ?- ifmap:(sample_theory(0, Th), theory_to_cla(Th, Cla), sample_desire(0, D), theory_to_cla(D, Cla1), tok(Cla1, X), zip(X, X, Id), invertable_type_map(Id, Cla1, Cla, R)). 174% ?- ifmap:(sample_theory(0, Th), theory_to_cla(Th, Cla), sample_observation(0, O), theory_to_cla(O, Cla1), tok(OD, X), zip(X, X, Id), invertable_type_map(Id, Cla1, Cla, R)). 175 176% representation_system(Cla_O, Theo_D, Theory, F_OT, F_DT, Im_O, Im_D):- 177% Cla_O = cla(_, T_O, _), 178% Theo_D = theory(T_D, _), 179% theory_to_cla(Theo_D, Cla_D), 180% theory_to_cla(Theory, Cla_ch), 181% zip(T_O, T_O, ID_O), 182% zip(T_D, T_D, ID_D), 183% invertable_type_map(ID_O, Cla_O, Cla_ch, Im_O), 184% invertable_type_map(ID_D, Cla_D, Cla_ch, Im_D). 185 186representation_system(Cla_O, Theo_D, Theory, F_OT, F_DT, Im_O, Im_D):- 187 theory_to_cla(Theo_D, Cla_D), 188 theory_to_cla(Theory, Cla_ch), 189 ( var(F_OT) 190 -> typ(Cla_O, T_O), 191 zip(T_O, T_O, F_OT) 192 ; true 193 ), 194 ( var(F_DT) 195 -> typ(Cla_D, T_D), 196 zip(T_D, T_D, F_DT) 197 ; true 198 ), 199 invertable_type_map(F_OT, Cla_O, Cla_ch, Im_O), 200 invertable_type_map(F_DT, Cla_D, Cla_ch, Im_D). 201 202representation_system(Cla_O, Theo_D, Theory, Im_O, Im_D):- !, 203 representation_system(Cla_O, Theo_D, Theory, _, _, Im_O, Im_D). 204 205sample_theory(-1, theory( [a], [[] => [a]])). 206 207sample_theory(0, theory( ['ã´ãããªå ¥ã', 'ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', '欲ãã'], 208 [ ['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹'] => [], 209 ['ã´ãããªå ¥ã'] => []] 210 )). 211 212sample_theory(sub(0), theory( ['ã´ãããªå ¥ã', 'ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', '欲ãã'], 213 [] 214 )). 215sample_theory(sub(sub(0)), theory( ['ã´ãããªå ¥ã', 'ã³ã¼ãã¼'], 216 [] 217 )). 218sample_theory(0-1, theory( ['ã´ãããªå ¥ã', 'ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', '欲ãã'], 219 [ ['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹'] => [], 220 ['ã´ãããªå ¥ã', '欲ãã'] => []] 221 )). 222 223% sample_theory(0, theory( ['ã´ãããªå ¥ã', 'ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', 'é¦ã°ããé¦ã', 'è¦å³', '飲ã¿ç©', '欲ãã'], 224% [[] => ['ã´ãããªå ¥ã', 'ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', 'é¦ã°ããé¦ã', 'è¦å³', '飲ã¿ç©', '欲ãã'], 225% ['ã´ãããªå ¥ã', '欲ãã'] => [], 226% ['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹'] => []] 227% )). 228sample_theory(0-0, theory( ['ã´ãããªå ¥ã', 'ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹','飲ã¿ç©', '欲ãã'], 229 [[] => ['ã´ãããªå ¥ã', 'ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', '飲ã¿ç©', '欲ãã']])). 230sample_theory(1, theory([ag,pa,ind,fs,eubd], 231 [[] => [ag,fs], 232 [ag,fs] => [], 233 [pa] => [ag], 234 [ind] => [ag], 235 [pa,ind] => [], 236 [eubd] => [fs]])). 237 238sample_theory(2, theory([apple, orange, sweet, acid], 239 [[apple] => [sweet], 240 [orange] => [acid], 241 [sweet, acid] => []])). 242 243% 244sample_desire(-1, theory([a], [ [] => [a]])). 245 246% ?- ifmap:theory_to_cla_show(theory([c,o,g,h], [[h]=>[c,o], [h,g]=>[], [c,o]=>[]])). 247%@ true. 248 249% ?- ifmap:invertable_type_map(=, cla([c1, o1, g1, x], [o, c, g], [o-[o1], c-[c1],g-[g1]]), theory([c,o,g,h], [[h]=>[c,o],[c,g]=>[], [h,g]=>[], [c,o]=>[], [g,o]=>[]])). 250% ?- ifmap:invertable_type_map(=, cla([c1, o1, x], [o, c], [o-[o1], c-[c1]]), theory([c,o,g,h], [[h]=>[c,o],[c,g]=>[], [h,g]=>[], [c,o]=>[], [g,o]=>[]])). 251% ?- ifmap:invertable_type_map(=, cla([c1, o1, x], [o, c], [o-[o1], c-[c1]]), theory([c,o,h], [[h]=>[c,o], [c,o]=>[]])). 252 253sample_desire(0, 254 theory(['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', 'ã´ãããªå ¥ã', '欲ãã'], 255 [ ['欲ãã'] => ['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹'], 256 ['欲ãã', 'ã´ãããªå ¥ã'] => [] 257 ] )). 258 259sample_desire(0-1, 260 theory(['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', 'ã´ãããªå ¥ã', '欲ãã'], 261 [ ['ã³ã¼ãã¼'] => ['欲ãã', 'ã´ãããªå ¥ã'], 262 ['ãªã¬ã³ã¸ã¸ã¥ã¼ã¹'] => ['欲ãã', 'ã´ãããªå ¥ã'], 263 ['欲ãã', 'ã´ãããªå ¥ã'] => [] 264 ] )). 265 266sample_desire(1, 267 theory(['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', '欲ãã'], 268 [ [] => ['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹'], 269 ['ã³ã¼ãã¼'] => ['欲ãã'], 270 ['ãªã¬ã³ã¸ã¸ã¥ã¼ã¹'] => ['欲ãã']])). 271sample_desire(2, 272 theory( ['ã´ãããªå ¥ã', 'ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', 'é¦ã°ããé¦ã', 'è¦å³', '飲ã¿ç©', '欲ãã'], 273 [['ã´ãããªå ¥ã', '欲ãã'] => [], 274 ['ã³ã¼ãã¼'] => ['ã´ãããªå ¥ã', '欲ãã'], 275 ['ãªã¬ã³ã¸ã¸ã¥ã¼ã¹'] => ['ã´ãããªå ¥ã', '欲ãã'] 276 ])). 277 278% 279sample_observation(-1, 280 cla([coffee0], 281 [a], 282 [a - [coffee0]])). 283sample_observation(0, 284 cla([coffee0, x], 285 ['ã³ã¼ãã¼', 'ã´ãããªå ¥ã'], 286 ['ã³ã¼ãã¼' - [coffee0]])). 287 288sample_observation(1, 289 cla([coffee1], 290 ['ã³ã¼ãã¼', 'ã´ãããªå ¥ã'], 291 ['ã³ã¼ãã¼' - [coffee1], 292 'ã´ãããªå ¥ã' - [coffee1]])). 293sample_observation(2, 294 cla([orange_juice0], 295 ['ãªã¬ã³ã¸ã¸ã¥ã¼ã¹'], 296 ['ãªã¬ã³ã¸ã¸ã¥ã¼ã¹' - [orange_juice0]])). 297sample_observation(3, 298 cla([orange_juice1], 299 ['ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', 'ã´ãããªå ¥ã'], 300 ['ãªã¬ã³ã¸ã¸ã¥ã¼ã¹' - [orange_juice1], 301 'ã´ãããªå ¥ã' - [orange_juice1]])). 302 303 304% 305is_preferred(X, Y):- member(A-[X0], X), 306 member(A-[Y0], Y), 307 intersection(['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', '欲ãã'], X0, S), 308 S \== [], 309 intersection(['ã³ã¼ãã¼', 'ãªã¬ã³ã¸ã¸ã¥ã¼ã¹', '欲ãã'], Y0, T), 310 T \== []. 311 312% :- module(channel_demo,[]). 313 314% ?- ifmap: (theory_base(1, A), theory_to_cla(A, B), build_info_map(B, B, X)). 315%@ A = theory([ag, pa, ind, fs, eubd], [=>([], [ag, fs]), =>([ag, fs], []), =>([pa], [ag]), =>([ind], [ag]), =>([pa, ind], []), =>([eubd], [fs])]), 316%@ B = cla([1, 2, 3, 4, 5], [ag, pa, ind, fs, eubd], [ag-[3, 4, 5], eubd-[1], fs-[1, 2], ind-[3], pa-[4]]), 317%@ X = im([eubd-ag, fs-ag, ind-ag, pa-ag, ag-ag], [5-1, 4-1, 3-1, 2-1, 1-1]) . 318 319% ?- ifmap:test_preference(1, 1, R). 320% ?- spy(inverse_type_map), ifmap:test_preference(2, 2, R). 321% ?- ifmap:test_preference(2, 2, R). 322%@ R = [[acid, ~(sweet), ~(orange), ~(apple)]-[[acid, ~(sweet), ~(orange), ~(apple)]], [~(acid), sweet, ~(orange), ~(apple)]-[[~(acid), sweet, ~(orange), ~(apple)]]] . 323 324% test_preference(I, J, R):- theory_base(I, T_I), 325% classification_base(J, C_J), 326% theory_to_cla(T_I, C_I), 327% typ(C_I, P), 328% maplist(pred([X,X-X]), P, Id), 329% pre_inverse_in_boolean_atoms(Id, C_I, C_J, R). 330 331:- meta_predicate show_graph(,). 332% ?- ifmap:show_graph(ifmap:[A-B, (A, "", B)], [a-b,b-d]). 333% ?- ifmap:show_graph((=), [(a,f,b),(b, g, c)]). 334 335show_graph(F, DG):- maplist(F, DG, Arrows), 336 coalgebra:autviz(ifmap:digraph_viz, Arrows). 337 338% 339digraph_viz(Arrows) :- 340 format("digraph g {~n",[]), 341 format("rankdir=LR;~n",[]), 342 coalgebra:move_in_dot(Arrows), 343 format("}~n",[]). 344 345% ?- ifmap_demo:interoperability(X, Y). 346%@ X = cla(emptyset, [[1], []], [[1]-[], []-[]]), 347%@ Y = cla([sos, bca, bea, age, ins], [[5], [5, 1], [5, 2, 1], [5, 2], [5, 3, 2], [5, 3|...], [5|...], [...|...]|...], [[5]-[sos], [5, 1]-[sos, age, ins], [5, 2, 1]-[sos, age, age, ins], [5, 2]-[sos, age], [5, 3|...]-[sos, bea|...], [5|...]-[sos|...], [...|...]-[...|...], ... - ...|...]) . 348 349% interoperability(Pow_Flip_A_UK, Pow_Flip_A_US):- 350% Typ_UK = [fco, ho], 351% Typ_US = [dos, doj], 352% theory_uk(Theory_Uk), 353% theory_us(Theory_US), 354% theory_cla_flip_pow(Theory_UK, Pow_Flip_A_UK), 355% theory_cla_flip_pow(Theory_US, Pow_Flip_A_US). 356 357 358% iopera(P, K):- theory_uk(TUK), theory_us(TUS), 359% theory_to_cla(TUK,ClaUK), 360% theory_to_cla(TUS,ClaUS), 361 362% ?- ifmap_demo:iopera_core_tokens(X). 363 364% ?- ifmap_demo:(theory_uk(UK), theory_us(US), UK=theory(P,_), US=theory(Q,_), maplist(pred([A,B,A-B]), P, Q, Zip)), ds_theory_cover_with_constraint([UK,US], [im(1,2,Zip)], [], X, Y). 365%@ UK = theory([ag, pa, ind, fs, eubd], [[]=>[ag, fs], [ag, fs]=>[], [pa]=>[ag], [ind]=>[ag], [pa, ind]=>[], [eubd]=>[fs]]), 366%@ US = theory([sos, bca, bea, age, ins], [[]=>[sos, age], [sos, age]=>[], [bca]=>[sos], [bea]=>[sos], [bca, bea]=>[], [ins]=>[age]]), 367%@ P = [ag, pa, ind, fs, eubd], 368%@ Q = [sos, bca, bea, age, ins], 369%@ Zip = [ag-sos, pa-bca, ind-bea, fs-age, eubd-ins], 370%@ X = [[[eubd, fs]-[ag, ind, pa], [age, ins]-[bca, bea, sos]], [[fs]-[ag, eubd, ind, pa], [age]-[bca, bea, ins, sos]], [[ag, ind]-[eubd, fs, pa], [bea, sos]-[age, bca, ins]], [[ag, pa]-[eubd, fs, ind], [bca, sos]-[age, bea, ins]], [[ag]-[eubd, fs, ind, pa], [sos]-[age, bca, bea, ins]]], 371%@ Y = [[1:eubd, 2:ins], [1:fs, 2:age], [1:ind, 2:bea], [1:pa, 2:bca], [1:ag, 2:sos]] . 372 373iopera_core_tokens(X):- theory_uk(UK), theory_us(US), 374 theory_sum_tokens([UK,US], X). 375 376 377% inter-operability demo 378 379demo_theory(uk, theory([ag,pa,ind,fs,eubd], 380 [[]=>[ag,fs], 381 [ag,fs]=>[], 382 [pa]=>[ag], 383 [ind]=>[ag], 384 [pa,ind]=>[], 385 [eubd]=>[fs]])). 386demo_theory(us, theory([sos,bca,bea,age,ins], 387 [[]=>[sos,age], 388 [sos,age]=>[], 389 [bca]=>[sos], 390 [bea]=>[sos], 391 [bca,bea]=>[], 392 [ins]=>[age]])). 393% ?- import_module(engine, X). 394 395% ?- default_module(snippets, X). 396%@ X = snippets ; 397%@ X = engine ; 398%@ X = user ; 399%@ X = system . 400 401% ?- default_module(engine, X). 402%@ X = engine ; 403%@ X = user ; 404%@ X = system ; 405%@ false. 406 407 408%@ true. 409 410% ?- default_module('emacs-handler', X). 411%@ X = 'emacs-handler' ; 412 413%@ X = engine ; 414%@ X = user ; 415%@ X = system ; 416%@ false. 417 418 419% ?- ifmap_demo:cla_by_theory_show(uk). 420%@ ERROR: snippets:show_digraph/2: Undefined procedure: snippets:new_base_name/2 421%@ Exception: (23) snippets:new_base_name([out(pdf), counter_name(graph_counter), stem("dot_graph"), directory("/Users/cantor/Desktop/_iMG_TMP")], _G919) ? creep 422 423% ?- ifmap_demo:cla_by_theory_show(us). 424cla_by_theory_show(Name):- demo_theory(Name, Th), 425 theory_to_cla(Th, Cla), 426 cla(flip(Cla), Flipped), 427 show_cla(Cla), 428 show_cla(Flipped). 429 430% ?- ifmap_demo:demo_cla(X, Y). 431demo_cla(uk, cla([ag,pa,ind,fs,eubd], 432 [fco, ho], 433 [fco-[fs,eubd], ho-[ag,pa,ind]])). 434demo_cla(us, cla([sos,bca,bea,age,ins], 435 [dos,doj], 436 [dos-[sos,bca,bea], doj-[age,ins]])). 437demo_cla(uk_flip, A):- once(uk_flip(A)). 438demo_cla(uk_flip_boole, A):- once(uk_flip_boole(A)). 439demo_cla(us_flip, A):- once(us_flip(A)). 440demo_cla(us_flip_boole, A):- once(us_flip_boole(A)). 441demo_cla(align, A) :- once(theory_to_cla(theory([alpha,beta,gamma],[]), A)). 442 443% ?- ifmap_demo:demo_cla(align, A), ifmap:show_cla(A). 444% ?- ifmap_demo:demo_informorphism(im(uk_flip,uk_flip_boole, X, Y)). 445%@ X = [r1-[r1], r2-[r2], r3-[r3], r4-[r4], r5-[r5]], 446%@ Y = [ag-ag, eubd-eubd, fs-fs, ind-ind, pa-pa] . 447 448demo_informorphism(im(align, uk_flip, [alpha-r1, beta-r2, gamma-r4])). 449demo_informorphism(im(align, us_flip, [alpha-s1, beta-s4, gamma-s2])). 450demo_informorphism(im(uk_flip, uk_flip_boole, TypeMap, Id)):- 451 demo_cla(uk_flip, cla(Xs,Ts,_)), 452 maplist(pred([X, X-[X]]), Ts, TypeMap), 453 maplist(pred([X, X-X]), Xs, Id). 454demo_informorphism(im(uk, uk_flip_boole, [ho-[r1,r2,r3], fco-[r4,r5]])). 455demo_informorphism(im(us_flip, us_flip_boole, TypeMap, Id)):- 456 demo_cla(us_flip, cla(Xs,Ts,_)), 457 maplist(pred([X, X-[X]]), Ts, TypeMap), 458 maplist(pred([X, X-X]), Xs, Id). 459demo_informorphism(im(us, us_flip_boole, [dos-[s1,s2,s3], doj-[s4,s5]])). 460 461 462% ?- ifmap_demo:demo_token_map(X). 463demo_token_map(X):- 464 demo_informorphism(im(uk, uk_flip_boole, M)), 465 demo_cla(uk, UK), 466 demo_cla(uk_flip_boole, UKFB), 467 invertable_type_map(M, UK, UKFB, X). 468 469 470% ?- ifmap_demo:demo_ds(ds(X, Y, [])), maplist(writeln, X), maplist(writeln, Y). 471demo_ds(ds([ uk:UK, uk_flip:UKF, uk_flip_boole:UKFB, 472 align:Align, 473 us:US, us_flip:USF, us_flip_boole:USFB 474 ], 475 [im(uk,uk_flip_boole, UK_to_boole), 476 im(uk_flip, uk_flip_boole, UKF_to_boole), 477 im(us, us_flip_boole, US_to_boole), 478 im(us_flip, us_flip_boole, USF_to_boole), 479 im(align, uk_flip, A_to_UKF), 480 im(align, us_flip, A_to_USF) 481 ], 482 [])):- demo_cla(uk, UK), 483 demo_cla(us, US), 484 demo_cla(uk_flip, UKF), 485 demo_cla(us_flip, USF), 486 demo_cla(uk_flip_boole, UKFB), 487 demo_cla(us_flip_boole, USFB), 488 demo_cla(align, Align), 489 demo_informorphism(im(align, uk_flip, A_to_UKF)), 490 demo_informorphism(im(align, us_flip, A_to_USF)), 491 demo_informorphism(im(uk, uk_flip_boole, UK_to_boole)), 492 demo_informorphism(im(us, us_flip_boole, US_to_boole)), 493 demo_informorphism(im(uk_flip, uk_flip_boole, UKF_to_boole, _)), 494 demo_informorphism(im(us_flip, us_flip_boole, USF_to_boole, _)). 495 496% ?- ifmap_demo:responsibility_uk(UK), ifmap:cla(flip(UK), R). 497% ?- ifmap:cla(clean_disj(pow(flip(empty))), R), write(R). 498% ?- ifmap:cla(clean_disj(pow(flip(cla([1,2],[a,b],[a-[1],b-[2]])))), R), write(R). 499% ?- ifmap_demo:responsibility_us(US), ifmap:cla(cleaning(pow(flip(US))), R), write(R). 500% ?- ifmap_demo:responsibility_uk(UK), ifmap:cla(cleaning(pow(flip(UK))), R), write(R). 501 502uk_flip(A):- responsibility_uk(UK), 503 cla(flip(UK), A0), 504 cla(sort(A0), A). 505 506% ?- ifmap_demo:uk_flip_boole(A). 507 508uk_flip_boole(A):- uk_flip(B), cla(pow(B), A0), 509 cla(cleaning_boole(A0), A). 510 511us_flip(A):- responsibility_us(B), 512 cla(flip(B), A0), 513 cla(sort(A0), A). 514% ?- ifmap_demo:us_flip_bool(A). 515us_flip_boole(A):- us_flip(B), cla(pow(B), A0), 516 cla(cleaning_boole(A0), A). 517 518% ?- ifmap: invertable_type_map([a-s],cla([1],[a],[a-[1]]), cla([2],[s],[s-[2]]),R). 519responsibility_uk(cla([r1,r2,r3,r4,r5],[ag, pa,ind,fs,eubd], 520 [ag - [r1,r2,r3], 521 pa - [r1], 522 ind - [r2], 523 fs - [r4,r5], 524 eubd - [r4]])). 525 526responsibility_us(cla([s1,s2,s3,s4,s5],[sos,bca,bea,age,ins], 527 [sos - [s1,s2,s3], 528 bca - [s1], 529 bea - [s2], 530 age - [s4,s5], 531 ins - [s4]])). 532 533% 534theory_cla_flip_pow(Th, Cla):- theory_to_cla(Th, A), 535 cla(flip(A), FA), 536 cla(pow(FA), Cla). 537 538 539 540% ?- ifmap:test1(A). 541% ?- test1(A). 542%@ A = cla([1,2,3],[bird,fly],[bird-[3],fly-[2,3]]) . 543 544% ?- ifmap:test2(A). 545%@ A = cla([1, 2, 3, 4, 5], [penguine, bird, fly], [bird-[2, 3, 4], fly-[1, 2], penguine-[4]]) . 546% ?- ifmap:test3(A, B). 547% ?- trace, ifmap:test4(A). 548%@ A = cla([1, 2, 3, 4, 5, 6], 549% [[bird, bird], [bird, fly], [bird, penguine], [fly, bird], [fly, fly], [fly, penguine]], 550% [[bird, bird]-[2, 3, 4, 6], 551% [bird, fly]-[2, 5, 6], 552% [bird, penguine]-[2, 4], 553% [fly, bird]-[1, 2, 3, 4, 6], 554% [fly, fly]-[1, 2, 5, 6], 555% [fly, penguine]-[1, 2, 4]]) . 556 557% ?- [pac(ifmap)], module(ifmap). 558% ?- ifmap:theory_to_cla(theory([ag,pa,ind,fs,eubd], [[]=>[ag,fs],[ag,fs]=>[],[pa]=>[ag], [ind]=>[ag], [pa,ind]=>[], [eubd]=>[fs]]), A). 559%@ A = cla([1,2,3,4,5],[ag,pa,ind,fs,eubd],[ag-[1,2,3],eubd-[5],fs-[4,5],ind-[3],pa-[2]]) . 560% ?- ifmap:theory_to_cla(theory([sos,bca,bea,age,ins],[[]=>[sos,age],[sos,age]=>[],[bca]=>[sos], [bea]=>[sos], [bca,bea]=>[], [ins]=>[age]]), A). 561%@ A = cla([1,2,3,4,5],[sos,bca,bea,age,ins],[age-[4,5],bca-[2],bea-[3], (ins)-[5],sos-[1,2|...]]) [write] 562%@ A = cla([1, 2, 3, 4, 5], [sos, bca, bea, age, ins], [age-[4, 5], bca-[2], bea-[3], (ins)-[5], sos-[1, 2, 3]]) . 563 564% ?- module(ifmap). 565%@ true. 566 567% ?- ifmap:theory_to_cla(theory([bird,fly], [[bird] => [fly]]), A). 568% ?- ifmap:theory_to_cla(theory([a,b,c], [[] => [a],[]=>[b],[]=>[c]]), A). 569%@ A = cla([1], [a, b, c], [a-[1], b-[1], c-[1]]) . 570% ?- ifmap:theory_to_cla(theory([a,b,c], [[a] => [b],[b]=>[c]]), A). 571%@ A = cla([1,2,3,4],[a,b,c],[a-[4],b-[3,4],c-[2,3,4]]) . 572% ?- ifmap:theory_to_cla(theory([a,b,c,d], [[a] => [b],[a]=>[c],[b] => [d],[c] =>[d]]), A). 573%@ A = cla([1, 2, 3, 4, 5, 6], [a, b, c, d], [a-[6], b-[3, 5, 6], c-[4, 5, 6], d-[2, 3, 4, 5, 6]]) . 574% ?- ifmap:theory_to_cla(theory([bird,fly,penguin], [[bird] => [fly],[penguin,fly]=>[]]), A). 575%@ A = cla([1, 2, 3, 4], [bird, fly, penguin], [bird-[3], fly-[2, 3], penguin-[4]]) . 576% ?- ifmap:theory_to_cla(theory([bird,fly,penguin], [[penguin]=>[bird],[bird] => [fly],[penguin,fly]=>[]]), A). 577%@ A = cla([1, 2, 3], [bird, fly, penguin], [bird-[3], fly-[2, 3]]) . 578 579 580test1(A) :- ifmap:theory_to_cla(theory([bird,fly], [[bird] => [fly]]), A). 581test2(A) :- ifmap:theory_to_cla( 582 theory([penguine, bird, fly], 583 [[penguine, fly] => [], 584 [penguine] => [bird]] 585 ), 586 A). 587test3(C, M) :- test1(A), 588 test2(B), 589 ds_create((bird-A)+(penguine-B), DS), 590 ds_cover(DS, C, M). 591 592test4(C) :- test1(A), 593 test2(B), 594 cla(flip(A), A0), 595 cla(flip(B), B0), 596 ds_create((bird-A0) + (penguine-B0), Ds), 597 ds_cover(Ds, C0, _), 598 cla(flip(C0), C). 599 600% ?- ifmap:ds_cover( 601% ds( [ bird-cla( [bird, fly], [1, 2, 3], [2-[fly], 3-[bird, fly]]), 602% penguine-cla( [penguine, bird, fly], 603% [1, 2, 3, 4, 5], 604% [2-[bird], 3-[bird, penguine], 4-[fly], 5-[bird, fly]])], 605% []), 606% cla( [[bird, bird], [bird, fly], [bird, penguine], [fly, bird], [fly, fly], [fly, penguine]], 607% [1, 2, 3, 4, 5, 6], 608% [ 1-[[fly, bird], [fly, fly], [fly, penguine]], 609% 2-[[bird, bird], [bird, fly], [bird, penguine], [fly, bird], [fly, fly], [fly, penguine]], 610% 3-[[bird, bird], [fly, bird]], 611% 4-[[bird, bird], [bird, penguine], [fly, bird], [fly, penguine]], 612% 5-[[bird, fly], [fly, fly]], 613% 6-[[bird, bird], [bird, fly], [fly, bird], [fly, fly]]] 614% ), 615% [ im(penguine, [5-6, 4-5, 3-4, 2-3], proj(penguine)), 616% im(bird, [3-2, 2-1], proj(bird)) 617% ] 618% ). 619 620% ?- ifmap:test(a, b, R). 621%@ R = a-b. 622% test(A) --> pred(A, [X, A-X]). 623 624% ?- ifmap:cover_test(Cover, Tmap). 625%@ Cover = cla([[x, a, a, a, a, x]], [1, 2], [1-[[x, a, a, a, a, x]], 2-[[x, a, a, a, a, x]]]), 626%@ Tmap = [1-[2:x, 1:a, 3:[x]], 2-[5:x, 6:a, 4:[x]]] . 627 628% ?- [pac(ifmap)]. 629% ?- trace, ifmap:demo_ontology(Cover, Tmap). 630%@ Cover = cla([[1, x, a, a, c, c, u], [1, x, a, a, d, d, u]], [1, 2, 3], [1-[[1, x, a, a, c, c, u], [1, x, a, a, d, d, u]], 2-[[1, x, a, a, d, d, u]], 3-[[1, x, a, a, c, c, u], [1, x, a, a, d, d, u]]]), 631%@ Tmap = [1-[1:a, 1:b, 3:x, 6:u, 2:a, 4:[x], 7:c, 5:[u]], 2-[6:v, 5:[v]], 3-[7:d, 5:[u, v]]] . 632 633% ?- [pac(ifmap)]. 634 635% ?- bagof(SequentsOut, ifmap:debug(theory([a,b], [[a]=> [b]]), left-cla([x], [a], [a-[x]]), right-cla([u,v], [c,d], [c-[u],d-[u,v]]), SequentsOut), S), length(S, L), sort(S, S0). 636% ?- trace, ifmap:debug(theory([a,b], [[a]=>[b]]), left-cla([x], [a], [a-[x]]), right-cla([u,v], [c,d], [c-[u],d-[u,v]]), SequentsOut). 637 638%@ SequentsOut = [[left:a] => [right:c], [right:c] => [left:a]] . 639 640% ds -- distributed system, or sketch (acronym). 641 642% debug(Theory, Left, Right, SequentsOut):- 643% Left= (A-_), 644% Right = (B-_), 645% Index = [A, B], 646% once(sample_ds(Left, Right, E, FlipLeft, FlipRight)), % 647% ds_create(E, Ds), 648% ds_check_info_map(Ds), 649% theory_to_cla(Theory, M), 650% get_cla(FlipLeft, Ds, C2), 651% get_cla(FlipRight, Ds, D2), 652% build_info_map(M, C2, im(LU, LL)), 653% build_info_map(M, D2, im(RU, RL)), 654% ds_add(im(theorycla, FlipLeft, LU, LL) 655% + im(theorycla, FlipRight, RU, RL) 656% + (theorycla- M), 657% Ds, Sketch), 658% ds_cover(Sketch, Cover, _Tmap), 659% maplist(Sketch^[K, J]:- get_key_pos(K, Sketch, J), Index, I0), 660% get_key_pos(theorycla, Sketch, N), 661% Theory=theory(_, Sequents), 662% maplist(N^[=>(L,R), =>(L0, R0)] 663% :- (maplist(N^[A, N:A], L, L0), 664% maplist(N^[A, N:A], R, R0)), 665% Sequents, Sequents0), 666% Cover= cla(_, Partition, _), 667% % zip(_, Partition, Tmap), 668% partition_to_restricted_massoc(Partition, N, I0, Massoc), 669% subst_theory_multiple(Massoc, Sequents0, Sequents1), 670% flatten(Sequents1, Sequents2), 671% subst_types_back(Sequents2, Sketch, Sequents3), 672% simplify_theory(Sequents3, SequentsOut). 673 674% 675sample_ds(A, B, 676 F13 + F23 + G13 + G23 + A 677 + (c2-C2) + (c3-C3) + (d3-D3) + (d2-D2) + B, 678 c2, d2) 679 :- 680 A=(I-C1), 681 B=(J-D1), 682 cla(flip(C1), C2), % flip class 683 cla(pow(C2), C3), % power class 684 cla(flip(D1), D2), 685 cla(pow(D2), D3), 686 power_cla_inclusion(C2, U23, L23), 687 F23 = im(c2, c3, U23, L23), 688 cla(supp(C1), U13), 689 section(U13, L13), 690 F13 = im(I, c3, U13, L13), 691 power_cla_inclusion(D2, V23, M23), 692 G23 = im(d2, d3, V23, M23), 693 cla(supp(D1), V13), 694 section(V13, M13), 695 G13 = im(J, d3, V13, M13). 696 697% ?- [pac(ifmap)]. 698% ?-ifmap:partition_to_restricted_massoc([[a:x, b:y, c:z]], a,[b,c], R). 699%@ R = [[a:x]-[b:y, c:z]] . 700% ?-ifmap:partition_to_restricted_massoc([[a:x, b:y, c:z], [a:u, a:v, c:z]],a,[b,c], R). 701%@ R = [[a:x]-[b:y, c:z], [a:u, a:v]-[c:z]] . 702 703partition_to_restricted_massoc(P, I, S, A):- 704 maplist(pred([I, S], [X, Y] 705 :- foldr( 706 pred([I,S], ([J:U, L-R, L-[J:U|R]] 707 :- memberchk(J, S), ! ) 708 & ([I:U, L-R, [I:U|L]-R]:- ! ) 709 & [_, LR, LR]), 710 X, []-[], Y)), 711 P, A). 712 713 714% ?- ifmap:subst_types_back([[1:x] => [2:y]], ds([a,b],dummy,dummy), T). 715%@ T = [[a:x]=>[b:y]].