[mercury-users] Aditi (was Re: Mercury in academic teaching?)

Simon Taylor staylr at netspace.net.au
Mon Nov 20 22:59:38 AEDT 2006


Richard O'Keefe wrote:
> I sometimes wonder whether something like Aditi might make a better
> introduction to logic programming. But Aditi's dead, isn't it?

Pretty much.

For anyone who is still interested in Aditi, I've finally completed
a (mostly) working version.  Let me know if you want a copy, but
don't use it to store anything you don't want to lose.

Unfortunately, the only way to make this usable in terms of stability,
performance and standard database features (like foreign keys,
triggers, etc, etc) would be to throw away the Aditi database entirely
and build on top of something like PostgreSQL instead.  To get decent
performance would still be a significant amount of work, since it would
require runtime query optimization and efficient creation and destruction
of temporary relations.

I've attached an example to give an idea of how it works.

Advantages of Mercury as a database query language:

- Seamless calling of database procedures from Mercury application code.
- Integrated, very expressive language, which is much easier to work
with than SQL's awful expression language.
- A more expressive data model, removing the need for kludges like NULL.
- Recursive queries (far less restricted than SQL).
- Type-safe updates.

Disadvantages:

- Huge gap between what the programmer writes and what the database
executes, which requires heroics from the compiler to get decent
performance.  The current compiler isn't quite heroic enough.
Runtime optimization would be necessary because there can be
significant differences in cost between different iterations of
a recursive query.  (IMHO runtime optimization is really necessary
for SQL too, but the vendors seem to get by without it).

The other consequence of the gap between source and execution is
that it is difficult for the programmer to predict or influence
the performance of a query.

- Recursive queries aren't actually that nice for non-trivial queries,
because they don't give enough control.  There's an example in the
attached flights database.  I wanted to write "return all routes that
are one or two hops longer than the shortest possible route", but with
a recursive query there's no nice way to do it without generating all
possible routes, then doing an aggregate and a selection.  It would
take AI-complete optimization technology to give acceptable performance.
In a more procedural language like PL/SQL, it would be simple to
incrementally generate routes a hop at a time, noting when the
destination is first reached and then stopping two iterations later.

Also, even simple recursive aggregate queries like bill of materials
require the programmer to understand modular stratification, which is
a bit much to expect (see <http://citeseer.ist.psu.edu/95250.html>).

Simon Taylor.


aditi.m
=======
%-----------------------------------------------------------------------------%
% Copyright (C) 1998-2000,2003,2006 University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%
% File: aditi.m
% Main author: stayl
%
% This module provides an interface to the Aditi deductive database
% system developed at the University of Melbourne.
%
% Aditi applications must be compiled with
%   `mmc --make --options-file $(INSTALLPATH)/lib/Mercury.options.aditi ...'
% Compilation with Mmake is not supported.
% 
% More information on writing and compiling programs which use this
% interface is available in
% - the "Aditi deductive database interface" section of the
% "Implementation-dependent extensions" chapter of the Mercury
% Language Reference Manual.
% - the "Using Aditi" chapter of the Mercury User's Guide.
%
% It is currently up to the application to ensure that any updates
% do not violate the determinism of a base relation. If any update
% does violate the determinism of a base relation, then the behaviour
% is undefined. However, updates of relations with unique B-tree
% indexes are checked to ensure that a key is not given multiple
% values. An exception will be thrown if this occurs.
%
% Compilation grade notes (see the section "Compilation model options"
% in the Mercury User's Guide for more information):
%
%	This module requires a compilation grade with conservative garbage 
%	collection. Any grade containing `.gc' in its name, such as
%	`asm_fast.gc' or `asm_fast.gc.tr', will do.
%
% 	When trailing is not being used (the compilation grade does not
% 	contain `.tr'), resources will sometimes not be cleaned up until
%	the end of a transaction.
%	If there is a commit across a nondet database call, or an exception
%	is thrown, or a database call is retried in the debugger, the output
%	relation from the call and its cursor will not be cleaned up until the
%	transaction ends.
%	It is up to the programmer to decide whether imposing the overhead
%	of trailing on the rest of the program is worthwhile.
%
%
% The transaction interface used here is described in
%	Kemp, Conway, Harris, Henderson, Ramamohanarao and Somogyi,
% 	"Database transactions in a purely declarative 
%		logic programming language", 
%	In Proceedings of the Fifth International Conference on Database
%	Systems for Advanced Applications, pp. 283-292.
%	Melbourne, Australia, 1-4 April, 1997.
%
%	This paper is also available as
%	Technical Report 96/45, Department of Computer Science, 
%	University of Melbourne, December 1996,
%	<http://www.cs.mu.OZ.AU/publications/tr_db/mu_96_45_cover.ps.gz>
%	and <http://www.cs.mu.OZ.AU/publications/tr_db/mu_96_45.ps.gz>.
%
%-----------------------------------------------------------------------------%
:- module aditi.

:- interface.

:- import_module bool, io, list.

:- type aditi.state.

% XXX This will change to unique when the mode system is fully implemented.
:- inst aditi_unique == ground.
:- mode aditi_di == in(aditi_unique).
:- mode aditi_uo == out(aditi_unique).
:- mode aditi_ui == in(aditi_unique).
:- mode aditi_mui == in(aditi_unique).

% Like `pred' but evaluated using Aditi.
% :- type aditi_pred(...).

:- type aditi.result(T)
	--->	ok(T)
	;	error(aditi.error, string).

:- type aditi.result
	--->	ok
	;	error(aditi.error, string).

:- type aditi.error
	--->	error_creating_client
	;	invalid_passwd
	;	too_many_connections
	;	invalid_ticket
	;	general_failure
	;	already_logged_in
	;	not_logged_in
	;	not_connected
	;	not_implemented
	;	abort
	;	bad_value
	;	bad_rl_code
	;	error_opening_relation
	;	security_violation
	;	unique_key_violation
	;	relation_or_cursor_not_open
	;	timeout
	;	determinism_error	% The number of solutions returned
					% for a procedure did not match
					% its determinism declaration.
	;	parse_error_in_tuple	% Aditi returned a tuple
					% which the Mercury interface
					% code could not understand.
	.

:- type aditi.exception
	--->	aditi.exception(aditi.error, string).

%-----------------------------------------------------------------------------%

	%
	% Connection management.
	%

:- type aditi.connection_info
	--->	direct	% Database embedded in the current process.

			% Not yet implemented.
	;	host(server :: string, port :: int, library_file :: string)
	.

:- type aditi.connection.

	% aditi.connect(Info, User, Passwd, Result).
	%
	% Only one connection is allowed per process.
	% LibFileName gives the filename of the `.so' library created
	% for this program.  If the program was compiled with
	% `--no-aditi-calls-mercury', this can be set to "".
:- pred aditi.connect(aditi.connection_info, string, string,
		aditi.result(aditi.connection), io.state, io.state).
:- mode aditi.connect(in, in, in, out, di, uo) is det.

:- pred aditi.connect_and_reset_database(aditi.connection_info, string, string,
		aditi.result(aditi.connection), io.state, io.state).
:- mode aditi.connect_and_reset_database(in, in, in, out, di, uo) is det.

:- pred aditi.disconnect(aditi.connection, aditi.result,
		io.state, io.state).
:- mode aditi.disconnect(in, out, di, uo) is det.

%-----------------------------------------------------------------------------%

	%
	% Transaction management.
	%

:- type aditi.transaction(T) == pred(T, aditi.state, aditi.state).
:- inst aditi.transaction == (pred(out, aditi_di, aditi_uo) is det).
:- inst aditi.transaction_cc == (pred(out, aditi_di, aditi_uo) is cc_multi).

	% aditi.transaction(Connection, Transaction, Result).
	%
	% Start a transaction with the Aditi database referred to by
	% Connection, call Transaction, returning ok(Result) if the
	% transaction is not aborted, or error(Error, Msg) if
	% the transaction fails.
	%
	% If Transaction throws an exception, the transaction will
	% be aborted and the exception will be rethrown to the caller.
	%
	% Predicates with `:- pragma aditi' or `:- pragma base_relation'
	% markers can only be called from within a transaction -- there
	% is no other way to get an `aditi.state' to pass to them.
:- pred aditi.transaction(aditi.connection, aditi.transaction(T),
		aditi.result(T), io.state, io.state).
:- mode aditi.transaction(in, in(aditi.transaction), out, di, uo) is det.
:- mode aditi.transaction(in, in(aditi.transaction_cc),
		out, di, uo) is cc_multi.

	% As above, except that it throws an exception if the
	% transaction is aborted.
:- pred aditi.transaction_exception(aditi.connection, aditi.transaction(T),
		T, io.state, io.state).
:- mode aditi.transaction_exception(in, in(aditi.transaction),
		out, di, uo) is det.
:- mode aditi.transaction_exception(in, in(aditi.transaction_cc),
		out, di, uo) is cc_multi.

%-----------------------------------------------------------------------------%

	%
	% Aggregates.
	%

	% aditi.aggregate(DB, Closure, UpdateAcc, ComputeInitial, Results)
	%
	% When called, the query Closure returns the relation to be 
	% aggregated over. This relation must have two attributes,
	% the first being the attribute to group by. The closure 
	% ComputeInitial computes an initial accumulator for each 
	% group given the first tuple in the group. The closure
	% UpdateAcc is called for each tuple in each group to 
	% update the accumulator. The outputs are the group-by element
	% and final accumulator for each group.
	%
	% `aditi.aggregate' may only be called within a predicate
	% marked with `:- pragma aditi'.
	%
	% For example, to compute a sum over relation `p/3' where
	% the first non-aditi.state attribute of `p' is the group-by
	% attribute:
	% 	aditi.aggregate(DB, p,
	%		(func(_, Attr, Acc) = Acc + Attr),
	%		(func(_, _) = 0),
	%		GrpBy, Sum).
:- pred aditi.aggregate(aditi.state,
		aditi_pred(aditi.state, GrpBy, NonGrpBy), 
		func(GrpBy, NonGrpBy, Acc) = Acc,
		func(GrpBy, NonGrpBy) = Acc, GrpBy, Acc).
:- mode aditi.aggregate(aditi_mui,
		pred(aditi_mui, out, out) is nondet, 
		func(in, in, in) = out is det,
		func(in, in) = out is det, out, out) is nondet.
:- mode aditi.aggregate(aditi_mui,
		pred(aditi_mui, out, out) is multi,
		func(in, in, in) = out is det,
		func(in, in) = out is det, out, out) is multi.

%-----------------------------------------------------------------------------%

	%
	% Database updates.
	%

	% For each base relation a function is automatically generated
	% with declaration
	%	`:- func <name>_<arity> = aditi_relation({T1, ...})',
	% where the tuple type in the return value contains all of the
	% arguments in the `:- pred' declaration minus the `aditi.state'
	% argument.
	%
	% For example, for `:- pred chain(aditi.state, int, int)' the
	% function `:- func chain_3 = aditi.relation({int, int})'
	% would be generated.
	%
	% `aditi.insert(chain_3, {1, 2}, !DB)' inserts the tuple
	% `chain(_, 1, 2)' into the database.
	% 
:- type relation(T).

	% Returns `yes' if the base relation exists.
:- pred relation_exists(aditi.state, relation(T)).
:- mode relation_exists(aditi_ui, in) is semidet.

	% Create an empty base relation and all of its indexes.
	%
	% It is an error if the relation already exists.
	% Throws an exception on any error.
:- pred create_relation(relation(T), aditi.state, aditi.state).
:- mode create_relation(in, aditi_di, aditi_uo) is det.

	% create_relation_and_bulk_insert(Rel, Closure, !DB) <=> (
	%	create_relation(Rel, !DB),
	%	bulk_insert(Rel, Closure, !DB)
	%
	% It is more efficient to add data before adding the indexes.
:- pred create_relation_and_bulk_insert(relation(T),
		aditi_pred(aditi.state, T),
		aditi.state, aditi.state).
:- mode create_relation_and_bulk_insert(in, in(pred(aditi_mui, out) is nondet),
		aditi_di, aditi_uo) is det.

	% create_relation_and_bulk_insert(Rel, Stream, !DB) <=> (
	%	create_relation(Rel, !DB),
	%	bulk_insert_from_stream(Rel, Stream, !DB)
	%
	% It is more efficient to add data before adding the indexes.
:- pred create_relation_and_bulk_insert_from_stream(relation(T),
		io.input_stream, aditi.state, aditi.state).
:- mode create_relation_and_bulk_insert_from_stream(in, in,
		aditi_di, aditi_uo) is det.

	% create_relation_and_bulk_insert(Rel, File, !DB) <=> (
	%	create_relation(Rel, !DB),
	%	bulk_insert_from_file(Rel, File, !DB)
	%
	% It is more efficient to add data before adding the indexes.
:- pred create_relation_and_bulk_insert_from_file(relation(T),
		string, aditi.state, aditi.state).
:- mode create_relation_and_bulk_insert_from_file(in, in,
		aditi_di, aditi_uo) is det.

	% Destroy a base relation.
	% It is an error for the relation not to exist before the call.
	% Throws an exception on any error.
:- pred destroy_relation(relation(T), aditi.state, aditi.state).
:- mode destroy_relation(in, aditi_di, aditi_uo) is det.

	% Insert a tuple into a base relation.
	% Throws an exception on any error.
:- pred insert(relation(T), T, aditi.state, aditi.state).
:- mode insert(in, in, aditi_di, aditi_uo) is det.

	% Insert all tuples returned by the given closure
	% into the base relation.
	% Throws an exception on any error.
:- pred bulk_insert(relation(T), aditi_pred(aditi.state, T),
		aditi.state, aditi.state).
:- mode bulk_insert(in, in(pred(aditi_mui, out) is nondet),
		aditi_di, aditi_uo) is det.

	% Insert all tuples in the given stream into the
	% base relation.
	% The input stream must contain one tuple per line.
	% The tuples must have format `{Arg1, Arg2, ...}.'.
	% Throws an exception on any error.
:- pred bulk_insert_from_stream(relation(T), io.input_stream,
		aditi.state, aditi.state).
:- mode bulk_insert_from_stream(in, in, aditi_di, aditi_uo) is det.

	% Insert all tuples in the given file into the
	% base relation.
	% The file name is the name of the file on the server.
	% The input stream must contain one tuple per line.
	% The tuples must have format `{Arg1, Arg2, ...}.'.
	% Throws an exception on any error.
	%
	% XXX Currently this uses Aditi's broken term parser.
	% Brackets must be included for atoms (`atom()' rather than `atom').
	% Quotes, module qualification and operators are not supported.
	%
:- pred bulk_insert_from_file(relation(T), string, aditi.state, aditi.state).
:- mode bulk_insert_from_file(in, in, aditi_di, aditi_uo) is det.

	% Delete the given tuple from a base relation.
	% Throws an exception on any error.
:- pred delete(relation(T), T, aditi.state, aditi.state).
:- mode delete(in, in, aditi_di, aditi_uo) is det.

	% Delete all tuples returned by the given closure
	% from the base relation.
	% Throws an exception on any error.
:- pred bulk_delete(relation(T), aditi_pred(aditi.state, T),
		aditi.state, aditi.state).
:- mode bulk_delete(in, in(pred(aditi_mui, out) is nondet),
		aditi_di, aditi_uo) is det.

	% For each pair of tuples returned by the given closure,
	% delete the first tuple and insert the second.
	% Throws an exception on any error.
:- pred bulk_modify(relation(T), aditi_pred(aditi.state, T, T),
		aditi.state, aditi.state).
:- mode bulk_modify(in, in(pred(aditi_mui, out, out) is nondet),
		aditi_di, aditi_uo) is det.

%-----------------------------------------------------------------------------%

	% A slightly higher level interface for loading data into
	% base relations.
:- type rel
	---> some [T] relation(relation(T), rel_data(T)).

:- func rel(relation(T), rel_data(T)) = rel.

:- type rel_data(T)
	--->	file(string)
	;	view(aditi_pred(aditi.state, T))
	.

	% For each given base relation, destroy it if it already exists,
	% then create it and load the data.
:- pred setup_relations(list(rel)::in,
		aditi.state::aditi_di, aditi.state::aditi_uo) is det.

%-----------------------------------------------------------------------------%


flights.m
=========
% Flights database example from Aditi1, translated and extensively modified.
% This source file is hereby placed in the public domain. -stayl (the author).
%
% Queries a database of airline flights to find possible sequences
% of flights from a start airport to an end airport.
%
% Notes:
%
% This is horribly slow.  There are several reasons for this:

% - Mercury/Aditi doesn't have an atom type, so we're manipulating
% the full names of the cities at each step rather than an integer
% identifier.
% - Aditi2's performance with schemas and expressions manipulating
% compound terms is atrocious, at least partly because each schema
% keeps its own full copy of the type definitions which makes lots
% of conversion necessary.
% - Memoing would probably help in places if it worked.  I've manually
% created materialised views where I thought it would help.  In any case,
% memoing only lasts within one transaction, so a real system would need
% to do something like this anyway.
%
% This differs in a few ways from the Aditi1 code, mainly because
% the Aditi1 code cheated horribly (in their defence they were trying
% to get reasonable performance with 1993 computers).  It included a
% grotty hard-coded predicate to limit the feasible routes between
% cities which would not have allowed the system to find routes
% between some cities. This has been replaced by more general rules
% restricting the allowed routes between cities.
%
:- module flights.

:- interface.

:- import_module calendar.
:- import_module aditi, list.

%-----------------------------------------------------------------------------%

:- pred setup_flights(aditi.state::aditi_di, aditi.state::aditi_uo) is det.

:- func flights_rels = list(rel).

%-----------------------------------------------------------------------------%

% Base relations.

:- type days_later == int.
:- type airport == string.
:- type region == string.
:- type airline == string.
:- type flight_number == string.

:- pred gmt(aditi.state, airport, time) is nondet.
:- mode gmt(aditi_mui, in, out) is semidet.
:- mode gmt(aditi_mui, out, out) is nondet.
:- pragma base_relation(gmt/3).
:- pragma aditi_index(gmt/3, unique_B_tree, [2]).

:- pred region(aditi.state, airport, region).
:- mode region(aditi_mui, in, out) is semidet.
:- mode region(aditi_mui, out, out) is nondet.
:- pragma base_relation(region/3).
:- pragma aditi_index(region/3, unique_B_tree, [2]).

:- pred flight_weekly(aditi.state, airport, airport, time, time, days_later,
		airline, flight_number, day, date, date).
:- mode flight_weekly(aditi_mui, out, out, out, out, out, out, out,
		out, out, out) is nondet.
:- pragma base_relation(flight_weekly/11).
:- pragma aditi_index(flight_weekly/11, non_unique_B_tree, [2]).
:- pragma aditi_index(flight_weekly/11, non_unique_B_tree, [3]).

:- pred flight_daily(aditi.state, airport, airport, date, time, date, time,
		airline, flight_number).
:- mode flight_daily(aditi_mui, out, out, out, out, out, out,
		out, out) is nondet.
:- pragma base_relation(flight_daily/9).
:- pragma aditi_index(flight_daily/9, non_unique_B_tree, [2]).
:- pragma aditi_index(flight_daily/9, non_unique_B_tree, [3]).

:- pred direct_route(aditi.state::aditi_mui,
		airport::out, airport::out, airline::out) is nondet.
:- pragma base_relation(direct_route/4).
:- pragma aditi_index(direct_route/4, non_unique_B_tree, [2]).
:- pragma aditi_index(direct_route/4, non_unique_B_tree, [3]).

:- pred direct_route_between_regions(aditi.state::aditi_mui,
		region::out, region::out) is nondet.
:- pragma base_relation(direct_route_between_regions/3).
:- pragma aditi_index(direct_route_between_regions/3, non_unique_B_tree, [2]).
:- pragma aditi_index(direct_route_between_regions/3, non_unique_B_tree, [3]).

%-----------------------------------------------------------------------------%

% Route finding.

:- type arrival_or_departure
	---> arrival_or_departure(
		airport :: airport,
		date_and_time :: date_and_time
	).

:- type flight
	---> flight(
		flight_airline :: airline,
		flight_number :: flight_number,
		arrival_or_departure,
		arrival_or_departure
	).

:- type route_airline
	--->	mixed_airlines
	;	same_airline
	;	specific_airline(airline)
	.

:- type route == list(airport).

	% trip(DB, StartAirport, EndAirport, RouteAirline,
	%	DepartureDate, 
:- pred trip(aditi.state::aditi_mui, airport::in, airport::in,
		route_airline::in, date_and_time::in, date_and_time::in,
		time::in, list(flight)::out) is nondet.
:- pragma aditi(trip/8).

	% route(DB, StartAirport, EndAirport, RouteAirlineSpec,
	%	ActualRouteAirline, Route).
:- pred route(aditi.state::aditi_mui, airport::in, airport::in,
		route_airline::in, route_airline::out, route::out) is nondet.
:- pragma aditi(route/6).

	% route(DB, Region, StartAirport, EndAirport, RouteAirlineSpec,
	%	ActualRouteAirline, Route).
:- pred route_within_region(aditi.state::aditi_mui, region::in,
		airport::in, airport::in, route_airline::in,
		route_airline::out, route::out) is nondet.
:- pragma aditi(route_within_region/7).

%-----------------------------------------------------------------------------%

:- implementation.

:- import_module int, list, std_util.

setup_flights(!DB) :-
	setup_relations(flights_rels, !DB).
	
flights_rels = [
		%rel(flight_daily_9, file("DATA.flight_daily")),
		rel(flight_weekly_11, file("DATA.flight_weekly")),
		rel(gmt_3, file("DATA.gmt")),
		rel(region_3, file("DATA.place")),
		rel(direct_route_4, view(direct_route_view)),
		rel(direct_route_between_regions_3,
		view(direct_route_between_regions_view)),
		rel(hub_4, view(hub_view))
	].

trip(DB, From, To, Airline0, Earliest, Latest, Stime, Flights) :-
	route(DB, From, To, Airline0, Airline, Route),
	Route = [From | Rest],
	route_to_trip(DB, From, Rest, Airline,
		Earliest, Latest, Stime, Flights).

route(DB, Airport1, Airport2, Airline0, Airline,
		list.remove_adjacent_dups(Route)) :-
	route_2(DB, Airport1, Airport2, Airline0, Airline, Route).

	% We only consider routes that go via at most
	% one intermediate region.
:- pred route_2(aditi.state::aditi_mui, airport::in, airport::in,
		route_airline::in, route_airline::out,  route::out) is nondet.
:- pragma aditi(route_2/6).

route_2(DB, Airport1, Airport2, !Airline, Route) :-
	region(DB, Airport1, Region1),
	region(DB, Airport2, Region2),
	(
		Region1 = Region2,
		route_within_region(DB, Region1, Airport1, Airport2,
			!Airline, Route)
	;
		Region1 \= Region2,
		direct_route_between_regions(DB, Region1, Region2),
		route_to_hub(DB, Airport1, Region1Hub,
			Region2, !Airline, Region1Route),
		direct_route(DB, Region1Hub, Region2Hub, !Airline),
		route_to_hub(DB, Airport2, Region2Hub, Region1,
			!Airline, Region2Route),
		Route = Region1Route ++ Region2Route
	;
		Region1 \= Region2,
		\+ direct_route_between_regions(DB, Region1, Region2),

		% We're going via an intermediate region,
		% e.g. Sydney -> Singapore -> London
		region_route(DB, Region1, IntRegion, Region2),

		% Find a route to the hub in the start region.
		route_to_hub(DB, Airport1, Region1Hub,
			IntRegion, !Airline, Region1Route),

		hub(DB, IntRegionHub1, IntRegion, Region1),
		direct_route(DB, Region1Hub, IntRegionHub1, !Airline),

		% Find a route to a hub in the intermediate region
		% that will take us to the destination region.
		route_to_hub(DB, IntRegionHub1, IntRegionHub2,
			Region2, !Airline, IntRegionRoute),

		direct_route(DB, IntRegionHub2, Region2Hub, !Airline),

		% Find a route from the hub in the destination
		% region to the destination.
		route_to_hub(DB, Airport2, Region2Hub, IntRegion,
			!Airline, Region2Route),
		Route = Region1Route ++ IntRegionRoute ++ reverse(Region2Route)
	;
		% If either end is in a dead end region, we may need more
		% flights.  This case gets us out of the dead end region,
		% then recursively finds a route.
		Region1 \= Region2,
		( dead_end_region(Region1),
			DeadEndRegion = Region1,
			DeadEndAirport = Airport1,
			OtherAirport = Airport2
		; dead_end_region(Region2),
			DeadEndRegion = Region2,
			DeadEndAirport = Airport2,
			OtherAirport = Airport1	
		),
		\+ direct_route_between_regions(DB, Region1, Region2),
		\+ region_route(DB, Region1, _, Region2),
		route_to_hub(DB, DeadEndAirport, DeadEndRegionHub,
			OtherRegion, !Airline, DeadEndRoute),
		hub(DB, OtherHub, OtherRegion, DeadEndRegion),
		direct_route(DB, DeadEndRegionHub, OtherHub, !Airline),
		route(DB, OtherHub, OtherAirport, !Airline, RestRoute),
		Route0 = DeadEndRoute ++ RestRoute,
		( DeadEndRegion = Region1 ->
			Route = Route0
		;
			Route = reverse(Route0)
		)
	).

	% route_to_trip(DB, From, Rest, Airline, EarliestDtime, LatestDtime,
	%	Stime, Flights).   
	%
	% Finds flights which depart from From and arrive at To which depart
	% between the times Earliest and Latest and waiting for no more than
	% Stime hours at in-between stops. 
	%
:- pred route_to_trip(aditi.state::aditi_mui, airport::in, route::in,
	route_airline::in, date_and_time::in, date_and_time::in, time::in,
	list(flight)::out) is nondet.
:- pragma aditi(route_to_trip/8).

route_to_trip(_DB, _, [], _, _, _, _, []).
route_to_trip(DB, From, [Stop | Rest], Airline, EarliestDtime, LatestDtime,
		Stime, [Flight | Flights]) :-
	flight_during(DB, From, Stop, Airline, EarliestDtime, LatestDtime,
		Dtime, StopAtime, FlightAirline, FlightNum),
	Flight = flight(FlightAirline, FlightNum,
			arrival_or_departure(From, Dtime),
			arrival_or_departure(Stop, StopAtime)),

	StopEarliestDtime = add_time(StopAtime, 100),
	StopLatestDtime = add_time(StopAtime, Stime),

	route_to_trip(DB, Stop, Rest, Airline, StopEarliestDtime,
		StopLatestDtime, Stime, Flights).

	% flight_during(From, To, Airline, ET, LT, Departure, Arrival,
	%		Airline, FlightNumber).
	% Finds flights which depart between the times ET and LT.
:- pred flight_during(aditi.state::aditi_mui, airport::in, airport::in,
		route_airline::in, date_and_time::in, date_and_time::in,
		date_and_time::out, date_and_time::out,
		airline::out, flight_number::out) is nondet.
:- pragma aditi(flight_during/10).

flight_during(DB, From, To, Airline, ETime, LTime,
		{Ddate, Dtime}, {Adate, Atime}, FlightAirline, FlightNum) :- 
	DatesAndTimes = split_dates_and_times(ETime, LTime),
	member({Ddate, DETime, DLTime}, DatesAndTimes),
	day(Ddate, Day),
	flight_weekly(DB, From, To, Dtime, Atime, Incr,
		FlightAirline, FlightNum, Day, V_from, V_to),
	DETime =< Dtime, Dtime =< DLTime, 
	( Airline = specific_airline(FlightAirline)
	; Airline = mixed_airlines
	),
	no_earlier(Ddate, V_from),
	no_later(Ddate, V_to),
	Adate = later_date(Ddate, Incr).

:- pred hub(aditi.state::aditi_mui, airport::out,
		region::out, region::out) is nondet.
:- pragma base_relation(hub/4).
:- pragma aditi_index(hub/4, non_unique_B_tree, [3]).

:- pred hub_view(aditi.state::aditi_mui,
		{airport, region, region}::out) is nondet.
:- pragma aditi(hub_view/2).

	% A hub has flights into other regions.
hub_view(DB, {Airport, Region, OtherRegion}) :-
	region(DB, Airport, Region),
	direct_route(DB, Airport, OtherAirport, _),
	region(DB, OtherAirport, OtherRegion),
	Region \= OtherRegion.

:- pred dead_end_region(region).
:- mode dead_end_region(in) is semidet.
:- mode dead_end_region(out) is multi.

	% Don't try to construct a route from one region
	% to another through these regions.
dead_end_region("pacific").
dead_end_region("south_america").
dead_end_region("africa").

:- pred direct_route(aditi.state::aditi_mui, airport::in, airport::in,
		route_airline::in, route_airline::out) is nondet.
:- mode direct_route(aditi_mui, in, out, in, out) is nondet.
:- pragma aditi(direct_route/5).

direct_route(DB, Airport1, Airport2, !Airline) :-
	(
		!.Airline = specific_airline(Airline),
		direct_route(DB, Airport1, Airport2, Airline)
	;
		!.Airline = mixed_airlines,
		direct_route(DB, Airport1, Airport2, _)
	;
		!.Airline = same_airline,
		direct_route(DB, Airport1, Airport2, Airline),
		!:Airline = specific_airline(Airline)
	).

:- pred direct_route_view(aditi.state::aditi_mui,
		{airport, airport, airline}::out) is nondet.
:- pragma aditi(direct_route_view/2).

direct_route_view(DB, {Airport1, Airport2, Airline}) :-
	flight_weekly(DB, Airport1, Airport2, _, _, _, Airline, _, _, _, _).

:- pred direct_route_between_regions_view(aditi.state::aditi_mui,
		{region, region}::out) is nondet.
:- pragma aditi(direct_route_between_regions_view/2).

direct_route_between_regions_view(DB, {Region1, Region2}) :-
	direct_route(DB, Airport1, Airport2, _),
	region(DB, Airport1, Region1),
	region(DB, Airport2, Region2),
	Region1 \= Region2.

	% We only consider routes that go through one intermediate region.
	% e.g. Melbourne -> Singapore -> London, but not
	% Melbourne -> Singapore -> LA -> New York -> London.
:- pred region_route(aditi.state::aditi_mui,
		region::in, region::out, region::in) is nondet.
:- pragma aditi(region_route/4).

region_route(DB, StartRegion, StopRegion, DestRegion) :-
	\+ direct_route_between_regions(DB, StartRegion, DestRegion),
	StartRegion \= DestRegion,
	direct_route_between_regions(DB, StartRegion, StopRegion),
	\+ dead_end_region(StopRegion),
	direct_route_between_regions(DB, StopRegion, DestRegion).

	% Find routes to a hub in this region that can
	% take us to another region.
:- pred route_to_hub(aditi.state::aditi_mui, airport::in, airport::out,
		region::in, route_airline::in, route_airline::out,
		list(airport)::out) is nondet.
:- pragma aditi(route_to_hub/7).

route_to_hub(DB, Airport1, Hub, OtherRegion, !Airline, Route) :-
	region(DB, Airport1, Region),
	hub(DB, Hub, Region, OtherRegion),
	route_within_region(DB, Region, Airport1, Hub, !Airline, Route).

route_within_region(DB, Region, Airport1, Airport2, !Airline, reverse(Route)) :-
	route_within_region_2(DB, Region, Airport1, Airport2,
		!Airline, [Airport1], Route).

:- pred route_within_region_2(aditi.state::aditi_mui, region::in,
	airport::in, airport::in, route_airline::in, route_airline::out,
	list(airport)::in, list(airport)::out) is nondet.
:- pragma aditi(route_within_region_2/8).

route_within_region_2(DB, Region, Airport1, Airport2,
		!Airline, Route0, Route) :-
	% If there is a direct route, don't consider indirect routes.
	% XXX This is a bit too restrictive.  Maybe we should only
	% consider routes that are one or two hops longer than the
	% shortest route, but there is no efficient way to express that.
	(
		Airport1 = Airport2,
		Route = Route0
	;
		Airport1 \= Airport2,
		direct_route(DB, Airport1, Airport2, !Airline),
		Route = [Airport2 | Route0]
	;
		Airport1 \= Airport2,
		\+ direct_route(DB, Airport1, Airport2, !.Airline, _),
		direct_route(DB, Airport1, Stop, !Airline),
		\+ list.member(Stop, Route0),
		region(DB, Stop, Region),
		route_within_region_2(DB, Region, Stop, Airport2,
			!Airline, [Stop | Route0], Route)
	).


calender.m
==========
:- module calendar.

:- interface.

:- import_module list.
 
:- type date ---> date(year::int, month::int, day::int).

:- type date_and_time == {date, time}.
:- type time == int.	% In 24 hour format, e.g. 2330

	% Split the given time interval on day boundaries.
	% For example,
	% split_dates_and_times({date(2006, 1, 1), 400},
	%	{date(2006, 1, 2), 1600},
	%	[{date(2006, 1, 1), 400, 2359},
	%	{date(2006, 1, 2), 0, 1600}])
:- func split_dates_and_times(date_and_time, date_and_time) =
		list({date, time, time}).

:- func add_time(date_and_time, time) = date_and_time.

	% next(Date1) = Date2.
	% Date2 is the day following Date1.
:- func next(date) = date.

	% prev(Date1) = Date2.
	% Date2 is the day before Date1.
:- func prev(date) = date.

	% last_day(Y, M) = D
	% D is the last day of the month M in year Y.
:- func last_day(int, int) = int.

	% leap(Y)
	% Succeeds if Y is a leap year (according to the Gregorian system).
:- pred leap(int::in) is semidet.

	% before(Date1, Date2).
	% Succeeds if Date1 is (strictly) before Date2.
:- pred before(date::in, date::in) is semidet.

	% after(Date1, Date2).
	% Succeeds if Date1 is (strictly) after Date2. 
:- pred after(date::in, date::in) is semidet.

	% no_later(Date1, Date2)
	% Succeeds if Date1 is no later than Date2.
:- pred no_later(date::in, date::in) is semidet.

	% no_earlier(Date1, Date2)
	% Succeeds if Date1 is no earlier than Date2.
:- pred no_earlier(date::in, date::in) is semidet.

	% in_between(Date, Date1, Date2)
	% Succeeds if Date is between Date1 and Date2 (inclusive)
:- pred in_between(date::in, date::in, date::in) is semidet.

	% later_date(Date1, N, Date2)
	% Date2 is N days later than Date1.
:- func later_date(date, int) = date.

:- func days_later(date, date) = int.

:- type day ---> mon; tue; wed; thu; fri; sat; sun.

	% day(date(D,M,Y), Day)
	% The date D/M/Y falls on day Day.
	% This is only correct for years between 1901 and 2099.
:- pred day(date::in, day::out) is det.

	% advance(Day1, N, Days)
	% Day2 is N days later in the week than Day1.
:- pred advance(day::in, int::in, day::out) is det.

	% days(Year, YearDays).
:- pred days(int::in, int::out) is det.

:- pred day_pos(day, int).
:- mode day_pos(in, out) is det.
:- mode day_pos(out, in) is semidet.
:- mode day_pos(out, out) is multi.

:- implementation.

:- import_module list, int, require, std_util.

split_dates_and_times({D1, T1}, {D2, T2}) =
	( D1 = D2 ->
		[{D1, T1, T2}]
	;
		[{D1, T1, 2359} |
				split_dates_and_times({next(D1), 0}, {D2, T2})]
	).

add_time({D0, T1}, T2) = {D, T} :-
	some [!H, !M] (
		!:H = (T1 // 100) + (T2 // 100),
		!:M = (T1 rem 100) + (T2 rem 100),
		( !.M >= 60 ->
			!:M = !.M - 60,
			!:H = !.H + 1
		;
			true
		),
		D = later_date(D0, !.H // 24),
		!:H = !.H rem 24,
		T = !.H * 100 + !.M
	).

next(date(Y, M, D)) = Next :-
	( D = 31, M = 12 ->
		Next = date(Y + 1, 1, 1)
	; D = last_day(Y, M) ->
		Next = date(Y, M + 1, 1)
	;
		Next = date(Y, M, D + 1)
	).

prev(date(Y, M, D)) = Next :-
	( D = 1, M = 1 ->
		Next = date(Y - 1, 12, 31)
	; D = 1 ->
		Next = date(Y, M - 1, last_day(Y, M - 1))
	;
		Next = date(Y, M, D - 1)
	).

last_day(Y, M) = D :-
	( last_day2(D0, M, Y) ->
		D = D0
	;
		error("last_day")
	).

:- pred last_day2(int::out, int::in, int::in) is semidet.

last_day2(31,1,_).
last_day2(Day,2,Y) :- ( leap(Y) -> Day = 29 ; Day = 28 ).
last_day2(31,3,_).
last_day2(30,4,_).
last_day2(31,5,_).
last_day2(30,6,_).
last_day2(31,7,_).
last_day2(31,8,_).
last_day2(30,9,_).
last_day2(31,10,_).
last_day2(30,11,_).
last_day2(31,12,_).

leap(Y) :- Y mod 4 = 0, Y1 is Y mod 100, Y1 \= 0.
leap(Y) :- Y mod 4 = 0, Y mod 400 = 0.

before(date(Y1,_,_), date(Y2,_,_)) :- Y1 < Y2.
before(date(Y1,M1,_), date(Y2,M2,_)) :- Y1 = Y2, M1 < M2.
before(date(Y1,M1,D1), date(Y2,M2,D2)) :- Y1 = Y2, M1 = M2, D1 < D2.

after(date(Y1,_,_), date(Y2,_,_)) :- Y1 > Y2.
after(date(Y1,M1,_), date(Y2,M2,_)) :- Y1 = Y2, M1 > M2.
after(date(Y1,M1,D1), date(Y2,M2,D2)) :- Y1 = Y2, M1 = M2, D1 > D2.

no_later(D, D).
no_later(D1, D2) :- before(D1, D2). 

no_earlier(D, D).
no_earlier(D1, D2) :- after(D1, D2). 

in_between(D, D1, D2) :-
	no_later(D, D2), no_earlier(D, D1).

later_date(D1, N) = 
	( N = 0 ->
		D1
	; N < 0 ->
		later_date(prev(D1), N + 1)
	;
		later_date(next(D1), N - 1)
	).

days_later(date(Y1, _, _) @ Date1, date(Y2, _, _) @ Date2) = N :-
	( Y1 = Y2 ->
		day_num(Date1, N1),
		day_num(Date2, N2),
		N = N2 - N1
	; Y2 > Y1 ->
		day_num(Date2, N2),
		EndPrevYear = date(Y2 - 1, 12, 31),
		N1 = days_later(Date1, EndPrevYear),
		N = N1 + N2
	;
		N0 = days_later(Date2, Date1),
		N = -N0
	).

day(date(Y0, M, D), Day) :-
	Y1 = (Y0 - 1990) mod 28,
	Y2 = (Y1 >= 0 -> Y1 ; Y1 + 28),
	base(Y2, B),
	( first_day(B, Day1) ->
		day_mod(date(Y0, M, D), N),
		advance(Day1, N, Day)
	;
		error("calendar.day")
	).

% base(N,M)
% Find the appropriate base M for years corresponding to N in the cycle.
:- pred base(int::in, int::out) is det.

base(N,M) :-
	( N mod 4 = 2 ->
		M is N // 4
	;
		reduce(N,N1),
		base(N1,M)
	).

:- pred reduce(int::in, int::out) is det.

reduce(N, N1) :-
	( N >= 11 ->
		N1 = N - 11
	;
		N1 = N + 17
	).

% first_day(Base, Day).
% Years corresponding to Base commence on day Day.
:- pred first_day(int::in, day::out) is semidet.

first_day(0, wed).
first_day(1, mon).
first_day(2, sat).
first_day(3, thu).
first_day(4, tue).
first_day(5, sun).
first_day(6, fri).

% day_mod(date(D,M,Y), N)
% The date D/M/Y is N days later in the week than the first day of the year.
:- pred day_mod(date::in, int::out) is det.

day_mod(date(Y,M,D), N) :-
	day_num(date(Y,M,D), N1), N is (N1 - 1) mod 7.

% day_num(date(D,M,Y), N)
:- pred day_num(date::in, int::out) is det.

day_num(date(Y,M,D), N) :-
	prev_months(M, Y, N1),
	N is N1 + D.

% prev_months(M, Y, N)
% The months prior to the month M have N days in total in year Y.
:- pred prev_months(int::in, int::in, int::out) is det.

prev_months(M, Y, N) :-
	( M = 1 ->
		N = 0
	;
		M1 = M - 1,
		D = last_day(Y, M1),
		prev_months(M1, Y, N1),
		N = N1 + D
	).

advance(Day1, N, Day2) :-
	day_pos(Day1, Num),
	N2 = (Num + N) mod 7,
	( day_pos(Day2a, N2) ->
		Day2 = Day2a
	;
		error("advance")
	).

days(Y, Days) :- ( leap(Y) -> Days = 366 ; Days = 365 ).

day_pos(mon, 0).
day_pos(tue, 1).
day_pos(wed, 2).
day_pos(thu, 3).
day_pos(fri, 4).
day_pos(sat, 5).
day_pos(sun, 6).
--------------------------------------------------------------------------
mercury-users mailing list
Post messages to:       mercury-users at csse.unimelb.edu.au
Administrative Queries: owner-mercury-users at csse.unimelb.edu.au
Subscriptions:          mercury-users-request at csse.unimelb.edu.au
--------------------------------------------------------------------------



More information about the users mailing list