rcsid('$Header$'). %------------------------------------------------------------------------------ % Copyright (C) 1990, 1991, 1992 D. Stott Parker % % This program is free software; you can redistribute it and/or modify % it under the terms of the GNU General Public License as published by % the Free Software Foundation; either version 1, or (at your option) % any later version. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program; if not, write to the Free Software % Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. % % D. Stott Parker UCLA Computer Science Department % +1 (213) 825-6871, 825-1322 secy. Los Angeles, CA 90024-1596 % stott@cs.ucla.edu U.S.A. %------------------------------------------------------------------------------ %------------------------------------------------------------------------------ % simple SVP implementation %------------------------------------------------------------------------------ % % The implementation is done here in Bop, a conditional rewrite rule language % and extension of Prolog, developed at UCLA. % % The examples here are drawn directly from the paper: % % D.S. Parker, E. Simon, P. Valduriez, % SVP -- a Model Capturing Sets, Streams, and Parallelism % 1992. % % In some cases we have changed the argument or statement order slightly % as a consequence of Bop's implementation. Prolog indexing is typically % restricted to the first argument of predicates, and Bop does not change % this. As a result, the first argument is used for the recursion argument, % whereas in the paper the last argument is typically used. % % Bop can be viewed as a lazy functional language. The '=>>' primitive % can be used to force evaluation explicitly when necessary. % %------------------------------------------------------------------------------ % SVP model primitives %------------------------------------------------------------------------------ % Here the infix operator '<>' is used as the collection constructor. % '{}' represents the empty collection. % {X} represents the collection containing one value X. % Thus ({1}<>{2})<>({3}<>{4}) is a balanced collection. % % By default, the '<>' operator is right associative, so the unparenthesized % collection {1}<>{2}<>{3}<>{4} is a (right-linear, list-like) sequence. %------------------------------------------------------------------------------ :- op(550,xfy,<>). ({}) <> S => S :- !. S <> ({}) => S :- !. S <> T => S <> T. ({}) => ({}). ({X}) => ({X}). emptycollection({}) => true :- !. emptycollection(_) => false. unitcollection({_}) => true :- !. unitcollection(_) => false. unitcollectionvalue({X}) => X. collection({}) => true :- !. collection({_}) => true :- !. collection(_<>_) => true :- !. collection(_) => false. atom(X) => true :- atomic(X), !. atom(_) => false. tuple(X) => true :- functor(X,t,_), !. tuple(_) => false. % tuples are represented as terms of form t(_,_,...,_) t(X1) => t(X1). t(X1,X2) => t(X1,X2). t(X1,X2,X3) => t(X1,X2,X3). t(X1,X2,X3,X4) => t(X1,X2,X3,X4). %------------------------------------------------------------------------------ % Collectors and other useful binary operators %------------------------------------------------------------------------------ :- op(400,xfy,(::)). % collection append :- op(400,xfy,(<>~)). % S <>~ T = T <> S :- op(400,xfy,(min)). % value min :- op(400,xfy,(max)). % value max :- op(400,xfx,(or)). % boolean or :- op(400,xfx,(and)). % boolean and :- op(400,xfx,(fst)). % X fst Y = X [not a collector] :- op(400,xfx,(snd)). % X snd Y = Y [not a collector] (S <>~ T) => T <> S. % reverse of <> (S :: T) => if emptycollection(S) then T else append1(S,T). append1({},_) => {}. append1({X},T) => {X} <> T. append1(S1<>S2,T) => append1(S1,append1(S2,T)). (A + B) => C :- A =>> X, B =>> Y, C is X+Y. (A * B) => C :- A =>> X, B =>> Y, C is X*Y. (A min B) => C :- A =>> X, B =>> Y, minValue(X,Y,C). (A max B) => C :- A =>> X, B =>> Y, maxValue(X,Y,C). minValue(X,Y,X) :- X =< Y, !. minValue(X,Y,Y) :- X > Y. maxValue(X,Y,X) :- X >= Y, !. maxValue(X,Y,Y) :- X < Y. true or true => true. true or false => true. false or true => true. false or false => false. true and true => true. true and false => false. false and true => false. false and false => false. (A - B) => C :- A =>> X, B =>> Y, C is X-Y. (A / B) => C :- A =>> X, B =>> Y, C is X/Y. (X fst _) => X. (_ snd X) => X. %------------------------------------------------------------------------------ % Diffs of a sequence or stream ([]-terminated sequence) %------------------------------------------------------------------------------ diffs(S) => diffs1(S,{}). diffs1({},_) => {}. diffs1({_},{}) => {} :- !. diffs1({[]},_) => {[]} :- !. diffs1({X},{Y}) => {D} :- D is X-Y. diffs1(S1<>S2,Q) => diffs1(S1,Q) <> diffs1(S2,S1). diffs_demo => diffs( {98}<>{99}<>{97}<>{97}<>{99}<>{96}<>{[]} ). %------------------------------------------------------------------------------ % Polygon example %------------------------------------------------------------------------------ :- [library(math_pl)]. % include Prolog sqrt() function total_area(Polygon) => sum(areas(triangles(Polygon))). triangles(S) => triangles1(S,t(_,_,_)). triangles1({},_) => {}. triangles1({P},Q) => output_triangle(NQ) :- next_triangle({P},Q,NQ). triangles1(S1<>S2,Q) => triangles1(S1,Q) <> triangles1(S2,NQ) :- next_triangle(S1,Q,NQ). output_triangle(Q) => {Q} :- complete_triangle(Q), !. output_triangle(_) => {}. complete_triangle(t(P0,P1,P2)) :- nonvar(P0), nonvar(P1), nonvar(P2). next_triangle({P},t(P0,_ ,P2),t(P0,P2,P)) :- nonvar(P2), !. next_triangle({P},t(P0,P1,_ ),t(P0,P1,P)) :- nonvar(P1), !. next_triangle({P},t(P0,_ ,_ ),t(P0,P,_)) :- nonvar(P0), !. next_triangle({P},t(_ ,_ ,_ ),t(P,_,_)). areas({}) => {0}. areas({t(P0,P1,P2)}) => {A} :- heron_area(P0,P1,P2,A). areas(S1<>S2) => areas(S1) <> areas(S2). heron_area(P0,P1,P2,Area) :- distance(P0,P1,A), distance(P1,P2,B), distance(P2,P0,C), S is (A+B+C)/2, AreaSq is S*(S-A)*(S-B)*(S-C), sqrt(AreaSq,Area). distance((X1,Y1),(X2,Y2),Distance) :- DistanceSq is (X1-X2)*(X1-X2) + (Y1-Y2)*(Y1-Y2), sqrt(DistanceSq,Distance). sample_polygon => {(0,0)} <> {(1,4)} <> {(5,6)} <> {(6,3)} <> {(4,-1)}. polygon_demo => total_area(sample_polygon). %------------------------------------------------------------------------------ % Restructuring %------------------------------------------------------------------------------ mirror({}) => {}. mirror({X}) => {X}. mirror(S1<>S2) => mirror(S1) <>~ mirror(S2). mirror_demo => mirror( ({1} <> {2}) <> ({3} <> ({4} <> {5})) ). %------------------------------------------------------------------------------ % Sequencing (flattening) a collection %------------------------------------------------------------------------------ naive_sequence(S) => sequence1(first_rest(S)). sequence1({}) => {}. sequence1({X}) => {X}. sequence1(S1<>S2) => sequence1(first_rest(S1)) <> sequence1(first_rest(S2)). first_rest(S) => first(S) <> rest(S). first({}) => {}. first({X}) => {X}. first(S1<>S2) => first(S1) fst first(S2). rest(S) => rest1(S,true). rest1({},_) => {}. rest1({X},Initial) => if Initial then {} else {X}. rest1(S1<>S2,Initial) => rest1(S1,Initial) <> rest1(S2,false). naive_sequence_demo => sequence( ({8}<>(({3}<>{1})<>(({7}<>{5})<>{9})))<>({4}<>{2}) ). sequence({}) => {}. sequence({X}) => {X}. sequence(S1<>S2) => sequence(S1) :: sequence(S2). sequence_demo => sequence( ({8}<>(({3}<>{1})<>(({7}<>{5})<>{9})))<>({4}<>{2}) ). streamify(S) => if nil_terminated(S) then sequence(S) else sequence(S<>{[]}). nil_terminated(S) => if last(S) = {[]} then true else false. last({}) => {}. last({X}) => {X}. last(S1<>S2) => last(S1) snd last(S2). %------------------------------------------------------------------------------ % Partitioning %------------------------------------------------------------------------------ :- op(650,xfx,(combine_partitions)). t(R1,R2) combine_partitions t(S1,S2) => t(R1S1,R2S2) :- R1<>S1 =>> R1S1, R2<>S2 =>> R2S2. partition_tree(t(P1,P2)) => P1 <> P2. partition(S,P) => partition_tree(partitionify(S,P)). partitionify({},_) => t({},{}). partitionify({X},P) => if P@X then t({X},{}) else t({},{X}). partitionify(S1<>S2,P) => partitionify(S1,P) combine_partitions partitionify(S2,P). partition_demo => partition( {a}<>{1}<>{2}<>{b}<>{3}, numeric). numeric => X \ (Num :- X =>> Xval, number(Xval) -> Num=true ; Num=false). %------------------------------------------------------------------------------ % Balancing %------------------------------------------------------------------------------ balance(S) => balance1(split(sequence(S))). balance1({}) => {}. balance1({X}) => {X}. balance1(S<>T) => balance1(split(S)) <> balance1(split(T)). split(S) => partition_tree(halves(sequence(S),1,N)) :- count(S) =>> N. halves({},_,_) => t({},{}). halves({X},I,N) => t({X},{}) :- I =< N/2, !. halves({X},_,_) => t({},{X}). halves(S1<>S2,I,N) => halves(S1,I,N) combine_partitions halves(S2,I1,N) :- I1 is I+1. balance_demo => balance( {a}<>{3}<>{1}<>{b}<>{5}<>{d}<>{4}<>{2} ). halves_demo => halves( {a}<>{3}<>{1}<>{b}<>{5}<>{d}<>{4}<>{2} ,1, 8). %------------------------------------------------------------------------------ % Grouping %------------------------------------------------------------------------------ :- op(650,xfy,(combine_groups)). group(H,S) => gather(hashify(S,H)). hashify({},_) => {}. hashify({X},H) => {t(HX,{X})} :- H@X =>> HX. hashify(S1<>S2,H) => hashify(S1,H) <> hashify(S2,H). gather(S) => gather1(sequence(S),{}). gather1({},_) => {}. gather1({X},Q) => insert(Q,{X}). gather1(S1<>S2,Q) => gather1(S1,Q) snd gather1(S2,insert(S1,Q)). insert({},_) => {}. insert({B},S0) => S1 :- insert1(S0,B) =>> t(true,S1), !. insert({B},S0) => S0 <> {B}. insert(S1<>S2,S0) => insert(S1,S0) snd insert(S2,insert(S1,S0)). insert1({},_) => t(false,{}). insert1({t(K1,S)},t(K,{X})) => t(true, {t(K,S<>{X})}) :- K=K1, !. insert1({t(K1,S)},_) => t(false,{t(K1,S)} ). insert1(S1<>S2,Q) => insert1(S1,Q) combine_groups insert1(S2,Q). t(B1,S1) combine_groups t(B2,S2) => t(B1orB2, S1S2) :- (B1 or B2) =>> B1orB2, S1<>S2 =>> S1S2. group_demo => group( crude_hash, {a}<>{b}<>{c}<>{d}<>{e}<>{f}<>{g} ). crude_hash => X \ (Hashvalue :- name(X,[C|_]), Hashvalue is C/\3). %------------------------------------------------------------------------------ % Simple Statistics %------------------------------------------------------------------------------ avg => avg. avg(S) => A :- sum(S) =>> T, count(S) =>> N, A is T/N. sum({}) => 0. sum({X}) => X. sum(S1<>S2) => sum(S1) + sum(S2). count({}) => 0. count({_}) => 1. count(S1<>S2) => count(S1) + count(S2). avg_demo => avg( {8}<>{3}<>{1}<>{7}<>{5}<>{9}<>{4}<>{2}<>{6} ). %------------------------------------------------------------------------------ % Sorting %------------------------------------------------------------------------------ sort(S) => sort(S, lessEq, first). sort(S,Ordering,MedianEstimate) => sort1( partition(S, (X\(Ordering@X@(MedianEstimate@S)))), Ordering, MedianEstimate ). sort1({},_,_) => {}. sort1({X},_,_) => {X}. sort1(S<>T,Ordering,MedianEstimate) => sort1( partition(S, (X\(Ordering@X@(MedianEstimate@S)))), Ordering, MedianEstimate) <> sort1( partition(T, (Y\(Ordering@Y@(MedianEstimate@T)))), Ordering, MedianEstimate). lessEq => (X \ Y \ (T :- X=>>A, Y=>>B, (compare(>,A,B) -> T=false ; T=true))). sort_demo => sort( {8}<>{3}<>{1}<>{7}<>{5}<>{9}<>{4}<>{2}, lessEq, avg). %------------------------------------------------------------------------------ % Generalized joins and Combine %------------------------------------------------------------------------------ combine(Map1,Map2,Test,Rslt,R,S) => combine1(R,S,Map1,Map2,Test,Rslt). combine1({}, _,_,_,_,_) => {}. combine1({P}, S,Map1,Map2,Test,Rslt) => combine2(Map1P,Map2PS,Test,Rslt) :- Map1@P =>> Map1P, Map2@P@S =>> Map2PS. combine1(P1<>P2,S,Map1,Map2,Test,Rslt) => combine1(P1,S,Map1,Map2,Test,Rslt) <> combine1(P2,S,Map1,Map2,Test,Rslt). combine2({}, _,_,_) => {}. combine2({X}, Si,Test,Rslt) => combine3(Si,{X},Test,Rslt). combine2(Ri1<>Ri2,Si,Test,Rslt) => combine2(Ri1,Si,Test,Rslt) <> combine2(Ri2,Si,Test,Rslt). combine3({}, _,_,_) => {}. combine3({Y}, {X},Test,Rslt) => if Test@X@Y then Rslt@X@Y else {}. combine3(Si1<>Si2, Q,Test,Rslt) => combine3(Si1,Q,Test,Rslt) <> combine3(Si2,Q,Test,Rslt). nested_loops_join(RJoinField,SJoinField,R,S) => combine( unit, % MAP1 second, % MAP2 matching_tuples(RJoinField,SJoinField), % TEST join_output(RJoinField,SJoinField), % RESULT R,S). unit => (X \ {X}). second => (_ \ Y \ Y). matching_tuples(RJoinField,SJoinField) => (Rtuple \ Stuple \ (Match :- tuple_field(RJoinField,Rtuple) =>> RField, tuple_field(SJoinField,Stuple) =>> SField, compare(C,RField,SField), (C == (=) -> Match = true ; Match = false)) ). join_output(RJoinField,SJoinField) => (Rtuple\ Stuple\ join_result(RJoinField,SJoinField,Rtuple,Stuple)). tuple_field(FieldNumber) => (Tuple \ (Field :- arg(FieldNumber,Tuple,Field))). tuple_field(FieldNumber,Tuple) => (Field :- arg(FieldNumber,Tuple,Field)). join_result(FieldNumber1,FieldNumber2,Tuple1,Tuple2) => {Tuple} :- tuple_args_except(Tuple1,FieldNumber1,List1), tuple_args_except(Tuple2,FieldNumber2,List2), appendList(List1,List2,OtherFields), arg(FieldNumber1,Tuple1,JoinField), Tuple =.. [t,JoinField|OtherFields]. tuple_args_except(Tuple,FieldNumber,List) :- functor(Tuple,t,Arity), tuple_args_except(0,Arity,Tuple,FieldNumber,List). tuple_args_except(N,N,_,_,[]) :- !. tuple_args_except(I0,Arity,Tuple,FieldNumber,List) :- I is I0+1, I == FieldNumber, !, tuple_args_except(I,Arity,Tuple,FieldNumber,List). tuple_args_except(I0,Arity,Tuple,FieldNumber,[Field|List]) :- I is I0+1, arg(I,Tuple,Field), tuple_args_except(I,Arity,Tuple,FieldNumber,List). appendList([],L,L). appendList([X|L1],L2,[X|L3]) :- appendList(L1,L2,L3). hash_join(RJoinField,SJoinField,R,S) => combine( group_bucket, % MAP1 matching_bucket, % MAP2 matching_tuples(RJoinField,SJoinField), % TEST join_output(RJoinField,SJoinField), % RESULT RGs, SGs ) :- group(tuple_field_hash(RJoinField),R) =>> RGs, group(tuple_field_hash(SJoinField),S) =>> SGs. group_bucket => (Group \ (Bucket :- Group = t(_Key,Bucket))). matching_bucket => (Group \ GroupCollection \ (MatchingBucket :- Group = t(Key,_Bucket), keyBucket(GroupCollection,Key) =>> MatchingBucket)). :- op(550,xfy,(select_bucket)). {} select_bucket G => G :- !. G select_bucket _ => G. keyBucket({}, _) => {}. keyBucket({t(Key1,Bucket)},Key) => Bucket :- Key1 == Key, !. keyBucket({t(_,_)}, _) => {}. keyBucket(S1<>S2, Key) => keyBucket(S1,Key) select_bucket keyBucket(S2,Key). tuple_field_hash(FieldNumber) => (Tuple \ (HashValue :- arg(FieldNumber,Tuple,Field), name(Field,[C|_]), name(HashValue,[C]))). tuple_field_hash(FieldNumber,Tuple) => (HashValue :- arg(FieldNumber,Tuple,Field), name(Field,[C|_]), name(HashValue,[C])). nested_loops_demo => nested_loops_join(1,1,emp,project). hash_join_demo => hash_join(1,1,emp,project). emp => {t( amiel, 39-63-59-65 )} <> {t( amsaleg, 39-63-52-55 )} <> {t( baque, 39-63-52-50 )} <> {t( bellosta, 39-63-59-65 )} <> {t( cheiney, 39-63-52-52 )} <> {t( cirio, 39-63-52-50 )} <> {t( darrieumerlou, 39-63-55-72 )} <> {t( daynes, 39-63-52-55 )} <> {t( de_maindreville, 39-63-56-19 )} <> {t( gardarin, 39-63-56-86 )} <> {t( gruber, 39-63-56-35 )} <> {t( kiernan, 39-63-56-19 )} <> {t( lanzelotte, 39-63-56-32 )} <> {t( parker, 39-63-59-64 )} <> {t( pucheral, 39-63-55-79 )} <> {t( simon, 39-63-52-52 )} <> {t( thevenin, 39-63-55-79 )} <> {t( valduriez, 39-63-52-51 )} <> {t( viallet, 39-63-55-79 )} <> {t( zait, 39-63-56-18 )} <> {t( ziane, 39-63-56-32 )}. project => {t( amiel, omnis )} <> {t( amsaleg, eos )} <> {t( baque, sabre )} <> {t( bellosta, omnis )} <> {t( cheiney, rdl )} <> {t( cirio, sabre )} <> {t( darrieumerlou, geode )} <> {t( daynes, geode )} <> {t( de_maindreville, rdl )} <> {t( gardarin, optimisation )} <> {t( gardarin, sabre )} <> {t( gruber, eos )} <> {t( kiernan, rdl )} <> {t( lanzelotte, optimisation )} <> {t( parker, svp )} <> {t( pucheral, geode )} <> {t( simon, rdl )} <> {t( simon, svp )} <> {t( simon, sabre )} <> {t( thevenin, geode )} <> {t( valduriez, eos )} <> {t( valduriez, geode )} <> {t( valduriez, omnis )} <> {t( valduriez, optimisation )} <> {t( valduriez, sabre )} <> {t( valduriez, svp )} <> {t( viallet, omnis )} <> {t( zait, optimisation )} <> {t( ziane, optimisation )}. %------------------------------------------------------------------------------ % Merge Scans %------------------------------------------------------------------------------ merge_scan(R,S) => merge1(sequence(S),sequence(R)). merge1({}, R) => R. merge1({Y}, R) => prefixy(R,{Y}). merge1(S1<>S2,R) => merge1(S1,R) :: merge1(suffix(R,S1),S2). prefixy(R,{Y}) => prefix(R,{Y}) :: {Y}. prefix({}, _) => {}. prefix({X}, {Y}) => {X} :- X= {}. prefix(S1<>S2,V) => prefix(S1,V) :: prefix(S2,V). suffix({}, _) => {}. suffix({X}, {Y}) => {X} :- X>Y, !. suffix({_}, _) => {}. suffix(S1<>S2,V) => suffix(S1,V) :: suffix(S2,V). merge_demo => merge_scan( {1}<>{4}<>{8}<>{9}, {2}<>{3}<>{5}<>{11}). %------------------------------------------------------------------------------ % Set operations %------------------------------------------------------------------------------ union(R,S) => sorted_union(streamify(sort(R)),streamify(sort(S))). sorted_union(R,S) => sorted_union1(S,R). sorted_union1({[]}, R) => R :- !. sorted_union1({Y}<>S,R) => union_output(R,Y) <> sorted_union1(S,union_state(R,Y)). union_output(R,Y) => union_output1(R,Y,false). union_output1({}, _,_) => {}. union_output1({X}, Y,C) => union_output_increment(Y,X,C). union_output1(Q1<>Q2,Y,C) => union_output1(Q1,Y,C) <> union_output1(Q2,Y,output_complete(Q1,Y,C)). union_output_increment(Y,X,Complete) => if Complete then {} else (if X = [] then {Y} else (if X > Y then {Y} else (if X = Y then {} else /* X < Y */ {X}))). union_state({}, _) => {}. union_state({X}, Y) => union_state_increment(Y,X). union_state(Q1<>Q2,Y) => union_state(Q1,Y) <> union_state(Q2,Y). union_state_increment(Y,X) => if X = [] then {[]} else (if X > Y then {X} else (if X = Y then {X} else /* X < Y */ {})). intersection(R,S) => sorted_intersection(streamify(sort(R)),streamify(sort(S))). sorted_intersection(R,S) => sorted_intersection1(S,R). sorted_intersection1({[]}, _) => {[]} :- !. sorted_intersection1({Y}<>S,R) => intersection_output(R,Y) <> sorted_intersection1(S,intersection_state(R,Y)). intersection_output(R,Y) => intersection_output1(R,Y,false). intersection_output1({}, _,_) => {}. intersection_output1({X}, Y,C) => intersection_output_increment(Y,X,C). intersection_output1(Q1<>Q2,Y,C) => intersection_output1(Q1,Y,C) <> intersection_output1(Q2,Y,output_complete(Q1,Y,C)). intersection_output_increment(Y,X,Complete) => if Complete then {} else (if X = [] then {} else (if X > Y then {} else (if X = Y then {Y} else /* X < Y */ {}))). intersection_state({}, _) => {}. intersection_state({X}, Y) => intersection_state_increment(Y,X). intersection_state(Q1<>Q2,Y) => intersection_state(Q1,Y) <> intersection_state(Q2,Y). intersection_state_increment(Y,X) => if X = [] then {[]} else (if X > Y then {X} else (if X = Y then {X} else /* X < Y */ {})). difference(R,S) => sorted_difference(streamify(sort(R)),streamify(sort(S))). sorted_difference(R,S) => sorted_difference1(S,R). sorted_difference1({[]}, R) => R :- !. sorted_difference1({Y}<>S,R) => difference_output(R,Y) <> sorted_difference1(S,difference_state(R,Y)). difference_output(R,Y) => difference_output1(R,Y,false). difference_output1({}, _,_) => {}. difference_output1({X}, Y,C) => difference_output_increment(Y,X,C). difference_output1(Q1<>Q2,Y,C) => difference_output1(Q1,Y,C) <> difference_output1(Q2,Y,output_complete(Q1,Y,C)). difference_output_increment(Y,X,Complete) => if Complete then {} else (if X = [] then {} else (if X > Y then {} else (if X = Y then {} else /* X < Y */ {X}))). difference_state({}, _) => {}. difference_state({X}, Y) => difference_state_increment(Y,X). difference_state(Q1<>Q2,Y) => difference_state(Q1,Y) <> difference_state(Q2,Y). difference_state_increment(Y,X) => if X = [] then {[]} else (if X > Y then {X} else (if X = Y then {} else /* X < Y */ {})). output_complete(_,_,true) => true :- !. output_complete({[]},_,_) => true :- !. output_complete({X},Y,_) => if X < Y then false else true. (X < Y) => true :- compare(<,X,Y), !. (_ < _) => false. (X = Y) => true :- compare(=,X,Y), !. (_ = _) => false. (X > Y) => true :- compare(>,X,Y), !. (_ > _) => false. r => {t(a,1)} <> {t(b,2)} <> {t(c,3)} <> {t(e,5)} <> {[]}. s => {t(a,1)} <> {t(c,3)} <> {t(d,4)} <> {[]}. union_demo => sorted_union(R,S) :- r =>> R, s =>> S. difference_demo => sorted_difference(R,S) :- r =>> R, s =>> S. intersection_demo => sorted_intersection(R,S) :- r =>> R, s =>> S. %------------------------------------------------------------------------------ % Bond yield analysis %------------------------------------------------------------------------------ bond( scg, 'Southern California Gas', 'Open Mortgage--Outstg.', 0.0825, 100.00, 'A1', 96/11/15, 2, {payment(91/05/01, 4.12)} <> {payment(91/11/01, 4.13)} <> {payment(92/05/01, 4.12)} <> {payment(92/11/01, 4.13)} <> {payment(93/05/01, 4.12)} <> {payment(93/11/01, 4.13)} <> {payment(94/05/01, 4.12)} <> {payment(94/11/01, 4.13)} <> {payment(95/05/01, 4.12)} <> {payment(95/11/01, 4.13)} <> {payment(96/05/01, 4.12)} <> {payment(96/11/01, 4.13)} <> {payment(96/11/15, 100.00)} <> {[]} , {call(90/11/15, 91/11/14, 104.43)} <> {call(91/11/15, 92/11/14, 103.32)} <> {call(92/11/15, 93/11/14, 102.21)} <> {call(93/11/15, 94/11/14, 101.11)} <> {call(94/11/15, 95/11/14, 100.00)} <> {call(95/11/15, 96/11/14, 100.00)} <> {[]} ). yield_to_worst(BondId,Price,Date) => min( yield_to_maturity(BondId,Price,Date), yield_to_call(BondId,Price,Date) ). yield_to_maturity(BondId,Price,Date) => Yield :- Date = (CurrentYear/_/_), bond(BondId,_,_,Coupon,Face,_,(MaturityYear/_/_),M,_,_), N is MaturityYear-CurrentYear+1, C is Coupon*Face, yield(Price,C,Face,M,N,Yield). yield_to_call(BondId,Price,Date) => collection_min( yields(Payments,Calls,Date,Price,C,M,0) ) :- bond(BondId,_,_,Coupon,Face,_,_,M,Payments,Calls), C is Coupon*Face. yields({[]},_,_,_,_,_) => {[]}. yields({_}<>{[]},_,_,_,_,_,_) => {[]} :- !. yields({payment(PD,_)}<>Ps,Cs,Date,P,C,M,N) => yields(Ps,Cs,Date,P,C,M,N) :- beforeDate(PD,Date), !. yields({payment(PD,_)}<>Ps,Cs,D,P,C,M,N0) => {Yield}<>yields(Ps,Cs,D,P,C,M,N) :- N is N0 + 1/M, call_price(Cs,Ps,PD) =>> R, yield(P,C,R,M,N, Yield). call_price({call(_,CallEnd,_CP)}<>Calls,Ps,PD) => call_price(Calls,Ps,PD) :- beforeDate(CallEnd,PD), CallEnd \== PD, !. call_price({call(CallStart,CallEnd,CP)}<>Cs,Ps,PD) => CallPrice :- beforeDate(CallStart,PD), beforeDate(PD,CallEnd), !, Cs =>> Calls, Ps =>> Payments, callPrice(Calls,Payments,CP,CallPrice). callPrice({[]},_,CP,CP) :- !. callPrice(_,{[]},CP,CP) :- !. callPrice({call(NextCallStart,_,NextCP)}<>_,{payment(NextPD,_)}<>_,CP,CallPrice) :- (beforeDate(NextCallStart,NextPD) -> CallPrice is NextCP ; CallPrice is CP ), !. beforeDate(Date1,Date2) :- Date1 = (Y1/M1/D1), Date2 = (Y2/M2/D2), (Y1 X :- plusInfinity(X). collection_min({[]}) => X :- plusInfinity(X), !. collection_min({X}) => X. collection_min(S1<>S2) => collection_min(S1) min collection_min(S2). plusInfinity(1.79e+308). % double precision IEEE %------------------------------------------------------------------------------ % % Let $yield(P,C,R,m,n)$ denote the yield of a bond with: % \begin{itemize} % \item purchase price $P$, % \item annual coupon interest $C$, % \item final redemption value (maturity face value) $R$, % \item yearly payment frequency $m$, % \item which is held over $n$ years. % \end{itemize} % % The yield $y~=~yield(P,C,R,m,n)$ is defined by the equation % \[ % P % ~~~=~~~ % \frac{C}{m} ~ \sum_{i=1}^{mn} ~ (1 + \frac{y}{m})^{-i} % ~~+~~ % R ~ (1 + \frac{y}{m})^{-mn} , % \] % using the definition for compound interest. % For bonds, $m$ is typically 2. % Values for $y$ are typically found iteratively, or with tables. % % Using Newton's method, the error $error(y)$ in this sum is % \[ % error(y) % ~~~=~~~ % \frac{C}{m} ~ \sum_{i=1}^{mn} ~ (1 + \frac{y}{m})^{-i} % ~~+~~ % R ~ (1 + \frac{y}{m})^{-mn} , % ~~-~~ % P % \] % and we use an iteration $y_{n+1} ~=~ y_n - error(y_n)/error'(y_n). % % We also define the `future value' % \[ % FV( PV, r, m, n ) ~~ = ~~ PV ~ (1 + \frac{r}{m} )^{mn} % \] % of an amount $PV$ invested today and compounded at annual interest rate $r$ % $m$ times per year for $n$ years. Similary we have the `present value' % \[ % PV( FV, r, m, n ) ~~ = ~~ FV ~ (1 + \frac{r}{m} )^{-mn}. % \] % % % See: % F.J. Fabozzi, I.M. Pollack (eds.), % {\em The Handbook of Fixed Income Securities} (3rd ed.), % Homewood, Illinois: Business One Irwin, 1991. % %------------------------------------------------------------------------------ fv(PV,R,M,N, FV) :- powerValue((1+(R/M)),(M*N),Compound), FV is PV * Compound. pv(FV,R,M,N, PV) :- powerValue((1+(R/M)),-(M*N),Compound), PV is FV * Compound. yield_from_horizon_value(HV,P,M,N, Y) :- % HV = fv(P,Y,M,N) = P*(1+(Y/M))^(-M*N) % so Y = ((HV/P)^(-1/(M*N)) - 1) * M powerValue(HV/P, (-1/(M*N)), HVPP), Y is (HVPP-1)*M. yield(P,C,R,M,N, Y) :- newtonYield(0.0,P,C,R,M,N,Y). newtonYield(Y0,P,C,R,M,N,Y) :- yieldError(Y0,P,C,R,M,N,Error), newtonIterate(Y0,P,C,R,M,N,Error,Y). newtonIterate(Y0,_,_,_,_,_,Error,Y0) :- negligibleError(Error), !. newtonIterate(Y0,P,C,R,M,N,Error,Y) :- yieldErrorDerivative(Y0,P,C,R,M,N,ErrorDerivative), NewY0 is Y0 - Error/ErrorDerivative, newtonYield(NewY0,P,C,R,M,N,Y). yieldError(Y,P,C,R,M,N, Error) :- X is (1/(1+Y/M)), powerSum(X,(M*N), CPS), CouponCashFlow is (C/M)*CPS, powerValue(X,(M*N), RP), RedemptionCashFlow is R * RP, Error is (CouponCashFlow + RedemptionCashFlow) - P. yieldErrorDerivative(Y,_,C,R,M,N, ErrorDerivative) :- X is (1/(1+Y/M)), DXDY is (-1/(X*X))*(1/M), % chain rule powerSumDerivative(X,(M*N), PSD), CouponCashFlowDerivative is (C/M) * PSD * DXDY, powerValue(X,(M*N-1), PX1), XPD is (M*N) * PX1, RedemptionCashFlowDerivative is R * XPD * DXDY, ErrorDerivative is (CouponCashFlowDerivative + RedemptionCashFlowDerivative). negligibleError(0.0) :- !. negligibleError(X) :- X>0.0, !, X < 1.0e-5. negligibleError(X) :- X > -1.0e-5. % powerSum/3 computes PS = (x + x^2 + ... + x^N) = x(1 - x^N)/(1 - x) powerSum(0.0,_,1.0) :- !. powerSum(1.0,N,N) :- !. powerSum(X,N,PS) :- powerValue(X,N,XN), PS is X*(1-XN)/(1-X). % powerSumDerivative/3 computes % d/dx (x + x^2 + ... + x^N) % = d/dx (1 + x + x^2 + ... + x^N) % = d/dx [(1 - x^(N+1))/(1 - x)] % = [(1 - x) (- (N+1) x^N) + (1 - x^(N+1))] / (1 - x)^2 powerSumDerivative(0.0,_,1.0) :- !. powerSumDerivative(1.0,N,NN1) :- !, NN1 is N*(N+1)/2. powerSumDerivative(X,N,PSD) :- powerValue(X,N,XN), XN1 is X*XN, PSD is (( (1-X)*(-(N+1)*XN) + (1 - XN1) ))/((1-X)*(1-X)). powerValue(0.0,_,0.0) :- !. powerValue(X,Y,Power) :- XValue is X, YValue is Y, log(XValue,LogX), YLogX is YValue*LogX, exp(YLogX,Power). % yield_to_maturity(scg, 105.00, 91/04/04) =>> 0.07208791346601839 yield_to_maturity_demo => yield_to_maturity(scg, 105.00, 91/04/04). % Example: yield_to_worst(scg, 105.00, 91/04/04) =>> 0.06281876021279004 % This (6.28 percent) is the yield at the call on 91/11/15. yield_to_worst_demo => yield_to_worst(scg, 105.00, 91/04/04). %------------------------------------------------------------------------------ % Moving averages %------------------------------------------------------------------------------ moving_average(M,S) => windowAvgs(sequence(S),M,{}). windowAvgs({}, _,_) => {}. windowAvgs({X}, M,W) => windowAvg({X},M,W). windowAvgs(S1<>S2,M,W) => windowAvgs(S1,M,W) <> windowAvgs(S2,M,window(S1,M,W)). windowAvg({_},M,W) => {} :- count(W) =>> N, N < M-1, !. windowAvg({X},M,W) => {A} :- avg(window({X},M,W)) =>> A. window({X},M,W) => all_but_first(W<>{X},M1) :- count(W) =>> N, M1 is N+1-M. all_but_first({}, _) => {}. all_but_first({X}, N) => if (N > 0) then {} else {X}. all_but_first(S1<>S2,N) => all_but_first(S1,N) <> all_but_first(S2,N1) :- count(S1) =>> C, N1 is N-C. moving_average_demo => moving_average(3, {1}<>{4}<>{9}<>{16}<>{25}<>{36}<>{49}<>{64} ). %------------------------------------------------------------------------------ % Conservative extensions... %------------------------------------------------------------------------------ mirrored_append(S,T) => if emptycollection(S) then T else mirror(prepend(mirror(S),mirror(T))). prepend({},_) => {}. prepend({X},T) => T <> {X}. prepend(S1<>S2,T) => prepend(S1,T) <> prepend(S2,{}). append_demo => mirrored_append( ({1}<>{2})<>({3}<>{4}), ({5}<>{6})<>{7} ). %------------------------------------------------------------------------------ X => X :- atomic(X), !. % atoms and numbers are values, terminating rewriting X => X :- functor(X,t,_), !. % all tuples are values. %------------------------------------------------------------------------------ demos :- run_demo(diffs_demo), run_demo(polygon_demo), run_demo(naive_sequence_demo), run_demo(sequence_demo), run_demo(mirror_demo), run_demo(balance_demo), run_demo(partition_demo), run_demo(group_demo), run_demo(halves_demo), run_demo(avg_demo), run_demo(sort_demo), run_demo(nested_loops_demo), run_demo(hash_join_demo), run_demo(merge_demo), run_demo(union_demo), run_demo(difference_demo), run_demo(intersection_demo), run_demo(yield_to_maturity_demo), run_demo(yield_to_worst_demo), run_demo(moving_average_demo), run_demo(append_demo). run_demo(D) :- nl, write(D), nl, (D => Expression), Expression =>> Value, tab(4), write(Expression), nl, tab(4), write(' =>> '), write(Value), nl. %------------------------------------------------------------------------------ % Demo output % % Six long lines in the output below were edited into (more readable) % multiple lines, but otherwise the output is exactly as produced. %------------------------------------------------------------------------------ % % ?- demos. % % diffs_demo % diffs({98}<>{99}<>{97}<>{97}<>{99}<>{96}<>{[]}) % =>> {1}<>{-2}<>{0}<>{2}<>{-3}<>{[]} % % polygon_demo % total_area(sample_polygon) % =>> 26.50000000000002 % % naive_sequence_demo % sequence(({8}<>({3}<>{1})<>({7}<>{5})<>{9})<>{4}<>{2}) % =>> {8}<>{3}<>{1}<>{7}<>{5}<>{9}<>{4}<>{2} % % sequence_demo % sequence(({8}<>({3}<>{1})<>({7}<>{5})<>{9})<>{4}<>{2}) % =>> {8}<>{3}<>{1}<>{7}<>{5}<>{9}<>{4}<>{2} % % mirror_demo % mirror(({1}<>{2})<>{3}<>{4}<>{5}) % =>> (({5}<>{4})<>{3})<>{2}<>{1} % % balance_demo % balance({a}<>{3}<>{1}<>{b}<>{5}<>{d}<>{4}<>{2}) % =>> (({a}<>{3})<>{1}<>{b})<>({5}<>{d})<>{4}<>{2} % % partition_demo % partition({a}<>{1}<>{2}<>{b}<>{3},numeric) % =>> ({1}<>{2}<>{3})<>{a}<>{b} % % group_demo % group(crude_hash,{a}<>{b}<>{c}<>{d}<>{e}<>{f}<>{g}) % =>> (({t(3,{g}<>{c})}<>{t(1,{a}<>{e})})<>{t(2,{b}<>{f})})<>{t(0,{d})} % % halves_demo % halves({a}<>{3}<>{1}<>{b}<>{5}<>{d}<>{4}<>{2},1,8) % =>> t({a}<>{3}<>{1}<>{b},{5}<>{d}<>{4}<>{2}) % % avg_demo % avg({8}<>{3}<>{1}<>{7}<>{5}<>{9}<>{4}<>{2}<>{6}) % =>> 5.0 % % sort_demo % sort({8}<>{3}<>{1}<>{7}<>{5}<>{9}<>{4}<>{2},lessEq,avg) % =>> {8}<>{3}<>{1}<>{7}<>{5}<>{9}<>{4}<>{2} % % nested_loops_demo % nested_loops_join(1,1,emp,project) % =>> {t(amiel,39-63-59-65,omnis)} <> % {t(amsaleg,39-63-52-55,eos)} <> % {t(baque,39-63-52-50,sabre)} <> % {t(bellosta,39-63-59-65,omnis)} <> % {t(cheiney,39-63-52-52,rdl)} <> % {t(cirio,39-63-52-50,sabre)} <> % {t(darrieumerlou,39-63-55-72,geode)} <> % {t(daynes,39-63-52-55,geode)} <> % {t(de_maindreville,39-63-56-19,rdl)} <> % ({t(gardarin,39-63-56-86,optimisation)} <> % {t(gardarin,39-63-56-86,sabre)}) <> % {t(gruber,39-63-56-35,eos)} <> % {t(kiernan,39-63-56-19,rdl)} <> % {t(lanzelotte,39-63-56-32,optimisation)} <> % {t(parker,39-63-59-64,svp)} <> % {t(pucheral,39-63-55-79,geode)} <> % ({t(simon,39-63-52-52,rdl)} <> % {t(simon,39-63-52-52,svp)} <> % {t(simon,39-63-52-52,sabre)}) <> % {t(thevenin,39-63-55-79,geode)} <> % ({t(valduriez,39-63-52-51,eos)} <> % {t(valduriez,39-63-52-51,geode)} <> % {t(valduriez,39-63-52-51,omnis)} <> % {t(valduriez,39-63-52-51,optimisation)} <> % {t(valduriez,39-63-52-51,sabre)} <> % {t(valduriez,39-63-52-51,svp)}) <> % {t(viallet,39-63-55-79,omnis)} <> % {t(zait,39-63-56-18,optimisation)} <> % {t(ziane,39-63-56-32,optimisation)} % % hash_join_demo % hash_join(1,1,emp,project) % =>> ((((((((((({t(ziane,39-63-56-32,optimisation)} <> % {t(zait,39-63-56-18,optimisation)}) <> % {t(amiel,39-63-59-65,omnis)} <> % {t(amsaleg,39-63-52-55,eos)}) <> % {t(baque,39-63-52-50,sabre)} <> % {t(bellosta,39-63-59-65,omnis)}) <> % {t(cheiney,39-63-52-52,rdl)} <> % {t(cirio,39-63-52-50,sabre)}) <> % ({t(darrieumerlou,39-63-55-72,geode)} <> % {t(daynes,39-63-52-55,geode)}) <> % {t(de_maindreville,39-63-56-19,rdl)}) <> % ({t(gardarin,39-63-56-86,optimisation)} <> % {t(gardarin,39-63-56-86,sabre)}) <> % {t(gruber,39-63-56-35,eos)}) <> % {t(kiernan,39-63-56-19,rdl)}) <> % {t(lanzelotte,39-63-56-32,optimisation)}) <> % {t(parker,39-63-59-64,svp)} <> % {t(pucheral,39-63-55-79,geode)}) <> % ({t(simon,39-63-52-52,rdl)} <> % {t(simon,39-63-52-52,svp)}) <> % {t(simon,39-63-52-52,sabre)}) <> % {t(thevenin,39-63-55-79,geode)}) <> % ((((({t(valduriez,39-63-52-51,eos)} <> % {t(valduriez,39-63-52-51,geode)}) <> % {t(valduriez,39-63-52-51,omnis)}) <> % {t(valduriez,39-63-52-51,optimisation)}) <> % {t(valduriez,39-63-52-51,sabre)}) <> % {t(valduriez,39-63-52-51,svp)}) <> % {t(viallet,39-63-55-79,omnis)} % % merge_demo % merge_scan({1}<>{4}<>{8}<>{9},{2}<>{3}<>{5}<>{11}) % =>> {1}<>{2}<>{3}<>{4}<>{5}<>{8}<>{9}<>{11} % % union_demo % sorted_union({t(a,1)}<>{t(b,2)}<>{t(c,3)}<>{t(e,5)}<>{[]}, % {t(a,1)}<>{t(c,3)}<>{t(d,4)}<>{[]}) % =>> ({t(a,1)}<>{t(b,2)})<>({t(c,3)}<>{t(d,4)})<>{t(e,5)}<>{[]} % % difference_demo % sorted_difference({t(a,1)}<>{t(b,2)}<>{t(c,3)}<>{t(e,5)}<>{[]}, % {t(a,1)}<>{t(c,3)}<>{t(d,4)}<>{[]}) % =>> {t(b,2)}<>{t(e,5)}<>{[]} % % intersection_demo % sorted_intersection({t(a,1)}<>{t(b,2)}<>{t(c,3)}<>{t(e,5)}<>{[]}, % {t(a,1)}<>{t(c,3)}<>{t(d,4)}<>{[]}) % =>> {t(a,1)}<>{t(c,3)}<>{[]} % % yield_to_maturity_demo % yield_to_maturity(scg,105.0,91/4/4) % =>> 0.07208791346601839 % % yield_to_worst_demo % yield_to_worst(scg,105.0,91/4/4) % =>> 0.06281876021279004 % % moving_average_demo % moving_average(3,{1}<>{4}<>{9}<>{16}<>{25}<>{36}<>{49}<>{64}) % =>> {4.666666666666668}<>{9.666666666666664}<>{16.66666666666667}<> % {25.66666666666667}<>{36.66666666666666}<>{49.66666666666666} % % append_demo % mirrored_append(({1}<>{2})<>{3}<>{4},({5}<>{6})<>{7}) % =>> ({1}<>{2})<>{3}<>{4}<>({5}<>{6})<>{7} % %------------------------------------------------------------------------------ demo(polygon, 'SVP: polygon areas', []) :- svp(polygon_demo). demo(diffs, 'SVP: incremental diffs', []) :- svp(diffs_demo). demo(sequence, 'SVP: sequence (flatten)', []) :- svp(sequence_demo). demo(naive_sequence,'SVP: naive sequence',[]) :- svp(naive_sequence_demo). demo(mirror, 'SVP: mirror', []) :- svp(mirror_demo). demo(balance, 'SVP: tree balancing', []) :- svp(balance_demo). demo(partition, 'SVP: partitioning',[]) :- svp(partition_demo). demo(group, 'SVP: grouping', []) :- svp(group_demo). demo(halves, 'SVP: halving', []) :- svp(halves_demo). demo(avg, 'SVP: average', []) :- svp(avg_demo). demo(sort, 'SVP: sorting', []) :- svp(sort_demo). demo(nested_loops, 'SVP: nested loops join',[]) :- svp(nested_loops_demo). demo(hash_join, 'SVP: hash join', []) :- svp(hash_join_demo). demo(merge, 'SVP: merge scan', []) :- svp(merge_demo). demo(union, 'SVP: union (scan)', []) :- svp(union_demo). demo(difference, 'SVP: difference', []) :- svp(difference_demo). demo(intersection, 'SVP: intersection',[]) :- svp(intersection_demo). demo(yield1, 'SVP: yield to maturity',[]) :- svp(yield_to_maturity_demo). demo(yield2, 'SVP: yield to worst',[]) :- svp(yield_to_worst_demo). demo(moving_avg, 'SVP: moving average',[]) :- svp(moving_average_demo). demo(append, 'SVP: simple append', []) :- svp(append_demo). demo(all, 'SVP: ALL OF THE ABOVE', []) :- demos. svp(D) :- run_demo(D).