#!/usr/local/bin/perl -T # Script: power.pl # Author: Michael Friendly # Version: 1.0 # Date: Wed Jan 10 16:24:06 EST 1996 # This script uses the cgi-utils.pl by Lincoln Stein, available at # http://www-genome.wi.mit.edu/WWW/tools/scripting/cgi-utils.html unshift(@INC, "/usr/local/lib/perl"); # where cgi-utils.pl lives require "cgi-utils.pl"; # --- Configuration items ----- $SAS = '/LocalApps/sas.app/sas'; # where the sas executable lives $config = '/users/faculty/friendly/config.sas'; # a suitable config.sas $power = "/users/FTP/pub/sas/macros/fpower.sas"; # %include file pathname # image to be displayed if the script fails. Set to "" -> no image $fail_image = "/SCS/icons/bomb.gif"; # The directory where the sas input/output files are created must # be writable by the user under which httpd runs. $httmp = '/usr/local/etc/httpd/htdocs/tmp'; # where SAS file get created $tmp = '/tmp'; # use for the sasuser directory $sasfile = "$httmp/pwr"; srand(time); $sasfile .= int(rand(9))+1; # add random digit to filename $lstfile = "$sasfile.lst"; $sasopts = "-sasuser $tmp -config $config"; $debug=0; # unbuffer output so that we can see it as it comes # out, rather than waiting for buffers to flush $| = 1; $ENV{'PATH'}="/bin:/usr/bin:/usr/ucb"; # a nice clean path &print_HTTP_header; &print_head; %query = &get_query; # we assume a parameter list here unless (%query) { &print_prompt; } else { &do_work(%query); } &print_tail; # ----------------- subroutines ------------ sub print_HTTP_header { print "Content-type: text/html\n\n"; } sub print_head { print < Power Analysis for ANOVA Designs

Power Analysis for ANOVA Designs

END } sub print_tail { print < friendly\@yorku.ca END } sub print_prompt { print "This program is designed to be run by the www server.\n"; } sub do_work { local(%query)=@_; $a = $query{'A'}; $b = $query{'B'}; $delta = $query{'DELTA'}; $alpha = $query{'ALPHA'}; $output = $query{'OUTPUT'}; print "The power parameters you specified were: "; print "
    \n"; print "
  • a = '$a' (levels of factor for power)\n"; print "
  • b = '$b' (levels of factor(s) crossed with A)\n"; print "
  • delta = '$delta' (effect size(s))\n"; print "
  • alpha = '$alpha' (significance level)\n"; print "
\n"; print "
\n"; #--- Sanity checks --- $ok = &is_int($a) && &is_int($b); unless ($ok) { &fail("Error: a and b must be integers. I got a= $a and b= $b"); return; } $ok = &is_numeric($alpha) && (0 < $alpha) && ($alpha < 1); unless ($ok) { &fail("Error: alpha should be a number between 0 and 1. I got alpha=$alpha"); return; } ($ok, $delta) = &make_do_list($delta); unless($ok) { &fail("Error: delta should be one or more positive numbers. I got delta=$delta"); return; } #-- Choose output format if ($output == 'ptable') { $out = 'ptable=YES, ntable=NO'; } else { $out = 'ptable=NO, ntable=YES'; } $\="\n"; # write the SAS program calling fpower, then run it. open (SASFILE,">$sasfile".'.sas') || warn("Can't open $sasfile\n"); print SASFILE <<"END"; options nodate nocenter nonumber; title 'Power analysis for ANOVA designs'; %include "$power"; %fpower(a=$a, b=$b, delta=%str($delta), alpha=$alpha, $out); END close(SASFILE); print "
Running $SAS $sasopts $sasfile
\n" if $debug; chdir($httmp); system ("$SAS $sasopts $sasfile"); if (-f $lstfile) { open (LST, "< $lstfile"); print "
\n";
		$\="";
		while () {
			print;
		}
		print "
\n"; close(LST); print "

The sample size values given are those for each of the $a ", "levels of the factor called 'Factor A'."; if ($b > 1) { print "With $b combinations of other factors at each level of ", "Factor A, divide the sample size by $b to determine the sample ", "size per treatment cell."; } } else { &fail("

Oops, something went wrong! The output file $lstfile was not created"); } } sub is_int { local ($value) = @_; $value =~ s/\s//; $ok = ($value =~ /\d+/) && ($value == int($value)); } sub is_numeric { local ($value) = @_; $value =~ s/\s//; ($value =~ /^(\d+\.\d*|\.\d+)$/); } # Parse a string containing numbers, return a comma-separated do-list sub make_do_list { local($list) = @_; # local ($nums); local(@l); $len = @l = split(/[, \t]+/, $list); #split on comma or whitespace $nums = grep(&is_numeric($_), @l); #test is each is a number # print "Nums: $nums, list length: $len \n"; (($nums == $len) ? 1 : 0), join(',',@l); } sub fail { local($msg) = @_; if ($fail_image) { print qq(failed); } print "$msg\n"; }