home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 5 / DATAFILE_PDCD5.iso / utilities / b / binprolog / !BinPro330 / progs / lattice < prev    next >
Encoding:
Text File  |  1993-09-08  |  2.5 KB  |  105 lines
  1.  
  2. go:-
  3.     statistics(runtime,_),
  4.     findall(C,concept(C),Cs),
  5.     statistics(runtime,[_,T]),
  6.     write(time=T),nl,statistics,
  7.     set_member(C,Cs),
  8.       write(C),nl,
  9.     fail.
  10. go.
  11.  
  12.  
  13. gen_all:-
  14.     findall(X,gen_one(X),Is),
  15.     fill_instr(Is,0,_),
  16.     pp_is(Is).
  17.  
  18. gen_one(wam(_,L)):-
  19.     set_member(X,[deep,top]),
  20.     set_member(Y,[head,body]),
  21.     set_member(Z,[constant,structure,value,variable]),
  22.     sort([X,Y,Z],L).
  23.  
  24. fill_instr([],N,N).
  25. fill_instr([wam(N1,_)|Is],N1,N2):-
  26.     N is N1+1,
  27.     fill_instr(Is,N,N2).
  28.     
  29. pp_is(Is):-set_member(I,Is),write(I),write('.'),nl,fail.
  30. pp_is(_).
  31.  
  32. /*
  33. in BinProlog: let(earth,moon,[planet]),let(earth,moon,[planet])...
  34. in general let(object,attribut,[<relation_name>|...]): => yes  absence: => no
  35.  
  36. relation(planet,[o1,o2,...],[a1,...an]).
  37.  
  38. relation(planet,LeftList,RightList):
  39. */
  40.  
  41. context(L,R):-lcontext(L,Rs),set_member(R,Rs).
  42.  
  43. rcontext(R,Ls):-setof(L,context(L,R),Ls).
  44.  
  45. lset(Ls):-findall(L,lcontext(L,_),Ls).
  46. rset(Rs):-findall(R,rcontext(R,_),Rs).
  47.  
  48. an_intent([I|Is]):-
  49.     lset(Ls),
  50.     subset(Ls,Xs),
  51.     extent2intent(Xs,[I|Is]).
  52.  
  53. intent(Is):-
  54.     findall(Is,an_intent(Is),Unsorted),
  55.     sort(Unsorted,Iss),
  56.     set_member(Is,Iss).
  57.  
  58. % Finds the lattice of concepts defined on on context
  59. % as defined at pp. 221-236 in Davey & Priestley,
  60. % Introduction to Lattices and Order (Cambridge Univ. Press, 1990)
  61. % the theory of Formal Concept Analysis is due to R. WILLE
  62.  
  63. concept(Es-Is):-
  64.     intent(Is),
  65.     intent2extent(Is,Es).
  66.  
  67. % tools
  68.  
  69. extent2intent([X|Xs], Ans) :- lcontext(X,L),intersect_extents(Xs, L, Ans).
  70.  
  71. intent2extent([X|Xs], Ans) :- rcontext(X,R),intersect_intents(Xs, R, Ans).
  72.  
  73. intersect_extents([], Ans, Ans).
  74. intersect_extents([X|Xs], Ans0, Ans) :-
  75.     lcontext(X,L),
  76.     ord_intersect(Ans0, L, Ans1),
  77.     intersect_extents(Xs, Ans1, Ans).
  78.  
  79. intersect_intents([], Ans, Ans).
  80. intersect_intents([X|Xs], Ans0, Ans) :-
  81.     rcontext(X,R),
  82.     ord_intersect(Ans0, R, Ans1),
  83.     intersect_intents(Xs, Ans1, Ans).
  84.  
  85. ord_intersect(_, [], []) :- !.
  86. ord_intersect([], _, []) :- !.
  87. ord_intersect([Head1|Tail1], [Head2|Tail2], Intersection) :-
  88.     compare(Order, Head1, Head2),
  89.     ord_intersect(Order, Head1, Tail1, Head2, Tail2, Intersection).
  90.  
  91. ord_intersect(=, Head,  Tail1, _,     Tail2, [Head|Intersection]) :-
  92.     ord_intersect(Tail1, Tail2, Intersection).
  93. ord_intersect(<, _,     Tail1, Head2, Tail2, Intersection) :-
  94.     ord_intersect(Tail1, [Head2|Tail2], Intersection).
  95. ord_intersect(>, Head1, Tail1, _,     Tail2, Intersection) :-
  96.     ord_intersect([Head1|Tail1], Tail2, Intersection).
  97.  
  98. subset([],[]).
  99. subset([_|Xs],Ys):-subset(Xs,Ys).
  100. subset([X|Xs],[X|Ys]):-subset(Xs,Ys).
  101.  
  102. set_member(X,[X|_]).
  103. set_member(X,[_|Xs]):-
  104.     set_member(X,Xs).
  105.