1/* Part of SWI-Prolog 2 3 Author: Jan Wielemaker 4 E-mail: J.Wielemaker@vu.nl 5 WWW: http://www.swi-prolog.org 6 Copyright (c) 2016-2019, VU University Amsterdam 7 CWI, Amsterdam 8 All rights reserved. 9 10 Redistribution and use in source and binary forms, with or without 11 modification, are permitted provided that the following conditions 12 are met: 13 14 1. Redistributions of source code must retain the above copyright 15 notice, this list of conditions and the following disclaimer. 16 17 2. Redistributions in binary form must reproduce the above copyright 18 notice, this list of conditions and the following disclaimer in 19 the documentation and/or other materials provided with the 20 distribution. 21 22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS 25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE 26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, 27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, 28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER 30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 33 POSSIBILITY OF SUCH DAMAGE. 34*/ 35 36:- module(r_call, 37 [ (<-)/2, % ?Var, +Expression 38 (<-)/1, % +Expression 39 r_call/2, % +Function, +Options 40 41 % Internal predicates 42 r/4, % Quasi quotation parser 43 r_execute/3, % +Assignments, +Command, -Result 44 r_setup_graphics/2, % +Rconn, +Format 45 46 op(900, fx, <-), 47 op(900, xfx, <-), 48 op(400, yfx, $), 49 op(100, yf, []) 50 ]). 51:- use_module(r_serve). 52:- use_module(r_grammar). 53:- use_module(r_term). 54:- use_module(library(apply)). 55:- use_module(library(error)). 56:- use_module(library(lists)). 57:- use_module(library(debug)). 58:- use_module(library(quasi_quotations)). 59:- use_module(library(dcg/basics)). 60:- use_module(library(settings)). 61:- use_module(library(option)). 62 63:- multifile 64 r_init_session/1, % +Session 65 r_console/2, % +Type, ?Term 66 r_console_property/1, % ?Property 67 r_display_images/1. % +Images 68 69/** <module> R plugin for SWISH 70 71This module make R available to SWISH using the 72[Rserve](https://rforge.net/Rserve/) R package. The module r_serve.pl 73implements a SWI-Prolog wrapper around the Rserve C++ client to realise 74the communication with the R server. 75 76The Prolog view at R is inspired by 77[real](http://stoics.org.uk/~nicos/sware/real/) from Nicos Angelopoulos. 78 79It consists of the following two predicates: 80 81 - Var <- Expression 82 Assign the result of evaluating the given R Expression to Var. Var 83 can be a Prolog variable or an R expression. 84 - <- Expression 85 Evaluate expression, discarding the result. Possible console output 86 is captured. 87 88In addition, the _quasi quotation_ `r` is defined. The quasi quotation 89takes Prolog variables as arguments and an R expression as content. 90Arguments (Prolog variable names) that match R identifiers cause the 91temporary of an R variable with that name bound to the translated Prolog 92value. R quasi quotations can be used as isolated goals, as well as as 93right-hand arguments to <-/2 and <-/1. The example below calls the R 94plot() function on the given Prolog list. 95 96 ``` 97 ?- numlist(1,10,Data), 98 {|r(Data)||plot(Data)|}. 99 ``` 100 101Images created by the R session are transferred as SVG and sent to the 102SWISH console using pengine_output/1. 103*/ 104 105:- setting(rserve:socket, atom, '/home/rserve/socket', 106 "Unix domain socket for connecting to Rserve"). 107:- setting(rserve:host, atom, '127.0.0.1', 108 "Host for connecting to Rserve"). 109:- setting(rserve:port, integer, 6311, 110 "Port for connecting to Rserve"). 111 112%% (Var <- Expression) is det. 113% 114% Assign the result of evaluating the given R Expression to Var. 115% Var can be a Prolog variable or an R expression. 116 117Var <- Expression :- 118 var(Var), !, 119 ( var(Expression) 120 -> instantiation_error(Expression) 121 ; Expression = r_execute(Assignments, Command, Var) 122 -> r_execute(Assignments, Command, Var) 123 ; phrase(r_expression(Expression, Assignments), Command) 124 -> r_execute(Assignments, Command, Var) 125 ; domain_error(r_expression, Expression) 126 ). 127Var <- Expression :- 128 ( atom(Var), 129 r_primitive_data(Expression) 130 -> r_assign($, Var, Expression) 131 ; <-(Var<-Expression) 132 ). 133 134r_primitive_data(Data) :- 135 is_list(Data), !. 136r_primitive_data(Data) :- 137 compound(Data), !, fail. 138 139%% (<- Expression) is det. 140% 141% Evaluate Expression, discarding the result. Possible console 142% output is captured using the R function `capture.output`. 143 144<- Term :- 145 ( var(Term) 146 -> instantiation_error(Term) 147 ; Term = r_execute(Assignments, Command, _Var) 148 -> r_capture_output(Assignments, Command) 149 ; phrase(r_expression(Term, Assignments), Command) 150 -> r_capture_output(Assignments, Command) 151 ; domain_error(r_expression, Term) 152 ). 153 154%% r_capture(Assignments, Command) 155% 156% Execute Command, presenting the R console output to the (Prolog) 157% user. 158 159r_capture_output(Assignments, Command) :- 160 to_string(Command, CommandS), 161 r_assign($, 'Rserve.cmd', CommandS), 162 r_execute(Assignments, 163 "capture.output(eval(parse(text=Rserve.cmd)))", 164 Output), 165 emit_r_output(Output). 166 167to_string(Command, CommandS) :- 168 string(Command), !, 169 CommandS = Command. 170to_string(Command, CommandS) :- 171 string_codes(CommandS, Command). 172 173emit_r_output(Output) :- 174 r_console(stdout, Output), !. 175emit_r_output(Output) :- 176 maplist(writeln, Output). 177 178%! r_call(+Fun, +Options) 179% 180% Construct and possibly call an R function. Fun can be an atom or 181% a compound, eg plot, or plot(width=3). The predicate also 182% supports multiple output destinations. Options processed: 183% 184% - call(Bool) 185% If `false` (default `true`), do __not__ call the result. 186% - fcall(-Term) 187% Term is unified with the constructed call 188% - rvar(Var) 189% Variable for the output 190% 191% @compat This is a partial implementation of the corresponding 192% [real](http://www.swi-prolog.org/pack/file_details/real/prolog/real.pl) predicate. 193 194r_call(Func, Options) :- 195 partition(eq_pair, Options, XArgs, Options1), 196 extend(Func, XArgs, Call), 197 option(fcall(Call), Options1, _), 198 ( option(call(true), Options1, true) 199 -> ( option(rvar(Var), Options1) 200 -> Var <- Call 201 ; <- Call 202 ) 203 ; true 204 ). 205 206eq_pair(_=_). 207 208extend(Compound, XArgs, Term) :- 209 compound(Compound), !, 210 compound_name_arguments(Compound, Func, Args0), 211 append(Args0, XArgs, Args), 212 compound_name_arguments(Term, Func, Args). 213extend(Atom, XArgs, Term) :- 214 compound_name_arguments(Term, Atom, XArgs). 215 216 217%% r_console(+Stream, ?Term) 218% 219% Hook console interaction. Currently only used for <-/1 to emit 220% the captured output. In this cases, Stream is `stdout` and Term 221% is a list of strings, each representing a line of output. The 222% list can be empty. If the hook fails, maplist(writeln, Term) is 223% called to write the output to `current_output`. 224 225%% r_execute(+Assignments, +Command, -Result) is det. 226% 227% Execute the R command Command after binding the variables in 228% Assignments and unify the result with Result. 229% 230% @arg Assignments is a list of Name=Value, where Name must be a 231% valid R indentifier. 232% @arg Command is a string holding the R command to execute 233 234r_execute(Assignments, Command, Result) :- 235 r_setup_console($), 236 setup_call_cleanup( 237 maplist(r_bind, Assignments), 238 r_eval_ex($, Command, Result), 239 r_unbind(Assignments)), 240 r_send_images. 241 242r_bind(RVar=Value) :- 243 r_assign($, RVar, Value). 244 245%% r_unbind(+Bindings) 246% 247% Remove the created bindings from the R environment 248 249r_unbind([]) :- !. 250r_unbind(Bindings) :- 251 maplist(arg(1), Bindings, Vars), 252 phrase(r_remove(Vars), Command), 253 r_eval($, Command, _). 254 255r_remove(Vars) --> 256 "remove(", r_vars(Vars), ")". 257 258r_vars([H|T]) --> 259 atom(H), 260 ( {T==[]} 261 -> "" 262 ; ",", 263 r_vars(T) 264 ). 265 266%! r_setup_console(+R) 267% 268% Set the notion of R's console with to the width of the Prolog 269% console. This may be hooked by 270% r_console_property(size(Rows,Cols) to deal with e.g., SWISH. 271 272r_setup_console(R) :- 273 ( r_console_property(size(_Rows, Cols)) 274 -> true 275 ; tty_size(_Rows, Cols) 276 ), !, 277 format(string(Command), 'options(width=~d)', Cols), 278 r_eval(R, Command, _). 279r_setup_console(_). 280 281 282 /******************************* 283 * QUASI QUOTATION * 284 *******************************/ 285 286:- quasi_quotation_syntax(r). 287 288%% r(+Content, +Vars, +VarDict, -Goal) is det. 289% 290% Parse {|r(Arg,...||R-code|} into a the expression below. This 291% expression may be passed to <-/2 and <-/1 as well as used 292% directly as a goal, calling r_execute/3. 293% 294% r_execute(Assignments, Command, Result) 295% 296% @see https://cran.r-project.org/doc/manuals/r-release/R-lang.html#Parser 297% @tbd Verify more of the R syntax. 298 299r(Content, Vars, Dict, r_execute(Assignments, Command, _Result)) :- 300 include(qq_var(Vars), Dict, QQDict), 301 phrase_from_quasi_quotation( 302 r(QQDict, Assignments, Parts), 303 Content), 304 atomics_to_string(Parts, Command). 305 306qq_var(Vars, _=Var) :- 307 member(V, Vars), 308 V == Var, !. 309 310r(Dict, Assignments, [Pre|More]) --> 311 here(Here0), 312 r_tokens(_), 313 r_token(identifier(Name)), 314 here(Here1), 315 { memberchk(Name=Var, Dict), !, 316 Assignments = [Name=Var|AT], 317 diff_to_atom(Here0, Here1, Pre) 318 }, 319 r(Dict, AT, More). 320r(_, [], [Last]) --> 321 string(Codes), 322 \+ [_], !, 323 { atom_codes(Last, Codes) }. 324 325 326%% diff_to_atom(+Start, +End, -Atom) 327% 328% True when Atom is an atom that represents the characters between 329% Start and End, where End must be in the tail of the list Start. 330 331diff_to_atom(Start, End, Atom) :- 332 diff_list(Start, End, List), 333 atom_codes(Atom, List). 334 335diff_list(Start, End, List) :- 336 Start == End, !, 337 List = []. 338diff_list([H|Start], End, [H|List]) :- 339 diff_list(Start, End, List). 340 341here(Here, Here, Here). 342 343 344 /******************************* 345 * IMAGES * 346 *******************************/ 347 348:- multifile rserve:r_open_hook/2. 349 350%% rserve:r_open_hook(+Name, -R) 351% 352% Called for lazy creation to the Rserve server. Connections are 353% per-thread. The destination depends on settings: 354% 355% $ Unix domain socket : 356% If `rserve:socket` is defined and not empty, it is taken 357% as the path to a Unix domain socket to connect to. 358% $ TCP/IP socket : 359% Else, if `rserve:port` and `rserve:host` is defined, we 360% connect to the indicated host and port. 361% 362% After the connection is established, the session can be 363% configured using the hook r_init_session/1. The default calls 364% r_setup_graphics/2 to setup graphics output to send SVG files. 365 366rserver_open_hook($, R) :- 367 nb_current('R', R), !. 368rserver_open_hook($, R) :- 369 setting(rserve:socket, Socket), 370 Socket \== '', 371 access_file(Socket, exist), !, 372 debug(r(connect), 'Connecting to ~p ...', [Socket]), 373 r_open(R, 374 [ host(Socket), 375 port(-1) 376 ]), 377 r_setup(R). 378rserver_open_hook($, R) :- 379 setting(rserve:port, Port), 380 setting(rserve:host, Host), 381 debug(r(connect), 'Connecting to ~p ...', [Host:Port]), 382 r_open(R, 383 [ host(Host), 384 port(Port) 385 ]), 386 r_setup(R). 387 388r_setup(R) :- 389 thread_at_exit(r_close(R)), 390 debug(r, 'Created ~p', [R]), 391 call_init_session(R), 392 nb_setval('R', R), !. 393 394call_init_session(R) :- 395 r_init_session(R), !. 396call_init_session(R) :- 397 r_setup_graphics(R, svg). 398 399%% r_init_session(+RConn) is semidet. 400% 401% Multifile hook that is called after the Rserve server has handed 402% us a new connection. If this hook fails, r_setup_graphics/2 is 403% called to setup capturing graphics as SVG files. 404 405%% r_setup_graphics(+Rconn, +Format) is det. 406% 407% Setup graphics output using files. Currently only supports 408% `Format = svg`. 409 410r_setup_graphics(R, svg) :- 411 r_eval(R, "mysvg <- function() { 412 svg(\"Rplot%03d.svg\") 413 par(mar=c(4,4,1,1)) 414 } 415 options(device=mysvg)", X), 416 debug(r, 'Devices: ~p', [X]), 417 nb_setval('Rimage_base', 'Rplot'), 418 nb_setval('Rimage_ext', 'svg'). 419 420%% r_send_images is det. 421% 422% Collect the images saved on the server and send them to SWISH 423% using pengine_output/1. 424 425r_send_images :- 426 r_images(Images), !, 427 length(Images, Count), 428 debug(r, 'Got ~d images~n', [Count]), 429 r_send_images(Images). 430r_send_images. 431 432r_send_images(Images) :- 433 r_display_images(Images), !. 434r_send_images(Images) :- 435 print_message(warning, r_images(Images)). 436 437%% r_display_images(+Images:list) 438% 439% Hook to display images. 440% 441% @arg Images is a list of images. Each image is of the form 442% Format(String), where Format is the file extension. Currently 443% only uses `svg`. If not defined, print_message/2 is called 444% with the term r_images(Images). 445 446%% r_images(-Images:list) is semidet. 447% 448% Collect saved image files from Rserve. This assumes that 449% 450% 1. The R connection is in the global variable =R=. If 451% there is no connection, there are no images. 452% 2. There are only images if there is a current device. 453% This is closed using =|dev.off()|=. 454% 3. Images are called <base>%03d.<ext>, where <base> is 455% in the global variable =Rimage_base= and <ext> in 456% =Rimage_ext=. 457 458r_images(List) :- 459 nb_current('R', _), 460 ( r_eval($, "names(dev.list())", Devices), 461 Devices = ["svg"|_] 462 -> r_eval($, "dev.off()", _), 463 r_fetch_images(1, List) 464 ). 465 466r_fetch_images(I, Images) :- 467 nb_getval('Rimage_base', Base), 468 nb_getval('Rimage_ext', Ext), 469 format(string(Name), "~w~|~`0t~d~3+.~w", [Base,I,Ext]), 470 debug(r, 'Trying ~p~n', [Name]), 471 ( catch(r_read_file($, Name, Content), E, r_error_fail(E)) 472 -> debug(r, 'Got ~p~n', [Name]), 473 Image =.. [Ext,Content], 474 Images = [Image|Rest], 475 ( debugging(r(plot)) 476 -> save_plot(Name, Content) 477 ; true 478 ), 479 I2 is I+1, 480 r_fetch_images(I2, Rest) 481 ; Images = [] 482 ). 483 484r_error_fail(error(r_error(70),_)) :- !, fail. 485r_error_fail(Error) :- print_message(warning, Error), fail. 486 487save_plot(File, Data) :- 488 setup_call_cleanup( 489 open(File, write, Out, [type(binary)]), 490 format(Out, '~s', [Data]), 491 close(Out)). 492 493 494 /******************************* 495 * MESSAGES * 496 *******************************/ 497 498:- multifile 499 prolog:message//1. 500 501prologmessage(r_images(Images)) --> 502 { length(Images, Count) }, 503 [ 'Rserve sent ~d images files.'-[Count], nl ], 504 [ 'Define r_call:r_display_images/1 to display them.'-[] ]