void strrev_utf8(char *p)
{
char *q = p;
strrev(p); /* call base case */
/* Ok, now fix bass-ackwards UTF chars. */
while(q && *q) ++q; /* find eos */
while(p < --q)
switch( (*q & 0xF0) >> 4 ) {
case 0xF: /* U+010000-U+10FFFF: four bytes. */
SWP(*(q-0), *(q-3));
SWP(*(q-1), *(q-2));
q -= 3;
break;
case 0xE: /* U+000800-U+00FFFF: three bytes. */
SWP(*(q-0), *(q-2));
q -= 2;
break;
case 0xC: /* fall-through */
case 0xD: /* U+000080-U+0007FF: two bytes. */
SWP(*(q-0), *(q-1));
q--;
break;
}
}
int main()
{
freopen("in.txt","r",stdin);
char a[N+1],b[N+1];
scanf("%s%s",a,b);
int ans=0,i=0;
for(;a[i];++i)
if(a[i]!=b[i])
{
int j=i;
for(;b[j] && a[i]!=b[j];++j)
++ans;
if(b[j]=='\0')
{
printf("-1");
return 0;
}
SWP(b[i],b[j]);
}
if(b[i])
printf("-1");
else
printf("%d",ans);
return 0;
}
// draw from MVN -- adapted from R package MNP
void rMVN(
std::vector<double>& Sample,
std::vector<double>& mean,
std::vector<std::vector<double> >& Var,
size_t size)
{
GetRNGstate();
std::vector<std::vector<double> > Model;
Model.resize(size +1);
for(size_t j=0; j<= size; j++){
Model[j].resize(size + 1);
}
double cond_mean;
/* draw from mult. normal using SWP */
for(size_t j=1;j<=size;j++){
for(size_t k=1;k<=size;k++) {
Model[j][k]=Var[j-1][k-1];
}
Model[0][j]=mean[j-1];
Model[j][0]=mean[j-1];
}
Model[0][0]=-1;
Sample[0]=(double)norm_rand()*sqrt(Model[1][1])+Model[0][1];
for(size_t j=2;j<=size;j++){
SWP(Model,j-1,size+1);
cond_mean=Model[j][0];
for(size_t k=1;k<j;k++) cond_mean+=Sample[k-1]*Model[j][k];
Sample[j-1]=(double)norm_rand()*sqrt(Model[j][j])+cond_mean;
}
PutRNGstate();
}
/* Sample from the MVN dist */
void rMVN(
double *Sample, /* Vector for the sample */
double *mean, /* The vector of means */
double **Var, /* The matrix Variance */
int size) /* The dimension */
{
int j,k;
double **Model = doubleMatrix(size+1, size+1);
double cond_mean;
/* draw from mult. normal using SWP */
for(j=1;j<=size;j++){
for(k=1;k<=size;k++)
Model[j][k]=Var[j-1][k-1];
Model[0][j]=mean[j-1];
Model[j][0]=mean[j-1];
}
Model[0][0]=-1;
Sample[0]=(double)norm_rand()*sqrt(Model[1][1])+Model[0][1];
for(j=2;j<=size;j++){
SWP(Model,j-1,size+1);
cond_mean=Model[j][0];
for(k=1;k<j;k++) cond_mean+=Sample[k-1]*Model[j][k];
Sample[j-1]=(double)norm_rand()*sqrt(Model[j][j])+cond_mean;
}
FreeMatrix(Model,size+1);
}
static void control_SPSEL_write(bool spsel, bool force, enum Mode forced_mode) {
union control_t c;
c.storage = SR(&physical_control.storage);
c.SPSEL = spsel;
SW(&physical_control.storage, c.storage);
enum Mode mode = (force) ? forced_mode : CORE_CurrentMode_read();
(void) mode;
// XXX: I'm confused on exactly the semantics here, esp w.r.t. exceptions
//if (mode == Mode_Thread) {
SWP(&physical_sp_p, (spsel) ? &sp_process : &sp_main);
//} else {
// CORE_ERR_unpredictable("SPSEL write in Handler mode\n");
//}
}
SYSLIBFUNC(BOOL) StrReverseW(LPCWSTR lpSource,DWORD dwSourceSize,LPWSTR lpOut)
{
bool bRet=false;
do
{
if (!SYSLIB_SAFE::CheckStrParamW(lpSource,dwSourceSize))
break;
if (!dwSourceSize)
{
dwSourceSize=lstrlenW(lpSource);
if (!dwSourceSize)
break;
}
if (!SYSLIB_SAFE::CheckParamWrite(lpOut,(dwSourceSize+1)*sizeof(WCHAR)))
break;
if (lpSource != lpOut)
{
for (int i=0, j=dwSourceSize-1; j >= 0; i++, j--)
lpOut[i]=lpSource[j];
}
else
{
LPWSTR lpEnd=lpOut+dwSourceSize;
for (lpEnd--; lpOut < lpEnd; lpOut++, lpEnd--)
SWP(*lpOut,*lpEnd);
}
lpOut[dwSourceSize]=0;
bRet=true;
}
while (false);
return bRet;
}
inline void swp(int i, int j) {
SWP(q[i], q[j]), SWP(loc[q[i]], loc[q[j]]); }
SYSLIBFUNC(BOOL) StrReverseA(LPCSTR lpSource,DWORD dwSourceSize,LPSTR lpOut)
{
bool bRet=false;
do
{
if (!SYSLIB_SAFE::CheckStrParamA(lpSource,dwSourceSize))
break;
if (!dwSourceSize)
{
dwSourceSize=lstrlenA(lpSource);
if (!dwSourceSize)
break;
}
if (!SYSLIB_SAFE::CheckParamWrite(lpOut,dwSourceSize+1))
break;
if (lpSource != lpOut)
{
for (int i=0, j=dwSourceSize-1; j >= 0; i++, j--)
{
char cChr=lpSource[i];
switch ((cChr & 0xF0) >> 4)
{
case 0xF: /* U+010000-U+10FFFF: four bytes. */
{
memcpy(&lpOut[j-3],&lpSource[i],4);
i+=3;
j-=3;
break;
}
case 0xE: /* U+000800-U+00FFFF: three bytes. */
{
memcpy(&lpOut[j-1],&lpSource[i],3);
i+=2;
j-=2;
break;
}
case 0xC: /* fall-through */
case 0xD: /* U+000080-U+0007FF: two bytes. */
{
memcpy(&lpOut[j-1],&lpSource[i],2);
i++;
j--;
break;
}
default:
{
lpOut[j]=cChr;
break;
}
}
}
}
else
{
LPSTR lpEnd=lpOut+dwSourceSize;
for (lpEnd--; lpOut < lpEnd; lpOut++, lpEnd--)
SWP(*lpOut,*lpEnd);
lpOut=(LPSTR)lpSource;
lpEnd=lpOut+dwSourceSize;
while (lpSource < --lpEnd)
{
switch ((*lpEnd & 0xF0) >> 4)
{
case 0xF: /* U+010000-U+10FFFF: four bytes. */
{
SWP(*(lpEnd-0),*(lpEnd-3));
SWP(*(lpEnd-1),*(lpEnd-2));
lpEnd-=3;
break;
}
case 0xE: /* U+000800-U+00FFFF: three bytes. */
{
SWP(*(lpEnd-0),*(lpEnd-2));
lpEnd-=2;
break;
}
case 0xC: /* fall-through */
case 0xD: /* U+000080-U+0007FF: two bytes. */
{
SWP(*(lpEnd-0),*(lpEnd-1));
lpEnd--;
break;
}
}
}
}
bRet=true;
lpOut[dwSourceSize]=0;
}
void MARprobit(int *Y, /* binary outcome variable */
int *Ymiss, /* missingness indicator for Y */
int *iYmax, /* maximum value of Y; 0,1,...,Ymax */
int *Z, /* treatment assignment */
int *D, /* treatment status */
int *C, /* compliance status */
double *dX, double *dXo, /* covariates */
double *dBeta, double *dGamma, /* coefficients */
int *iNsamp, int *iNgen, int *iNcov, int *iNcovo,
int *iNcovoX, int *iN11,
/* counters */
double *beta0, double *gamma0, double *dA, double *dAo, /*prior */
int *insample, /* 1: insample inference, 2: conditional inference */
int *smooth,
int *param, int *mda, int *iBurnin,
int *iKeep, int *verbose, /* options */
double *pdStore
) {
/*** counters ***/
int n_samp = *iNsamp; /* sample size */
int n_gen = *iNgen; /* number of gibbs draws */
int n_cov = *iNcov; /* number of covariates */
int n_covo = *iNcovo; /* number of all covariates for outcome model */
int n_covoX = *iNcovoX; /* number of covariates excluding smooth
terms */
int n11 = *iN11; /* number of compliers in the treament group */
/*** data ***/
double **X; /* covariates for the compliance model */
double **Xo; /* covariates for the outcome model */
double *W; /* latent variable */
int Ymax = *iYmax;
/*** model parameters ***/
double *beta; /* coef for compliance model */
double *gamma; /* coef for outcomme model */
double *q; /* some parameters for sampling C */
double *pc;
double *pn;
double pcmean;
double pnmean;
double **SS; /* matrix folders for SWEEP */
double **SSo;
// HJ commented it out on April 17, 2018
// double **SSr;
double *meanb; /* means for beta and gamma */
double *meano;
double *meanr;
double **V; /* variances for beta and gamma */
double **Vo;
double **Vr;
double **A;
double **Ao;
double *tau; /* thresholds: tau_0, ..., tau_{Ymax-1} */
double *taumax; /* corresponding max and min for tau */
double *taumin; /* tau_0 is fixed to 0 */
double *treat; /* smooth function for treat */
/*** quantities of interest ***/
int n_comp, n_compC, n_ncompC;
double *ITTc;
double *base;
/*** storage parameters and loop counters **/
int progress = 1;
int keep = 1;
int i, j, k, main_loop;
int itemp, itempP = ftrunc((double) n_gen/10);
double dtemp, ndraw, cdraw;
double *vtemp;
double **mtemp, **mtempo;
/*** marginal data augmentation ***/
double sig2 = 1;
int nu0 = 1;
double s0 = 1;
/*** get random seed **/
GetRNGstate();
/*** define vectors and matricies **/
X = doubleMatrix(n_samp+n_cov, n_cov+1);
Xo = doubleMatrix(n_samp+n_covo, n_covo+1);
W = doubleArray(n_samp);
tau = doubleArray(Ymax);
taumax = doubleArray(Ymax);
taumin = doubleArray(Ymax);
SS = doubleMatrix(n_cov+1, n_cov+1);
SSo = doubleMatrix(n_covo+1, n_covo+1);
// HJ commented it out on April 17, 2018
// SSr = doubleMatrix(4, 4);
V = doubleMatrix(n_cov, n_cov);
Vo = doubleMatrix(n_covo, n_covo);
Vr = doubleMatrix(3, 3);
beta = doubleArray(n_cov);
gamma = doubleArray(n_covo);
meanb = doubleArray(n_cov);
meano = doubleArray(n_covo);
meanr = doubleArray(3);
q = doubleArray(n_samp);
pc = doubleArray(n_samp);
pn = doubleArray(n_samp);
A = doubleMatrix(n_cov, n_cov);
Ao = doubleMatrix(n_covo, n_covo);
vtemp = doubleArray(n_samp);
mtemp = doubleMatrix(n_cov, n_cov);
mtempo = doubleMatrix(n_covo, n_covo);
ITTc = doubleArray(Ymax+1);
treat = doubleArray(n11);
base = doubleArray(2);
/*** read the data ***/
itemp = 0;
for (j =0; j < n_cov; j++)
for (i = 0; i < n_samp; i++)
X[i][j] = dX[itemp++];
itemp = 0;
for (j =0; j < n_covo; j++)
for (i = 0; i < n_samp; i++)
Xo[i][j] = dXo[itemp++];
/*** read the prior and it as additional data points ***/
itemp = 0;
for (k = 0; k < n_cov; k++)
for (j = 0; j < n_cov; j++)
A[j][k] = dA[itemp++];
itemp = 0;
for (k = 0; k < n_covo; k++)
for (j = 0; j < n_covo; j++)
Ao[j][k] = dAo[itemp++];
dcholdc(A, n_cov, mtemp);
for(i = 0; i < n_cov; i++) {
X[n_samp+i][n_cov]=0;
for(j = 0; j < n_cov; j++) {
X[n_samp+i][n_cov] += mtemp[i][j]*beta0[j];
X[n_samp+i][j] = mtemp[i][j];
}
}
dcholdc(Ao, n_covo, mtempo);
for(i = 0; i < n_covo; i++) {
Xo[n_samp+i][n_covo]=0;
for(j = 0; j < n_covo; j++) {
Xo[n_samp+i][n_covo] += mtempo[i][j]*gamma0[j];
Xo[n_samp+i][j] = mtempo[i][j];
}
}
/*** starting values ***/
for (i = 0; i < n_cov; i++)
beta[i] = dBeta[i];
for (i = 0; i < n_covo; i++)
gamma[i] = dGamma[i];
if (Ymax > 1) {
tau[0] = 0.0;
taumax[0] = 0.0;
taumin[0] = 0.0;
for (i = 1; i < Ymax; i++)
tau[i] = tau[i-1]+2/(double)(Ymax-1);
}
for (i = 0; i < n_samp; i++) {
pc[i] = unif_rand();
pn[i] = unif_rand();
}
/*** Gibbs Sampler! ***/
itemp=0;
for(main_loop = 1; main_loop <= n_gen; main_loop++){
/** COMPLIANCE MODEL **/
if (*mda) sig2 = s0/rchisq((double)nu0);
/* Draw complier status for control group */
for(i = 0; i < n_samp; i++){
dtemp = 0;
for(j = 0; j < n_cov; j++)
dtemp += X[i][j]*beta[j];
if(Z[i] == 0){
q[i] = pnorm(dtemp, 0, 1, 1, 0);
if(unif_rand() < (q[i]*pc[i]/(q[i]*pc[i]+(1-q[i])*pn[i]))) {
C[i] = 1; Xo[i][1] = 1;
}
else {
C[i] = 0; Xo[i][1] = 0;
}
}
/* Sample W */
if(C[i]==0)
W[i] = TruncNorm(dtemp-100,0,dtemp,1,0);
else
W[i] = TruncNorm(0,dtemp+100,dtemp,1,0);
X[i][n_cov] = W[i]*sqrt(sig2);
W[i] *= sqrt(sig2);
}
/* SS matrix */
for(j = 0; j <= n_cov; j++)
for(k = 0; k <= n_cov; k++)
SS[j][k]=0;
for(i = 0; i < n_samp+n_cov; i++)
for(j = 0; j <= n_cov; j++)
for(k = 0; k <= n_cov; k++)
SS[j][k] += X[i][j]*X[i][k];
/* SWEEP SS matrix */
for(j = 0; j < n_cov; j++)
SWP(SS, j, n_cov+1);
/* draw beta */
for(j = 0; j < n_cov; j++)
meanb[j] = SS[j][n_cov];
if (*mda)
sig2=(SS[n_cov][n_cov]+s0)/rchisq((double)n_samp+nu0);
for(j = 0; j < n_cov; j++)
for(k = 0; k < n_cov; k++) V[j][k] = -SS[j][k]*sig2;
rMVN(beta, meanb, V, n_cov);
/* rescale the parameters */
if(*mda) {
for (i = 0; i < n_cov; i++) beta[i] /= sqrt(sig2);
}
/** OUTCOME MODEL **/
/* Sample W */
if (Ymax > 1) { /* tau_0=0, tau_1, ... */
for (j = 1; j < (Ymax - 1); j++) {
taumax[j] = tau[j+1];
taumin[j] = tau[j-1];
}
taumax[Ymax-1] = tau[Ymax-1]+100;
taumin[Ymax-1] = tau[Ymax-2];
}
if (*mda) sig2 = s0/rchisq((double)nu0);
for (i = 0; i < n_samp; i++){
dtemp = 0;
for (j = 0; j < n_covo; j++) dtemp += Xo[i][j]*gamma[j];
if (Ymiss[i] == 1) {
W[i] = dtemp + norm_rand();
if (Ymax == 1) { /* binary probit */
if (W[i] > 0) Y[i] = 1;
else Y[i] = 0;
}
else { /* ordered probit */
if (W[i] >= tau[Ymax-1])
Y[i] = Ymax;
else {
j = 0;
while (W[i] > tau[j] && j < Ymax) j++;
Y[i] = j;
}
}
}
else {
if(Ymax == 1) { /* binary probit */
if(Y[i] == 0) W[i] = TruncNorm(dtemp-100,0,dtemp,1,0);
else W[i] = TruncNorm(0,dtemp+100,dtemp,1,0);
}
else { /* ordered probit */
if (Y[i] == 0)
W[i] = TruncNorm(dtemp-100, 0, dtemp, 1, 0);
else if (Y[i] == Ymax) {
W[i] = TruncNorm(tau[Ymax-1], dtemp+100, dtemp, 1, 0);
if (W[i] < taumax[Ymax-1]) taumax[Ymax-1] = W[i];
}
else {
W[i] = TruncNorm(tau[Y[i]-1], tau[Y[i]], dtemp, 1, 0);
if (W[i] > taumin[Y[i]]) taumin[Y[i]] = W[i];
if (W[i] < taumax[Y[i]-1]) taumax[Y[i]-1] = W[i];
}
}
}
Xo[i][n_covo] = W[i]*sqrt(sig2);
W[i] *= sqrt(sig2);
}
/* draw tau */
if (Ymax > 1)
for (j = 1; j < Ymax; j++)
tau[j] = runif(taumin[j], taumax[j])*sqrt(sig2);
/* SS matrix */
for(j = 0; j <= n_covo; j++)
for(k = 0; k <= n_covo; k++)
SSo[j][k]=0;
for(i = 0;i < n_samp+n_covo; i++)
for(j = 0;j <= n_covo; j++)
for(k = 0; k <= n_covo; k++)
SSo[j][k] += Xo[i][j]*Xo[i][k];
/* SWEEP SS matrix */
for(j = 0; j < n_covo; j++)
SWP(SSo, j, n_covo+1);
/* draw gamma */
for(j = 0; j < n_covo; j++)
meano[j] = SSo[j][n_covo];
if (*mda)
sig2=(SSo[n_covo][n_covo]+s0)/rchisq((double)n_samp+nu0);
for(j = 0; j < n_covo; j++)
for(k = 0; k < n_covo; k++) Vo[j][k]=-SSo[j][k]*sig2;
rMVN(gamma, meano, Vo, n_covo);
/* rescaling the parameters */
if(*mda) {
for (i = 0; i < n_covo; i++) gamma[i] /= sqrt(sig2);
if (Ymax > 1)
for (i = 1; i < Ymax; i++)
tau[i] /= sqrt(sig2);
}
/* computing smooth terms */
if (*smooth) {
for (i = 0; i < n11; i++) {
treat[i] = 0;
for (j = n_covoX; j < n_covo; j++)
treat[i] += Xo[i][j]*gamma[j];
}
}
/** Compute probabilities **/
for(i = 0; i < n_samp; i++){
vtemp[i] = 0;
for(j = 0; j < n_covo; j++)
vtemp[i] += Xo[i][j]*gamma[j];
}
for(i = 0; i < n_samp; i++){
if(Z[i]==0){
if (C[i] == 1) {
pcmean = vtemp[i];
if (*smooth)
pnmean = vtemp[i]-gamma[0];
else
pnmean = vtemp[i]-gamma[1];
}
else {
if (*smooth)
pcmean = vtemp[i]+gamma[0];
else
pcmean = vtemp[i]+gamma[1];
pnmean = vtemp[i];
}
if (Y[i] == 0){
pc[i] = pnorm(0, pcmean, 1, 1, 0);
pn[i] = pnorm(0, pnmean, 1, 1, 0);
}
else {
if (Ymax == 1) { /* binary probit */
pc[i] = pnorm(0, pcmean, 1, 0, 0);
pn[i] = pnorm(0, pnmean, 1, 0, 0);
}
else { /* ordered probit */
if (Y[i] == Ymax) {
pc[i] = pnorm(tau[Ymax-1], pcmean, 1, 0, 0);
pn[i] = pnorm(tau[Ymax-1], pnmean, 1, 0, 0);
}
else {
pc[i] = pnorm(tau[Y[i]], pcmean, 1, 1, 0) -
pnorm(tau[Y[i]-1], pcmean, 1, 1, 0);
pn[i] = pnorm(tau[Y[i]], pnmean, 1, 1, 0) -
pnorm(tau[Y[i]-1], pnmean, 1, 1, 0);
}
}
}
}
}
/** Compute quantities of interest **/
n_comp = 0; n_compC = 0; n_ncompC = 0; base[0] = 0; base[1] = 0;
for (i = 0; i <= Ymax; i++)
ITTc[i] = 0;
if (*smooth) {
for(i = 0; i < n11; i++){
if(C[i] == 1) {
n_comp++;
if (Z[i] == 0) {
n_compC++;
base[0] += (double)Y[i];
}
pcmean = vtemp[i];
pnmean = vtemp[i]-treat[i]+gamma[0];
ndraw = rnorm(pnmean, 1);
cdraw = rnorm(pcmean, 1);
if (*insample && Ymiss[i]==0)
dtemp = (double)(Y[i]==0) - (double)(ndraw < 0);
else
dtemp = pnorm(0, pcmean, 1, 1, 0) - pnorm(0, pnmean, 1, 1, 0);
ITTc[0] += dtemp;
if (Ymax == 1) { /* binary probit */
if (*insample && Ymiss[i]==0)
dtemp = (double)Y[i] - (double)(ndraw > 0);
else
dtemp = pnorm(0, pcmean, 1, 0, 0) - pnorm(0, pnmean, 1, 0, 0);
ITTc[1] += dtemp;
}
else { /* ordered probit */
if (*insample && Ymiss[i]==0)
dtemp = (double)(Y[i]==Ymax) - (double)(ndraw > tau[Ymax-1]);
else
dtemp = pnorm(tau[Ymax-1], pcmean, 1, 0, 0) -
pnorm(tau[Ymax-1], pnmean, 1, 0, 0);
ITTc[Ymax] += dtemp;
for (j = 1; j < Ymax; j++) {
if (*insample && Ymiss[i]==0)
dtemp = (double)(Y[i]==j) - (double)(ndraw < tau[j] &&
ndraw > tau[j-1]);
else
dtemp = (pnorm(tau[j], pcmean, 1, 1, 0) -
pnorm(tau[j-1], pcmean, 1, 1, 0))
- (pnorm(tau[j], pnmean, 1, 1, 0) -
pnorm(tau[j-1], pnmean, 1, 1, 0));
ITTc[j] += dtemp;
}
}
}
else
if (Z[i] == 0) {
n_ncompC++;
base[1] += (double)Y[i];
}
}
}
else {
for(i = 0; i < n_samp; i++){
if(C[i] == 1) {
n_comp++;
if (Z[i] == 1) {
pcmean = vtemp[i];
pnmean = vtemp[i]-gamma[0]+gamma[1];
}
else {
n_compC++;
base[0] += (double)Y[i];
pcmean = vtemp[i]+gamma[0]-gamma[1];
pnmean = vtemp[i];
}
ndraw = rnorm(pnmean, 1);
cdraw = rnorm(pcmean, 1);
if (*insample && Ymiss[i]==0) {
if (Z[i] == 1)
dtemp = (double)(Y[i]==0) - (double)(ndraw < 0);
else
dtemp = (double)(cdraw < 0) - (double)(Y[i]==0);
}
else
dtemp = pnorm(0, pcmean, 1, 1, 0) - pnorm(0, pnmean, 1, 1, 0);
ITTc[0] += dtemp;
if (Ymax == 1) { /* binary probit */
if (*insample && Ymiss[i]==0) {
if (Z[i] == 1)
dtemp = (double)Y[i] - (double)(ndraw > 0);
else
dtemp = (double)(cdraw > 0) - (double)Y[i];
}
else
dtemp = pnorm(0, pcmean, 1, 0, 0) - pnorm(0, pnmean, 1, 0, 0);
ITTc[1] += dtemp;
}
else { /* ordered probit */
if (*insample && Ymiss[i]==0) {
if (Z[i] == 1)
dtemp = (double)(Y[i]==Ymax) - (double)(ndraw > tau[Ymax-1]);
else
dtemp = (double)(cdraw > tau[Ymax-1]) - (double)(Y[i]==Ymax);
}
else
dtemp = pnorm(tau[Ymax-1], pcmean, 1, 0, 0) -
pnorm(tau[Ymax-1], pnmean, 1, 0, 0);
ITTc[Ymax] += dtemp;
for (j = 1; j < Ymax; j++) {
if (*insample && Ymiss[i]==0) {
if (Z[i] == 1)
dtemp = (double)(Y[i]==j) - (double)(ndraw < tau[j] && ndraw > tau[j-1]);
else
dtemp = (pnorm(tau[j], pcmean, 1, 1, 0) -
pnorm(tau[j-1], pcmean, 1, 1, 0)) - (double)(Y[i]==j);
}
else
dtemp = (pnorm(tau[j], pcmean, 1, 1, 0) -
pnorm(tau[j-1], pcmean, 1, 1, 0))
- (pnorm(tau[j], pnmean, 1, 1, 0) -
pnorm(tau[j-1], pnmean, 1, 1, 0));
ITTc[j] += dtemp;
}
}
}
else
if (Z[i] == 0) {
n_ncompC++;
base[1] += (double)Y[i];
}
}
}
/** storing the results **/
if (main_loop > *iBurnin) {
if (keep == *iKeep) {
pdStore[itemp++]=(double)n_comp/(double)n_samp;
if (Ymax == 1) {
pdStore[itemp++]=ITTc[1]/(double)n_comp;
pdStore[itemp++]=ITTc[1]/(double)n_samp;
pdStore[itemp++] = base[0]/(double)n_compC;
pdStore[itemp++] = base[1]/(double)n_ncompC;
pdStore[itemp++] = (base[0]+base[1])/(double)(n_compC+n_ncompC);
}
else {
for (i = 0; i <= Ymax; i++)
pdStore[itemp++]=ITTc[i]/(double)n_comp;
for (i = 0; i <= Ymax; i++)
pdStore[itemp++]=ITTc[i]/(double)n_samp;
}
if (*param) {
for(i = 0; i < n_cov; i++)
pdStore[itemp++]=beta[i];
if (*smooth) {
for(i = 0; i < n_covoX; i++)
pdStore[itemp++]=gamma[i];
for(i = 0; i < n11; i++)
pdStore[itemp++]=treat[i];
}
else
for(i = 0; i < n_covo; i++)
pdStore[itemp++]=gamma[i];
if (Ymax > 1)
for (i = 0; i < Ymax; i++)
pdStore[itemp++]=tau[i];
}
keep = 1;
}
else
keep++;
}
if(*verbose) {
if(main_loop == itempP) {
Rprintf("%3d percent done.\n", progress*10);
itempP += ftrunc((double) n_gen/10);
progress++;
R_FlushConsole();
}
}
R_FlushConsole();
R_CheckUserInterrupt();
} /* end of Gibbs sampler */
/** write out the random seed **/
PutRNGstate();
/** freeing memory **/
FreeMatrix(X, n_samp+n_cov);
FreeMatrix(Xo, n_samp+n_covo);
free(W);
free(beta);
free(gamma);
free(q);
free(pc);
free(pn);
FreeMatrix(SS, n_cov+1);
FreeMatrix(SSo, n_covo+1);
free(meanb);
free(meano);
free(meanr);
FreeMatrix(V, n_cov);
FreeMatrix(Vo, n_covo);
FreeMatrix(Vr, 3);
FreeMatrix(A, n_cov);
FreeMatrix(Ao, n_covo);
free(tau);
free(taumax);
free(taumin);
free(ITTc);
free(vtemp);
free(treat);
free(base);
FreeMatrix(mtemp, n_cov);
FreeMatrix(mtempo, n_covo);
} /* main */
static void
shell(void)
{
register char* s;
register char* f = 0;
register int c;
if (ed.given)
squeeze(ed.dol > ed.zero);
s = getrec(ed.buffer.line, '\n', 0);
if (s[0] == '!' && !s[1]) {
if (!*sfstrbase(ed.buffer.shell))
error(2, "no saved shell command");
f = sfstrbase(ed.buffer.file);
}
else if (!s[0])
error(2, "empty shell command");
else
SWP(ed.buffer.shell, ed.buffer.line);
s = sfstrbase(ed.buffer.shell);
sfstrseek(ed.buffer.line, 0, SEEK_SET);
sfputc(ed.buffer.line, '!');
while (c = *s++) {
if (c == '\\') {
if (*s != '%')
sfputc(ed.buffer.line, c);
sfputc(ed.buffer.line, *s++);
}
else if (c == '%')
sfputr(ed.buffer.line, f = sfstrbase(ed.buffer.file), -1);
else
sfputc(ed.buffer.line, c);
}
if (ed.given) {
if (!ed.tmpfile && !(ed.tmpfile = pathtemp(NiL, 0, NiL, error_info.id, NiL)))
error(ERROR_SYSTEM|2, "cannot generate temp file name");
if (!(ed.iop = sfopen(NiL, ed.tmpfile, "w")))
error(ERROR_SYSTEM|2, "%s: cannot create temp file", ed.tmpfile);
error_info.file = ed.tmpfile;
if (ed.dol > ed.zero)
putfile();
exfile();
ed.bytes = 0;
ed.lines = 0;
sfprintf(ed.buffer.line, " < %s", ed.tmpfile);
if (!(s = sfstruse(ed.buffer.line)))
error(ERROR_SYSTEM|3, "out of space");
if (!(ed.iop = sfpopen(NiL, s + 1, "r")))
error(ERROR_SYSTEM|2, "%s: cannot execute shell command", s);
error_info.file = s;
rdelete(ed.addr1, ed.addr2);
append(getfile, ed.dot, NiL);
exfile();
remove(ed.tmpfile);
}
else {
if (!(s = sfstruse(ed.buffer.line)))
error(ERROR_SYSTEM|3, "out of space");
s++;
if (f)
putrec(s);
if (!(ed.iop = sfpopen(NiL, s, "")))
error(ERROR_SYSTEM|2, "%s: cannot execute shell command", s);
if (sfclose(ed.iop)) {
ed.iop = 0;
error(ERROR_SYSTEM|2, "%s: shell command exit error", s);
}
if (ed.verbose)
putrec("!");
}
}
void strrev(char *p)
{
char *q = p;
while(q && *q) ++q; /* find eos */
for(--q; p < q; ++p, --q) SWP(*p, *q);
}
void WString::fromUtf8(const char* str, size_t length)
{
int len = 0;
for(unsigned int i = 0 ; i < length; i++)
{
#ifndef WIN32
if (((Shared::Platform::byte)str[i]) < 0x80)
#else
if (((byte)str[i]) < 0x80)
#endif
{
#ifndef WIN32
pBuffer[len++] = ((Shared::Platform::byte)str[i]);
#else
pBuffer[len++] = ((byte)str[i]);
#endif
continue;
}
#ifndef WIN32
if (((Shared::Platform::byte)str[i]) >= 0xC0)
{
wchar_t c = ((Shared::Platform::byte)str[i++]) - 0xC0;
while(((Shared::Platform::byte)str[i]) >= 0x80)
c = (c << 6) | (((Shared::Platform::byte)str[i++]) - 0x80);
#else
if (((byte)str[i]) >= 0xC0)
{
wchar_t c = ((byte)str[i++]) - 0xC0;
while(((byte)str[i]) >= 0x80)
c = (c << 6) | (((byte)str[i++]) - 0x80);
#endif
--i;
pBuffer[len++] = c;
continue;
}
}
pBuffer[len] = 0;
}
void strrev(char *p) {
if(p != NULL) {
char *q = p;
while(q && *q) ++q;
for(--q; p < q; ++p, --q)
*p = *p ^ *q,
*q = *p ^ *q,
*p = *p ^ *q;
}
}
#define SWP(x,y) (x^=y, y^=x, x^=y)
void strrev_utf8(char *p) {
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
char *q = p;
strrev(p); /* call base case */
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
/* Ok, now fix bass-ackwards UTF chars. */
while(q && *q) ++q; /* find eos */
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
while(p < --q) {
//printf("In [%s::%s] Line: %d p [%s] q [%s]\n",__FILE__,__FUNCTION__,__LINE__,p,q); fflush(stdout);
switch( (*q & 0xF0) >> 4 ) {
case 0xF: /* U+010000-U+10FFFF: four bytes. */
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
SWP(*(q-0), *(q-3));
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
SWP(*(q-1), *(q-2));
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
q -= 3;
break;
case 0xE: /* U+000800-U+00FFFF: three bytes. */
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
SWP(*(q-0), *(q-2));
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
q -= 2;
break;
case 0xC: /* fall-through */
case 0xD: /* U+000080-U+0007FF: two bytes. */
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
SWP(*(q-0), *(q-1));
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
q--;
break;
}
//printf("In [%s::%s] Line: %d\n",__FILE__,__FUNCTION__,__LINE__); fflush(stdout);
}
//printf("In [%s::%s] Line: %d p [%s]\n",__FILE__,__FUNCTION__,__LINE__,p); fflush(stdout);
}
static int wci_sh_sortlen(uchar *len, uchar *symb)
{
int ls[5], hs[5];
int high, low, mid, cursymb, curlen, tmp, s, n, i, j;
for(i=n=0; i<SH_N; i++)
{
if(len[i])
{
n++;
}
symb[i]=i;
}
ls[0]=0;
hs[0]=SH_N-1;
for(s=0; s>=0; s--)
{
low=ls[s];
high=hs[s];
while(low<high)
{
if(high-low<=8)
{
for(i=low+1; i<=high; i++)
{
curlen=len[symb[i]];
cursymb=symb[i];
for(j=i; j>low && CMP(curlen,len[symb[j-1]],cursymb,symb[j-1]); j--)
symb[j]=symb[j-1];
symb[j]=cursymb;
}
break;
}
mid=(high+low)>>1;
curlen=len[symb[mid]];
cursymb=symb[mid];
SWP(low,mid);
i=low+1;
j=high;
while(1)
{
while(i<=j && CMP(len[symb[i]],curlen,symb[i],cursymb))
i++;
while(CMP(curlen,len[symb[j]],cursymb,symb[j]))
j--;
if(i>=j)
break;
SWP(i,j);
}
SWP(low,j);
if(j-low<=high-j)
{
ls[s]=j+1;
hs[s++]=high;
high=j-1;
}
else
{
ls[s]=low;
hs[s++]=j-1;
low=j+1;
}
}
}
return n;
}
static int wci_sh_sortfreq(uint *freq, uchar *symb)
{
int ls[5], hs[5];
int high, low, mid, tmp, pivot, n, i, j;
int s;
for(i=n=0; i<SH_N; i++)
{
if(freq[i])
n++;
symb[i]=i;
}
ls[0]=0; hs[0]=SH_N-1;
for(s=0; s>=0; s--)
{
low=ls[s];
high=hs[s];
while(low<high)
{
if(high-low<=8)
{
for(i=low+1; i<=high; i++)
{
pivot=freq[symb[i]];
tmp=symb[i];
for(j=i; j>low && pivot<freq[symb[j-1]]; j--)
symb[j]=symb[j-1]; symb[j]=tmp;
}
break;
}
mid=(high+low)>>1;
pivot=freq[symb[mid]];
SWP(low,mid);
i=low+1; j=high;
while(1)
{ while(i<=j && freq[symb[i]]<=pivot) i++;
while(pivot<freq[symb[j]]) j--;
if(i>=j) break; SWP(i,j);
}
SWP(low,j);
if(j-low<=high-j)
{ ls[s]=j+1;
hs[s++]=high;
high=j-1;
}
else
{ ls[s]=low;
hs[s++]=j-1;
low=j+1;
}
}
}
for(i=0; i<n; i++)
SWP(i,SH_N-n+i);
return n;
}
void Grnn::Trainer::trainBrent(Grnn& grnn)
{
double a = tolerance();
double b = grnn.bandwidth();
double x = 0.5*(a + b);
bracket(grnn, a, b, x);
if (a > b)
SWP(a, b);
double fx = error(grnn, x);
double w = x, fw = fx;
double v = x, fv = fx;
double d = 0.0, u, e = 0.0;
for(unsigned iter = 1; iter <= maxIter(); ++iter)
{
double xm = 0.5*(a + b);
double tol1 = tolerance()*fabs(x) + ZEPS;
double tol2 = 2.0*(tol1);
if (fabs(x - xm) <= (tol2 - 0.5*(b - a)))
break;
if (fabs(e) > tol1)
{
double p = (x-v)*(x-v)*(fx-fw) - (x-w)*(x-w)*(fx-fv);
double q = 2.0*((x-v)*(fx-fw) - (x-w)*(fx-fv));
if (q > 0.0)
p = -p;
q = fabs(q);
double etemp = e;
e = d;
if (fabs(p) >= fabs(0.5*q*etemp) ||
p <= q*(a - x) ||
p >= q*(b - x))
{
if (x >= xm)
e = a - x;
else
e = b - x;
d = CGOLD*(e);
}
else
{
d = p/q;
u = x + d;
if (u - a < tol2 || b - u < tol2)
d = SIGN(tol1, xm - x);
}
}
else
{
if (x >= xm)
e = a - x;
else
e = b - x;
d = CGOLD *(e);
}
double u;
if(fabs(d) >= tol1)
u = x + d;
else
u = x + SIGN(tol1, d);
double fu = error(grnn, u);
if (fu <= fx)
{
if (u >= x)
a = x;
else
b = x;
SHFT(v, w, x, u);
SHFT(fv, fw, fx, fu);
}
else
{
if (u < x)
a = u;
else
b = u;
if (fu <= fw || w == x)
{
v = w;
w = u;
fv = fw;
fw = fu;
}
else if (fu <= fv || v == x || v == w)
{
v = u;
fv = fu;
}
}
}
grnn.setBandwidth(x);
}
void Grnn::Trainer::bracket(Grnn& grnn, double& a, double& b, double& c)
{
double fa = error(grnn, a);
double fb = error(grnn, b);
if (fb > fa)
{
SWP(a, b);
SWP(fa, fb);
}
c = b + GOLD*(b - a);
double fc = error(grnn, c);
double fu;
while (fb > fc)
{
double r = (b - a)*(fb - fc);
double q = (b - c)*(fb - fa);
double u = b - (q*(b - c) - r*(b - a))/
(2.0*SIGN(FMAX(fabs(q - r), TINY), q - r));
double ulim = b + GLIMIT*(c - b);
if(a > 5.0 && b > 5.0 && c > 5.0)
{
a = b;
b = u;
fa = fb;
fb = fu;
return;
}
if ((b - u)*(u - c) > 0.0)
{
fu = error(grnn, u);
if (fu < fc)
{
a = b;
b = u;
fa = fb;
fb = fu;
return;
}
else if (fu > fb)
{
c = u;
fc = fu;
return;
}
u = c + GOLD*(c - b);
fu = error(grnn, u);
}
else if ((c - u)*(u - ulim) > 0.0)
{
fu = error(grnn, u);
if (fu < fc)
{
double temp;
temp = c + GOLD*(c - b);
SHFT(b, c, u, temp);
temp = error(grnn, u);
SHFT(fb, fc, fu, temp);
}
}
else if ((u - ulim)*(ulim - c) >= 0.0)
{
u = ulim;
fu = error(grnn, u);
}
else
{
u = c + GOLD*(c - b);
fu = error(grnn, u);
}
SHFT(a, b, c, u);
SHFT(fa, fb, fc, fu);
}
}
