view release on metacpan or  search on metacpan

scripts/colpairs  view on Meta::CPAN

    push @out , UNDERLINE('q_value') if 0.9 < ($o{v}//'1')  ; 
    say join "\t" , @out ; 

    # 出力表の各行
    my $cell ; # $cell -> [] [] 
    for my $i ( 0 .. $cols - 1 ) { 
        my @out = () ;
        push @out , ($i+1) . ':' ;

        # 左下
        for my $j ( 0 .. $i - 1 ) { 
            my $val = do { my $t = pickN 1, ( qval $pf -> [$j][$i] ) ; $t =~ s/\t/|/r } ; 
            push @out , $val ;
        }
        # 対角線
        my $val = join'-',(min values%{$pf->[$i][$i]}),(midval $pf->[$i][$i]),(max values%{$pf->[$i][$i]}) ; 
        push @out , BRIGHT_GREEN $val ; 

        # 右上
        for my $j ( $i+1 .. $cols -1 ) { 
            my ( $val ) ; # セルの一つの値
            my @tmp ;
            push @tmp , min values %{ $pf->[$i][$j] } ;
            push @tmp , midval $pf->[$i][$j]  ; 
            push @tmp , max values %{ $pf->[$i][$j] }  ; 
            $val = join "-" , @tmp ; 
            push @out , $val ;
        }

        push @out , YELLOW $heads [$i] ; 
        #push @out , UNDERLINE('most_freq') if 0.9 < ($o{v}//'1')  ; 
        push @out , join "\t" , pickN $o{m}, @{[ map { tabsplit1 $_ } qval $pf->[$i][$i] ]} if 0.9 < ($o{v}//'1')  ; 

        print join "\t" , @out ;
        print "\n" ; 
    }
}

# 非決定性
sub nonDeterminability ( $$ ) { 
    my $cnt = 0 ;
    my $pfij = $pf -> [ $_[0] ][ $_[1] ] ; 

    for ( keys %{ $pfij } ) { # $pfijv
        if ( 1 < scalar keys %{ $pfij -> { $_ } } ) { 
        	$cnt ++ ; 
        	push @{ $pfijv -> [ $_[0] ] [ $_[1] ] } , $_ ; # <-- なんか難しいかも
        }
    }
    return $cnt ; 
}

sub showing3 ( ) { 
    my $cols = @{ $pf } ; 
    @heads = ( 1 .. $cols ) unless @heads ; #defined $cols
    my @diag = map { scalar keys %{ $pf -> [$_][$_]}}  0 .. $cols -1 ;

    # 出力表の表頭
    my @out = ( ( BOLD 'undec' ) , map { UNDERLINE $_ } 1 .. $cols ) ; 
    push @out , UNDERLINE YELLOW 'col_' . ($o{'='} ? 'name' : 'num')   ;
    push @out , UNDERLINE('value_not_determining_other_column_value') if 0.9 < ($o{v}//'1')  ; 
    say join "\t" , @out ; 

    # 出力表の各行
    my $cell ; # $cell -> [] [] 
    for my $i ( 0 .. $cols - 1 ) { 
        my @out = () ;
        push @out , ($i+1) . ':' ;

        # 左下
        my @o2 ; 
        for my $j ( 0 .. $cols - 1 ) { 
            my $val =  nonDeterminability ( $i , $j ) ; 
            push @o2 , $val ;
        }
        my $tmp = ( min grep { $_ != 0 } @o2 ) // '0' ; 
        my $posj ; # どこで最小値となったのか
        do { $o2[$_] == $tmp and $o2[$_] = BOLD $o2[$_] and $posj //= $_ } for 0 .. $#o2 ; 

        push @out , @o2 ;
        push @out , YELLOW $heads [$i] ; # 列名または列番号を挿入
        my @o3 = sort {  keys %{$pf->[$i][$posj]{$b}}  <=> keys %{$pf->[$i][$posj]{$a}} || $a cmp $b }  @{ $pfijv->[$i][$posj] } ;
        $_ = $_ . FAINT '(' .  (keys $pf->[$i][$posj]{$_} ) .')' for @o3 ; 
        push @out , pickN $o{m}, @o3 ; # @{ $pfijv->[$i][$posj] } ;


        say join "\t" , @out ;

        next ;
        # 対角線の部分
        # push @out, color('bright_green') . (scalar keys %{$pf->[$i][$i]}) . color('reset') ; 
        push @out, 0 ; 

        # 右上
        for my $j ( $i+1 .. $cols -1 ) { 
            my $val =  nonDeterminability ( $i , $j ) ; 
            push @out , $val ;
        }

        push @out , YELLOW $heads [$i] ; 
        say join "\t" , @out ; next ;
    }
}


sub showing4 ( ) { 
    my $cols = @{ $tf } ; 
    @heads = ( 1 .. $cols ) unless @heads ; #defined $cols
    my @diag = map { scalar keys %{ $tf -> [$_][$_][$_]}}  0 .. $cols -1 ;

    # 出力表の表頭
    print GREEN join ("\t" , "wC" , 1 .. $cols , "dis") , "\n" ; 

    # 出力表の各行
    my $cell ; # $cell -> [] [] 
    for my $i ( 0 .. $cols - 1 ) { 
        my @out = () ;
        push @out , color('green') . ($i+1) . color('reset') ;

        # 左下
        for my $j ( 0 .. $i - 1 ) {