SCM
scm_inv_cdf_chi_square(SCM sdf, SCM sp)
{
SCM_ASSERT(gh_exact_p(sdf), sdf, SCM_ARG1, "inv-cdf-chi-square");
SCM_ASSERT(gh_number_p(sp), sp, SCM_ARG2, "inv-cdf-chi-square");
int df = gh_scm2int(sdf);
double p = gh_scm2double(sp);
double x = inv_chi_square_cdf(df,p);
return gh_double2scm(x);
}
SCM
scm_cdf_t(SCM sdf, SCM sx)
{
SCM_ASSERT(gh_exact_p(sdf), sdf, SCM_ARG1, "cdf-t");
SCM_ASSERT(gh_number_p(sx), sx, SCM_ARG2, "cdf-t");
int df = gh_scm2int(sdf);
double x = gh_scm2double(sx);
double p = t_cdf(df,x);
return gh_double2scm(p);
}
SCM
scm_cdf_chi_square(SCM sdf, SCM sx)
{
SCM_ASSERT(gh_exact_p(sdf), sdf, SCM_ARG1, "cdf-chi-square");
SCM_ASSERT(gh_number_p(sx), sx, SCM_ARG2, "cdf-chi-square");
int df = gh_scm2int(sdf);
double x = gh_scm2double(sx);
double p = chi_square_cdf(df,x);
return gh_double2scm(p);
}
SCM tortoise_move(SCM s_steps)
{
double oldX = currentX;
double oldY = currentY;
double newX, newY;
double steps;
SCM_ASSERT(SCM_NUMBERP(s_steps), s_steps, SCM_ARG1, "tortoise-move");
//steps = SCM_NUM2DOUBLE(s_steps);
steps = scm_to_double(s_steps);
/* first work out the new endpoint */
newX = currentX + sin(currentDirection*DEGREES_TO_RADIANS) * steps;
newY = currentY - cos(currentDirection*DEGREES_TO_RADIANS) * steps;
/* if the pen is down, draw a line */
if (penDown)
XDrawLine(theDisplay, theWindow, theGC,
(int)currentX, (int)currentY,
(int)newX, (int)newY);
/* in either case, move the tortoise */
currentX = newX;
currentY = newY;
return gh_cons(gh_double2scm(oldX), gh_cons(gh_double2scm(oldY), SCM_EOL));
}
SCM
scm_inv_cdf_F(SCM sdf1, SCM sdf2, SCM sp)
{
SCM_ASSERT(gh_exact_p(sdf1), sdf1, SCM_ARG1, "inv-cdf-F");
SCM_ASSERT(gh_exact_p(sdf2), sdf2, SCM_ARG2, "inv-cdf-F");
SCM_ASSERT(gh_number_p(sp), sp, SCM_ARG3, "inv-cdf-F");
int df1 = gh_scm2int(sdf1);
int df2 = gh_scm2int(sdf1);
double p = gh_scm2double(sp);
double x = inv_F_cdf(df1,df2,p);
return gh_double2scm(x);
}
SCM
scm_cdf_F(SCM sdf1, SCM sdf2, SCM sx)
{
SCM_ASSERT(gh_exact_p(sdf1), sdf1, SCM_ARG1, "cdf-F");
SCM_ASSERT(gh_exact_p(sdf2), sdf2, SCM_ARG2, "cdf-F");
SCM_ASSERT(gh_number_p(sx), sx, SCM_ARG3, "cdf-F");
int df1 = gh_scm2int(sdf1);
int df2 = gh_scm2int(sdf1);
double x = gh_scm2double(sx);
double p = F_cdf(df1,df2,x);
return gh_double2scm(p);
}
SCM
scm_cdf_neg_binomal(SCM sk, SCM sn, SCM sx)
{
SCM_ASSERT(gh_exact_p(sk), sk, SCM_ARG1, "cdf-neg-binomial");
SCM_ASSERT(gh_exact_p(sn), sn, SCM_ARG2, "cdf-neg-binomial");
SCM_ASSERT(gh_number_p(sx), sx, SCM_ARG3, "cdf-neg-binomial");
int k = gh_scm2int(sk);
int n = gh_scm2int(sn);
double x = gh_scm2double(sx);
double p = neg_binomial_cdf(k,n,x);
return gh_double2scm(p);
}
SCM
scm_inv_cdf_normal(SCM sm, SCM ssd, SCM sp)
{
SCM_ASSERT(gh_number_p(sm), sm, SCM_ARG1, "inv-cdf-normal");
SCM_ASSERT(gh_number_p(ssd), ssd, SCM_ARG2, "inv-cdf-normal");
SCM_ASSERT(gh_number_p(sp), sp, SCM_ARG3, "inv-cdf-normal");
double m = gh_scm2double(sm);
double sd = gh_scm2double(ssd);
double p = gh_scm2double(sp);
double x = inv_normal_cdf(m,sd,p);
return gh_double2scm(x);
}
SCM
scm_cdf_normal(SCM sm, SCM ssd, SCM sx)
{
SCM_ASSERT(gh_number_p(sm), sm, SCM_ARG1, "cdf-normal");
SCM_ASSERT(gh_number_p(ssd), ssd, SCM_ARG2, "cdf-normal");
SCM_ASSERT(gh_number_p(sx), sx, SCM_ARG3, "cdf-normal");
double m = gh_scm2double(sm);
double sd = gh_scm2double(ssd);
double x = gh_scm2double(sx);
double p = normal_cdf(m,sd,x);
return gh_double2scm(p);
}
SCM
gconf_value_to_scm(GConfValue* val)
{
SCM retval = SCM_EOL;
if (val == NULL)
return SCM_EOL;
switch (val->type)
{
case GCONF_VALUE_INVALID:
/* EOL */
break;
case GCONF_VALUE_STRING:
retval = gh_str02scm(gconf_value_get_string(val));
break;
case GCONF_VALUE_INT:
retval = gh_int2scm(gconf_value_get_int(val));
break;
case GCONF_VALUE_FLOAT:
retval = gh_double2scm(gconf_value_get_float(val));
break;
case GCONF_VALUE_BOOL:
retval = gh_bool2scm(gconf_value_get_bool(val));
break;
case GCONF_VALUE_SCHEMA:
/* FIXME this is more complicated, we need a smob or something */
break;
case GCONF_VALUE_LIST:
/* FIXME This is complicated too... */
break;
case GCONF_VALUE_PAIR:
retval = gh_cons(gconf_value_to_scm(gconf_value_get_car(val)),
gconf_value_to_scm(gconf_value_get_cdr(val)));
break;
default:
g_warning("Unhandled type in %s", G_STRFUNC);
break;
}
return retval;
}
SCM scm_from_double(double x) {
return gh_double2scm(x);
}
