void advance_in_time ( double time_step, double position[3], double new_position[3] ) { /* Move a point along the Lorenz attractor */ double deriv0[3], deriv1[3], deriv2[3], deriv3[3] ; int i ; memcpy ( new_position, position, 3 * sizeof(double) ) ; /* Save the present values */ /* First pass in a Fourth-Order Runge-Kutta integration method */ calc_deriv ( position, deriv0 ) ; for ( i = 0; i < 3; i++ ) new_position[i] = position[i] + 0.5 * time_step * deriv0[i] ; /* Second pass */ calc_deriv ( new_position, deriv1 ) ; for ( i = 0; i < 3; i++ ) new_position[i] = position[i] + 0.5 * time_step * deriv1[i] ; /* Third pass */ calc_deriv ( position, deriv2 ) ; for ( i = 0; i < 3; i++ ) new_position[i] = position[i] + time_step * deriv2[i] ; /* Second pass */ calc_deriv ( new_position, deriv3 ) ; for ( i = 0; i < 3; i++ ) new_position[i] = position[i] + 0.1666666666666666667 * time_step * ( deriv0[i] + 2.0 * ( deriv1[i] + deriv2[i] ) + deriv3[i] ) ; }
void add_visc(Field *fld) { visc_tens(fld); /* Calculate div(Pi) */ calc_deriv(fld->Tens->Pixx,fld->Tens->divPix,NULL,fld->Params->dx,fld->kk); calc_deriv(fld->Tens->Pixy,fld->Tens->divPiy,fld->Tens->divPix,fld->Params->dx,fld->kk); calc_deriv(fld->Tens->Piyy,NULL,fld->Tens->divPiy,fld->Params->dx,fld->kk); /* Convolve with 1/Sigma */ convolve_inv(&fld->sig[istart],&fld->Tens->divPix[istart],fld->dtu,1); convolve_inv(&fld->sig[istart],&fld->Tens->divPiy[istart],fld->dtv,1); return; }
/** * Calculates the log likelihood (log probability of model given the * data) and gradient. If the calc_ll flag is FALSE, the * log-likelihood is not calculated and 0.0 is returned. If the * calc_grad flag is FALSE the gradient is not calculated and the * model partial derivatives are not updated. */ double bkgd_evo_mdl_calc_ll(Model *mdl, int calc_ll, int calc_grad) { BkgdEvoMdlParam param, ll_deriv; Branch *br; ColType *cltype; BkgdEvoMdlConfig *conf; BkgdEvoMdlData *data; double ll; ColTypeStat *clstat, *cons_clstat; long i; int j; conf = mdl->config; data = mdl->data; if(data == NULL) { g_error("bkgd_evo_mdl_calc_ll: data must be set before " "likelihood can be calculated\n"); } param_set_zero(¶m); param_set_zero(&ll_deriv); set_bkgd_evo_param_from_model(mdl, conf, ¶m); ll = 0.0; clstat = g_new(ColTypeStat, conf->n_cltype); cons_clstat = NULL; for(i = 0; i < conf->n_cltype; i++) { clstat[i].n = 0; clstat[i].ttl_prob = 0.0; clstat[i].ttl_prob_double = 0.0; clstat[i].ttl_prob_single = 0.0; clstat[i].ttl_ll = 0.0; } for(i = 0; i < data->n_bin; i++) { /* Combine non-exonic and exonic B vals and rescale by new * deleterious rate estimates. Use precomputed log B values so * that rescaling is more efficient (do not need to take logs * first and then re-exponentiate) */ param.B = exp(data->bin[i].lB_ex * param.u_ex_scale + data->bin[i].lB_nex * param.u_nex_scale); if(param.B < 0.0 || param.B > 1.0 || isnan(param.B) || isinf(param.B)) { g_error("bkgd_evo_mdl_calc_ll: invalid B (%g)\n" "B_ex=%g, B_nex=%g, u_ex_scale=%g, u_nex_scale=%g\n", param.B, data->bin[i].B_ex, data->bin[i].B_nex, param.u_ex_scale, param.u_nex_scale); } /* calculate mutation rate for current bin */ bkgd_evo_mdl_calc_mu(¶m, mdl, &data->bin[i]); /* calculate probability HC coalescent predates HC/G speciation */ if(param.T_hcg == 0.0) { param.k_hcg = 1.0; } else { param.k_hcg = exp(-0.5 * param.T_hcg / (param.B * param.N_hc)); if(param.k_hcg > 1.0 || param.k_hcg < 0.0) { g_error("bkgd_evo_mdl_calc_ll: invalid probability of HC " "coalescent predating gorilla speciation: k_hcg=%g\n", param.k_hcg); } } /* calculate branch lengths and substitution probs for current bin */ for(j = 0; j < conf->n_branch; j++) { br = &conf->branches[j]; br->set_len(br, ¶m); if(br->len < 0.0 || isnan(br->len) || isinf(br->len)) { g_warning("bkgd_evo_mdl_calc_ll: invalid length (%g) for branch %s", br->len, br->name); br->len = BRANCH_LEN_SMALL; } branch_set_prob(br, ¶m, conf); } /* calc prob of observing each observed column type for bin */ for(j = 0; j < conf->n_cltype; j++) { cltype = conf->cltypes[j]; /* do only non-conserved columns first */ if(cltype->subst_type == SUBST_TYPE_CONSERVED) { cons_clstat = &clstat[j]; continue; } cltype->set_n(cltype, &data->bin[i]); /* compute prob of a single observed column */ cltype_set_prob(cltype, ¶m, conf); if(cltype->n > 0) { /* add contribution to log-likelihood */ if(cltype->prob > 1.0 || cltype->prob < 0.0) { g_error("bkgd_evo_mdl_calc_ll: invalid probability (%g) " "for column type '%s'", cltype->prob, cltype->name); } if(cltype->prob < 1e-20) { fprintf(stderr, "LOW prob column %s: p=%g\n", cltype->name, cltype->prob); } ll += (double)cltype->n * log(cltype->prob); /* for debugging and analysis purposes record some statistics * about each column type */ clstat[j].n += cltype->n; clstat[j].ttl_prob += cltype->prob; clstat[j].ttl_prob_double += cltype->prob_ttl_double; clstat[j].ttl_prob_single += cltype->prob_single; clstat[j].ttl_ll += (double)cltype->n * log(cltype->prob); } } /* now add the contribution from the conserved column */ if(conf->cons_cltype != NULL) { cltype = conf->cons_cltype; cltype->set_n(cltype, &data->bin[i]); /* compute prob of a single observed column */ cltype_cons_set_prob(cltype, ¶m, conf); if(cltype->n > 0) { /* add contribution to log-likelihood */ if(cltype->prob > 1.0 || cltype->prob < 0.0) { g_error("bkgd_evo_mdl_calc_ll: invalid probability (%g) " "for column type '%s'", cltype->prob, cltype->name); } if(cltype->prob < 1e-20) { fprintf(stderr, "LOW prob column %s: p=%g\n", cltype->name, cltype->prob); } ll += (double)cltype->n * log(cltype->prob); /* fprintf(stderr, "bin=%ld, CONS prob=%g\n", i, cltype->prob);*/ cons_clstat->n += cltype->n; cons_clstat->ttl_prob += cltype->prob; cons_clstat->ttl_prob_double += cltype->prob_ttl_double; cons_clstat->ttl_prob_single += cltype->prob_single; cons_clstat->ttl_ll += (double)cltype->n * log(cltype->prob); } } if(calc_grad) { /* perform derivative calculations **/ calc_deriv( &ll_deriv, conf, ¶m, &data->bin[i]); } } if(calc_grad) { /* update model's derivatives */ bkgd_evo_mdl_set_mdl_deriv(mdl, &ll_deriv); /* model_write_grad_ln(mdl, stderr);*/ } /* for(i = 0; i < conf->n_cltype; i++) { */ /* double dbl_pp, single_pp, avg_p; */ /* char *name; */ /* name = conf->cltypes[i]->name; */ /* avg_p = clstat[i].ttl_prob / (double)clstat[i].n; */ /* single_pp = clstat[i].ttl_prob_single / clstat[i].ttl_prob; */ /* dbl_pp = clstat[i].ttl_prob_double / clstat[i].ttl_prob; */ /* fprintf(stderr, " %s: n=%ld, LL=%g, p(%s)=%g, " */ /* "p(single|%s)=%g, p(double|%s)=%g\n", */ /* name, clstat[i].n, clstat[i].ttl_ll, name, avg_p, */ /* name, single_pp, name, dbl_pp); */ /* } */ g_free(clstat); return ll; }