/*************************************************************************
*									 *
*	 YapR Module for Yap Prolog 					 *
*									 *
*	YapR Prolog was developed at FEUP - Universidade do Porto	 *
*									 *
* Copyright Joao Azevedo, Vitor Santos Costa and Universidade do Porto 2010-2011 		 *
*									 *
**************************************************************************
*									 *
* File:		yapr.pl							 *
* Last rev:								 *
* mods:									 *
* comments:	Prolog code to interface R-project software with Yap	 *
*									 *
*************************************************************************/

:- module('yapr', [init_r/0,
	float_val/2,
	int_val/2,
	list_val/2,
	r/2,
	r/1,
	r_in/1,
	r_print/1,
	op(950,yfx,<-),
	op(600,xfy,'..'),
	op(400,yfx,'%x%'),
	op(400,yfx,'%%'),
	op(400,yfx,'%/%'),
	op(400,yfx,'%*%'),
	op(400,yfx,'%o%'),
	op(400,yfx,'%in%'),
	op(400,yfx,'$'),
	(<-)/2]).

:- use_module(library(lists), [append/3, append/2, flatten/2]).

init_r_env :-
	% done
	getenv('R_HOME',_), !.
% windows is windows
init_r_env :-
	current_prolog_flag(windows, true),
	catch(win_registry_get_value('HKEY_LOCAL_MACHINE/Software/R-core/R','Current Version', Version),_,fail),
	atom_concat('HKEY_LOCAL_MACHINE/Software/R-core/R/',Version,SecondKey),
	catch(win_registry_get_value(SecondKey,'InstallPath', RPath),_,fail), !,
	% now we need to have the DLL in our path
	install_in_win32_path(RPath).
init_r_env :-
	% typical Linux 64 bit setup (fedora)
	current_prolog_flag(address_bits, 64),
	exists('/usr/lib64/R'), !,
	setenv('R_HOME','/usr/lib64/R'). 
init_r_env :-
	% typical Linux  setup (Ubuntu)
	exists('/usr/lib/R'), !,
	setenv('R_HOME','/usr/lib/R'). 
init_r_env :-
	% typical MacOs setup
	exists('/Library/Frameworks'), !,
	install_in_osx.


install_in_win32_path(RPath) :-
	current_prolog_flag(address_bits, 64), !,
	getenv('PATH',OPath),
	atom_concat([OPath,';',RPath,'\\bin\\x64'],Path),
	putenv('PATH',Path).
install_in_win32_path(RPath) :-
	getenv('PATH',OPath),
	atom_concat([OPath,';',RPath,'\\bin\\i386'],Path),
	putenv('PATH',Path).
	
install_in_osx :-
	% typical MacOs setup
	exists('/Library/Frameworks/R.framework/Resources'), !,
	setenv('R_HOME','/Library/Frameworks/R.framework/Resources'). 
install_in_osx :-
	current_prolog_flag(address_bits, 64),
	exists('/Library/Frameworks/lib64/R'), !,
	setenv('R_HOME','/Library/Frameworks/lib64/R'). 
install_in_osx :-
	setenv('R_HOME','/Library/Frameworks/lib/R'). 

% this must be done before we load R
:- init_r_env.

% get R interface.
:- load_foreign_files(['YapR'], [], init_my_predicates).

binary(':').
binary('.').
binary('-').
binary('+').
binary('/').
binary('*').
binary('^').
binary('%x%').
binary('%%').
binary('%/%').
binary('%*%').
binary('%o%').
binary('%in%').
binary('$').
binary('<-').
binary('=').
binary((:-)).

rfunc(data).
rfunc(frame).
rfunc(numeric).
rfunc(objects).
rfunc(off).
rfunc(sink).
rfunc(start).

r(C) :-
	rterm_to_string(C, L, []),
% atom_codes(C0,L), writeln(C0),
	send_r_command(L).

r_in(C) :- r(C).

(X <- Command) :- 
	var(X), !,
	rterm_to_string(Command, L, []),
% atom_codes(C,L), writeln(C),
	list_val(L, Result),
	get_result(Result, X).
(X <- Command) :-
	r((X <- Command)).

r(X,Command) :- (X <- Command).

get_result([H], H) :- !.
get_result(X, X).

rterm_to_string(V) -->
	{ var(V) }, !,
	{ throw(error(instantiation_error,r_interface)) }.
rterm_to_string(A) -->
	{ ascii_string(A) }, !,
        "\"", A, "\"".
rterm_to_string(A) -->
	% x.y
	{ A = [Head|Tail], Tail \= [_|_], Tail \= [] }, !,
        rterm_to_string(Head),
	".",
	rterm_to_string(Tail).
rterm_to_string(Array) -->
	{ Array = [_|_] },
	array_to_c(Array), !.
rterm_to_string(A) -->
	{ rfunc(A) }, !,
        add_atom(A),
	"()".
rterm_to_string(A) -->
	{ atom(A) }, !,
        add_atom(A).
rterm_to_string(A) -->
	{ number(A) }, !, 
	add_number(A).
rterm_to_string(A^List) -->
	{ atom(A), is_list(List) },
	add_atom(A),
	"[",
	rlist_to_string(List,first),
	"]".
% convert : to ., . has different associativity in Prolog.
rterm_to_string(A1..A2) --> { atom(A1) }, !,
	add_atom(A1),
	".",
	rterm_to_string(A2).
% R function definition
rterm_to_string((A1 :- A2)) -->
	!,
	rterm_to_string(A1),
	" ",
	rterm_to_string(A2).
rterm_to_string(S) -->
	{ functor(S, Na, 2), binary(Na), atom_codes(Na,NaS), arg(1,S,A1), arg(2,S,A2) }, !,
	rterm_to_string(A1),
	" ", NaS, " ",
	rterm_to_string(A2).
rterm_to_string(S) -->
	{ S =.. [F|Args] },
	add_atom(F),
	"(",
	rterms_to_string(Args, first),
	")".

rterms_to_string([], _) --> [].
rterms_to_string(Arg.Args, First) -->
	( { var(First) } -> "," ; "" ),
	rterm_to_string(Arg),
	rterms_to_string(Args, _).

rlist_to_string([],_) --> [].
rlist_to_string('*'.L,Start) -->
	( { var(Start) } -> "," ; "" ),
	rlist_to_string(L,_).
rlist_to_string(A.L,Start) -->
	( { var(Start) } -> "," ; "" ),
	rterm_to_string(A),
	rlist_to_string(L,_).

ascii_string([]).
ascii_string(C.Cs) :-
	integer(C),
	char_type(C,ascii),
        \+ char_type(C,cntrl),
	ascii_string(Cs).

uses_file(FileFunc, Name, File, Rest) :-
	FileFunc =.. [Name,File|Rest],
	uses_file(Name).

array_to_c(Array) -->
	{ Array = [[_|_]|_] }, !,
	/* matrix */
        "array(c(",
	flatten_matrix(Array, Dims, first),
	"),dim=",
	output_list(Dims),
	")".
array_to_c(Array) -->
	output_list(Array).

output_list(List) -->
	"c(",
	matrix_inside(List, _, first, 0, _),
	")".

flatten_matrix(Array, Length.Dims, Start) -->
	matrix_inside(Array, Dims, Start, 0, Length).

matrix_inside([], _, _, N, N) --> [].
matrix_inside(El.Array, Dims, Start, N0, N) -->
	matrix_el(El, Dims, Start),
	{ N1 is N0+1 },
	matrix_inside(Array, Dims, _, N1, N).
	
matrix_el(Array, Dims, Start) --> 
	{ Array = [_|_] },
	flatten_matrix(Array, Dims, Start).
matrix_el(El, [], Start) -->
	( { var(Start) } -> ", " ; "" ),
	rterm_to_string(El).

add_number(El) -->
	{ number_codes(El, Codes) },
	Codes.

%
% a nil atom in Prolog is likely to be the empty string in R.
%
add_atom([]) --> !,
	"\"\"".
add_atom(A) -->
	{ atom_codes(A, Codes) },
	Codes.

:- init_r.

% make it simple for now.
r_print(X) :-
	V <- X,
	format('~w = ~w~n',[X,V]).

