223 lines
4.6 KiB
Text
223 lines
4.6 KiB
Text
|
#! /usr/bin/perl -w
|
||
|
|
||
|
use strict;
|
||
|
|
||
|
#my $R_PREAMBLE = qq{
|
||
|
# postscript("__PLOT_NAME__.ps", width = 9.75, height = 6.375,
|
||
|
# horizontal = FALSE, onefile = FALSE, paper = "special",
|
||
|
# family = "ComputerModern")
|
||
|
# };
|
||
|
my $R_PREAMBLE;
|
||
|
|
||
|
my $outputFormat = "pdf";
|
||
|
|
||
|
my $width = 5;
|
||
|
my $height = 4;
|
||
|
my $dpi = 100;
|
||
|
|
||
|
sub set_format {
|
||
|
my $format = shift;
|
||
|
if($format eq "pdf") {
|
||
|
$R_PREAMBLE = qq{
|
||
|
pdf("__PLOT_NAME__.pdf", width = $width, height = $height,
|
||
|
horizontal = FALSE, onefile = FALSE, paper = "special")
|
||
|
|
||
|
};
|
||
|
# family = "ComputerModern")
|
||
|
} elsif ($format eq "ps") {
|
||
|
$R_PREAMBLE = qq{
|
||
|
postscript("__PLOT_NAME__.ps", width = $width, height = $height,
|
||
|
horizontal = FALSE, onefile = FALSE, paper = "special",
|
||
|
family = "ComputerModern")
|
||
|
};
|
||
|
} elsif ($format eq "png") {
|
||
|
my $pwidth = $width * $dpi;
|
||
|
my $pheight = $height * $dpi;
|
||
|
$R_PREAMBLE = qq{
|
||
|
png(filename = "__PLOT_NAME__.png", width = $pwidth, height = $pheight,
|
||
|
pointsize = 12, bg = "white", res = $dpi)
|
||
|
};
|
||
|
} else {
|
||
|
die ("Unknown format. Known formats are: pdf ps png\n");
|
||
|
}
|
||
|
}
|
||
|
my $R_READ = qq{
|
||
|
__NAME__<-read.table("__FILE__",header=F,sep="\\t")
|
||
|
};
|
||
|
|
||
|
my $R_FIRST_PLOT = qq{
|
||
|
plot(__NAME__\$V1, __NAME__\$V2, type="b",
|
||
|
xlim=c(0,max(__NAME_X_LIST__)),
|
||
|
ylim=c(0, max(__NAME_Y_LIST__)),
|
||
|
xlab="__XLAB__", ylab="__YLAB__",
|
||
|
main="__TITLE__", pch=1, col=1)
|
||
|
};
|
||
|
|
||
|
my $R_NEXT_PLOT = qq{
|
||
|
lines(__NAME__\$V1, __NAME__\$V2, type="b", pch=__N__+1, col=__N__+1)
|
||
|
};
|
||
|
|
||
|
my $R_LEGEND = qq{
|
||
|
legend((0 * max(__NAME_X_LIST__)), max(__NAME_Y_LIST__), legend=c(__NAME_LABEL_LIST__), bty="n", pch=c(1:__COUNT__), col=c(1:__COUNT__))
|
||
|
};
|
||
|
|
||
|
my $R_FINISH = qq{
|
||
|
dev.off()
|
||
|
};
|
||
|
|
||
|
sub replaceAll {
|
||
|
my $cmd = shift;
|
||
|
my $arglist_ref = shift;
|
||
|
my %arglist = %{$arglist_ref};
|
||
|
|
||
|
foreach my $i (keys %arglist) {
|
||
|
$cmd =~ s/$i/$arglist{$i}/g;
|
||
|
}
|
||
|
return $cmd;
|
||
|
}
|
||
|
|
||
|
sub getConfig {
|
||
|
my $basename = shift;
|
||
|
my $key = shift;
|
||
|
my $value = `grep ^$key: $basename.def`;
|
||
|
$value =~ s/^$key\:\s+//;
|
||
|
chomp $value;
|
||
|
return $value
|
||
|
}
|
||
|
|
||
|
sub filesToLabels {
|
||
|
my $array_ref = shift;
|
||
|
|
||
|
my @array = @{$array_ref};
|
||
|
|
||
|
for(my $i = 0; $i < @array; $i++) {
|
||
|
chomp $array[$i];
|
||
|
$array[$i] =~ s/^[^\-]+\-//;
|
||
|
$array[$i] =~ s/\.dat$//;
|
||
|
$array[$i] =~ s/[-_]/ /g;
|
||
|
}
|
||
|
|
||
|
my $ret = '"' . join ('", "', @array). '"';
|
||
|
|
||
|
return $ret;
|
||
|
}
|
||
|
|
||
|
sub labelsToVars {
|
||
|
my $i = shift;
|
||
|
|
||
|
$i =~ s/[^A-Za-z0-9\"\,]//g;
|
||
|
|
||
|
$i =~ s/\,/, /g;
|
||
|
|
||
|
return $i;
|
||
|
}
|
||
|
|
||
|
sub varsToXList {
|
||
|
my $i = shift;
|
||
|
|
||
|
$i =~ s/\"\,/\$V1\",/g;
|
||
|
$i =~ s/\"$/\$V1\"/;
|
||
|
|
||
|
$i =~ s/\"//g;
|
||
|
|
||
|
return $i;
|
||
|
}
|
||
|
sub varsToYList {
|
||
|
my $i = shift;
|
||
|
|
||
|
$i =~ s/\"\,/\$V2\",/g;
|
||
|
$i =~ s/\"$/\$V2\"/;
|
||
|
$i =~ s/\"//g;
|
||
|
|
||
|
return $i;
|
||
|
}
|
||
|
|
||
|
my %vals;
|
||
|
|
||
|
my $usage = "Usage: $0 [--format (pdf|ps|png)] [--width in] [--height -in] GRAPH_NAME\n";
|
||
|
|
||
|
my $basename;
|
||
|
while (@ARGV) {
|
||
|
if($ARGV[0] eq '--format') {
|
||
|
shift @ARGV;
|
||
|
$outputFormat = shift @ARGV;
|
||
|
} elsif ($ARGV[0] eq '--width') {
|
||
|
shift @ARGV;
|
||
|
$width = shift @ARGV;
|
||
|
} elsif ($ARGV[0] eq '--height') {
|
||
|
shift @ARGV;
|
||
|
$height = shift @ARGV;
|
||
|
} elsif ($ARGV[0] eq '--dpi') {
|
||
|
shift @ARGV;
|
||
|
$dpi = shift @ARGV;
|
||
|
} else {
|
||
|
defined($basename)
|
||
|
&& die ("Multiple graphs specified. Invalid parameter?\n$usage");
|
||
|
$basename = shift(@ARGV);
|
||
|
}
|
||
|
}
|
||
|
|
||
|
defined($basename) || die $usage;
|
||
|
|
||
|
set_format($outputFormat);
|
||
|
|
||
|
|
||
|
|
||
|
my @files = `ls $basename-*.dat`;
|
||
|
|
||
|
for(my $i =0; $i < @files; $i++) {
|
||
|
chomp $files[$i];
|
||
|
}
|
||
|
|
||
|
|
||
|
$vals{__PLOT_NAME__} = $basename;
|
||
|
$vals{__XLAB__} = getConfig($basename, "X-Label");
|
||
|
$vals{__YLAB__} = getConfig($basename, "Y-Label");
|
||
|
$vals{__TITLE__} = getConfig($basename, "Title");
|
||
|
$vals{__NAME_LABEL_LIST__} = filesToLabels(\@files);
|
||
|
|
||
|
my $vars = labelsToVars($vals{__NAME_LABEL_LIST__});
|
||
|
|
||
|
$vals{__NAME_X_LIST__} = varsToXList($vars);
|
||
|
$vals{__NAME_Y_LIST__} = varsToYList($vars);
|
||
|
$vals{__COUNT__} = @files;
|
||
|
|
||
|
my @names = split /[\"\,\s]+/, $vars;
|
||
|
|
||
|
if($names[0] =~ /^\s*$/) {
|
||
|
shift @names;
|
||
|
}
|
||
|
|
||
|
|
||
|
$vals{__FILE__} = $files[0];
|
||
|
$vals{__NAME__} = $names[0];
|
||
|
$vals{__N__} = 0;
|
||
|
|
||
|
print replaceAll($R_PREAMBLE, \%vals);
|
||
|
print replaceAll($R_READ, \%vals);
|
||
|
|
||
|
for(my $n = 1 ; $n < @names; $n++) {
|
||
|
$vals{__FILE__} = $files[$n];
|
||
|
$vals{__NAME__} = $names[$n];
|
||
|
print replaceAll($R_READ, \%vals);
|
||
|
}
|
||
|
|
||
|
$vals{__FILE__} = $files[0];
|
||
|
$vals{__NAME__} = $names[0];
|
||
|
|
||
|
|
||
|
print replaceAll($R_FIRST_PLOT, \%vals);
|
||
|
|
||
|
for(my $n = 1 ; $n < @names; $n++) {
|
||
|
$vals{__FILE__} = $files[$n];
|
||
|
$vals{__NAME__} = $names[$n];
|
||
|
$vals{__N__} = $n;
|
||
|
|
||
|
print replaceAll($R_NEXT_PLOT, \%vals);
|
||
|
|
||
|
}
|
||
|
|
||
|
print replaceAll($R_LEGEND, \%vals);
|
||
|
print replaceAll($R_FINISH, \%vals);
|
||
|
|