#
#	2つのネットワークファイル（pajek用 拡張子=net）をマージする
#		author	shinsuke-m
#		date	
#
#		◇入力
#		       .netファイル
#		◇出力
#		       マージ済み.netファイル と パーティション情報 を組み合わせた .paj ファイル
#                      (パーティションファイル(.clu) 1:入力1に属する 2:入力2に属する 3:両方に属する)
#
#		◇使用法
#			コマンドラインで、以下のコマンドをたたく(要 Perl 5 以上)
#			perl margeNetwroksByName.pl data1.net data2.net
#			
my $sep = " ";
&merge($ARGV[0], $ARGV[1]);
exit;
#--------------------------------------------------------------------------------
# 2ネットワークのマージング
sub merge {

    my ($netFileName1, $netFileName2) = @_;
    my %vert_h1, %arc_h1, %vert_h2, %arc_h2;
    my %resultVert_h, %resultArc_h;

    # netの読み込み
    &readNet($ARGV[0], \%vert_h1, \%arc_h1);
    &readNet($ARGV[1], \%vert_h2, \%arc_h2);
    
    &makePartitions(\%vert_h1, \%vert_h2, \%resultPart_h);
    &makeVertices(\%resultPart_h, \%resultVert_h);
    
    &makeArcs(\%vert_h1, \%arc_h1, \%vert_h2, \%arc_h2, \%resultVert_h, \%resultArc_h);

    &trimSelfArc(\%resultArc_h);

#    &printVert(\%resultVert_h);    print  "--------------------------------------------------------------------------------\n";
#    &printVert(\%resultPart_h);    print  "--------------------------------------------------------------------------------\n";
#    &printArc(\%arc_h1);    print  "--------------------------------------------------------------------------------\n";
#    &printArc(\%arc_h2);    print  "--------------------------------------------------------------------------------\n";
#    &printArc(\%resultArc_h);    print  "--------------------------------------------------------------------------------\n";

    # 日付部分を抜き出し
    $time = $ARGV[0];
    $time =~ s/(.*)([0-9]{6})(.*)/$2/;

    &printResult(\%resultVert_h, \%resultArc_h, \%resultPart_h, $time);
}
#--------------------------------------------------------------------------------
# 自己ループの削除
sub trimSelfArc {
    my $arc = $_[0];
    foreach my $key (keys %{$arc}) {
        foreach my $subkey (keys %{$$arc{$key}}) {
#            print $key, $subkey, "\n";
            if ($key eq $subkey) {
                delete $$arc{$key}{$subkey};
            }
        }
    }
}

#--------------------------------------------------------------------------------
# 2つのnetファイルからエッジ情報を作成
sub makeArcs {
    my ($vert1, $arc1, $vert2, $arc2, $vert, $resultArc) = ($_[0], $_[1], $_[2], $_[3], $_[4], $_[5]);

    # 1つ目のarcリストを結果に突っ込む
    foreach my $key (keys %{$arc1}) {
#        print $key, "--------------------------------------------------------------------------------\n";
        foreach my $subkey (keys %{$$arc1{$key}}) {
#            print "\t", $subkey, "\t|\t", $vertrev{$key}, "\t|\t", $vertrev{$subkey}, "\t|\t", $$arc1{$vertrev{$key}}{$vertrev{$subkey}}, "\t|\n";
            $$resultArc{$key}{$subkey} += $$arc1{$key}{$subkey};
        }
    }

    # 2つ目のarcリストを結果に突っ込む
    foreach my $key (keys %{$arc2}) {
#        print $key, "\n";
        foreach my $subkey (keys %{$$arc2{$key}}) {
#            print "\t", $subkey, "\n";
            $$resultArc{$key}{$subkey} += $$arc2{$key}{$subkey};
        }
    }
#    &printArc($resultArc);
}

#--------------------------------------------------------------------------------
# 2つのnetからpartition情報を作成
sub makePartitions {
    my ($v1, $v2, $resp) = @_;

    foreach my $key (keys %{$v1}) {
        # 両方のハッシュに存在した場合はpartition=3
        if ($$v2{$key} ne "") {
            $$resp{$key} = 3;
        }
        # 最初の引数側のみのハッシュに存在した場合はpartition=1
        elsif ($$v2{$key} eq "") {
            $$resp{$key} = 1;
        }
    }
    # 後ろの引数側のみのハッシュに存在した場合はpartition=2
    foreach my $key (keys %{$v2}) {
        if ($$v1{$key} eq "") {
            $$resp{$key} = 2;
        }
    }

}
#--------------------------------------------------------------------------------
# 2つのnetからpartition情報を作成
sub makeVertices {
    my ($part, $vert) = @_;

    @keys = sort keys %$part;

    my $n = 1;
    foreach $key (@keys) {
        $$vert{$n++} = $key;
    }
}

#--------------------------------------------------------------------------------
# ネットファイルの読み込み
sub readNet {
    my ($file, $vert, $arc) = ($_[0], $_[1], $_[2]);
    open NET, $file or die "file open error : $file";

    my $line;
    my %vert;
    my %tmp;

    # verticies の読み込み
    while($line = <NET>) {
        if($line =~ /^\*Arcs/){ last; }
        if($line =~ /^*Vertices/){ next; }

        my($p, $name) = split / /, $line;
        chomp $name;
        $$vert{$name} = $p;
        $tmp{$p} = $name;
    }

    # arcs の読み込み
    while($line = <NET>) {
        my($e1, $e2, $val) = split / /, $line;
        chomp $val;
        $$arc{$tmp{$e1}}{$tmp{$e2}} = $val;
    }

    close NET;
}

#--------------------------------------------------------------------------------
# 結果の出力
sub printResult {
    my ($vert, $arc, $part, $time) = @_;
    

    # vertの逆転ハッシュ作成
    my $vertrev;
    foreach $key (keys %$vert) {
        $vertrev{$$vert{$key}} = $key;
    }

    #&printVert(\%vertrev);

    # ハッシュのソート
    @keys_vt = sort {$a<=>$b} keys %$vert;

    # vertices の書き出し
    print "*Network $time\n", "*Vertices ", $#keys+1, "\n";
    foreach $key (@keys_vt) {
        print $key, $sep, $$vert{$key}, "\n";
    }

    # arcs の書き出し
    print "*Arcs\n";
    @keys_ac = sort keys %$arc;
    #print @keys_ac;
    foreach my $key (@keys_ac) {
        @subkeys_ac = sort keys %{$$arc{$key}};
        #print @subkeys_ac;
        foreach my $subkey (@subkeys_ac) {
            print $vertrev{$key}, $sep, $vertrev{$subkey}, $sep,  $$arc{$key}{$subkey}, "\n";
        }
    }

#     # arcs の書き出し
#     foreach my $key (keys %$arc) {
#         foreach my $subkey (keys %{$$arc{$key}}) {
#             print $key, $sep, $subkey, $sep,  $$arc{$key}{$subkey}, "\n";
#         }
#     }


    # partitions の書き出し
    print "*Partition $time\n", "*Vertices ", $#keys+1, "\n";
    foreach $key (@keys_vt) {
        print $$part{$$vert{$key}}, "\n";
    }
}

#--------------------------------------------------------------------------------
# デバッグ用：vertの出力
sub printVert {
    $vert = $_[0];

    foreach $key (keys %{$vert}) {
        print $$vert{$key}, "\t", $key, "\n";
    } 
}

#--------------------------------------------------------------------------------
# デバッグ用：arcの出力
sub printArc {
    $arc = $_[0];

    # 2つ目のarcリストを結果に突っ込む
    foreach my $key (keys %{$arc}) {
        foreach my $subkey (keys %{$$arc{$key}}) {
            print $key, "\t", $subkey, "\t", $$arc{$key}{$subkey}, "\n";
        }
    }
}