コード例 #1
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rdirichlet_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  nl_Matrix *v, *alpha = nl_checkmatrix(L, 1);
  lua_Number *ea, *ev, s;
  int i;
  checkrvector(L, alpha, 1);
  for (i = 0, ea = alpha->data; i < alpha->size; i++, ea += alpha->stride)
    luaL_argcheck(L, *ea > 0, 1, "nonpositive entry");
  lua_settop(L, 2);
  if (lua_isnil(L, 2))
    v = nl_pushmatrix(L, 0, 1, alpha->dim, 1, alpha->size,
        lua_newuserdata(L, alpha->size * sizeof(lua_Number)));
  else {
    v = nl_checkmatrix(L, 2);
    checkrvector(L, v, 2);
    luaL_argcheck(L, alpha->size == v->size, 2, "vector sizes differ");
  }
  /* sample gammas */
  ea = alpha->data;
  ev = v->data;
  s = 0;
  for (i = 0; i < v->size; i++) {
    s += *ev = gengam(r, *ea, 1);
    ev += v->stride;
    ea += alpha->stride;
  }
  /* normalize */
  for (i = 0, ev = v->data; i < v->size; i++, ev += v->stride)
    *ev /= s;
  return 1;
}
コード例 #2
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rgamma_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  lua_Number a = luaL_checknumber(L, 1);
  lua_Number s = luaL_optnumber(L, 2, 1);
  setdeviate(number, gengam(r, s, a), 3);
  return 1;
}
コード例 #3
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rpois_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  lua_Number mu = luaL_checknumber(L, 1);
  checkneg(L, mu);
  setdeviate(integer, ignpoi(r, mu), 2);
  return 1;
}
コード例 #4
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rnorm_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  lua_Number mean = luaL_optnumber(L, 1, 0);
  lua_Number sd = luaL_optnumber(L, 2, 1);
  checknp(L, sd);
  setdeviate(number, gennor(r, mean, sd), 3);
  return 1;
}
コード例 #5
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int runifint_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  int low = luaL_optinteger(L, 1, 0);
  int high = luaL_optinteger(L, 2, 0x7ffffffeUL);
  if (low > high)
    luaL_error(L, "inconsistent parameters: %d > %d", low, high);
  setdeviate(integer, ignuin(r, low, high), 3);
  return 1;
}
コード例 #6
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rbeta_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  lua_Number a = luaL_checknumber(L, 1);
  lua_Number b = luaL_checknumber(L, 2);
  checknp(L, a);
  checknp(L, b);
  setdeviate(number, genbet(r, a, b), 3);
  return 1;
}
コード例 #7
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rchisq_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  lua_Number df = luaL_checknumber(L, 1);
  lua_Number xnonc = luaL_optnumber(L, 2, 0);
  checknp(L, df);
  checkneg(L, xnonc);
  setdeviate(number,
      (xnonc == 0) ? genchi(r, df) : gennch(r, df, xnonc), 3);
  return 1;
}
コード例 #8
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rnbinom_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  int n = luaL_checkinteger(L, 1);
  lua_Number p = luaL_checknumber(L, 2);
  checkneg(L, n);
  if (p <= 0 || p >= 1)
    luaL_error(L, "parameter is out of range: %f", p);
  setdeviate(integer, ignnbn(r, n, p), 3);
  return 1;
}
コード例 #9
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int runif_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  lua_Number low = luaL_optnumber(L, 1, 0);
  lua_Number high = luaL_optnumber(L, 2, 1);
  if (low > high)
    luaL_error(L, "inconsistent parameters: %f > %f", low, high);
  if (low == 0 && high == 1)
    setdeviate(number, ranf(r), 3);
  else
    setdeviate(number, genunf(r, low, high), 3);
  return 1;
}
コード例 #10
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rf_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  lua_Number dfn = luaL_checknumber(L, 1);
  lua_Number dfd = luaL_checknumber(L, 2);
  lua_Number xnc = luaL_optnumber(L, 3, 0);
  checknp(L, dfn);
  checknp(L, dfd);
  checkneg(L, xnc);
  setdeviate(number,
      (xnc == 0) ? genf(r, dfn, dfd) : gennf(r, dfn, dfd, xnc), 4);
  return 1;
}
コード例 #11
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int runifx_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  lua_Number low = luaL_optnumber(L, 1, 0);
  lua_Number high = luaL_optnumber(L, 2, 1);
  lua_Number range = high - low;
  if (range < 0)
    luaL_error(L, "inconsistent parameters: %f > %f", low, high);
  if (low == 0 && high == 1)
    setdeviate(number, genrand_res53(r), 3); /* note: [0, 1) */
  else
    setdeviate(number, low + range * genrand_res53(r), 3);
  return 1;
}
コード例 #12
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int seed_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  if (lua_isnoneornil(L, 1))
    init_genrand(r, RNG_SEED);
  else if (lua_isnumber(L, 1)) /* seed? */
    init_genrand(r, lua_tointeger(L, 1));
  else { /* vector */
    unsigned long initkey[RNG_MAXSTATES];
    int i, k;
    lua_Number *e;
    nl_Matrix *m = nl_checkmatrix(L, 1);
    checkrvector(L, m, 1);
    for (i = 0, e = m->data; i < m->size; i++, e += m->stride) {
      lua_number2int(k, *e);
      initkey[i] = (unsigned long) k;
    }
    init_by_array(r, initkey, m->size);
  }
  return 0;
}
コード例 #13
0
ファイル: arx.c プロジェクト: EmanAliHassan/csl-validator.js
static void getsym(void) {
  for(;;) {
    if(0<=cc&&cc<=' ') {getcc(); continue;}
    switch(cc) {
    case -1: sym=SYM_EOF; return;
    case '#': do getcc(); while(cc!='\n'&&cc!='\r'); getcc(); continue;
    case '{':
      if(sym==SYM_VALD||sym==SYM_NVAL) {
	getrng(); sym=SYM_RENG;
      } else {
	getcc(); sym=SYM_LCUR;
      }
      return;
    case '}': getcc(); sym=SYM_RCUR; return;
    case '!': getcc();
      if(cc=='~') {
	getcc(); sym=SYM_NMTC;
      } else {
	if(getid()) {
	  if(strcmp("valid",value)!=0) {error(ARX_ER_EXP,sym2str(SYM_NVAL),value);} sym=SYM_NVAL;
	} else {error(ARX_ER_SYN); sym=SYM_INVL;}
      }
      return;
    case '=': getcc();
      switch(cc) {
      case '~': getcc(); sym=SYM_MTCH; return;
      case '>': getcc(); if(sym!=SYM_RGXP) error(ARX_ER_SYN); continue;
      default: sym=SYM_ASGN; return;
      }
    case '"': getq(); sym=SYM_LTRL; return;
    case '/': getq(); sym=SYM_RGXP; return;
    default:
      if(getid()) {
	sym=strcmp("grammars",value)==0?SYM_GRMS
	 : strcmp("valid",value)==0?SYM_VALD:SYM_IDNT;
      } else {getcc(); error(ARX_ER_SYN); sym=SYM_INVL;}
      return;
    }
  }
}
コード例 #14
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int lsample_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  nl_Matrix *w = nl_checkmatrix(L, 1);
  int i, normalized = lua_toboolean(L, 2);
  lua_Number *e, c, u, z = 0;
  checkrvector(L, w, 1);
  /* compute normalizing constant */
  if (!normalized) {
    e = w->data; z = *e;
    for (i = 1; i < w->size; i++) {
      e += w->stride;
      z = nl_lse(z, *e);
    }
  }
  /* sample */
  c = 0; u = ranf(r); e = w->data;
  for (i = 0; i < w->size && u >= c; i++) {
    if (!isinf(*e)) c += exp(*e - z);
    e += w->stride;
  }
  lua_pushinteger(L, i);
  return 1;
}
コード例 #15
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int copy_rng (lua_State *L) {
  nl_RNG *c = getrng(L);
  nl_RNG *r = newrng(L);
  *r = *c;
  return 1;
}
コード例 #16
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rexp_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  lua_Number av = luaL_optnumber(L, 1, 1);
  setdeviate(number, genexp(r, av), 2);
  return 1;
}
コード例 #17
0
ファイル: rng.c プロジェクト: LuaDist/numlua
static int rmvnorm_rng (lua_State *L) {
  nl_RNG *r = getrng(L);
  nl_Matrix *m = nl_checkmatrix(L, 1);
  nl_Matrix *S = nl_checkmatrix(L, 2);
  nl_Matrix *u;
  int i, n = m->size;
  lua_Number *em, *ev, *eu;
  /* check args */
  checkrvector(L, m, 1);
  luaL_argcheck(L, !S->iscomplex, 2, "real matrix expected");
  if (S->ndims == 1) {
    luaL_argcheck(L, S->size == n, 2, "arguments are not conformable");
    for (i = 0, ev = S->data; i < n; i++, ev += S->stride)
      luaL_argcheck(L, *ev > 0, 2, "variance is not positive");
  }
  else
    luaL_argcheck(L, S->ndims == 2 && S->dim[0] == n && S->dim[1] == n, 2,
        "arguments are not conformable");
  /* setup destination */
  lua_settop(L, 3);
  if (lua_isnil(L, 3))
    u = nl_pushmatrix(L, 0, 1, &n, 1, n,
        lua_newuserdata(L, n * sizeof(lua_Number)));
  else {
    u = nl_checkmatrix(L, 3);
    checkrvector(L, u, 3);
    luaL_argcheck(L, u->size == n, 3, "arguments are not conformable");
  }
  /* sample */
  if (S->ndims == 1) {
    em = m->data; ev = S->data; eu = u->data;
    for (i = 0; i < n; i++) {
      *eu = gennor(r, *em, *ev);
      em += m->stride; ev += S->stride; eu += u->stride;
    }
  }
  else {
    char uplo = 'L', trans = 'N', diag = 'N';
    lua_Number one = 1.0;
    /* u ~ N(0, I_n) */
    eu = u->data;
    for (i = 0; i < n; i++, eu += u->stride)
      *eu = gennor(r, 0, 1);
    /* u = S * u */
    if (S->stride != 1 /* non-unitary stride? */
        || (S->section != NULL /* non-block section? */
          && (S->section[0].step != 1 || S->section[1].step != 1))) {
      nl_Buffer *buf = nl_getbuffer(L, n * n);
      /* copy S to buffer */
      for (i = 0; i < S->size; i++)
        buf->data.bnum[i] = S->data[nl_mshift(S, i)];
      DTRMV(&uplo, &trans, &diag, &n, buf->data.bnum, &n,
          u->data, &u->stride, 1, 1, 1);
      nl_freebuffer(buf);
    }
    else {
      int ld = S->section ? S->section[0].ld : S->dim[0];
      DTRMV(&uplo, &trans, &diag, &n, S->data, &ld,
          u->data, &u->stride, 1, 1, 1);
    }
    /* u = u + m */
    DAXPY(&n, &one, m->data, &m->stride, u->data, &u->stride);
  }
  return 1;
}