double boxcox_method::run(const snp_row &row1, const snp_row &row2, float *output)
{
arma::uvec missing = get_data( )->missing;
m_model_matrix.update_matrix( row1, row2, missing );
set_num_ok_samples( missing.n_elem - sum( missing ) );
double max_logl = -DBL_MAX;
int best_index = -1;
for(int i = 0; i < m_model.size( ); i++)
{
glm_info null_info;
glm_fit( m_model_matrix.get_null( ), m_fixed_pheno, missing, *m_model[ i ], null_info );
if( !null_info.success )
{
continue;
}
if( null_info.logl > max_logl )
{
max_logl = null_info.logl;
best_index = i;
}
}
if( best_index == -1 )
{
return -9;
}
/* Fit alternative model and test against best null */
glm_info alt_info;
glm_fit( m_model_matrix.get_alt( ), m_fixed_pheno, missing, *m_model[ best_index ], alt_info );
if( alt_info.success )
{
try
{
double LR = -2 * ( max_logl - alt_info.logl );
double p = 1.0 - chi_square_cdf( LR, m_model_matrix.num_df( ) );
output[ 0 ] = m_lambda[ best_index ];
if( std::abs( m_lambda[ best_index ] ) < 1e-5 )
{
output[ 0 ] = 0.0;
}
output[ 1 ] = LR;
output[ 2 ] = p;
return p;
}
catch(bad_domain_value &e)
{
}
}
return -9;
}
double glm_method::run(const snp_row &row1, const snp_row &row2, float *output)
{
arma::uvec missing = get_data( )->missing;
m_model_matrix.update_matrix( row1, row2, missing );
glm_info null_info;
arma::vec b1 = glm_fit( m_model_matrix.get_null( ), get_data( )->phenotype, missing, m_model, null_info, get_data( )->fast_inversion );
glm_info alt_info;
arma::vec b = glm_fit( m_model_matrix.get_alt( ), get_data( )->phenotype, missing, m_model, alt_info, get_data( )->fast_inversion );
set_num_ok_samples( missing.n_elem - sum( missing ) );
if( null_info.success && alt_info.success )
{
double LR = -2 * ( null_info.logl - alt_info.logl );
try
{
output[ 0 ] = LR;
output[ 1 ] = 1.0 - chi_square_cdf( LR, m_model_matrix.num_df( ) );
return output[ 1 ];
}
catch(bad_domain_value &e)
{
}
}
return -9;
}
void lm_env_stepwise::run(const snp_row &row, std::ostream &output)
{
arma::uvec missing = get_data( )->missing;
bool valid;
init_matrix_with_snp( row, missing, &valid );
normal model( "identity" );
glm_info null_info;
glm_fit( m_null_matrix, get_data( )->phenotype, missing, model, null_info );
glm_info snp_info;
glm_fit( m_snp_matrix, get_data( )->phenotype, missing, model, snp_info );
glm_info env_info;
glm_fit( m_env_matrix, get_data( )->phenotype, missing, model, env_info );
glm_info add_info;
glm_fit( m_add_matrix, get_data( )->phenotype, missing, model, add_info );
glm_info alt_info;
glm_fit( m_alt_matrix, get_data( )->phenotype, missing, model, alt_info );
if( null_info.success && snp_info.success && env_info.success && add_info.success && alt_info.success && valid )
{
try
{
double LR_null = -2 *( null_info.logl - alt_info.logl );
double p_null = 1.0 - chi_square_cdf( LR_null, m_alt_matrix.n_cols - m_null_matrix.n_cols );
double LR_snp = -2 *( snp_info.logl - alt_info.logl );
double p_snp = 1.0 - chi_square_cdf( LR_snp, m_alt_matrix.n_cols - m_snp_matrix.n_cols );
double LR_env = -2 *( env_info.logl - alt_info.logl );
double p_env = 1.0 - chi_square_cdf( LR_env, m_alt_matrix.n_cols - m_env_matrix.n_cols );
double LR_add = -2 *( add_info.logl - alt_info.logl );
double p_add = 1.0 - chi_square_cdf( LR_add, m_alt_matrix.n_cols - m_add_matrix.n_cols );
output << p_null << "\t" << p_snp << "\t" << p_env << "\t" << p_add << "\t";
}
catch(bad_domain_value &e)
{
output << "NA\tNA\tNA\tNA\t";
}
}
else
{
output << "NA\tNA\tNA\tNA\t";
}
}
int pglm_fit(int *Rfamily, int *RN, int* RM, const double *y, const double *prior, const double * offset, const double *X, const int *stratum, int *Rinit,int *rank, double *Xb, double *fitted, double *resid, double *weights, double *scale, int *df_resid, double *Rtheta){
int N=*RN;
int M=*RM;
int maxit=25;
double conv=0.00001;
int init=*Rinit;
int failure=0;
int family=*Rfamily;
double theta=*Rtheta;
if(family==0){
failure=glm_nb(N, M, 1,y, prior, offset, X,stratum, maxit, conv,init,
rank,Xb,fitted, resid, weights,
scale, df_resid, Rtheta);
if (failure == 1) {
// Rprintf("Glm.nb : Failure to converge\n");
}
} else if(family==2){
failure=glm_fit(POISSON, LOG, N, M, 1,y, prior, offset, X,stratum, maxit, conv,init,
rank,Xb,fitted, resid, weights,
scale, df_resid, theta);
if (failure == 1) {
// Rprintf("Poisson : Failure to converge\n");
}
} else if(family==1){
failure=glm_fit(BINOMIAL, LOGIT, N, M, 1,y, prior, offset, X,stratum, maxit, conv,init,
rank,Xb,fitted, resid, weights,
scale, df_resid, theta);
if (failure == 1) {
// Rprintf("Binomial : Failure to converge\n");
}
}
}
