view release on metacpan or  search on metacpan

lib/Convert/Pheno/Audit/Terminology.pm  view on Meta::CPAN

    for my $index ( 0 .. $#COLUMNS ) {
        $audit->write_string( 0, $index, $COLUMNS[$index], $header_format );
    }
    $audit->freeze_panes( 1, 3 );
    $audit->set_selection( 1, 0 );
    $audit->set_zoom(85);

    my @widths = (
        8, 18, 25, 28, 28, 28, 18, 32, 22, 14,
        20, 20, 20, 18, 18, 16, 27, 29, 16, 20,
        17, 20, 32, 22, 17, 17,
    );
    for my $index ( 0 .. $#widths ) {
        $audit->set_column( $index, $index, $widths[$index] );
    }

    # Keep the default workbook focused on review while retaining all evidence
    # for users who choose to unhide the technical columns.
    my @hidden_columns = ( 6, 9 .. 15, 18 .. 21 );
    for my $index (@hidden_columns) {
        $audit->set_column( $index, $index, $widths[$index], undef, 1 );
    }

    $self->{format}               = 'xlsx';
    $self->{workbook}             = $workbook;
    $self->{summary_worksheet}    = $summary;
    $self->{audit_worksheet}      = $audit;
    $self->{header_format}        = $header_format;
    $self->{summary_label_format} = $summary_label_format;
    $self->{score_format}         = $score_format;
    $self->{row_format}           = \%row_format;
    $self->{legend_format}        = \%legend_format;
    $self->{next_xlsx_row}        = 1;
    return 1;
}

sub _write_xlsx_row {
    my ( $self, $row ) = @_;
    die "XLSX terminology audits support at most "
      . MAX_XLSX_DATA_ROWS
      . " decisions; use .tsv.gz for larger runs\n"
      if $self->{next_xlsx_row} > MAX_XLSX_DATA_ROWS;

    my $worksheet = $self->{audit_worksheet};
    my $xlsx_row = $self->{next_xlsx_row};

    for my $index ( 0 .. $#COLUMNS ) {
        my $column = $COLUMNS[$index];
        my $value = $row->{$column};
        next unless defined $value && length $value;

        if ( $NUMERIC_COLUMN{$column} && _is_number($value) ) {
            my $format =
              $column eq 'best_candidate_score' || $column eq 'score_margin'
              ? $self->{score_format}
              : undef;
            $worksheet->write_number( $xlsx_row, $index, $value, $format );
        }
        else {
            # Explicit string writes prevent source values beginning with '='
            # from being interpreted as spreadsheet formulas.
            $worksheet->write_string( $xlsx_row, $index, "$value" );
        }
    }

    $self->{next_xlsx_row}++;
    return 1;
}

sub _close_xlsx {
    my ($self) = @_;
    my $summary = $self->{summary_worksheet};
    my $config  = $self->{config};
    my $counts  = $self->{counts};

    my @summary_rows = (
        [ 'report_format',              'XLSX' ],
        [ 'configured_search_mode',     $config->{search} ],
        [ 'text_similarity_method',     $config->{text_similarity_method} ],
        [ 'min_text_similarity_score',  $config->{min_text_similarity_score} ],
        [ 'levenshtein_weight',         $config->{levenshtein_weight} ],
        [ 'total_decisions',            $self->{total_rows} ],
        [ 'exact_or_direct',            $counts->{resolved} ],
        [ 'similarity_review',          $counts->{review} ],
        [ 'unresolved',                 $counts->{unresolved} ],
        [ 'not_searched_or_source_fallback', $counts->{not_searched} ],
    );
    for my $index ( 0 .. $#summary_rows ) {
        $summary->write_string(
            $index + 1,
            0,
            $summary_rows[$index][0],
            $self->{summary_label_format},
        );
        my $value = $summary_rows[$index][1];
        if ( defined $value && _is_number($value) ) {
            $summary->write_number( $index + 1, 1, $value );
        }
        else {
            $summary->write_string( $index + 1, 1, defined $value ? "$value" : q{} );
        }
    }

    my $legend_row = @summary_rows + 3;
    $summary->write_string( $legend_row, 0, 'Review colors', $self->{summary_label_format} );
    my @legend = (
        [ resolved     => 'Exact, direct, or configured resolution' ],
        [ review       => 'Similarity or spelling result to review' ],
        [ unresolved   => 'No term emitted' ],
        [ not_searched => 'Not searched or source fallback' ],
    );
    for my $index ( 0 .. $#legend ) {
        my ( $category, $description ) = @{ $legend[$index] };
        $summary->write_string(
            $legend_row + $index + 1,
            0,
            $category,
            $self->{legend_format}{$category},
        );
        $summary->write_string( $legend_row + $index + 1, 1, $description );
    }
    $summary->write_string(
        $legend_row + @legend + 2,
        0,
        'Interpretation',
        $self->{summary_label_format},
    );
    $summary->write_string(
        $legend_row + @legend + 2,
        1,
        'Colors prioritize review; they do not measure clinical confidence.',
    );
    $summary->write_string(
        $legend_row + @legend + 4,
        0,
        'Workbook view',
        $self->{summary_label_format},
    );
    $summary->write_string(
        $legend_row + @legend + 4,
        1,
        'Technical audit columns are present but hidden by default.',
    );

    my $audit = $self->{audit_worksheet};
    $audit->autofilter( 0, 0, $self->{total_rows}, $#COLUMNS );
    if ( $self->{total_rows} ) {
        my $last_row = $self->{total_rows} + 1;
        my $range = "A2:Z$last_row";
        my @rules = (
            [ unresolved => '=$P2="not_found"' ],
            [ not_searched => '=OR($P2="not_searched",$Q2="source_fallback")' ],
            [ review => '=AND($P2<>"not_found",$P2<>"not_searched",$Q2<>"source_fallback",OR($T2="similarity",$V2="one_token_relaxed"))' ],
            [ resolved => '=AND($P2<>"not_found",$P2<>"not_searched",$Q2<>"source_fallback",$T2<>"similarity",$V2<>"one_token_relaxed")' ],
        );
        for my $rule (@rules) {
            $audit->conditional_formatting(
                $range,
                {
                    type     => 'formula',
                    criteria => $rule->[1],
                    format   => $self->{row_format}{ $rule->[0] },
                }
            );
        }
    }

    $self->{workbook}->close()
      or die "Failed to finalize XLSX terminology audit '$self->{path}'\n";
    return 1;
}

sub _review_category {
    my ($row) = @_;
    return 'unresolved' if ( $row->{match_status} // q{} ) eq 'not_found';
    return 'not_searched'
      if ( $row->{match_status} // q{} ) eq 'not_searched'
      || ( $row->{decision_reason} // q{} ) eq 'source_fallback';
    return 'review'
      if ( $row->{lookup_resolution} // q{} ) eq 'similarity'
      || ( $row->{retrieval_path} // q{} ) eq 'one_token_relaxed';
    return 'resolved';
}

sub _review_action {
    my ($row) = @_;
    my $category = _review_category($row);
    return 'keep'                       if $category eq 'resolved';
    return 'review_similarity'          if $category eq 'review';
    return 'resolve_or_accept_fallback' if $category eq 'unresolved';
    return 'review_source_fallback';
}

sub _tsv_field {
    my ($value) = @_;
    return q{} unless defined $value;
    $value =~ s/[\t\r\n]+/ /g;
    return $value;
}

sub _is_number {
    my ($value) = @_;
    return defined $value
      && $value =~ /\A[+-]?(?:\d+(?:\.\d*)?|\.\d+)(?:[Ee][+-]?\d+)?\z/;
}

1;