TIMTOWTDI, with a HoH... to get you started... though you might get problems with
extremely large numbers of Ax;Ay relationships. Then, try to use bitmaps or a DB.
HTH
Output:use strict; use warnings; my %A; my ($max_row, $max_col) = (4,4); # autovivify interesting rows/cols of %A while (<DATA>) { warn("Line $.: cannot understand: $_") , next unless /A(\d+);A(\d+)/ +; my ($row, $col) = ($1,$2); $A{$row}{$col}++; $A{$col}{$row}++; # uncomment if relationship is not bidirectional } # print col. header print " "; printf("A%-3d",$_) for (1..$max_col); print "\n"; #print matrix A for my $row (1 .. $max_row) { printf("A%-3d", $row); for my $col (1 .. $max_col) { printf(" %-3d", exists $A{$row}{$col} ? "1" : "0" ); } print "\n"; } __DATA__ A1;A4 A2;A3 A2;A4 A1;A3
Update: After OP clarified, that A1..A# are actually strings, here are some suggestions to modify the code above:A1 A2 A3 A4 A1 0 0 1 1 A2 0 0 1 1 A3 1 1 0 0 A4 1 1 0 0
use strict; use warnings; my %A; # remembers pairing (x,y) as $A{x}{y} and $A{y}{x} my @order; # set output order here or trust auto-generated @order be +low # e.g. @order = qw(eel horse lion mule tiger); # autovivify interesting pairings while (<DATA>) { warn("Line $.: cannot understand: $_") , next unless /(\w+);(\w+)/; my ($row, $col) = ($1,$2); $A{$row}{$col}++; # ++ just triggers the autovivification (see: perl +ref) $A{$col}{$row}++; # uncomment line if relationship is not bidirectio +nal # ... would break gimmick#1 } # Gimmick #1: auto-generated list-order when list-order was not given # assumption: symmetric relationship -> square matrix; # combinations never paired are filtered out - bug or feat +ure? @order = sort keys %A unless @order; # create order unless given above # Gimmick #2: fixed auto-width for output (min. width: 2+3 ('###')) my $width = 2 + (sort { $a <=> $b } ( map { length $_ } (@order, '### +' )) )[-1]; my $format = '%-' . $width . 's'; # printf()-format for fixed width c +olumns # print header printf($format, $_) for ( " ", @order ); print "\n"; # print matrix A for my $row (@order) { printf($format, $row); for my $col (@order) { printf($format, exists $A{$row}{$col} ? "1" : "0"); # Idea for gimmick#3: $format = f( column ) } print "\n"; } __DATA__ horse;tiger lion;mule lion;tiger horse;mule
In reply to Re: create a matrix for print 0 or 1 from pairing
by Perlbotics
in thread create a matrix for print 0 or 1 from pairing
by vis1982
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |