

:- module('YapR', [init_r/0,
	float_val/2,
	int_val/2,
	list_val/2,
	r_predicate/3,
	r_command/1,
	op(800,yfx,<-),
	(<-)/2]).

:- setenv('R_HOME','/usr/lib/R'), 
	load_foreign_files(['YapR'], [], init_my_predicates).

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

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

build_args([]) --> [].
build_args([H|T]) -->
	build_arg(H),
	( { T = [] } -> [] ; "," ),
	build_args(T).

build_arg(H) -->
	{ atomic(H) }, !,
	{ name(H, I) },
	I.
build_arg(H) -->
	build_arglist(H).

get_dimargs(A) -->
	{ atomic(A) }, !.
get_dimargs([H|T]) -->
	{ atomic(H) }, !,
	{ length([H|T], LH),
          number_codes(LH, NLH)
        },
	NLH.
get_dimargs([H|T]) -->
	{ length([H|T], LH),
          number_codes(LH, NLH)
        },
	NLH,
	",",
	get_dimargs(H).

build_arglist(L) -->
    { flatten(L, L) }, !,
    "c(",
    build_args(L),
    ")".
build_arglist(L) -->
    { flatten(L, LF) },
    "matrix(c(",
    build_args(LF),
    "),c(",
    get_dimargs(L),
    "),byrow=T)".

build_command(F, Args) -->
	{ binary(F) }, !,
	{
          name(F, FN),
          [O1, O2] = Args
        },
        build_args([O1]),
	FN,
        build_args([O2]).
build_command(F, Args) -->
        { name(F, FN) },
	FN,
	"(",
	build_args(Args),
        ")".

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

r_predicate(F, Args, R) :-
    build_command(F, Args, C, []),
format('~s~n',[C]),
    list_val(C, L),
    get_result(L, R).

r_command(C) :-
    name(C, CL),
    send_r_command(CL).

:- init_r.
