Changeset 7341

Timestamp:

03/01/08 21:28:42 (5 years ago)

Author:

daisuke

Message:

- Restructure modules, internal structure
- Remove singleton-ness
- Add buncha docs

Location:

lang/perl/R-Writer/trunk

Files:

• Changes (modified) (1 diff)
• lib/R/Writer.pm (modified) (13 diffs)
• lib/R/Writer/Call.pm (modified) (3 diffs)
• lib/R/Writer/Encoder.pm (modified) (2 diffs)
• lib/R/Writer/Range.pm (modified) (2 diffs)
• lib/R/Writer/Util.pm (deleted)
• lib/R/Writer/Var.pm (modified) (4 diffs)
• t/02_simple.t (modified) (2 diffs)
• t/03_assign.t (modified) (1 diff)
• t/04_function.t (added)
• t/05_reset.t (added)
• t/06_save.t (added)
• t/99_pod-coverage.t (added)
• t/99_pod.t (added)

lang/perl/R-Writer/trunk/Changes

@@ -2 +2 @@
 =======
 
+0.00001 Mar 01 2008
+  - Restructure modules, internal structure
+  - Remove singleton-ness
+  - Add buncha docs
+
 0.00001_01  Feb 26 2008
   - Initial release.

lang/perl/R-Writer/trunk/lib/R/Writer.pm

@@ -4 +4 @@
 use strict;
 use warnings;
+use 5.008;
 use base qw(Class::Accessor::Fast);
 use R::Writer::Call;
@@ -9 +10 @@
 use R::Writer::Range;
 use R::Writer::Var;
-use R::Writer::Util;
-
-__PACKAGE__->mk_accessors($_) for qw(encoder);
+
+__PACKAGE__->mk_accessors($_) for qw(encoder statements);
 
 our $VERSION = '0.00001';
@@ -18 +18 @@
 };
 
-my $base;
-
-sub append {
-    my $self = shift;
-    push @{ $self->{statements} }, { code => shift };
-    return $self;
-}
-
-sub R
-{
-    my $R = R::Writer::Util::__R();
-    my ($obj) = @_;
-
-    if (defined $R) {
-        $R->{object} = $obj if defined $obj;
-        return $R;
-    }
-
-    $base = R::Writer->new(@_) unless defined $base;
-    $base->{object} = $obj if defined $obj;
-    return $base;
-}
+sub R { return __PACKAGE__->new(@_) }
 
 sub new
@@ -53 +32 @@
 }
 
+sub __push_statement { push @{ $_[0]->statements }, $_[1]; }
+
+# Call is a statement to call functions
 sub call
 {
     my ($self, $function, @args) = @_;
+
+    # If this is the end of the call chain, then push the
+    # statement. Otherwise, return it
+    my $end_of_call_chain = ! defined wantarray;
     my $call = R::Writer::Call->new(
         call => $function,
         args => [@args],
-        end_of_call_chain => ! defined wantarray
+        end_of_call_chain => $end_of_call_chain,
     );
-    push @{$self->{statements}}, $call;
-    return $self;
-}
-
-# XXX - This looks fishy
+
+    if ($end_of_call_chain) {
+        $self->__push_statement( $call );
+    }
+    return $call;
+}
+
+BEGIN
+{
+    foreach my $method qw(c expression) {
+        eval sprintf(<<'        EOSUB', $method, $method);
+            sub %s {
+                my $self = shift;
+                return R::Writer::Call->new(
+                    call => '%s',
+                    args => [ @_ ],
+                );
+            }
+        EOSUB
+        die if $@;
+    }
+}
+
+sub var
+{
+    my ($self, $var, $value) = @_;
+
+    my $obj = R::Writer::Var->new($var, $value, $self);
+    $self->__push_statement($obj);
+    return $obj;
+}
+
 sub range
 {
     my ($self, $start, $end) = @_;
     my $obj = R::Writer::Range->new($start, $end);
-#    $self->append($obj->as_string, delimiter => "");
     $obj;
 }
 
-sub expression
-{
-    my ($self, $expr) = @_;
-    return R::Writer::Call->new(
-        call => 'expression',
-        args => [ $expr ],
-        end_of_call_chain => 1,
-    );
-}
-*expr = \&expression;
-
+# Turn myself into a string
 sub as_string
 {
@@ -91 +93 @@
 
     for my $s (@{$self->{statements}}) {
-        if (eval { $s->isa('R::Writer::Call') }) {
+        my $delimiter = defined $s->{delimiter}  ? $s->{delimiter} : ";";
+        if (my $c = $s->{code}) {
+            $ret .= $c;
+        }
+        else {
             $ret .= $s->as_string($self);
         }
-        elsif (my $c = $s->{code}) {
-            my $delimiter = defined $s->{delimiter}  ? $s->{delimiter} : ";";
-            $c .= $delimiter unless $c =~ /$delimiter\s*$/s;
-            $ret .= $c ."\n";
-        }
+        $ret .= $delimiter unless $ret =~ /$delimiter\s*$/s;
+        $ret .= "\n";
     }
     return $ret;
 }
 
-sub obj_as_string
+# Turn arbitrary objects to string
+sub __obj_as_string
 {
     my ($self, $obj) = @_;
@@ -110 +114 @@
 
     if ($ref eq 'CODE') {
-        return $self->obj_as_string($obj->());
+        return $self->__obj_as_string($obj->());
     }
     elsif ($ref =~ /^R::Writer/) {
@@ -120 +124 @@
     elsif ($ref eq 'ARRAY') {
         my @ret = map {
-            $self->obj_as_string($_)
+            $self->__obj_as_string($_)
         } @$obj;
 
@@ -128 +132 @@
         my %ret;
         while (my ($k, $v) = each %$obj) {
-            $ret{$k} = $self->obj_as_string($v)
+            $ret{$k} = $self->__obj_as_string($v)
         }
         return "{" . join (",", map { $self->encoder->encode($_) . ":" . $ret{$_} } keys %ret) . "}";
@@ -137 +141 @@
 }
 
-sub var
-{
-    my ($self, $var, $value) = @_;
-
-    my $obj = R::Writer::Var->new($var, $value, $self);
-    $self->append($obj->as_string($self));
-    return $self;
-}
-
 sub save
 {
     my ($self, $file) = @_;
 
-    open(my $fh, '>', $file) or die "Failed to open $file for writing: $!";
-    print $fh, $self->as_string;
-    close($fh);
-}
+    my $fh;
+    my $close = 1;
+    my $ref = ref $file;
+
+    if ($ref && ( $ref eq 'GLOB' || eval { $file->can('print') } )) {
+        $close = 0;
+        $fh = $file;
+    } else {
+        open($fh, '>', $file) or die "Failed to open $file for writing: $!";
+    }
+    print $fh $self->as_string;
+    close($fh) if $close;
+}
+
+sub reset { shift->statements([]) }
 
 1;
@@ -172 +178 @@
     # cat(y);
 
-    my $R = R();
-    $R->var(x => 1)
-      ->var(y => 'x + 1')
-      ->call(cat => \'y')
-    ;
+    my $R = R::Writer->new();
+    $R->var(x => 1);
+    $R->var(y => 'x + 1');
+    $R->call('cat' => $R->expr('a * x ^ 2 + 1') );
 
     print $R->as_string;
@@ -197 +202 @@
 Tool from within Perl.
 
-Implementation details heavily borrow from JavaScript::Writer. Without it,
-this module wouldn't have been possible (I'm not insan... smart enough to
-fiddle with DB package on my own. gugod++)
+It is intended to be a builder tool -- for example, you have a lot of data
+in your database, and you want to feed it to R -- and not necessarily a
+"sexy" interface to build R scripts like JavaScript::Writer.
+
+Each call constitutes a statement. Unlike JavaScript::Writer (from which this
+module was originally based off), you should not be using call chaining to 
+chain statement calls.
+
+=head1 EXAAMPLE
+
+=head2 DECLARING A VARIABLE
+
+If you simply want to declare a variable and set the value to a particular
+value, you can use the var() method:
+
+  my $value = 1;
+  $R->var(x => $value);
+
+This will yield to 'x <- 1;'.
+
+If you want to assign result of an arithmetic expression, you need to specify
+the actual string:
+
+  $R->var( y => 'x + 1' );
+
+This will yield to 'y <- x+ 1;'
+
+You can assign the result of a function call this way:
+
+  $R->var( y => $R->call('func', 100, 100) );
+
+Which will yield to 'y <- func(100, 100);'
+
+=head2 CALLING ARBITRARY FUNCTIONS
+
+To call functions, you can use the call() method:
+
+  $R->call( demo => 'plotmath' );
+
+Which will yield to 'demo("plotmath");'.
+
+You can of course use call() to feed the result of a function call to a
+function call to a... You get the idea:
+
+  $R->call( func1 => $R->call( func2 => $R->call( func3 => 3 ) ) );
+
+Which will yield to 'func1(func2(func3(3)));'
+
+The call() method can cover most function use cases, including oft-used
+functions such as c() and expr(). For convenience, the following methods
+are provided as shortcust to equivalent call() invocations:
+
+=head3 expression 
+
+=head3 c
+
+=head2 SPECIFYING A RANGE
+
+R allows you to specify a number range. This is achieved via range() function:
+
+  $R->var(x => $R->c( $R->range(0, 9) ));
+
+Which will yield to 'x <- c(0:9);'
 
 =head1 METHODS
 
-=head2 expression | expr
-
-The expression() method creates an mathematical expression, which can be
-assigned to a variable. Expressions that are not assigned to a variable is
-pretty useless, so when using expression(), you need to pass the result
-to some other method that can accept it:
-
-  $R->var(y => $R->expression('a * x ^ 2 + b * x + 1'));
-
-The above yields
-
-  y <- expression("a * x ^ 2 + b * x + 1");
+=head2 new()
+
+Creates a new instance of R::Writer
+
+=head2 R()
+
+Shortcut for the constructor call.
+
+  use R::Writer qw(R);
+  my $R = R();
+
+=head2 call($funcname [, $arg1, $arg2, ...])
+
+Calls a function with specified arguments
+
+=head2 var($name [, $value])
+
+Declares a variable.
+
+=head2 range($start, $end)
+
+Creates a range of values
+
+=head2 reset()
+
+Resets the accumulated R code, and resets R::Writer state.
+
+=head2 as_string()
+
+Returns the string representation of accumulated R statements in the given
+R::Writer instance. 
+
+=head2 save($filename | $fh)
+
+Saves the result of calling as_string() to the specified filename, or a 
+handle.
 
 =head1 TODO
@@ -220 +309 @@
 =over 4
 
+=item Missing Features
+
+Need way to declare functions, execute loops.
+Probably need way to handle datasets.
+
 =item Remove JavaScript-ness
 
 JSON and what not are probably not needed.
 
-=item Add Proper Documentation
-
 =item Document Way To Feed The Script To "R"
 
@@ -234 +326 @@
 Copyright (c) 2008 Daisuke Maki C<< <daisuke@endeworks.jp> >>
 
-Much of the code is gratuitously taken from JavaScript::Writer,
+A lot of the concepts and some code is based on JavaScript::Writer,
 which is by Kang-min Liu C<< <gugod@gugod.org> >>
 

lang/perl/R-Writer/trunk/lib/R/Writer/Call.pm

@@ +1 @@
+# $Id$
+#
+# Copyright (c) 2008 Daisuke Maki <daisuke@endeworks.jp>
+# all rights reserved.
+
 package R::Writer::Call;
 use strict;
@@ -19 +24 @@
 
     my $f = $self->call;
-    my $delimiter =
-        defined($self->delimiter) ? $self->delimiter : 
-        $self->end_of_call_chain  ? ";" :
-        "."
-    ;
     my $args = $self->args;
     return ($self->{object} ?  "$self->{object}." : "" ) .
@@ -29 +29 @@
             join(",",
                  map {
-                     $c->obj_as_string( $_ );
+                     $c->__obj_as_string( $_ );
                  } @$args
-             ) . ")" . $delimiter 
+             ) . ")"
     ;
 }
-
 
 1;
 
 __END__
+
+=head1 NAME
+
+R::Writer::Call - Function Calls
+
+=head1 SYNOPSIS
+
+  use R::Writer::Call;
+  # Internal use only
+
+=head1 METHODS
+
+=head2 new
+
+=head2 as_string
+
+=cut

lang/perl/R-Writer/trunk/lib/R/Writer/Encoder.pm

@@ -1 +1 @@
 # $Id$
+#
+# Copyright (c) 2008 Daisuke Maki <daisuke@endeworks.jp>
+# All rights reserved.
 
 package R::Writer::Encoder;
@@ -12 +15 @@
 
 1;
+
+__END__
+
+=head1 NAME
+
+R::Writer::Encoder - Default Encoder
+
+=head1 SYNOPSIS
+
+  use R::Writer::Encoder;
+  # Internal use only
+
+=head1 METHODS
+
+=head2 new
+
+=head2 encode
+
+=cut

lang/perl/R-Writer/trunk/lib/R/Writer/Range.pm

@@ -1 +1 @@
 # $Id$
+#
+# Copyright (c) 2008 DAisuke Maki <daisuke@endeworks.jp>
+# All rights reserved.
 
 package R::Writer::Range;
@@ -17 +20 @@
 
 1;
+
+__END__
+
+=head1 NAME
+
+R::Writer::Range - Range Of Values
+
+=head1 SYNOPSIS
+
+  use R::Writer::Range;
+  # Internal use only
+
+=head1 METHODS
+
+=head2 new
+
+=head2 as_string
+
+=cut

lang/perl/R-Writer/trunk/lib/R/Writer/Var.pm

@@ -1 +1 @@
 # $Id$
+# 
+# Copyright (c) 2008 Daisuke Maki <daisuke2endeworks.jp>
+# All rights reserved.
 
 package R::Writer::Var;
@@ -35 +38 @@
     }
     elsif ($ref eq 'CODE') {
-        $s = "$var <- " . $c->obj_as_string($value->());
+        $s = "$var <- " . $c->__obj_as_string($value->());
     }
     elsif ($ref =~ /^R::Writer/) {
@@ -47 +50 @@
     elsif ($ref eq 'SCALAR') {
         if (defined $$value) {
-            my $v = $self->obj_as_string($value);
+            my $v = $self->__obj_as_string($value);
 
             $s = "var $var = $v;";
@@ -70 +73 @@
 
 1;
+
+__END__
+
+=head1 NAME
+
+R::Writer::Var - Variables
+
+=head1 SYNOPSIS
+
+  use R::Writer::Var;
+  # Internal use only
+
+=head1 METHODS
+
+=head2 new
+
+=head2 as_string
+
+=cut

lang/perl/R-Writer/trunk/t/02_simple.t

@@ -35 +35 @@
     my $y = $R->var(y => 11);
     $R->call(c => \("x", "y"));
-    is($R->as_string, qq/x <- 11;\ny <- 11;\nc(x,y);/);
+    is($R->as_string, qq/x <- 11;\ny <- 11;\nc(x,y);\n/);
 }
 
@@ -44 +44 @@
 
     my $R = R::Writer->new;
-    $R->var(x => 1)
-         ->var(y => 'x + 1')
-         ->call(cat => \'y')
-    ;
-    is( $R->as_string, qq/x <- 1;\ny <- x + 1;\ncat(y);/);
+    $R->var(x => 1);
+    $R->var(y => 'x + 1');
+    $R->call(cat => \'y');
+    is( $R->as_string, qq/x <- 1;\ny <- x + 1;\ncat(y);\n/);
 }

lang/perl/R-Writer/trunk/t/03_assign.t

@@ -7 +7 @@
 }
 
-my $R = R::Writer->new();
-$R->var(y => $R->expression('a * x ^ 2'));
-is( $R->as_string(), qq|y <- expression("a * x ^ 2");\n|);
+{
+    my $R = R::Writer->new();
+    $R->var(y => $R->expression('a * x ^ 2'));
+    is( $R->as_string(), qq|y <- expression("a * x ^ 2");\n|);
+}