Example #1
0
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;
}
Example #2
0
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;
}
Example #3
0
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";
    }
}
Example #4
0
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");
		} 
}



}