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)).
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
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) ).
533r_started(F) :- r_started -> F=true; F=false.
542'<-'(X) :-
543 r(X).
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).
r_remove( Rvar )
.
See r_remove/1.
580'<<-'( X ) :-
581 r_remove( X ).
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)) ).
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.
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_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.
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.
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))).
847r_is_var( Rvar ) :-
848 r_is_var( Rvar, _ ).
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 ).
872r_char( Atomic, Rchar ) :-
873 atomic( Atomic ),
874 !,
875 atomic_list_concat( ['"',Atomic,'"'], Rchar ).
879r_devoff :-
880 <- invisible(-'dev.off()').
886r_devoff_all :- 887 Dev <- 'dev.cur()', 888 Dev > 1, 889 !, 890 r_devoff, 891 r_devoff_all. 892r_devoff_all.
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 ).
919r_wait :-
920 write('Press Return to continue...'), nl,
921 read_line_to_codes(user_input, _).
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 ).
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.
1031r_version( 2:3:0, date(2022,6,23), rotten_bins ).
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 ].
remove(Rvar)
).1076r_remove( Plvar ) :- 1077 <- remove( Plvar ). 1078 1079r_call_defaults( Defs ) :- 1080 Defs = [ call(true), fcall(_), outputs(false), stem(real_plot) ].
plot(width=3)
.
The predicate also supports multiple output destinations.
Opts a single or list of the following:
debug(real)
and restore at end of callx11(width=7)
)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( =(_,_) ).
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*/
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 ).
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*/
1565rname( ToAtom, Atom ) :-
1566 stringable_atom( ToAtom, 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 . 1586check_quoted(A, _) --> 1587 { format(codes(Codes), '"~a"', [A]) }, 1588 . 1589 1590add_number(El) --> 1591 { number_codes(El, Codes) }, 1592 . 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 ).
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 1732prologmessage(unhandled_exception(real_error(Message))) --> 1733 { debug( real, 'Unhandled ~p', Message ) }, 1734 message(Message). 1735 1736prologmessage(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( atom, List ). List = [atom].
1785to_list( Either, List ) :-
1786 ( (var(Either);(Either\=[_H|_T],Either\==[]) ) ->
1787 List = [Either]
1788 ;
1789 List = Either
1790 ).
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 1833usergoal_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).
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:
r(r_thread_loop_stop)
or <- r_thread_loop_stop in any thread.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
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.
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:
..
within atoms ->.
(ex.as..integer(c(1,2,3)) -> as.integer(c(1,2,3))
)^[]
after atoms ->[]
(ex.a^[2] -> a[2]
)(.)
at the end of atoms that are known R functions ->()
(ex.dev..off(.) -> dev.off()
)[]
->c()
(which equal to R's NULL value)f(x)
:- (..)) ->f(x)
(...)foo()
is valid syntax:<- dev..off()
works now (with no need for dev..off(.)
)m[1] <- 4
works now (with no need for m^[...])prolog_flag( allow_dot_in_atom, true )
.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
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:
However, not all possible "corrections" are currently supported. For instance,
In the data passing mode we map Prolog atoms to R strings-
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,
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.
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
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
Info
pack(real/examples/for_real)
, for_realpack(real/doc/real.html)
pack(real/doc/guide.pdf)
pack(real/doc/padl2013-real.pdf)
*/