#
#	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 @resultArcs;
my @resultVert;
my @resultPart;

# ネットファイルを整形してからマージング
&transformSmallLetter($ARGV[0], "tmp1.net");
&transformSmallLetter($ARGV[1], "tmp2.net");

#マージ
&merge("tmp1.net", "tmp2.net");
#&merge($ARGV[0], $ARGV[1]);

#その他雑多な処理
&renumbering;
&sumArcs;
&prepPartition;
&trimZero;



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


&writefile($time);

if(0){
    print "\n------------------\n";
    print @resultVert;
    print "\n------------------\n";
    print @resultArcs,"**";
    print "\n------------------\n";
    print @resultPart;
}



#--------------------------------------------------------------------------------
# バグ回避，全ラベルを小文字に変換＋同一名の統一
sub transformSmallLetter {
    ($fin, $fout) = @_;
    my @vert, @arcs;
    @vert = ();
    @arcs = ();

    open IN, $fin or die "file open error : $fin";
    while ($line = <IN>) {
        if ($line =~ /^\*Vertices.*/) { last; }
    }
    while ($line = <IN>) {
        if($line =~ /^\*Arcs/) { last; }
        push(@vert, $line);
    }
    #print @resultVert, "\n--------\n";

    while($line = <IN>) {
        if($line =~ /^\*Partition.*/) { last; }
        push(@arcs, $line);
    }
    #print @resultArcs, "\n--------\n";
    #print $#vert, "\n", $#arcs, "\n";
    
    # オーダーを抑えるためにあらかじめソーティング
    orderByArrayStr(\@vert, 1, 'ASC');

    # メイン処理
    my @resv, @resa;
    @resv = ();
    @resa = ();
    for ($i = 0; $i <= $#vert; $i++) {
        my($p1, $name1) = split / /, @vert[$i];
        my($p2, $name2) = split / /, @vert[$i+1];

        # 同一名を発見した場合はArcsの修正を行う
        if (lc $name1 eq lc $name2) {
            #print "------------";
            #print "[",$name1,"]", $i,"\n";


            for ($j = 0; $j <= $#arcs; $j++) {
                my ($arc1, $arc2, $val) = split / /, @arcs[$j];

                if (($p2 eq $arc1) and ($p2 eq $arc2)) {
                    @arcs[$j] = "_$p1 _$p1 $val";
                }
                elsif ($p2 eq $arc1) {
                    @arcs[$j] = "_$p1 $arc2 $val";
                }
                elsif ($p2 eq $arc2) {
                    @arcs[$j] = "$arc1 _$p1 $val";
                }
                else {
                    @arcs[$j] = "$arc1 $arc2 $val";
                }
            }
            #print @arcs, "&&&&&&&&&&&\n";

            # _ のトリミング
            for ($j = 0; $j <= $#arcs; $j++) {
                @arcs[$j] =~ tr/_//d;
            }

            $i++;
        }
        $n = lc $name1;
        push(@resv, "$p1 $n");
    }
    @resa = @arcs;

    
    #print "!!!!!!!!!!!!-----\n";
    #print "------------\n";
    #print @resv, "------------\n";
    #print @resa, "------------\n";

    #書き出し
    open DATA, ">$fout" or die "cannot open savefile.";
    my $fh = DATA;
    my $max = $#resv+1;
    print $fh "*Vertices $max\n", @resv;
    print $fh "*Arcs\n", @resa;
    close ($fh);
}

#--------------------------------------------------------------------------------
# 2ネットワークのマージング
sub merge {
    ($netfile1, $netfile2) = @_;
    my $no1,$no2,$name1,$name2;

#    print $netfile1, $netfile2;
    # result のスタック
    $vertMax = 0;

    open NET2, $netfile2 or die "file open error : $netfile2";
    $line2 = <NET2>;

    while($line2 = <NET2>) {

        if($line2 =~ /^\*Arcs/) {
            last;
        }
        push(@resultVert, $line2);
        $vertMax = $vertMax+1;

        my($no2, $name2) = split / /, $line2;
        push(@resultPart, "1 $name2");
    }
    #print @resultVert, "\n--------\n";


    while($line2 = <NET2>) {
        push(@resultArcs, $line2);
    }
    #print @resultArcs, "\n--------\n";


    # arcs1 のスタック
    open NET1, $netfile1 or die "file open error : $netfile1";
    while($line1 = <NET1>) {
        if($line1 =~ /^\*Arcs/) {
            last;
        }
    }
    # ナンバーを負数にしてスタック（重複回避）
    while($line1 = <NET1>) {
        my($arc1, $arc2, $val) = split / /, $line1;
        $arc1*=-1;
        $arc2*=-1;
        push(@arcList, "$arc1 $arc2 $val");
    }


    #--------------------
    open NET1, $netfile1 or die "file open error : $netfile1";
    $line1 = <NET1>;

    while($line1 = <NET1>) {
        if($line1 =~ /^\*Arcs/) {
            last;
        }
        my($no1, $name1) = split / /, $line1;

        #--------------------
        open NET2, $netfile2 or die "file open error : $netfile2";
        $line2 = <NET2>;
        $flag = 1;
        while($line2 = <NET2>) {
            if($line2 =~ /^\*Arcs/) {
                last;
            }
            my($no2, $name2) = split / /, $line2;

            #print $name1, " ", $name2, "\n";

            # 一致ユーザー発見
            if ($name1 eq $name2) {
                #print "00 ", $no2, $name2,":",  $flag;


                # arcs 探索
                for ($i = 0; $i <= $#arcList; $i++) {
                    my($arc1, $arc2, $val) = split / /, @arcList[$i];
                    ##print "__ ", $arc1," ", $arc2, "\n";
                    if (($no1 eq -1*$arc1) and ($no1 eq -1*$arc2)) {
                        @arcList[$i] = "$no2 $no2 $val";
                    }
                    elsif ($no1 eq -1*$arc1) {
                        @arcList[$i] = "$no2 $arc2 $val";
                    }
                    elsif ($no1 eq -1*$arc2) {
                        @arcList[$i] = "$arc1 $no2 $val";
                    }
                }
                $flag = 0;

                push(@resultPart, "3 $name1");
            }
        }
        #print "[", @resultPart, "]\n";
        # ユニークユーザ
        if ($flag) {
            $no1 *= -1;
            push(@resultVert, "$no1 $name1");
            push(@resultPart, "2 $name1");
        }
    }
    push(@resultArcs, @arcList);

    if (0) {
        print "\n------------------\n";
        print @resultVert;
        print "\n------------------\n";
        print @resultArcs,"**";
        print "\n------------------\n";
        print @resultPart;
    }
}



# 名前でソートしてrenumbering
sub renumbering {
    my @tmp =();

    # 名前順でソート
    orderByArrayStr(\@resultVert, 1, 'ASC');

    # verticies の全探索
    for ($i = 1; $i <= $#resultVert+1; $i++) {
        my($number, $name) = split / /, @resultVert[$i-1];

        @resultVert[$i-1] = "$i $name";

        for ($j = 0; $j <= $#resultArcs; $j++) {
            my($no1, $no2, $val) = split / /, @resultArcs[$j];
            #print "|",$no1, " ", $no2, " ", $number, " ", $i, ":", $val;

            # arcs 側の置換（重複回避のための _ を追記）
            if (($no1 eq $number) and ($no2 eq $number)) {
                @resultArcs[$j] = "_$i _$i $val";
            }
            elsif ($no1 eq $number) {
                @resultArcs[$j] = "_$i $no2 $val";
            }
            elsif ($no2 eq $number) {
                @resultArcs[$j] = "$no1 _$i $val";
            }
        }
    }  
    # _ のトリミング
    for ($i = 0; $i <= $#resultArcs; $i++) {
        @resultArcs[$i] =~ tr/_//d;
    }

    # arcs のソート
    orderByArrayNum(\@resultArcs, 1, 'ASC');
    orderByArrayNum(\@resultArcs, 0, 'ASC');

}


# Partition情報の整形（重複の削除）
sub prepPartition {
    my @tmp = ();
    orderByArrayNum(\@resultPart, 0, 'DESC');
    orderByArrayStr(\@resultPart, 1, 'ASC');

    for ($i = 0; $i <= $#resultPart; $i++) {
        my($p1, $name1) = split / /, @resultPart[$i];
        my($p2, $name2) = split / /, @resultPart[$i+1];

        if ($name1 eq $name2) {
            $i++;
        }
        push(@tmp, "$p1 $name1");

    }
    @resultPart = @tmp;
    
    # 名前の削除
    for ($i = 0; $i <= $#resultPart; $i++) {
        @resultPart[$i] =~ s/ .*//g
    }

    #print @resultPart, "----\n";
    #print @resultVert, "----\n";
    #print @resultArcs, "----\n";

}



#----------------------
#数値ソート
#----------------------
sub orderByArrayNum{
  my $data = shift;      #配列の参照
  my $key = shift || 0;    #ソートするキー
  my $set = shift || 'DESC';  #昇順or降順
  my @tmp = ();
  
  #-- 一時配列にキーを取り出す --#
  @tmp = map {(split / /)[$key]} @$data;

  #-- ソート開始 --#
  if( $set eq 'ASC' ){
    @$data = @$data[sort {$tmp[$a] <=> $tmp[$b]} 0 .. $#tmp];
  }
  else{
    @$data = @$data[sort {$tmp[$b] <=> $tmp[$a]} 0 .. $#tmp];
  }

}



#----------------------
#文字列ソート
#----------------------
sub orderByArrayStr{
  my $data = shift;      #配列の参照
  my $key = shift || 0;    #ソートするキー
  my $set = shift || 'DESC';  #昇順or降順
  my @tmp = ();
  
  #-- 一時配列にキーを取り出す --#
  @tmp = map {(split / /)[$key]} @$data;

  #-- ソート開始 --#
  if( $set eq 'ASC' ){
    @$data = @$data[sort {lc $tmp[$a] cmp lc $tmp[$b]} 0 .. $#tmp];
  }
  else{
    @$data = @$data[sort {lc $tmp[$b] cmp lc $tmp[$a]} 0 .. $#tmp];
  }

}






# Arcs データの重複を和に変更
sub sumArcs {
    @tmp = ();
    for ($i = 0; $i <= $#resultArcs; $i++) {
        my($no1a, $no2a, $vala) = split / /, @resultArcs[$i];
        my($no1b, $no2b, $valb) = split / /, @resultArcs[$i+1];

        if (($no1a == $no1b) and ($no2a == $no2b)) {
            $vala += $valb;

            push(@tmp, "$no1a $no2a $vala\n");
            $i++;
        }
        else {
            push(@tmp, "$no1a $no2a $vala");
        }

    }
    @resultArcs = @tmp;

#    print @resultVert;
#    print @resultArcs;

}

# 0 を含むArcsを除去する（本来不要，.net ファイルのバグ回避）
sub trimZero {
    for ($i = 0; $i <= $#resultArcs; $i++) {
        my($no1a, $no2a, $vala) = split / /, @resultArcs[$i];
        if ($no1a == 0) {
            @resultArcs[$i] = " $no2a $vala";
        }
    }
}

sub writefile {
    ($filename) = @_;
    $filename =~ s/$/.paj/;
    $filename =~ s/^/merge_/;

    open DATA, ">$filename" or die "cannot open savefile.";
    $fh = DATA;
    $max = $#resultVert+1;
    print $fh "*Network $filename\n", "*Vertices $max\n", @resultVert;
    print $fh "*Arcs\n", @resultArcs;
    print $fh "*Partition $filename\n", "*Vertices $max\n", @resultPart;
    close ($fh);
}