Return to lonplottest.pl CVS log

Up to [LON-CAPA] / loncom / test

Routine to create input files to stress-test lonplot.pm.  Does not
currently test <curve>,<data>, and <function> tags.  Each test should
produce a correct graph, a warning and a correct graph, or a broken
image.  My goal is to avoid hanging the web server.

#!/usr/bin/perl -w
# The LearningOnline Network with CAPA
# Dynamic plot testing routines
#
# $Id: lonplottest.pl,v 1.1 2002/01/04 19:05:34 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
# 12/30 Matthew
use strict;

##
## The goal here is to be able to take the metadata from lonplot.pm 
## verbatim, and add to it.
##

###################################################################
##                                                               ##
##        Tests used in checking the validitity of input         ##
##                                                               ##
###################################################################
my $int_test       = sub {$_[0]=~s/\s+//g;$_[0]=~/^\d+$/};
my $real_test      = 
    sub {$_[0]=~s/\s+//g;$_[0]=~/^[+-]?\d*\.?\d*([eE][+-]\d+)?$/};
my $color_test     = sub {$_[0]=~s/\s+//g;$_[0]=~/^x[\da-f]{6}$/};
my $onoff_test     = sub {$_[0]=~/^(on|off)$/};
my $key_pos_test   = sub {$_[0]=~/^(top|bottom|right|left|outside|below| )+$/};
my $sml_test       = sub {$_[0]=~/^(small|medium|large)$/};
my $linestyle_test = sub {$_[0]=~/^(lines|linespoints|dots|points|steps)$/};
my $words_test     = sub {$_[0]=~s/\s+/ /g;$_[0]=~/^([\w\(\)]+ ?)+$/};

###################################################################
##                                                               ##
##                      Attribute metadata                       ##
##                                                               ##
###################################################################

my %plot_defaults = 
    (
     height       => {
         default     => 200,
         test        => $int_test,
         description => 'vertical size of image (pixels)',
         edit_type   => 'entry' 
         },
     width        => {
         default     => 200,
         test        => $int_test,
         description => 'horizontal size of image (pixels)',
         edit_type   => 'entry'
         },
     bgcolor      => {
         default     => 'xffffff',
         test        => $color_test, 
         description => 'background color of image (xffffff)',
         edit_type   => 'entry'
         },
     fgcolor      => {
         default     => 'x000000',
         test        => $color_test,
         description => 'foreground color of image (x000000)',
         edit_type   => 'entry' 
         },
     transparent  => {
         default     => 'off',
         test        => $onoff_test, 
         description => '',
         edit_type   => 'on_off'
         },
     grid         => {
         default     => 'off',
         test        => $onoff_test, 
         description => '',
         edit_type   => 'on_off'
         },
     border       => {
         default     => 'on',
         test        => $onoff_test, 
         description => '',
         edit_type   => 'on_off'
         },
     font         => {
         default     => 'medium',
         test        => $sml_test,
         description => 'Size of font to use',
         edit_type   => 'choice',
         choices     => ['small','medium','large']
         },
     align        => {
         default     => 'left',
         test        => sub {$_[0]=~/^(left|right|center)$/},
         description => 'alignment for image in html',
         edit_type   => 'choice',
         choices     => ['left','right','center']
         } 
     );
my %key_defaults = 
    (
     title => { 
         default => '',
         test => $words_test,
         description => 'Title of key',
         edit_type   => 'entry'
         },
     box   => { 
         default => 'off',
         test => $onoff_test,
         description => 'Draw a box around the key?',
         edit_type   => 'on_off'
         },
     pos   => { 
         default => 'top right', 
         test => $key_pos_test, 
         description => 'position of the key on the plot',
         edit_type   => 'choice',
         choices     => ['top left','top right','bottom left','bottom right',
                         'outside','below']
         }
     );
my %label_defaults = 
    (
     xpos    => {
         default => 0,
         test => $real_test,
         description => 'x position of label (graph coordinates)',
         edit_type   => 'entry'
         },
     ypos    => {
         default => 0, 
         test => $real_test,
         description => 'y position of label (graph coordinates)',
         edit_type   => 'entry'
         },
     justify => {
         default => 'left',    
         test => sub {$_[0]=~/^(left|right|center)$/},
         description => 'justification of the label text on the plot',
         edit_type   => 'choice',
         choices     => ['left','right','center']
     }
     );
my %axis_defaults = 
    (
     color     => {
         default => 'x000000', 
         test => $color_test,
         description => 'color of axes (x000000)',
         edit_type   => 'entry'
         },
     xmin      => {
         default => '-10.0',
         test => $real_test,
         description => 'minimum x-value shown in plot',
         edit_type   => 'entry'
         },
     xmax      => {
         default => ' 10.0',
         test => $real_test,
         description => 'maximum x-value shown in plot',         
         edit_type   => 'entry'
         },
     ymin      => {
         default => '-10.0',
         test => $real_test,
         description => 'minimum y-value shown in plot',         
         edit_type   => 'entry'
         },
     ymax      => {
         default => ' 10.0',
         test => $real_test,
         description => 'maximum y-value shown in plot',         
         edit_type   => 'entry'
	 }
     );
my %curve_defaults = 
    (
     color     => {
         default => 'x000000',
         test => $color_test,
         description => 'color of curve (x000000)',
         edit_type   => 'entry'
         },
     name      => {
         default => '',
         test => $words_test,
         description => 'name of curve to appear in key',
         edit_type   => 'entry'
         },
     linestyle => {
         default => 'lines',
         test => $linestyle_test,
         description => 'Style of the axis lines',
         edit_type   => 'choice',
         choices     => ['lines','linespoints','dots','points','steps']
         }
     );

##############################################################
##                                                          ##
##   Values to use in the tests                             ##
##                                                          ##
##############################################################

my $long_text = 'Reader review of Bil Keane\'s "Daddy\'s Cap Is On Backwards":  Although he will probably forever be denied the Nobel Prize because of the radio broadcasts he made during the late war on behalf of the government in Rome, Bil Keane is certainly one writer who has nothing to prove. Having already taken his place among the company of Homer, Dante, Shakespeare, and Dostoyevsky, with the publication of "Daddy\'s Cap Is On Backwards" Bil Keane now emerges as the master of them all. The storyline is deceptively simple: after Thel dies in a freak accident, Daddy abandons PJ, Jeffie, and Little Billy to take Dolly on a meandering automobile tour across America -- culminating in the loss of Dolly, and the emergence, too late, of Daddy\'s ability to love. But God, as Keane has long demonstrated in his other works, is in the details, and in the intricate and masterfully coordinated layer upon layer of innuendo and hidden meanings. The title itself, on its face, refers only to Dolly\'s innocent, even endearing, observation that her father, unlike all the other men in her neighborhood, lacks a prepuce. But the true significance of Daddy\'s "cap" is slowly revealed, chapter by chapter, and even at the end of the book one is left wondering whether other layers of meaning remain, beyond the reader\'s grasp. The turning point of the narrative is the episode where Jeffy sells his soul to Mephistopheles for power and knowledge, yet this can be fully understood only in contrast to the many events that procede and follow it -- such as the haunting scene where little Billy carries his father out of the burning city on his shoulders, or the passage where PJ, now the viceroy of Egypt, reveals himself to his brothers as the boy whom they sold into servitude years before. Nothing can compare, however, to the episode where Jeffy hurls his harpoon at the great white whale, it fails to meet its mark, and is reclaimed by the Rhine-maidens as it descends into the waters, while flames from the untended hilltop fire engulf the island paradise, tossing a firebrand onto the raft where little Billy and the runaway slave are [remainder of review missing]';

my @color_test = ('x','xa','xaaaa','xaaaaaa','yaaaa','xabcdef',undef,'',
		  'xdeadbeef','xgggggg','\nset output /etc/passwdfile');

my @on_off_test = ('on','off','1','0','no','yes',undef,'',
		   '\nset output /etc/passwdfile');

my %plot_values = 
    (
     height       => ['300','10','-10','0'],
     width        => ['200','100000','-10','0'],
     bgcolor      => ['xffffff',@color_test],
     fgcolor      => ['x000000',@color_test],
     transparent  => ['off',@on_off_test],
     grid         => [@on_off_test],
     border       => [@on_off_test],
     font         => ['small','medium','large','huge','\nset output \/etc\/passwdfile'],
     align        => ['left','right','center','wobble','watson-crick']
     );

my %key_values = 
    (
     title => ['key title','',undef,'\n set output /etc/passwdfile\n'],
     box   => [@on_off_test],
     pos   => ['top left','top right','bottom left','bottom right','outside','below','below outside top left','suprise me']
     );

my %label_values = 
    (
     xpos    => ['1.3',undef,'-1000000.0','no','\nset output /etc/passwdfile'],
     ypos    => ['2.7',undef,'3.141592','no','\nset output /etc/passwdfile'],
     justify => ['center','left','right','no','yes','3.5','\nset output /etc/passwdfile'],
     text    => ['label text','\nset output /etc/passwdfile',undef,$long_text]
     );

my %axis_values = 
    (
     color => ['x000000',@color_test],
     xmin  => ['-5.0','6.0','inf',''],
     xmax  => [' 5.0','-6.0','inf',''],
     ymin  => ['-4.0','6.0','inf',''],
     ymax  => [' 4.0','-6.0','inf',''],
     );

my %curve_values = 
    (
     color     => ['xff0000',@color_test],
     name      => ['curve1'],
     linestyle => ['linespoints']
     );

my @function_values = ('sin(x)','f(x)=cos(x)','e^x','ln(t)','\nset output /etc/passwdfile\n','x^x');

my @data_values = 
    ( 
      [
        [ -3.0,-2.0,-1.0, 0.0, 1.0, 2.0, 3.0 ],
        [ -3.0, 2.0,-1.0, 3.3, 1.0, 2.0,-3.0 ] 
      ]
    );

my @title_values  = ('title 1','\nset output /etc/passwdfile',undef, 
		     $long_text);

my @xlabel_values = ('xlabel 1','\nset output /etc/passwdfile',undef, 
		     $long_text);

my @ylabel_values = ('ylabel 1','\nset output /etc/passwdfile',undef, 
		     $long_text);

##############################################################
##                                                          ##
##  Put it all together                                     ##
##                                                          ##
##############################################################

# run through plot variations
if ( (! -e 'plottest') && (! -d 'plottest')) {
    system 'mkdir plottest';
}

&write_tests(\%plot_values,'plot','plot_test_p_%02d_%02d',
	     q/$plot->{$key}/);
&write_tests(\%key_values,'key','plot_test_k_%02d_%02d',
	     q/$plot->{'key'}->{$key}/);
&write_tests(\%label_values,'label','plot_test_l_%02d_%02d',
	     q/$plot->{'labels'}->[0]->{$key}/);
&write_tests(\%axis_values,'axis','plot_test_a_%02d_%02d',
	     q/$plot->{'axis'}->{$key}/);
&write_tests(\@title_values,'title','plot_test_t_%02d',
	     q/$plot->{'title'}/);
&write_tests(\@xlabel_values,'xlabel','plot_test_xl_%02d',
	     q/$plot->{'xlabel'}/);
&write_tests(\@ylabel_values,'ylabel','plot_test_yl_%02d',
	     q/$plot->{'ylabel'}/);

sub write_tests {
    my $tmp = shift;
    my $dir = shift;
    system("mkdir plottest/$dir") if (! -d $dir);
    #
    my $filenameTemplate = shift;
    my $place = shift;
    if (ref($tmp) eq 'HASH') {
	my %valuesHash  = %{$tmp};
	my @Keys = keys(%valuesHash);
	for (my $i = 0; $i<=$#Keys; $i++) {
	    my $key = $Keys[$i];
	    for (my $j = 0; $j<=$#{$valuesHash{$key}}; $j++) { 
		my $plot = &set_defaults(); # hash reference
		eval($place.'=$valuesHash{$key}[$j]');
		my $filename = sprintf("plottest/$dir/$filenameTemplate.problem",$i,$j);
		open FILE,">$filename" || die "Unable to open $filename\n";
		print FILE "<problem>\n".&insert_plot($plot) ."\n</problem>\n";
		close FILE;
	    }
	}
    } elsif (ref($tmp) eq 'ARRAY') {
	my @valuesArray = @{$tmp};
	for (my $i = 0; $i<=$#valuesArray; $i++) {
	    my $key = $valuesArray[$i];
	    my $plot = &set_defaults(); # hash reference
	    eval($place.'=$key');
	    my $filename = sprintf("plottest/$dir/$filenameTemplate.problem",$i);
	    open FILE,">$filename" || die "Unable to open $filename\n";
	    print FILE "<problem>\n".&insert_plot($plot) ."\n</problem>\n";
	    close FILE;
	}
    }
}

##############################################################
# Set up the default values by taking the first item from each 
# xxx_values->{'attr'} array.
##############################################################
sub set_defaults{
    my $attr;
    my $plot;
    foreach $attr (keys (%plot_values)) {
	$plot->{$attr} = $plot_values{$attr}[0];
    }
    foreach $attr (keys (%key_values)) {
	$plot->{'key'}->{$attr} = $key_values{$attr}[0];
    }
    foreach $attr (keys (%axis_values)) {
	$plot->{'axis'}->{$attr} = $axis_values{$attr}[0];
    }
    foreach $attr (keys (%label_values)) {
	$plot->{'labels'}->[0]->{$attr} = $label_values{$attr}->[0];
    }
    foreach $attr (keys (%curve_values)) {
	$plot->{'curves'}->{$attr} = $curve_values{$attr}[0];
    }
    $plot->{'curves'}->{'data'}[0] = $data_values[0]->[0];
    $plot->{'curves'}->{'data'}[1] = $data_values[0]->[1];
    $plot->{'title'} = $title_values[0];
    $plot->{'xlabel'} = $xlabel_values[0];
    $plot->{'ylabel'} = $ylabel_values[0];
    return $plot;
}

##############################################################
##                                                          ##
##  Routines to output the plot information                 ##
##                                                          ##
##############################################################
sub insert_plot {
    my $plot = shift;
    my $result;
    #  plot attributes
    $result .= '<plot ';
    foreach my $attr (keys(%plot_defaults)) {
	$result .= "     $attr=\"$plot->{$attr}\"\n";
    }
    $result .= ">\n";
    # Add the components
    $result.=&insert_title ($plot->{'title'})  if (exists($plot->{'title'}));
    $result.=&insert_xlabel($plot->{'xlabel'}) if (exists($plot->{'xlabel'}));
    $result.=&insert_ylabel($plot->{'ylabel'}) if (exists($plot->{'ylabel'}));
    $result.=&insert_key($plot->{'key'})   if (exists($plot->{'key'}));
    $result.=&insert_axis($plot->{'axis'}) if (exists($plot->{'axis'}));
    if (exists($plot->{'labels'})) {
	foreach my $label (@{$plot->{'labels'}}) {
	    $result .= &insert_label($label) ;
	}
    }
    if (exists($plot->{'curves'})) {
#	foreach my $curve (@{$plot->{'curves'}} ) {
	$result .= &insert_curve($plot->{'curves'});
#	}
    }
    # close up the <plot>
    $result .= "</plot>\n";
    return $result;
}

sub insert_title  { return "    <title>$_[0]</title>\n" if (defined($_[0])); }
sub insert_xlabel { return "    <xlabel>$_[0]</xlabel>\n" if (defined($_[0])); }
sub insert_ylabel { return "    <ylabel>$_[0]</ylabel>\n" if (defined($_[0])); }

sub insert_key {
    my $key = shift;
    my $result;
    $result .= "    <key\n";
    foreach my $attr (keys(%key_defaults)) {
	$result .= "         $attr=\"$key->{$attr}\"\n";
    }
    $result .= "    />\n";
    return $result;
}

sub insert_axis{
    my $axis = shift;
    my $result;
    $result .= "    <axis \n";
    foreach my $attr (keys(%axis_defaults)) {
	$result .= "         $attr=\"$axis->{$attr}\"\n";
    }
    $result .= "    />\n";
    return $result;
}

sub insert_label {
    my $label = shift;
    my $result;
    $result .= "    <label \n";
    foreach my $attr (keys(%label_defaults)) {
	next if ($attr eq 'text');
	$result .= "         $attr=\"$label->{$attr}\"\n";
    }
    $result .= "    >$label->{'text'}</label>\n";
    return $result;
}

sub insert_curve {
    my $curve = shift;
    my $result;
    $result .= '    <curve ';
    foreach my $attr (keys(%curve_defaults)) {
	$result .= "         $attr=\"$curve->{$attr}\"\n";
    }
    $result .= "    >\n";
    if (exists($curve->{'function'})) {
	$result .= &insert_function($curve->{'function'});
    } else {
	$result .= &insert_data($curve->{'data'});
    }
    $result .= "    </curve>\n";
}

sub insert_function {
    my $function = shift;
    my $result;
    $result .= "<function>$function->{'text'}</function>\n";
    return $result;
}

sub insert_data {
    my $dataArray = shift;
    my $result;
    my $tmp = $";
    $" = ',';
    foreach my $data (@$dataArray) {
	$result .= "     <data>@$data</data>\n";
    }
    $"=$tmp;
    return $result;
}

##----------------------------------------------------------------------
1;
__END__