small fixes
This commit is contained in:
parent
a70da52e1f
commit
bc16bf83ec
@ -2072,11 +2072,8 @@ init_current_wide_atom( USES_REGS1 )
|
||||
void
|
||||
Yap_InitBackAtoms(void)
|
||||
{
|
||||
Yap_InitCPredBack("$current_atom", 1, 2, init_current_atom, cont_current_atom,
|
||||
SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPredBack("$current_wide_atom", 1, 2, init_current_wide_atom,
|
||||
cont_current_wide_atom,
|
||||
SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPredBack("$current_atom", 1, 2, init_current_atom, cont_current_atom,SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPredBack("$current_wide_atom", 1, 2, init_current_wide_atom,cont_current_wide_atom,SafePredFlag|SyncPredFlag);
|
||||
Yap_InitCPredBack("atom_concat", 3, 2, init_atom_concat3, cont_atom_concat3, 0);
|
||||
Yap_InitCPredBack("string_concat", 3, 2, init_string_concat3, cont_string_concat3, 0);
|
||||
Yap_InitCPredBack("sub_atom", 5, 5, init_sub_atom, cont_sub_atomic, 0);
|
||||
|
14
C/errors.c
14
C/errors.c
@ -242,6 +242,8 @@ DumpActiveGoals ( USES_REGS1 )
|
||||
if (!ONLOCAL (b_ptr) || b_ptr->cp_b == NULL)
|
||||
break;
|
||||
pe = Yap_PredForChoicePt(b_ptr);
|
||||
if (!pe)
|
||||
break;
|
||||
PELOCK(72,pe);
|
||||
{
|
||||
Functor f;
|
||||
@ -251,10 +253,13 @@ DumpActiveGoals ( USES_REGS1 )
|
||||
if (pe->ModuleOfPred)
|
||||
mod = pe->ModuleOfPred;
|
||||
else mod = TermProlog;
|
||||
YapPlWrite (mod);
|
||||
YapPutc (LOCAL_c_error_stream,':');
|
||||
if (mod != TermProlog &&
|
||||
mod != MkAtomTerm(AtomUser) ) {
|
||||
YapPlWrite (mod);
|
||||
YapPutc (LOCAL_c_error_stream,':');
|
||||
}
|
||||
if (pe->ArityOfPE == 0) {
|
||||
YapPlWrite (MkAtomTerm (NameOfFunctor(f)));
|
||||
YapPlWrite (MkAtomTerm ((Atom)f));
|
||||
} else {
|
||||
Int i = 0, arity = pe->ArityOfPE;
|
||||
Term *args = &(b_ptr->cp_a1);
|
||||
@ -1990,6 +1995,9 @@ E);
|
||||
Yap_RestartYap( 1 );
|
||||
}
|
||||
UNLOCK(LOCAL_SignalLock);
|
||||
#if DEBUG
|
||||
DumpActiveGoals( PASS_REGS1 );
|
||||
#endif
|
||||
/* wait if we we are in user code,
|
||||
it's up to her to decide */
|
||||
|
||||
|
21
C/iopreds.c
21
C/iopreds.c
@ -491,7 +491,6 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
|
||||
if (inp_stream == NULL) {
|
||||
return FALSE;
|
||||
}
|
||||
CurrentModule = tmod = MkAtomTerm(rd->module->AtomOfME);
|
||||
LOCAL_Error_TYPE = YAP_NO_ERROR;
|
||||
while (TRUE) {
|
||||
CELL *old_H;
|
||||
@ -558,7 +557,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
|
||||
}
|
||||
}
|
||||
repeat_cycle:
|
||||
CurrentModule = tmod;
|
||||
CurrentModule = tmod = MkAtomTerm(rd->module->AtomOfME);
|
||||
if (LOCAL_ErrorMessage || (t = Yap_Parse(rd)) == 0) {
|
||||
CurrentModule = OCurrentModule;
|
||||
if (LOCAL_ErrorMessage) {
|
||||
@ -601,6 +600,7 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
|
||||
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
|
||||
rd->has_exception = TRUE;
|
||||
rd->exception = Yap_InitSlot(terror PASS_REGS);
|
||||
CurrentModule = OCurrentModule;
|
||||
return FALSE;
|
||||
}
|
||||
} else {
|
||||
@ -634,8 +634,10 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
|
||||
TR = old_TR;
|
||||
}
|
||||
}
|
||||
if (!Yap_unify(v, Yap_GetFromSlot( rd->varnames PASS_REGS)))
|
||||
if (!Yap_unify(v, Yap_GetFromSlot( rd->varnames PASS_REGS))) {
|
||||
CurrentModule = OCurrentModule;
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
|
||||
if (rd->variables) {
|
||||
@ -659,11 +661,13 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
|
||||
TR = old_TR;
|
||||
}
|
||||
}
|
||||
if (!Yap_unify(v, Yap_GetFromSlot( rd->variables PASS_REGS)))
|
||||
if (!Yap_unify(v, Yap_GetFromSlot( rd->variables PASS_REGS))) {
|
||||
CurrentModule = OCurrentModule;
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
if (rd->singles) {
|
||||
Term v;
|
||||
Term v;
|
||||
while (TRUE) {
|
||||
CELL *old_H = HR;
|
||||
|
||||
@ -689,11 +693,14 @@ Yap_read_term(term_t t0, IOSTREAM *inp_stream, struct read_data_t *rd)
|
||||
else
|
||||
rd->singles = FALSE;
|
||||
} else if (rd->singles) {
|
||||
if (!Yap_unify( v, Yap_GetFromSlot( rd->singles PASS_REGS )))
|
||||
return FALSE;
|
||||
if (!Yap_unify( v, Yap_GetFromSlot( rd->singles PASS_REGS ))) {
|
||||
CurrentModule = OCurrentModule;
|
||||
return FALSE;
|
||||
}
|
||||
}
|
||||
}
|
||||
Yap_clean_tokenizer(tokstart, LOCAL_VarTable, LOCAL_AnonVarTable, LOCAL_Comments);
|
||||
CurrentModule = OCurrentModule;
|
||||
return TRUE;
|
||||
}
|
||||
|
||||
|
@ -121,7 +121,7 @@ LookupModule(Term a )
|
||||
|
||||
/* prolog module */
|
||||
if (a == 0) {
|
||||
return GetModuleEntry(AtomProlog);
|
||||
return GetModuleEntry(AtomUser);
|
||||
}
|
||||
at = AtomOfTerm(a);
|
||||
me = GetModuleEntry(at);
|
||||
|
@ -1823,6 +1823,9 @@ TrueFileName (char *source, char *root, char *result, int in_lib, int expand_roo
|
||||
char ares1[YAP_FILENAME_MAX];
|
||||
|
||||
result[0] = '\0';
|
||||
if (strlen(source) >= YAP_FILENAME_MAX) {
|
||||
Yap_Error(OPERATING_SYSTEM_ERROR, TermNil, "%s in true_file-name is larger than the buffer size (%d bytes)", source, strlen(source));
|
||||
}
|
||||
#if defined(__MINGW32__) || _MSC_VER
|
||||
/* step 0: replace / by \ */
|
||||
strncpy(ares1, source, YAP_FILENAME_MAX);
|
||||
|
@ -47,6 +47,7 @@
|
||||
variable_value/3
|
||||
]).
|
||||
|
||||
:- use_module(library(lists)).
|
||||
:- use_module(library(clpr)).
|
||||
:- use_module(library(assoc)).
|
||||
:- use_module(library(pio)).
|
||||
|
@ -179,46 +179,46 @@ vars_set(Term, Vars) :-
|
||||
|
||||
sort(=<, L, R) :-
|
||||
length(L, N),
|
||||
$bp_sort(@=<, N, L, _, R1), !,
|
||||
'$bp_sort'(@=<, N, L, _, R1), !,
|
||||
R = R1.
|
||||
sort(>=, L, R) :-
|
||||
length(L, N),
|
||||
$bp_sort(@>=, N, L, _, R1), !,
|
||||
'$bp_sort'(@>=, N, L, _, R1), !,
|
||||
R = R1.
|
||||
sort(<, L, R) :-
|
||||
length(L, N),
|
||||
$bp_sort2(@<, N, L, _, R1), !,
|
||||
'$bp_sort2'(@<, N, L, _, R1), !,
|
||||
R = R1.
|
||||
sort(>, L, R) :-
|
||||
length(L, N),
|
||||
$bp_sort2(@>, N, L, _, R1), !,
|
||||
'$bp_sort2'(@>, N, L, _, R1), !,
|
||||
R = R1.
|
||||
|
||||
$bp_sort(P, 2, [X1, X2|L], L, R) :- !,
|
||||
'$bp_sort'(P, 2, [X1, X2|L], L, R) :- !,
|
||||
(
|
||||
call(P, X1, X2) ->
|
||||
R = [X1,X2]
|
||||
;
|
||||
R = [X2,X1]
|
||||
).
|
||||
$bp_sort(_, 1, [X|L], L, [X]) :- !.
|
||||
$bp_sort(_, 0, L, L, []) :- !.
|
||||
$bp_sort(P, N, L1, L3, R) :-
|
||||
'$bp_sort'(_, 1, [X|L], L, [X]) :- !.
|
||||
'$bp_sort'(_, 0, L, L, []) :- !.
|
||||
'$bp_sort'(P, N, L1, L3, R) :-
|
||||
N1 is N // 2,
|
||||
plus(N1, N2, N),
|
||||
$bp_sort(P, N1, L1, L2, R1),
|
||||
$bp_sort(P, N2, L2, L3, R2),
|
||||
$bp_predmerge(P, R1, R2, R).
|
||||
'$bp_sort'(P, N1, L1, L2, R1),
|
||||
'$bp_sort'(P, N2, L2, L3, R2),
|
||||
'$bp_predmerge'(P, R1, R2, R).
|
||||
|
||||
$bp_predmerge(_, [], R, R) :- !.
|
||||
$bp_predmerge(_, R, [], R) :- !.
|
||||
$bp_predmerge(P, [H1|T1], [H2|T2], [H1|Result]) :-
|
||||
'$bp_predmerge'(_, [], R, R) :- !.
|
||||
'$bp_predmerge'(_, R, [], R) :- !.
|
||||
'$bp_predmerge'(P, [H1|T1], [H2|T2], [H1|Result]) :-
|
||||
call(P, H1, H2), !,
|
||||
$bp_predmerge(P, T1, [H2|T2], Result).
|
||||
$bp_predmerge(P, [H1|T1], [H2|T2], [H2|Result]) :-
|
||||
$bp_predmerge(P, [H1|T1], T2, Result).
|
||||
'$bp_predmerge'(P, T1, [H2|T2], Result).
|
||||
'$bp_predmerge'(P, [H1|T1], [H2|T2], [H2|Result]) :-
|
||||
'$bp_predmerge'(P, [H1|T1], T2, Result).
|
||||
|
||||
$bp_sort2(P, 2, [X1, X2|L], L, R) :- !,
|
||||
'$bp_sort2'(P, 2, [X1, X2|L], L, R) :- !,
|
||||
(
|
||||
call(P, X1, X2) ->
|
||||
R = [X1,X2]
|
||||
@ -229,22 +229,22 @@ $bp_sort2(P, 2, [X1, X2|L], L, R) :- !,
|
||||
;
|
||||
R = [X2,X1]
|
||||
).
|
||||
$bp_sort2(_, 1, [X|L], L, [X]) :- !.
|
||||
$bp_sort2(_, 0, L, L, []) :- !.
|
||||
$bp_sort2(P, N, L1, L3, R) :-
|
||||
'$bp_sort2'(_, 1, [X|L], L, [X]) :- !.
|
||||
'$bp_sort2'(_, 0, L, L, []) :- !.
|
||||
'$bp_sort2'(P, N, L1, L3, R) :-
|
||||
N1 is N // 2,
|
||||
plus(N1, N2, N),
|
||||
$bp_sort(P, N1, L1, L2, R1),
|
||||
$bp_sort(P, N2, L2, L3, R2),
|
||||
$bp_predmerge(P, R1, R2, R).
|
||||
'$bp_sort'(P, N1, L1, L2, R1),
|
||||
'$bp_sort'(P, N2, L2, L3, R2),
|
||||
'$bp_predmerge'(P, R1, R2, R).
|
||||
|
||||
$bp_predmerge2(_, [], R, R) :- !.
|
||||
$bp_predmerge2(_, R, [], R) :- !.
|
||||
$bp_predmerge2(P, [H1|T1], [H2|T2], [H1|Result]) :-
|
||||
'$bp_predmerge2'(_, [], R, R) :- !.
|
||||
'$bp_predmerge2'(_, R, [], R) :- !.
|
||||
'$bp_predmerge2'(P, [H1|T1], [H2|T2], [H1|Result]) :-
|
||||
call(P, H1, H2), !,
|
||||
$bp_predmerge(P, T1, [H2|T2], Result).
|
||||
$bp_predmerge2(P, [H1|T1], [H2|T2], [H1|Result]) :-
|
||||
'$bp_predmerge'(P, T1, [H2|T2], Result).
|
||||
'$bp_predmerge2'(P, [H1|T1], [H2|T2], [H1|Result]) :-
|
||||
H1 == H2, !,
|
||||
$bp_predmerge(P, T1, T2, Result).
|
||||
$bp_predmerge2(P, [H1|T1], [H2|T2], [H2|Result]) :-
|
||||
$bp_predmerge(P, [H1|T1], T2, Result).
|
||||
'$bp_predmerge'(P, T1, T2, Result).
|
||||
'$bp_predmerge2'(P, [H1|T1], [H2|T2], [H2|Result]) :-
|
||||
'$bp_predmerge'(P, [H1|T1], T2, Result).
|
||||
|
@ -1,4 +1,4 @@
|
||||
s% File : compile_foreach.pl
|
||||
% File : compile_foreach.pl
|
||||
% Author : Neng-Fa Zhou
|
||||
% Updated: June 2009, updated Dec. 2009, updated Sep. 2010
|
||||
% Purpose: compile away foreach
|
||||
@ -10,9 +10,12 @@ s% File : compile_foreach.pl
|
||||
|
||||
:- yap_flag(unknown,error).
|
||||
:- ensure_loaded(actionrules).
|
||||
:- op(560,xfx,[..,to,downto]).
|
||||
:- op(700,xfx,[subset,notin,in,@=]).
|
||||
|
||||
:- op(1200,fy,[delay]).
|
||||
:- op(1150,xfy,[?]).
|
||||
:- op(560,xfy,[..,to,downto]).
|
||||
:- op(700,xfx,[subset,notin,is,in,\==,\=,@>=,@>,@=<,@=,@<,@:=,?=,>=,>,
|
||||
=\=,==,=<,=:=,=..,=,<=,<,:=,$>=,$=<,$=,#\=,#>=,#>,#=<,
|
||||
#=,#<\-,#<>,#<-,#<,#:=,##]).
|
||||
/*
|
||||
test:-
|
||||
Cl1=(test1(L):-foreach(I in L, write(I))),
|
||||
@ -32,7 +35,7 @@ test:-
|
||||
(member(NCl,NCls), portray_clause(NCl),fail;true).
|
||||
*/
|
||||
compile_foreach(File):-
|
||||
$getclauses_read_file(File,'$t.t.t$',0,_Singleton,_Redef,Cls,[]),
|
||||
'$getclauses_read_file'(File,'$t.t.t$',0,_Singleton,_Redef,Cls,[]),
|
||||
compile_foreach(Cls,NCls),
|
||||
foreach(NCl in NCls, portray_clause(NCl)).
|
||||
|
||||
@ -137,8 +140,8 @@ exp_contains_list_comp(max([(_ : _)|_]),Flag) => Flag=1.
|
||||
exp_contains_list_comp(_,_) => true.
|
||||
|
||||
%%
|
||||
$change_list_comprehension_to_foreach_cmptime(T,I,Is,CallForeach,L):-
|
||||
$retrieve_list_comp_lvars_goal_cmptime(Is,LocalVars1,Goal1,Is1),
|
||||
'$change_list_comprehension_to_foreach_cmptime'(T,I,Is,CallForeach,L):-
|
||||
'$retrieve_list_comp_lvars_goal_cmptime'(Is,LocalVars1,Goal1,Is1),
|
||||
(nonvar(T),T=_^_-> % array access
|
||||
LocalVars=[TempVar|LocalVars1],
|
||||
(Goal1==true->
|
||||
@ -157,20 +160,20 @@ $change_list_comprehension_to_foreach_cmptime(T,I,Is,CallForeach,L):-
|
||||
append(Is1,[LocalVars,ac1(L,[]),Goal],Is2),
|
||||
CallForeach=..[foreach,I|Is2].
|
||||
|
||||
$retrieve_list_comp_lvars_goal_cmptime([],LocalVars,Goal,Is) =>
|
||||
'$retrieve_list_comp_lvars_goal_cmptime'([],LocalVars,Goal,Is) =>
|
||||
LocalVars=[],Goal=true,Is=[].
|
||||
$retrieve_list_comp_lvars_goal_cmptime([E|Es],LocalVars,Goal,Is),E = (_ in _) =>
|
||||
'$retrieve_list_comp_lvars_goal_cmptime'([E|Es],LocalVars,Goal,Is),E = (_ in _) =>
|
||||
Is=[E|IsR],
|
||||
$retrieve_list_comp_lvars_goal_cmptime(Es,LocalVars,Goal,IsR).
|
||||
$retrieve_list_comp_lvars_goal_cmptime([LVars,G],LocalVars,Goal,Is),LVars=[] =>
|
||||
'$retrieve_list_comp_lvars_goal_cmptime'(Es,LocalVars,Goal,IsR).
|
||||
'$retrieve_list_comp_lvars_goal_cmptime'([LVars,G],LocalVars,Goal,Is),LVars=[] =>
|
||||
Is=[],LocalVars=LVars,G=Goal.
|
||||
$retrieve_list_comp_lvars_goal_cmptime([LVars,G],LocalVars,Goal,Is),LVars=[_|_] =>
|
||||
'$retrieve_list_comp_lvars_goal_cmptime'([LVars,G],LocalVars,Goal,Is),LVars=[_|_] =>
|
||||
Is=[],LocalVars=LVars,G=Goal.
|
||||
$retrieve_list_comp_lvars_goal_cmptime([LVars],LocalVars,Goal,Is),LVars=[_|_] =>
|
||||
'$retrieve_list_comp_lvars_goal_cmptime'([LVars],LocalVars,Goal,Is),LVars=[_|_] =>
|
||||
Is=[],LocalVars=LVars,Goal=true.
|
||||
$retrieve_list_comp_lvars_goal_cmptime([LVars],LocalVars,Goal,Is),LVars=[] =>
|
||||
'$retrieve_list_comp_lvars_goal_cmptime'([LVars],LocalVars,Goal,Is),LVars=[] =>
|
||||
Is=[],LocalVars=LVars,Goal=true.
|
||||
$retrieve_list_comp_lvars_goal_cmptime([G],LocalVars,Goal,Is),nonvar(G) =>
|
||||
'$retrieve_list_comp_lvars_goal_cmptime'([G],LocalVars,Goal,Is),nonvar(G) =>
|
||||
Is=[],LocalVars=[],G=Goal.
|
||||
|
||||
%%
|
||||
@ -400,7 +403,7 @@ split_acs_map([ac_inout(Name,In,Out)|ACMap],ACMap1,ACMap2) =>
|
||||
/* utilities */
|
||||
extract_arg_vars([],_I,_Iterators,_LocalVars,_ACMap,Args,ArgsR) => Args=ArgsR.
|
||||
extract_arg_vars([Var|Vars],I,Iterators,LocalVars,ACMap,Args,ArgsR):-true ?
|
||||
($occur(Var,I);
|
||||
('$occur'(Var,I);
|
||||
is_a_loop_var(Var,Iterators);
|
||||
membchk(Var,LocalVars);
|
||||
foreach_lookup_acmap(Var,1,_,ACMap);
|
||||
@ -410,7 +413,7 @@ extract_arg_vars([Var|Vars],I,Iterators,LocalVars,ACMap,Args,ArgsR) =>
|
||||
Args=[Var|Args1],
|
||||
extract_arg_vars(Vars,I,Iterators,LocalVars,ACMap,Args1,ArgsR).
|
||||
|
||||
is_a_loop_var(Var,(I in _)):-true ? $occur(Var,I),!.
|
||||
is_a_loop_var(Var,(I in _)):-true ? '$occur'(Var,I),!.
|
||||
is_a_loop_var(Var,(Iterators1,_)):-true ?
|
||||
is_a_loop_var(Var,Iterators1),!.
|
||||
is_a_loop_var(Var,(_,Iterators2)) =>
|
||||
|
@ -43,7 +43,9 @@ do(0, NumProc):-
|
||||
set_value(n, NewCounter),
|
||||
NewCounter == 1,
|
||||
!,
|
||||
format( '0: Result: ~q.~n', [
|
||||
format( '0: Result: ~q.~n', [NewAcc]).
|
||||
|
||||
|
||||
do(Rank, NumProc):-
|
||||
!,
|
||||
% catch the task broadcast
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -1,184 +0,0 @@
|
||||
|
||||
:- use_module(library(lists)). % member/2.
|
||||
:- use_module(library(readutil)). % read_line_to_codes/2.
|
||||
|
||||
:- nl, nl.
|
||||
:- ( r_bin(Rbin) ->
|
||||
write( 'Will be using the R found at: ' ), nl,
|
||||
write( Rbin ), nl, nl
|
||||
;
|
||||
write( 'This session cannot locate an R executable. Please register the location' ), nl,
|
||||
write( 'of the R executalbe using r_bin/1 before you can run the demos.' ), nl, nl
|
||||
).
|
||||
|
||||
:- write( 'Demo predicates for R (r_session) package.' ), nl.
|
||||
:- write( 'See r_demo_1/0,...,r_demo_10/0.' ), nl.
|
||||
:- write( 'The goal r_demo/0 is a shorthand for r_demo_1/0,...,r_demo_7/0 which are the main demos.' ), nl, nl.
|
||||
:- write( 'r_demo_all/0 and r_demo_clauses/0 for r_demo_1,...,r_demo_10.' ), nl.
|
||||
:- write( 'which include demos for some non-basic features.' ), nl.
|
||||
:- write( 'You need to look at the sources before running r_demo_8,9 and 10.' ).
|
||||
:- nl, nl.
|
||||
|
||||
r_demo :-
|
||||
nl, nl,
|
||||
Rdemos = [r_demo_1,r_demo_2,r_demo_3,r_demo_4,r_demo_5,r_demo_6,r_demo_7],
|
||||
r_demo( Rdemos, false ).
|
||||
|
||||
r_demo_all:-
|
||||
nl, nl,
|
||||
Rdemos = [r_demo_1,r_demo_2,r_demo_3,r_demo_4,r_demo_5,r_demo_6,r_demo_7,r_demo_8,r_demo_9,r_demo_10],
|
||||
r_demo( Rdemos, false ).
|
||||
|
||||
r_demo_clauses :-
|
||||
nl, nl,
|
||||
Rdemos = [r_demo_1,r_demo_2,r_demo_3,r_demo_4,r_demo_5,r_demo_6,r_demo_7,r_demo_8,r_demo_9,r_demo_10],
|
||||
r_demo( Rdemos, true ).
|
||||
|
||||
r_demo( Rdemos, Clauses ) :-
|
||||
member(Wh, Rdemos ),
|
||||
write( doing-Wh ), nl,
|
||||
( Clauses == true ->
|
||||
write( 'Clauses: ' ), nl,
|
||||
findall( Wh-Body, (clause(Wh,Body),
|
||||
portray_clause((Wh:-Body)), nl), _ )
|
||||
;
|
||||
true
|
||||
),
|
||||
( call(Wh) ->
|
||||
true
|
||||
;
|
||||
write( 'Demo ended with failure.' ), nl
|
||||
),
|
||||
nl, nl,
|
||||
fail.
|
||||
r_demo( _Rdemos, _ ) :-
|
||||
write( done ), nl.
|
||||
|
||||
r_demo_1 :-
|
||||
write( 'Demo: basic vector interactions.' ), nl, nl,
|
||||
r_open,
|
||||
r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ),
|
||||
( r_out( print(x), Lines ), r_lines_print( Lines ), fail; true ),
|
||||
r_print( x ),
|
||||
r_in( x ),
|
||||
r_in( (y <- c(6,5,4,3,2,1); y) ), % The extra paranthesis are only
|
||||
% needed for Yap.
|
||||
r_in( Z <- c(10.4, 5.6, 3.1, 6.4, 21.7) ),
|
||||
write( z(Z) ), nl,
|
||||
r_close.
|
||||
|
||||
r_demo_2 :-
|
||||
write( 'Demo: plots (screen and postscript).' ), nl, nl,
|
||||
r_open,
|
||||
r_in( y <- rnorm(50) ),
|
||||
r_print( y ),
|
||||
r_in( Y <- y ),
|
||||
write( y(Y) ), nl,
|
||||
r_in( x <- rnorm(y) ),
|
||||
r_print( x ),
|
||||
r_in( X <- x ),
|
||||
write( x(X) ), nl,
|
||||
r_in( x11(width=5,height=3.5) ),
|
||||
r_in( plot(x,y)),
|
||||
write( 'Press Return to continue...' ), nl,
|
||||
current_prolog_flag( version, V ),
|
||||
( integer(V) -> User = current_input % SWI Prolog
|
||||
; User = user ),
|
||||
read_line_to_codes( User, _ ),
|
||||
r_in( 'dev.off()' ),
|
||||
r_in( 'postscript(file="x_vs_y.eps")' ),
|
||||
r_in( plot(x,y)),
|
||||
r_in( 'dev.off()' ),
|
||||
r_close,
|
||||
!, % Swi leaves a backtracking point at read_line_to_codes/2
|
||||
write( 'Check that file x_vs_y.eps has been created.' ), nl.
|
||||
|
||||
r_demo_3 :-
|
||||
write( 'Demo: aliases.' ), nl, nl,
|
||||
r_open( [alias(mamonaku)] ),
|
||||
( current_r_session(Alias),write(session(Alias)),nl, fail; true ),
|
||||
r_in( mamonaku, x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ),
|
||||
r_print( mamonaku, x ),
|
||||
r_close( mamonaku ).
|
||||
|
||||
r_demo_4 :-
|
||||
write( 'Demo: history.' ), nl, nl,
|
||||
r_open,
|
||||
( r_history(A,B), write(history(A,B)), nl, fail; true ),
|
||||
r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ),
|
||||
( r_out( print(x), Lines ), r_lines_print( Lines ), fail; true ),
|
||||
r_print( x ),
|
||||
( r_history(C,D), write(h(C,D)), nl, fail; true ),
|
||||
r_close.
|
||||
|
||||
r_demo_5 :-
|
||||
write( 'Demo: calls to R functions.' ), nl, nl,
|
||||
r_open,
|
||||
r_in( i <- 0:14 ),
|
||||
r_print( i ),
|
||||
r_in( I <- i ),
|
||||
write( 'I'(I) ), nl,
|
||||
r_in( x <- i/10 ),
|
||||
r_in( y <- c(176.547,194.2552,218.5462,441.3706,795.786,1190.8606,1321.0128,1326.4694,1437.3068,1364.6906,1343.768,1513.7298,1553.8264,1554.1748,1549.399) ),
|
||||
r_print( (integrate(splinefun(x,y), 0.2, 0.4)) ),
|
||||
r_close.
|
||||
|
||||
r_demo_6 :-
|
||||
write( 'Demo: copying output and error on to file.' ), nl, nl,
|
||||
r_open( [copy('rec_both.txt',both)] ),
|
||||
r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ),
|
||||
r_print( x ),
|
||||
write( 'Check that file rec_both.txt has been created.' ), nl,
|
||||
r_close.
|
||||
|
||||
r_demo_7 :-
|
||||
write( 'Demo: error on R.' ), nl, nl,
|
||||
r_open( [at_r_halt(restart)] ),
|
||||
r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ),
|
||||
r_print( x ),
|
||||
r_print( y ),
|
||||
r_print( x ),
|
||||
r_close.
|
||||
|
||||
%%% Cut-off
|
||||
|
||||
r_demo_8 :-
|
||||
write( 'Demo: reinstate on halt.' ), nl,
|
||||
write( 'This is no longer valid.' ), nl, nl,
|
||||
r_open( [at_r_halt(reinstate)] ),
|
||||
r_in( x <- c(10.4, 5.6, 3.1, 6.4, 21.7) ),
|
||||
r_print( y ),
|
||||
% here slave dies
|
||||
% and r_session tries to restar_demo it and replay all commands.
|
||||
r_print( x ),
|
||||
% succeeds
|
||||
r_close.
|
||||
|
||||
/* change 192.168.0.* to a host in your domain before running the following. */
|
||||
r_demo_9 :-
|
||||
write( 'Demo: ssh on a machine with R on a different location.' ), nl, nl,
|
||||
r_open( [ssh('192.168.0.3')] ),
|
||||
r_in( I <- 0:14 ),
|
||||
write( 'I'(I) ), nl,
|
||||
r_close.
|
||||
|
||||
r_demo_10 :-
|
||||
write( 'Demo: ssh on a machine with explicit set of the remote R location.' ),
|
||||
nl, nl,
|
||||
r_bin( '/usr/local/users/nicos/local/bin/R' ),
|
||||
r_open( [ssh('192.168.0.3')] ),
|
||||
r_in( I <- 0:14 ),
|
||||
write( 'I'(I) ), nl,
|
||||
r_close.
|
||||
|
||||
/*
|
||||
% You can replace any of the above r_open/0,1, with one of the following
|
||||
r_open( [with(restore)] ).
|
||||
% do not use --no-restore on the R flags
|
||||
r_open( [copy(copied,both)] ).
|
||||
% copy both input and output to file copied
|
||||
r_open( [at_r_halt(restar_demo),alias(mamunaku),copy(copied_in,in)] ).
|
||||
% copy input to file copied_in
|
||||
r_open( [at_r_halt(restar_demo),alias(mamunaku),copy(copy_out,out)] ).
|
||||
% copy output to file copied_out
|
||||
*/
|
@ -11,13 +11,13 @@
|
||||
pcg_init_graph/0
|
||||
]).
|
||||
|
||||
:- load_files([library(clpbn)],
|
||||
:- load_files(library(clpbn),
|
||||
[if(not_loaded), silent(true)]).
|
||||
|
||||
:- use_module([library(lists)],
|
||||
:- use_module(library(lists),
|
||||
[sum_list/2]).
|
||||
|
||||
:- use_module([library(matrix)],
|
||||
:- use_module(library(matrix)],
|
||||
[matrix_new/3,
|
||||
matrix_add/3,
|
||||
matrix_get/3,
|
||||
|
@ -30,8 +30,8 @@
|
||||
*/
|
||||
|
||||
:- module('$win_menu',
|
||||
[ win_insert_menu_item/4, % +PopupName, +Item, +Before, :Goal
|
||||
win_has_menu/0 % Test whether we have menus
|
||||
[ % win_insert_menu_item/4, % +PopupName, +Item, +Before, :Goal
|
||||
% win_has_menu/0 % Test whether we have menus
|
||||
]).
|
||||
|
||||
:- meta_predicate
|
||||
|
@ -25,7 +25,7 @@
|
||||
persistent_retract/1
|
||||
]).
|
||||
|
||||
:- use_module(library(system),[]).
|
||||
:- use_module(library(system)).
|
||||
|
||||
:- dynamic(persistent_desc/2).
|
||||
|
||||
|
@ -69,7 +69,7 @@ predicate_options/3. This directive allows us to specify that e.g.,
|
||||
open/4 processes options using the 4th argument and supports the option
|
||||
=type= using the values =text= and =binary=. Declaring options that are
|
||||
processed allows for more reliable handling of predicate options and
|
||||
simplifies porting applications. This libarry provides the following
|
||||
simplifies porting applications. This library provides the following
|
||||
functionality:
|
||||
|
||||
* Query supported options through current_predicate_option/3
|
||||
|
Reference in New Issue
Block a user