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( ['ã´ãããªå ¥