#
#	アドレス対応表から，ネットワークをシュリンクするツール
#		author	yoji-o
#		date	2007-01-11
#
#		◇入力
#			.netファイルと，アドレス対応表
#		◇出力
#			シュリンクされた.netファイル
#
#		◇使用法
#			コマンドラインで、以下のコマンドをたたく(要 Perl 5 以上)
#			perl networkShrinker.pl data.net email_translate.txt
#			
#				引数
#					data.net				シュリンクしたい.netファイル
#					email_translate.txt		アドレス対応表
#

use Strict;

#変数宣言
my %correspond;			#新旧のアドレス対応関係
my %relation;			#レス関係の対応ハッシュ(2次元ハッシュ，新アドレスでの関係)
my @old_list;			#元の.netファイルのリスト
#my %old_list_r;			#元の.netファイルのリスト(ハッシュ)
my @new_list;			#新しい.netファイルのリスト
my %new_list_r;			#新しい.netファイルのリスト(ハッシュ)


#ここから
&shrink();					#shrinkする
&save();					#それを保存
exit;


################################################################################
#以下サブルーチン群

#===============================================================================
#	shrink
#		shrinkする
sub shrink {

	if(@ARGV < 2) {
		print "Need more arguments : @ARGV\n";
	}
	
	#関係ファイル読み込み
	open CORRESPOND, $ARGV[1] or die "correspondence file open error : $ARGV[1].";
		while($line = <CORRESPOND>) {
			chomp $line;
			my ($old, $new) = split / /, $line;
			
			$correspond{$old} = $new;
			if($old eq $new) {
				push @new_list, $new;
				$new_list_r{$new} = $#new_list;
			}
		}
	close CORRESPOND;
	
	#Pajekファイル読み込み
	open PAJEK, $ARGV[0] or die "Pajek file open error : $ARGV[0].";
		#読み捨て
		$line = <PAJEK>;
		
		while($line = <PAJEK>) {
			chomp $line;
			if($line =~ /^\*Arcs/) {
				last;
			}
			
			my ($no, $address) = split / /, $line;
			$address =~ s/^\"(.*)\"/$1/;						#"
			$old_list[$no] = $address;
		}
		
		while($line = <PAJEK>) {
			chomp $line;
			my($from, $to, $num) = split / /, $line;
			$relation{$new_list_r{$correspond{$old_list[$from]}}}{$new_list_r{$correspond{$old_list[$to]}}} += $num;
		}
		
	close PAJEK;
}


#===============================================================================
#	save
#		saveする
sub save {
	
	#新規ファイルに保存
	$ARGV[0] =~ s/^(.*)\.net$/$1_sr.net/;
	open NEWPAJEK, ">$ARGV[0]" or die "Save file open error : $ARGV[0].";
		#ノードデータ
		print NEWPAJEK "*Vertices ", scalar(@new_list), "\n";
		for(my $i = 0; $i <= $#new_list; $i++) {
			print NEWPAJEK $i+1, " \"", $new_list[$i], "\"\n";
		}
		
		#有向グラフデータ
		print NEWPAJEK "*Arcs\n";
		foreach $firstkey (keys %relation) {
			while (my ($secondkey, $value) = each %{$relation{$firstkey}}) {
				if($firstkey ne "" && $secondkey ne "") {
					print NEWPAJEK "$firstkey $secondkey $value\n";
				}
			}
		}
	close NEWPAJEK;
	
}