Mercurial > repos > jesse-erdmann > tapdance
diff lib/list2tab.pl @ 0:1437a2df99c0
Uploaded
author | jesse-erdmann |
---|---|
date | Fri, 09 Dec 2011 11:56:56 -0500 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lib/list2tab.pl Fri Dec 09 11:56:56 2011 -0500 @@ -0,0 +1,93 @@ +#!/usr/bin/perl +# The Missing Textutils, Ondrej Bojar, obo@cuni.cz +# http://www.cuni.cz/~obo/textutils +# +# 'list2tab' builds a 2D table out of key-key-value triples. +# +# $Id: list2tab,v 1.4 2006/07/07 15:01:53 bojar Exp $ +# + +$rows = shift; +$cols = shift; +$data = shift; +$blankvalue = shift; +@rows = split /,/, $rows; +@cols = split /,/, $cols; +@data = split /,/, $data; + +$blankvalue = "-" if $blankvalue eq ""; + +if (!$rows || !$cols || !$data) { + my $help = <<EOH; +Sample usage: + ./list2tab.pl 1,2 5,6 3,4 [default_value] < datafile > tablefile +The output table will have lines labelled with values seen in columns 1 and 2, +columns labelled with values from columns 5,6 and the values in the interior of the table will come from columns 3,4. + +Sample input: +GIN Praha 5 +IOL Praha 20 +GIN Brno 10 +IOL Nova Paka 2 + +Output produced by: "list2tab 2 1 3 none" + + GIN IOL +Brno 10 none +Nova Paka none 2 +Praha 5 20 +EOH + print STDERR $help; + exit $1; +} + + +while (<>) { + chomp; + @line = split /\t/; + $key = $val = $datum = ""; + foreach $row (@rows) { + $key .= $line[$row-1]."\t"; + } + chop $key; + foreach $col (@cols) { + $val .= $line[$col-1]."\t"; + } + chop $val; + foreach $dat (@data) { + $datum .= $line[$dat-1]."\t"; + } + chop $datum; + $datum =~ s/^ *//; + $datum =~ s/ *$//; + + $table{"$key\t$val"} = $datum; +#print STDERR "Tabulka >>$key\t$val<<.....$datum\n"; + $keys{$key} = 1; + push @svals, $val if (!$vals{$val}); + $vals{$val} = 1; +} + +@skeys = sort {uc($a) cmp uc($b)} keys %keys; +#@svals = sort {uc($a) cmp uc($b)} keys %vals; + +#print STDERR "Klice: ".join(",",@skeys)."\n"; +#print STDERR "Hodnoty: ".join(",",@svals)."\n"; + + +print "\t" x $#rows; + +foreach $col (@svals) { + print "\t$col"; +} +print "\n"; + +foreach $row (@skeys) { + print "$row"; + foreach $col (@svals) { + $pos = "$row\t$col"; + print "\t$table{$pos}" if defined $table{$pos}; + print "\t$blankvalue" if ! defined $table{$pos}; + } + print "\n"; +}