lib Rcmd
SummaryPackage variablesSynopsisDescriptionGeneral documentationMethods
Summary
Rcmd - Perl interface for R language
Package variables
Privates (from "my" definitions)
@tmpdat = ()
$save = '--no-save'
$output = ''
Included modules
Carp qw ( croak )
File::Copy
Synopsis
  use Rcmd;

  $rcmd = new Rcmd;

  @result = $rcmd->exec("","");
Description
  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.
Methods
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
Methods description
None available.
Methods code
DESTROYdescriptionprevnextTop
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;
    }
}
arraydescriptionprevnextTop
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");
}
execdescriptionprevnextTop
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;
    }
}
newdescriptionprevnextTop
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 }
}
sarraydescriptionprevnextTop
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");
}
set_modedescriptionprevnextTop
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};
    }
}
General documentation
AUTHORTop
Kazuharu Arakawa, gaou@sfc.keio.ac.jp