Mercurial > forge

changeset 45:163afdf50666 octave-forge

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
added makefile and tests added as_scalar method
author aadler
date Sun, 11 Nov 2001 03:00:54 +0000
parents 153fb900776a
children ee2e734de04e
files extra/perl/Makefile.PL extra/perl/NOINSTALL extra/perl/NOINTALL extra/perl/Octave.pm extra/perl/t/1_simple.t extra/perl/t/2_calling.t extra/perl/t/3_defines.t extra/perl/t/5_hilbert.t
diffstat 6 files changed, 199 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/perl/Makefile.PL	Sun Nov 11 03:00:54 2001 +0000
@@ -0,0 +1,51 @@
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+#
+#   Find the octave interpreter
+#
+
+$octave= "octave";
+$octave_validated= 0;
+while (not $octave_validated) {
+   $octave_validated= 1 if `$octave -v` =~ /Octave, version 2/;
+
+   if ($octave_validated) {
+      print "Found octave interpreter:[$octave]\n";
+      print "Enter new path or <RETURN> to accept: ";
+   } else {
+      print "Unable to find octave interpreter at:[$octave]\n";
+      print "Please enter new path: " ;
+
+   }
+   
+   chomp( $inp= <> );
+   if ($inp) {
+      $octave_validated= 0;
+      $octave= $inp;
+   }
+}
+
+#
+# Rewrite Octave.pm 
+#
+   print "\nFixing Octave.pm for octave path...\n" ;
+   open(OCTAVE, "<Octave.pm") or die "Can't open Octave.pm for reading" ;
+   my @lines = <OCTAVE> ;
+   close(OCTAVE) ;
+
+   open(OCTAVE, ">Octave.pm") or die "Can't open Octave.pm for writing" ;
+   foreach my $line (@lines) {
+      $line =~ s/(\$o->{ILSM}->{INTERP} = \")octave/$1$octave/;
+      print OCTAVE $line ;
+   }
+   close(OCTAVE) ;
+
+
+WriteMakefile(
+    'NAME'         => 'Inline::Octave',
+    'VERSION_FROM' => 'Octave.pm',
+    'PREREQ_PM'    => { Inline => 0.4 },
+    'clean'        => {FILES => '_Inline_test/'},  
+);
--- a/extra/perl/Octave.pm	Wed Nov 07 15:02:21 2001 +0000
+++ b/extra/perl/Octave.pm	Sun Nov 11 03:00:54 2001 +0000
@@ -7,7 +7,7 @@
 package Inline::Octave;
 
 
-$VERSION = '0.01';
+$VERSION = '0.10';
 require Inline;
 @ISA = qw(Inline);
 use Carp;
@@ -64,12 +64,18 @@
       if(/\bfunction\s+(.*?=\s*\w*|\w*)\b/) {
          my $pat =$1;
          my $fnam= $1 if $pat =~ /(\w*)$/;
+         #TODO make this better - ie loop
          my $nargout=0;
             $nargout= 1 if $pat =~ /^\w+\s*=/;
             $nargout= 1 if $pat =~ /^\[\s*\w+\s*\]\s*=/;
             $nargout= 2 if $pat =~ /^\[\s*\w+\s*,\s*\w+\s*]\s*=/;
             $nargout= 3 if $pat =~ /^\[\s*\w+\s*,\s*\w+\s*,\s*\w+\s*]\s*=/;
             $nargout= 4 if $pat =~ /^\[\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*]\s*=/;
+            $nargout= 5 if $pat =~ /^\[\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*]\s*=/;
+            $nargout= 6 if $pat =~ /^\[\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*]\s*=/;
+            $nargout= 7 if $pat =~ /^\[\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*]\s*=/;
+            $nargout= 8 if $pat =~ /^\[\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*]\s*=/;
+            $nargout= 9 if $pat =~ /^\[\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*,\s*\w+\s*]\s*=/;
          $nargouts{$fnam}=$nargout;
       }
       if (/^\s*##\s*Inline::Octave::(\w+)\s*\(nargout=(\d+)\)\s*=>\s*(\w*)/) {
@@ -152,13 +158,13 @@
    #output variables
    my \$outargs;
    my \@vout;
-   for (my \$i=0; \$i < \$nargout; \$i++) {
+   for (my \$i=0; \$i < $nargout; \$i++) {
       \$vout[\$i]= new Inline::Octave::Matrix( -101101.101101 ); #code
       \$outargs.= \$vout[\$i]->name.",";
    }
    chop(\$outargs); #remove last ,
    \$outargs= "[".\$outargs."]=";
-   \$outargs= "" if \$nargout==0;
+   \$outargs= "" if $nargout==0;
 
    my \$call= "\$outargs $oct_funname(\$inargs);";
 #  print "--\$call--\\n";
@@ -205,8 +211,9 @@
    return unless $Oin and $Oout;
 
    print $Oin "exit\n";
-   <$Oin>; #clean up input
-   close $Oin, $Oout;
+   #<$Oin>; #clean up input - is this required?
+   close $Oin;
+   close $Oout;
    $o->{ILSM}->{OCTIN} = "";
    $o->{ILSM}->{OCTOUT} = "";
 }   
@@ -306,7 +313,9 @@
    } else {
       croak "Can't construct Matrix from Perl var of type:".ref($m);
    }
-   croak "Matrix is not size ${cols}x${rows}" unless @vals== $rows*$cols;
+   croak "Matrix is not size ${cols}x${rows}" unless
+                (ref $m eq "Inline::Octave::Matrix")
+                || (@vals == $rows*$cols) ;
 
    # pack data into doubles and use fread to grab it from octave
    # since octave is column major and nested lists in perl are
@@ -364,6 +373,20 @@
    return \@m;
 }
 
+sub as_scalar
+{
+   my $self = shift;
+   my $varname= $self->name;
+   croak "Can't handle complex" if $self->{complex};
+   croak "requested as_scalar for non scalar value:".
+           $self->{cols}."x".$self->{rows}
+           unless $self->{cols} == 1 && $self->{rows} == 1;
+   my $code = "fwrite(stdout, $varname,'double');";
+   my $retval= $Inline::Octave::inline_object->interpret( $code );
+   my @list= unpack "d1", $retval;
+   return $list[0];
+}   
+
 sub DESTROY
 {
 #  print "DESTROYing $varname\n";
@@ -392,6 +415,12 @@
 
 __END__
 
+$Log$
+Revision 1.4  2001/11/11 03:00:54  aadler
+added makefile and tests
+added as_scalar method
+
+
 =head1 NAME
 
 Inline::Octave - Inline octave code into your perl
@@ -554,6 +583,10 @@
    $var= [ [1,2,3],[4,5,6],[7,8,9] ];
 
 
+4. $oct_var->as_scalar()
+
+Returns a perl scalar if $oct_var
+is a 1x1 matrix, dies with an error otherwise
 
 =head1 Using Inline::Octave::Matrix
 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/perl/t/1_simple.t	Sun Nov 11 03:00:54 2001 +0000
@@ -0,0 +1,10 @@
+use strict;
+use Test;
+ 
+BEGIN {
+           plan(tests => 1) ;
+}
+         
+use Inline Octave => q{ };
+
+ok(1);
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/perl/t/2_calling.t	Sun Nov 11 03:00:54 2001 +0000
@@ -0,0 +1,14 @@
+use strict;
+use Test;
+ 
+BEGIN {
+           plan(tests => 1) ;
+}
+         
+use Inline Octave => q{
+   function x=jnk1(u); x=u+1; endfunction
+};   
+
+my $v= jnk1(3)->disp();
+chomp ($v);
+ok( $v, "4" );
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/perl/t/3_defines.t	Sun Nov 11 03:00:54 2001 +0000
@@ -0,0 +1,36 @@
+use strict;
+use Test;
+BEGIN {
+           plan(tests => 2) ;
+}
+
+use Data::Dumper;
+$Data::Dumper::Terse= 1;
+$Data::Dumper::Indent= 0;
+sub structeq {
+   return (Dumper($_[0]) eq Dumper($_[1])) +0;
+}   
+         
+
+use Inline Octave => "DATA";
+
+my $c= new Inline::Octave::Matrix([ [1.5,2,3],[4.5,1,-1] ]);
+   
+my ($b, $t)= jnk2( $c, [4,4],[5,6] );
+
+ok ( structeq( [$t->as_list()], ["6"] ) );
+
+ok ( structeq( $b->as_matrix(),
+              [['46.5','47','48'],['49.5','46','44']]
+             ));
+
+
+
+__DATA__
+
+__Octave__
+   function [b,t]=jnk2(x,a,b);
+      b=x+1+a'*b;
+      t=6;
+   endfunction
+
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/extra/perl/t/5_hilbert.t	Sun Nov 11 03:00:54 2001 +0000
@@ -0,0 +1,49 @@
+use strict;
+use Test;
+BEGIN {
+           plan(tests => 2) ;
+}
+
+use Data::Dumper;
+$Data::Dumper::Terse= 1;
+$Data::Dumper::Indent= 0;
+sub structeq {
+   return (Dumper($_[0]) eq Dumper($_[1])) +0;
+}   
+         
+
+use Inline Octave => "DATA";
+
+my $h= hilb(5);
+my $i= inv($h);
+my $ih= invhilb(5);
+my $d= mse( $i, $ih);
+
+ok ( $d->as_scalar() < .00001 );
+
+my $m1= $i ->as_matrix();
+my $m2= $ih->as_matrix();
+
+my $sum=0;
+for (my $i1= 0; $i1<5; $i1++ ) {
+   for (my $i2= 0; $i2<5; $i2++ ) {
+      $sum+= ( $m1->[$i1]->[$i2] -
+               $m2->[$i1]->[$i2] ) ** 2;
+   }
+}   
+      
+
+ok ( sqrt($sum) < .00001 );
+
+
+
+__DATA__
+
+__Octave__
+## Inline::Octave::hilb    (nargout=1)  => hilb
+## Inline::Octave::invhilb (nargout=1)  => invhilb
+## Inline::Octave::inv     (nargout=1)  => inv
+function d=mse (a,b)
+   d= sqrt( sumsq( a(:)-b(:) ) );
+endfunction   
+