Rcmd documentation.

  Name: $rcmd = new Rcmd()   -   create an instance of R language session

  This module is a simple interface to open-source R statistics language
  availabe under GPL at http://www.r-project.org/.

  Rcmd enables Perl manipulation of the R language by simply executing them
  through $rcmd->exec() function. Input is an array of R commands.

  ex:

  print $rcmd->exec(
                  "x = 5", 
                  "y = 4", 
                  "z = x * y", 
                  "z"
		   );

  Returned values are always an array. Therefore, in case the returned value
  is only one, the value is accessible as:

  @val = $rcmd->exec("y");

  print $val[0];

  All the values are saved in each session. Thus,

    $val1 = $rcmd->exec( "x = 5" , "x" );
    $val2 = $rcmd->exec( "x");

  will output "5" for both $val1 and $val2.

  Obviously, it is also possible to use perl variables, as:

    $i = 3;

    print $rcmd->exec("x = x * $i","x");

  The strength of R graphing abilities can be accessed as:

  @array = $rcmd->exec(
		       "postscript(\"/tmp/out.ps\")", 
		       "x = c(1:10)",
		       "y = c(3,6,3,5,8,0,1,9,2,6)",
		       "plot(x,y)",
		       "z = lsfit(x,y)",
		       "abline(z)",
		       "y"
		       );

  system("gs /tmp/out.ps");

  You can easily add Perl array data by $rcmd->array() for numerical data, or
  by $rcmd->sarray() for character data. For example:

    $rcmd->array("array1", 1, 2, 3, 4, 5);

  or

    $rcmd->sarray("array2", "a", "b", "c", "d", "e");

  Note: We recommend using R/S Perl (http://www.omegahat.org/RSPerl/) instead
  of this module in UNIX environment. Follow instructions of the above web site.

sub DESTROY {

    my $this = shift;
    if (length $output){
	copy($this->{cmd}, $output);
    }
    unlink $this->{cmd};
    unlink $this->{log};
    unlink $this->{tmpcmd};
    unlink $this->{tmplog};

    foreach my $file (@tmpdat){
	unlink $file;
    }

}

sub array {

    my $this = shift;
    my $val = shift;
    my @array = @_;

    my $uniq = rand(9999999999);
    open(OUT, ">/tmp/$uniq.dat") || die($!);
    print OUT join(",", @array);
    close(OUT);
    open(CMD, '>>' . $this->{cmd});
    print CMD "$val <- scan\(\"/tmp/$uniq.dat\", sep\=\",\"\)\n";
    close(CMD);
    push(@tmpdat, "/tmp/$uniq.dat");

}

sub exec {

    my $this = shift;
    my @tmp = @_;
    my $tmprequest = join("\n", @_, '');
    my $request = '';

    foreach my $line (split(/\n/, $tmprequest)){
	if (length $line > 1023){
	    $line =~ s/,/,\n/g;
	}
	$request .= $line . "\n";
    }
    my $data = '';

    open(CMD, '>>' . $this->{cmd});
    print CMD $request;
    close(CMD);

    system("/usr/bin/env R $save --slave < "
	   . $this->{cmd} . " >& " . $this->{log});

    open(DATA, $this->{log});
    while(<DATA>){
	if (/\[(\d+).*\] +(.*)/){
	    if ($1 > 1){
		$data .= ' ' . $2;
	    }else{
		$data = $2;
	    }
	}elsif(/Error/){
	    print STDERR $_;
	    while(<DATA>){
		print STDERR $_;
	    }
	    die("Error in R, exiting...\n");
	}elsif(/Warning/){
	    print STDERR $_;
	    while(<DATA>){
		print STDERR $_;
		last;
	    }
	    warn("Warning in R...\n");
	}
    }
    close(DATA);

    if (wantarray()){
	return split(/\s+/,$data);
    }else{
	return $data;
    }

}

sub new {

    my $this = shift;
    $save = shift; 
    $output = shift;
    my $uniq = rand(9999999999);
    my $cmd = "/tmp/$uniq.cmd";
    my $log = "/tmp/$uniq.log";

    my $tmpcmd = "/tmp/$uniq.tmpcmd";
    my $tmplog = "/tmp/$uniq.tmplog";

    my $rPath;
    eval {
	$rPath = `/usr/bin/which R`;
    };

    unless(length($rPath)){
	croak("R language not found in your system.");
	return;
    }

    bless { 
	cmd => $cmd, 
	log => $log,
	tmpcmd => $tmpcmd,
	tmplog => $tmplog,
	sessioncmd => $cmd,
	sessionlog => $log
    }

}

sub sarray {

    my $this = shift;
    my $val = shift;
    my @array = @_;

    my $uniq = rand(9999999999);
    open(OUT, ">/tmp/$uniq.dat") || die($!);
    print OUT join(" ", @array), "\n";
    close(OUT);

    open(CMD, '>>' . $this->{cmd});
    print CMD "$val <- scan\(\"/tmp/$uniq.dat\"\, character\(\)\)\n";
    close(CMD);
    push(@tmpdat, "/tmp/$uniq.dat");

}

sub set_mode {

    my $this = shift;
    my $option = shift;

    if($option eq 'tmp'){
	$this->{cmd} = $this->{tmpcmd};
	$this->{log} = $this->{tmplog};
    }else{
	unlink($this->{tmpcmd});
	unlink($this->{tmplog});
	$this->{cmd} = $this->{sessioncmd};
	$this->{log} = $this->{sessionlog};
    }

}

DESTROY	No description	Code
array	No description	Code
exec	No description	Code
new	No description	Code
sarray	No description	Code
set_mode	No description	Code