realset_smob.cpp

非常著名的曲线拟合程序

    RealSet* rs = scm2realset(scm_rs);
    int lag = gh_scm2int(scm_lag);
    SCM_ASSERT(lag>=0 && lag<(int)rs->size()-3, scm_lag,
	       SCM_OUTOFRANGE, str_autocorr_z);
    x = goose_autocorr_z(*rs, lag);
  } GOOSE_CATCH(str_autocorr_z);
    
  return gh_double2scm(x);
}

GOOSE_PROC(cvm, "realset-cramer-von-mises",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_cvm);
  double x = 0;
  try {
    RealSet* rs = scm2realset(scm_rs);
    x = goose_cramer_vos_mises(*rs);
  } GOOSE_CATCH(str_cvm);

  return gh_double2scm(x);
}

GOOSE_PROC(anddar, "realset-anderson-darling",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_anddar);
  double x = 0;
  try {
    RealSet* rs = scm2realset(scm_rs);
    x = goose_anderson_darling(*rs);
  } GOOSE_CATCH(str_cvm);

  return gh_double2scm(x);
}

GOOSE_PROC(gmeanthresh, "realset-gmean-threshold",
	   2,0,0, (SCM scm_rs, SCM scm_c))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_gmeanthresh);
  SCM_ASSERT(gh_number_p(scm_c), scm_c, SCM_ARG2, str_gmeanthresh);

  double c = gh_scm2double(scm_c);
  SCM_ASSERT(c >= 0 && c <= 1, scm_c, SCM_OUTOFRANGE, str_gmeanthresh);
  double x = 0;
  try {
    RealSet* rs = scm2realset(scm_rs);
    x = goose_gmean_threshold(*rs, c);
  } GOOSE_CATCH(str_gmeanthresh);

  return gh_double2scm(x);
}

GOOSE_PROC(meanthrperc, "realset-mean-threshold-percentage",
	   2,0,0, (SCM scm_rs, SCM scm_c))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_meanthrperc);
  SCM_ASSERT(gh_number_p(scm_c), scm_c, SCM_ARG2, str_meanthrperc);

  double c = gh_scm2double(scm_c);
  SCM_ASSERT(c >= 0 && c <= 1, scm_c, SCM_OUTOFRANGE, str_meanthrperc);
  double x = 0;
  try {
    RealSet* rs = scm2realset(scm_rs);
    x = goose_mean_threshold_percentage(*rs, c);
  } GOOSE_CATCH(str_meanthrperc);

  return gh_double2scm(x);
}


GOOSE_PROC(gmeanthrperc, "realset-gmean-threshold-percentage",
	   2,0,0, (SCM scm_rs, SCM scm_c))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_gmeanthrperc);
  SCM_ASSERT(gh_number_p(scm_c), scm_c, SCM_ARG2, str_gmeanthrperc);

  double c = gh_scm2double(scm_c);
  SCM_ASSERT(c >= 0 && c <= 1, scm_c, SCM_OUTOFRANGE, str_gmeanthrperc);
  double x = 0;
  try {
    RealSet* rs = scm2realset(scm_rs);
    x = goose_gmean_threshold_percentage(*rs, c);
  } GOOSE_CATCH(str_gmeanthrperc);

  return gh_double2scm(x);
}

GOOSE_PROC(covar, "realset-covar",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_covar);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_covar);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_covar(*rs1, *rs2);
  } GOOSE_CATCH(str_covar);

  return gh_double2scm(x);
}

GOOSE_PROC(corr, "realset-corr",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_corr);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_corr);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_corr(*rs1, *rs2);
  } GOOSE_CATCH(str_corr);

  return gh_double2scm(x);
}

GOOSE_PROC(spearrho, "realset-spearman-rho",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_spearrho);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_spearrho);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_spearman_rho(*rs1, *rs2);
  } GOOSE_CATCH(str_spearrho);

  return gh_double2scm(x);
}

GOOSE_PROC(kentau, "realset-kendall-tau",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_kentau);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_kentau);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_kendall_tau(*rs1, *rs2);
  } GOOSE_CATCH(str_kentau);

  return gh_double2scm(x);
}

GOOSE_PROC(edf_Dp, "realset-EDF-D+",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_edf_Dp);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_edf_Dp);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_EDF_D_plus(*rs1, *rs2);
  } GOOSE_CATCH(str_edf_Dp);

  return gh_double2scm(x);
}

GOOSE_PROC(edf_Dm, "realset-EDF-D-",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_edf_Dm);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_edf_Dm);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_EDF_D_minus(*rs1, *rs2);
  } GOOSE_CATCH(str_edf_Dm);

  return gh_double2scm(x);
}


GOOSE_PROC(edf_D, "realset-EDF-D",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_edf_D);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_edf_D);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_EDF_D(*rs1, *rs2);
  } GOOSE_CATCH(str_edf_D);

  return gh_double2scm(x);
}

GOOSE_PROC(edf_kv, "realset-EDF-kuiper-V",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_edf_kv);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_edf_kv);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_EDF_kuiper_V(*rs1, *rs2);
  } GOOSE_CATCH(str_edf_kv);

  return gh_double2scm(x);
}

GOOSE_PROC(pooled_mean, "realset-pooled-mean",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_pooled_mean);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_pooled_mean);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_pooled_mean(*rs1, *rs2);
  } GOOSE_CATCH(str_pooled_mean);

  return gh_double2scm(x);
}

GOOSE_PROC(pooled_var, "realset-pooled-var",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs1), scm_rs1, SCM_ARG1, str_pooled_var);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG2, str_pooled_var);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_pooled_var(*rs1,*rs2);
  } GOOSE_CATCH(str_pooled_var);
  return gh_double2scm(x);
}

GOOSE_PROC(wtd_mean, "realset-weighted-mean",
	   2,0,0, (SCM scm_rs1, SCM scm_rs2))
{
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs1, SCM_ARG1, str_wtd_mean);
  SCM_ASSERT(REALSET_P(scm_rs2), scm_rs2, SCM_ARG1, str_wtd_mean);
  double x = 0;
  try {
    RealSet* rs1 = scm2realset(scm_rs1);
    RealSet* rs2 = scm2realset(scm_rs2);
    x = goose_weighted_mean(*rs1, *rs2);
  } GOOSE_CATCH(str_wtd_mean);

  return gh_double2scm(x);
}

GOOSE_PROC(rs_sort, "realset-sort!",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_sort);
  RealSet* rs = scm2realset(scm_rs);
  rs->sort();
  return scm_rs;
}

GOOSE_PROC(rs_lin_trans, "realset-linear-transform!",
	   3,0,0, (SCM scm_rs, SCM scm_a, SCM scm_b))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_lin_trans);
  SCM_ASSERT(gh_number_p(scm_a), scm_a, SCM_ARG2, str_rs_lin_trans);
  SCM_ASSERT(gh_number_p(scm_b), scm_b, SCM_ARG3, str_rs_lin_trans);
  RealSet* rs = scm2realset(scm_rs);
  double a = gh_scm2double(scm_a);
  double b = gh_scm2double(scm_b);
  rs->linear_transform(a,b);
  return scm_rs;
}

GOOSE_PROC(rs_log_trans, "realset-log-transform!",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_log_trans);
  RealSet* rs = scm2realset(scm_rs);
  rs->log_transform();
  return scm_rs;
}


GOOSE_PROC(rs_exp_trans, "realset-exp-transform!",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_exp_trans);
  RealSet* rs = scm2realset(scm_rs);
  rs->exp_transform();
  return scm_rs;
}

GOOSE_PROC(rs_logit_trans, "realset-logit-transform!",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_logit_trans);
  RealSet* rs = scm2realset(scm_rs);
  rs->logit_transform();
  return scm_rs;
}

GOOSE_PROC(rs_reverse, "realset-reverse!",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_reverse);
  RealSet* rs = scm2realset(scm_rs);
  rs->reverse();
  return scm_rs;
}

GOOSE_PROC(rs_scramble, "realset-scramble!",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_scramble);
  RealSet* rs = scm2realset(scm_rs);
  rs->scramble();
  return scm_rs;
}

GOOSE_PROC(rs_rank, "realset-rank!",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_rank);
  RealSet* rs = scm2realset(scm_rs);
  rs->rank();
  return scm_rs;
}

GOOSE_PROC(rs_std, "realset-standardize!",
	   1,0,0, (SCM scm_rs))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_std);
  RealSet* rs = scm2realset(scm_rs);
  rs->standardize();
  return scm_rs;
}

GOOSE_PROC(rs_gt, "realset-greater-than",
	   2,0,0, (SCM scm_rs, SCM scm_x))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_gt);
  SCM_ASSERT(gh_number_p(scm_x), scm_x, SCM_ARG2, str_rs_gt);
  RealSet* rs = scm2realset(scm_rs);
  double x = gh_scm2double(scm_x);
  return gh_int2scm(rs->greater_than(x));
}

GOOSE_PROC(rs_lt, "realset-less-than",
	   2,0,0, (SCM scm_rs, SCM scm_x))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_lt);
  SCM_ASSERT(gh_number_p(scm_x), scm_x, SCM_ARG2, str_rs_lt);
  RealSet* rs = scm2realset(scm_rs);
  double x = gh_scm2double(scm_x);
  return gh_int2scm(rs->less_than(x));
}

GOOSE_PROC(rs_between, "realset-between",
	   3,0,0, (SCM scm_rs, SCM scm_x, SCM scm_y))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_between);
  SCM_ASSERT(gh_number_p(scm_x), scm_x, SCM_ARG2, str_rs_between);
  SCM_ASSERT(gh_number_p(scm_y), scm_y, SCM_ARG3, str_rs_between);
  RealSet* rs = scm2realset(scm_rs);
  double x = gh_scm2double(scm_x);
  double y = gh_scm2double(scm_y);
  return gh_int2scm(rs->between(x,y));
}

GOOSE_PROC(rs_eq, "realset-equal-to",
	   2,0,0, (SCM scm_rs, SCM scm_x))
{
  SCM_ASSERT(REALSET_P(scm_rs), scm_rs, SCM_ARG1, str_rs_eq);
  SCM_ASSERT(gh_number_p(scm_x), scm_x, SCM_ARG2, str_rs_eq);
  RealSet* rs = scm2realset(scm_rs);
  double x = gh_scm2double(scm_x);
  return gh_int2scm(rs->equal_to(x));
}

GOOSE_PROC(rs_set_add, "realset+",
	   2,0,0, (SCM rs1, SCM rs2))
{
  SCM_ASSERT(REALSET_P(rs1), rs1, SCM_ARG1, str_rs_set_add);
  SCM_ASSERT(REALSET_P(rs2), rs2, SCM_ARG1, str_rs_set_add);

  RealSet* rs = 0;
  try {
    // Crap: potential memory leak if something throws.
    rs = new RealSet(*scm2realset(rs1));
    *rs += *scm2realset(rs2);
  } GOOSE_CATCH(str_rs_set_add);
  
  return realset2scm(rs);
}

GOOSE_PROC(rs_set_sub, "realset-",
	   2,0,0, (SCM rs1, SCM rs2))
{
  SCM_ASSERT(REALSET_P(rs1), rs1, SCM_ARG1, str_rs_set_sub);
  SCM_ASSERT(REALSET_P(rs2), rs2, SCM_ARG1, str_rs_set_sub);

  RealSet* rs = 0;
  try {
    // Crap: potential memory leak if something throws.
    rs = new RealSet(*scm2realset(rs1));
    *rs -= *scm2realset(rs2);
  } GOOSE_CATCH(str_rs_set_sub);
  
  return realset2scm(rs);
}

GOOSE_PROC(rs_set_mul, "realset*",
	   2,0,0, (SCM rs1, SCM rs2))
{
  SCM_ASSERT(REALSET_P(rs1), rs1, SCM_ARG1, str_rs_set_mul);
  SCM_ASSERT(REALSET_P(rs2), rs2, SCM_ARG1, str_rs_set_mul);

  RealSet* rs = 0;
  try { 
    // Crap: potential memory leak if something throws.
    rs = new RealSet(*scm2realset(rs1));
    *rs *= *scm2realset(rs2);
  } GOOSE_CATCH(str_rs_set_mul);
  
  return realset2scm(rs);
}


//////////////////////////////////////////////////////////////////////////////

void
scm_init_realset()
{
  static bool initialized = false;
  if (initialized) return;
  initialized = true;

  realset_type_tag = scm_newsmob(&realset_funcs);

#include "RealSet_smob.x"

}


// $Id: RealSet_smob.cpp,v 1.13 1999/07/15 19:01:54 trow Exp $