1:-module(rsasak_forward_wa_star_h_add,[]).
2
3:- style_check(-singleton).
4
5:- use_module(library(prolog_pack)).
6:- if( \+ prolog_pack:current_pack(logicmoo_planners)).
7:- dynamic user:file_search_path/2.
8:- multifile user:file_search_path/2.
9:- prolog_load_context(directory,Dir),
10 DirFor = planner,
11 (( \+ user:file_search_path(DirFor,Dir)) ->asserta(user:file_search_path(DirFor,Dir));true),
12 absolute_file_name('../..',Y,[relative_to(Dir),file_type(directory)]),
13 (( \+ user:file_search_path(pack,Y)) ->asserta(user:file_search_path(pack,Y));true).
14:- attach_packs.
15:- initialization(attach_packs).
16:- endif.
17
18
19:- if( \+ user:file_search_path(pddl,_) ).
20:- prolog_load_context(directory,Dir),
21 must((absolute_file_name('../pddl',Y,[relative_to(Dir),file_type(directory)]),
22 (( \+ user:file_search_path(pddl,Y)) ->asserta(user:file_search_path(pddl,Y));true))).
23:- endif.
24
25:- expects_dialect(sicstus).
26:-use_module(library(timeout)).
27:-use_module(library(lists)).
28:-use_module(library(rsasak_pddl_parser)).
51
52pairfrom([Element1|Set], Element1, Element2, Residue) :-
53 select_20_faster(Element2, Set, Residue).
54pairfrom([Head|Tail], Element1, Element2, [Head|Rest]) :-
55 pairfrom(Tail, Element1, Element2, Rest).
56
57
58
62
63select_20_faster(X, [X|R], R ).
64select_20_faster(X, [A,X|R], [A|R] ).
65select_20_faster(X, [A,B,X|R], [A,B|R] ).
66select_20_faster(X, [A,B,C|L], [A,B,C|R]) :-
67 select_20_faster(X, L, R).
68
76
78
82command_line:-
83 prolog_flag(argv, [D,P]),
84 solve_files(D, P),
85 halt.
86
87
88
93
129
131
133solve_files(DomainFile, ProblemFile):-
134 parseDomain(DomainFile, DD, _),
135 parseProblem(ProblemFile, PP, _),
136 term_to_ord_term(DD, D),
137 term_to_ord_term(PP, P),
138 reset_statistic,
139 !,
140 time_out(solve(D, P, S), 500000, _Result), 141 show_statistic(P, S),
142 !.
143
144
145
148solve(D, P, Solution):-
149 get_init(P, I), bb_put(initState, I),
150 get_goal(P, G), bb_put(goalState, G),
151 get_metric(P, M), bb_put(metric, M),
152 get_actions(D, A), bb_put(actions, A),
153 get_objects(P, O), bb_put(objects, O),
154 make_init_state(IS),
155 search(IS, G, Solution).
156
157
161term_to_ord_term([], []).
162term_to_ord_term(A, A):-atomic(A), !.
163term_to_ord_term([H|T], R):-
164 term_to_ord_term(H, OH),
165 term_to_ord_term(T, OT),
166 ord_add_element(OT, OH, R), !.
168term_to_ord_term(T, OT):-
169 T =.. [F,P], !,
170 term_to_ord_term(P, OP),
171 OT =..[F,OP].
172term_to_ord_term(T, OT):-
173 T =.. [F,P|Ps],
174 NT=.. [F|Ps],
175 term_to_ord_term(P, OP),
176 term_to_ord_term(NT, ONT),
177 ONT =.. [_|OPs],
178 OT =.. [F,OP|OPs], !.
179
180
181
185mysubset([], _).
186mysubset([X|R], S):- member(X, S), mysubset(R, S).
187
188
189
192get_actions( domain(_, _, _, _, _, _, _, A), A).
193get_problem_name( problem(N, _, _, _, _, _, _, _, _), N).
194get_init( problem(_, _, _, _, I, _, _, _, _), I).
195get_goal( problem(_, _, _, _, _, G, _, _, _), G).
196get_metric( problem(_, _, _, _, _, _, _, M, _), M).
197get_objects( problem(_, _, _, O, _, _, _, _, _), O).
198get_precondition( action(_, _, P, _, _, _), P).
199get_positiv_effect( action(_, _, _, PE, _, _), PE).
200get_negativ_effect( action(_, _, _, _, NE, _), NE).
201get_assign_effect( action(_, _, _, _, _, AE), AE).
202get_parameters( action(_, P, _, _, _, _), P).
203get_action_def( action(Name, Params, _, _, _, _), F):-
204 untype(Params, UP),
205 F =.. [Name|UP].
206
207
209get_action(A):-
210 get_action(A, _).
211get_action(A, ActionDef):-
212 bb_get(actions, As),
213 member(Afree, As),
214 copy_term_spec(Afree, A),
216 get_action_def(A, ActionDef).
217
218
219get_goal(G):-bb_get(goalState, G).
220get_init(I):-bb_get(initState, I).
221
223untype([], []).
224untype([H|T], [U|Us]):- compound(H), H =.. [_T, [U]], !, untype(T, Us).
225untype([H|T], [H|Us]):- untype(T, Us).
226
228setInit([], []).
229setInit([set(F, V)|Ls], S):-
230 F =.. A,
231 concat_atom(A, '-', CA),
232 bb_put(CA, V),
234 setInit(Ls, S), !.
235setInit([A|Ls], [A|Ss]):-
236 setInit(Ls, Ss).
237
239concat_atom([E1, E2], D, O):-
240 atom_concat(E1, D, Temp),
241 atom_concat(Temp, E2, O).
242concat_atom([H|T], D, O):-
243 concat_atom(T, D, Ts),
244 atom_concat(H, D, Temp),
245 atom_concat(Temp, Ts, O).
246
247
251copy_term_spec(A,B):- cp(A,[],B,_).
252
253cp(A,Vars,A,Vars):- atomic(A), A\= ?(_).
254cp(?(V),Vars,NV,NVars):- atomic(V), register_var(V,Vars,NV,NVars).
255cp(V,Vars,NV,NVars):- var(V),register_var(V,Vars,NV,NVars).
256
257cp(Term,Vars,NTerm,NVars):-
258 compound(Term),
259 Term \= ?(_),
260 Term=..[F|Args], 261 cp_args(Args,Vars,NArgs,NVars),
262 NTerm=..[F|NArgs]. 263cp_args([H|T],Vars,[NH|NT],NVars):- cp(H,Vars,NH,SVars),
264cp_args(T,SVars,NT,NVars).
265cp_args([],Vars,[],Vars).
266
269register_var(V,[X/H|T],N,[X/H|NT]):-
270 V\==X, 271 register_var(V,T,N,NT).
272register_var(V,[X/H|T],H,[X/H|T]):-
273 V==X. 274register_var(V,[],N,[V/N]).
275
276
277
280minOfList([X|Xs], Min):-
281 minOfList(Xs, X, Min).
282minOfList([], Min, Min).
283minOfList([X|Xs], Min0, Min):-
284 ( X @< Min0 -> Min1 = X ; Min1 = Min0 ),
285 minOfList(Xs, Min1, Min).
286
287
288
289reset_statistic:-
290 bb_put(stat_nodes, 0),
291 statistics(runtime, [T,_]),
292 bb_put(startTime, T).
293
294show_statistic:-
295 bb_get(stat_nodes, N),
296 bb_get(startTime, T0),
297 statistics(runtime, [T1,_]),
298 statistics(memory, [M, _]),
299 T is T1-T0,
300 format('~3d sec ~d nodes ~d bytes~n', [T, N, M]).
301
303show_statistic(P, S):-
304 ground(S),
305 get_problem_name(P, Name),
306 bb_get(stat_nodes, N),
307 bb_get(startTime, T0),
308 statistics(runtime, [T1,_]),
309 statistics(memory, [M, _]),
310 T is T1-T0,
311 length(S, L),
312 format('~a ~3d ~d ~d ~d', [Name,T, N, M, L]),
313 solution_to_lisp(S),
314 nl, !.
315show_statistic(_, _).
316
317solution_to_lisp([]).
318solution_to_lisp([H|T]):-
319 H =.. [F|P],
320 write(' ('),
321 write(F),
322 write_list(P),
323 write(')'),
324 solution_to_lisp(T).
325
326write_list([]).
327write_list([H|T]):-
328 write(' '), write(H),
329 write_list(T).
330
331
332stat_node:-
333 bb_get(stat_nodes, N),
334 NN is N+1,
335 bb_update(stat_nodes, _, NN).
336
337
338
339space(0):-!.
340space(I):-
341 write(' '),
342 NI is I-1,
343 space(NI).
344
345writel([]):-nl.
346writel([H|T]):-
347 write(H),nl,
348 writel(T).
349
350w(X):-
351 attvar(X),
352 353 get_attrs(X,Attrs),!,write(=(X,Attrs)).
354
355w(X):-
356 var(X),!,
357 write(X).
358
359w(X):-
360 atomic(X),!,
361 write(X).
362w([H|T]):-
363 write('['), !,
364 w_list([H|T]),
365 write(']').
366w(X):-
367 compound(X),!,
368 X=..[F|L],
369 write(F),write('('),
370 w_params(L),
371 write(')').
372w_params([H]):-
373 w(H).
374w_params([H,H2|T]):-
375 w(H),write(','),
376 w_params([H2|T]).
377w_list([H]):-
378 w(H), !.
379w_list([H|T]):-
380 w(H),
381 write(','),
382 w_list(T).
383
385state_record(S, PS, A, D, [S, PS, A, D]).
386
388solution(SR, V, L):-
389 solution(SR, V, [], L).
390solution(SR, _, L, L):-
391 state_record(_, nil, nil, _, SR), !.
392solution(SR, V, R, L):-
393 state_record(_, PS, AD, _, SR),
394 state_record(PS, _, _, _, Previous),
395 member(Previous, V),
396 solution(Previous, V, [AD|R], L).
397
398
399
402
403 make_mutex(M):-
404 bagof(R1, forbiden_pair(R1), MA),
405 bagof(R2, forbiden_pair(MA, R2), MB),
408 union(MA, MB, M0),
411 clear_mutex1(M0, M1),
412 clear_mutex2(M1, M2),
413 clear_duplicates(M2, M).
414 415
416clear_duplicates([], []).
417clear_duplicates([H|T], R):-
418 member(M, T),
419 identical_but_for_variables(H, M),
420 !,
421 clear_duplicates(T, R).
422clear_duplicates([H|T], [H|R]):-
423 clear_duplicates(T, R).
424
425forbiden_pair(R):-
426 get_action(A),
427 get_positiv_effect(A, PE),
428 get_negativ_effect(A, NE),
429 member(P, PE),
430 member(Q, NE),
431 copy_term_spec(P-Q, R).
432forbiden_pair(MA, NR):-
433 member(P-Q, MA),
434 get_action(A),
435 get_precondition(A, Precond),
436 get_positiv_effect(A, PE),
437 member(R, Precond),
438 member(P, PE),
439 copy_term_spec(R-Q, NR).
440
441clear_mutex1([], []):-!.
442clear_mutex1([PP-QQ|T], M):-
443 (P-Q = PP-QQ ; P-Q = QQ-PP),
444 get_init(I),
445 select_20_faster(P, I, R),
446 member(Q, R),
448 clear_mutex1(T, M), !.
449clear_mutex1([P-Q|R], [P-Q|M]):-
450 clear_mutex1(R, M).
451
452clear_mutex2(M0, M):-
453 (select_20_faster(P-Q, M0, R) ; select_20_faster(Q-P, M0, R)),
454 get_action(A, _Def), get_precondition(A, Precond), get_positiv_effect(A, PE), get_negativ_effect(A, NE),
455 select_20_faster(P, PE, RPE),
456 \+ member(Q, NE),
457 (
458 member(Q, RPE) 459 ;
460 all_not_in(Precond, P, Q, M0) 461 ),
463
464 clear_mutex2(R, M), !.
465clear_mutex2(M0, M0).
466
467all_not_in([], _, _, _).
468all_not_in([P|T], P, Q, M):-
469 all_not_in(T, P, Q, M).
470all_not_in([R|T], P, Q, M):-
471 \+ (member(R-Q, M) ; member(Q-R, M)),
472 473 all_not_in(T, P, Q, M).
474
475
476
478check_mutex(S):-
479 bb_get(mutex, M),
480 pairfrom(S, P, Q, _),
481 (member(P-Q, M) ; member(Q-P, M)),
483 !, fail.
484check_mutex(_).
485
486
487identical_but_for_variables(X, Y) :-
488 \+ \+ (
489 copy_term(X, Z),
490 numbervars(Z, 0, N),
491 numbervars(Y, 0, N),
492 Z = Y
493 ). 498:- expects_dialect(sicstus).
499:-use_module(library(ordsets)).
500:-use_module(library(heaps)).
501
503search(I, _, Solution):-
504 a_star(I, Solution, _).
505
506
508a_star(S, A, C):-
509 state_record(S, nil, nil, 0, SR),
510 list_to_heap([0-SR], PQ),
511 a_star(PQ, [], A, C).
512
513
515a_star(PQ, _, 'NO SOLUTION', _):-
516 empty_heap(PQ),!.
517a_star(PQ, V, Solution, C):-
518 get_from_heap(PQ, C, SR, _),
519 state_record(S, _, _, _, SR),
520 is_goal(S),
524 solution(SR, V, Solution).
525
526a_star(PQ, V, Solution, C):-
527 get_from_heap(PQ, _K, SR, RPQ),
528 ord_add_element(V, SR, NV),
529 (bagof(K-NS, next_node(SR, PQ, NV, K, NS), NextNodes) ; NextNodes=[]),
532
533 add_list_to_heap(RPQ, NextNodes, NPQ),
534
535 stat_node,
536 a_star(NPQ, NV, Solution, C).
537
539next_node(SR, Q, V, E, NewSR):-
540 state_record(S, _, _, D, SR),
541 step(S, A, NewS),
542 state_record(NewS, _, _, _, Temp),
543 \+ my_ord_member(NewS, V),
544 heap_to_list(Q, PQL),
545 \+ member(Temp, PQL),
546 h(S, H),
547 E is 5*H+D,
548 ND is D+1,
549 state_record(NewS, S, A, ND, NewSR).
550
552add_list_to_heap(OH, [], OH).
553add_list_to_heap(OH, [K-D|T], NH):-
554 add_to_heap(OH, K, D, H),
555 add_list_to_heap(H, T, NH).
556
557my_ord_member(S, [SR|_]):-
558 state_record(S2, _, _, _,SR),
559 repeating(S, S2),
560 !.
561my_ord_member(S, [_|T]):-
562 my_ord_member(S, T).
570
571:-use_module(library(ordsets)).
572
573make_init_state(I):-
574 get_init(I),
575 get_goal(G),
576 bb_put(fictiveGoal, G).
577
578
579make_solution(S, S).
580
581step(State, ActionDef, NewState):-
582 get_action(A, ActionDef),
583 get_precondition(A, P), mysubset(P, State), 584 get_negativ_effect(A, NE), ord_subtract(State, NE, State2),
585 get_positiv_effect(A, PE), ord_union(State2, PE, NewState).
586
587is_goal(S):-
588 get_goal(G),
589 ord_subset(G, S).
590
591repeating(S1, S2):-
592 S1 = S2.
593
597
598h(S, E):-h_add(S, E).
602
603h_0(_, 0).
604
605h_diff(S, E):-
606 bb_get(fictiveGoal, G),
607 ord_subtract(G, S, I),
608 length(I, E).
609
610h_add(S, E):-
611 bb_get(fictiveGoal, G),
612 relax(S, G, E).
614
615relax(_, [], 0):-!.
616relax(S, G, E):-
617 subtract(G, S, Delta),
618 setof(P, relax_step(S, P), RS),
619 ord_union([S|RS], NS),
620 relax(NS, Delta, NE),
621 length(Delta, LD),
622 E is LD+NE.
623
624relax_step(State, PE):-
625 get_action(A), get_precondition(A, P),
626 mysubset(P, State),
627 get_positiv_effect(A, PE).
628
629
630
631h_addb([], 0).
632h_addb([H|T], E):-
633 bb_get(predicatesPrices, Ps),
634 member(H-Price, Ps),
635 h(T, Sum),
636 E is Sum + Price.
637
638
640init_heuristics(_):-!.
641init_heuristics_addb(InitState):-
642 relax_addb(InitState, InitState, 0, Ps),
643 bb_put(predicatesPrices, Ps).
644
645relax_addb(_, [], _D, []):-!.
646relax_addb(S, Delta, D, Ps):-
647 mark_by(Delta, D, Marked),
648 setof(P, relax_step(S, P), PE),
649 ord_union([S|PE], NS),
650 ord_subtract(NS, S, NewDelta),
651 ND is D+1,
652 relax_addb(NS, NewDelta, ND, NewPs),
653 ord_union(NewPs, Marked, Ps).
654
655 mark_by([], _, []).
656 mark_by([H|T], D, [H-D|NT]):-
657 mark_by(T, D, NT).
658
659
660
661
669
670:-set_prolog_stack(global, limit(16*10**9)).
671:-set_prolog_stack(local, limit(16*10**9)).
672:-set_prolog_stack(trail, limit(16*10**9)).
673
674command_line_sas:-
675 prolog_flag(argv, [D,P]),!,
676 solve_files(D, P),
677 halt.
678
679command_line_sas:- test_blocks, test_all.
680
681slow_on('blocks-07-0.pddl').
682slow_on('blocks-08-0.pddl').
683slow_on('blocks-09-0.pddl').
684
685min_sas(A,B,A):-A =< B,!.
686min_sas(_,A,A).
687
688
689must_filematch(string(A),string(B)):-!.
690must_filematch(A,B):-must((filematch(A,B))).
691
692
693test_all:-test_all(7).
694
695test_all(N):-
696 must_filematch(('./test/?*?/domain*.pddl'),_),!,
697 (forall(must_filematch(('./test/?*?/domain*.pddl'),E),
698 once(test_domain(E,N)))).
699
700
701test_all(N):-
702 must_filematch(('./test/?*?/domain*.pddl'),_),!,
703 (forall(must_filematch(('./test/?*?/domain*.pddl'),E),
704 once(test_domain(E,N)))).
705
706test_all(N):- expand_file_name(('./test/?*?/domain*.pddl'),RList),RList\=[],!,reverse(RList,List),
707 forall(member(E,List),once(test_domain(E,N))).
708
710
711
712first_n_elements(ListR,Num,List):-length(ListR,PosNum),min_sas(PosNum,Num,MinNum),length(List,MinNum),append(List,_,ListR),!.
713
714test_domain(DP):- t_l:loading_files,!,must(load_domain(DP)).
715test_domain(DP):- test_domain(DP,12).
716
717test_domain(DP,Num):- \+ atom(DP),forall((filematch(DP,FOUND),exists_file(FOUND)),test_domain(FOUND,Num)),!.
718test_domain(DP,Num):- \+ exists_file(DP),!, forall(filematch(DP,MATCH),(exists_file(MATCH),test_domain(MATCH,Num))).
719test_domain(DP,Num):-
720 format('~q.~n',[test_domain(DP)]),
721 directory_file_path(D,_,DP),directory_files(D,RList),reverse(RList,ListR),
722 sort(ListR,ListS),length(ListR,PosNum),min_sas(PosNum,Num,MinNum),length(List,MinNum),append(List,_,ListS),!,
723 forall(member(T,List),ignore((directory_file_path(D,T,TP),exists_file(TP),not(same_file(DP,TP)),
724 solve_files(DP,TP)))).
725
726
740
741load_domain(DP):- \+ atom(DP),forall((filematch(DP,FOUND),exists_file(FOUND)),load_domain(FOUND)),!.
742load_domain(DP):- \+ exists_file(DP),!, forall(filematch(DP,MATCH),((exists_file(MATCH),load_domain(MATCH)))).
743load_domain(DP):-
744 format('~q.~n',[load_domain(DP)]),
745 directory_file_path(D,_,DP),directory_files(D,RList),
746 forall(member(T,RList),ignore((directory_file_path(D,T,TP),exists_file(TP),load_file(TP)))).
747
748
749:-export(z2p/2).
750z2p(A,A).
751
752save_type_named(Type,Named,O):- doall(retract((is_saved_type(Type,Named,_):-_))),nop(ain((is_saved_type(Type,Named,A):-z2p(O,A)))).
753save_sterm(O):-nop((gensym(sterm,Named),save_type_named(sterm,Named,O))).
754
755
756test_blocks:- solve_files(('./test/blocks/domain-blocks.pddl'),
757 ('./test/blocks/blocks-03-0.pddl')), fail.
758test_blocks:- fail, expand_file_name(('./test/blocks/domain*.pddl'),RList),reverse(RList,List),
759 forall(member(E,List),once(test_domain(E))).
760test_blocks:- expand_file_name(('./test/?*?/domain*.pddl'),RList),reverse(RList,List),
761 forall(member(E,List),once(test_domain(E))).
762test_blocks.
763
764
766:-thread_local(t_l:loading_files).
767:-thread_local(t_l:hyhtn_solve/1).
769
770
771
772:- flag(time_used,_,0).
773:- flag(time_used_other,_,0).
774
775probfreecell:- solve_files('../pddl/benchmarks/freecell/domain.pddl', '../pddl/benchmarks/freecell/probfreecell-9-5.pddl').