#
#	pajekのネットワークファイル（.netファイル）を整形
#		author	shinsuke-m
#		date	
#
#		◇入力
#		       .netファイル
#		◇出力
#		       ソート＋整形済み.netファイル
#                      ファイル名は 入力名_sort.net
#
#		◇使用法
#			コマンドラインで、以下のコマンドをたたく(要 Perl 5 以上)
#			perl fixnet.pl data1.net
#


    my @resultArcs = ();
    my @resultVert = ();


foreach $file (@ARGV) {

     @resultArcs = ();
     @resultVert = ();

    &readfile($file);


# 小文字に統一して再修正
#  単なるソートの場合は不要
#    &transformSmallLetter;
    
     &renumbering;
     &remove0arcs;
     &removeLoops;
    &writefile($file);
}


sub readfile {
    (my $fname) = @_;
    open NET2, $fname or die "file open error : $ARGV[0]";
    $line2 = <NET2>;
    while($line2 = <NET2>) {
        if($line2 =~ /^\*Arcs/) {
            last;
        }
        push(@resultVert, $line2);
        $vertMax = $vertMax+1;
    }
    #print @resultVert, "\n--------\n";

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

sub remove0arcs {
    @resa = ();
    for ($i = 1; $i <= $#resultArcs; $i++) {
        my($no1, $no2, $val) = split / /, @resultArcs[$i];
        if ($no1 == 0 or $no2 == 0 or $no1 == "" or $no2 == "") {
            next;
        }
        push @resa, @resultArcs[$i];

    }
    @resultArcs = @resa;
}


sub removeLoops {
    my @tmp;
    for ($i = 0; $i <= $#resultArcs; $i++) {
        my($arc1, $arc2, $val) = split / /, @resultArcs[$i];
        if ($arc1 eq $arc2) {
            
        }
        else {
            push(@tmp, "$arc1 $arc2 $val");
        }
    }
    #print @tmp;
    @resultArcs = @tmp;
}


# 名前でソートして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');
}








#--------------------------------------------------------------------------------
#--------------------------------------------------------------------------------
#--------------------------------------------------------------------------------

# バグ回避，全ラベルを小文字に変換＋同一名の統一
sub transformSmallLetter {
    # 名前順でソート
    orderByArrayStr(\@resultVert, 1, 'ASC');

    @vert = @resultVert;
    @arcs = @resultArcs;
    # メイン処理
    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;


    @resultVert = @resv;
    @resultArcs = @resa;
    #print "!!!!!!!!!!!!-----\n";
    #print "------------\n";
    #print @resv, "------------\n";
    #print @resa, "------------\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];
  }
}


#----------------------

sub writefile {

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