Advertisement
logicmoo

Untitled

Nov 3rd, 2019
809
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Prolog 10.93 KB | None | 0 0
  1. (base) root@gitlab:/opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/programk/prolog/programk# cat graphmaster.pl
  2. % ===================================================================
  3. % File 'graphmaster.pl'
  4. % Purpose: An Implementation in SWI-Prolog of Graphmaster Index
  5. % Maintainer: Douglas Miles
  6. % Contact: $Author: dmiles $@users.sourceforge.net ;
  7. % Version: 'graphmaster.pl' 1.0.0
  8. % Revision: $Revision: 1.7 $
  9. % Revised At: $Date: 2002/07/11 21:57:28 $
  10. % ===================================================================
  11.  
  12.  
  13. :- use_module(library(dictoo_lib)).
  14. :- use_module(library(globals_api)).
  15. :- set_prolog_flag(generate_debug_info, false).
  16. %:- cls.
  17. % :- use_module(library(wam_cl/init)).
  18.  
  19. :- include(hashmap_oo).
  20.  
  21. % ===================================================================
  22. % ===================================================================
  23. track_now(Graph):- track_now(Graph, inst).
  24. track_now(Graph, _Type):- hashtable_get(Graph, track_id, _), !.
  25. track_now(Graph, Type):- gensym(Type, I), oo_set(Graph, track_id, I).
  26.  
  27. %%isStar0(Word1):- member(Word1, [*, '_']).
  28. isStar0(X):-var(X), !, throw(isStar0(X)).
  29. isStar0('*').
  30. isStar0('_').
  31.  
  32. into_path(List, NList):- notrace((is_list(List), !, maplist(upcase_atom, List, NList))), !.
  33. into_path(List, NList):- atom(List), !, upcase_atom(List, NList).
  34. into_path(List, NList):- throw(into_path(List, NList)).
  35.  
  36. sameWords(Word1, Word2):-atom(Word1), atom(Word2), atoms_match0(Word1, Word2).
  37.  atoms_match0(Word1, Word2):- (isStar0(Word1);isStar0(Word2)), !, fail.
  38.  atoms_match0(Word1, Word1):-!.
  39.  atoms_match0(Word1, Word2):-into_path(Word1, WordO), into_path(Word2, WordO), !.
  40.  
  41. into_name(Graph, Name):- atom(Graph), !, ignore((Graph=Name)).
  42. into_name(Graph, Name):- is_hashtable(Graph), !, ignore((hashtable_get(Graph, name, Name))).
  43.  
  44. into_named_map(RB, Name, Graph):- oo_get(RB, Name, Graph), !.
  45. into_named_map(RB, Name, Graph):- hashtable_new(Graph), oo_set(Graph, name, Name), track_now(Graph), oo_set(RB, Name, Graph).
  46.  
  47.  
  48. :- nb_current('$graphs', _) -> true ; (hashtable_new( RB), nb_setval('$graphs', RB)).
  49. into_graph(Name):- atom(Name), into_graph(Name, _O).
  50. into_graph(Graph):- into_graph(_, Graph).
  51. into_graph(Name, Graph):-  is_hashtable(Graph), !, ignore((hashtable_get(Graph, name, Name))).
  52. into_graph(Name, Graph):-
  53.  ignore(Name=graphmaster),
  54.  into_name(Name, GName),
  55.  nb_getval('$graphs', RB),
  56.  into_named_map(RB, GName, Graph).
  57.  
  58. :- nb_current('$states', _) -> true ; (hashtable_new( RB), nb_setval('$states', RB)).
  59. into_state(Name):- atom(Name), into_state(Name, _O).
  60. into_state(State):- into_state(_, State).
  61. into_state(Name, Graph):-  is_hashtable(Graph), !, ignore((hashtable_get(Graph, name, Name))).
  62. into_state(Name, State):-
  63.  ignore(Name=statemaster),
  64.  into_name(Name, GName),
  65.  nb_getval('$states', RB),
  66.  into_named_map(RB, GName, State).
  67.  
  68. hashtable_set_props(Graph, Props):- is_list(Props), !,
  69.   maplist(hashtable_set_props(Graph), Props).
  70. hashtable_set_props(Graph, HT):-
  71.   is_hashtable(HT),hashtable_pairs(HT,Pairs),!,
  72.   hashtable_set_props(Graph, Pairs).
  73. hashtable_set_props(Graph, [P|Props]):- !,
  74.   hashtable_set_props(Graph, Props),
  75.   hashtable_set_props(Graph, P).
  76. hashtable_set_props(Graph, Props):-
  77.   (Props=..[Key, Value] -> true ; Props=..[_, Key, Value]),
  78.   hashtable_set(Graph, Key, Value).
  79.  
  80. hashtable_get_props(Graph, Props):- is_list(Props), !,
  81.   maplist(hashtable_get_props(Graph), Props).
  82. hashtable_get_props(Graph, Props):- compound(Props),
  83.   (Props=..[Key, Value] -> true ; Props=..[_, Key, Value]),
  84.   hashtable_get(Graph, Key, Value).
  85. hashtable_get_props(Graph, Props):- hashtable_pairs(Graph,Props).
  86.  
  87.  
  88. into_props(NState,Props,NPropsO):-
  89.  must(cate_states(NState,NCate)),
  90.  must(into_pairs(Props,Pairs)),
  91.  must(append(NCate,Pairs,NProps)),
  92.  flatten(NProps, NPropsO).
  93.  
  94. cate_states(NState,NCate):-into_pairs(NState, Pairs),
  95.    include(cate_state,Pairs,NCate).
  96.  
  97. cate_state(N=_):- cate_prop(N).
  98. cate_prop(pattern).
  99. cate_prop(template).
  100.  
  101. into_pairs(Graph, Props):- \+ compound(Graph),!,Props=Graph.
  102. into_pairs(Graph, Props):- into_pairs_now(Graph, Pairs),flatten([Pairs],Props),!.
  103.  
  104. into_pairs_now(Graph, Props):- is_list(Graph), !,
  105.   maplist(into_pairs_now,Graph,Props).
  106. into_pairs_now(Graph, Props):- \+ compound(Graph),!,Props=Graph.
  107. into_pairs_now(Graph, Props):- is_hashtable(Graph),!,
  108.   hashtable_pairs(Graph,Props).
  109. into_pairs_now(Props, [Key=Value]):- compound(Props),
  110.   (Props=..[Key, Value] -> true ; Props=..[_, Key, Value]).
  111.  
  112.  
  113. % ===================================================================
  114. % ===================================================================
  115. set_template(Path, Template, Graph):- into_state(State),set_pathprops( State, Path, template(Template), Graph).
  116.  
  117. get_template(Path, Template, Graph):- into_state(State),get_pathprops( State, Path, template(Template), Graph).
  118.  
  119.  
  120. % ===================================================================
  121. % ===================================================================
  122. set_pathprops(Path, Props, Graph):- set_pathprops(_State, Path, Props, Graph).
  123. set_pathprops(State, Path, Props, Graph):-
  124.  must(notrace((into_state(State, NState),
  125.           into_path(Path, NPath),
  126.           into_props([pattern=Path|NState],Props,NProps),
  127.           into_graph(Graph, NGraph)))),
  128.  set_pathprop_now(NState, NPath, NProps, NGraph).
  129.  
  130. set_pathprop_now(_State, [], Props, Graph):- !,
  131.  must(compound(Props)),
  132.  hashtable_set_props(Graph, Props).
  133.  
  134. set_pathprop_now( State, [W1|More], Props, Graph):- !,
  135.  ( hashtable_get(Graph, W1, Next)
  136.    -> set_pathprop_now( State, More, Props, Next)
  137.     ; (hashtable_new(NewNode),
  138.        set_pathprop_now( State, More, Props, NewNode),
  139.        hashtable_set(Graph, W1, NewNode))).
  140.  
  141.  
  142. % ===================================================================
  143. % ===================================================================
  144. get_pathprops(Path, Props, Graph):- get_pathprops(_State, Path, Props, Graph),!.
  145. get_pathprops( State, Path, Props, Graph):-
  146.  term_variables(Props,PropsV),
  147.  notrace((into_state(State, NState),
  148.           into_path(Path, NPath),
  149.           into_props([pattern=Path|NState],Props,NProps),
  150.           into_graph(Graph, NGraph))),
  151.  get_pathprops_now(NState, NPath, NProps, NGraph),!,
  152.  ignore((PropsV==[Props], flatten(NProps,Props))).
  153.  
  154. get_pathprops_now( State, [W1|More], Props, Graph):- !,
  155.  hashtable_get(Graph, W1, Next),
  156.  get_pathprops_now( State, More, Props, Next).
  157. get_pathprops_now(_State, _, Props, Graph):-
  158.  hashtable_get_props(Graph, Props).
  159.  
  160.  
  161.  
  162. % ===================================================================
  163. % ===================================================================
  164. path_match(State, Path, Graph, Result):-
  165.  must(notrace((into_state(State, NState),
  166.           into_path(Path, NPath),
  167.           into_graph(Graph, NGraph)))),
  168.  path_match_now(NState, NPath, NGraph, Result).
  169.  
  170. path_match_now(_State, [], Graph, Result):- !, get_template([], Result, Graph).
  171. % exact match
  172. path_match_now(State, [Input|List], Graph, Result):-
  173.  into_path(Input,InputM),
  174.  hashtable_get(Graph, InputM, GraphMid),
  175.  path_match_now(State, List, GraphMid, Result).
  176. % ^ match
  177. path_match_now(State, InputList, Graph, Result):-
  178.  hashtable_get(Graph, '^', ComplexHT),
  179.  complex_match(State, 0, InputList, ComplexHT, Result).
  180. % * match
  181. path_match_now(State, [Input|List], Graph, Result):-
  182.  hashtable_get(Graph, '*', ComplexHT),
  183.  complex_match(State, 1, [Input|List], ComplexHT, Result).
  184.  
  185.  
  186. complex_match(State, Min, InputList, ComplexHT, Result):-
  187.  member(NextWord, InputList),
  188.  into_path(NextWord,NextWordU),
  189.  hashtable_get(ComplexHT, NextWordU, GraphNext),
  190.  append(Left, [NextWord|Right], InputList),
  191.  length(Left, LL), LL>Min,
  192.  %Star = [Input|Left],
  193.  %set_state(State, star, Left),
  194.  path_match_now(State, Right, GraphNext, Result).
  195.  
  196.  
  197. %%REAL-UNUSED set_matchit1(StarName, Pattern, Matcher, OnBind):- length(Pattern, MaxLen0), MaxLen is MaxLen0 + 2,
  198. %%REAL-UNUSED set_matchit2(StarName, Pattern, Matcher, MaxLen, OnBind).
  199.  
  200.  
  201. :- into_graph(_, _).
  202.  
  203. %:- rtrace(set_template([a, b1, c], template_a_b1_c, _)).
  204. %:- set_template([a, b2, c], template_a_b2_c, _).
  205. :- set_template([a, b, c, d, e], abcde, _).
  206. :- set_template([a, b, c2, d, e], abccde, _).
  207. :- set_pathprops([a, b, c2, d, e], pattern([a, b, c2, d, e]), _).
  208. :- set_pathprops([a, b, c2, d, e], [a=aaaa,b=bbbb], _).
  209. :- set_template([a, b, c2, d, e], abc2de, _).
  210. :- set_template([a, b, *, e], ab_e, _).
  211. :- show_name_values.
  212. (base) root@gitlab:/opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/programk/prolog/programk# cat hashmap_oo.pl
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219. is_hashtable(Tree):- is_rbtree(Tree).
  220. hashtable_new(Tree):- rb_new(Tree).
  221. hashtable_lookup(Key, Val, Tree):- rb_lookup(Key, Val, Tree).
  222.  
  223. hashtable_get(Tree, Key, Val):- rb_lookup(Key, Val, Tree).
  224.  
  225. hashtable_insert(UDT,Key,Value,NewUDT):- rb_insert(UDT,Key,Value,NewUDT).
  226.  
  227. nb_hashtable_insert(UDT,Key,Value):- nb_rb_insert(UDT,Key,Value),!.
  228.  
  229. hashtable_set(UDT,Key,Value):- notrace(nb_hashtable_get_node(Key,UDT,Node)
  230.  -> nb_hashtable_set_node_value(Node, Value)
  231.  ; (rb_insert(UDT,Key,Value,NewUDT),
  232.  arg(1,NewUDT,Arg1),duplicate_term(Arg1,Arg1D),nb_setarg(1,UDT,Arg1D),
  233.  arg(2,NewUDT,Arg2),duplicate_term(Arg2,Arg2D),nb_setarg(2,UDT,Arg2D))).
  234.  
  235.  
  236. nb_hashtable_set_node_value(Node, Value):- nb_rb_set_node_value(Node, Value).
  237. nb_hashtable_get_node(Key, Tree, Node):- nb_rb_get_node(Key, Tree, Node).
  238.  
  239.  
  240. hashtable_pairs(Var,VarO):- var(Var),!,Var=VarO.
  241. hashtable_pairs(Atomic,Atom):- \+ compound(Atomic),!,Atom=Atomic.
  242. hashtable_pairs(Tree,PairsO):- is_hashtable(Tree),!,rb_visit(Tree,Pairs),maplist(hashtable_pairs,Pairs,PairsO).
  243. hashtable_pairs(Pairs,PairsO):- is_list(Pairs),!,maplist(hashtable_pairs,Pairs,PairsO).
  244. hashtable_pairs(Props, [Key=ValueO]):- % compound(Props),
  245.   (Props=..[Key, Value] -> true ; Props=..[_, Key, Value]),
  246.   hashtable_pairs(Value,ValueO),!.
  247. hashtable_pairs(VV,VV).
  248.  
  249.  
  250.  
  251. (base) root@gitlab:/opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/programk/prolog/programk# swipl graphmaster.pl
  252.  
  253.  '$states'-statemaster-name == statemaster.
  254.  '$states'-statemaster-track_id == inst2.
  255.  
  256.  '$term_position' == '$stream_position'(8526,210,0,8526).
  257.  
  258.  '$loop_checker' == 1.
  259.  
  260.  '$xform_arity' == xform_arity(_252,_254,_256).
  261.  
  262.  '$term_user' == :-show_name_values.
  263.  
  264.  '$graphs'-graphmaster-'A'-'B'-(*)-'E'-template == ab_e.
  265.  '$graphs'-graphmaster-'A'-'B'-'C'-'D'-'E'-template == abcde.
  266.  '$graphs'-graphmaster-'A'-'B'-'C2'-'D'-'E'-a == aaaa.
  267.  '$graphs'-graphmaster-'A'-'B'-'C2'-'D'-'E'-b == bbbb.
  268.  '$graphs'-graphmaster-'A'-'B'-'C2'-'D'-'E'-pattern == [a,b,c2,d,e].
  269.  '$graphs'-graphmaster-'A'-'B'-'C2'-'D'-'E'-template == abc2de.
  270.  '$graphs'-graphmaster-name == graphmaster.
  271.  '$graphs'-graphmaster-track_id == inst1.
  272.  
  273. % init_why(after('/opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/programk/prolog/programk/graphmaster.pl')).
  274. % init_why(after('/opt/logicmoo_workspace/packs_sys/small_adventure_games/prolog/programk/prolog/programk/graphmaster.pl')).
  275. % init_why(program).
  276. ?-
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement