|
0
|
1 #!/usr/bin/perl
|
|
|
2 # The Missing Textutils, Ondrej Bojar, obo@cuni.cz
|
|
|
3 # http://www.cuni.cz/~obo/textutils
|
|
|
4 #
|
|
|
5 # 'list2tab' builds a 2D table out of key-key-value triples.
|
|
|
6 #
|
|
|
7 # $Id: list2tab,v 1.4 2006/07/07 15:01:53 bojar Exp $
|
|
|
8 #
|
|
|
9
|
|
|
10 $rows = shift;
|
|
|
11 $cols = shift;
|
|
|
12 $data = shift;
|
|
|
13 $blankvalue = shift;
|
|
|
14 @rows = split /,/, $rows;
|
|
|
15 @cols = split /,/, $cols;
|
|
|
16 @data = split /,/, $data;
|
|
|
17
|
|
|
18 $blankvalue = "-" if $blankvalue eq "";
|
|
|
19
|
|
|
20 if (!$rows || !$cols || !$data) {
|
|
|
21 my $help = <<EOH;
|
|
|
22 Sample usage:
|
|
|
23 ./list2tab.pl 1,2 5,6 3,4 [default_value] < datafile > tablefile
|
|
|
24 The output table will have lines labelled with values seen in columns 1 and 2,
|
|
|
25 columns labelled with values from columns 5,6 and the values in the interior of the table will come from columns 3,4.
|
|
|
26
|
|
|
27 Sample input:
|
|
|
28 GIN Praha 5
|
|
|
29 IOL Praha 20
|
|
|
30 GIN Brno 10
|
|
|
31 IOL Nova Paka 2
|
|
|
32
|
|
|
33 Output produced by: "list2tab 2 1 3 none"
|
|
|
34
|
|
|
35 GIN IOL
|
|
|
36 Brno 10 none
|
|
|
37 Nova Paka none 2
|
|
|
38 Praha 5 20
|
|
|
39 EOH
|
|
|
40 print STDERR $help;
|
|
|
41 exit $1;
|
|
|
42 }
|
|
|
43
|
|
|
44
|
|
|
45 while (<>) {
|
|
|
46 chomp;
|
|
|
47 @line = split /\t/;
|
|
|
48 $key = $val = $datum = "";
|
|
|
49 foreach $row (@rows) {
|
|
|
50 $key .= $line[$row-1]."\t";
|
|
|
51 }
|
|
|
52 chop $key;
|
|
|
53 foreach $col (@cols) {
|
|
|
54 $val .= $line[$col-1]."\t";
|
|
|
55 }
|
|
|
56 chop $val;
|
|
|
57 foreach $dat (@data) {
|
|
|
58 $datum .= $line[$dat-1]."\t";
|
|
|
59 }
|
|
|
60 chop $datum;
|
|
|
61 $datum =~ s/^ *//;
|
|
|
62 $datum =~ s/ *$//;
|
|
|
63
|
|
|
64 $table{"$key\t$val"} = $datum;
|
|
|
65 #print STDERR "Tabulka >>$key\t$val<<.....$datum\n";
|
|
|
66 $keys{$key} = 1;
|
|
|
67 push @svals, $val if (!$vals{$val});
|
|
|
68 $vals{$val} = 1;
|
|
|
69 }
|
|
|
70
|
|
|
71 @skeys = sort {uc($a) cmp uc($b)} keys %keys;
|
|
|
72 #@svals = sort {uc($a) cmp uc($b)} keys %vals;
|
|
|
73
|
|
|
74 #print STDERR "Klice: ".join(",",@skeys)."\n";
|
|
|
75 #print STDERR "Hodnoty: ".join(",",@svals)."\n";
|
|
|
76
|
|
|
77
|
|
|
78 print "\t" x $#rows;
|
|
|
79
|
|
|
80 foreach $col (@svals) {
|
|
|
81 print "\t$col";
|
|
|
82 }
|
|
|
83 print "\n";
|
|
|
84
|
|
|
85 foreach $row (@skeys) {
|
|
|
86 print "$row";
|
|
|
87 foreach $col (@svals) {
|
|
|
88 $pos = "$row\t$col";
|
|
|
89 print "\t$table{$pos}" if defined $table{$pos};
|
|
|
90 print "\t$blankvalue" if ! defined $table{$pos};
|
|
|
91 }
|
|
|
92 print "\n";
|
|
|
93 }
|
