[m-rev.] diff: initial gen of a tariffed shopper screen
Peter Ross
pro at missioncriticalit.com
Fri Jun 4 21:42:34 AEST 2004
Hi,
===================================================================
Add tariffed_shopper_screen_rdf which returns the rdf for a tariffed
version of the shopper screen. Currently it fakes the tarrification
part and just works out how to assign the actual risk objects to each
product.
mas/mas.m:
Assign all possible combinations of risk objects to each
product.
mas/mas.rdf.m:
Add write_tariff_rdf, which just prints out the information
generated for the moment.
online/mas-server/mas_server.m:
Call the tariffed_shopper_screen_rdf service.
online/mas-server/Mmakefile:
Add a rule to kill the mas_server before starting the server
again.
Index: mas/mas.m
===================================================================
RCS file: D:/project/CVSROOT/mas-src/mas/mas.m,v
retrieving revision 1.21
diff -u -r1.21 mas.m
--- mas/mas.m 2 Jun 2004 08:22:36 -0000 1.21
+++ mas/mas.m 4 Jun 2004 11:15:09 -0000
@@ -26,6 +26,9 @@
:- pred risk_objects_rdf(S::in, mas::in,
io::di, io::uo) is det <= stream__output(S).
+:- pred tariffed_shopper_screen_rdf(S::in, mas::in, list(risk_object)::in,
+ io::di, io::uo) is det <= stream__output(S).
+
:- pred shopper_screen_rdf(S::in, mas::in, list(risk_object)::in,
io::di, io::uo) is det <= stream__output(S).
@@ -174,6 +177,124 @@
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
+tariffed_shopper_screen_rdf(S, Mas, RiskObjects, !IO) :-
+ % Get all valid products.
+ RiskObjectTypes = list__map(func(RO) = RO ^ ro_type, RiskObjects),
+ list__filter(possible_product(list_to_set(RiskObjectTypes)),
+ Mas ^ all_products, Products),
+
+ % Tariff product
+ Tariffs = list__condense(
+ list__map(
+ product_to_tariffs(Mas ^ possible_risk_objects, RiskObjects),
+ Products)
+ ),
+
+ stream__write_strings(S, [
+ "<?xml version=\"1.0\"?>\n",
+ "<rdf:RDF " ++
+ "xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"\n",
+ " xmlns:nc=\"http://winterthur.be/MAS/rdf#\">\n",
+ " <rdf:Description about=\"urn:root\">\n"], !IO),
+ write_tariff_rdf(S, 2, Tariffs, !IO),
+ stream__write_strings(S, [
+ " <nc:end>\n",
+ " <rdf:Seq>\n",
+ " <rdf:li>\n",
+ " <rdf:Description nc:done=\"true\"/>\n",
+ " </rdf:li>\n",
+ " </rdf:Seq>\n",
+ " </nc:end>\n",
+ " </rdf:Description>\n",
+ "</rdf:RDF>\n"], !IO).
+
+:- type tariff
+ ---> tariff(
+ name, % Product name
+ list(name), % Covered objects
+ list(guarantee_tariff) % Tariffed guarantees
+ ).
+
+:- type guarantee_tariff
+ ---> guarantee_tariff(
+ name, % Guarantee name
+ list({name, float}) % List of option names and prices.
+ ).
+
+
+ %
+ % Find all possible risk object combinations that could be used to
+ % tariff a product and then return a tariff for each combination.
+ %
+:- func product_to_tariffs(list(risk_object_desc),
+ list(risk_object), product) = list(tariff).
+
+product_to_tariffs(RODescs, RiskObjects, Product) = Tariffs :-
+ PossibleCovers = match_risk_objects_to_product(RiskObjects, Product),
+ Tariffs = list__map(product_to_tariff(RODescs, Product), PossibleCovers).
+
+:- func product_to_tariff(list(risk_object_desc),
+ product, list(risk_object)) = tariff.
+
+product_to_tariff(RiskObjDescs, Product, Covered) = Tariff :-
+ Name = Product ^ product_name,
+ CoveredNames = list__map(
+ (func(C) = name(N, N, N) :-
+ N = risk_object_to_string(RiskObjDescs, C)),
+ Covered),
+ Guarantees = list__map(guarantee_to_tariff, Product ^ product_guarantees),
+ Tariff = tariff(Name, CoveredNames, Guarantees).
+
+
+ %
+ % Find all possible combinations of risk objects which could be used
+ % to instantiate a product.
+ %
+:- func match_risk_objects_to_product(list(risk_object), product) =
+ list(list(risk_object)).
+
+match_risk_objects_to_product(AllRiskObjects, Product) = CoveredBy :-
+ Covers = to_sorted_list(Product ^ product_covers),
+ CoveredBy = get_covered_variants(Covers, AllRiskObjects).
+
+ %
+ % Given the type of risk objects a product covers and all the actual
+ % risk objects, find all possible combinations of risk objects that
+ % match the type constraints.
+ %
+:- func get_covered_variants(list(string), list(risk_object)) =
+ list(list(risk_object)).
+
+get_covered_variants([], _) = [[]].
+get_covered_variants([ROType | ROTypes], RiskObjects) = Variants :-
+ list__filter(is_covered_risk_object(ROType),
+ RiskObjects, CoveredRiskObjects),
+ Variants0 = get_covered_variants(ROTypes, RiskObjects),
+ Variants = list__condense(
+ list__map(add_risk_object_to_variants(Variants0), CoveredRiskObjects)).
+
+:- pred is_covered_risk_object(string::in, risk_object::in) is semidet.
+
+is_covered_risk_object(RiskObjectType, RiskObject) :-
+ RiskObjectType = RiskObject ^ ro_type.
+
+:- func add_risk_object_to_variants(list(list(risk_object)), risk_object) =
+ list(list(risk_object)).
+
+add_risk_object_to_variants(Variants, RiskObj) =
+ list__map(func(ROs) = [RiskObj | ROs], Variants).
+
+ %
+ % XXX This needs to be completed.
+ %
+:- func guarantee_to_tariff(guarantee) = guarantee_tariff.
+
+guarantee_to_tariff(Guarantee) = Tariff :-
+ Options = [{name("A", "A", "A"), 10.0}, {name("B", "B", "B"), 20.0}],
+ Tariff = guarantee_tariff(Guarantee ^ guarantee_name, Options).
+
+%------------------------------------------------------------------------------%
+
shopper_screen_rdf(S, Mas, RiskObjects, !IO) :-
% Get all valid products.
RiskObjectTypes = list__map(func(RO) = RO ^ ro_type, RiskObjects),
@@ -191,9 +312,10 @@
OrderedQsWithROs = list__map(
func(Qs) = {to_sorted_list(component_relates_to(Qs)), Qs},
OrderedQs),
+ RODescs = Mas ^ possible_risk_objects,
Boxes = list__condense(list__map(
- associate_questions_with_risk_object(ROMap, RiskObjects),
- OrderedQsWithROs)),
+ associate_questions_with_risk_object(RODescs, ROMap, RiskObjects),
+ OrderedQsWithROs)),
stream__write_strings(S, [
"<?xml version=\"1.0\"?>\n",
@@ -341,14 +463,16 @@
%
% XXX Here we have another combinatorial problem.
%
-:- func associate_questions_with_risk_object(map(string, risk_object_desc),
+:- func associate_questions_with_risk_object(list(risk_object_desc),
+ map(string, risk_object_desc),
list(risk_object), {list(string), questions}) = list(box).
-associate_questions_with_risk_object(ROMap,
+associate_questions_with_risk_object(RODescs, ROMap,
RiskObjects, {Types, Questions}) = Boxes :-
( Types = [Type] ->
ActualRiskObjects = risk_objects_of_type(RiskObjects, Type),
- Boxes = list__map(ro_to_box(ROMap, Questions), ActualRiskObjects)
+ Boxes = list__map(ro_to_box(RODescs, ROMap, Questions),
+ ActualRiskObjects)
;
error("XXX NYI")
).
@@ -364,15 +488,49 @@
risk_objects_of_type(ROs, Type)
).
-:- func ro_to_box(map(string, risk_object_desc), questions, risk_object) = box.
+:- func ro_to_box(list(risk_object_desc),
+ map(string, risk_object_desc), questions, risk_object) = box.
-ro_to_box(RiskObjects, Questions, risk_object(ROId, Type, Attrs)) = Box :-
- Id = string__append_list(list__map(func({_, V}) = V ++ " ", Attrs)),
+ro_to_box(RODescs, RiskObjects, Questions, RiskObject) = Box :-
+ RiskObject = risk_object(ROId, Type, _Attrs),
+ Id = risk_object_to_string(RODescs, RiskObject),
RODesc = map__lookup(RiskObjects, Type),
RODesc ^ ro_name = name(French, Dutch, English),
Name = name(French ++ ": " ++ Id,
Dutch ++ ": " ++ Id, English ++ ": " ++ Id),
Box = box(Id, yes(Name), no, list__map(replace_id(ROId), Questions)).
+
+:- func risk_object_to_string(list(risk_object_desc), risk_object) = string.
+
+risk_object_to_string(RiskObjDescs, RiskObject) = Str :-
+ RiskObjDesc = find_risk_object_desc(RiskObjDescs, RiskObject),
+
+ IDAttrs = list_to_set(
+ list__map(func(Q) = Q ^ q_risk_variable ^ riskvar_id,
+ RiskObjDesc ^ ro_questions)),
+
+ Str = string__append_list(
+ list__map(
+ (func({Id, V}) =
+ ( Id `member` IDAttrs ->
+ V ++ " "
+ ;
+ ""
+ )
+ ), RiskObject ^ ro_attributes)).
+
+:- func find_risk_object_desc(list(risk_object_desc), risk_object) =
+ risk_object_desc.
+
+find_risk_object_desc([], _) = func_error("find_risk_object_desc: not found").
+find_risk_object_desc([ROD | RODS], RiskObj) =
+ ( ROD ^ ro_id = RiskObj ^ ro_type ->
+ ROD
+ ;
+ find_risk_object_desc(RODS, RiskObj)
+ ).
+
+
:- func replace_id(string, question) = question.
Index: mas/mas.rdf.m
===================================================================
RCS file: D:/project/CVSROOT/mas-src/mas/mas.rdf.m,v
retrieving revision 1.9
diff -u -r1.9 mas.rdf.m
--- mas/mas.rdf.m 2 Jun 2004 12:55:49 -0000 1.9
+++ mas/mas.rdf.m 4 Jun 2004 11:15:09 -0000
@@ -20,6 +20,8 @@
:- pred write_javascript_list_rdf(S::in, int::in, list(javascript)::in,
io::di, io::uo) is det <= stream__output(S).
+:- pred write_tariff_rdf(S::in, int::in, list(tariff)::in,
+ io::di, io::uo) is det <= stream__output(S).
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
@@ -322,6 +324,95 @@
;
error("function_string: NYI")
).
+
+%------------------------------------------------------------------------------%
+%------------------------------------------------------------------------------%
+
+write_tariff_rdf(S, Indent, Tariffs, !IO) :-
+ Indent = I,
+ stream__write_strings(S, [
+ indent(I) ++ "<nc:questionbox>\n",
+ indent(I+1) ++ "<rdf:Seq>\n"], !IO),
+
+ list__foldl2(write_product_tariff_rdf(S, I+2), Tariffs, 0, _, !IO),
+
+ stream__write_strings(S, [
+ indent(I+1) ++ "</rdf:Seq>\n",
+ indent(I) ++ "</nc:questionbox>\n"
+ ], !IO).
+
+:- pred write_product_tariff_rdf(S::in, int::in, tariff::in, int::in, int::out,
+ io::di, io::uo) is det <= stream__output(S).
+
+write_product_tariff_rdf(S, Indent, tariff(TName, ONames, Guarantees),
+ N, N+1, !IO) :-
+ BoxId = "Box_" ++ int_to_string(N),
+ Ident = " nc:ident=\"" ++ BoxId ++ "\"",
+ Name = name_to_attributes(TName),
+ Order = " nc:order=\"" ++ int_to_string(N) ++ "\"",
+
+ Attributes = Ident ++ Name ++ Order,
+
+ I = Indent,
+ stream__write_strings(S, [
+ indent(I) ++ "<rdf:li>\n",
+ indent(I+1) ++ "<rdf:Description" ++ Attributes ++ ">\n",
+ indent(I+2) ++ "<nc:information>\n",
+ indent(I+3) ++ "<rdf:Seq>\n"], !IO),
+
+ list__foldl2(write_covered_object_rdf(S, I+4), ONames, 0, X, !IO),
+ list__foldl2(write_guarantee_tariff_rdf(S, I+4), Guarantees, X, _, !IO),
+
+ stream__write_strings(S, [
+ indent(I+3) ++ "</rdf:Seq>\n",
+ indent(I+2) ++ "</nc:information>\n",
+ indent(I+1) ++ "</rdf:Description>\n",
+ indent(I) ++ "</rdf:li>\n"], !IO).
+
+:- pred write_covered_object_rdf(S::in, int::in, name::in,
+ int::in, int::out, io::di, io::uo) is det <= stream__output(S).
+
+write_covered_object_rdf(S, Indent, OName, N, N+1, !IO) :-
+ Id = "XXX",
+ Ident = " nc:ident=\"" ++ Id ++ "\"",
+ Name = name_to_attributes(OName),
+ Order = " nc:order=\"" ++ int_to_string(N) ++ "\"",
+
+ Attributes = Ident ++ Name ++ Order,
+ Indent = I,
+ stream__write_strings(S, [
+ indent(I) ++ "<rdf:li>\n",
+ indent(I+1) ++ "<rdf:Description" ++ Attributes ++ "/>\n",
+ indent(I) ++ "</rdf:li>\n"], !IO).
+
+:- pred write_guarantee_tariff_rdf(S::in, int::in, guarantee_tariff::in,
+ int::in, int::out, io::di, io::uo) is det <= stream__output(S).
+
+write_guarantee_tariff_rdf(S, Indent, Guarantee, N0, N, !IO) :-
+ Guarantee = guarantee_tariff(_, Options),
+ I = Indent,
+ list__foldl2(write_guarantee_option_rdf(S, I), Options, N0, N, !IO).
+
+:- pred write_guarantee_option_rdf(S::in, int::in, {name, float}::in,
+ int::in, int::out, io::di, io::uo) is det <= stream__output(S).
+
+write_guarantee_option_rdf(S, Indent, {GName, Float}, N, N+1, !IO) :-
+ GName = name(Fr, Nl, En),
+ Currency = " " ++ float_to_string(Float),
+ NewGName = name(Fr ++ Currency, Nl ++ Currency, En ++ Currency),
+
+ Id = "XXX",
+ Ident = " nc:ident=\"" ++ Id ++ "\"",
+ Name = name_to_attributes(NewGName),
+ Order = " nc:order=\"" ++ int_to_string(N) ++ "\"",
+
+ Attributes = Ident ++ Name ++ Order,
+ Indent = I,
+ stream__write_strings(S, [
+ indent(I) ++ "<rdf:li>\n",
+ indent(I+1) ++ "<rdf:Description" ++ Attributes ++ "/>\n",
+ indent(I) ++ "</rdf:li>\n"], !IO).
+
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
Index: online/mas-server/Mmakefile
===================================================================
RCS file: D:/project/CVSROOT/mas-src/online/mas-server/Mmakefile,v
retrieving revision 1.1
diff -u -r1.1 Mmakefile
--- online/mas-server/Mmakefile 21 May 2004 16:16:45 -0000 1.1
+++ online/mas-server/Mmakefile 4 Jun 2004 11:15:09 -0000
@@ -52,6 +52,7 @@
.PHONY: install
install: mas_server
+ kill -9 `ps | grep mas_server | cut -d ' ' -f 6`
./mas_server $(HOSTNAME) $(SERVER_PORT) &
.moo.m:
Index: online/mas-server/mas_server.m
===================================================================
RCS file: D:/project/CVSROOT/mas-src/online/mas-server/mas_server.m,v
retrieving revision 1.5
diff -u -r1.5 mas_server.m
--- online/mas-server/mas_server.m 2 Jun 2004 08:22:37 -0000 1.5
+++ online/mas-server/mas_server.m 4 Jun 2004 11:15:09 -0000
@@ -150,6 +150,7 @@
:- type request
---> create_risk_object
; shopper_screen(list(risk_object))
+ ; tariff_shopper_screen(list(risk_object))
; unknown(string)
.
@@ -178,6 +179,14 @@
list__filter_map(risk_object(Doc),
children(RiskObjectsRef, Doc), RiskObjects),
Request = shopper_screen(RiskObjects)
+ ; Action = "risk_objects_shopper_screen_action" ->
+ RiskObjectsRef = find_first_element(Doc, [
+ "request" `with_attrs` [],
+ "riskobjects" `with_attrs` []
+ ], Root),
+ list__filter_map(risk_object(Doc),
+ children(RiskObjectsRef, Doc), RiskObjects),
+ Request = tariff_shopper_screen(RiskObjects)
;
Request = unknown("unknown action: " ++ Action)
)
@@ -215,6 +224,8 @@
risk_objects_rdf(Stream, Mas, !IO).
handle_request(Stream, shopper_screen(RiskObjects), Mas, !IO) :-
shopper_screen_rdf(Stream, Mas, RiskObjects, !IO).
+handle_request(Stream, tariff_shopper_screen(RiskObjects), Mas, !IO) :-
+ tariffed_shopper_screen_rdf(Stream, Mas, RiskObjects, !IO).
handle_request(Stream, unknown(String), Mas, !IO) :-
unknown_rdf(Stream, String, !IO).
--
Software Engineer (Work) +32 2 757 10 15
Mission Critical (Mobile) +32 485 482 559
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list