예제 #1
0
/* wrapper for calc_pairprob_condindep */
void R_calc_pairprob_condindep(int *n_ind, int *n_pos, int *n_gen,
                               double *genoprob, double *pairprob)
{
    double ***Genoprob, *****Pairprob;

    reorg_genoprob(*n_ind, *n_pos, *n_gen, genoprob, &Genoprob);

    reorg_pairprob(*n_ind, *n_pos, *n_gen, pairprob, &Pairprob);

    calc_pairprob_condindep(*n_ind, *n_pos, *n_gen,
                            Genoprob, Pairprob);
}
예제 #2
0
void R_scantwo_1chr_em(int *n_ind, int *n_pos, int *n_gen,
		       double *pairprob, double *addcov, int *n_addcov, 
		       double *intcov, int *n_intcov, 
		       double *pheno, double *weights, double *result,
		       int *maxit, double *tol, int *verbose,
		       int *n_col2drop, int *col2drop)
{
  double **Result, **Addcov=0, **Intcov=0, *****Pairprob;

  reorg_pairprob(*n_ind, *n_pos, *n_gen, pairprob, &Pairprob);
  reorg_errlod(*n_pos, *n_pos, result, &Result);

  /* reorganize addcov and intcov (if they are not empty) */
  if(*n_addcov > 0) reorg_errlod(*n_ind, *n_addcov, addcov, &Addcov);
  if(*n_intcov > 0) reorg_errlod(*n_ind, *n_intcov, intcov, &Intcov);

  scantwo_1chr_em(*n_ind, *n_pos, *n_gen, Pairprob, 
		  Addcov, *n_addcov, Intcov, *n_intcov, 
		  pheno, weights, Result, *maxit, *tol, *verbose,
		  *n_col2drop, col2drop);
}
예제 #3
0
void R_scantwo_1chr_hk(int *n_ind, int *n_pos, int *n_gen,
                       double *genoprob, double *pairprob,
                       double *addcov, int *n_addcov,
                       double *intcov, int *n_intcov,
                       double *pheno, int* nphe, double *weights,
                       double *result, int *n_col2drop, int *col2drop)
{
    double ***Genoprob, ***Result, **Addcov=0, **Intcov=0, *****Pairprob;

    reorg_genoprob(*n_ind, *n_pos, *n_gen, genoprob, &Genoprob);
    reorg_pairprob(*n_ind, *n_pos, *n_gen, pairprob, &Pairprob);
    reorg_genoprob(*n_pos, *n_pos, *nphe, result, &Result);

    /* reorganize addcov and intcov (if they are not empty) */
    if(*n_addcov > 0) reorg_errlod(*n_ind, *n_addcov, addcov, &Addcov);
    if(*n_intcov > 0) reorg_errlod(*n_ind, *n_intcov, intcov, &Intcov);

    scantwo_1chr_hk(*n_ind, *n_pos, *n_gen, Genoprob, Pairprob,
                    Addcov, *n_addcov, Intcov, *n_intcov,
                    pheno, *nphe, weights, Result, *n_col2drop,
                    col2drop);
}
예제 #4
0
void calc_pairprob(int n_ind, int n_pos, int n_gen, int *geno,
                   double *rf, double *rf2,
                   double error_prob, double *genoprob,
                   double *pairprob,
                   double initf(int, int *),
                   double emitf(int, int, double, int *),
                   double stepf(int, int, double, double, int *))
{
    int i, j, j2, v, v2, v3;
    double s=0.0, **alpha, **beta;
    int **Geno;
    double ***Genoprob, *****Pairprob;
    int cross_scheme[2];

    /* cross scheme hidden in genoprob argument; used by hmm_bcsft */
    cross_scheme[0] = genoprob[0];
    cross_scheme[1] = genoprob[1];
    genoprob[0] = 0.0;
    genoprob[1] = 0.0;

    /* n_pos must be at least 2, or there are no pairs! */
    if(n_pos < 2) error("n_pos must be > 1 in calc_pairprob");

    /* allocate space for alpha and beta and
       reorganize geno, genoprob, and pairprob */
    reorg_geno(n_ind, n_pos, geno, &Geno);
    reorg_genoprob(n_ind, n_pos, n_gen, genoprob, &Genoprob);
    reorg_pairprob(n_ind, n_pos, n_gen, pairprob, &Pairprob);
    allocate_alpha(n_pos, n_gen, &alpha);
    allocate_alpha(n_pos, n_gen, &beta);

    for(i=0; i<n_ind; i++) { /* i = individual */

        R_CheckUserInterrupt(); /* check for ^C */

        /* initialize alpha and beta */
        for(v=0; v<n_gen; v++) {
            alpha[v][0] = initf(v+1, cross_scheme) + emitf(Geno[0][i], v+1, error_prob, cross_scheme);
            beta[v][n_pos-1] = 0.0;
        }

        /* forward-backward equations */
        for(j=1,j2=n_pos-2; j<n_pos; j++, j2--) {

            for(v=0; v<n_gen; v++) {
                alpha[v][j] = alpha[0][j-1] + stepf(1, v+1, rf[j-1], rf2[j-1], cross_scheme);

                beta[v][j2] = beta[0][j2+1] + stepf(v+1,1,rf[j2], rf2[j2], cross_scheme) +
                    emitf(Geno[j2+1][i],1,error_prob, cross_scheme);

                for(v2=1; v2<n_gen; v2++) {
                    alpha[v][j] = addlog(alpha[v][j], alpha[v2][j-1] +
                                         stepf(v2+1,v+1,rf[j-1],rf2[j-1], cross_scheme));
                    beta[v][j2] = addlog(beta[v][j2], beta[v2][j2+1] +
                                         stepf(v+1,v2+1,rf[j2],rf2[j2], cross_scheme) +
                                         emitf(Geno[j2+1][i],v2+1,error_prob, cross_scheme));
                }

                alpha[v][j] += emitf(Geno[j][i],v+1,error_prob, cross_scheme);
            }
        }

        /* calculate genotype probabilities */
        for(j=0; j<n_pos; j++) {
            s = Genoprob[0][j][i] = alpha[0][j] + beta[0][j];
            for(v=1; v<n_gen; v++) {
                Genoprob[v][j][i] = alpha[v][j] + beta[v][j];
                s = addlog(s, Genoprob[v][j][i]);
            }
            for(v=0; v<n_gen; v++)
                Genoprob[v][j][i] = exp(Genoprob[v][j][i] - s);
        }

        /* calculate Pr(G[j], G[j+1] | marker data) for i = 1...n_pos-1 */
        for(j=0; j<n_pos-1; j++) {
            for(v=0; v<n_gen; v++) {
                for(v2=0; v2<n_gen; v2++) {
                    Pairprob[v][v2][j][j+1][i] = alpha[v][j] + beta[v2][j+1] +
                        stepf(v+1,v2+1,rf[j],rf2[j], cross_scheme) +
                        emitf(Geno[j+1][i],v2+1,error_prob, cross_scheme);
                    if(v==0 && v2==0) s=Pairprob[v][v2][j][j+1][i];
                    else s = addlog(s,Pairprob[v][v2][j][j+1][i]);
                }
            }
            /* scale to sum to 1 */
            for(v=0; v<n_gen; v++)
                for(v2=0; v2<n_gen; v2++)
                    Pairprob[v][v2][j][j+1][i] =
                        exp(Pairprob[v][v2][j][j+1][i] - s);
        }

        /* now calculate Pr(G[i], G[j] | marker data) for j > i+1 */
        for(j=0; j<n_pos-2; j++) {
            for(j2=j+2; j2<n_pos; j2++) {

                for(v=0; v<n_gen; v++) { /* genotype at pos'n j */
                    for(v2=0; v2<n_gen; v2++) { /* genotype at pos'n j2 */

                        Pairprob[v][v2][j][j2][i] = 0.0;

                        for(v3=0; v3<n_gen; v3++) { /* genotype at pos'n j2-1 */
                            s = Genoprob[v3][j2-1][i];
                            if(fabs(s) > TOL) /* avoid 0/0 */
                                Pairprob[v][v2][j][j2][i] += Pairprob[v][v3][j][j2-1][i]*
                                    Pairprob[v3][v2][j2-1][j2][i]/s;
                        }

                    }
                } /* end loops over genotypes */

            }
        } /* end loops over pairs of positions */

    } /* end loop over individuals */
}