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

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

See r_remove/1.

  580'<<-'( X ) :-
  581     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.
  597'<<-'(X,Y) :-
  598     r_new(X),
  599     !,
  600     r( X, Y ).
  601'<<-'(X,_Y) :-
  602     atom( X ),
  603     r_is_var(X),
  604     !,
  605     throw( real_error(r_new_exists(X)) ).
  606'<<-'(X,_Y) :-
  607     \+ atom( X ),
  608     !,
  609     throw( real_error(r_new_var(X)) ).
  610'<<-'(X,_Y) :-
  611     throw( real_error(r_new_inconsistent(X)) ).
 r(R)
Nickname for <-(R).
  617r( R ) :-
  618     var( R ),
  619     !,
  620     % fixme: print better message
  621     throw(error(instantiation_error,r/1)).
  622r( R ) :-
  623     real_server_thread( Server ),
  624     real_thread_self( Self ),
  625     Self \== Server,
  626     !,
  627     r_thread( Server, Self, r(R) ).
  628r( R ) :-
  629     r_term( R ).
  630
  631r_term( Lib ) :-
  632     Lib = library(R),
  633     !,
  634     r_library( R ).
  635r_term( RvarIn ) :-
  636     (  rvar_identifier(RvarIn,_,RvarCs) ->
  637        true
  638        ; (atom(RvarIn),atom_codes(RvarIn,RvarCs))
  639     ),
  640     !,
  641     atom_codes('print( ', PrintOpen), % JW: I think we should be using atoms
  642     atom_codes(' )', PrintClose),     % JW: all along
  643     append([PrintOpen,RvarCs,PrintClose], CmdCodes),
  644     atom_codes( Cmd, CmdCodes ),
  645     r_send( Cmd ).
  646r_term( A ++ B ) :-
  647     !,
  648     r_call( A, B ).
  649r_term( Term ) :-
  650     rexpr( Term, TmpRs, R ),
  651     !,
  652     r_send( R ),
  653     maplist( r_remove, TmpRs ).
  654r_term( _Other ) :-
  655     % fixme: print "proper" error
  656     write( user_error, 'Cannot use input to <-/1.' ), nl, nl,
  657     fail.
 r(?L, +R)
Nickname for <-(L,R).
  663r( A, B ) :-
  664     real_server_thread( Server ),
  665     real_thread_self( Self ),
  666     Self \== Server,
  667     debug( real, 'Calling from thread:~p', Self ),
  668     !,
  669     r_thread( Server, Self, r(A,B) ).
  670     % thread_send_message( main, real_call(Caller,Real) ),
  671     % thread_get_message( Caller, real_ply(Ball,Real) ),
  672     % fixme: we should be able to write the caught Ball here, except if it is
  673     % is thread related, in which case possibilities are probably also limited
  674
  675r( A, B ) :-
  676     r_assign( A, B ).
  677
  678/*
  679r( A, B ) :-
  680     current_prolog_flag( real, thread ),
  681     !,
  682     debug( real, 'Using R on thread',  [] ),
  683     r_thread( r(A,B) ).
  684     */
  685r_assign( C, A ++ B ) :-
  686     !,
  687     r_call( A, [rvar(C)|B] ).
  688r_assign( Plvar, RvarIn ) :-
  689     var(Plvar),
  690     rvar_identifier( RvarIn, RvarIn, _ ),
  691     !,
  692     debug( real, 'Assigning to Prolog variable R variable ~a',  [RvarIn] ),
  693     robj_to_pl_term( RvarIn, Plvar ).
  694%   Plvar <- Rexpr.
  695r_assign( Plvar, Rexpr ) :-
  696     var(Plvar),
  697     rexpr( Rexpr, TmpRs, R ),
  698     !,
  699     debug( real, 'Assigning to Prolog variable R expression ~a',  [R] ),
  700     atom_codes( R, Rcodes ), % fixme, make the following take atoms
  701     rexpr_to_pl_term( Rcodes, Plvar ),
  702     maplist( r_remove, TmpRs ).
  703%  Rvar <- Plval.
  704r_assign( RvarIn, PlrExpr ) :-
  705     assignment( PlrExpr, RvarIn ),
  706     !.
  707%  Rexpr1 <- Rexpr2
  708r_assign( LRexpr, RRexpr ) :-
  709     rexpr('<-'(LRexpr,RRexpr),TmpRs,R),
  710     !,
  711     r_send( R ),
  712     maplist( r_remove, TmpRs ).
  713r_assign( _Plvar, _Rexpr ) :-
  714     write( user_error, 'Cannot decipher modality of <-/2. \n ' ), nl,
  715     fail.
  716
  717% r_start_server is det.
  718%
  719% Starts a new thread running r_thread_loop/0 as an R server.
  720% The created thread is given an alias of 'real' and is detached.
  721% If more control over thread creation is required, then you can
  722% create the thread yourself and call r_thread_loop within it.
  723%
  724% Once started, any calls to r/1, r/2, (<-)/1, or (<-)/2 work by passing
  725% a message to the server thread and waiting for a response.
  726% See r_call_as_server/1 for an alternative approach to multithreaded
  727% R programming.
  728%
  729% @throws real_error(server_already_running(ThreadId)) if another thread
  730% has already been designated as an R server.
  731r_start_server :-
  732   r_check_no_server,
  733   thread_create(r_thread_loop, _, [alias(real),detached(true)]).
  734
  735
  736% r_call_as_server(Goal).
  737%
  738% Calls Goal with the current thread designated as an R serving thread. This
  739% means that any other thread that calls an R goal will send a request to this thread.
  740% By using this predicate, you agree to check for and execute
  741% and R requests by calling r_serve/0 periodically.
  742% While this goal is running, any attempt to create a new R server thread will
  743% result in an exception.
  744%
  745% @throws real_error(server_already_running(ThreadId)) if another thread
  746% has already been designated as an R server.
  747r_call_as_server(Goal) :-
  748     r_check_no_server,
  749     thread_self( Me ),
  750     debug(real, 'Running as R server on ~w: ~q...',[Me,Goal]),
  751     setup_call_cleanup(
  752        assert( real_server_thread(Me) ),      Goal,
  753        retractall( real_server_thread(_) ) ).
  754
  755r_check_no_server :-
  756   (  real_server_thread(TID)
  757   -> throw(real_error(server_already_running(TID)))
  758   ;  true
  759   ).
 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.
  773r_thread_loop :-
  774     r_call_as_server( r_thread_loop_body ).
  775
  776r_thread_loop_body :-
  777     thread_get_message( Mess ),
  778     r_thread_message( Mess ).
  779
  780r_thread_message( quit ) :-
  781     !,
  782     halt(0).
  783r_thread_message( real_call(Caller,Goal) ) :-
  784     debug( real, 'In r_thread_loop got ~p, from ~p', [Goal,Caller] ),
  785     r_thread_serve( Goal, Caller ).
  786
  787r_thread_serve( r(r_thread_loop_stop), Caller ) :-
  788     % debug( real, 'In r_thread_loop2 got ~p from ~p', [Goal,Caller] ),
  789     % Goal =.. [Name|Args],
  790     % debug( real, 'Name ~p args ~p', [Name,Args] ),
  791     % Goal = <-(r_thread_loop_stop),
  792     !,
  793     debug( real, 'Caught stop_loop signal from caller: ~p', Caller ),
  794     thread_send_message( Caller, real_ply(yes,r(r_thread_loop_stop))).
  795r_thread_serve( Goal, Caller ) :-
  796     reify( Goal, Result ),
  797     debug( real, 'Called ~p, result ~p', [Goal,Result] ),
  798     thread_send_message( Caller, real_ply(Result,Goal) ),
  799     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.
  815r_serve :-
  816     thread_self( Me ),
  817     ( real_server_thread( Server ) -> true; throw(real_error(no_server_thread))),
  818     ( Server\=Me -> throw(real_error(server_thread_mismatch(Me,Server))); true),
  819     thread_peek_message( _G),
  820     !,
  821     thread_get_message( real_call(Caller,Goal) ),
  822     debug( real, 'In main got ~p, from ~p', [Goal,Caller] ),
  823     reify( with_mutex( real, Goal ), Result ),
  824     debug( real, 'Called ~p, result ~p', [Goal,Result] ),
  825     thread_send_message( Caller, real_ply(Result,Goal) ),
  826     r_serve.
  827r_serve.
  828
  829r_thread( Eval, Caller, Real ) :-
  830     % thread_self(Caller),
  831     debug( real, 'Sending call ~p from caller ~p to evaluator ~p', [Real,Caller,Eval] ),
  832     thread_send_message( Eval, real_call(Caller,Real) ),
  833     thread_get_message( Caller, real_ply(Result,Real) ),
  834     debug( real, 'Caller ~p received goal ~p and got result ~p', [Caller,Real,Result] ),
  835     reflect( Real, Result ).
  836
  837reify( Goal, Result) :-
  838   (  catch( (Goal,Result=yes), Ex, Result=ex(Ex) ) -> true
  839   ;  Result = no
  840   ).
  841
  842reflect(_,yes) :- !.
  843reflect(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.
  847r_is_var( Rvar ) :-
  848     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.
  854r_is_var( RvarIn, Rvar ) :-
  855     atom(RvarIn), !,
  856     is_r_variable(RvarIn),
  857     RvarIn = Rvar.
  858r_is_var( RvarIn, Rvar ) :-
  859     rvar_identifier( RvarIn, Rvar, _RvarAtom ),
  860     is_r_variable( Rvar ),
  861     rexpr( mode(Rvar), [], Rmode ),
  862     atom_codes( Rmode, RmodeCs ), % fixme, make the following take atoms
  863     rexpr_to_pl_term( RmodeCs, Plmode ),
  864     RvarModes  = [character,complex,list,logical,'NULL',numeric,raw,'S4'],
  865     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.
  872r_char( Atomic, Rchar ) :-
  873    atomic( Atomic ),
  874    !,
  875    atomic_list_concat( ['"',Atomic,'"'], Rchar ).
 r_devoff
Close the current plot devise without any reporting. Short for <- invisible('dev.off'()').
  879r_devoff :-
  880     <- invisible(-'dev.off()').
 r_devoff_all
Close all open devices.
  886r_devoff_all :-
  887     Dev <- 'dev.cur()',
  888     Dev > 1,
  889     !,
  890     r_devoff,
  891     r_devoff_all.
  892r_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.

  912r_new( Rv ) :-
  913     atomic( Rv ),
  914     \+ r_is_var( Rv ).
 r_wait
Currently only waiting for Return to be pressed.
  919r_wait :-
  920     write('Press Return to continue...'), nl,
  921     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.

  973r_library( Rlib ) :-
  974     current_predicate(string/1),
  975     string( Rlib ),
  976     !,
  977     atom_string( RlibAtm, Rlib ),
  978     r_library( RlibAtm ).
  979r_library( Rlib ) :-
  980     getenv( 'R_LIB_REAL', RlibRealPath ),
  981     atomic_list_concat( RlibDirs, ':', RlibRealPath ),
  982     member( Rdir, RlibDirs ),
  983     member( Ext, ['','r','R'] ),
  984     file_name_extension( Rlib, Ext, Rbase ),
  985     directory_file_path( Rdir, Rbase, Rfile ),
  986     exists_file( Rfile ),
  987     !,
  988     <- source( +Rfile ).
  989
  990r_library( Rlib ) :-
  991     current_prolog_flag( real_suppress_lib_messages, false ),
  992     !,
  993     r_library_codes( Rlib, '', '', Rcodes ), % fixme to atom
  994     atom_codes( R, Rcodes ),
  995     r_send(R).
  996r_library( Rlib ) :-
  997     Pre = 'suppressPackageStartupMessages(',
  998     r_library_codes( Rlib, Pre, ')', Rcodes ),
  999     atom_codes( R, Rcodes ),
 1000     r_send( R ).
 1001
 1002r_library_codes( Rlib, Pre, Post, Rcodes ) :-
 1003     ( is_list(Rlib) -> Rlib=Rlibs; Rlibs = [Rlib] ),
 1004     atomic_list_concat( Rlibs, ',', RlibsAtm ),
 1005     atomic_list_concat( [Pre,'library(',RlibsAtm,')',Post], RlibCallAtm ),
 1006     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. 
 ?- r_version( V, D, N ).
 V = 2:3:0,
 D = date(2022, 6, 23),
 N = rotten_bins.
version
- 2:2:0, 2022/6/21, new_bins
- 2:1:0, 2020/5/29, swi8_2
- 2:0:0, 2016/9/5, ijar
- 1:5:0, 2016/1/23, j_review
- 1:4:0, 2015/5/24, configurable
- 1:3:0, 2015/5/3, collaborative
- 1:2:0, 2015/1/2, regardless
- 1:1:0, 2013/3/24, thankless_task
- 1:0:0, 2013/12/6, sinter_class
- 0:1:2, 2013/11/3, the_stoic
- 0:1:0, 2012/12/26,oliebollen
 1031r_version( 2:3:0, date(2022,6,23), rotten_bins ).
 r_citation(-Atom, -Bibterm)
Although the original name was R..eal, when citing 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.

 1042r_citation( Atom, bibtex(Type,Key,Pairs) ) :-
 1043    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.',
 1044    Type = article,
 1045    Key  = 'AngelopoulosN+2016',
 1046    Pairs = [
 1047               author = 'Nicos Angelopoulos, Samer Abdallah and Georgios Giamas',
 1048               title  = 'Advances in integrative statistics for logic programming',
 1049               journal = 'Journal of Approximate Reasoning',
 1050               year = 2016,
 1051               volume = 78,
 1052               month = 'November',
 1053               pages = '103-115',
 1054               pdate = 'online:2016/7/5',
 1055               url   = 'http://dx.doi.org/10.1016/j.ijar.2016.06.008'
 1056     ].
 1057
 1058r_citation( Atom, bibtex(Type,Key,Pairs) ) :-
 1059    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).',
 1060    Type = inproceedings,
 1061    Key  = 'AngelopoulosN+2012',
 1062    Pairs = [
 1063               author = 'Nicos Angelopoulos and Vitor Santos Costa and Joao Azevedo and Jan Wielemaker and Rui Camacho and Lodewyk Wessels',
 1064               title  = 'Integrative functional statistics in logic programming',
 1065               booktitle = 'Proc. of Practical Aspects of Declarative Languages}',
 1066               year = 2013,
 1067               month = 'January',
 1068               address = 'Rome, Italy',
 1069               url     = 'http://stoics.org.uk/~nicos/pbs/padl2013-real.pdf'
 1070     ].
 r_remove(Rvar)
Remove Rvar from R's workspace (<- remove(Rvar)).
 1076r_remove( Plvar ) :-
 1077     <- remove( Plvar ).
 1078
 1079r_call_defaults( Defs ) :-
 1080     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:

Ropt = Rarg
=/2 terms in Opts are added to the function call
call(Call=true)
whether to call the constructed function
debug(Dbg=false)
turn on debug(real) and restore at end of call
fcall(Fcall)
returns the constructed Fcall
outputs(Outs=false)
a single or list of [false,x11,pdf] also terms of those (eg x11(width=7))
post_call(Post)
call this after the function call. this can be an arbitrary callable including another <-/2 or r_call/2
rmv(Rmv=false)
when Rvar is given, should it be removed from R workspace at end? (see r_remove/1)
rvar(Rvar)
when given call is expanded to Rvar <- Fcall, else <- Fcall is called
stem(Stem=real_plot)
stem to use for output files

Only the first Ropt=Rarg for each matching Ropt is used. This is also the case for =pairs in args of Func. These are pre-pended for the check, so they always have precedence.

 ?- r_call( plot([1,2,3]), [debug(true)]  ).
 ?- <- plot(c(1,2,3)) ++ debug(true).
 ?- <- plot(c(1,2,3)) ++ xlab=+an_xlab
 1118r_call( FPre, ArgS ) :-
 1119     to_list( ArgS, Args ),
 1120     ( memberchk(debug(true),Args) -> debug(real); true ), % fixme: turn-off again
 1121     FPre =.. [Fun|FPreList], % fixme: ? test plot, plot() & plot(c(1,2,3))
 1122     r_call_defaults( Defs ),
 1123     partition( eq_pair, FPreList, FPreEqPairs, FPreRArgs ),
 1124     flatten( [FPreEqPairs,Args,Defs], Opts ),
 1125     options_equals_pairs( Opts, Rpairs ),
 1126     append( FPreRArgs, Rpairs, FArgs ),
 1127     compound( FCall, Fun, FArgs ), % SWI-7 specific if FList is []
 1128     memberchk( fcall(FCall), Opts ),
 1129     ( memberchk(rvar(Rvar),Opts) ->
 1130	Callable = (Rvar <- FCall)
 1131	;
 1132	Callable = (<- FCall)
 1133     ),
 1134     memberchk( call(CallBool), Opts ),
 1135     call_r_function( CallBool, Callable, Opts ).
 1136
 1137%%% end of interface predicates
 1138
 1139eq_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].
 1158options_equals_pairs( Opts, Rpairs ) :-
 1159     options_equals_pairs( Opts, [], Rpairs ).
 1160
 1161options_equals_pairs( [], _SeenKs, [] ).
 1162options_equals_pairs( [O|Os], SeenKs, Rpairs ) :-
 1163     ( O = (K=+_V) ; O = (K=_V) ),
 1164     !,
 1165     ( memberchk(K,SeenKs) ->
 1166	NextSKs = SeenKs,
 1167	Rpairs = Tpairs
 1168	;
 1169	NextSKs = [K|SeenKs],
 1170	Rpairs = [O|Tpairs]
 1171     ),
 1172     options_equals_pairs( Os, NextSKs, Tpairs ).
 1173options_equals_pairs( [_O|Os], SeenKs, Rpairs ) :-
 1174     options_equals_pairs( Os, SeenKs, Rpairs ).
 1175
 1176call_r_function( false, _Callable, _Opts ) :- !.
 1177call_r_function( _True, Callable, Opts ) :-
 1178     memberchk( outputs(OutS), Opts ),
 1179     to_list( OutS, Outs ),
 1180     memberchk( stem(Stem), Opts ),
 1181     maplist( r_call_output(Callable,Stem,Opts), Outs ).
 1182
 1183r_call_output( Call, Stem, Opts, Out ) :-
 1184     arity( Out, Ofun, _ ),
 1185     ( Ofun == x11 ->
 1186		arity( Pfx, Ofun, 0 )  % SWI-specific
 1187		;
 1188		file_name_extension( Stem, Ofun, File ),
 1189		Pfx =.. [Ofun,+File]
 1190     ),
 1191     arg_append( Out, [], OutComp ), % converts to compound as a side-effect
 1192     % term_compound( Out, OutComp ),
 1193     arg_append( Pfx, OutComp, OutCall ),
 1194     debug( real, 'Output call: ~w', (<- OutCall) ),
 1195     ( Ofun == false ->
 1196	true
 1197	;
 1198	<- OutCall
 1199     ),
 1200     debug( real, 'R call: ~w', (<- Call) ),
 1201     call( Call ),
 1202     ( memberchk(post_call(Post),Opts) ->
 1203	debug( real, 'Post call: ~w', [Post] ),
 1204	call( Post )
 1205	;
 1206	debug( real, 'No post call in: ~w', [Opts] )
 1207     ),
 1208     r_call_ouput_dev_off( Ofun ).
 1209
 1210r_call_ouput_dev_off( false ) :- !.
 1211r_call_ouput_dev_off( x11 ) :- !.
 1212r_call_ouput_dev_off( _ ) :- r_devoff.
 1213
 1214r_start_auto :-
 1215     % current_predicate( prefs:start_r_auto/1 ),
 1216     % prefs:start_r_auto( false ),
 1217     current_prolog_flag( real_start, false ),
 1218     !.
 1219r_start_auto :-
 1220     r_start.
 1221
 1222r_send( R ) :-
 1223     % send_r_codes( Rcodes ) :-
 1224     atom_codes( R, Rcodes ), % fixme, make send_r_command/1 to understand atoms
 1225     debug( real, 'Sending to R: ~s', [Rcodes] ),
 1226     send_r_command( Rcodes ).
 1227
 1228assignment(PlDataIn, Rvar) :-
 1229     % atom( Rvar ),
 1230     rvar_identifier( Rvar, Rvar, _ ),
 1231     compound( PlDataIn, c, _Arity ),
 1232     % functor( PlDataIn, c, _Arity ),
 1233     send_c_vector(PlDataIn, Rvar), !,
 1234     debug( real, 'Assigned c vector to R variable ~a.', [Rvar] ).
 1235
 1236assignment(PlDataIn, Rvar) :-
 1237     % atom( Rvar ),
 1238          % we would like to use rvar_identifier here, instead of atom/1
 1239          % but a$b <- 3 does not work with set_r_variable/2.
 1240     rvar_identifier( Rvar, Rvar, _ ),
 1241     pl_data( PlDataIn, PlData ),
 1242     !,
 1243     % term_to_atom( RvarIn, RvarAtom ),
 1244     set_r_variable(Rvar, PlData),
 1245     debug( real, 'Assigned Prolog data to R variable ~a.', [Rvar] ).
 1246
 1247assignment( Rexpr, Rvar ) :-
 1248     rvar_identifier( Rvar, _Rvar, RAssgn ),
 1249     rexpr( '<-'(-RAssgn,Rexpr), TmpRs, R ),
 1250     !,
 1251     r_send( R ),
 1252     maplist( r_remove, TmpRs ).
 1253
 1254pl_data( PlData, PlData ) :-
 1255     ( number(PlData); PlData=[_|_]; boolean_atom(PlData); PlData = @(_) ).
 1256/*
 1257pl_data( PlDataIn, PlData ) :-
 1258     PlDataIn =.. [c|PlData].
 1259*/
 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.

*/

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

JW: July, 2016.

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