Prolog "plot"

         
/**
* Modern Albufeira Prolog Interpreter
*
* Warranty & Liability
* To the extent permitted by applicable law and unless explicitly
* otherwise agreed upon, XLOG Technologies AG makes no warranties
* regarding the provided information. XLOG Technologies AG assumes
* no liability that any problems might be solved with the information
* provided by XLOG Technologies AG.
*
* Rights & License
* All industrial property rights regarding the information - copyright
* and patent rights in particular - are the sole property of XLOG
* Technologies AG. If the company was not the originator of some
* excerpts, XLOG Technologies AG has at least obtained the right to
* reproduce, change and translate the information.
*
* Reproduction is restricted to the whole unaltered document. Reproduction
* of the information is only allowed for non-commercial uses. Selling,
* giving away or letting of the execution of the library is prohibited.
* The library can be distributed as part of your applications and libraries
* for execution provided this comment remains unchanged.
*
* Restrictions
* Only to be distributed with programs that add significant and primary
* functionality to the library. Not to be distributed with additional
* software intended to replace any components of the library.
*
* Trademarks
* Jekejeke is a registered trademark of XLOG Technologies AG.
*/
:- ensure_loaded(library(text/format)).
:- ensure_loaded(library(util/sequence)).
:- ensure_loaded(library(text/vector)).
:- ensure_loaded(library(util/aggregate)).
/*******************************************************************/
/* Non-Progressive Plotting */
/*******************************************************************/
/**
* plot(D, L):
* plot(S, D, L):
* The predicate succeeds. As a side effect a line plot for the data D
* and plotting options L is created as a SVG graphics element. The
* ternary predicate allows specifying a markup writer S.
*/
% plot(+List, +List)
plot(D, Opts) :-
current_output(S),
plot(S, D, Opts).
% plot(+Stream, List, +List)
plot(S, D, Opts) :-
aggregate_all((min(X), max(X), min(A), max(B)),
(member([X|Ys], D), sys_plot_bound(Ys, A, B)),
(MinX2, MaxX2, MinY2, MaxY2)),
sys_plot_default(mark, Mark),
sys_plot_default(line, Line),
sys_plot_default(decor, Decor),
sys_plot_opts(Opts, v(x(100-100,[]-[]), u(Mark-Line,'plot'-Decor),
w(MinX2-MaxX2,MinY2-MaxY2), ''-L),
v(x(Width-Height,XMap-YMap),u(Mark2-Line2,Render-Decor2),w(MinMaxX,MinMaxY), Css-[])),
svg_begin(S, [height(Height),width(Width),css(Css)|L]),
sys_plot_x_axis(XMap, MinMaxX, MinMaxY, Width, Height, S),
sys_plot_y_axis(YMap, MinMaxX, MinMaxY, Width, Height, S),
sys_plot_render(D, MinMaxX, MinMaxY, Width, Height, Mark2, Line2, Render, S),
sys_plot_decor(D, MinMaxX, MinMaxY, Width, Height, Mark2, Decor2, S),
svg_end(S).
% sys_plot_bound(+List, -Number, -Number)
sys_plot_bound(Ys, MinY, MaxY) :-
aggregate_all((min(Y), max(Y)), member(Y, Ys), (MinY, MaxY)).
% sys_plot_default(-Term)
sys_plot_default(mark, XStyle) :-
YStyle = ['mark', 'mark2'|YStyle],
XStyle = [YStyle|XStyle].
sys_plot_default(line, XStyle) :-
YStyle = ['line', 'line2'|YStyle],
XStyle = [YStyle|XStyle].
sys_plot_default(decor, XStyle) :-
YStyle = ['triangle', 'square'|YStyle],
XStyle = [YStyle|XStyle].
/*******************************************************************/
/* Progressive Plotting */
/*******************************************************************/
/**
* plot_begin(L):
* plot_begin(S, L):
* The predicate succeeds. As a side effect the axes for the plotting
* options L are created as a SVG graphics element. The binary predicate
* allows specifying a markup writer S.
*/
% plot_begin(+List)
plot_begin(Opts) :-
current_output(S),
plot_begin(S, Opts).
% plot_begin(+Stream, +List)
plot_begin(S, Opts) :-
sys_plot_opts(Opts, v(x(100-100,[]-[]), u(''-'','plot'-''),
w((-1.0)-1.0,(-1.0)-1.0), ''-L),
v(x(Width-Height,XMap-YMap),_,w(MinMaxX,MinMaxY), Css-[])),
svg_begin(S, [height(Height),width(Width),css(Css)|L]),
sys_plot_x_axis(XMap, MinMaxX, MinMaxY, Width, Height, S),
sys_plot_y_axis(YMap, MinMaxX, MinMaxY, Width, Height, S).
/**
* plot_add(D, L):
* plot_add(S, D, L):
* The predicate succeeds. As a side effect a line plot for the data
* D and plotting options L is added to the SVG graphics element. The
* ternary predicate allows specifying a markup writer S.
*/
% plot_add(+List, +List)
plot_add(D, Opts) :-
current_output(S),
plot_add(S, D, Opts).
% plot_add(+Stream, +List, +List)
plot_add(S, D, Opts) :-
sys_plot_default(mark, Mark),
sys_plot_default(line, Line),
sys_plot_default(decor, Decor),
sys_plot_opts(Opts, v(x(100-100,[]-[]), u(Mark-Line,'plot'-Decor),
w((-1.0)-1.0,(-1.0)-1.0), ''-_),
v(x(Width-Height,_),u(Mark2-Line2,Render-Decor2),w(MinMaxX,MinMaxY), _-[])),
sys_plot_render(D, MinMaxX, MinMaxY, Width, Height, Mark2, Line2, Render, S),
sys_plot_decor(D, MinMaxX, MinMaxY, Width, Height, Mark2, Decor2, S).
/**
* plot_end:
* plot_end(S):
* The predicate succeeds as a side effect the SVG graphics element is
* closed. The unary predicate allows specifying a markup writer S.
*/
% plot_end
plot_end :-
current_output(S),
plot_end(S).
% plot_end(+Stream)
plot_end(S) :-
svg_end(S).
/*******************************************************************/
/* X-Axis Plotting */
/*******************************************************************/
/**
* sys_plot_x_axis(Map, MinMaxX, MinMaxY, Width, Height, S):
* The predicate succeeds. As a side effect an x-axis is rendered.
*/
% sys_plot_x_axis(+Map, +Pair, +Pair, +Number, +Number, +Stream)
sys_plot_x_axis([], MinMaxX, MinMaxY, Width, Height, S) :- !,
sys_coord_y_svg(0, SY, MinMaxY, Height),
svg_line(S, 32, SY, 5*Width-32, SY, [class(pen)]),
sys_plot_x_range(0, MinMaxX, MinMaxY, Width, Height, S).
sys_plot_x_axis(Map, MinMaxX, MinMaxY, Width, Height, S) :-
sys_coord_y_svg(0, SY, MinMaxY, Height),
svg_line(S, 32, SY, 5*Width-32, SY, [class(pen)]),
sys_plot_x_map(Map, MinMaxX, MinMaxY, Width, Height, S).
% sys_plot_x_range(+Integer, +Pair, +Pair, +Number, +Number, +Stream)
sys_plot_x_range(I, _, _, _, _, _) :- I > 24, !.
sys_plot_x_range(I, MinX-MaxX, MinMaxY, Width, Height, S) :-
X is MinX+I*(MaxX-MinX)/24,
sys_coord_y_svg(0, SY, MinMaxY, Height),
sys_coord_x_svg(X, SX, MinX-MaxX, Width),
SY2 is SY+5,
svg_line(S, SX, SY, SX, SY2, [class(pen)]),
(I mod 3 =:= 0 ->
sys_plot_axis_prec(MinX-MaxX, Format),
format_atom(Format, [X], A),
SY3 is SY+17,
svg_text(S, SX, SY3, A, [class('label x-axis')]);
true),
J is I+1,
sys_plot_x_range(J, MinX-MaxX, MinMaxY, Width, Height, S).
% sys_plot_x_map(+Map, +Pair, +Pair, +Number, +Number, +Stream)
sys_plot_x_map([], _, _, _, _, _).
sys_plot_x_map([X-A|Map], MinMaxX, MinMaxY, Width, Height, S) :-
sys_coord_y_svg(0, SY, MinMaxY, Height),
sys_coord_x_svg(X, SX, MinMaxX, Width),
SY2 is SY+5,
svg_line(S, SX, SY, SX, SY2, [class(pen)]),
SY3 is SY+17,
svg_text(S, SX, SY3, A, [class('label x-axis')]),
sys_plot_x_map(Map, MinMaxX, MinMaxY, Width, Height, S).
/*******************************************************************/
/* Y-Axis Plotting */
/*******************************************************************/
/**
* sys_plot_y_axis(Map, MinMaxX, MinMaxY, Width, Height, S):
* The predicate succeeds. As a side effect an y-axis is rendered.
*/
% sys_plot_y_axis(+Map, Pair, +Pair, +Number, +Number, +Stream)
sys_plot_y_axis([], MinMaxX, MinMaxY, Width, Height, S) :- !,
sys_coord_x_svg(0, SX, MinMaxX, Width),
svg_line(S, SX, 25, SX, 4*Height-25, [class(pen)]),
sys_plot_y_range(0, MinMaxX, MinMaxY, Width, Height, S).
sys_plot_y_axis(Map, MinMaxX, MinMaxY, Width, Height, S) :-
sys_coord_x_svg(0, SX, MinMaxX, Width),
svg_line(S, SX, 25, SX, 4*Height-25, [class(pen)]),
sys_plot_y_map(Map, MinMaxX, MinMaxY, Width, Height, S).
% sys_plot_y_range(+Integer, Pair, +Pair, +Number, +Number, +Stream)
sys_plot_y_range(I, _, _, _, _, _) :- I > 20, !.
sys_plot_y_range(I, MinMaxX, MinY-MaxY, Width, Height, S) :-
Y is MinY+I*(MaxY-MinY)/20,
sys_coord_x_svg(0, SX, MinMaxX, Width),
sys_coord_y_svg(Y, SY, MinY-MaxY, Height),
SX2 is SX-5,
svg_line(S, SX2, SY, SX, SY, [class(pen)]),
(I mod 5 =:= 0 ->
sys_plot_axis_prec(MinY-MaxY, Format),
format_atom(Format, [Y], A),
SY2 is SY+5, SX3 is SX-7,
svg_text(S, SX3, SY2, A, [class('label y-axis')]);
true),
J is I+1,
sys_plot_y_range(J, MinMaxX, MinY-MaxY, Width, Height, S).
% sys_plot_y_map(+Map, Pair, +Pair, +Number, +Number, +Stream)
sys_plot_y_map([], _, _, _, _, _).
sys_plot_y_map([Y-A|Map], MinMaxX, MinMaxY, Width, Height, S) :-
sys_coord_x_svg(0, SX, MinMaxX, Width),
sys_coord_y_svg(Y, SY, MinMaxY, Height),
SX2 is SX-5,
svg_line(S, SX2, SY, SX, SY, [class(pen)]),
SY2 is SY+5, SX3 is SX-7,
svg_text(S, SX3, SY2, A, [class('label y-axis')]),
sys_plot_y_map(Map, MinMaxX, MinMaxY, Width, Height, S).
% sys_plot_axis_prec(+Pair, -Atom)
sys_plot_axis_prec(Min-Max, '~2f') :- abs(Min) < 1, abs(Max) < 1, !.
sys_plot_axis_prec(Min-Max, '~1f') :- abs(Min) < 10, abs(Max) < 10, !.
sys_plot_axis_prec(_, '~0f').
/*******************************************************************/
/* Render Plotting */
/*******************************************************************/
/**
* sys_plot_render(D, MinMaxX, MinMaxY, Width, Height, Mark, Line, Renders, S):
* The predicate succeeds. As a side effect the data lines
* for the data D are rendered.
*/
% sys_plot_render(+List, +Pair, +Pair, +Number, +Number, +Term, +Term, +Term, +Stream)
sys_plot_render([], _, _, _, _, _, _, _, _).
sys_plot_render([_], _, _, _, _, _, _, _, _) :- !.
sys_plot_render([[X2|Y2s],[X|Ys]|D], MinMaxX, MinMaxY, Width, Height, Marks, Lines, Renders, S) :-
sys_plot_split(Marks, Mark, Marks2),
sys_plot_split(Lines, Line, Lines2),
sys_plot_split(Renders, Render, Renders2),
sys_coord_x_svg(X2, SX2, MinMaxX, Width),
sys_coord_y_svg_list(Y2s, SY2s, MinMaxY, Height),
sys_coord_x_svg(X, SX, MinMaxX, Width),
sys_coord_y_svg_list(Ys, SYs, MinMaxY, Height),
sys_coord_y_svg(0, SZ, MinMaxY, Height),
sys_plot_lines(SY2s, SX2, SYs, SX, SZ, Mark, Line, Render, S),
sys_plot_render([[X|Ys]|D], MinMaxX, MinMaxY, Width, Height, Marks2, Lines2, Renders2, S).
% sys_plot_lines(+List, +Number, +List, +Number, +Number, +Term, +Term, +Term, +Stream)
sys_plot_lines([], _, [], _, _, _, _, _, _).
sys_plot_lines([SY2|SY2s], SX2, [SY|SYs], SX, SZ, Marks, Lines, Renders, S) :-
sys_plot_split(Marks, Mark, Marks2),
sys_plot_split(Lines, Line, Lines2),
sys_plot_split(Renders, Render, Renders2),
sys_plot_line(Render, SX2, SY2, SX, SY, SZ, Mark, Line, S),
sys_plot_lines(SY2s, SX2, SYs, SX, SZ, Marks2, Lines2, Renders2, S).
% sys_plot_line(+Atom, +Number, +Number, +Number, +Number, +Number, +Atom, +Atom, ++Stream)
sys_plot_line(none, _, _, _, _, _, _, _, _) :- !.
sys_plot_line(_, _, 0rNaN, _, _, _, _, _, _) :- !.
sys_plot_line(bars, SX2, SY2, SX, _, SZ, Mark, _, S) :- !,
svg_path(S, ['M', SX2, SZ, 'L', SX2, SY2,
'L', SX, SY2, 'L', SX, SZ, 'Z'], [class(Mark),shape-rendering('crispEdges')]).
sys_plot_line(_, _, _, _, 0rNaN, _, _, _, _) :- !.
sys_plot_line(area, SX2, SY2, SX, SY, SZ, Mark, _, S) :- !,
svg_path(S, ['M', SX2, SZ, 'L', SX2, SY2,
'L', SX, SY, 'L', SX, SZ, 'Z'], [class(Mark),shape-rendering('crispEdges')]).
sys_plot_line(_, SX2, SY2, SX, SY, _, _, Line, S) :-
svg_line(S, SX2, SY2, SX, SY, [class(Line)]).
/*******************************************************************/
/* Decor Plotting */
/*******************************************************************/
/**
* sys_plot_decor(D, MinMaxX, MinMaxY, Width, Height, Mark, Decors, S):
* The predicate succeeds. As a side effect the data markers
* for the data D are decorated.
*/
% sys_plot_render(+List, +Pair, +Pair, +Number, +Number, +Term, +Term, +Stream)
sys_plot_decor([], _, _, _, _, _, _, _).
sys_plot_decor([[X|Ys]|D], MinMaxX, MinMaxY, Width, Height, Marks, Decors, S) :-
sys_plot_split(Marks, Mark, Marks2),
sys_plot_split(Decors, Decor, Decors2),
sys_coord_x_svg(X, SX, MinMaxX, Width),
sys_coord_y_svg_list(Ys, SYs, MinMaxY, Height),
sys_plot_marks(SYs, SX, Mark, Decor, S),
sys_plot_decor(D, MinMaxX, MinMaxY, Width, Height, Marks2, Decors2, S).
% sys_plot_marks(+List, +Number, +Term, +Term, +Stream)
sys_plot_marks([], _, _, _, _).
sys_plot_marks([SY|SYs], SX, Marks, Decors, S) :-
sys_plot_split(Marks, Mark, Marks2),
sys_plot_split(Decors, Decor, Decors2),
sys_plot_mark(Decor, SX, SY, Mark, S),
sys_plot_marks(SYs, SX, Marks2, Decors2, S).
% sys_plot_mark(+Atom, +Number, +Number, +Atom, +Stream)
sys_plot_mark(none, _, _, _, _) :- !.
sys_plot_mark(_, _, 0rNaN, _, _) :- !.
sys_plot_mark(triangle, SX, SY, Mark, S) :- !,
SX2 is SX-3, SY2 is SY+3,
SY3 is SY-3, SX3 is SX+3,
svg_path(S, ['M', SX2, SY2, 'L', SX, SY3,
'L', SX3, SY2, 'Z'], [class(Mark)]).
sys_plot_mark(square, SX, SY, Mark, S) :- !,
SX2 is SX-3, SY2 is SY-3,
svg_rect(S, SX2, SY2, 6, 6, [class(Mark)]).
sys_plot_mark(_, SX, SY, Mark, S) :-
svg_circle(S, SX, SY, 3, [class(Mark)]).
% sys_plot_split(+Term, -Atom, -Term)
sys_plot_split([C|L], C, L) :- !.
sys_plot_split(C, C, C).
/*******************************************************************/
/* Calculations */
/*******************************************************************/
% sys_coord_x_svg(+Number, -Number, +Pair, +Number)
sys_coord_x_svg(X, SX, MinX-MaxX, Width) :-
SX is 32+(5*Width-64)*(X-MinX)/(MaxX-MinX).
% sys_coord_y_svg(+Number, -Number, +Pair, +Number)
sys_coord_y_svg(Y, Y, _, _) :- Y = 0rNaN, !.
sys_coord_y_svg(Y, SY, MinY-MaxY, Height) :-
SY is (4*Height-25)-(4*Height-50)*(Y-MinY)/(MaxY-MinY).
% sys_coord_y_svg_list(+List, -List, +Pair, +Number)
sys_coord_y_svg_list([], [], _, _).
sys_coord_y_svg_list([Y|Ys], [SY|SYs], MinMaxY, Height) :-
sys_coord_y_svg(Y, SY, MinMaxY, Height),
sys_coord_y_svg_list(Ys, SYs, MinMaxY, Height).
/*******************************************************************/
/* Plot Options */
/*******************************************************************/
/**
* sys_plot_opts(L, F, G):
* The predicate succeeds in G with the options L starting with defaults F.
*/
% sys_plot_opts(+List, +Quad, -Quad)
sys_plot_opts(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_plot_opts([X|L], I, O) :- !,
sys_plot_opt(X, I, H),
sys_plot_opts(L, H, O).
sys_plot_opts([], H, H) :- !.
sys_plot_opts(L, _, _) :-
throw(error(type_error(list,L),_)).
% sys_plot_opt(+Option, +Quad, -Quad)
sys_plot_opt(V, _, _) :- var(V),
throw(error(instantiation_error,_)).
sys_plot_opt(width(W), v(x(_-H,Y),E,F,G), v(x(W-H,Y),E,F,G)) :- !.
sys_plot_opt(height(H), v(x(W-_,Y),E,F,G), v(x(W-H,Y),E,F,G)) :- !.
sys_plot_opt(xaxis(A), v(x(X,_-B),E,F,G), v(x(X,A-B),E,F,G)) :- !.
sys_plot_opt(yaxis(B), v(x(X,A-_),E,F,G), v(x(X,A-B),E,F,G)) :- !.
sys_plot_opt(mark(A), v(D,u(_-B,Y),F,G), v(D,u(A-B,Y),F,G)) :- !.
sys_plot_opt(line(B), v(D,u(A-_,Y),F,G), v(D,u(A-B,Y),F,G)) :- !.
sys_plot_opt(render(A), v(D,u(X,_-B),F,G), v(D,u(X,A-B),F,G)) :- !.
sys_plot_opt(decor(B), v(D,u(X,A-_),F,G), v(D,u(X,A-B),F,G)) :- !.
sys_plot_opt(minx(M), v(D,E,w(_-Q,Y),G), v(D,E,w(M-Q,Y),G)) :- !.
sys_plot_opt(maxx(M), v(D,E,w(P-_,Y),G), v(D,E,w(P-M,Y),G)) :- !.
sys_plot_opt(miny(M), v(D,E,w(X,_-Q),G), v(D,E,w(X,M-Q),G)) :- !.
sys_plot_opt(maxy(M), v(D,E,w(X,P-_),G), v(D,E,w(X,P-M),G)) :- !.
sys_plot_opt(css(R), v(D,E,F,_-L), v(D,E,F,R-L)) :- !.
sys_plot_opt(X, v(D,E,F,R-[X|L]), v(D,E,F,R-L)) :- callable(X), !.
sys_plot_opt(O, _, _) :-
throw(error(domain_error(plot_option,O),_)).
/****************************************************************/
/* Error Texts */
/****************************************************************/
% strings(+Atom, +Atom, -Atom)
:- multifile(strings/3).
strings('domain_error.plot_option', de, 'Plotoption erwartet, gefunden ~q.').
strings('domain_error.plot_option', '', 'Plot option expected, found ~q.').

Use Privacy (c) 2005-2026 XLOG Technologies AG