Trip planner in Prolog

wyprawy.pro

%#!/usr/bin/env swipl -q -g main -s
%
% ^ Uncomment the line above and make this file executable
%   to turn it into a valid SWI Prolog script
%
% (c) Marek Stepniowski, 222149 <[email protected]>
:- dynamic edge/5.

% -----------------------
% Application entry point
% -----------------------
main :-
        current_prolog_flag(argv, Argv),
        append(_, [--|Av], Argv),
	!,
        main(Av).
main([File]) :-
	!,
	load_edges_file(File),
	menu.
% Error handling (wrong number of arguments)
main(_) :-
	write('Usage: ./wyprawy FILE\n\n'),
	write('FILE should contain a list of Prolog terms in the form:\n'),
	write('Name : (A, B, Kind, Length)\n'),
	halt.

% Sictus Prolog binary entry point
user:runtime_entry(start):-
	current_prolog_flag(argv, Av),
	main(Av).


% ---------
% Main loop
% ---------
%
% Shows the menu in a loop. The only way to get out of the menu is by
% writing 'koniec.' as an answer to one of the inputs (See exit_application/0).
menu :-
	wildcard_input('Podaj miejsce startu: ', A),
	wildcard_input('Podaj miejsce koncowe: ', B),
	constraint_input('Podaj warunki: ', KindC, LenC),
	write('\n'),
	write_all_paths(A, B, KindC, LenC),
	menu.

% write_all_paths(+A, +B, +KindC, +LenC)
%
% Write all paths from A to B to stdout, taking `KindC` and `LenC`
% constraints into account
%
% - `A` and `B` should be either atoms (place names) or variables.
% - `LenC` should be a list containing at most one term
%    dlugosc(constraint, k), where constraint = eq, lt, le, gt or ge
%    and k is a number. If it's empty that means there is no constraint.
% - `KindC` should be a fully resolved list of allowed kinds.
%    If it's empty, that means all kinds are allowed (no constraint).
%
% (First we must convert empty lists into nils).
write_all_paths(A, B, KindC, []) :-
	write_all_paths_normalized_lenc(A, B, KindC, nil).
write_all_paths(A, B, KindC, [LenC]) :-
	write_all_paths_normalized_lenc(A, B, KindC, LenC).

write_all_paths_normalized_lenc(A, B, [], LenC) :-
	write_all_paths_fully_normalized(A, B, nil, LenC).
write_all_paths_normalized_lenc(A, B, [H|T], LenC) :-
	write_all_paths_fully_normalized(A, B, [H|T], LenC).
% The LOOP!
write_all_paths_fully_normalized(A, B, KindC, LenC) :-
	path(A, B, KindC, LenC, Path, Len),
	write_path(Path, Len),
	write('\n'),
	fail; true.

% write_path(+Path, +Len)
% 
% Writes the path edges and length to stdout, taking care of formatting.
write_path([edge(A, B, Kind, _, Name)|Rest], Len) :-
	format('~w -(~w,~w)-> ~w', [A, Name, Kind, B]),
	write_path_rest(Rest, Len).
write_path_rest([], Len) :-
	format('~nDlugosc trasy: ~w.~n', Len).
write_path_rest([edge(_, B, Kind, _, Name)|Rest], Len) :-
	format(' -(~w,~w)-> ~w', [Name, Kind, B]),
	write_path_rest(Rest, Len).


% -----------------------
% Searching edge database
% -----------------------
%
% path(+A, +B, +KindC, +LenC, -Path, -Len)
%
% Calculates all the possible paths between `A` and `B`, taking care
% not to traverse any edge twice. Places can be visited multiple times.
% Takes into account the `KindC` and `LenC` constraints.
%
% - `A` and `B` should be either atoms (place names) or variables.
% - `LenC` should be a term dlugosc(constraint, k), where
%    constraint = eq, lt, le, gt or ge and k is a number.
%    It can also be nil, meaning that all lengths are allowed (no constraint).	   
% - `KindC` should be either a fully resolved list of allowed kinds
%    or nil, meaning that all kinds are allowed (no constraint).
path(A, B, KindC, LenC, Path, Len) :-
	path(A, B, KindC, LenC, [], 0, ReversePath, Len),
	allowed_len(Len, LenC),
	reverse(ReversePath, Path).

path(A, A, _, _, Path, Len, Path, Len).
path(A, B, KindC, LenC, PathSoFar, LenSoFar, Path, Len) :-
	edge(A, C, Kind, L, N),
	\+ member(edge(A, C, Kind, L, N), PathSoFar),
	allowed_kind(Kind, KindC),
	NewLen is LenSoFar + L,
	% Optimization: We want to break out of unsuccesful searches ASAP.
	allowed_partial_len(NewLen, LenC),
	path(C, B, KindC, LenC, [edge(A, C, Kind, L, N)|PathSoFar], NewLen, Path, Len).


% --------------------
% Handling constraints
% --------------------
%
% Allowed constraint specifications. Used mainly when validating user input.
allowed_constraint(dlugosc(X, Y)) :-
	allowed_length_operator(X),
	number(Y).
allowed_constraint(rodzaj(X)) :- atom(X).

% Allowed operators for length constraint.
allowed_length_operator(eq).
allowed_length_operator(lt).
allowed_length_operator(le).
allowed_length_operator(gt).
allowed_length_operator(ge).

% allowed_kind(+Kind, +KindC)
%
% `KindC` should be either a fully resolved list or nil, meaning all
% kinds are allowed (no constraint).
allowed_kind(_, nil).
allowed_kind(Kind, KindC) :- member(rodzaj(Kind), KindC).

% allowed_len(+Len, +LenC)
%
% Checks that a number `Len` doesn't violate a `LenC` constraint.
%
% `LenC` should be a term dlugosc(constraint, k), where
% constraint = eq, lt, le, gt or ge and k is a number.
% It can also be nil, meaning that all lengths are allowed
% (no constraint).
allowed_len(_, nil).
allowed_len(Len, dlugosc(eq, Len)).
allowed_len(Len, dlugosc(lt, LenC)) :- Len < LenC.
allowed_len(Len, dlugosc(le, LenC)) :- Len < LenC; Len = LenC.
allowed_len(Len, dlugosc(gt, LenC)) :- Len > LenC.
allowed_len(Len, dlugosc(ge, LenC)) :- Len > LenC; Len = LenC.

% allowed_partial_len(+Len, +LenC)
%
% Checks that a number greater or equal to `Len` doesn't violate a
% `LenC` constraint. You can think of `Len` as a length of partial
% path obtained during graph search.
%
% `LenC` should be a term dlugosc(constraint, k), where
% constraint = eq, lt, le, gt or ge and k is a number.
% It can also be nil, meaning that all lengths are allowed
% (no constraint).
allowed_partial_len(_, nil).
allowed_partial_len(Len, dlugosc(eq, LenC)) :- Len < LenC; Len = LenC.
allowed_partial_len(Len, dlugosc(lt, LenC)) :- Len < LenC.
allowed_partial_len(Len, dlugosc(le, LenC)) :- Len < LenC; Len = LenC.
allowed_partial_len(_, dlugosc(gt, _)).
allowed_partial_len(_, dlugosc(ge, _)).


% ---------------------
% Reading edge database
% ---------------------
load_edges_file(File) :-
	retractall(edge(_, _, _, _, _)),
        open(File, read, Stream),
        call_cleanup(load_edges(Stream),
                     close(Stream)).

load_edges(Stream) :-
        read(Stream, T),
        load_edges(T, Stream).

load_edges(end_of_file, _) :- !.
load_edges(T, Stream) :-
	T = Name:(A, B, Kind, Length),
	!,
        assert(edge(A, B, Kind, Length, Name)),
        read(Stream, NewT),
        load_edges(NewT, Stream).
% Error handling (invalid path database format)
load_edges(T, _) :-
	write('ERROR: Invalid database format:\n'),
	write('ERROR: load_edges/2: expected term Name: (A, B, Kind, Length) '),
	format('got: ~w.~n', T),
	halt.


% -------------------
% Handling user input
% -------------------
%
% wildcard_input(+Message, -Input)
%
% Asks a user for atom or a nil, where nil is converted to an
% unbounded variable. In case of an error, asks again.
wildcard_input(Message, Input) :-
	write(Message),
	read(T),
	parse_wildcard_input(T, Message, Input).

parse_wildcard_input(nil, _, _).
parse_wildcard_input(koniec, _, _) :- exit_application.
parse_wildcard_input(end_of_file, _, _) :- exit_application.
parse_wildcard_input(T, _, T) :- atom(T), !.
% Error handling (invalid input)
parse_wildcard_input(T, Message, Input) :-
	format('ERROR: Niepoprawne miejsce - ~w. Podaj atom lub nil.~n', T),
	wildcard_input(Message, Input).

% constraint_input(+Message, -KindC, -LenC)
%
% Asks a user for a list of constraints, where nil is treated as an
% empty list. In case of an error, asks again.
%
% `KindC` and `LenC` are guaranteed to be a valid list of constraints
% after constraint_input/3 finishes succesfully.
constraint_input(Message, KindC, LenC) :-
	write(Message),
	read(T),
	parse_constraint_input(T, Message, KindC, LenC).

parse_constraint_input(nil, _, [], []).
parse_constraint_input(koniec, _, _, _) :- exit_application.
parse_constraint_input(end_of_file, _, _, _) :- exit_application.
parse_constraint_input(Constraints, _, KindC, LenC) :-
	terms_to_list(Constraints, ConstraintList),
	divide_constraints(ConstraintList, KindC, LenC, nil),
	length(LenC, X), X < 2, !.
% Error handling (invalid input - unknown constraint)
parse_constraint_input(Constraints, Message, KindC, LenC) :-
	terms_to_list(Constraints, ConstraintList),
	divide_constraints(ConstraintList, _, InvalidLenC, invalid_constraint(T)),
	length(InvalidLenC, X), X < 2,
	!,
	format('ERROR: Niepoprawny warunek - ~w.~n', T),
	constraint_input(Message, KindC, LenC).
% Error handling (invalid input - too many length constraints)
parse_constraint_input(Constraints, Message, KindC, LenC) :-
	terms_to_list(Constraints, ConstraintList),
	divide_constraints(ConstraintList, _, InvalidLenC, nil),
	length(InvalidLenC, X), X > 1,
	write('ERROR: za duzo warunkow na dlugosc\n'),
	constraint_input(Message, KindC, LenC).

% divide_constraints(+Constraints, -KindC, -LenC, -Error)
%
% Divides contraint terms in `Constraints` list into two groups,
% according to their predicate names:
%    dlugosc -> `LenC`
%    rodzaj -> `KindC`
% The last argument `Error` is nil if all the terms were
% of proper form, in other cases it contains the first invalid term.
divide_constraints([], [], [], nil).
divide_constraints([rodzaj(X)|RestC], [rodzaj(X)|KindC], LenC, Error) :-
	allowed_constraint(rodzaj(X)),
	!,
	divide_constraints(RestC, KindC, LenC, Error).
divide_constraints([dlugosc(X, Y)|RestC], KindC, [dlugosc(X, Y)|LenC], Error) :-
	allowed_constraint(dlugosc(X, Y)),
	!,
	divide_constraints(RestC, KindC, LenC, Error).
divide_constraints([T|RestC], KindC, LenC, invalid_constraint(T)) :-
	\+ allowed_constraint(T),
	divide_constraints(RestC, KindC, LenC, _).

terms_to_list((T, Rest), [T|RestL]) :- terms_to_list(Rest, RestL), !.
terms_to_list((T), [T]).

% Writes a goodbye message and exits the application
exit_application :-
	write('\n'),
	write('Koniec programu. Milych wedrowek!\n'),
	halt.

% ---------
% Utilities
% ---------
reverse([], []).
reverse([H|T], L) :-
	reverse(T, R),
	append(R, [H], L).