691 lines
		
	
	
		
			16 KiB
		
	
	
	
		
			Prolog
		
	
	
	
	
	
			
		
		
	
	
			691 lines
		
	
	
		
			16 KiB
		
	
	
	
		
			Prolog
		
	
	
	
	
	
 | 
						||
:- ensure_loaded( library(real) ).
 | 
						||
:- ensure_loaded( library(lists) ).
 | 
						||
:- use_module( library(apply_macros) ).
 | 
						||
:- use_module( library(readutil) ).
 | 
						||
 | 
						||
:- set_prolog_flag(double_quotes, string).
 | 
						||
 | 
						||
% for_real.
 | 
						||
%
 | 
						||
%  Some examples illustrating usage of the r..eal library.
 | 
						||
 | 
						||
for_real :-
 | 
						||
     ( Head = ex(_Ex); Head = tut(_Tut) ),
 | 
						||
     clause( Head, Body ),
 | 
						||
     write(running:Head), nl, nl,
 | 
						||
     portray_clause( (Head:-Body) ), nl, nl,
 | 
						||
     write( 'Output: ' ), nl,
 | 
						||
     ( catch(Head,Exc,Fex=true) -> 
 | 
						||
          ( Fex==true-> 
 | 
						||
               write( '! ' ), write( caught(Exc) ), nl, abort
 | 
						||
               ;
 | 
						||
               write(status:true)
 | 
						||
          )
 | 
						||
          ;
 | 
						||
          write( '! ' ), write( failure ), nl, abort
 | 
						||
     ),
 | 
						||
     nl, nl, write('-----'), nl, nl,
 | 
						||
     fail.
 | 
						||
for_real :-
 | 
						||
     write( 'All done.' ), nl.
 | 
						||
 | 
						||
 | 
						||
% ex(int).
 | 
						||
%
 | 
						||
%  Pass the salt please. 
 | 
						||
%  The most basic example: pass a Prolog list of integers to an R variable 
 | 
						||
%  and then back again to a Prolog variable.
 | 
						||
%
 | 
						||
ex(int) :-
 | 
						||
     i <- [1,2,3,4],
 | 
						||
     <- i,
 | 
						||
     I <- i,
 | 
						||
     write( i(I) ), nl.
 | 
						||
 | 
						||
% float.
 | 
						||
%
 | 
						||
%  Pass a Prolog list of floats to an R variable and then back again to a Prolog variable.
 | 
						||
%
 | 
						||
ex(float) :-
 | 
						||
     f <- [1.0,2,3,4],
 | 
						||
     <- f,
 | 
						||
     F <- f,
 | 
						||
     write( f(F) ), nl.
 | 
						||
 | 
						||
% ex( float ).
 | 
						||
%
 | 
						||
%  Pass a mixed Prolog list of integers and floats to an R variable and
 | 
						||
%  then back again to a Prolog variable.
 | 
						||
%  The returning list is occupied by floats as is the R variable.
 | 
						||
%
 | 
						||
ex(to_float) :-
 | 
						||
     m <- [1,2,3,4.0],
 | 
						||
     <- m,
 | 
						||
     M1 <- m,
 | 
						||
     write( m(M1) ), nl,
 | 
						||
     m <- [1,2,3,4.1],
 | 
						||
     <- m,
 | 
						||
     M2 <- m,
 | 
						||
     write( m(M2) ), nl.
 | 
						||
 | 
						||
% ex(bool).
 | 
						||
%
 | 
						||
%
 | 
						||
ex(bool) :- 
 | 
						||
     b <- [true,false,true,true],
 | 
						||
     <- print( b ),
 | 
						||
     B <- b,
 | 
						||
     write( b(B) ), nl.
 | 
						||
 | 
						||
% at_bool.
 | 
						||
%
 | 
						||
%  In cases where disambiguation is needed, boolean values can be represented by @Val terms.
 | 
						||
%
 | 
						||
ex(at_bool) :- 
 | 
						||
     b <- [@true,@false,@true,@true],
 | 
						||
     <- print( b ),
 | 
						||
     B <- b,
 | 
						||
     write( at_b(B) ), nl.
 | 
						||
 | 
						||
%  ex(bool_f).
 | 
						||
%
 | 
						||
%   This fails since there is a non boolean value in a list.
 | 
						||
%
 | 
						||
%   On SWI this fails...
 | 
						||
%   On YAP this throuws exception....
 | 
						||
%
 | 
						||
ex(bool_f) :-
 | 
						||
     ( catch(b <- [true,false,true,true,other],_,fail) ->
 | 
						||
          fail
 | 
						||
          ;
 | 
						||
          true
 | 
						||
     ).
 | 
						||
 | 
						||
%  ex(bool_back).
 | 
						||
%
 | 
						||
%   Get some boolean values back from applying a vector element equality to an integer
 | 
						||
%   vector we just passed to R. Prints the R bools first for comparison.
 | 
						||
%
 | 
						||
ex(bool_back) :- 
 | 
						||
     t <- [1,2,3,4,5,1],
 | 
						||
     <- print(t),
 | 
						||
     s <- t==1,
 | 
						||
     <- print(s),
 | 
						||
     S <- s,
 | 
						||
     write( s(S) ), nl.
 | 
						||
 | 
						||
% ex(atom_char).
 | 
						||
%
 | 
						||
%  Pass some atoms to an R vector of characters.
 | 
						||
%
 | 
						||
ex(atom_char) :- 
 | 
						||
     f <- [a,b,c],
 | 
						||
     <- f,
 | 
						||
     F <- f,
 | 
						||
     write( f(F) ), nl.
 | 
						||
 | 
						||
% ex(matrix_int). 
 | 
						||
%
 | 
						||
%  Pass a 2-level list of lists of integers to an R matrix (and back again).
 | 
						||
%
 | 
						||
ex(matrix_int) :-
 | 
						||
     a <- [[1,2,3],[4,5,6]],
 | 
						||
     <- print(a),
 | 
						||
     A <- a,
 | 
						||
     nl, write( a(A) ), nl.
 | 
						||
 | 
						||
% ex(matrix_char). 
 | 
						||
%
 | 
						||
%  Pass a 2-level list of lists of characters to an R matrix (and back again).
 | 
						||
%
 | 
						||
ex(matrix_char) :-
 | 
						||
     a <- [[a,b,c],[d,e,f]],
 | 
						||
     <- print(a),
 | 
						||
     A <- a,
 | 
						||
     write( a(A) ), nl.
 | 
						||
 | 
						||
 | 
						||
 | 
						||
% ex(matrix_idx).
 | 
						||
%
 | 
						||
ex(matrix_idx) :-
 | 
						||
     a <- [[1,2,3],[4,5,6]],
 | 
						||
     <- a,
 | 
						||
	J <- a[1,_],
 | 
						||
	write( j(J) ), nl.
 | 
						||
 | 
						||
% ex(list).
 | 
						||
%
 | 
						||
%  A Prolog = pairlist to an R list. Shows 2 alternative ways to access the list items.
 | 
						||
% 
 | 
						||
ex(list) :-
 | 
						||
     a <- [x=1,y=0,z=3],
 | 
						||
     A <- a,
 | 
						||
     X0 <- a[1],
 | 
						||
     format( 'First pair of list: ~w~n', [X0] ),
 | 
						||
     X <- a[[1]],
 | 
						||
     format( 'First element of list: ~w~n', [X] ),
 | 
						||
     Y <- a$y,
 | 
						||
     format( 'Second element of list: ~w~n', [Y] ),
 | 
						||
     write( a(A) ), nl.
 | 
						||
 | 
						||
% ex(list).
 | 
						||
%
 | 
						||
%  R allows for unamed lists.
 | 
						||
% 
 | 
						||
ex(unamed) :-
 | 
						||
	 li <- list(),
 | 
						||
	 li[[1]] <- c(1,2,3),
 | 
						||
	  <- li,
 | 
						||
	  L <- li,
 | 
						||
	  write( l(L) ), nl.
 | 
						||
 | 
						||
% ex(list_ea).
 | 
						||
%
 | 
						||
% Produces error due to name of constructor: -.
 | 
						||
%
 | 
						||
ex(list_ea) :-  % produces error
 | 
						||
     catch_controlled( a <- [x=1,y=0,z-3] ),
 | 
						||
     <- a,
 | 
						||
     A <- a,
 | 
						||
     write( a(A) ), nl.
 | 
						||
 | 
						||
% ex(list_eb).
 | 
						||
%
 | 
						||
% Produces an error due to mismatch of arity of =.
 | 
						||
%
 | 
						||
ex(list_eb) :- 
 | 
						||
     catch_controlled( a <- [x=1,y=0,=(z,3,4)] ),
 | 
						||
     <- a,
 | 
						||
     A <- a,
 | 
						||
     write( a(A) ), nl.
 | 
						||
 | 
						||
% ex(char_list).
 | 
						||
%
 | 
						||
%  Pass a list which has a char value.
 | 
						||
%
 | 
						||
ex(char_list) :-
 | 
						||
     a <- [x=1,y=0,z="three"],
 | 
						||
     <- print(a),
 | 
						||
     A <- a,
 | 
						||
     memberchk( Z="three", A ),
 | 
						||
     write( z(Z):a(A) ), nl.
 | 
						||
 | 
						||
% ex(mix_list). 
 | 
						||
%
 | 
						||
%  An R-list of mixed types.
 | 
						||
%
 | 
						||
ex(mix_list) :-
 | 
						||
     a <- [x=1,y=[1,2,3],z=[[a,b,c],[d,e,f]],w=[true,false]],
 | 
						||
     A <- a, 
 | 
						||
     <- print(a),
 | 
						||
     write( a(A) ), nl.
 | 
						||
 | 
						||
% ex(list2).
 | 
						||
%
 | 
						||
%  Illustrates ways of accessing list elements.
 | 
						||
% 
 | 
						||
ex(list2) :-
 | 
						||
     l <- list(), 
 | 
						||
     l[["what"]] <- c(1,2,3),
 | 
						||
     l$who <- c(4,5,6),
 | 
						||
     <- print(l),
 | 
						||
     L <- l,
 | 
						||
     write( l(L) ), nl.
 | 
						||
 | 
						||
% ex(slot).
 | 
						||
%
 | 
						||
%  Creating formal objects and accessing their content.
 | 
						||
%
 | 
						||
ex(slot) :-
 | 
						||
     <- setClass("track", representation(x="numeric", y="numeric")),
 | 
						||
     myTrack <- new("track", x = -4:4, y = exp(-4:4)),
 | 
						||
      <- print( myTrack@x ),
 | 
						||
     % [1] -4 -3 -2 -1  0  1  2  3  4
 | 
						||
      Y <- myTrack@y, 
 | 
						||
      write( y(Y) ), nl,
 | 
						||
      <- setClass("nest", representation(z="numeric", t="track")),
 | 
						||
      myNest <- new("nest", z=c(1,2,3) ),
 | 
						||
      myNest@t <- myTrack,
 | 
						||
      myNest@t@x <- Y+1,  % good ex. for hidden vars.
 | 
						||
      <- print( myNest ),
 | 
						||
      % N <- myNest, % unsupported r-type
 | 
						||
      % X <- myNest@t@x,
 | 
						||
      <- print(myNest@t@x),
 | 
						||
      X <- myNest@t@x,
 | 
						||
      <- print( myNest@t@x ),
 | 
						||
      write( x(X) ), nl.
 | 
						||
 | 
						||
      % myTrack@x <- c(1,2,3).
 | 
						||
 | 
						||
% ex(add_element).
 | 
						||
%
 | 
						||
%   Adds a third element to a list after creation.
 | 
						||
%
 | 
						||
ex(add_element) :-
 | 
						||
     x <- [a=1,b=2],
 | 
						||
     x$c <- [3,4], 
 | 
						||
     <- print( x ),    % print   =   $a 3
 | 
						||
     X <- x,
 | 
						||
     write( x(X) ), nl.   % X = [a=3.0].
 | 
						||
 | 
						||
% ex(singletons).
 | 
						||
%
 | 
						||
%  Pass an integer and a singleton number list and get them back.
 | 
						||
% Although in R both are passed as vectors of length on, when back in Prolog
 | 
						||
% the singleton list constructors are stripped, returing a single integer value in both cases.
 | 
						||
%  
 | 
						||
ex(singletons) :- 
 | 
						||
     s <- 3,
 | 
						||
     <- print(s),
 | 
						||
     S <- s,
 | 
						||
     <- print( s ),
 | 
						||
     t <- [3],
 | 
						||
     <- print( t ),
 | 
						||
     T <- t,
 | 
						||
     write( s(S)-t(T) ), nl.
 | 
						||
 | 
						||
% ex(assign). 
 | 
						||
%
 | 
						||
% Simple assignment of an R function (+) application on 2 R values originated in Prolog.
 | 
						||
% 
 | 
						||
ex(assign) :- 
 | 
						||
     a <- 3,
 | 
						||
     <- print( a ),
 | 
						||
     b <- [2],
 | 
						||
     <- print( b ),
 | 
						||
     C <- a + b,
 | 
						||
     write( c(C) ), nl.
 | 
						||
 | 
						||
 | 
						||
% ex(assign_1).
 | 
						||
%
 | 
						||
%  Assign the result of an R operation on matrix and value to a Prolog variable.
 | 
						||
%
 | 
						||
ex(assign_1) :- 
 | 
						||
     a <- [[1,2,3],[4,5,6]], 
 | 
						||
     <- a,
 | 
						||
     B <- a*3, 
 | 
						||
     write( b(B) ), nl.
 | 
						||
 | 
						||
% ex(assign_2).
 | 
						||
%
 | 
						||
%  Assign the result of an R operation on matrices to a Prolog variable.
 | 
						||
%
 | 
						||
ex(assign_2) :- 
 | 
						||
     a <- [[1,2,3],[4,5,6]], 
 | 
						||
     <- print( a ),
 | 
						||
     b <- 3,
 | 
						||
     <- print( b ),
 | 
						||
     C <- a*b,
 | 
						||
     write( c(C) ), nl.
 | 
						||
 | 
						||
% ex(assign_r).
 | 
						||
%
 | 
						||
% Assign values to R variables and operate on them. 
 | 
						||
% Using c as an R variable is also a good test, as we test against c(...).
 | 
						||
%
 | 
						||
ex(assign_r) :- 
 | 
						||
     a <- [3],
 | 
						||
     <- print( a ),
 | 
						||
     b <- [2],
 | 
						||
     <- print( b ),
 | 
						||
     c <- a + b,
 | 
						||
     <- print( c ).
 | 
						||
 | 
						||
/*  disable for now. once Yap supports . in atoms
 | 
						||
    re-establish this, but make sure you restor
 | 
						||
    relevant flag back to its original setting. */
 | 
						||
 | 
						||
% ex(dot_in_function_names).
 | 
						||
%
 | 
						||
% Test dots in functions names via the .. mechanism.
 | 
						||
%
 | 
						||
ex(dot_in_function_names) :-
 | 
						||
     a <- [1.1,2,3],
 | 
						||
     <- print(a),
 | 
						||
     x <- as.integer(a),
 | 
						||
     <- print(x).
 | 
						||
 | 
						||
 | 
						||
/* as above */
 | 
						||
% ex(dot_in_rvars).
 | 
						||
%
 | 
						||
%  Test dots in R variable names via the .. mechanism. Generates an error on the last goal.
 | 
						||
%
 | 
						||
ex(dot_in_rvar) :-
 | 
						||
     a.b <- [1,2,3],
 | 
						||
     <- print( a.b ),
 | 
						||
     <- print( 'a.b' ),
 | 
						||
     catch_controlled( <- print('a..b') ).
 | 
						||
 | 
						||
 | 
						||
% ex(semi_column).
 | 
						||
%
 | 
						||
%  A:B in R generates a vector of all integers from A to B.
 | 
						||
%
 | 
						||
ex(semi_column) :-
 | 
						||
     z <- 1:50,
 | 
						||
     <- print( z ),
 | 
						||
     Z <- z, 
 | 
						||
     length( Z, Len ),
 | 
						||
     write( len(Len) ), nl.
 | 
						||
 | 
						||
% ex(c_vectors).
 | 
						||
%
 | 
						||
%  r.eal also supports c() R function concatenation.
 | 
						||
%
 | 
						||
ex(c_vectors) :-
 | 
						||
     a <- c(1,2,3,5),  % this goes via the fast route
 | 
						||
     <- print(a),
 | 
						||
     b <- c(1,1,2,2) + c(1:4),
 | 
						||
     <- print( b ),
 | 
						||
     C <- a+b,
 | 
						||
     write( 'C'(C) ), nl.
 | 
						||
 | 
						||
% ex(empty_args).
 | 
						||
%
 | 
						||
%  Test calling R functions that take no arguments (via foo()).
 | 
						||
%
 | 
						||
ex(empty_args) :-
 | 
						||
     <- plot( 1:10, 1:10 ),
 | 
						||
     findall( I, (between(1,6,I),write('.'), flush_output, sleep(1)), _ ),
 | 
						||
     nl,
 | 
						||
     <- dev.off().  % fixme use dev.off() when Yap starts supporting it.
 | 
						||
 | 
						||
% ex(string).
 | 
						||
%
 | 
						||
%  Test new (2013/11/22) string type in SWI Prolog v7.
 | 
						||
%
 | 
						||
ex(string) :-
 | 
						||
	( (current_predicate(string/1),string("abc")) ->
 | 
						||
     	<- plot( 1:10, 1:10, main="native string type has arrived to Prolog" ),
 | 
						||
     	findall( I, (between(1,6,I),write('.'), flush_output, sleep(1)), _ )
 | 
						||
		;
 | 
						||
		true
 | 
						||
	).
 | 
						||
 | 
						||
% ex(binary_op).
 | 
						||
%
 | 
						||
% Early versions of r..eal were not handling this example properly.  
 | 
						||
% Thanks to Michiel Hildebrand for spotting this.
 | 
						||
% The correct answer is =|[0.0,4.0]|=. First subtract v1 from v2 and then take power 2.
 | 
						||
%
 | 
						||
ex(binary_op) :-
 | 
						||
     v1 <- c(1,1),
 | 
						||
     <- print( v1 ),
 | 
						||
     v2 <- c(1,-1),
 | 
						||
     <- print( v2 ),
 | 
						||
     P <- (v1-v2)^2,
 | 
						||
     write( P ), nl.
 | 
						||
     % not !!! : P = [0.0, 0.0].
 | 
						||
 | 
						||
% ex(utf).
 | 
						||
%
 | 
						||
% Plots 3 points with the x-axis label showing some Greek letters (alpha/Omega).
 | 
						||
%
 | 
						||
ex(utf) :-
 | 
						||
	<- plot( c(1,2,3), c(3,2,1), xlab= "αω" ),
 | 
						||
	findall( I, (between(1,4,I),write('.'), flush_output, sleep(1)), _ ),
 | 
						||
	nl,
 | 
						||
	<- dev.off().
 | 
						||
 | 
						||
 | 
						||
% ex(utf_atom).
 | 
						||
%
 | 
						||
% Plots 3 points with the x-axis label showing some Greek letters (alpha/Omega) as atom preceded by +.
 | 
						||
%
 | 
						||
ex(utf_atom) :-
 | 
						||
	<- plot( c(1,2,3), c(3,2,1), xlab= "α/Ω" ),
 | 
						||
	findall( I, (between(1,4,I),write('.'), flush_output, sleep(1)), _ ),
 | 
						||
	nl,
 | 
						||
	<-dev.off().
 | 
						||
 | 
						||
% ex( utf_1 ).
 | 
						||
%
 | 
						||
%  Thanks to  Guillem R.
 | 
						||
%
 | 
						||
ex(utf_1) :-
 | 
						||
     s <- ['Pour ce garçon être sur une île, y avoir des histoires de cœur ambiguës et vider un fût de bière sur un canoë entouré par des caïmans, ne fut pas un mince affaire.'],
 | 
						||
     <- print( s ),
 | 
						||
     S <- s,
 | 
						||
     write( s(S) ), nl.
 | 
						||
 | 
						||
% ex( utf1 ).
 | 
						||
%
 | 
						||
%  Mostly Vitor's then Sander and last one from Nicos.
 | 
						||
%
 | 
						||
ex(utf_2) :-
 | 
						||
     x <- [hello, 'olá', 'जैसा कहर बरपा तो बर्बाद हो जाएगी मुंबई','Beëindigen','άμπελος'],
 | 
						||
     <- x,
 | 
						||
     X <- x,
 | 
						||
     write( x(X) ), nl.
 | 
						||
 | 
						||
 | 
						||
% ex(plot_cpu).
 | 
						||
%
 | 
						||
%  Create a plot of 4 time points. Each having a push and a pull time component.
 | 
						||
%  These are the time it takes to push a list through to R and the time to Pull the same
 | 
						||
%  (very long) list back.
 | 
						||
%
 | 
						||
ex(plot_cpu) :-
 | 
						||
     plot_cpu( 1000 ).
 | 
						||
 | 
						||
ex(debug) :-
 | 
						||
     real_debug,
 | 
						||
     write( started_debugging ), nl,
 | 
						||
     x <- c(1,2,3),  % c-vectors
 | 
						||
     y <- [1,2,3],   % PL data lists
 | 
						||
     X <- x,         % R var to PL var
 | 
						||
     x <- [a=[1,2,4],b=[4,5,6]],
 | 
						||
     A <- x,
 | 
						||
     B <- x$b,       % R expression to PL var
 | 
						||
     Y <- x$b + x$a,
 | 
						||
     x$c <- [6,3,7],
 | 
						||
     real_nodebug,
 | 
						||
     write( x(X) ), nl,
 | 
						||
     write( a(A) ), nl,
 | 
						||
     write( b(B) ), nl,
 | 
						||
     write( y(Y) ), nl,
 | 
						||
     write( stopped_debugging ), nl.
 | 
						||
 | 
						||
% ex(rtest).
 | 
						||
% Some tests from r_session, 
 | 
						||
%
 | 
						||
ex(rtest) :-
 | 
						||
     <- set.seed(1),  % fixme: dot
 | 
						||
	y <- rnorm(500),
 | 
						||
	<- print(y),
 | 
						||
	x <- rnorm(y),
 | 
						||
     <- print(x),
 | 
						||
%     <- x11(width=5,height=3.5),
 | 
						||
	<- plot(x,y),
 | 
						||
     r_wait,
 | 
						||
	<- dev.off(),
 | 
						||
	Y <- y,
 | 
						||
	write( y(Y) ), nl,
 | 
						||
	findall( Zx, between(1,9,Zx), Z ),
 | 
						||
	z <- Z,
 | 
						||
	<- print( z ),
 | 
						||
	cars <- [1, 3, 6, 4, 9],
 | 
						||
	% cars <- c(1, 3, 6, 4, 9),
 | 
						||
	<- print(cars),
 | 
						||
	<- pie(cars),
 | 
						||
	r_wait,
 | 
						||
	<- dev.off().
 | 
						||
 | 
						||
% list_times.
 | 
						||
%
 | 
						||
% Print some timing statistics for operations on a long list of integers.
 | 
						||
%
 | 
						||
list_times :-
 | 
						||
     findall( I, between(1,10000000,I), List ),
 | 
						||
     statistics( cputime, Cpu1 ), write( cpu_1(Cpu1) ), nl,
 | 
						||
     l <- List,
 | 
						||
     a <- median( l ),
 | 
						||
     statistics( cputime, Cpu2 ), write( cpu_2(Cpu2) ), nl,
 | 
						||
     b <- median( List ),
 | 
						||
     statistics( cputime, Cpu3 ), write( cpu_3(Cpu3) ), nl,
 | 
						||
     <- print(a),
 | 
						||
     <- print(b).
 | 
						||
 | 
						||
% adapted from YapR
 | 
						||
 | 
						||
% Intrinsic attributes: mode and length
 | 
						||
tut(tut1) :-
 | 
						||
	z <- 0:9,
 | 
						||
	<- print(z),
 | 
						||
	digits <- as.character(z), % fixme: dot
 | 
						||
	<- print(digits),
 | 
						||
	d <- as.integer(digits),  % fixme: dot
 | 
						||
	<- print(d).
 | 
						||
 | 
						||
% changing the length of an object
 | 
						||
tut(tut2) :-
 | 
						||
	e <- numeric(),
 | 
						||
	(e[3]) <- 17,
 | 
						||
	<- print(e),
 | 
						||
	alpha <- 1:10,
 | 
						||
	alpha <- alpha[2 * 1:5],
 | 
						||
     <- alpha,   % = 2, 4, 6, 8 10
 | 
						||
	length(alpha) <- 3,
 | 
						||
	<- print(alpha),   % = 2, 4, 6
 | 
						||
     nl, write( ' on beta now ' ), nl, nl,
 | 
						||
     beta <- 1:10,
 | 
						||
     beta <- 2 * beta,
 | 
						||
     <- print(beta),    % 2  4  6  8 10 12 14 16 18 2
 | 
						||
     length(beta) <- 3,
 | 
						||
     <- print(beta).    % 2 4 6
 | 
						||
 | 
						||
% Getting and setting attributes
 | 
						||
tut(tut3) :-
 | 
						||
	z <- 1:100,
 | 
						||
	attr(z, "dim") <- c(10,10),
 | 
						||
	<- print( z ).
 | 
						||
 | 
						||
% factors and tapply.
 | 
						||
tut(tut4) :-
 | 
						||
      /* state <- c("tas", "sa",  "qld", "nsw", "nsw", "nt",  "wa",  "wa",
 | 
						||
                  "qld", "vic", "nsw", "vic", "qld", "qld", "sa",  "tas",
 | 
						||
                  "sa",  "nt",  "wa",  "vic", "qld", "nsw", "nsw", "wa",
 | 
						||
                  "sa",  "act", "nsw", "vic", "vic", "act"), */
 | 
						||
     state <- [tas,sa,qld,nsw,nsw,nt,wa,wa,qld,vic,nsw,vic,qld,qld,sa,tas,sa,nt,wa,vic,qld,nsw,nsw,wa,sa,act,nsw,vic,vic,act],
 | 
						||
	<- print( state ),
 | 
						||
     % <- astate,
 | 
						||
	statef <- factor(state),
 | 
						||
	<- print( statef ),
 | 
						||
	<- levels(statef),
 | 
						||
	incomes <- c(60, 49, 40, 61, 64, 60, 59, 54, 62, 69, 70, 42, 56,
 | 
						||
                    61, 61, 61, 58, 51, 48, 65, 49, 49, 41, 48, 52, 46,
 | 
						||
                    59, 46, 58, 43),
 | 
						||
	incmeans <- tapply(incomes, statef, mean),
 | 
						||
	% notice the function definition.
 | 
						||
	stderr <- ( function(x) ->  sqrt(var(x)/length(x)) ),
 | 
						||
%	<- print( stderr ),
 | 
						||
	X <- stderr( [1,2,3,4,5,6,7,8,9,10] ),
 | 
						||
	writeln(stderr=X),
 | 
						||
	incster <- tapply(incomes, statef, stderr),
 | 
						||
	<- print( incster ).
 | 
						||
 | 
						||
tut(tut5) :-
 | 
						||
	z <- 1:1500,
 | 
						||
	dim(z) <- c(3,5,100),
 | 
						||
	a <- 1:24,
 | 
						||
	dim(a) <- c(3,4,2),
 | 
						||
	<- print(a[2,_,_]),
 | 
						||
	<- print(dim(a)),
 | 
						||
	x <- array(1:20, dim=c(4,5)),
 | 
						||
	<- print( x ),
 | 
						||
	i <- array(c(1:3,3:1), dim=c(3,2)),
 | 
						||
	<- print( i ),
 | 
						||
	x[i] <- 0,
 | 
						||
	<- print( x ),
 | 
						||
	h <- 1:10,
 | 
						||
	z <- array(h, dim=c(3,4,2)),
 | 
						||
	<- print( z ),
 | 
						||
	a <- array(0, dim=c(3,4,2)),
 | 
						||
	<- print( a ),
 | 
						||
	% ab <- z '%o%' a,
 | 
						||
	ab <- z+a, % z @^@ a,
 | 
						||
	<- ab,
 | 
						||
        f <- ( function(xx, yy) -> cos(yy)/(1 + xx^2) ),
 | 
						||
	w <- outer(z, a, f),
 | 
						||
	<- w.
 | 
						||
 | 
						||
tut(tut6) :-
 | 
						||
	d <- outer(0:9, 0:9),
 | 
						||
	fr <- table(outer(d, d, "-")),
 | 
						||
	<- plot(as.numeric(names(fr)), fr, type="h", xlab="Determinant", ylab="Frequency"), % fixme: dot
 | 
						||
     format( '~n   type :- "dev.off()." to close the plot display.~n', []).
 | 
						||
 | 
						||
tut(tut7) :-
 | 
						||
	m <- function(x) -> [ array(a), (a[x]<- x), while((x > 0), [x <-x-1, a[x] <- a[x+1]+x]), a[0] ],
 | 
						||
	m(100),
 | 
						||
	X <- a,
 | 
						||
	writeln(X).
 | 
						||
 | 
						||
% auxiliary,
 | 
						||
cpu_points( [], [], [] ).
 | 
						||
cpu_points( [H|T], [S|Ss], [L|Ls] ) :-
 | 
						||
     between_1_and(H,Long),
 | 
						||
     statistics( cputime, _) , 
 | 
						||
     length( Long, Lengtho ), write( leno(Lengtho) ), nl,
 | 
						||
     statistics( cputime, S0 ), 
 | 
						||
     ( number(S0) -> S0 = S ; S0 = [_,S] ),
 | 
						||
     % statistics( cputime, [_,S] ), 
 | 
						||
     long <- Long,
 | 
						||
     Back <- long,
 | 
						||
     Back = [Hb|_],
 | 
						||
     Hb =:= 1,
 | 
						||
     statistics( cputime, L0 ), 
 | 
						||
     ( number(L0) -> L0 = L ; L0 = [_,L] ),
 | 
						||
     % statistics( cputime, [_,L] ), 
 | 
						||
     length( Back, BackLen ),
 | 
						||
     write( back_len(BackLen) ), nl,
 | 
						||
     % L = 0,
 | 
						||
     cpu_points( T, Ss, Ls ) .
 | 
						||
 | 
						||
% auxiliaries,
 | 
						||
 | 
						||
catch_controlled( Expr ) :-
 | 
						||
     catch( Expr, Caught, true ),
 | 
						||
     ( \+ var(Caught) -> write( caught_controlled(Caught) ), nl; fail ).
 | 
						||
 | 
						||
between_1_and(N,X) :-
 | 
						||
     ( var(N) -> N is 100; true ),
 | 
						||
     IntN is integer(N),
 | 
						||
     findall( I, between(1,IntN,I), Is ),
 | 
						||
     i <- Is,
 | 
						||
     X <- i.
 | 
						||
cpu( R ) :-
 | 
						||
     ( var(R) -> R is 10000; true ),
 | 
						||
     findall( F, between_1_and(R,F), Fs ),
 | 
						||
     f <- Fs, 
 | 
						||
     statistics( cputime,  Cpu1 ),
 | 
						||
     write( cputime_to_push(Cpu1) ), nl,
 | 
						||
     X <- f,   % when   F <- f   the predicate fails midway for large Len !!!
 | 
						||
     statistics( cputime,  Cpu2 ),
 | 
						||
     write( cputime_to_pull(Cpu2) ), nl,
 | 
						||
     length( X, Len ),
 | 
						||
     write( len(Len) ), nl.
 | 
						||
plot_cpu( Factor ) :-
 | 
						||
     nl,
 | 
						||
     ( Factor > 10 ->
 | 
						||
         M='if your set-up fails on this test increase the size of stack.',
 | 
						||
         write( M ), nl, nl 
 | 
						||
          ;
 | 
						||
          true
 | 
						||
     ),
 | 
						||
     points <- [10,100,500,1000],
 | 
						||
     points <- as.integer( points * Factor ), % fixme: dot
 | 
						||
     <- points,
 | 
						||
     Points <- points,
 | 
						||
     write( points(Points) ), nl,
 | 
						||
     cpu_points( Points, Push, Pull ), 
 | 
						||
     push <- Push,
 | 
						||
     pull <- Pull,
 | 
						||
     write( plotting(Pull,Push) ), nl,
 | 
						||
     <- plot( points, pull, ylab = "pull & push (red) - in seconds" ),
 | 
						||
     <- points( points, push, col="red" ).
 |