Exemple #1
0
void JucerTreeViewBase::paintContent (Graphics& g, const Rectangle<int>& area)
{
    g.setFont (getFont());
    g.setColour (isMissing() ? getContrastingColour (Colours::red, 0.8f)
                 : getContrastingColour (0.8f));

    g.drawFittedText (getDisplayName(), area, Justification::centredLeft, 1, 0.8f);
}
Exemple #2
0
bool Instance::classIsMissing() const
{
    int classIndexValue = classIndex();
    if (classIndexValue < 0)
    {
        throw "Class is not set!";
    }
    return isMissing(classIndexValue);
}
Colour JucerTreeViewBase::getContentColour (bool isIcon) const
{
    if (isMissing())
        return Colours::red;

    if (isSelected())
        return getOwnerView()->findColour (defaultHighlightedTextColourId);

    return getOwnerView()->findColour (isIcon ? treeIconColourId : defaultTextColourId);
}
long getmodel(Symbolhandle list, long nargs, long startKey, long silent,
			  Symbolhandle symhWts, Symbolhandle symhOffset,
			  Symbolhandle symhN)
{
	long            i, j, i2, inc;
	long            ny, ndata, nvars, nfactors, nterms, nerrorterms;
	long            needed, balanced;
	long            foundNonIntY = 0, foundNonIntN = 0;
	long            intercept;
	long            nmissing, nzerowt;
	long            dim[2];
	modelPointer    kterm;
	Symbolhandle    symh;
	double          tmp;
	double         *glmoffset, *casewts, *misswts, *ptmp, *factorvar;
	double          yi, logitni, *y, *logitn, maxlevel;
	long            caseweights = MODELTYPE & CASEWEIGHTS;
	char           *ipfwarning =
		"WARNING: ipf() cannot be used, poisson() substituted";
	modelInfoPointer info = (modelInfoPointer) 0;
	WHERE("getmodel");
	TRASH(NTRASH,errorExit);

	*OUTSTR = '\0';
	USEGLMOFFSET = 0;
	
	if (!initmodelparse(STRMODEL) || modelparse() != 0)
	{/* parse it */
		goto errorExit;
	}
	info = getModelInfo(); /* retrieve model information */
	if((ndata = checkVariables(info)) < 0)
	{
		goto errorExit;
	}
	if(!(GLMCONTROL & MULTIVAR) && !isVector(info->modelvars[0]))
	{
		sprintf(OUTSTR,
				"ERROR: non-vector response variable for %s()", FUNCNAME);
		goto errorExit;
	}
	
	NVARS = nvars = MODELINFO->nvars = info->nvars;
	NFACTORS = nfactors = MODELINFO->nfactors = info->nfactors;
	NTERMS = nterms = MODELINFO->nterms = info->nterms;
	
	NERRORTERMS = nerrorterms = MODELINFO->nerrorterms = info->nerrorterms;
	for(i=0;i<nerrorterms;i++)
	{
		modeltermAssign((modelPointer) info->errorterms[i],
						(modelPointer) MODELINFO->errorterms[i]);
	}
/* Note: As of 930601, INTMODEL has been eliminated */
	MODEL = info->model;
	info->model = (modelHandle) 0;
	
	if(MODELTYPE & (OLSREG|LEAPS))
	{
		NFACTORS = nfactors = MODELINFO->nfactors = 0;
		intercept = 0;
		for(j=0;j<nterms;j++)
		{
			kterm = modelterm(MODEL,j);
			if(nvInTerm(kterm) > 1)
			{
				sprintf(OUTSTR,
						"ERROR: crossed variates and/or factors are illegal for %s()",
						FUNCNAME);
				goto errorExit;
			} /*if(nvInTerm(modelterm(MODEL,j)) > 1)*/
			if(modeltermEqual(kterm,(modelPointer) NULLTERM))
			{
				intercept = 1;
			}
		} /*for(j=0;j<nterms;j++)*/
	} /*if(MODELTYPE & (OLSREG|LEAPS))*/

	if (MODELTYPE & LEAPS && !intercept)
	{
		sprintf(OUTSTR,
				"ERROR: a model without an intercept is illegal for %s()",
				FUNCNAME);
		goto errorExit;
	}

	/* set up MODELVARS */
	for (i = 0; i <= nvars; i++)
	{
		if(MODELVARS[i] != (Symbolhandle) 0)
		{
			Delete(MODELVARS[i]);
		}
		
		MODELVARS[i] = Makesymbol(REAL);
		if (MODELVARS[i] == (Symbolhandle) 0)
		{
			goto errorExit;
		}
		
		if (!Copy(info->modelvars[i], MODELVARS[i]))
		{
			goto errorExit;
		}
		info->modelvars[i] = (Symbolhandle) 0;
		strcpy(VARNAMES[i], NAME(MODELVARS[i]));
		if(i < nvars)
		{
			NCLASSES[i] = info->nclasses[i];
		}			
		clearNotes(MODELVARS[i]);
	} /*for (i = 0; i <= nvars; i++)*/

	/* set up Y and X */
	/* response and factors are known to be matrix or vector */
	for (i = 0; i <= nvars; i++)
	{
		symh = MODELVARS[i];
		(void) isMatrix(symh,dim); /* get dimensions */
		if (HASLABELS(symh) && NDIMS(symh) != 2)
		{
			if (!fixupMatLabels(symh, USEBOTHLABELS))
			{
				goto errorExit;
			}
		} /*if (HASLABELS(symh) && NDIMS(symh) != 2)*/
		else
		{
			Setdims(symh, 2, dim);
		}
		
		if(i == 0)
		{
			Y = DATA(symh);
			ny = dim[1];
			NDATA = (double) ndata;
			NY = (double) ny;
			/* make sure dimensions are correct, always 2 */
		} /*if(i == 0)*/
		else
		{/* i > 0 */
			X[i - 1] = DATA(symh);

			if (isVariate(i-1))
			{
				GLMCONTROL |= UNBALANCED;
			} /*if (isVariate(i-1))*/
		}  /*if(i == 0){}else{}*/
		if(*OUTSTR)
		{
			goto errorExit;
		}
	} /*for (i = 0; i <= nvars; i++)*/

	/* check for crossed variates */

	for (i = 0; i < nvars-1; i++)
	{
		if (isVariate(i))
		{
			/* variable i is a variate */
			for (j = 0; j < nterms; j++)
			{					/* 
				find the terms it is in and check to see it is not crossed
				with another variate
			  */
				kterm = modelterm(MODEL,j);
				
				if(inTerm(i,kterm) && nvInTerm(kterm) > 1)
				{
					/* 
					  j-th term has variable i and there are at least 2
					  variables or factors in the term.
					  Check to see if j-th term has another variate
					*/
					for (i2 = i+1; i2 < nvars; i2++)
					{
						if (isVariate(i2) && inTerm(i2,kterm))
						{
							sprintf(OUTSTR,
									"ERROR: crossed variates in model are illegal for %s()",
									FUNCNAME);
							goto errorExit;
						} /*if (isVariate(i2) && inTerm(i2,kterm))*/
					} /*for (i2 = 0; i2 < nvars; i2++)*/
				} /*if(inTerm(i,kterm))*/
			} /*for (j = 0; j < nterms; j++)*/
		} /*if (isVariate(i))*/
	} /*for (i = 0; i < nvars; i++)*/

	/* check for case weights, i.e., user specified weights */

	if (caseweights)
	{
		if (symhWts == (Symbolhandle) 0)
		{
			sprintf(OUTSTR,
					"ERROR: no weights given for %s()",FUNCNAME);
		}
		else if (TYPE(symhWts) != REAL || !isVector(symhWts) ||
				 symbolSize(symhWts) != ndata)
		{
			sprintf(OUTSTR,
					"ERROR: weights for %s() not REAL vector with length = nrows(%s)",
					FUNCNAME, NAME(MODELVARS[0]));
		}
		else
		{
			CASEWTS = (double **) mygethandle(ndata * sizeof(double));
			if (CASEWTS == (double **) 0)
			{
				goto errorExit;
			}
			casewts = *CASEWTS;

			doubleCopy( DATAPTR(symhWts), casewts, ndata);
			for (i = 0; i < ndata; i++)
			{
				if (!isMissing(casewts[i]) && casewts[i] < 0)
				{
					sprintf(OUTSTR,"ERROR: negative case weights for %s()",
							FUNCNAME);
					break;
				}
			} /*for (i = 0; i < ndata; i++)*/
		}
		if(*OUTSTR)
		{
			goto errorExit;
		}
	} /* if(caseweights) */

	/* check for logistic N */
	if (GLMCONTROL & BINOMDIST)
	{
		if (symhN == (Symbolhandle) 0)
		{
			sprintf(OUTSTR,"ERROR: no N variable given for %s()", FUNCNAME);
		}
		else if(!isVector(symhN) || TYPE(symhN) != REAL || 
				symbolSize(symhN) != ndata && symbolSize(symhN) != 1)
		{
			sprintf(OUTSTR,
					"ERROR: %s() N not REAL scalar or vector of same length as response",
					FUNCNAME);
		}
		else
		{
			LOGITN = (double **) mygethandle(ndata * sizeof(double));
			if (LOGITN == (double **) 0)
			{
				goto errorExit;
			}
		}
		if(*OUTSTR)
		{
			goto errorExit;
		}
		inc = (symbolSize(symhN) == 1) ? 0 : 1;
		i2 = 0;
		y = *Y;
		logitn = *LOGITN;
		ptmp = DATAPTR(symhN);
		for (i = 0; i < ndata; i++)
		{
			yi = y[i];
			logitni = logitn[i] = ptmp[i2];
			if (!isMissing(yi) && !isMissing(logitni))
			{
				tmp = floor(logitni);
				if (tmp <= 0.0)
				{
					sprintf(OUTSTR,
							"ERROR:  N values must be nonnegative for %s()",
							FUNCNAME);
				}
				else if (yi < 0.0 || yi > logitni)
				{
					sprintf(OUTSTR,
							"ERROR: response value out of range for %s()",
							FUNCNAME);
				}
				if(*OUTSTR)
				{
					goto errorExit;
				}
				if (!foundNonIntY && yi != floor(yi))
				{
					foundNonIntY = 1;
				}
				if (!foundNonIntN && logitni != tmp)
				{
					foundNonIntN = 1;
				}
			} /*if (!isMissing(yi) && !isMissing(logitni))*/
			i2 += inc;
		}/* for (i = 0; i < ndata; i++) */
	} /*if (GLMCONTROL & BINOMDIST)*/
	else if (GLMCONTROL & POISSONDIST)
	{/* check for nonnegative Y in Poisson distributed glm */
		y = *Y;
		for (i = 0; i < ndata; i++)
		{
			yi = y[i];
			if (!isMissing(yi))
			{
				if (yi < 0.0)
				{
					sprintf(OUTSTR,
							"ERROR: response variable negative for %s()",
							FUNCNAME);
					goto errorExit;
				}
				if (!foundNonIntY && floor(yi) != yi)
				{
					foundNonIntY = 1;
				}
			} /*if (!isMissing(yi))*/			
		} /*for (i = 0; i < ndata; i++)*/
	} /*if (glmcontrol & POISSONDIST)*/

	if (!silent)
	{
		if (foundNonIntY)
		{
			sprintf(OUTSTR,
					"WARNING: non-integer value(s) of response variable for %s()",
					FUNCNAME);
			putErrorOUTSTR();
		}
		if (foundNonIntN)
		{
			sprintf(OUTSTR,
					"WARNING: non-integer number N of trials for %s()",
					FUNCNAME);
			putErrorOUTSTR();
		}
	} /*if (!silent)*/
	
	/* check for user defined glmoffset */

	if (symhOffset != (Symbolhandle) 0)
	{
		if (TYPE(symhOffset) != REAL || !isVector(symhOffset) ||
			symbolSize(symhOffset) != ndata)
		{
			sprintf(OUTSTR,
					"ERROR: offsets for %s() not REAL vector nrows(offset) = nrows(response)",
					FUNCNAME);
			goto errorExit;
		}

		USEGLMOFFSET = 1;
		GLMOFFSET = (double **) mygethandle(ndata * sizeof(double));
		if (GLMOFFSET == (double **) 0)
		{
			goto errorExit;
		}
		doubleCopy(DATAPTR(symhOffset), *GLMOFFSET, ndata);
	} /*if (symhOffset != (Symbolhandle) 0)*/

	/* check for missing & fill MISSWTS if any are missing*/
	nmissing = countMissing(MODELINFO, &MISSWTS);
	if(nmissing < 0)
	{
		goto errorExit;
	}

	if(caseweights || GLMCONTROL & BINOMDIST || USEGLMOFFSET)
	{
		casewts = (caseweights) ? *CASEWTS : (double *) 0;
		logitn = (GLMCONTROL & BINOMDIST) ? *LOGITN : (double *) 0;
		glmoffset = (USEGLMOFFSET) ? *GLMOFFSET : (double *) 0;
		misswts = (nmissing > 0) ? *MISSWTS : (double *) 0;
		for (i = 0; i < ndata; i++)
		{
			if (caseweights && isMissing(casewts[i]) ||
				(GLMCONTROL & BINOMDIST) && isMissing(logitn[i]) ||
				USEGLMOFFSET && isMissing(glmoffset[i]))
			{
				if(nmissing == 0)
				{
					MISSWTS = (double **) mygethandle(ndata * sizeof(double));
					if (MISSWTS == (double **) 0)
					{
						goto errorExit;
					}
					misswts = *MISSWTS;
					doubleFill(misswts, 1.0, ndata);
					casewts = (caseweights) ? *CASEWTS : (double *) 0;
					logitn = (GLMCONTROL & BINOMDIST) ? *LOGITN : (double *) 0;
					glmoffset = (USEGLMOFFSET) ? *GLMOFFSET : (double *) 0;
				} /*if(nmissing == 0)*/
				if (misswts[i] != 0.0)
				{
					misswts[i] = 0.0;
					nmissing++;
				}
			}
		} /*for (i = 0; i < ndata; i++)*/
	} /*if(caseweights || GLMCONTROL & BINOMDIST || USEGLMOFFSET)*/
	
	if(nmissing > 0)
	{
		MODELTYPE |= MISSWEIGHTS;
		GLMCONTROL |= UNBALANCED;
		misswts = *MISSWTS;
	} /*if(nmissing > 0)*/

	/* find the actual maximum factor levels included */
	if (nfactors > 0)
	{
		for (j = 0; j < nvars; j++)
		{
			if (!isVariate(j))
			{
				factorvar = *(X[j]);
				maxlevel = 0;
				for (i = 0;i < ndata; i++)
				{
					if (!isMissing(factorvar[i]) && factorvar[i] > maxlevel &&
						(nmissing == 0 || misswts[i] > 0.0))
					{
						maxlevel = factorvar[i];
					}
				} /*for (i = 0;i < ndata; i++)*/
				NCLASSES[j] = (long) maxlevel;
			} /*if (!isVariate(j))*/
		} /*for (j = 0; j < nvars; j++)*/
	} /*if (nfactors > 0)*/
	
	if (nmissing > 0 && !silent)
	{
		putOutErrorMsg("WARNING: cases with missing values deleted");
	}

	/* check for zero case weights, i.e., user specified weights */
	if (caseweights)
	{
		casewts = *CASEWTS;
		misswts = (MODELTYPE & MISSWEIGHTS) ? *MISSWTS : (double *) 0;
		nzerowt = 0;
		for (i = 0; i < ndata; i++)
		{
			if ((!(MODELTYPE & MISSWEIGHTS) || misswts[i] > 0.0) &&
				casewts[i] == 0)
			{
				nzerowt++;
			}
		}
		if (nzerowt != 0 && !silent)
		{
			putOutErrorMsg("WARNING: cases with zero weight completely removed");
		}
		nmissing += nzerowt;
	} /*if (caseweights)*/
	NOTMISSING = NDATA - nmissing;

	if(NOTMISSING == 0)
	{
		sprintf(OUTSTR,
				"ERROR: no non-missing cases with non-zero weight");
		goto errorExit;
	}
	
	/*
	   Check for possible Latin Square or other balanced main effect design
	    for which balanced computation is appropriate
	  In the future, we need code to recognize fractional factorials,
	  confounded factorials, etc
	 */

	balanced = (!(GLMCONTROL & UNBALANCED) && !(MODELTYPE & FASTANOVA) &&
				isBalanced(ONEWAYBALANCE));
	
	if (balanced && nvars > 1)
	{
		if (anovaEffectsOnly(1))
		{
			balanced = isBalanced(TWOWAYBALANCE);
		}
		else
		{
			balanced = isBalanced(COMPLETEBALANCE);
		}
		if (balanced < 0)
		{
			goto errorExit;
		}
	} /*if (balanced)*/
	
	if(!balanced)
	{
		GLMCONTROL |= UNBALANCED;
		if (MODELTYPE & IPF)
		{
			MODELTYPE &= ~IPF;
			MODELTYPE |= POISSONREG;
			if(!silent)
			{
				putOutErrorMsg(ipfwarning);
			}
		}
	} /*if(!balanced)*/

	/* check for incremental deviances specified by extra argument */
	if (MODELTYPE & (ITERGLMS | IPF) && !INCREMENTAL &&
		nargs > startKey && !isKeyword(COMPVALUE(list,nargs-1)))
	{
		INCREMENTAL = 1;
	}

	/*
	  990319 moved creation of side-effect variables DEPVNAME and
	  TERMNAMES to glm()
    */
	/* save dependent variable name */
	needed = strlen(VARNAME(0)) + 1;
	
	DEPVNAME = mygethandle(needed);
	if(DEPVNAME == (char **) 0)
	{
		goto errorExit;
	}
	/* re-dereference name after memory allocation */
	strcpy(*DEPVNAME, VARNAME(0));
	
	/* Create TERMNAMES */
	needed = makeTermNames(0); /* get space requirement */
	TERMNAMES = mygethandle(needed);
	if (TERMNAMES == (char **) 0)
	{
		goto errorExit;
	}
	
	/* now fill in TERMNAMES */

	(void) makeTermNames(needed);

	emptyTrash();
	
	return (0); /* normal (no error) return */

/* NOTE: cleanup of globals is done in glm after error return */
 errorExit:
	putErrorOUTSTR();
	emptyTrash();
	if(info != (modelInfoPointer) 0)
	{
		mydisphandle((char **) info->model);
		MODEL = info->model = (modelHandle) 0;
	}
	
	return (1);

} /*getmodel()*/
Symbolhandle    setseed(Symbolhandle list)
{
	Symbolhandle    symhf, symhl, symhKey;
	double          first, last;
	long            nargs = NARGS(list);
	long            margs = nargs;
	long            verbose = 1;
	char           *keyword;
	
	OUTSTR[0] = '\0';

	if (nargs > 3)
	{
		badNargs(FUNCNAME, -3);
		goto errorExit;
	}
	if (nargs > 1)
	{ /* check for quiet:T or simply logical scalar 3rd argument */
		symhKey = COMPVALUE(list,nargs-1);
		if (!argOK(symhKey, 0, nargs))
		{
			goto errorExit;
		}
		if ((keyword = isKeyword(symhKey)) && strcmp(keyword, "quiet") != 0)
		{
			badKeyword(FUNCNAME, keyword);
			goto errorExit;
		}
		if (isTorF(symhKey))
		{
			verbose = (DATAVALUE(symhKey,0) == 0);
			nargs--;
		}
		else if(keyword || nargs == 3)
		{
			notTorF((keyword) ? keyword : "argument 3");
			goto errorExit;
		}
	} /*if (nargs > 1)*/
	
	symhf = COMPVALUE(list,0);
	if(!argOK(symhf, REAL, (margs > 1) ? 1 : 0))
	{
		goto errorExit;
	}

	if(nargs == 2)
	{
		if(!argOK(symhl = COMPVALUE(list,1), REAL,2))
		{
			goto errorExit;
		}
		if (!isInteger(symhf, NONNEGATIVEVALUE) ||
			!isInteger(symhl, NONNEGATIVEVALUE))
		{
			sprintf(OUTSTR,
					"ERROR: when seeds are separate arguments, both must be integers >= 0");
		}
		else
		{
			first = DATAVALUE(symhf,0);
			last = DATAVALUE(symhl,0);
		}		
	} /*if(nargs == 2)*/
	else
	{
		if(!isVector(symhf) || symbolSize(symhf) != 2)
		{
			sprintf(OUTSTR,
					"ERROR: a single seed argument to %s must be a vector of length 2",
					FUNCNAME);
		}
		else
		{
			first = DATAVALUE(symhf,0);
			last = DATAVALUE(symhf,1);
		}
	} /*if(nargs == 2){}else{}*/
	if(*OUTSTR)
	{
		goto errorExit;
	}
	
	if(isMissing(first) || isMissing(last))
	{
		sprintf(OUTSTR,"ERROR: missing values not allowed as seeds");
	}
	else if(first != floor(first) || first < 0 ||
			last != floor(last) || last < 0 ||
			first > RANDM1 || last > RANDM2)
	{
		sprintf(OUTSTR,
				"ERROR: seeds must non-negative integers, seed1 <= %ld and seed2 <= %ld",
				RANDM1, RANDM2);
	}
	if(*OUTSTR)
	{
		goto errorExit;
	}
	

	if(first == 0 || last == 0)
	{
		randomSeed(verbose);
	}
	else
	{
		Rands1 = first;
		Rands2 = last;
	}	

	return (NULLSYMBOL);

  errorExit:
	
	putErrorOUTSTR();
	return (0);

} /*setseed()*/
/*
  Setup for if, else, elseif, while, and for

  Routine to test logic and correspondingly set globals to affect course
  of parsing.  It sets globals affecting subsequent parsing.  It returns 0
  when an error is found.
 
  The first argument list is a LIST and the second is IF, ELSEIF, ELSE, WHILE
  or FOR.

  On IF, ELSEIF and WHILE, NCOMPS(list) should be 1 and COMPVALUE(list,0)
  should be a LOGICAL scalar specifying the condition.

  On ELSE, list is a null handle.

  On FOR, 2 <= NCOMPS(list) <= 4.
   NAME(COMPVALUE(list, 0)) is the name of the index variable
   If NCOMPS(list) == 2, COMPVALUE(list,1) is a REAL vector specifying
   the values of the index.
   If NCOMPS(list) == 4, COMPVALUE(list,3) must be a non-zero non-MISSING
   REAL scalar inc (default value 1)
   If NCOMPS(list) == 3 or 4, COMPVALUE(list,1) and COMPVALUE(list,2) must
   be non MISSING REAL scalars i1 and i2 and a range vector of the form
   run(i1,i2,inc) is computed and saved.

  The depth of nested for and while loops is given by WDEPTH which is
  incremented here and decremented in the parser.

  The name of the index variable used in for(index,range){} is
  IndexNames[WDEPTH-1] and the vector of values is stored in reverse
  order in FORVECTORS[WDEPTH-1].

  The depth of nested if/elseif/else statements is given by IDEPTH which is
  incremented here and decremented in the parser.

  The value of Logical in if(Logical){} or ...elseif(Logical){} is
  put in IFCONDITIONS[IDEPTH-1]

  As of 911002 only IF was processed and the input stream was modified was
  to skip ahead to be just before '{'  and to wipe out input stream on
  errors.  It was changed so that the input stream is not changed and all
  control of parsing is through globals.

   931110  Ifsetup() now returns error code rather than set Global IfsetupError
   980208  Fixed divide by zero bug in for(i,1,1){}
           Modified some of the code checking arguments to make use of
           isScalar() which incorporates a check for a 0 Symbolhandle
           Removed some unneeded externs
   980218  Corrected handling of MISSING i1, i2 and inc in for(i,i1,i2[,inc])
   980220  for(i,NULL){...} just skips compound statment and is not an error.

*/
int Ifsetup(Symbolhandle list, long op)
{
	Symbolhandle    logic, indexVal, range, start, end, inc;
	char           *opname;
	long            condition;
	long            i,i1, length, halfLength;
	long            iftype = (op == IF || op == ELSEIF);
	long            nullList = (list == (Symbolhandle) 0);
	long            ncomps = (nullList) ? 0 : NCOMPS(list);
	long            badForList;
	double          startVal, endVal, incVal = 1.0, endVal1, span, val;
	double         *forVector, *rangeVec;
	WHERE("Ifsetup");

	OUTSTR[0] = '\0';
	
	if (op != ELSE)
	{ /* IF, ELSEIF, FOR and WHILE */
		if (iftype)
		{
			opname = (op == IF) ? "if" : "elseif";
		}
		else
		{
			opname = (op == WHILE) ? "while" : "for";
		}
		
		if ((!iftype && WDEPTH >= MAXWDEPTH) ||
			(op == IF && IDEPTH >= MAXIDEPTH))
		{
			sprintf(OUTSTR,"ERROR: too many nested %s's",opname);

			goto yyerrorExit;
		}

		if (!iftype)
		{ /* for & while */
			WDEPTH++;
		}
		else if (op == IF)
		{
			IDEPTH++;
		}
	
		if (op == WHILE || (iftype && !nullList))
		{
			char       *condValue = "conditional value";
			
			if (ncomps > 1)
			{
				sprintf(OUTSTR,"ERROR: usage is %s(LOGICAL){ ... }", opname);
			}
			else if ((logic = COMPVALUE(list,0)) == (Symbolhandle) 0)
			{
				sprintf(OUTSTR,"ERROR: no %s %s", opname, condValue);
			}
			else if (!isDefined(logic))
			{
				sprintf(OUTSTR,"ERROR: %s %s is UNDEFINED", opname, condValue);
			}
			else if (TYPE(logic) != LOGIC)
			{
				sprintf(OUTSTR,"ERROR: %s %s not LOGICAL", opname, condValue);
			}
			else if (!isScalar(logic))
			{
				sprintf(OUTSTR,
						"ERROR: %s %s has length > 1", opname, condValue);
			}
			else if (isMissing(DATAVALUE(logic,0)))
			{
				sprintf(OUTSTR, "ERROR: %s %s is MISSING", opname, condValue);
			}
			if (*OUTSTR)
			{
				goto yyerrorExit;
			}
			condition = (DATAVALUE(logic,0) != 0.0);
		} /* if (op == WHILE || (iftype && !nullList) */
		else if (op == FOR)
		{ /* for */
			opname = "for";
			if (FORVECTORS[WDEPTH-1] == (double **) 0)
			{
				/* first time through at this level */
				indexVal = COMPVALUE(list,0);
				COMPVALUE(list,0) = (Symbolhandle) 0;
				/* Check index symbol */
				if (indexVal == (Symbolhandle) 0 ||
				   TYPE(indexVal) == BLTIN || isscratch(NAME(indexVal)))
				{
					sprintf(OUTSTR,
							"ERROR: %s index to %s loop",
							(indexVal==(Symbolhandle) 0) ? "missing" : "illegal",
							opname);
					goto yyerrorExit;
				}

				badForList = (ncomps == 1 || ncomps > 4) ? BADNCOMPS : 0;

				if (!badForList)
				{
					if (ncomps == 2)
					{
						range = COMPVALUE(list, 1);
						if (TYPE(range) != NULLSYM &&
							(!isVector(range) || TYPE(range) != REAL))
						{
							badForList = BADRANGEVAL;
						}
					} /*if (ncomps == 2)*/
					else
					{
						start = COMPVALUE(list, 1);
						end = COMPVALUE(list, 2);
						inc = (ncomps == 4) ?
						  COMPVALUE(list, 3) : (Symbolhandle) 0;
						if (!isScalar(start) || TYPE(start) != REAL ||
							!isScalar(end) || TYPE(end) != REAL ||
							(ncomps == 4 &&
							 (!isScalar(inc) || TYPE(inc) != REAL)))
						{
							badForList = BADLIMITSVAL;
						}
						else
						{
							startVal = DATAVALUE(start, 0);
							endVal = DATAVALUE(end, 0);
							incVal = (ncomps == 4) ? DATAVALUE(inc, 0) : 1.0;
						
							if (isMissing(startVal) || isMissing(endVal) ||
								isMissing(incVal))
							{
								badForList = MISSVALLIMITS;
							}
							else
							{
								double     howFar = endVal - startVal;
								
								if (ncomps == 3)
								{
									incVal = (howFar >= 0) ? 1.0 : -1.0;
								}
								else if (howFar != 0.0 && incVal == 0.0)
								{
									badForList = ZEROINC;
								}
								else if (incVal * howFar < 0.0)
								{
									badForList = WRONGSIGNINC;
								}
							}
						}
					} /*if (ncomps == 2){}else{}*/
				} /*if (!badForList)*/
				
				if (badForList)
				{
					char        *usage1 = "for(index,i1,i2[,inc]){...}";
					char        *usage2 = "for(index,i1,i2,inc){...}";
				
					switch (badForList)
					{
					  case BADNCOMPS:
						sprintf(OUTSTR,
							   "ERROR: usage is for(index,realVec){...} or %s", usage1);
						break;
						
					  case BADRANGEVAL:
						sprintf(OUTSTR,
								"ERROR: range must be REAL vector in for(index, range){...}");
						break;
						
					  case BADLIMITSVAL:
						sprintf(OUTSTR,
								"ERROR: i1, i2, inc must be non-MISSING REAL scalars in %s",
								usage1);
						break;

					  case MISSVALLIMITS:
						sprintf(OUTSTR,
								"ERROR: i1, i2, inc must not be MISSING in %s", 
								usage1);
						break;
						
					  case ZEROINC:
						sprintf(OUTSTR,
								"ERROR: inc must not be 0 in %s", usage2);
						break;
						
					  case WRONGSIGNINC:
						sprintf(OUTSTR,
								"ERROR: inc has wrong sign in %s", usage2);
						break;
					} /*switch (badForList)*/
					goto yyerrorExit;
				} /*if (badForList)*/
				
				incVal = (incVal) ? incVal : 1.0;

				if (ncomps == 2)
				{
					length = symbolSize(range);
				} /*if (ncomps == 2)*/
				else
				{
					span = endVal - startVal;
					length = (long) (span / incVal) + 1;

/* 
   The following is intended to insure that if endVal is essentially an exact
   multiple of by away from startVal, then the last element of the result
   will be close to endVal, even if slightly outside the interval from
   startVal to endVal; in addition, a very near zero is made exactly zero
   The behavior is supposed to be exactly that of run().
*/
					if (length > 1)
					{		
						for (endVal1 = startVal + length * incVal;
							 incVal > 0.0 && endVal1 <= endVal ||
							 incVal < 0.0 && endVal1 >= endVal ||
							 fabs((endVal1 - endVal)/span) <= RUNFUZZ;
							 endVal1 = startVal + length * incVal)
						{
							length++;
						}
					} /*if (length > 1)*/
				} /*if (ncomps == 2){}else{}*/
				
				WHILELIMITS[WDEPTH-1] = length;

				/* get temporary storage for range */
				if (length == 0)
				{
					/* must be for(i,NULL){...} */
					FORVECTORS[WDEPTH-1] = (double **) 0;
					WHILECONDITIONS[WDEPTH-1] = 0;
					/* return signal to skip compound statement*/
					return (-1);
				} /*if (length == 0)*/

				if (ncomps > 2 || !isscratch(NAME(range)))
				{
					FORVECTORS[WDEPTH-1] = 
					  (double **) mygethandle(length*sizeof(double));
					if (FORVECTORS[WDEPTH-1] == (double **) 0)
					{
						goto errorExit;
					}
					if (ncomps == 2)
					{
						rangeVec  = DATAPTR(range);
					}
				} /*if (ncomps > 2 || !isscratch(NAME(range)))*/
				else
				{ /* for(i,scratchVec){}*/
					rangeVec  = DATAPTR(range);
					FORVECTORS[WDEPTH-1] = DATA(range);
					setDATA(range, (double **) 0);
				} /*if (ncomps > 2 || !isscratch(NAME(range))){}else{}*/

				forVector = *FORVECTORS[WDEPTH-1];

				/*
				  Copy range or run(startVal,endVal, incVal) to FORVECTORS
				  in reverse order, doing it in such a way that forVector
				  can be the same as rangeVec
				  */
				if (ncomps == 2)
				{ /* copy from rangeVec to forVector in reverse order */
					halfLength = length/2;
					for (i = 0,i1 = length - 1;i < halfLength;i++, i1--)
					{
						val = rangeVec[i];
						forVector[i] = rangeVec[i1];
						forVector[i1] = val;
					}
					if (2*halfLength != length)
					{
						forVector[i] = rangeVec[i1];
					}
				} /*if (ncomps == 2)*/
				else if (length == 1)
				{
					forVector[0] = startVal;
				}
				else
				{ /* generate run(startVal,endVal,incVal)*/
					for (i = 0,i1 = length - 1;i1 >= 0;i1--, i++)
					{
						val = startVal + (double) i * incVal;
						forVector[i1] = 
						  (incVal && fabs(val/span) < RUNFUZZ) ? 0.0 : val;
					}
					if (fabs((val-endVal)/span) < RUNFUZZ)
					{
						forVector[0] = endVal;
					}
				} /*if (ncomps == 2){}else{}*/

				/* save index name */
				strncpy(IndexNames[WDEPTH-1],NAME(indexVal),NAMELENGTH);
				IndexNames[WDEPTH-1][NAMELENGTH] = '\0';
			} /* if (FORVECTORS[WDEPTH-1] == (double **) 0) */
			else
			{ /* not first time through */
				indexVal = Lookup(IndexNames[WDEPTH-1]);
			}
			/* re-use index variable if it is a REAL scalar */
			if (!isScalar(indexVal) || TYPE(indexVal) != REAL)
			{
				Removesymbol(indexVal);
				indexVal = (Symbolhandle) 0;
			}
			if (indexVal == (Symbolhandle) 0)
			{
				indexVal = RInstall(IndexNames[WDEPTH-1],1);
				if (indexVal == (Symbolhandle) 0)
				{
					goto errorExit;
				}
			}
			val = (*FORVECTORS[WDEPTH-1])[WHILELIMITS[WDEPTH-1]-1];
#if (USENOMISSING)
			if (isMissing(val))
			{
				clearNOMISSING(indexVal);
			}
			else
			{
				setNOMISSING(indexVal);
			}
#endif /*USENOMISSING*/
			DATAVALUE(indexVal,0) = val;
		}
 
		if (op == WHILE)
		{
			/* WHILESTARTS, WHILEBRACKETLEV, and IFBRACKETLEV set in yylex */
			if (--WHILELIMITS[WDEPTH-1] <= 0 && condition)
			{					/* safety precaution */
				/* Note: Parser also recognizes this condition and terminates
				   loop
				*/
				sprintf(OUTSTR,"ERROR: more than %ld repetitions of %s loop",
						(long) MAXWHILE-1,opname);
				putErrorOUTSTR();
			}	
			WHILECONDITIONS[WDEPTH-1] = condition;
		} /*if (op == WHILE)*/
		else if (op == FOR)
		{/* Note: WDEPTH & WHILELIMITS[WDEPTH-1] are decremented in mainpars */
			WHILECONDITIONS[WDEPTH-1] = 1;
			if (WHILELIMITS[WDEPTH-1] == 1)
			{ /* this is the last time */
				IndexNames[WDEPTH-1][0] = '\0';
				mydisphandle((char **) FORVECTORS[WDEPTH-1]);
				FORVECTORS[WDEPTH-1] = (double **) 0;
			}
		} /*if (op == WHILE){}else if (op == FOR)*/
		else if (!nullList) /* op == IF or op == ELSEIF */
		{
			IFCONDITIONS[IDEPTH-1] = condition;
		}
	} /* if (op != ELSE) */
	else
	{
		opname = "else";
	}
	
	/* go look for starting bracket enclosing the compound statement */
	if (!findLParen(op, '{'))
	{
		goto errorExit;
	}

	if (op == FOR)
	{
		WHILESTARTS[WDEPTH-1] = ISTRCHAR;
	}
	*OUTSTR = '\0';
	
	if (interrupted(DEFAULTTICKS) != INTNOTSET)
	{
		goto errorExit;
	}

	return (1);

  yyerrorExit:
	yyerror(OUTSTR);
	return (0);
	
  errorExit:
	putErrorOUTSTR();

	/* report error to parser */

	return (0);
	
} /*Ifsetup()*/