void marker_loglik(int n_ind, int n_gen, int *geno, double error_prob, double initf(int, int *), double emitf(int, int, double, int *), double *loglik) { int i, v; double temp; int cross_scheme[2]; /* cross scheme hidden in loglik argument; used by hmm_bcsft */ cross_scheme[0] = (int) ftrunc(*loglik / 1000.0); cross_scheme[1] = ((int) *loglik) - 1000 * cross_scheme[0]; *loglik = 0.0; for(i=0; i<n_ind; i++) { /* i = individual */ R_CheckUserInterrupt(); /* check for ^C */ temp = initf(1, cross_scheme) + emitf(geno[i], 1, error_prob, cross_scheme); for(v=1; v<n_gen; v++) temp = addlog(temp, initf(v+1, cross_scheme) + emitf(geno[i], v+1, error_prob, cross_scheme)); (*loglik) += temp; } }
void calc_markprob(int n_ind, int n_pos, int n_gen, int *geno, double *rf, double *rf2, double error_prob, double *markprob, double initf(int), double emitf(int, int, double), double stepf(int, int, double, double)) { int i, j, j2, v, v2; double **betal, **betar; /* betas for left and right sides of the chromosome */ int **Geno; double ***Markprob; /* allocate space for betal and betar and reorganize geno and markprob */ reorg_geno(n_ind, n_pos, geno, &Geno); reorg_genoprob(n_ind, n_pos, n_gen, markprob, &Markprob); allocate_alpha(n_pos, n_gen, &betal); allocate_alpha(n_pos, n_gen, &betar); for(i=0; i<n_ind; i++) { /* i = individual */ /* initialize betal and betar */ for(v=0; v<n_gen; v++) { betal[v][0] = 0.0; betar[v][n_pos-1] = 0.0; } /* backward equations */ for(j=1,j2=n_pos-2; j<n_pos; j++, j2--) { for(v=0; v<n_gen; v++) { betal[v][j] = betal[0][j-1] + stepf(v+1, 1, rf[j-1], rf2[j-1]) + emitf(Geno[j-1][i],1,error_prob); betar[v][j2] = betar[0][j2+1] + stepf(v+1,1,rf[j2], rf2[j2]) + emitf(Geno[j2+1][i],1,error_prob); for(v2=1; v2<n_gen; v2++) { betal[v][j] = addlog(betal[v][j], betal[v2][j-1] + stepf(v+1,v2+1,rf[j-1],rf2[j-1]) + emitf(Geno[j-1][i],v2+1,error_prob)); betar[v][j2] = addlog(betar[v][j2], betar[v2][j2+1] + stepf(v+1,v2+1,rf[j2],rf2[j2]) + emitf(Geno[j2+1][i],v2+1,error_prob)); } } } /* calculate genotype probabilities */ for(j=0; j<n_pos; j++) for(v=0; v<n_gen; v++) Markprob[v][j][i] = exp(betal[v][j] + betar[v][j] + emitf(Geno[j][i], v+1, error_prob)); } /* loop over individuals */ }
int compile(tree *t) { ncode = 100; codebuf = (code *)emalloc(ncode*sizeof codebuf[0]); codep = 0; emiti(0); /* reference count */ outcode(t, flag['e']?1:0); if(nerror){ efree((char *)codebuf); return 0; } readhere(); emitf(Xreturn); emitf(0); return 1; }
void marker_loglik(int n_ind, int n_gen, int *geno, double error_prob, double initf(int), double emitf(int, int, double), double *loglik) { int i, v; double temp; *loglik = 0.0; for(i=0; i<n_ind; i++) { /* i = individual */ R_CheckUserInterrupt(); /* check for ^C */ temp = initf(1) + emitf(geno[i], 1, error_prob); for(v=1; v<n_gen; v++) temp = addlog(temp, initf(v+1) + emitf(geno[i], v+1, error_prob)); (*loglik) += temp; } }
void backward_prob(int i, int n_mar, int n_gen, int curpos, int *cross_scheme, double error_prob, int **Geno, double **probmat, double **beta, double initf(int, int *), double emitf(int, int, double, int *)) { /* backward equations */ /* Note: true genotypes coded as 1, 2, ... but in the alpha's and beta's, we use 0, 1, ... */ /* could divide this into forward and backward, then use forward second time in est_map */ int j2,v,v2; double errortol,sbeta; /* initialize alpha and beta */ for(v=0; v<n_gen; v++) beta[v][n_mar-1] = 0.0; /* curpos = -1: use error_prob always */ /* curpos >= 0: use TOL except when j2+1 == curpos, then use error_prob */ errortol = error_prob; if(curpos >= 0) errortol = TOL; for(j2=n_mar-2; j2>=0; j2--) { if(curpos == j2+1) errortol = error_prob; for(v=0; v<n_gen; v++) { sbeta = beta[0][j2+1] + stepfc(v+1, 1, j2, probmat) + emitf(Geno[j2+1][i], 1, errortol, cross_scheme); for(v2=1; v2<n_gen; v2++) { sbeta = addlog(sbeta, beta[v2][j2+1] + stepfc(v+1, v2+1, j2, probmat) + emitf(Geno[j2+1][i], v2+1, errortol, cross_scheme)); } beta[v][j2] = sbeta; } if(curpos == j2+1) errortol = TOL; } }
void forward_prob(int i, int n_mar, int n_gen, int curpos, int *cross_scheme, double error_prob, int **Geno, double **probmat, double **alpha, double initf(int, int *), double emitf(int, int, double, int *)) { /* forward equations */ /* Note: true genotypes coded as 1, 2, ... but in the alpha's and beta's, we use 0, 1, ... */ int j,v,v2; double errortol,salpha; /* initialize alpha */ /* curpos = -1: use error_prob always */ /* curpos >= 0: use TOL except when j == curpos, then use error_prob */ errortol = error_prob; if(curpos > 0) errortol = TOL; for(v=0; v<n_gen; v++) alpha[v][0] = initf(v+1, cross_scheme) + emitf(Geno[0][i], v+1, errortol, cross_scheme); if(curpos == 0) errortol = TOL; for(j=1; j<n_mar; j++) { if(curpos == j) errortol = error_prob; for(v=0; v<n_gen; v++) { salpha = alpha[0][j-1] + stepfc(1, v+1, j-1, probmat); for(v2=1; v2<n_gen; v2++) salpha = addlog(salpha, alpha[v2][j-1] + stepfc(v2+1, v+1, j-1, probmat)); alpha[v][j] = salpha + emitf(Geno[j][i], v+1, errortol, cross_scheme); } if(curpos == j) errortol = TOL; } }
void codeswitch(tree *t, int eflag) { int leave; /* patch jump address to leave switch */ int out; /* jump here to leave switch */ int nextcase; /* patch jump address to next case */ tree *tt; if(c1->child[0]==nil || c1->child[0]->type!=';' || !iscase(c1->child[0]->child[0])){ yyerror("case missing in switch"); return; } emitf(Xmark); outcode(c0, eflag); emitf(Xjump); nextcase = emiti(0); out = emitf(Xjump); leave = emiti(0); stuffdot(nextcase); t = c1->child[0]; while(t->type==';'){ tt = c1; emitf(Xmark); for(t = c0->child[0];t->type==ARGLIST;t = c0) outcode(c1, eflag); emitf(Xcase); nextcase = emiti(0); t = tt; for(;;){ if(t->type==';'){ if(iscase(c0)) break; outcode(c0, eflag); t = c1; } else{ if(!iscase(t)) outcode(t, eflag); break; } } emitf(Xjump); emiti(out); stuffdot(nextcase); } stuffdot(leave); emitf(Xpopm); }
static void analop_esil(RAnal *a, RAnalOp *op, ut64 addr, const ut8 *buf) { r_strbuf_init (&op->esil); r_strbuf_set (&op->esil, ""); switch (buf[0]) { // Irregulars sorted by lower nibble case 0x00: /* nop */ emit (","); break; case 0x10: /* jbc bit, offset */ k (BIT_R "?{," BIT_MASK XI(BIT, "&") JMP ",}"); break; case 0x20: /* jb bit, offset */ k (BIT_R CJMP); break; case 0x30: /* jnb bit, offset */ k (BIT_R "!," CJMP); break; case 0x40: /* jc offset */ h ("c,1,&," CJMP); break; case 0x50: /* jnc offset */ h ("c,1,&,!," CJMP ); break; case 0x60: /* jz offset */ h ("a,0,==," CJMP); break; case 0x70: /* jnz offset */ h ("a,0,==,!," CJMP); break; case 0x11: case 0x31: case 0x51: case 0x71: case 0x91: case 0xB1: case 0xD1: case 0xF1: /* acall addr11 */ case 0x12: /* lcall addr16 */ j (CALL); /* fall through */ case 0x01: case 0x21: case 0x41: case 0x61: case 0x81: case 0xA1: case 0xC1: case 0xE1: /* ajmp addr11 */ case 0x02: /* ljmp addr16 */ case 0x80: /* sjmp offset */ j (JMP); break; case 0x22: /* ret */ case 0x32: /* reti */ emitf (POP2 "pc,="); break; case 0x03: /* rr a */ emit ("1,a,0x101,*,>>,a,=," FLAG_P); break; case 0x04: /* inc a */ h (XI(A, "++") FLAG_P); break; case 0x05: /* inc direct */ h (XI(IB1, "++")); break; case 0x06: case 0x07: /* inc @Ri */ j (XI(RI, "++")); break; case 0x08: case 0x09: case 0x0A: case 0x0B: case 0x0C: case 0x0D: case 0x0E: case 0x0F: /* dec @Rn */ h (XI(RN, "++")); break; case 0x13: /* rrc a */ emit ("7,c,<<,1,a,&,c,=,0x7f,1,a,>>,&,+,a,=," FLAG_P); break; case 0x14: /* dec a */ h (XI(A, "--") FLAG_P); break; case 0x15: /* dec direct */ h (XI(IB1, "--")); break; case 0x16: case 0x17: /* dec @Ri */ j (XI(RI, "--")); break; case 0x18: case 0x19: case 0x1A: case 0x1B: case 0x1C: case 0x1D: case 0x1E: case 0x1F: /* dec @Rn */ h (XI(RN, "--")); break; case 0x23: /* rl a */ h ("7,a,0x101,*,>>,a,=," FLAG_P); break; TEMPLATE_ALU (0x20, "+", FLAG_C FLAG_AC FLAG_OV FLAG_P) /* 0x24..0x2f add a,.. */ case 0x33: /* rlc a */ h ("c,1,&,a,a,+=,$c7,c,=,a,+=," FLAG_P); break; TEMPLATE_ALU_C (0x30, "+", FLAG_C FLAG_AC FLAG_OV FLAG_P) /* 0x34..0x2f addc a,.. */ case 0x42: /* orl direct, a */ h (XR(A) XI(IB1, "|")); break; case 0x43: /* orl direct, imm */ h (XR(L2) XI(IB1, "|")); break; TEMPLATE_ALU (0x40, "|", FLAG_P) /* 0x44..0x4f orl a,.. */ case 0x52: /* anl direct, a */ h (XR(A) XI(IB1, "&")); break; case 0x53: /* anl direct, imm */ h (XR(L2) XI(IB1, "&")); break; TEMPLATE_ALU (0x50, "&", FLAG_P) /* 0x54..0x5f anl a,.. */ case 0x62: /* xrl direct, a */ h (XR(A) XI(IB1, "^")); break; case 0x63: /* xrl direct, imm */ h (XR(L2) XI(IB1, "^")); break; TEMPLATE_ALU (0x60, "^", FLAG_P) /* 0x64..0x6f xrl a,.. */ case 0x72: /* orl C, bit */ k (BIT_R XI(C, "|")); break; case 0x73: /* jmp @a+dptr */ emit ("dptr,a,+,pc,="); break; case 0x74: /* mov a, imm */ h (XR(L1) XW(A) FLAG_P); break; case 0x75: /* mov direct, imm */ h (XR(L2) XW(IB1)); break; case 0x76: case 0x77: /* mov @Ri, imm */ j (XR(L1) XW(RI)); break; case 0x78: case 0x79: case 0x7A: case 0x7B: case 0x7C: case 0x7D: case 0x7E: case 0x7F: /* mov Rn, imm */ h (XR(L1) XW(RN)); break; case 0x82: /* anl C, bit */ k (BIT_R XI(C, "&")); break; case 0x83: /* movc a, @a+pc */ emit ("a,pc,--,+,[1]," XW(A) FLAG_P); break; case 0x84: /* div ab */ emit ("b,!,OV,=,0,a,b,a,/=,a,b,*,-,-,b,=,0,c,="); break; case 0x85: /* mov direct, direct */ h (XR(IB1) XW(IB2)); break; case 0x86: case 0x87: /* mov direct, @Ri */ j (XR(RI) XW(IB1)); break; case 0x88: case 0x89: case 0x8A: case 0x8B: case 0x8C: case 0x8D: case 0x8E: case 0x8F: /* mov direct, Rn */ h (XR(RN) XW(IB1)); break; case 0x90: /* mov dptr, imm */ h (XR(L16) XW(DP)); break; case 0x92: /* mov bit, C */ k (BIT_C BIT_MASK XR(BIT) "&,|," XW(BIT)); break; case 0x93: /* movc a, @a+dptr */ h ("a,dptr,+,[1]," XW(A) FLAG_P); break; TEMPLATE_ALU_C (0x90, "-", FLAG_B FLAG_AB FLAG_OB FLAG_P) /* 0x94..0x9f subb a,.. */ case 0xA0: /* orl C, /bit */ k (BIT_R "!," XI(C, "|")); break; case 0xA2: /* mov C, bit */ k (BIT_R XW(C)); break; case 0xA3: /* inc dptr */ h (XI(DP, "++")); break; case 0xA4: /* mul ab */ emit ("8,a,b,*,NUM,>>,NUM,!,!,ov,=,b,=,a,=,0,c,="); break; case 0xA5: /* "reserved" */ emit ("0,trap"); break; case 0xA6: case 0xA7: /* mov @Ri, direct */ j (XR(IB1) XW(RI)); break; case 0xA8: case 0xA9: case 0xAA: case 0xAB: case 0xAC: case 0xAD: case 0xAE: case 0xAF: /* mov Rn, direct */ h (XR(IB1) XW(RN)); break; case 0xB0: /* anl C, /bit */ k (BIT_R "!," XI(C, "&")); break; case 0xB2: /* cpl bit */ k (BIT_SET XI(BIT, "^")); break; case 0xB3: /* cpl C */ h ("1," XI(C, "^")); break; case 0xB4: /* cjne a, imm, offset */ h (XR(L1) XR(A) "-," CJMP); break; case 0xB5: /* cjne a, direct, offset */ h (XR(IB1) XR(A) "-," CJMP); break; case 0xB6: case 0xB7: /* cjne @ri, imm, offset */ j (XR(L1) XR(RI) "-," CJMP); break; case 0xB8: case 0xB9: case 0xBA: case 0xBB: case 0xBC: case 0xBD: case 0xBE: case 0xBF: /* cjne Rn, imm, offset */ h (XR(L1) XR(RN) "-," CJMP); break; case 0xC0: /* push direct */ h (XR(IB1) PUSH1); break; case 0xC2: /* clr bit */ k (BIT_MASK XI(BIT, "&")); break; case 0xC3: /* clr C */ h ("0," XW(C)); break; case 0xC4: /* swap a */ h ("0xff,4,a,0x101,*,>>,&," XW(A) FLAG_P); break; case 0xC5: /* xch a, direct */ h (XR(A) "0,+," XR(IB1) XW(A) XW(IB1) FLAG_P); break; case 0xC6: case 0xC7: /* xch a, @Ri */ j (XR(A) "0,+," XR(RI) XW(A) XW(RI) FLAG_P); break; case 0xC8: case 0xC9: case 0xCA: case 0xCB: case 0xCC: case 0xCD: case 0xCE: case 0xCF: /* xch a, Rn */ h (XR(A) "0,+," XR(RN) XW(A) XW(RN) FLAG_P); break; case 0xD0: /* pop direct */ h (POP1 XW(IB1)); break; case 0xD2: /* setb bit */ k (BIT_SET XI(BIT, "|")); break; case 0xD3: /* setb C */ h ("1," XW(C)); break; case 0xD4: /* da a */ // BCD adjust after add: // if (lower nibble > 9) or (AC == 1) add 6 // if (higher nibble > 9) or (C == 1) add 0x60 // carry |= carry caused by this operation emit ("a,0x0f,&,9,<,ac,|,?{,6,a,+=,$c7,c,|=,},a,0xf0,&,0x90,<,c,|,?{,0x60,a,+=,$c7,c,|=,}," FLAG_P); break; case 0xD5: /* djnz direct, offset */ h (XI(IB1, "--") XR(IB1) "0,==,!," CJMP); break; case 0xD6: case 0xD7: /* xchd a, @Ri*/ j (XR(A) "0xf0,&," XR(RI) "0x0f,&,|," XR(RI) "0xf0,&," XR(A) "0x0f,&,|," XW(RI) XW(A) FLAG_P); break; case 0xD8: case 0xD9: case 0xDA: case 0xDB: case 0xDC: case 0xDD: case 0xDE: case 0xDF: /* djnz Rn, offset */ h (XI(RN, "--") XR(RN) "0,==,!," CJMP); break; case 0xE0: /* movx a, @dptr */ h (XR(DPX) XW(A) FLAG_P); break; case 0xE2: case 0xE3: /* movx a, @Ri */ j (XR(R0X) XW(A) FLAG_P); break; case 0xE4: /* clr a */ emit ("0," XW(A) FLAG_P); break; case 0xE5: /* mov a, direct */ h (XR(IB1) XW(A) FLAG_P); break; case 0xE6: case 0xE7: /* mov a, @Ri */ j (XR(RI) XW(A) FLAG_P); break; case 0xE8: case 0xE9: case 0xEA: case 0xEB: case 0xEC: case 0xED: case 0xEE: case 0xEF: /* mov a, Rn */ h (XR(RN) XW(A) FLAG_P); break; case 0xF0: /* movx @dptr, a */ h (XR(A) XW(DPX)); break; case 0xF2: case 0xF3: /* movx @Ri, a */ j (XR(A) XW(R0X)); break; case 0xF4: /* cpl a */ h ("255," XI(A, "^") FLAG_P); break; case 0xF5: /* mov direct, a */ h (XR(A) XW(IB1)); break; case 0xF6: case 0xF7: /* mov @Ri, a */ j (XR(A) XW(RI)); break; case 0xF8: case 0xF9: case 0xFA: case 0xFB: case 0xFC: case 0xFD: case 0xFE: case 0xFF: /* mov Rn, a */ h (XR(A) XW(RN)); break; default: break; } }
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 */ }
void calc_genoprob(int n_ind, int n_pos, int n_gen, int *geno, double *rf, double *rf2, double error_prob, double *genoprob, double initf(int, int *), double emitf(int, int, double, int *), double stepf(int, int, double, double, int *)) { int i, j, j2, v, v2; double s, **alpha, **beta; int **Geno; double ***Genoprob; 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; /* allocate space for alpha and beta and reorganize geno and genoprob */ reorg_geno(n_ind, n_pos, geno, &Geno); reorg_genoprob(n_ind, n_pos, n_gen, genoprob, &Genoprob); 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); } /* the following is the old version */ /* for(j=0; j<n_pos; j++) { s = 0.0; for(v=0; v<n_gen; v++) s += (Genoprob[v][j][i] = exp(alpha[v][j] + beta[v][j])); for(v=0; v<n_gen; v++) Genoprob[v][j][i] /= s; } */ } /* loop over individuals */ }
void argmax_geno(int n_ind, int n_pos, int n_gen, int *geno, double *rf, double *rf2, double error_prob, int *argmax, double initf(int, int *), double emitf(int, int, double, int *), double stepf(int, int, double, double, int *)) { int i, j, v, v2; double s, t, *gamma, *tempgamma, *tempgamma2; int **Geno, **Argmax, **traceback; int cross_scheme[2]; /* cross scheme hidden in argmax argument; used by hmm_bcsft */ cross_scheme[0] = argmax[0]; cross_scheme[1] = argmax[1]; argmax[0] = geno[0]; argmax[1] = geno[1]; /* Read R's random seed */ /* in the case of multiple "most likely" genotype sequences, we pick from them at random */ GetRNGstate(); /* allocate space and reorganize geno and argmax */ reorg_geno(n_ind, n_pos, geno, &Geno); reorg_geno(n_ind, n_pos, argmax, &Argmax); allocate_imatrix(n_pos, n_gen, &traceback); allocate_double(n_gen, &gamma); allocate_double(n_gen, &tempgamma); allocate_double(n_gen, &tempgamma2); for(i=0; i<n_ind; i++) { /* i = individual */ R_CheckUserInterrupt(); /* check for ^C */ /* begin viterbi algorithm */ if(n_pos > 1) { /* multiple markers */ for(v=0; v<n_gen; v++) gamma[v] = initf(v+1, cross_scheme) + emitf(Geno[0][i], v+1, error_prob, cross_scheme); for(j=0; j<n_pos-1; j++) { for(v=0; v<n_gen; v++) { tempgamma[v] = s = gamma[0] + stepf(1, v+1, rf[j], rf2[j], cross_scheme); traceback[j][v] = 0; for(v2=1; v2<n_gen; v2++) { t = gamma[v2] + stepf(v2+1, v+1, rf[j], rf2[j], cross_scheme); if(t > s || (fabs(t-s) < TOL && unif_rand() < 0.5)) { tempgamma[v] = s = t; traceback[j][v] = v2; } } tempgamma2[v] = tempgamma[v] + emitf(Geno[j+1][i], v+1, error_prob, cross_scheme); } for(v=0; v<n_gen; v++) gamma[v] = tempgamma2[v]; } /* finish off viterbi and then traceback to get most likely sequence of genotypes */ Argmax[n_pos-1][i] = 0; s = gamma[0]; for(v=1; v<n_gen; v++) { if(gamma[v] > s || (fabs(gamma[v]-s) < TOL && unif_rand() < 0.5)) { s = gamma[v]; Argmax[n_pos-1][i] = v; } } for(j=n_pos-2; j >= 0; j--) Argmax[j][i] = traceback[j][Argmax[j+1][i]]; } else { /* for exactly one marker */ s = initf(1, cross_scheme) + emitf(Geno[0][i], 1, error_prob, cross_scheme); Argmax[0][i] = 0; for(v=1; v<n_gen; v++) { t = initf(v+1, cross_scheme) + emitf(Geno[0][i], v+1, error_prob, cross_scheme); if(t > s || (fabs(t-s) < TOL && unif_rand() < 0.5)) { s = t; Argmax[0][i] = v; } } } /* code genotypes as 1, 2, ... */ for(j=0; j<n_pos; j++) Argmax[j][i]++; } /* loop over individuals */ /* write R's random seed */ PutRNGstate(); }
void est_map(int n_ind, int n_mar, int n_gen, int *geno, double *rf, double *rf2, double error_prob, double initf(int, int *), double emitf(int, int, double, int *), double stepf(int, int, double, double, int *), double nrecf1(int, int, double, int*), double nrecf2(int, int, double, int*), double *loglik, int maxit, double tol, int sexsp, int verbose) { int i, j, j2, v, v2, it, flag=0, **Geno, ndigits; double s, **alpha, **beta, **gamma, *cur_rf, *cur_rf2; double curloglik, maxdif, temp; char pattern[100], text[200]; int cross_scheme[2]; /* cross scheme hidden in loglik argument; used by hmm_bcsft */ cross_scheme[0] = (int) ftrunc(*loglik / 1000.0); cross_scheme[1] = ((int) *loglik) - 1000 * cross_scheme[0]; *loglik = 0.0; /* allocate space for beta and reorganize geno */ reorg_geno(n_ind, n_mar, geno, &Geno); allocate_alpha(n_mar, n_gen, &alpha); allocate_alpha(n_mar, n_gen, &beta); allocate_dmatrix(n_gen, n_gen, &gamma); allocate_double(n_mar-1, &cur_rf); allocate_double(n_mar-1, &cur_rf2); /* digits in verbose output */ if(verbose) { ndigits = (int)ceil(-log10(tol)); if(ndigits > 16) ndigits=16; sprintf(pattern, "%s%d.%df", "%", ndigits+3, ndigits+1); } /* begin EM algorithm */ for(it=0; it<maxit; it++) { for(j=0; j<n_mar-1; j++) { cur_rf[j] = cur_rf2[j] = rf[j]; rf[j] = 0.0; if(sexsp) { cur_rf2[j] = rf2[j]; rf2[j] = 0.0; } } 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_mar-1] = 0.0; } /* forward-backward equations */ for(j=1,j2=n_mar-2; j<n_mar; j++, j2--) { for(v=0; v<n_gen; v++) { alpha[v][j] = alpha[0][j-1] + stepf(1, v+1, cur_rf[j-1], cur_rf2[j-1], cross_scheme); beta[v][j2] = beta[0][j2+1] + stepf(v+1,1,cur_rf[j2], cur_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,cur_rf[j-1],cur_rf2[j-1], cross_scheme)); beta[v][j2] = addlog(beta[v][j2], beta[v2][j2+1] + stepf(v+1,v2+1,cur_rf[j2],cur_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); } } for(j=0; j<n_mar-1; j++) { /* calculate gamma = log Pr(v1, v2, O) */ for(v=0, s=0.0; v<n_gen; v++) { for(v2=0; v2<n_gen; v2++) { gamma[v][v2] = alpha[v][j] + beta[v2][j+1] + emitf(Geno[j+1][i], v2+1, error_prob, cross_scheme) + stepf(v+1, v2+1, cur_rf[j], cur_rf2[j], cross_scheme); if(v==0 && v2==0) s = gamma[v][v2]; else s = addlog(s, gamma[v][v2]); } } for(v=0; v<n_gen; v++) { for(v2=0; v2<n_gen; v2++) { rf[j] += nrecf1(v+1,v2+1, cur_rf[j], cross_scheme) * exp(gamma[v][v2] - s); if(sexsp) rf2[j] += nrecf2(v+1,v2+1, cur_rf[j], cross_scheme) * exp(gamma[v][v2] - s); } } } } /* loop over individuals */ /* rescale */ for(j=0; j<n_mar-1; j++) { rf[j] /= (double)n_ind; if(rf[j] < tol/1000.0) rf[j] = tol/1000.0; else if(rf[j] > 0.5-tol/1000.0) rf[j] = 0.5-tol/1000.0; if(sexsp) { rf2[j] /= (double)n_ind; if(rf2[j] < tol/1000.0) rf2[j] = tol/1000.0; else if(rf2[j] > 0.5-tol/1000.0) rf2[j] = 0.5-tol/1000.0; } else rf2[j] = rf[j]; } if(verbose>1) { /* print estimates as we go along*/ Rprintf(" %4d ", it+1); maxdif=0.0; for(j=0; j<n_mar-1; j++) { temp = fabs(rf[j] - cur_rf[j])/(cur_rf[j]+tol*100.0); if(maxdif < temp) maxdif = temp; if(sexsp) { temp = fabs(rf2[j] - cur_rf2[j])/(cur_rf2[j]+tol*100.0); if(maxdif < temp) maxdif = temp; } /* bsy add */ if(verbose > 2) Rprintf("%d %f %f\n", j+1, cur_rf[j], rf[j]); /* bsy add */ } sprintf(text, "%s%s\n", " max rel've change = ", pattern); Rprintf(text, maxdif); } /* check convergence */ for(j=0, flag=0; j<n_mar-1; j++) { if(fabs(rf[j] - cur_rf[j]) > tol*(cur_rf[j]+tol*100.0) || (sexsp && fabs(rf2[j] - cur_rf2[j]) > tol*(cur_rf2[j]+tol*100.0))) { flag = 1; break; } } if(!flag) break; } /* end EM algorithm */ if(flag) warning("Didn't converge!\n"); /* calculate log likelihood */ *loglik = 0.0; for(i=0; i<n_ind; i++) { /* i = individual */ /* initialize alpha */ 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); } /* forward equations */ for(j=1; j<n_mar; j++) { 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); 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)); alpha[v][j] += emitf(Geno[j][i],v+1,error_prob, cross_scheme); } } curloglik = alpha[0][n_mar-1]; for(v=1; v<n_gen; v++) curloglik = addlog(curloglik, alpha[v][n_mar-1]); *loglik += curloglik; } if(verbose) { if(verbose < 2) { /* print final estimates */ Rprintf(" no. iterations = %d\n", it+1); maxdif=0.0; for(j=0; j<n_mar-1; j++) { temp = fabs(rf[j] - cur_rf[j])/(cur_rf[j]+tol*100.0); if(maxdif < temp) maxdif = temp; if(sexsp) { temp = fabs(rf2[j] - cur_rf2[j])/(cur_rf2[j]+tol*100.0); if(maxdif < temp) maxdif = temp; } } sprintf(text, "%s%s\n", " max rel've change at last step = ", pattern); Rprintf(text, maxdif); } Rprintf(" loglik: %10.4lf\n\n", *loglik); } }
void calc_genoprob_special(int n_ind, int n_pos, int n_gen, int *geno, double *rf, double *rf2, double error_prob, double *genoprob, double initf(int), double emitf(int, int, double), double stepf(int, int, double, double)) { int i, j, j2, v, v2, curpos; double s, **alpha, **beta; int **Geno; double ***Genoprob; /* allocate space for alpha and beta and reorganize geno and genoprob */ reorg_geno(n_ind, n_pos, geno, &Geno); reorg_genoprob(n_ind, n_pos, n_gen, genoprob, &Genoprob); allocate_alpha(n_pos, n_gen, &alpha); allocate_alpha(n_pos, n_gen, &beta); for(i=0; i<n_ind; i++) { /* i = individual */ for(curpos=0; curpos < n_pos; curpos++) { if(!Geno[curpos][i]) continue; R_CheckUserInterrupt(); /* check for ^C */ /* initialize alpha and beta */ for(v=0; v<n_gen; v++) { if(curpos==0) alpha[v][0] = initf(v+1) + emitf(Geno[0][i], v+1, error_prob); else alpha[v][0] = initf(v+1) + emitf(Geno[0][i], v+1, TOL); 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]); if(curpos==j2+1) beta[v][j2] = beta[0][j2+1] + stepf(v+1,1,rf[j2], rf2[j2]) + emitf(Geno[j2+1][i],1,error_prob); else beta[v][j2] = beta[0][j2+1] + stepf(v+1,1,rf[j2], rf2[j2]) + emitf(Geno[j2+1][i],1,TOL); 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])); if(curpos==j2+1) beta[v][j2] = addlog(beta[v][j2], beta[v2][j2+1] + stepf(v+1,v2+1,rf[j2],rf2[j2]) + emitf(Geno[j2+1][i],v2+1,error_prob)); else beta[v][j2] = addlog(beta[v][j2], beta[v2][j2+1] + stepf(v+1,v2+1,rf[j2],rf2[j2]) + emitf(Geno[j2+1][i],v2+1,TOL)); } if(curpos==j) alpha[v][j] += emitf(Geno[j][i],v+1,error_prob); else alpha[v][j] += emitf(Geno[j][i],v+1,TOL); } } /* calculate genotype probabilities */ s = Genoprob[0][curpos][i] = alpha[0][curpos] + beta[0][curpos]; for(v=1; v<n_gen; v++) { Genoprob[v][curpos][i] = alpha[v][curpos] + beta[v][curpos]; s = addlog(s, Genoprob[v][curpos][i]); } for(v=0; v<n_gen; v++) Genoprob[v][curpos][i] = exp(Genoprob[v][curpos][i] - s); } /* end loop over current position */ } /* loop over individuals */ }
void outcode(tree *t, int eflag) { int p, q; tree *tt; if(t==0) return; if(t->type!=NOT && t->type!=';') runq->iflast = 0; switch(t->type){ default: pfmt(err, "bad type %d in outcode\n", t->type); break; case '$': emitf(Xmark); outcode(c0, eflag); emitf(Xdol); break; case '"': emitf(Xmark); outcode(c0, eflag); emitf(Xqdol); break; case SUB: emitf(Xmark); outcode(c0, eflag); emitf(Xmark); outcode(c1, eflag); emitf(Xsub); break; case '&': emitf(Xasync); if(havefork){ p = emiti(0); outcode(c0, eflag); emitf(Xexit); stuffdot(p); } else emits(fnstr(c0)); break; case ';': outcode(c0, eflag); outcode(c1, eflag); break; case '^': emitf(Xmark); outcode(c1, eflag); emitf(Xmark); outcode(c0, eflag); emitf(Xconc); break; case '`': emitf(Xbackq); if(havefork){ p = emiti(0); outcode(c0, 0); emitf(Xexit); stuffdot(p); } else emits(fnstr(c0)); break; case ANDAND: outcode(c0, 0); emitf(Xtrue); p = emiti(0); outcode(c1, eflag); stuffdot(p); break; case ARGLIST: outcode(c1, eflag); outcode(c0, eflag); break; case BANG: outcode(c0, eflag); emitf(Xbang); break; case PCMD: case BRACE: outcode(c0, eflag); break; case COUNT: emitf(Xmark); outcode(c0, eflag); emitf(Xcount); break; case FN: emitf(Xmark); outcode(c0, eflag); if(c1){ emitf(Xfn); p = emiti(0); emits(fnstr(c1)); outcode(c1, eflag); emitf(Xunlocal); /* get rid of $* */ emitf(Xreturn); stuffdot(p); } else emitf(Xdelfn); break; case IF: outcode(c0, 0); emitf(Xif); p = emiti(0); outcode(c1, eflag); emitf(Xwastrue); stuffdot(p); break; case NOT: if(!runq->iflast) yyerror("`if not' does not follow `if(...)'"); emitf(Xifnot); p = emiti(0); outcode(c0, eflag); stuffdot(p); break; case OROR: outcode(c0, 0); emitf(Xfalse); p = emiti(0); outcode(c1, eflag); stuffdot(p); break; case PAREN: outcode(c0, eflag); break; case SIMPLE: emitf(Xmark); outcode(c0, eflag); emitf(Xsimple); if(eflag) emitf(Xeflag); break; case SUBSHELL: emitf(Xsubshell); if(havefork){ p = emiti(0); outcode(c0, eflag); emitf(Xexit); stuffdot(p); } else emits(fnstr(c0)); if(eflag) emitf(Xeflag); break; case SWITCH: codeswitch(t, eflag); break; case TWIDDLE: emitf(Xmark); outcode(c1, eflag); emitf(Xmark); outcode(c0, eflag); emitf(Xmatch); if(eflag) emitf(Xeflag); break; case WHILE: q = codep; outcode(c0, 0); if(q==codep) emitf(Xsettrue); /* empty condition == while(true) */ emitf(Xtrue); p = emiti(0); outcode(c1, eflag); emitf(Xjump); emiti(q); stuffdot(p); break; case WORDS: outcode(c1, eflag); outcode(c0, eflag); break; case FOR: emitf(Xmark); if(c1){ outcode(c1, eflag); emitf(Xglob); } else{ emitf(Xmark); emitf(Xword); emits(strdup("*")); emitf(Xdol); } emitf(Xmark); /* dummy value for Xlocal */ emitf(Xmark); outcode(c0, eflag); emitf(Xlocal); p = emitf(Xfor); q = emiti(0); outcode(c2, eflag); emitf(Xjump); emiti(p); stuffdot(q); emitf(Xunlocal); break; case WORD: emitf(Xword); emits(strdup(t->str)); break; case DUP: if(t->rtype==DUPFD){ emitf(Xdup); emiti(t->fd0); emiti(t->fd1); } else{ emitf(Xclose); emiti(t->fd0); } outcode(c1, eflag); emitf(Xpopredir); break; case PIPEFD: emitf(Xpipefd); emiti(t->rtype); if(havefork){ p = emiti(0); outcode(c0, eflag); emitf(Xexit); stuffdot(p); } else { emits(fnstr(c0)); } break; case REDIR: emitf(Xmark); outcode(c0, eflag); emitf(Xglob); switch(t->rtype){ case APPEND: emitf(Xappend); break; case WRITE: emitf(Xwrite); break; case READ: case HERE: emitf(Xread); break; case RDWR: emitf(Xrdwr); break; } emiti(t->fd0); outcode(c1, eflag); emitf(Xpopredir); break; case '=': tt = t; for(;t && t->type=='=';t = c2); if(t){ for(t = tt;t->type=='=';t = c2){ emitf(Xmark); outcode(c1, eflag); emitf(Xmark); outcode(c0, eflag); emitf(Xlocal); } outcode(t, eflag); for(t = tt; t->type=='='; t = c2) emitf(Xunlocal); } else{ for(t = tt;t;t = c2){ emitf(Xmark); outcode(c1, eflag); emitf(Xmark); outcode(c0, eflag); emitf(Xassign); } } t = tt; /* so tests below will work */ break; case PIPE: emitf(Xpipe); emiti(t->fd0); emiti(t->fd1); if(havefork){ p = emiti(0); q = emiti(0); outcode(c0, eflag); emitf(Xexit); stuffdot(p); } else { emits(fnstr(c0)); q = emiti(0); } outcode(c1, eflag); emitf(Xreturn); stuffdot(q); emitf(Xpipewait); break; } if(t->type!=NOT && t->type!=';') runq->iflast = t->type==IF; else if(c0) runq->iflast = c0->type==IF; }
void cleanhere(char *f) { emitf(Xdelhere); emits(strdup(f)); }
static void analop_esil(RAnal *a, RAnalOp *op, ut64 addr, const ut8 *buf, const char *buf_asm) { r_strbuf_init (&op->esil); r_strbuf_set (&op->esil, ""); switch (buf[0]) { // Irregulars sorted by lower nibble case 0x00: /* nop */ emit(","); break; case 0x10: /* jbc */ k(BIT_R "&,?{,%2$d,1,<<,255,^,%1$d,&=[1],%3$hhd,3,+,pc,+=,}"); break; case 0x20: /* jb */ k(BIT_R "&,?{,%3$hhd,3,+,pc,+=,}"); break; case 0x30: /* jnb */ k(BIT_R "&,!,?{,%3$hhd,3,+,pc,+=,}"); break; case 0x40: /* jc */ emitf("C,!,?{,%hhd,2,+,pc,+=,}", buf[1]); break; case 0x50: /* jnc */ emitf("C,""?{,%hhd,2,+,pc,+=,}", buf[1]); break; case 0x60: /* jz */ emitf("A,!,?{,%hhd,2,+,pc,+=,}", buf[1]); break; case 0x70: /* jnz */ emitf("A,""?{,%hhd,2,+,pc,+=,}", buf[1]); break; case 0x80: /* sjmp */ j(ESX_L1 JMP("2")); break; case 0x90: /* mov */ emitf("%d,dptr,=", (buf[1]<<8) + buf[2]); break; case 0xA0: /* orl */ k(BIT_R "C,|="); break; case 0xB0: /* anl */ k(BIT_R "C,&="); break; case 0xC0: /* push */ h(XR(IB1) PUSH1); break; case 0xD0: /* pop */ h(POP1 XW(IB1)); break; case 0xE0: /* movx */ /* TODO */ break; case 0xF0: /* movx */ /* TODO */ break; case 0x11: case 0x31: case 0x51: case 0x71: case 0x91: case 0xB1: case 0xD1: case 0xF1: emit(CALL("2")); // fall through case 0x01: case 0x21: case 0x41: case 0x61: case 0x81: case 0xA1: case 0xC1: case 0xE1: emitf("0x%x,pc,=", (addr & 0xF800) | ((((unsigned short)buf[0])<<3) & 0x0700) | buf[1]); break; case 0x02: /* ljmp */ emitf( "%d,pc,=", (unsigned int)((buf[1]<<8)+buf[2])); break; case 0x12: /* lcall */ emitf(CALL("3")",%d,pc,=", (unsigned int)((buf[1]<<8)+buf[2])); break; case 0x22: /* ret */ emitf(POP2 "pc,="); break; case 0x32: /* reti */ /* TODO */ break; case 0x72: /* orl */ /* TODO */ break; case 0x82: /* anl */ /* TODO */ break; case 0x92: /* mov */ /* TODO */ break; case 0xA2: /* mov */ /* TODO */ break; case 0xB2: /* cpl */ k("%2$d,1,<<,%1$d,^=[1]"); break; case 0xC2: /* clr */ /* TODO */ break; case 0x03: /* rr */ emit("1,A,0x101,*,>>,A,="); break; case 0x13: /* rrc */ /* TODO */ break; case 0x23: /* rl */ emit("7,A,0x101,*,>>,A,="); break; case 0x33: /* rlc */ /* TODO */ break; case 0x73: /* jmp */ emit("dptr,A,+,pc,="); break; case 0x83: /* movc */ emit("A,dptr,+,[1],A,="); break; case 0x93: /* movc */ emit("A,pc,+,[1],A,="); break; case 0xA3: /* inc */ h(XI(IB1, "++")); break; case 0xB3: /* cpl */ emit("1," XI(C, "^")); break; case 0xC3: /* clr */ emit("0,C,="); break; // Regulars sorted by upper nibble OP_GROUP_UNARY_4(0x00, "++") OP_GROUP_UNARY_4(0x10, "--") OP_GROUP_INPLACE_LHS_4(0x20, A, "+") case 0x34: h (XR(L1) "C,+," XI(A, "+")) break; case 0x35: h (XR(IB1) "C,+," XI(A, "+")) break; case 0x36: case 0x37: j (XR(R0I) "C,+," XI(A, "+")) break; case 0x38: case 0x39: case 0x3A: case 0x3B: case 0x3C: case 0x3D: case 0x3E: case 0x3F: h (XR(R0) "C,+," XI(A, "+")) break; OP_GROUP_INPLACE_LHS_4(0x40, A, "|") OP_GROUP_INPLACE_LHS_4(0x50, A, "&") OP_GROUP_INPLACE_LHS_4(0x60, A, "^") case 0x74: h (XR(L1) XW(A)) break; case 0x75: h (XR(L2) XW(IB1)) break; case 0x76: case 0x77: j (XR(L1) XW(R0I)) break; case 0x78: case 0x79: case 0x7A: case 0x7B: case 0x7C: case 0x7D: case 0x7E: case 0x7F: h (XR(L1) XW(R0)) break; case 0x84: /* div */ emit("B,!,OV,=,0,A,B,A,/=,A,B,*,-,-,B,=,0,C,="); break; case 0x85: /* mov */ h(IRAM_BASE ",%2$d,+,[1]," IRAM_BASE ",%2$d,+,=[1]"); break; case 0x86: case 0x87: j (XR(R0I) XW(IB1)) break; case 0x88: case 0x89: case 0x8A: case 0x8B: case 0x8C: case 0x8D: case 0x8E: case 0x8F: h (XR(R0) XW(IB1)) break; OP_GROUP_INPLACE_LHS_4(0x90, A, ".") case 0xA4: /* mul */ emit("8,A,B,*,DUP,>>,DUP,!,!,OV,=,B,=,A,=,0,C,="); break; case 0xA5: /* ??? */ emit("0,TRAP"); break; case 0xA6: case 0xA7: j (XR(IB1) XW(R0I)) break; case 0xA8: case 0xA9: case 0xAA: case 0xAB: case 0xAC: case 0xAD: case 0xAE: case 0xAF: h (XR(IB1) XW(R0)) break; case 0xB4: h (XR(L1) XR(A) "!=,?{,%3$hhd,2,+pc,+=,}") break; case 0xB5: h (XR(IB1) XR(A) "!=,?{,%3$hhd,2,+pc,+=,}") break; case 0xB6: case 0xB7: j (XR(L1) XR(R0I) "!=,?{,%3$hhd,2,+pc,+=,}") break; case 0xB8: case 0xB9: case 0xBA: case 0xBB: case 0xBC: case 0xBD: case 0xBE: case 0xBF: h (XR(L1) XR(R0) "!=,?{,%3$hhd,2,+pc,+=,}") break; case 0xC4: /* swap */ emit("4,A,0x101,*,>>,A,="); break; case 0xC5: /* xch */ /* TODO */ break; case 0xC6: case 0xC7: /* xch */ /* TODO */ break; case 0xC8: case 0xC9: case 0xCA: case 0xCB: case 0xCC: case 0xCD: case 0xCE: case 0xCF: /* xch */ h (XR(A) XR(R0) XW(A) "," XW(R0)); break; case 0xD2: /* setb */ /* TODO */ break; case 0xD3: /* setb */ /* TODO */ break; case 0xD4: /* da */ emit("A,--="); break; case 0xD5: /* djnz */ h(XI(R0I, "--") "," XR(R0I) CJMP(L2, "2")); break; case 0xD6: /* xchd */ /* TODO */ break; case 0xD7: /* xchd */ /* TODO */ break; case 0xD8: case 0xD9: case 0xDA: case 0xDB: case 0xDC: case 0xDD: case 0xDE: case 0xDF: /* djnz */ h(XI(R0, "--") "," XR(R0) CJMP(L1, "2")); break; case 0xE2: case 0xE3: /* movx */ j(XRAM_BASE "r%0$d,+,[1]," XW(A)); break; case 0xE4: /* clr */ emit("0,A,="); break; case 0xE5: /* mov */ h (XR(IB1) XW(A)) break; case 0xE6: case 0xE7: /* mov */ j (XR(R0I) XW(A)) break; case 0xE8: case 0xE9: case 0xEA: case 0xEB: case 0xEC: case 0xED: case 0xEE: case 0xEF: /* mov */ h (XR(R0) XW(A)) break; case 0xF2: case 0xF3: /* movx */ j(XR(A) XRAM_BASE "r%0$d,+,=[1]"); case 0xF4: /* cpl */ h ("255" XI(A, "^")) break; case 0xF5: /* mov */ h (XR(A) XW(IB1)) break; case 0xF6: case 0xF7: /* mov */ j (XR(A) XW(R0I)) break; case 0xF8: case 0xF9: case 0xFA: case 0xFB: case 0xFC: case 0xFD: case 0xFE: case 0xFF: /* mov */ h (XR(A) XW(R0)) break; default: break; } }
void sim_geno(int n_ind, int n_pos, int n_gen, int n_draws, int *geno, double *rf, double *rf2, double error_prob, int *draws, double initf(int, int *), double emitf(int, int, double, int *), double stepf(int, int, double, double, int *)) { int i, k, j, v, v2; double s, **beta, *probs; int **Geno, ***Draws, curstate; int cross_scheme[2]; /* cross scheme hidden in draws argument; used by hmm_bcsft */ cross_scheme[0] = draws[0]; cross_scheme[1] = draws[1]; draws[0] = 0; draws[1] = 0; /* allocate space for beta and reorganize geno and draws */ /* Geno indexed as Geno[pos][ind] */ /* Draws indexed as Draws[rep][pos][ind] */ reorg_geno(n_ind, n_pos, geno, &Geno); reorg_draws(n_ind, n_pos, n_draws, draws, &Draws); allocate_alpha(n_pos, n_gen, &beta); allocate_double(n_gen, &probs); /* Read R's random seed */ GetRNGstate(); for(i=0; i<n_ind; i++) { /* i = individual */ R_CheckUserInterrupt(); /* check for ^C */ /* do backward equations */ /* initialize beta */ for(v=0; v<n_gen; v++) beta[v][n_pos-1] = 0.0; /* backward equations */ for(j=n_pos-2; j>=0; j--) { for(v=0; v<n_gen; v++) { beta[v][j] = beta[0][j+1] + stepf(v+1,1,rf[j], rf2[j], cross_scheme) + emitf(Geno[j+1][i],1,error_prob, cross_scheme); for(v2=1; v2<n_gen; v2++) beta[v][j] = addlog(beta[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)); } } for(k=0; k<n_draws; k++) { /* k = simulation replicate */ /* first draw */ /* calculate probs */ s = (probs[0] = initf(1, cross_scheme)+emitf(Geno[0][i],1,error_prob, cross_scheme)+beta[0][0]); for(v=1; v<n_gen; v++) { probs[v] = initf(v+1, cross_scheme) + emitf(Geno[0][i], v+1, error_prob, cross_scheme) + beta[v][0]; s = addlog(s, probs[v]); } for(v=0; v<n_gen; v++) probs[v] = exp(probs[v] - s); /* make draw: returns a value from {1, 2, ..., n_gen} */ curstate = Draws[k][0][i] = sample_int(n_gen, probs); /* move along chromosome */ for(j=1; j<n_pos; j++) { /* calculate probs */ for(v=0; v<n_gen; v++) probs[v] = exp(stepf(curstate,v+1,rf[j-1],rf2[j-1], cross_scheme) + emitf(Geno[j][i],v+1,error_prob, cross_scheme) + beta[v][j] - beta[curstate-1][j-1]); /* make draw */ curstate = Draws[k][j][i] = sample_int(n_gen, probs); } } /* loop over replicates */ } /* loop over individuals */ /* write R's random seed */ PutRNGstate(); }