view release on metacpan or  search on metacpan

lib/CohortExplorer/Command/Query/Compare.pm  view on Meta::CPAN

package CohortExplorer::Command::Query::Compare;

use strict;
use warnings;

our $VERSION = 0.14;

use base qw(CohortExplorer::Command::Query);
use CLI::Framework::Exceptions qw( :all );

#-------
# Command is only available to longitudinal datasources
sub usage_text {
 q\
     compare [--out|o=<directory>] [--export|e=<table>] [--export-all|a] [--save-command|s] [--stats|S] [--cond|c=<cond>]
             [variable] : compare entities across visits with/without conditions on variables


     NOTES
       The variables entity_id and visit (if applicable) must not be provided as arguments as they are already part of the
       query-set. However, the user can impose conditions on both variables.

       Other variables in arguments/cond (option) must be referenced as <table>.<variable> or <visit>.<table>.<variable>
       where visit can be vAny, vLast, v1, v2, v3 ... vMax. Here vMax is the maximum visit number for which data is
       available.

       Conditions can be imposed using the operators: =, !=, >, <, >=, <=, between, not_between, like, not_like, ilike, in,
       not_in, regexp and not_regexp. The keyword undef can be used to specify null.

       When condition is imposed on variable with no prefix such as vAny, vLast, v1, v2 and v3 the command assumes the
       condition applies to all visits of the variable.

       The directory specified in 'out' option must have RWX enabled (i.e. chmod 777) for CohortExplorer.


     EXAMPLES
       compare --out=/home/user/exports --stats --save-command --cond=v1.CER.Score='>, 20' v1.SC.Date

       compare --out=/home/user/exports --export=CER --cond=SD.Sex='=, Male' v1.CER.Score v3.DIS.Status
 
       compare --out=/home/user/exports --export=CER --cond=v2.CER.Score'!=, undef' vLast.DIS.Status

       compare -o/home/user/exports -Ssa -c vLast.CER.Score='in, 25, 30, 40' DIS.Status 

       compare -o/home/user/exports -eCER -eSD -c vLast.CER.Score='between, 25, 30' DIS.Status

    \;
}

sub get_valid_variables {
 my ($self) = @_;
 my $ds = $self->cache->get('cache')->{datasource};
 return [ 'entity_id', keys %{ $ds->variable_info },
          @{ $ds->visit_variables } ];
}

sub create_query_params {
 my ( $self, $opts, @args ) = @_;
 my ( $ds, $csv ) = @{ $self->cache->get('cache') }{qw/datasource csv/};
 my $visit_info       = $ds->visit_info;
 my $dialect          = $ds->dialect;
 my $struct           = $ds->entity_structure;
 my %map              = @{ $struct->{-columns} };
 my $aliase_in_having = $dialect->aliase_in_having || undef;
 my $visit = $dialect->aggregate( "DISTINCT $map{visit} " 
                                 . ( $struct->{-order_by} ? " ORDER BY $struct->{-order_by} " : '' ), '@@' );
 
 my ( @vars, %param );
 # Extract all variables from args/cond (option) except
 # entity_id and visit as they are dealt separately
 my $visit_regex = join( '|', map { $visit_info->{$_}{name} } keys %$visit_info );
 
 for my $v ( @args, keys %{ $opts->{cond} } ) {
  $v =~ s/^(?:vLast|vAny|$visit_regex)\.//;
  if ( !grep ( $_ eq $v, ( 'entity_id', 'visit', @vars ) ) ) {
   push @vars, $v;
  }
 }
 
 for my $var (@vars) {
  ##---- BUILD 'WHERE' FOR TABLES AND VARIABLES ----##
  my ( $t, $v ) = @{ $ds->variable_info->{$var} }{qw/table variable/};
  my $table_type = $ds->table_info->{$t}{__type__};
  
  push @{ $param{$table_type}{-where}{ $map{table} }{-in} },    $t;
  push @{ $param{$table_type}{-where}{ $map{variable} }{-in} }, $v;
  
  my $col_sql = 'CAST( NULLIF( '
    . $dialect->aggregate(
       (
        ( $table_type eq 'static' ? 'DISTINCT' : '' )
        . " CASE WHEN CONCAT( $map{table}, '.', $map{variable} ) " 
        . (