#!/usr/bin/perl -w $nw1_pajekFile = $ARGV[0]; $nw2_pajekFile = $ARGV[1]; $abs_outFile = $ARGV[2]; @nw1_label_info = &parse_NWFile($nw1_pajekFile); print "NW1 : @nw1_label_info\n"; $nos_nw1_labels = @nw1_label_info; foreach(@nw1_label_info) { chomp($_); my($f, $s) = split(" ", $_); $hash_nw1{$f} = $f; } @nw2_label_info = &parse_NWFile($nw2_pajekFile); print "NW2 : @nw2_label_info\n"; $nos_nw2_labels = @nw2_label_info; foreach(@nw1_label_info) { chomp($_); my($f, $s) = split(" ", $_); $f_pseudo = $f + $nos_nw1_labels; $hash_nw2{$f_pseudo} = $f_pseudo; } @abs_match = &parse_ABSFile($abs_outFile); foreach(@abs_match) { chomp($_); my @tmp = (); @tmp = split(" ", $_); $nw1_lbl = $hash_nw1{$tmp[1]}; $nw2_code = $tmp[4] + $nos_nw1_labels; $nw2_lbl = $hash_nw2{$nw2_code}; print "> $nw1_lbl -- $nw2_lbl\n"; } @nw1_arcs = &readNW_arcs($nw1_pajekFile); print "## @nw1_arcs\n"; @nw2_arcs = &readNW_arcs($nw2_pajekFile); print "## @nw2_arcs\n"; &print_PajekFile(); exit(0); ###### SUB-ROUTINES ########### sub print_PajekFile() { $pajekFile = $abs_outFile; $pajekFile =~s/\.map/_pajek\.txt/; print "$pajekFile\n"; $ver_ctr = $nos_nw1_labels + $nos_nw2_labels; open(OUT, ">$pajekFile"); print OUT"*Vertices $ver_ctr\n"; foreach(@nw1_label_info) { print OUT"$_ ic Orange bc Mahogany\n"; } foreach(@nw2_label_info) { my ($f, $s) = split(" ", $_); $f = $f + $nos_nw1_labels; print OUT"$f $s ic Mahogany bc Orange\n"; } print OUT"*Arcs\n"; foreach(@nw1_arcs) { chomp($_); print OUT"$_ 1 c Green\n"; } foreach(@nw2_arcs) { chomp($_); my ($f, $s) = split(" ", $_); $f = $f + $nos_nw1_labels; $s = $s + $nos_nw1_labels; print OUT"$f $s 1 c Red\n"; } foreach(@abs_match) { chomp($_); my @tmp = (); @tmp = split(" ", $_); $nw1_lbl = $hash_nw1{$tmp[1]}; $nw2_code = $tmp[4] + $nos_nw1_labels; $nw2_lbl = $hash_nw2{$nw2_code}; print OUT"$nw1_lbl $nw2_lbl 1 c Black\n"; } } sub readNW_arcs() { my $file = $_[0]; print ">) { chomp($_); if ($_ =~/Arcs/) { $flag = 1; } if ($flag) { push(@arcs, $_); } } close(IN); shift(@arcs); return(@arcs); } sub parse_ABSFile() { my $file = $_[0]; print "FileName: $file\n"; my @data = (); my $flag = 0; open(IN, $file); @data = ; close(IN); my @tmp = (); foreach(@data) { chomp($_); if ($_=~/^-/) { $flag = 1; } if($flag) { push(@tmp, $_); } } shift(@tmp); return (@tmp); } sub parse_NWFile() { my $file = $_[0]; print "FileName: $file\n"; my @data = (); open(IN, $file); while(){ chomp($_); if ($_ =~/Arcs/) { last; }else{ push(@data, $_); } } close(IN); shift(@data); return(@data); }