1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    2%    Authors:       Nicos Angelopoulos, Vitor Santos Costa
    3%    Contributor:   Jan Wielemaker, restructuring of C code for first public version
    4%    Contributor:   Samer Abdallah, improvements to threads and setting R_HOME (2015)
    5%    Contributor:   Jan Wielemaker, 16.07.29, some compiling and tidying up in including Real in Swish, and creating new Rserve pack
    6%    E-mail:        Nicos Angelopoulos firstn.lastn@gmail.com
    7%    Copyright (C): Nicos Angelopoulos, Vitor Santos Costa
    8%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
    9/*
   10   This program is free software; you can redistribute it and/or
   11    modify it under the terms of MIT license
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
   16
   17*/
   18
   19:- module(real, [
   20     r/2,
   21     r/1,
   22     r_call/2,
   23     r_char/2,
   24     r_citation/2,
   25     r_devoff/0,
   26     r_devoff_all/0,
   27     r_end/0,  % not working currently, just prints warning
   28     r_is_var/1,
   29     r_is_var/2,
   30     r_library/1,
   31     r_remove/1,
   32     r_serve/0,
   33     r_start/0,
   34     r_started/1,
   35     r_thread_loop/0,
   36     r_start_server/0,
   37     r_call_as_server/1,
   38     r_version/3,
   39     r_wait/0,
   40     (<-)/1,
   41     (<-)/2,
   42     (<<-)/1,
   43     (<<-)/2,
   44     op(950,fx,<-),
   45     op(950,yfx,<-),
   46     op(950,yfx,<<-),
   47     op(950,xf,<<-),   % maybe this should be fx.  <<- Rvar
   48     op(600,xfy,~),
   49     % op(400,yfx,'%x%'),  % function exists
   50     % op(400,yfx,'%%'),   % mod
   51     % op(400,yfx,'%/%'),  % //
   52     op(400,yfx,@*@),      % %*%  matrix inner product
   53	op(400,yfx,@^@),      % %o%  array outer product
   54     op(400,yfx,@~@),      % %in% set membership
   55
   56     op(400,yfx,$),
   57     op(400,yfx,@),
   58     op(800,fx,@),
   59     op(700,fx,!),
   60     op(700,fx,~),
   61     op(700,xfx,<=),
   62     % op(750,xfy,;),  % tmp? sustitute for |
   63     op(750,xfy,::), % tmp? sustitute for ||
   64     op(750,xfy,&),
   65     op(750,xfy,&&),
   66     op(400,xfy,=+),
   67     op(500,xfy,++), % R option appending, r_call/2
   68     op(100, yf, [])
   69     % op(100, yf, '()')
   70     ]).   71
   72:- multifile
   73     user:portray/1.   74:- dynamic
   75     user:portray/1.   76:- dynamic
   77     real_server_thread/1,
   78     r_started/0.   79
   80:- use_module(library(shlib)).   81:- use_module(library(lists)).   82:- use_module(library(apply_macros)).   83:- use_module(library(charsio)).   84:- use_module(library(readutil)).   85:- use_module(library(debug)).

An interface to the R statistical software.

Introduction

This library enables the communication with an R process started as a shared library. Version 1, was the result of the efforts of two research groups that have worked in parallel. The syntactic emphasis on a minimalistic interface. Versions between 1.4 and 2.0, also work done by others particularly in interfacing to web applications. See credits for more details.

In the doc/ directory of the distribution there is user's guide, a published paper and html documentation from PlDoc. There is large number of examples in examples/for_real.pl.

By default when the library is loaded an R object is started which will serve the R commands. If current_prolog_flag(real_start,false) succeeds, the R object is not loaded and the user needs to issue r_start/0 to do that.

A single predicate (<-/2,<-/1) channels the bulk of the interactions between Prolog and R. In addition to using R as a shared library, real uses the c-interfaces of SWI/Yap and R to pass objects in both directions. The usual mode of operation is to load Prolog values on to R variables and then call R functions on these values. The return value of the called function can be either placed on R variable or passed back to Prolog. It has been tested extensively on current SWI and YAP on Linux machines but it should also compile and work on MS operating systems and Macs.

Since v1.1 Real supports threads for web services and v1.3 it supports running an R server in any thread, not just the main thread. The library now has the concept of a designated R server thread. By default, there is no designated server thread, and the evaluation/execution of R expressions/commands is done in the calling thread. This should be done in a single threaded way. A designated server thread can come into existence in one of three ways:

  1. By starting a dedicated server thread using r_start_server/0.
  2. By running r_thread_loop/1 in any thread. This will run until a message to quit the thread is received by executing r(r_thread_loop_stop) or <- r_thread_loop_stop in any thread.
  3. By running any goal G as r_call_as_server(G). While G is running, the thread that it is running in becomes the designated server thread, and G should call r_serve/0 periodically to answer any R requests that accumulate. While there is a designated server thread, a call to r/1, r/2, (<-)/1 or (<-)/2 in any thread results in the request being posted to the server thread and the current thread blocking until a reply is received. As of July 2016 SWI-Prolog also has an alternative pack (pack(rserve_client)) which works with Rserve and Swish.

The main modes for utilising the interface are

     <- +Rexpr
     <- +Rvar
Print  Rvar or evaluate expression Rexpr in R
     +Rvar   <- +PLdata
     +Rexpr  <- +PLdata
     -PLvar  <- +Rvar
     -PLvar  <- +Rexpr
     +Rexpr1 <- +Rexpr2

Pass Prolog data to R, pass R data to Prolog or assign an R expression to an assignable R expression.

Testing

There is a raft of examples packed in a sinlge file that test the library.

     ?- [pack(real/examples/for_real)].

     ?- for_real.

     ?- edit( pack(real/examples/for_real) ).

Syntax

There are syntactic conventions in R that make unparsable prolog code. Notably function and variable names are allowed to contain dots, square brackets are used to access parts of vectors and arrays and functions are allowed empty argument tuples. We have introduced relevant syntax which allows for easy transition between prolog and R. Prolog constructs are converted by the library as follows:

Data transfers

R vectors are mapped to prolog lists and matrices are mapped to nested lists. The convention works the other way around too.

There are two ways to pass prolog data to R. The more efficient one is by using

 Rvar <- PLdata

Where Pldata is one of the basic data types (number,boolean) a list or a c/n term. This transfers via C data between R and Prolog. In what follows atomic PLval data are simply considered as singleton lists. Flat Pldata lists are translated to R vectors and lists of one level of nesting to R matrices (which are 2 dimensional arrays in R parlance). The type of values of the vector or matrice is taken to be the type of the first data element of the Pldata according to the following :

Booleans are represented in prolog as true/false atoms. Currently arrays of aribtrary dimensions are not supported in the low-level interface. Note that in R a scalar is just a one element vector. When passing non-scalars the interface will assume the type of the object is that of the first scalar until it encounters something different. Real will currently re-start and repopulate partial integers for floats as illustrated below:

r <- [1,2,3].         % pass 1,2,3 to an R vector r
R <- r.               % pass contents of R vector r to Prolog variable R
R = [1, 2, 3].

i <- [1,2,3.1].       % r is now a vector of floats, rather than integers
I <- i.
I = [1.0, 2.0, 3.1].

However, not all possible "corrections" are currently supported. For instance,

?- c <- [a,b,c,1].
ERROR: real:set_r_variable/2: Type error: `boolean' expected, found `a'

In the data passing mode we map Prolog atoms to R strings-

?- x <- [abc,def].
true.

?- <- x.
[1] "abc" "def"
true.

?- X <- x.
X = [abc, def].

In addition, Prolog data can be passed through the expression mechanism. That is, data appearing in an arbitrary R expression will be parsed and be part of the long string that will be passed from Prolog to R for evaluation. This is only advisable for short data structures. For instance,

tut_4a :-
    state <- c(+"tas", +"sa",  +"qld", +"nsw", +"nsw"),
    <- state.

tut_4b :-
    state <- c(+tas, +sa,  +qld, +nsw, +nsw),
    <- state.

Through this interface it is more convenient to be explicit about R chars by Prolog prepending atoms or codes with + as in the above example.

The Prolog atoms '$NaN' and '' are passed to NA values in R. '$NaN' is the bidirectional value, '' is only understood in the Prolog -> R direction as it is useful for passing missing values from CSV read matrices.

nan_ex :-
    x <- [c(1,2,''),c(3,4,'$NaN')],
    X <- x,
    write( x(X) ), nl.

?- nan_ex.
x( [[1, 2, '$NaN'], [3, 4, '$NaN']] )

Other predicates

Use r_citation/2 to access publication information about the interface. Although the original name was R..eal, when citating please use Real as the name for this library.

The library listens to

?- debug(real).
?- nodebug(real).

Predicate <<-/2 is a shorthand that ensures that the R variable on the left is fresh/new at the time of call, and <<-/1 blanks R variable out (r_remove/1).

Examples


?- e <- numeric(.).
yes
?- e^[3] <- 17.
yes
?- e[3] <- 17.
yes
?- Z <- e.
Z = ['$NaN','$NaN',17.0]
?- e^[10] <- 12.
yes
?- Z <- e.
Z = ['$NaN','$NaN',17.0,'$NaN','$NaN','$NaN','$NaN','$NaN','$NaN',12.0]

rtest :-
     y <- rnorm(50),               % get 50 random samples from normal distribution
     <- y,                         % print the values via R
     x <- rnorm(y),                % get an equal number of normal samples
     <- x11(width=5,height=3.5),   % create a plotting window
     <- plot(x,y)                  % plot the two samples
     r_wait,                       % wait for user to hit Enter
     % <- dev..off(.).             % old syntax, still supported
     <- dev..off().                % close the plotting window. foo() now acceptable in supported Prologs

tut6 :-
     d <- outer(0:9, 0:9),
     fr <- table(outer(d, d, "-")),
     <- plot(as..numeric(names(fr)), fr, type="h", xlab="Determinant", ylab="Frequency").

tut4b :-
     state <- [tas,sa,qld,nsw,nsw,nt,wa],
     statef <- factor(state),
     incmeans <- tapply( c(60, 49, 40, 61, 64, 60, 59), statef, mean ),
     <- incmeans.

logical :-
     t <- [1,2,3,4,5,1],
     s <- t==1,
     <- s,
     S <- s,
     write( s(S) ), nl.

Info

author
- Nicos Angelopoulos
- Vitor Santos Costa
version
- 2:1:0, 2020/5/29, swi8_2
See also
- http://stoics.org.uk/~nicos/sware/real
- ?- pack(real/examples/for_real), for_real
- pack(real/doc/real.html)
- pack(real/doc/guide.pdf)
- pack(real/doc/padl2013-real.pdf)
- http://www.r-project.org/

*/

license
- MIT
  357%%%
  358
  359init_r_env :-
  360     getenv('R_HOME',Path),
  361     % done, except if in windows...
  362     \+ current_prolog_flag(windows, true),
  363     !,
  364     debug( real, 'Found R_HOME: ~a', [Path] ).
  365:- if(current_predicate(win_registry_get_value/3)).  366init_r_env :-
  367     % windows is windows
  368        current_prolog_flag(windows, true),
  369     ( HKEY='HKEY_LOCAL_MACHINE/Software/R-core/R';
  370          HKEY='HKEY_CURRENT_USER/Software/R-core/R' ),
  371        catch(win_registry_get_value(HKEY,'Current Version', Version),_,fail),
  372     !,
  373     atomic_list_concat([HKEY,Version],'/',SecondKey),
  374     win_registry_get_value(SecondKey,'InstallPath', RPath), !,
  375     setenv('R_HOME',RPath), % this probably does not help (at least not XPs)
  376     % now we need to have the DLL in our path
  377     % nicos: although on xp it seems that path has to already be set.
  378     ( current_prolog_flag(address_bits, 64) ->
  379          Psf = '\\bin\\x64'
  380          ;
  381          Psf = '\\bin\\i386'
  382     ),
  383     atomic_list_concat( [RPath,Psf], ToR ),
  384     install_in_ms_windows(ToR).
  385:- endif.  386init_r_env :-
  387     % SA: this should work whenever R is in the path
  388     absolute_file_name(path('R'),_,[access(execute)]), !,
  389     setup_call_cleanup( open(pipe('R RHOME'),read,Stream),
  390                         read_line_to_codes(Stream,Codes),
  391                         close(Stream)),
  392     atom_codes(Home,Codes),
  393     debug( real, 'Setting R_HOME to: ~a', [Home] ),
  394     setenv('R_HOME',Home).
  395init_r_env :-
  396        current_prolog_flag(unix, true),
  397     % typical Linux 64 bit setup (fedora)
  398     current_prolog_flag(address_bits, 64),
  399     Linux64 = '/usr/lib64/R',
  400     exists_directory(Linux64), !,
  401     debug( real, 'Setting R_HOME to: ~a', [Linux64] ),
  402     setenv('R_HOME',Linux64).
  403init_r_env :-
  404     current_prolog_flag(unix, true),
  405     % typical Linux  setup (Ubuntu)
  406     Linux32 = '/usr/lib/R',
  407     exists_directory( Linux32 ), !,
  408     debug( real, 'Setting R_HOME to: ~a', [Linux32] ),
  409     setenv('R_HOME',Linux32).
  410% nicos, fixme: Linux multilib ?
  411
  412init_r_env :-
  413     % typical MacOs setup
  414     exists_directory('/Library/Frameworks'), !,
  415     install_in_osx.
  416init_r_env :-
  417     absolute_file_name( path('R'), This,
  418                [ extensions(['',exe]),
  419                  access(execute),
  420                  file_errors(fail) % Wouter Beek, 14.03.18
  421                ] ),
  422     dirpath_to_r_home( This, Rhome ),
  423     exists_directory( Rhome ), !,
  424     debug( real, 'Setting R_HOME to bin relative: ~a', [Rhome] ),
  425     setenv('R_HOME',Rhome).
  426init_r_env :-
  427     throw( real_error(r_root) ).
  428
  429% track down binary through symbolic links...
  430%
  431dirpath_to_r_home( This0, Rhome ) :-
  432     read_link(This0, _, This), !,
  433     dirpath_to_r_home( This, Rhome ).
  434dirpath_to_r_home( This, Rhome ) :-
  435     file_directory_name( This, R1 ),
  436     file_base_name(R1, Execdir) ->
  437     ( Execdir == bin ->
  438       Rhome = R1
  439     ;
  440       % windows with multiple binaries
  441       file_directory_name( R1, R2 ),
  442       file_base_name(R2, bin),
  443       file_directory_name( R2, Rhome )
  444     ).
  445
  446r_home_postfix( 'lib64/R' ) :-
  447     current_prolog_flag(address_bits, 64).
  448r_home_postfix( 'lib/R' ).
  449
  450to_nth( [To|T], To, T ) :- !.
  451to_nth( [_H|T], To, Right ) :-
  452     to_nth( T, To, Right ).
  453
  454% nicos: This should become the standard way.  2013/01/02.
  455:- if(current_predicate(win_add_dll_directory/1)).  456install_in_ms_windows( ToR ) :-
  457     debug( real, 'Setting up ms-wins dll directory: ~a', [ToR] ),
  458     win_add_dll_directory( ToR ),
  459     install_in_ms_windows_path( ToR ).
  460:- else.  461install_in_ms_windows(RPath) :-
  462     install_in_ms_windows_path( RPath ).
  463:- endif.  464
  465install_in_ms_windows_path(RPath) :-
  466     getenv('PATH',OPath),
  467     atomic_list_concat([OPath,';',RPath],Path),
  468     % if you have problems with R associated dlls, you might also want to add:
  469     % atomic_list_concat([IPath,';',RPath,'\\modules\\i386'],Path),
  470     debug( real, 'Changing wins path to: ~a', [Path] ),
  471     setenv('PATH',Path).
  472
  473install_in_osx :-
  474     current_prolog_flag(address_bits, 64),
  475     Mac64 = '/Library/Frameworks/lib64/R',
  476     exists_directory(Mac64), !,
  477     debug( real, 'Setting R_HOME to: ~a', [Mac64] ),
  478     setenv('R_HOME',Mac64).
  479install_in_osx :-
  480     % typical MacOs setup
  481     MacTypical = '/Library/Frameworks/R.framework/Resources',
  482     exists_directory(MacTypical), !,
  483     debug( real, 'Setting R_HOME to: ~a', [MacTypical] ),
  484     setenv('R_HOME', MacTypical).
  485install_in_osx :-
  486     LastMac = '/Library/Frameworks/lib/R',
  487     ( exists_directory(LastMac) ->
  488     debug( real, 'Setting R_HOME to: ~a', [LastMac] )
  489          ;
  490          debug( real, 'Setting R_HOME to non-existing: ~a', [LastMac] )
  491     ),
  492     setenv('R_HOME', LastMac ).
  493
  494% interface predicates
 r_start is det
Start an R object. This is done automatically upon loading the library, except if current_prolog_flag( real_start, false) succeeds. Only 1 instance should be started per Prolog session. Calls to the predicate when the R object is loaded and connected to succeed silently but have no useful side-effects.
  503r_start :-
  504     r_started(false), !,
  505     swipl_wins_warn,
  506     init_r_env,
  507     use_foreign_library(foreign(real)),
  508     init_r,
  509     assert( r_started ).
  510r_start :-
  511     r_started(true), !,
  512     print_message(informational,real_error(r_already_started)).
  513
  514% SA: Disabled for now, as it does not seem to have any effect, and
  515% calling r_start after r_end results in a crash.
  516% nicos: Made this print a warning instead.
  517%% r_end.
  518%
  519%    End the connection to the R object.
  520%    Currently this only prints a warning.
  521%
  522% r_end :-
  523%      stop_r,
  524%      retractall( r_started ).
  525%
  526r_end :-
  527     print_message( informational, real_error(stop_r_is_buggy) ).
 r_started(-F:boolean) is det
Unifies F with true if R has been started or false if not.
  532r_started(F) :- r_started -> F=true; F=false.
 <-(+Rvar)
<-(+Rexpr)
If Rvar is an atom and a known R object, then print Rvar on R. Else treat the input as an R expression and pass it on R for interpretation. (Throws result away, if expression is not a <- expression itself).
  541'<-'(X) :-
  542     r(X).
 <-(+Rexpr, +PLdata)
<-(-PLvar, +Rexpr)
<-(+Rexpr1, +Rexpr2)
Pass Prolog data PLdata to Rvar. PLdata is a term that is one of: an atomic value, flat list or list of depth 2. This mode uses the C-interface to pass the value to an R variable.

Pass PLdata to an assignable R expression.

Pass Rvar to PLvar variable via the C-interface.

Evaluate Rexpr and store its return value to PLvar.

Pass Rexpr1 <- Rexpr2 to R.

Note that all Rexpr* are first processed as described in the section about syntax before passed to R. Real also looks into Rexpressions and passes embeded lists to hidden R variables in order to pass large data efficiently.

c/n terms are recognised as PLdata if and only if they contain basic data items in all their arguments that can be cast to a single data type. This builds on the c() function of R that is a basic data constructor. Currently c/n terms are not recognised within nested expressions. But a mechanism similar to the hidden variables for Prolog lists in expressions should be easy to implement.

  571'<-'(X,Y) :-
  572     r(X,Y).
 <<-(Rvar)
Nick name for r_remove( Rvar ).

See r_remove/1.

  579'<<-'( X ) :-
  580     r_remove( X ).
 <<-(+Rv, +Expr)
True iff Rv is a undefined R variable and Rv <- Expr succeeds. If Rv is not an atom or if its an atom that corresponds to an R variable the predicate errors.

See r_new/1 for a predicate that fails instead in a similar context.

 ?- x <<- [1,2,3].
 true.

 ?- x <<- [1,2,3].
 ERROR: First argument of <<- exists as R variable: x.
  596'<<-'(X,Y) :-
  597     r_new(X),
  598     !,
  599     r( X, Y ).
  600'<<-'(X,_Y) :-
  601     atom( X ),
  602     r_is_var(X),
  603     !,
  604     throw( real_error(r_new_exists(X)) ).
  605'<<-'(X,_Y) :-
  606     \+ atom( X ),
  607     !,
  608     throw( real_error(r_new_var(X)) ).
  609'<<-'(X,_Y) :-
  610     throw( real_error(r_new_inconsistent(X)) ).
 r(R)
Nickname for <-(R).
  616r( R ) :-
  617     var( R ),
  618     !,
  619     % fixme: print better message
  620     throw(error(instantiation_error,r/1)).
  621r( R ) :-
  622     real_server_thread( Server ),
  623     real_thread_self( Self ),
  624     Self \== Server,
  625     !,
  626     r_thread( Server, Self, r(R) ).
  627r( R ) :-
  628     r_term( R ).
  629
  630r_term( Lib ) :-
  631     Lib = library(R),
  632     !,
  633     r_library( R ).
  634r_term( RvarIn ) :-
  635     (  rvar_identifier(RvarIn,_,RvarCs) ->
  636        true
  637        ; (atom(RvarIn),atom_codes(RvarIn,RvarCs))
  638     ),
  639     !,
  640     atom_codes('print( ', PrintOpen), % JW: I think we should be using atoms
  641     atom_codes(' )', PrintClose),     % JW: all along
  642     append([PrintOpen,RvarCs,PrintClose], CmdCodes),
  643     atom_codes( Cmd, CmdCodes ),
  644     r_send( Cmd ).
  645r_term( A ++ B ) :-
  646     !,
  647     r_call( A, B ).
  648r_term( Term ) :-
  649     rexpr( Term, TmpRs, R ),
  650     !,
  651     r_send( R ),
  652     maplist( r_remove, TmpRs ).
  653r_term( _Other ) :-
  654     % fixme: print "proper" error
  655     write( user_error, 'Cannot use input to <-/1.' ), nl, nl,
  656     fail.
 r(?L, +R)
Nickname for <-(L,R).
  662r( A, B ) :-
  663     real_server_thread( Server ),
  664     real_thread_self( Self ),
  665     Self \== Server,
  666     debug( real, 'Calling from thread:~p', Self ),
  667     !,
  668     r_thread( Server, Self, r(A,B) ).
  669     % thread_send_message( main, real_call(Caller,Real) ),
  670     % thread_get_message( Caller, real_ply(Ball,Real) ),
  671     % fixme: we should be able to write the caught Ball here, except if it is
  672     % is thread related, in which case possibilities are probably also limited
  673
  674r( A, B ) :-
  675     r_assign( A, B ).
  676
  677/*
  678r( A, B ) :-
  679     current_prolog_flag( real, thread ),
  680     !,
  681     debug( real, 'Using R on thread',  [] ),
  682     r_thread( r(A,B) ).
  683     */
  684r_assign( C, A ++ B ) :-
  685     !,
  686     r_call( A, [rvar(C)|B] ).
  687r_assign( Plvar, RvarIn ) :-
  688     var(Plvar),
  689     rvar_identifier( RvarIn, RvarIn, _ ),
  690     !,
  691     debug( real, 'Assigning to Prolog variable R variable ~a',  [RvarIn] ),
  692     robj_to_pl_term( RvarIn, Plvar ).
  693%   Plvar <- Rexpr.
  694r_assign( Plvar, Rexpr ) :-
  695     var(Plvar),
  696     rexpr( Rexpr, TmpRs, R ),
  697     !,
  698     debug( real, 'Assigning to Prolog variable R expression ~a',  [R] ),
  699     atom_codes( R, Rcodes ), % fixme, make the following take atoms
  700     rexpr_to_pl_term( Rcodes, Plvar ),
  701     maplist( r_remove, TmpRs ).
  702%  Rvar <- Plval.
  703r_assign( RvarIn, PlrExpr ) :-
  704     assignment( PlrExpr, RvarIn ),
  705     !.
  706%  Rexpr1 <- Rexpr2
  707r_assign( LRexpr, RRexpr ) :-
  708     rexpr('<-'(LRexpr,RRexpr),TmpRs,R),
  709     !,
  710     r_send( R ),
  711     maplist( r_remove, TmpRs ).
  712r_assign( _Plvar, _Rexpr ) :-
  713     write( user_error, 'Cannot decipher modality of <-/2. \n ' ), nl,
  714     fail.
  715
  716% r_start_server is det.
  717%
  718% Starts a new thread running r_thread_loop/0 as an R server.
  719% The created thread is given an alias of 'real' and is detached.
  720% If more control over thread creation is required, then you can
  721% create the thread yourself and call r_thread_loop within it.
  722%
  723% Once started, any calls to r/1, r/2, (<-)/1, or (<-)/2 work by passing
  724% a message to the server thread and waiting for a response.
  725% See r_call_as_server/1 for an alternative approach to multithreaded
  726% R programming.
  727%
  728% @throws real_error(server_already_running(ThreadId)) if another thread
  729% has already been designated as an R server.
  730r_start_server :-
  731   r_check_no_server,
  732   thread_create(r_thread_loop, _, [alias(real),detached(true)]).
  733
  734
  735% r_call_as_server(Goal).
  736%
  737% Calls Goal with the current thread designated as an R serving thread. This
  738% means that any other thread that calls an R goal will send a request to this thread.
  739% By using this predicate, you agree to check for and execute
  740% and R requests by calling r_serve/0 periodically.
  741% While this goal is running, any attempt to create a new R server thread will
  742% result in an exception.
  743%
  744% @throws real_error(server_already_running(ThreadId)) if another thread
  745% has already been designated as an R server.
  746r_call_as_server(Goal) :-
  747     r_check_no_server,
  748     thread_self( Me ),
  749     debug(real, 'Running as R server on ~w: ~q...',[Me,Goal]),
  750     setup_call_cleanup(
  751        assert( real_server_thread(Me) ),      Goal,
  752        retractall( real_server_thread(_) ) ).
  753
  754r_check_no_server :-
  755   (  real_server_thread(TID)
  756   -> throw(real_error(server_already_running(TID)))
  757   ;  true
  758   ).
 r_thread_loop is det
Starts a loop that serves R calls received from <-/1 and <-/2 calls from other threads. It can be run on any thread as long as no other thread is running an R serving thread. If there is, an exception is thrown. To stop it, query from any thread in the pool:
   <- r_thread_loop_stop.
  772r_thread_loop :-
  773     r_call_as_server( r_thread_loop_body ).
  774
  775r_thread_loop_body :-
  776     thread_get_message( Mess ),
  777     r_thread_message( Mess ).
  778
  779r_thread_message( quit ) :-
  780     !,
  781     halt(0).
  782r_thread_message( real_call(Caller,Goal) ) :-
  783     debug( real, 'In r_thread_loop got ~p, from ~p', [Goal,Caller] ),
  784     r_thread_serve( Goal, Caller ).
  785
  786r_thread_serve( r(r_thread_loop_stop), Caller ) :-
  787     % debug( real, 'In r_thread_loop2 got ~p from ~p', [Goal,Caller] ),
  788     % Goal =.. [Name|Args],
  789     % debug( real, 'Name ~p args ~p', [Name,Args] ),
  790     % Goal = <-(r_thread_loop_stop),
  791     !,
  792     debug( real, 'Caught stop_loop signal from caller: ~p', Caller ),
  793     thread_send_message( Caller, real_ply(yes,r(r_thread_loop_stop))).
  794r_thread_serve( Goal, Caller ) :-
  795     reify( Goal, Result ),
  796     debug( real, 'Called ~p, result ~p', [Goal,Result] ),
  797     thread_send_message( Caller, real_ply(Result,Goal) ),
  798     r_thread_loop_body.
 r_serve
Serves any R calls that are waiting on the thread queue. The queue is populated by calls to <-/1 and <-/2 that are called on other threads. The predicate succeeds if there are no calls in the queue.

This predicate must be called in the context of r_call_as_server/1; this is required to ensure that the current thread is designated as an R server thread, so that R evaluations from other threads are properly redirected to this thread.

throws
- real_error(no_server_thread) if no thread has been designated a server thread.
- real_error(thread_server_mismatch(T1,T2) if r_serve/0 is called on thread T1 but the designated server thread is T2.
  814r_serve :-
  815     thread_self( Me ),
  816     ( real_server_thread( Server ) -> true; throw(real_error(no_server_thread))),
  817     ( Server\=Me -> throw(real_error(server_thread_mismatch(Me,Server))); true),
  818     thread_peek_message( _G),
  819     !,
  820     thread_get_message( real_call(Caller,Goal) ),
  821     debug( real, 'In main got ~p, from ~p', [Goal,Caller] ),
  822     reify( with_mutex( real, Goal ), Result ),
  823     debug( real, 'Called ~p, result ~p', [Goal,Result] ),
  824     thread_send_message( Caller, real_ply(Result,Goal) ),
  825     r_serve.
  826r_serve.
  827
  828r_thread( Eval, Caller, Real ) :-
  829     % thread_self(Caller),
  830     debug( real, 'Sending call ~p from caller ~p to evaluator ~p', [Real,Caller,Eval] ),
  831     thread_send_message( Eval, real_call(Caller,Real) ),
  832     thread_get_message( Caller, real_ply(Result,Real) ),
  833     debug( real, 'Caller ~p received goal ~p and got result ~p', [Caller,Real,Result] ),
  834     reflect( Real, Result ).
  835
  836reify( Goal, Result) :-
  837   (  catch( (Goal,Result=yes), Ex, Result=ex(Ex) ) -> true
  838   ;  Result = no
  839   ).
  840
  841reflect(_,yes) :- !.
  842reflect(Real,ex(Ex)) :- throw(real_error(thread(Real,Ex))).
 r_is_var(+Rvar)
True if Rvar is an atom and a known variable in the R environment.
  846r_is_var( Rvar ) :-
  847     r_is_var( Rvar, _ ).
 r_is_var(+Rvar, -RvarAtom)
True if Rvar is a term and a known variable in the R environment. RvarAtom is the atomic representation of the Rvar term.
  853r_is_var( RvarIn, Rvar ) :-
  854     atom(RvarIn), !,
  855     is_r_variable(RvarIn),
  856     RvarIn = Rvar.
  857r_is_var( RvarIn, Rvar ) :-
  858     rvar_identifier( RvarIn, Rvar, _RvarAtom ),
  859     is_r_variable( Rvar ),
  860     rexpr( mode(Rvar), [], Rmode ),
  861     atom_codes( Rmode, RmodeCs ), % fixme, make the following take atoms
  862     rexpr_to_pl_term( RmodeCs, Plmode ),
  863     RvarModes  = [character,complex,list,logical,'NULL',numeric,raw,'S4'],
  864     memberchk( Plmode, RvarModes ).
 r_char(+Atomic, +RcharAtom)
Wrap an atomic value with double quotes so it can pass as an R char type. This is more or less obsolete. You can use +Atomic directly in R expressions.
  871r_char( Atomic, Rchar ) :-
  872    atomic( Atomic ),
  873    !,
  874    atomic_list_concat( ['"',Atomic,'"'], Rchar ).
 r_devoff
Close the current plot devise without any reporting. Short for <- invisible('dev.off'()').
  878r_devoff :-
  879     <- invisible(-'dev.off()').
 r_devoff_all
Close all open devices.
  885r_devoff_all :-
  886     Dev <- 'dev.cur()',
  887     Dev > 1,
  888     !,
  889     r_devoff,
  890     r_devoff_all.
  891r_devoff_all.
 r_new(+Rvar)
True iff Rvar is an atom and not a current R variable. The predicate fails silently otherwise.

See <<-/2 for a version that throws errors in a similar scenario.

 ?- r_new( x ).
 true.
 ?- x <- [1,2,3].
 true.
 ?- r_new( x ).
 fail.
 ?- x <<- true.
  911r_new( Rv ) :-
  912     atomic( Rv ),
  913     \+ r_is_var( Rv ).
 r_wait
Currently only waiting for Return to be pressed.
  918r_wait :-
  919     write('Press Return to continue...'), nl,
  920     read_line_to_codes(user_input, _).
 r_library(+Rlib)
Load Rlib while respecting prolog_flag/2 real_suppress_lib_messages.

By default and when the flag is not defined messages are suppressed by wrapping the call to R's suppressPackageStartupMessages().

If you want the messages, use

 ?- set_prolog_flag( real_suppress_lib_messages, false ).

The predicate first looks into all subdirs of R_LIB_REAL for Rlib, Rlib.r and Rlib.R which allows to use local implementations rather than library packages. This is useful if you have made changes to a publically available R package that has a single file entry point. You can then use the local version for your purposes but allow others to also use your Real code with the puablic R function without any changes to the interface calls. The usual scenario is that the local version has a couple of extra arguments that specialises usage. Interface predicates to the R package can happily thus work with either version.

For instance, assume file '/home/user/r/lib/pheatmap.r' is a local file that can be independently sourced and corrensponds to the main function file of R's package pheatmap. Then the following code will source the local copy rather than look for the package installed via R.

 ?- setenv( 'R_LIB_REAL', '/home/user/r/lib' ), debug(real), r_library(pheamap).
 % Sending to R: source("/home/nicos/islp/r/lib/pheatmap.R")

If you want to use locally installed packages include their root location to R_LIB_USER (as per R documentation).

Examples:

  ?- r_library( ggplot2 ).
  ?- r_library( "ggplot2" ).
  ?- r_library( [ggplot2,goProfiles] ).
  ?- debug( real ).
  ?- <- library("ggplot2").
  % Sending to R: suppressPackageStartupMessages(library(ggplot2))
  ?- set_prolog_flag( real_suppress_lib_messages, false ).
  ?- <- library("ggplot2").
  % Sending to R: library(ggplot2)

<- library(Rlib) also re-directs here. These are the best ways to include R libraries from within Real. Rlib is allowed to be atomic or a string, or a list of atoms each corresponding to an R library name.

  972r_library( Rlib ) :-
  973     current_predicate(string/1),
  974     string( Rlib ),
  975     !,
  976     atom_string( RlibAtm, Rlib ),
  977     r_library( RlibAtm ).
  978r_library( Rlib ) :-
  979     getenv( 'R_LIB_REAL', RlibRealPath ),
  980     atomic_list_concat( RlibDirs, ':', RlibRealPath ),
  981     member( Rdir, RlibDirs ),
  982     member( Ext, ['','r','R'] ),
  983     file_name_extension( Rlib, Ext, Rbase ),
  984     directory_file_path( Rdir, Rbase, Rfile ),
  985     exists_file( Rfile ),
  986     !,
  987     <- source( +Rfile ).
  988
  989r_library( Rlib ) :-
  990     current_prolog_flag( real_suppress_lib_messages, false ),
  991     !,
  992     r_library_codes( Rlib, '', '', Rcodes ), % fixme to atom
  993     atom_codes( R, Rcodes ),
  994     r_send(R).
  995r_library( Rlib ) :-
  996     Pre = 'suppressPackageStartupMessages(',
  997     r_library_codes( Rlib, Pre, ')', Rcodes ),
  998     atom_codes( R, Rcodes ),
  999     r_send( R ).
 1000
 1001r_library_codes( Rlib, Pre, Post, Rcodes ) :-
 1002     ( is_list(Rlib) -> Rlib=Rlibs; Rlibs = [Rlib] ),
 1003     atomic_list_concat( Rlibs, ',', RlibsAtm ),
 1004     atomic_list_concat( [Pre,'library(',RlibsAtm,')',Post], RlibCallAtm ),
 1005     atom_codes( RlibCallAtm, Rcodes ).
 r_version(-Version, -Date, -Note)
Version and release Date (data(Y,M,D) term). Note is either a note or nickname for the release. In git development sources this is set to <Something>_dev.
 1012r_version( 2:1:0, date(2020,5,29), swi8_2 ).
 1013     % 2:0:0, 2016/9/5, ijar
 1014     % 1:5:0, 2016/1/23, j_review
 1015     % 1:4:0, 2015/5/24, configurable
 1016	% 1:3:0, 2015/5/3,  collaborative
 1017     % 1:2:0, 2015/1/2,  regardless
 1018     % 1:1:0, 2013/3/24, thankless_task
 1019     % 1:0:0, 2013/12/6, sinter_class
 1020     % 0:1:2, 2013/11/3, the_stoic
 1021     % 0:1:0, 2012/12/26,oliebollen
 r_citation(-Atom, -Bibterm)
Although the original name was R..eal, when citating please use Real as the name for this library.

This predicate succeeds once for each publication related to this library. Atom is the atom representation % suitable for printing while Bibterm is a bibtex(Type,Key,Pairs) term of the same publication. Produces all related publications on backtracking.

 1032r_citation( Atom, bibtex(Type,Key,Pairs) ) :-
 1033    Atom = 'Advances in integrative statistics for logic programming\nNicos Angelopoulos, Samer Abdallah and Georgios Giamas \nInternational Journal of Approximate Reasoning, 8:103-115, 2016\nhttp://dx.doi.org/10.1016/j.ijar.2016.06.008.',
 1034    Type = article,
 1035    Key  = 'AngelopoulosN+2016',
 1036    Pairs = [
 1037               author = 'Nicos Angelopoulos, Samer Abdallah and Georgios Giamas',
 1038               title  = 'Advances in integrative statistics for logic programming',
 1039               journal = 'Journal of Approximate Reasoning',
 1040               year = 2016,
 1041               volume = 78,
 1042               month = 'November',
 1043               pages = '103-115',
 1044               pdate = 'online:2016/7/5',
 1045               url   = 'http://dx.doi.org/10.1016/j.ijar.2016.06.008'
 1046     ].
 1047
 1048r_citation( Atom, bibtex(Type,Key,Pairs) ) :-
 1049    Atom = 'Integrative functional statistics in logic programming \nNicos Angelopoulos, Vítor Santos Costa, Joao Azevedo, Jan Wielemaker, Rui Camacho and Lodewyk Wessels \nProc. of Practical Aspects of Declarative Languages (PADL 2013). Accepted (January, 2013. Rome, Italy).',
 1050    Type = inproceedings,
 1051    Key  = 'AngelopoulosN+2012',
 1052    Pairs = [
 1053               author = 'Nicos Angelopoulos and Vitor Santos Costa and Joao Azevedo and Jan Wielemaker and Rui Camacho and Lodewyk Wessels',
 1054               title  = 'Integrative functional statistics in logic programming',
 1055               booktitle = 'Proc. of Practical Aspects of Declarative Languages}',
 1056               year = 2013,
 1057               month = 'January',
 1058               address = 'Rome, Italy',
 1059               url     = 'http://stoics.org.uk/~nicos/pbs/padl2013-real.pdf'
 1060     ].
 r_remove(Rvar)
Remove Rvar from R's workspace (<- remove(Rvar)).
 1066r_remove( Plvar ) :-
 1067     <- remove( Plvar ).
 1068
 1069r_call_defaults( Defs ) :-
 1070     Defs = [ call(true), fcall(_), outputs(false), stem(real_plot) ].
 r_call(+Fun, +Opts)
Construct and possibly call an R function. Fun can be an atom or a compound, eg plot, or plot(width=3). The predicate also supports multiple output destinations.

Opts a single or list of the following:

 ?- r_call( plot([1,2,3]), [debug(true)]  ).
 ?- <- plot(c(1,2,3)) ++ debug(true).
 ?- <- plot(c(1,2,3)) ++ xlab=+an_xlab
 1099r_call( FPre, ArgS ) :-
 1100     to_list( ArgS, Args ),
 1101     ( memberchk(debug(true),Args) -> debug(real); true ), % fixme: turn-off again
 1102     FPre =.. [Fun|FPreList], % fixme: ? test plot, plot() & plot(c(1,2,3))
 1103     r_call_defaults( Defs ),
 1104     partition( eq_pair, FPreList, FPreEqPairs, FPreRArgs ),
 1105     flatten( [FPreEqPairs,Args,Defs], Opts ),
 1106     options_equals_pairs( Opts, Rpairs ),
 1107     append( FPreRArgs, Rpairs, FArgs ),
 1108     compound( FCall, Fun, FArgs ), % SWI-7 specific if FList is []
 1109     memberchk( fcall(FCall), Opts ),
 1110     ( memberchk(rvar(Rvar),Opts) ->
 1111	Callable = (Rvar <- FCall)
 1112	;
 1113	Callable = (<- FCall)
 1114     ),
 1115     memberchk( call(CallBool), Opts ),
 1116     call_r_function( CallBool, Callable, Opts ).
 1117
 1118%%% end of interface predicates
 1119
 1120eq_pair( =(_,_) ).
 options_equals_pairs(+Opts, -Rpairs)
Extract the first K=V pair for all K=_ in Opts.

The rationale is that these pairs are present in a list of usual options.

Making them stick out by using =/2 notation helps distinguish them. Requiring only the first means that Opts can include default values.

 ?- options_equals_pairs( [k=1,be(not),l=3,k=a], Rpairs ).
 Rpairs = [k=1, l=3].
 ?- options_equals_pairs( [k=1,be(not),l=+a,k=a], Rpairs ).
 Rpairs = [k=1, l=+a].
 1139options_equals_pairs( Opts, Rpairs ) :-
 1140     options_equals_pairs( Opts, [], Rpairs ).
 1141
 1142options_equals_pairs( [], _SeenKs, [] ).
 1143options_equals_pairs( [O|Os], SeenKs, Rpairs ) :-
 1144     ( O = (K=+_V) ; O = (K=_V) ),
 1145     !,
 1146     ( memberchk(K,SeenKs) ->
 1147	NextSKs = SeenKs,
 1148	Rpairs = Tpairs
 1149	;
 1150	NextSKs = [K|SeenKs],
 1151	Rpairs = [O|Tpairs]
 1152     ),
 1153     options_equals_pairs( Os, NextSKs, Tpairs ).
 1154options_equals_pairs( [_O|Os], SeenKs, Rpairs ) :-
 1155     options_equals_pairs( Os, SeenKs, Rpairs ).
 1156
 1157call_r_function( false, _Callable, _Opts ) :- !.
 1158call_r_function( _True, Callable, Opts ) :-
 1159     memberchk( outputs(OutS), Opts ),
 1160     to_list( OutS, Outs ),
 1161     memberchk( stem(Stem), Opts ),
 1162     maplist( r_call_output(Callable,Stem,Opts), Outs ).
 1163
 1164r_call_output( Call, Stem, Opts, Out ) :-
 1165     arity( Out, Ofun, _ ),
 1166     ( Ofun == x11 ->
 1167		arity( Pfx, Ofun, 0 )  % SWI-specific
 1168		;
 1169		file_name_extension( Stem, Ofun, File ),
 1170		Pfx =.. [Ofun,+File]
 1171     ),
 1172     arg_append( Out, [], OutComp ), % converts to compound as a side-effect
 1173     % term_compound( Out, OutComp ),
 1174     arg_append( Pfx, OutComp, OutCall ),
 1175     debug( real, 'Output call: ~w', (<- OutCall) ),
 1176     ( Ofun == false ->
 1177	true
 1178	;
 1179	<- OutCall
 1180     ),
 1181     debug( real, 'R call: ~w', (<- Call) ),
 1182     call( Call ),
 1183     ( memberchk(post_call(Post),Opts) ->
 1184	debug( real, 'Post call: ~w', [Post] ),
 1185	call( Post )
 1186	;
 1187	debug( real, 'No post call in: ~w', [Opts] )
 1188     ),
 1189     r_call_ouput_dev_off( Ofun ).
 1190
 1191r_call_ouput_dev_off( false ) :- !.
 1192r_call_ouput_dev_off( x11 ) :- !.
 1193r_call_ouput_dev_off( _ ) :- r_devoff.
 1194
 1195r_start_auto :-
 1196     % current_predicate( prefs:start_r_auto/1 ),
 1197     % prefs:start_r_auto( false ),
 1198     current_prolog_flag( real_start, false ),
 1199     !.
 1200r_start_auto :-
 1201     r_start.
 1202
 1203r_send( R ) :-
 1204     % send_r_codes( Rcodes ) :-
 1205     atom_codes( R, Rcodes ), % fixme, make send_r_command/1 to understand atoms
 1206     debug( real, 'Sending to R: ~s', [Rcodes] ),
 1207     send_r_command( Rcodes ).
 1208
 1209rexpr_codes( Rterm, RTmps, Rcodes ) :-
 1210     rexpr_codes( Rterm, RTmps, Rcodes, [] ).
 1211
 1212assignment(PlDataIn, Rvar) :-
 1213     % atom( Rvar ),
 1214     rvar_identifier( Rvar, Rvar, _ ),
 1215     compound( PlDataIn, c, _Arity ),
 1216     % functor( PlDataIn, c, _Arity ),
 1217     send_c_vector(PlDataIn, Rvar), !,
 1218     debug( real, 'Assigned c vector to R variable ~a.', [Rvar] ).
 1219
 1220assignment(PlDataIn, Rvar) :-
 1221     % atom( Rvar ),
 1222          % we would like to use rvar_identifier here, instead of atom/1
 1223          % but a$b <- 3 does not work with set_r_variable/2.
 1224     rvar_identifier( Rvar, Rvar, _ ),
 1225     pl_data( PlDataIn, PlData ),
 1226     !,
 1227     % term_to_atom( RvarIn, RvarAtom ),
 1228     set_r_variable(Rvar, PlData),
 1229     debug( real, 'Assigned Prolog data to R variable ~a.', [Rvar] ).
 1230
 1231assignment( Rexpr, Rvar ) :-
 1232     rvar_identifier( Rvar, _Rvar, RAssgn ),
 1233     rexpr( '<-'(-RAssgn,Rexpr), TmpRs, R ),
 1234     !,
 1235     r_send( R ),
 1236     maplist( r_remove, TmpRs ).
 1237
 1238pl_data( PlData, PlData ) :-
 1239     ( number(PlData); PlData=[_|_]; boolean_atom(PlData); PlData = @(_) ).
 1240/*
 1241pl_data( PlDataIn, PlData ) :-
 1242     PlDataIn =.. [c|PlData].
 1243*/
 rvar_identifier(Rterm, Rvar, Rcodes)
True if Rterm is an access term for an R variable Rvar and Rcodes are the codes corresponding to Rterm. Note that it is not the case that term_to_codes( Rterm, Rcodes ) holds. Rterm might contain code lists that are contextually interpreted by R as slots or list item labels. Or, Rterm might contain indices that we translate.

*/

 1255rvar_identifier( Rt, Rv, Rc ) :-
 1256     rvar_identifier_1( Rt, Rv, Ra ),
 1257     !,
 1258     % is_r_variable( Rv ),
 1259     atom_codes( Ra, Rc ).
 1260
 1261rvar_identifier_1( Rvar, Rvar, Rvar ) :-
 1262     atom( Rvar ),
 1263     ( catch(term_to_atom(Atom,Rvar),_,fail) ),
 1264     Atom == Rvar.
 1265/*
 1266rvar_identifier_1( A..B, Atom, Atom ) :-
 1267     atom(B),
 1268     rvar_identifier_1( A, Aatom, _ ),
 1269     atomic_list_concat( [Aatom,'.',B], Atom ).
 1270     */
 1271rvar_identifier_1( A$B, Rv, C ) :-
 1272     rname_atom( B, Batom ),
 1273     rvar_identifier_1( A, Rv, Aatom ),
 1274     % term_to_atom( Aatom$Batom, C ).
 1275     atomic_list_concat( [Aatom,'$',Batom], C ).
 1276rvar_identifier_1( A@B, Rv, C ) :-
 1277     rname_atom( B, Batom ),
 1278     rvar_identifier_1( A, Rv, Aatom ),
 1279     atomic_list_concat( [Aatom,'@',Batom], C ).
 1280rvar_identifier_1( []([[B]],A), Rv, C ) :-
 1281     rvar_identifier_1( A, Rv, Aatom ),
 1282     % rexpr_codes(B, [], BCs, [] ),
 1283     rexpr( B, [], Batom ),
 1284     % atom_codes( Batom, BCs ),
 1285     atomic_list_concat( [Aatom,'[[',Batom,']]'], C ).
 1286rvar_identifier_1( A^[[B]], Rv, C ) :-
 1287     rvar_identifier_1( A, Rv, Aatom ),
 1288     % rexpr_codes(B, [], BCs, [] ),
 1289     rexpr( B, [], Batom ),
 1290     % atom_codes( Batom, BCs ),
 1291     atomic_list_concat( [Aatom,'[[',Batom,']]'], C ).
 1292rvar_identifier_1( [](B,A), A, C ) :-
 1293     rindices( B, Batom ),
 1294     % atom_codes( Batom, BCs ),
 1295     atom_concat( A, Batom, C ).
 1296rvar_identifier_1( A^B, A, C ) :-
 1297     atom( A ),
 1298     is_list( B ),
 1299	rindices( B, Batom ),
 1300     atom_concat( A, Batom, C ).
 rexpr_codes(V, _, _)
Generate (or parse) an R expression as codes from/to a Prolog term. */
 1306rexpr( V, [], '' ) :-
 1307     var(V),
 1308     !,
 1309     throw(error(instantiation_error,r_interface)).
 1310rexpr( Numb, [], Expr ) :-
 1311     number(Numb),
 1312     !,
 1313     atom_number( Expr, Numb ).
 1314rexpr( Atom, [], Atom ) :-
 1315     atom(Atom), !.
 1316rexpr( String, [], Atom ) :-
 1317     current_predicate(string/1),
 1318     string(String),
 1319     !,
 1320     rexpr_string( String, Atom ).
 1321rexpr( +ToString, [], Atom ) :-
 1322     !,
 1323     rexpr_string( ToString, Atom ).
 1324rexpr( -ToAtom, [], Atom ) :-
 1325     stringable_atom( ToAtom, Atom ),
 1326	!.
 1327rexpr( =+(A,B), [], Atom ) :-
 1328     !,
 1329     rexpr( (A = +B), [], Atom ).
 1330rexpr( Array, TmpRs, TmpV ) :-
 1331     % Array = [_|_],
 1332	is_list(Array),
 1333	( Array == [] ->
 1334		TmpV = 'c()',  % NULL
 1335		TmpRs = []
 1336		;
 1337	array_to_c( Array, TmpV, TmpV ),
 1338	TmpRs = [TmpV]
 1339	),
 1340	!.
 1341% Only for SWI 6 and Yap ?
 1342rexpr( Term, [], Atom ) :-
 1343     compound( Term, '()', [Fname] ),
 1344     !,
 1345     atomic_list_concat( [Fname,'()'], Atom ).
 1346% Allows   ls(.)  as an alternative writing of ls()
 1347% fixme: explore doing compound/3 once and the using the functor to differantiate ...
 1348rexpr( Term, [], Atom ) :-
 1349     compound( Term, Name, ['.'] ),
 1350     !,
 1351     atomic_list_concat( [Name,'()'], Atom ).
 1352% fixme, 15.04.08: not sure what this is:
 1353rexpr( AKey, TmpRs, Atom ) :-
 1354     compound(AKey,[], [[[Key]], A]),
 1355     !,
 1356     rexpr( A, Atmps, Aatm ),
 1357     rexpr( Key, Ktmps, Katm ),
 1358     atomic_list_concat( [Aatm,'[[',Katm,']]'], Atom ),
 1359     append( Atmps, Ktmps , TmpRs ).
 1360
 1361rexpr( A^[[Key]], TmpRs, Atom ) :-
 1362     !,
 1363     rexpr( A, Atmps, Aatm ),
 1364     rexpr( Key, Ktmps, Katm ),
 1365     atomic_list_concat( [Aatm,'[[',Katm,']]'], Atom ),
 1366     append( Atmps, Ktmps, TmpRs ).
 1367% fixme, 15.04.08: old syntax ?
 1368rexpr( AList, TmpRs, Atom ) :-
 1369     compound( AList, [], [List,A] ),
 1370     !,
 1371     rexpr( A, TmpRs, Aatm ),
 1372     rindices( List, Latm  ),
 1373     atomic_list_concat( [Aatm,Latm], Atom ).
 1374rexpr( A^List, TmpRs, Atom ) :-
 1375     is_list(List),
 1376     !,
 1377     rexpr( A, TmpRs, Aatm ),
 1378     % rexpr_unquoted(A, TmpRs),
 1379     rindices( List, Latm ),
 1380     atomic_list_concat( [Aatm,Latm], Atom ).
 1381rexpr( A$B, TmpRs, Atom ) :-
 1382     !,
 1383     rexpr( A, TmpRs, Aatm ),
 1384	( atomic(B) ->
 1385	rname( B, Batm ),
 1386	atomic_list_concat( [Aatm,'$',Batm], Atom )
 1387		;
 1388		compound(B,[],[Args,Index]),
 1389		atomic_list_concat( [Aatm,Index], '$', Left ),
 1390		NewExpr =.. [[],Args,Left],
 1391		rexpr( NewExpr, TmpRs, Atom )
 1392	).
 1393rexpr( A@B, TmpRs, Atom ) :-
 1394     !,
 1395     rexpr( A, TmpRs, Aatm ),
 1396     rname( B, Batm ),
 1397     atomic_list_concat( [Aatm,'@',Batm], Atom ).
 1398rexpr((A :- B), TmpRs, Atom ) :- % fixme: test this
 1399     !,
 1400     rexpr( A, Atmps, Aatm ),
 1401     rexpr( B, Btmps, Batm ),
 1402     atomic_list_concat( [Aatm,' ',Batm], Atom ),
 1403     append( Atmps, Btmps, TmpRs ).
 1404rexpr( Term, TmpRs, Atom ) :-
 1405     arity( Term, NaIn, 2 ),
 1406     binary( NaIn, Na ),
 1407     % atom_codes( Na, NaS ),
 1408     arg( 1, Term, A ),
 1409     arg( 2, Term, B ),
 1410     !,
 1411     % fixme: we need something better in the following line (nicos)
 1412     left( Na, NaL ),
 1413     rexpr( A, Atmps, Aatm ),
 1414     % " ", NaS, " ",
 1415     rexpr( B, Btmps, Batm ),
 1416     right( Na, NaR ),
 1417     atomic_list_concat( [NaL,Aatm,' ',Na,' ',Batm,NaR], Atom ),
 1418     append( Atmps, Btmps, TmpRs ).
 1419
 1420rexpr( Term, TmpRs, Atom ) :-
 1421     compound( Term, F, Args ),
 1422     % Term =.. [F|Args], NA 15.5.7: this is superflous, and in the case of
 1423	% swi7's x11(), wrong. Maybe added by SA ?
 1424     F \== '.',
 1425     !,
 1426     stringable_atom( F, Fatm ),
 1427     rexprs(Args, true, F, TmpRs, InnerList ),
 1428     atomic_list_concat( InnerList, ',', Inner ),
 1429     atomic_list_concat( [Fatm,'(',Inner,')'], Atom ).
 1430
 1431rexpr_string( ToString, Atom ) :-
 1432     stringable_atom( ToString, InnerAtom ),
 1433     atomic_list_concat( ['"',InnerAtom,'"'], Atom ).
 1434
 1435stringable_atom( String, Atom ) :-
 1436     current_predicate(string/1),
 1437     string( String ),
 1438     !,
 1439     atom_string( Atom, String ).
 1440stringable_atom( String, Atom ) :-
 1441     atom( String ),
 1442     !,
 1443     Atom = String.
 1444stringable_atom( Codes, Atom ) :-
 1445     is_list( Codes ),
 1446     !,
 1447     atom_codes( Atom, Codes ).
 1448
 1449left( Na, Left ) :-
 1450     no_brace( Na ),
 1451     !,
 1452     Left = ''.
 1453left( _Na, '(' ).
 1454
 1455right( Na, Right ) :-
 1456     no_brace( Na ),
 1457     !,
 1458     Right = ''.
 1459right( _Na, ')' ).
 1460
 1461no_brace(<-).
 1462no_brace(=).
 1463no_brace(+).
 1464
 1465rexprs( [], _, _, [], [] ).
 1466rexprs([Arg|Args], _Fin, Func, TmpRs, [Aatm|Argsatms] ) :-
 1467     % ( Fin==true -> Sep='' ; Sep= ' ,' ),
 1468     % ( Args == [] -> Sep =
 1469     rexpr( Arg, Atmps, Aatm ),
 1470     rexprs(Args, false, Func, Argstmps, Argsatms ),
 1471     append( Atmps, Argstmps, TmpRs ).
 1472     % atomic_list_concat( [Aatm,Argsatm], Sep, Atom ).
 1473
 1474rindices( List, Atom ) :-
 1475     rindex( List, Inner ),
 1476     atomic_list_concat( ['[',Inner,']'], Atom ).
 1477
 1478rindex( [], '' ).
 1479rindex( [H|T], Atom ) :-
 1480     rindex_element( H, Hatm ),
 1481     rindex_comma( T, Comma ),
 1482     rindex( T, TAtm ),
 1483     atomic_list_concat( [Hatm,Comma,TAtm], Atom ).
 1484
 1485rindex_element( *, '' ).
 1486rindex_element( List, Atom ) :-
 1487     is_list(List),
 1488     !,
 1489     rindex( List, Inner ),
 1490     atomic_list_concat( ['c(',Inner,')'], Atom ).
 1491rindex_element( +ToString, Atom ) :-
 1492     !,
 1493     rexpr_string( ToString, Atom ).
 1494rindex_element( -El, Atom ) :-
 1495     rindex_element( El, ElAtm ),
 1496     atomic_list_concat( ['-', ElAtm], Atom ).
 1497rindex_element( ElL:ElR, Atom ) :-
 1498     rindex_element( ElL, Latm ),
 1499     rindex_element( ElR, Ratm ),
 1500     atomic_list_concat( [Latm,':',Ratm], Atom ).
 1501rindex_element( CExp, Atom ) :-
 1502     CExp =.. [c|Cs], !,
 1503     rindex( Cs, Inner ),
 1504     atomic_list_concat( [c,'(',Inner,')'], Atom ).
 1505rindex_element( Term, Atom ) :-
 1506	compound(Term),
 1507	!,
 1508	% fixme: 15.11.04 make sure [] below is steadfast
 1509	rexpr( Term, [], Atom ).
 1510rindex_element( Oth, Atom ) :-
 1511     (integer(Oth);atom(Oth)),
 1512     !,
 1513     write_to_chars(Oth,Codes),
 1514     atom_codes( Atom, Codes ).
 1515rindex_element( CExp, _ ) :-
 1516     throw(cannot_process_index(CExp)).
 1517
 1518rindex_comma( [], '' ) :- !.
 1519rindex_comma( _, ',' ).
 1520
 1521/* obsolete ?
 1522%% codes_string(Codes,Quoted).
 1523% check a list is full of (utf ?) codes
 1524% while replacing any " with \" to produce Quoted from Ascii
 1525%
 1526codes_string([],[]).
 1527codes_string(.(C,Cs),Q) :-
 1528     integer(C),
 1529     % <=nicos.  char_type(C,ascii),
 1530        % <=nicos.   \+ char_type(C,cntrl),
 1531     char_my_utf8(C),
 1532     sew_code( C, Q, T ),
 1533     codes_string(Cs,T).
 1534
 1535char_my_utf8( C ) :-
 1536     char_type(C,graph),
 1537     !.
 1538char_my_utf8( C ) :-
 1539     char_type(C,white).
 1540
 1541%% ascii_code_sew( C, Q, T ).
 1542%  Sew C or its quoted form on list Q with its tail returned in T.
 1543%
 1544sew_code( 34, [0'\\,0'"|T], T ) :- !.
 1545sew_code( C, [C|T], T ).
 1546*/
 rname(+Name)
first cut in supporting places where R is expecting "names or string constants" as in the RHS of $ and @
 1553rname( ToAtom, Atom ) :-
 1554     stringable_atom( ToAtom, Atom ).
 rname_atom(Rname, Atom)
Holds for atomic Atom a map of Rname. If Rname is a list is assumed to be a list of codes that is atom_code(/2)d to Atom.
 1562rname_atom( Rname, Atom ) :-
 1563     ( atomic(Rname) ->
 1564          Atom = Rname
 1565          ;
 1566          atom_codes( Atom, Rname )
 1567     ).
 1568
 1569check_quoted(true, _) --> !, "TRUE".
 1570check_quoted(false, _) --> !, "FALSE".
 1571check_quoted(A, _) --> { is_r_variable(A) }, !,
 1572     { format(codes(Codes), '~a', [A]) },
 1573     Codes.
 1574check_quoted(A, _) -->
 1575     { format(codes(Codes), '"~a"', [A]) },
 1576     Codes.
 1577
 1578add_number(El) -->
 1579     { number_codes(El, Codes) },
 1580     Codes.
 1581
 1582% i am sure there is something missing here, else Rv
 1583% is just used twice
 1584array_to_c( Array, Rv, Rv ) :-
 1585     fresh_r_variable( Rv ),
 1586     set_r_variable( Rv, Array ).
 1587
 1588fresh_r_variable(Plv) :-
 1589     between( 1, 10000, I ),
 1590     atomic_list_concat([pl,v,I], '_', Plv),
 1591     \+ r_is_var(Plv),
 1592     !.
 1593
 1594% hmmmm
 1595% originally this (binary/1) included a call to exist,
 1596% this rightly fails on lm(speeds~exprs)
 1597% we are converting this to an operators version and we might
 1598% need to introduce a top-level version that checks for functions
 1599binary( Plname, Rname ) :-
 1600     current_op( _, Assoc, real:Plname ),
 1601     binary_real_r( Plname, Rname ),
 1602     once( binary_op_associativity( Assoc ) ).
 1603     % atomic_list_concat( [exists,'("',Rname,'",mode="function")'],  Atom ),
 1604     % atom_codes( Atom, Rcodes ),
 1605     % rexpr_to_pl_term( Rcodes, Rbool ),
 1606     % Rbool == true.
 1607
 1608binary_real_r( Plname, Rname ) :-
 1609     binary_real_op( Plname, Rname ),
 1610     !.
 1611binary_real_r( OpName, OpName ).
 binary_real_op(+Plname, -Rname)
Rname is R's operator name for Plname. We only to define cases where Plname \== Rname.
 1617binary_real_op(  @*@, '%*%' ).
 1618binary_real_op(  @^@, '%o%' ).
 1619binary_real_op(  @~@, '%in%' ).
 1620binary_real_op(  //, '%/%' ).
 1621binary_real_op( mod, '%%'  ).
 1622binary_real_op( \= , '!='  ).
 1623% binary_real_op( =<, <= ).
 1624	% the alternative is to define '!=' but in usage the `` have to be included
 1625binary_real_op( ; , '|'  ).
 1626binary_real_op( :: , '||'  ).
 1627
 1628binary_op_associativity( yfx ).
 1629binary_op_associativity( xfy ).
 1630binary_op_associativity( xfx ).
 1631
 1632boolean_atom( true ).
 1633boolean_atom( false ).
 1634
 1635% Only on SWI, bug Vitor for at_halt/1.
 1636r_halt :-
 1637     r_started,
 1638     r_devoff_all,
 1639     stop_r,
 1640     !.
 1641r_halt.
 1642
 1643% try to work with SWI v7's extensions on compounds
 1644compound( Term, Name, Args ) :-
 1645     current_predicate( compound_name_arguments/3 ),
 1646     !,
 1647     once( (compound(Term) ; (ground(Name),is_list(Args))) ),
 1648     % !,
 1649     compound_name_arguments( Term, Name, Args ).
 1650compound( Term, Name, Args ) :-
 1651     once( (compound(Term) ; (ground(Name),ground(Args))) ),
 1652     Term =.. [Name,Args].
 1653
 1654arity( Term, Name, Arity ) :-
 1655     current_predicate( compound_name_arity/3 ),
 1656     \+ atomic( Term ),
 1657     !,
 1658     compound_name_arity( Term, Name, Arity ).
 1659arity( Term, Name, Arity ) :-
 1660     functor( Term, Name, Arity ).
 1661
 1662/* @version  0.3 2015/01/12, allow Term to be an atom
 1663   */
 1664
 1665arg_append( Term, AppList, New ) :-
 1666     is_list( AppList ),
 1667     !,
 1668     ( compound(Term,Tname,TArgs) ->
 1669	true
 1670	;
 1671	atom(Term), % fixme: atomic?
 1672	Tname = Term,
 1673	TArgs = []
 1674     ),
 1675     % Term =.. [Tname|TArgs],
 1676     append( TArgs, AppList, NArgs ),
 1677     compound( New, Tname, NArgs ).
 1678     % New =.. [Tname|NArgs].
 1679arg_append( Term, AppTerm, New ) :-
 1680     compound( AppTerm ),
 1681     !,
 1682     % AppTerm =.. [_ATname|ATArgs],
 1683     % Term =.. [Tname|TArgs],
 1684     compound( AppTerm, _ATname, ATArgs ),
 1685     compound( Term, Tname, TArgs ),
 1686     append( TArgs, ATArgs, NArgs ),
 1687     % New =.. [Tname|NArgs].
 1688     compound( New, Tname, NArgs ).
 1689arg_append( Term, AppAtomic, New ) :-
 1690     atomic( AppAtomic ),
 1691     % Term =.. [Tname|TArgs],
 1692     compound( Term, Tname, TArgs ),
 1693     append( TArgs, [AppAtomic], NArgs ),
 1694     % New =.. [Tname|NArgs].
 1695     compound( New, Tname, NArgs ).
 1696
 1697swipl_wins_warn :-
 1698     current_prolog_flag(hwnd,_), % true iff ran via swipl-win.exe
 1699	\+ current_prolog_flag( real_wins_warn, false ),
 1700     !,
 1701     L = "    library(real) notice: ",
 1702     A = "         There is a known issue with swipl-win.exe.",
 1703     B = "         R's I/O streams cannot be connected to those of Prolog.",
 1704     C = "         So for instance, <- print(x) does not print x to the terminal.",
 1705     D = "         All other functionalities are fine.",
 1706     E = "         To circumvent use things like X <- x, write( x ).",
 1707     F = "         If you need printing on console from R, you can start SWI via swipl.exe",
 1708     G = "         To avoid seeing this message ?- set_prolog_flag(real_wins_warn,false). before loading Real.",
 1709     Lines = [nl,nl,L,nl,nl,A,nl,B,nl,C,nl,D,nl,E,nl,F,nl,G,nl,nl],
 1710     print_message_lines(current_output, '', Lines ).
 1711swipl_wins_warn.
 1712
 1713real_thread_self( Self ) :-
 1714     current_predicate( thread_self/1 ),
 1715     thread_self( Self ).
 1716
 1717% error handling
 1718:- multifile prolog:message//1. 1719
 1720prolog:message(unhandled_exception(real_error(Message))) -->
 1721     { debug( real, 'Unhandled ~p', Message ) },
 1722     message(Message).
 1723
 1724prolog:message(real_error(Message)) -->
 1725     { debug( real, 'Real error ~p', Message ) },
 1726     message(Message).
 1727
 1728message( stop_r_is_buggy ) -->
 1729     ['Currently r_end/0 has no effect as the recommended C code does not work.\nYour link to the R library is still alive'].
 1730message( r_already_started ) -->
 1731     ['R has already been started.'].
 1732message( server_alread_running(Thread) ) -->
 1733     ['R server thread already assigned as ~w'-[Thread] ].
 1734message( no_server_thread ) -->
 1735     ['r_serve/0 called with no designated R server thread' ].
 1736message( server_thread_mismatch(Me,Server) ) -->
 1737     ['r_serve/0 called in thread ~w, but designated server thread is ~w'-[Me,Server]].
 1738message( correspondence ) -->
 1739     ['R was unable to digest your statement, either syntax or existance error.' - [] ].
 1740message( r_root ) -->
 1741     ['Real was unable to find the R root directory. \n If you have installed R from sources set $R_HOME to point to $PREFIX/lib/R.\n You should also make sure libR.so is in a directory appearing in $LD_LIBRARY_PATH' - [] ].
 1742message( thread(G,real_error(Exc)) ) -->
 1743     % ( Ball = Real -> true; throw(real_error(thread(Real,Ball))) ).
 1744     { debug( real, 'Exception ~p', Exc ) },
 1745     message( Exc ),
 1746     ['\nR above was caught from thread execution while invoking ~p' - [G] ].
 1747% error(existence_error(r_variable,x),context(real:robj_to_pl_term/2,_G395)
 1748% message( thread(G,error(existence_error(r_variable,X),_,_)) ) -->
 1749message( thread(G,error(Error,Context)) ) -->
 1750     % ( Ball = Real -> true; throw(real_error(thread(Real,Ball))) ).
 1751     { debug( real, 'Attempt to print error/2 ball ~p', error(Error,Context) ) },
 1752     { print_message( error, error(Error,Context)  ) },
 1753     ['Above error was caught from thread execution while invoking ~p' - [G] ].
 1754message( thread(G,Exc) ) -->
 1755     { debug(real,'In with ~p',Exc) },
 1756     ['R thread was unable to digest your statement ~p, and caught exception: ~p.' - [G,Exc] ].
 1757message( r_new_exists(X) ) -->
 1758     ['First argument of <<- exists as R variable: ~w.' - [X] ].
 1759message( r_new_var(X) ) -->
 1760     ['First argument of <<- is not an atom: ~w.' - [X] ].
 1761message( r_new_inconsistent(X) ) -->  % we should never get to this really
 1762     ['First argument of <<- is weird: ~w.' - [X] ].
 to_list(+Term, -Listed)
Wrap Term into a list of it not one already. For converting to lists see term_to_list/3.
 ?- to_list( atom, List ).
 List = [atom].
 1773to_list( Either, List ) :-
 1774     ( (var(Either);(Either\=[_H|_T],Either\==[]) ) ->
 1775	List = [Either]
 1776	;
 1777	List = Either
 1778     ).
 expand_dotted_name(+TermIn, -TermOut) is det
Translate Atom1.Atom2 and Atom.Compound into 'Atom1.Atom2' and 'Atom1.Name'(Args).

JW: July, 2016.

 1787expand_dotted_name(TermIn, TermOut) :-
 1788	compound(TermIn), !,
 1789	(   join_dot(TermIn, Out)
 1790	->  TermOut = Out
 1791	;   contains_dot(TermIn)
 1792	->  compound_name_arguments(TermIn, Name, ArgsIn),
 1793	    maplist(expand_dotted_name, ArgsIn, ArgsOut),
 1794	    compound_name_arguments(TermOut, Name, ArgsOut)
 1795	;   TermOut = TermIn
 1796	).
 1797expand_dotted_name(Term, Term).
 1798
 1799join_dot(In, Out) :-
 1800	compound_name_arguments(In, '.', [A,B]),
 1801	atom(A),
 1802	(   atom(B)
 1803	->  atomic_list_concat([A,'.',B], Out)
 1804	;   compound(B)
 1805	->  compound_name_arguments(B, Name, Args),
 1806	    atomic_list_concat([A,'.',Name], Name2),
 1807	    compound_name_arguments(Out, Name2, Args)
 1808	;   Out = In
 1809	).
 1810
 1811contains_dot(Term) :-
 1812	compound(Term),
 1813	(   compound_name_arity(Term, '.', 2)
 1814	->  true
 1815	;   arg(_, Term, Arg),
 1816	    contains_dot(Arg)
 1817	->  true
 1818	).
 1819
 1820% JW July 2016
 1821user:goal_expansion(In, Out) :-
 1822	contains_dot(In), !,
 1823	expand_dotted_name(In, Out).
 1824% JW --end
 1825
 1826user:portray( r(R) ) :-
 1827     format('<- ~w', [R] ).
 1828user:portray( r(L,R) ) :-
 1829     format('~w <- ~w', [L,R]).
 1830
 1831:- ( current_prolog_flag(version_data,swi(_,_,_,_)) -> at_halt(r_halt); true ). 1832:- initialization(r_start_auto, now).