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 array {

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

    my $fh = File::Temp->new(SUFFIX=>'.dat');
    print $fh join(",", @array);

    open(my $fh2, '>>' . $this->{cmd});
    print $fh2 "$val <- scan\(\"" . $fh->filename . "\", sep\=\",\"\)\n";
    close($fh2);
    push(@{$this->{tmpdat}}, $fh);

}

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(my $fh, '>>' . $this->{cmd});
    print $fh $request;
    close($fh);

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

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

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

}

sub new {

    my $pkg = shift;
    my $save = shift || '--no-save'; 
    my $output = shift;

    my $uniq = time() . rand(1000);
    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;
    }

    my $this = {};

    $this->{cmd}        = $cmd; 
    $this->{log}        = $log;
    $this->{tmpcmd}     = $tmpcmd;
    $this->{tmplog}     = $tmplog;
    $this->{sessioncmd} = $cmd;
    $this->{sessionlog} = $log;
    $this->{output}     = $output;
    $this->{save}       = $save;
    $this->{tmpdat}     =[];

    return bless $this;

}

sub sarray {

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

    my $fh = File::Temp->new(SUFFIX=>'.dat');
    print $fh join(" ", @array), "\n";

    open(my $fh2, '>>' . $this->{cmd});
    print $fh2 "$val <- scan\(\"" . $fh->filename . "\"\, character\(\)\)\n";
    close($fh2);
    push(@{$this->{tmpdat}}, $fh);

}

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