void dd (header *hd)
{ header *st=hd,*hd1,*result;
int c1,c2,i,j,r;
double *m1,*m2,*mr;
complex *mc1,*mc2,*mcr,hc1,hc2;
interval *mi1,*mi2,*mir,hi1,hi2;
hd1=next_param(st);
equal_params_2(&hd,&hd1); if (error) return;
getmatrix(hd,&r,&c1,&m1); if (r!=1) wrong_arg();
getmatrix(hd1,&r,&c2,&m2); if (r!=1) wrong_arg();
if (c1!=c2) wrong_arg();
if (iscomplex(hd)) /* complex values */
{ mc1=(complex *)m1; mc2=(complex *)m2;
result=new_cmatrix(1,c1,""); if (error) return;
mcr=(complex *)matrixof(result);
memmove((char *)mcr,(char *)mc2,c1*sizeof(complex));
for (i=1; i<c1; i++)
{ for (j=c1-1; j>=i; j--)
{ if (mc1[j][0]==mc1[j-i][0] &&
mc1[j][1]==mc1[j-i][1]) wrong_arg();
c_sub(mcr[j],mcr[j-1],hc1);
c_sub(mc1[j],mc1[j-i],hc2);
c_div(hc1,hc2,mcr[j]);
}
}
}
else if (isinterval(hd)) /* complex values */
{ mi1=(complex *)m1; mi2=(complex *)m2;
result=new_imatrix(1,c1,""); if (error) return;
mir=(interval *)matrixof(result);
memmove((char *)mir,(char *)mi2,c1*sizeof(interval));
for (i=1; i<c1; i++)
{ for (j=c1-1; j>=i; j--)
{ i_sub(mir[j],mir[j-1],hi1);
if (hi1[0]<=0 && hi1[1]>=0)
{ output("Interval points coincide\n");
error=1; return;
}
i_sub(mi1[j],mi1[j-i],hi2);
i_div(hi1,hi2,mir[j]);
}
}
}
else if (isreal(hd))
{ result=new_matrix(1,c1,""); if (error) return;
mr=matrixof(result);
memmove((char *)mr,(char *)m2,c1*sizeof(double));
for (i=1; i<c1; i++)
{ for (j=c1-1; j>=i; j--)
{ if (m1[j]==m1[j-i]) wrong_arg();
mr[j]=(mr[j]-mr[j-1])/(m1[j]-m1[j-i]);
}
}
}
else wrong_arg();
moveresult(st,result);
}
void polymult (header *hd)
{ header *st=hd,*hd1,*result;
int c,c1,c2,i,r,j,k;
double *m1,*m2,*mr,x;
complex *mc1,*mc2,*mcr,xc,hc;
interval *mi1,*mi2,*mir,xi,hi;
hd1=next_param(st);
equal_params_2(&hd,&hd1); if (error) return;
getmatrix(hd,&r,&c1,&m1); if (r!=1) wrong_arg();
getmatrix(hd1,&r,&c2,&m2); if (r!=1) wrong_arg();
if ((LONG)c1+c2-1>INT_MAX) wrong_arg();
c=c1+c2-1;
if (iscomplex(hd))
{ mc1=(complex *)m1; mc2=(complex *)m2;
result=new_cmatrix(1,c,""); if (error) return;
mcr=(complex *)matrixof(result);
c_copy(xc,*mc1); mc1++;
for (i=0; i<c2; i++) c_mult(xc,mc2[i],mcr[i]);
for (j=1; j<c1; j++)
{ c_copy(xc,*mc1); mc1++;
for (k=j,i=0; i<c2-1; i++,k++)
{ c_mult(xc,mc2[i],hc);
c_add(hc,mcr[k],mcr[k]);
}
c_mult(xc,mc2[i],mcr[k]);
}
}
else if (isinterval(hd))
{ mi1=(interval *)m1; mi2=(interval *)m2;
result=new_imatrix(1,c,""); if (error) return;
mir=(interval *)matrixof(result);
i_copy(xi,*mi1); mi1++;
for (i=0; i<c2; i++) i_mult(xi,mi2[i],mir[i]);
for (j=1; j<c1; j++)
{ i_copy(xi,*mi1); mi1++;
for (k=j,i=0; i<c2-1; i++,k++)
{ i_mult(xi,mi2[i],hi);
c_add(hi,mir[k],mir[k]);
}
c_mult(xi,mi2[i],mir[k]);
}
}
else if (isreal(hd))
{ result=new_matrix(1,c,""); if (error) return;
mr=matrixof(result);
x=*m1++;
for (i=0; i<c2; i++) mr[i]=x*m2[i];
for (j=1; j<c1; j++)
{ x=*m1++;
for (k=j,i=0; i<c2-1; i++,k++) mr[k]+=x*m2[i];
mr[k]=x*m2[i];
}
}
else wrong_arg();
moveresult(st,result);
}
void polyadd (header *hd)
{ header *st=hd,*hd1,*result;
int c,c1,c2,i,r;
double *m1,*m2,*mr;
complex *mc1,*mc2,*mcr;
interval *mi1,*mi2,*mir;
hd1=next_param(st);
equal_params_2(&hd,&hd1); if (error) return;
getmatrix(hd,&r,&c1,&m1); if (r!=1) wrong_arg();
getmatrix(hd1,&r,&c2,&m2); if (r!=1) wrong_arg();
c=max(c1,c2);
if (iscomplex(hd)) /* complex values */
{ mc1=(complex *)m1; mc2=(complex *)m2;
result=new_cmatrix(1,c,""); if (error) return;
mcr=(complex *)matrixof(result);
for (i=0; i<c; i++)
{ if (i>=c1) { c_copy(*mcr,*mc2); mcr++; mc2++; }
else if (i>=c2) { c_copy(*mcr,*mc1); mcr++; mc1++; }
else { c_add(*mc1,*mc2,*mcr); mc1++; mc2++; mcr++; }
}
}
else if (isinterval(hd))
{ mi1=(interval *)m1; mi2=(interval *)m2;
result=new_imatrix(1,c,""); if (error) return;
mir=(interval *)matrixof(result);
for (i=0; i<c; i++)
{ if (i>=c1) { i_copy(*mir,*mi2); mir++; mi2++; }
else if (i>=c2) { i_copy(*mir,*mi1); mir++; mi1++; }
else { i_add(*mi1,*mi2,*mir); mi1++; mi2++; mir++; }
}
}
else if (isreal(hd))
{ result=new_matrix(1,c,""); if (error) return;
mr=matrixof(result);
for (i=0; i<c; i++)
{ if (i>=c1) { *mr++ = *m2++; }
else if (i>=c2) { *mr++ = *m1++; }
else { *mr++ = *m1++ + *m2++; }
}
}
else wrong_arg();
moveresult(st,result);
}
void polydd (header *hd)
{ header *st=hd,*hd1,*result;
int c1,c2,i,j,r;
double *m1,*m2,*mr,x;
complex *mc1,*mc2,*mcr,hc,xc;
hd1=next_param(st);
equal_params_2(&hd,&hd1); if (error) return;
getmatrix(hd,&r,&c1,&m1); if (r!=1) wrong_arg();
getmatrix(hd1,&r,&c2,&m2); if (r!=1) wrong_arg();
if (c1!=c2) wrong_arg();
if (iscomplex(hd)) /* complex values */
{ mc1=(complex *)m1; mc2=(complex *)m2;
result=new_cmatrix(1,c1,""); if (error) return;
mcr=(complex *)matrixof(result);
c_copy(mcr[c1-1],mc2[c1-1]);
for (i=c1-2; i>=0; i--)
{ c_copy(xc,mc1[i]);
c_mult(xc,mcr[i+1],hc);
c_sub(mc2[i],hc,mcr[i]);
for (j=i+1; j<c1-1; j++)
{ c_mult(xc,mcr[j+1],hc);
c_sub(mcr[j],hc,mcr[j]);
}
}
}
else
{ result=new_matrix(1,c1,""); if (error) return;
mr=matrixof(result);
mr[c1-1]=m2[c1-1];
for (i=c1-2; i>=0; i--)
{ x=m1[i];
mr[i]=m2[i]-x*mr[i+1];
for (j=i+1; j<c1-1; j++) mr[j]=mr[j]-x*mr[j+1];
}
}
moveresult(st,result);
}
void
raw_write(char *name, struct plot *pl, bool app, bool binary)
{
FILE *fp;
bool realflag = TRUE, writedims;
bool raw_padding;
int length, numdims, dims[MAXDIMS];
int nvars, i, j, prec;
struct dvec *v, *lv;
wordlist *wl;
struct variable *vv;
double dd;
char buf[BSIZE_SP];
char *branch;
raw_padding = !cp_getvar("nopadding", CP_BOOL, NULL);
/* Why bother printing out an empty plot? */
if (!pl->pl_dvecs) {
fprintf(cp_err, "Error: plot is empty, nothing written.\n");
return;
}
if (raw_prec != -1)
prec = raw_prec;
else
prec = DEFPREC;
#if defined(__MINGW32__) || defined(_MSC_VER)
/* - Binary file binary write - hvogt 15.03.2000 ---------------------*/
if (binary) {
if ((fp = fopen(name, app ? "ab" : "wb")) == NULL) {
perror(name);
return;
}
fprintf(cp_out, "binary raw file\n");
} else {
if ((fp = fopen(name, app ? "a" : "w")) == NULL) {
perror(name);
return;
}
fprintf(cp_out, "ASCII raw file\n");
}
/* --------------------------------------------------------------------*/
#else
if (!(fp = fopen(name, app ? "a" : "w"))) {
perror(name);
return;
}
#endif
numdims = nvars = length = 0;
for (v = pl->pl_dvecs; v; v = v->v_next) {
if (iscomplex(v))
realflag = FALSE;
nvars++;
/* Find the length and dimensions of the longest vector
* in the plot.
* Be paranoid and assume somewhere we may have
* forgotten to set the dimensions of 1-D vectors.
*/
if (v->v_numdims <= 1) {
v->v_numdims = 1;
v->v_dims[0] = v->v_length;
}
if (v->v_length > length) {
length = v->v_length;
numdims = v->v_numdims;
for (j = 0; j < numdims; j++) {
dims[j] = v->v_dims[j];
}
}
}
fprintf(fp, "Title: %s\n", pl->pl_title);
fprintf(fp, "Date: %s\n", pl->pl_date);
fprintf(fp, "Plotname: %s\n", pl->pl_name);
fprintf(fp, "Flags: %s%s\n",
realflag ? "real" : "complex", raw_padding ? "" : " unpadded");
fprintf(fp, "No. Variables: %d\n", nvars);
fprintf(fp, "No. Points: %d\n", length);
if (numdims > 1) {
dimstring(dims, numdims, buf);
fprintf(fp, "Dimensions: %s\n", buf);
}
for (wl = pl->pl_commands; wl; wl = wl->wl_next)
fprintf(fp, "Command: %s\n", wl->wl_word);
for (vv = pl->pl_env; vv; vv = vv->va_next) {
wl = cp_varwl(vv);
if (vv->va_type == CP_BOOL) {
fprintf(fp, "Option: %s\n", vv->va_name);
} else {
fprintf(fp, "Option: %s = ", vv->va_name);
if (vv->va_type == CP_LIST)
fprintf(fp, "( ");
wl_print(wl, fp);
if (vv->va_type == CP_LIST)
fprintf(fp, " )");
(void) putc('\n', fp);
}
}
/* Before we write the stuff out, make sure that the scale is the first
* in the list.
*/
for (lv = NULL, v = pl->pl_dvecs; v != pl->pl_scale; v = v->v_next)
lv = v;
if (lv) {
lv->v_next = v->v_next;
v->v_next = pl->pl_dvecs;
pl->pl_dvecs = v;
}
fprintf(fp, "Variables:\n");
for (i = 0, v = pl->pl_dvecs; v; v = v->v_next) {
if (v->v_type == SV_CURRENT) {
branch = NULL;
if ((branch = strstr(v->v_name, "#branch")) != NULL) {
*branch = '\0';
}
fprintf(fp, "\t%d\ti(%s)\t%s", i++, v->v_name, ft_typenames(v->v_type));
if (branch != NULL) *branch = '#';
} else if (v->v_type == SV_VOLTAGE) {
fprintf(fp, "\t%d\t%s\t%s", i++, v->v_name, ft_typenames(v->v_type));
} else {
fprintf(fp, "\t%d\t%s\t%s", i++, v->v_name, ft_typenames(v->v_type));
}
if (v->v_flags & VF_MINGIVEN)
fprintf(fp, " min=%e", v->v_minsignal);
if (v->v_flags & VF_MAXGIVEN)
fprintf(fp, " max=%e", v->v_maxsignal);
if (v->v_defcolor)
fprintf(fp, " color=%s", v->v_defcolor);
if (v->v_gridtype)
fprintf(fp, " grid=%d", v->v_gridtype);
if (v->v_plottype)
fprintf(fp, " plot=%d", v->v_plottype);
/* Only write dims if they are different from default. */
writedims = FALSE;
if (v->v_numdims != numdims) {
writedims = TRUE;
} else {
for (j = 0; j < numdims; j++)
if (dims[j] != v->v_dims[j])
writedims = TRUE;
}
if (writedims) {
dimstring(v->v_dims, v->v_numdims, buf);
fprintf(fp, " dims=%s", buf);
}
(void) putc('\n', fp);
}
if (binary) {
fprintf(fp, "Binary:\n");
for (i = 0; i < length; i++) {
for (v = pl->pl_dvecs; v; v = v->v_next) {
/* Don't run off the end of this vector's data. */
if (i < v->v_length) {
if (realflag) {
dd = (isreal(v) ? v->v_realdata[i] :
realpart(v->v_compdata[i]));
(void) fwrite(&dd, sizeof(double), 1, fp);
} else if (isreal(v)) {
dd = v->v_realdata[i];
(void) fwrite(&dd, sizeof(double), 1, fp);
dd = 0.0;
(void) fwrite(&dd, sizeof(double), 1, fp);
} else {
dd = realpart(v->v_compdata[i]);
(void) fwrite(&dd, sizeof(double), 1, fp);
dd = imagpart(v->v_compdata[i]);
(void) fwrite(&dd, sizeof(double), 1, fp);
}
} else if (raw_padding) {
dd = 0.0;
if (realflag) {
(void) fwrite(&dd, sizeof(double), 1, fp);
} else {
(void) fwrite(&dd, sizeof(double), 1, fp);
(void) fwrite(&dd, sizeof(double), 1, fp);
}
}
}
}
} else {
fprintf(fp, "Values:\n");
for (i = 0; i < length; i++) {
fprintf(fp, " %d", i);
for (v = pl->pl_dvecs; v; v = v->v_next) {
if (i < v->v_length) {
if (realflag)
fprintf(fp, "\t%.*e\n", prec,
isreal(v) ? v->v_realdata[i] :
realpart(v->v_compdata[i]));
else if (isreal(v))
fprintf(fp, "\t%.*e,0.0\n", prec,
v->v_realdata[i]);
else
fprintf(fp, "\t%.*e,%.*e\n", prec,
realpart(v->v_compdata[i]),
prec,
imagpart(v->v_compdata[i]));
} else if (raw_padding) {
if (realflag)
fprintf(fp, "\t%.*e\n", prec, 0.0);
else
fprintf(fp, "\t%.*e,%.*e\n", prec, 0.0, prec, 0.0);
}
}
(void) putc('\n', fp);
}
}
(void) fclose(fp);
}
void polydiv (header *hd)
{ header *st=hd,*hd1,*result,*rest;
int c1,c2,i,r,j;
double *m1,*m2,*mr,*mh,x,l;
complex *mc1,*mc2,*mcr,*mch,xc,lc,hc;
interval *mi1,*mi2,*mir,*mih,xi,li,hi;
hd1=next_param(st);
equal_params_2(&hd,&hd1); if (error) return;
getmatrix(hd,&r,&c1,&m1); if (r!=1) wrong_arg();
getmatrix(hd1,&r,&c2,&m2); if (r!=1) wrong_arg();
if (c1<c2)
{ result=new_real(0.0,"");
rest=(header *)newram;
moveresult(rest,hd1);
}
else if (iscomplex(hd))
{ mc1=(complex *)m1; mc2=(complex *)m2;
result=new_cmatrix(1,c1-c2+1,""); if (error) return;
mcr=(complex *)matrixof(result);
rest=new_cmatrix(1,c2,""); if (error) return;
mch=(complex *)newram;
if (!freeram(c1*sizeof(complex)))
{ output("Out of memory!\n"); error=190; return;
}
memmove((char *)mch,(char *)mc1,c1*sizeof(complex));
c_copy(lc,mc2[c2-1]);
if (lc[0]==0.0 && lc[1]==0.0) wrong_arg();
for (i=c1-c2; i>=0; i--)
{ c_div(mch[c2+i-1],lc,xc); c_copy(mcr[i],xc);
for(j=0; j<c2; j++)
{ c_mult(mc2[j],xc,hc);
c_sub(mch[i+j],hc,mch[i+j]);
}
}
memmove((char *)matrixof(rest),(char *)mch,c2*sizeof(complex));
}
else if (isinterval(hd))
{ mi1=(interval *)m1; mi2=(interval *)m2;
result=new_imatrix(1,c1-c2+1,""); if (error) return;
mir=(interval *)matrixof(result);
rest=new_imatrix(1,c2,""); if (error) return;
mih=(complex *)newram;
if (!freeram(c1*sizeof(complex)))
{ output("Out of memory!\n"); error=190; return;
}
memmove((char *)mih,(char *)mi1,c1*sizeof(interval));
i_copy(li,mi2[c2-1]);
if (li[0]<=0.0 && li[1]>=0.0) wrong_arg();
for (i=c1-c2; i>=0; i--)
{ i_div(mih[c2+i-1],li,xi); c_copy(mir[i],xi);
for(j=0; j<c2; j++)
{ i_mult(mi2[j],xi,hi);
i_sub(mih[i+j],hi,mih[i+j]);
}
}
memmove((char *)matrixof(rest),(char *)mih,c2*sizeof(interval));
}
else if (isreal(hd))
{ result=new_matrix(1,c1-c2+1,""); if (error) return;
mr=matrixof(result);
rest=new_matrix(1,c2,""); if (error) return;
mh=(double *)newram;
if (!freeram(c1*sizeof(double)))
{ output("Out of memory!\n"); error=190; return;
}
memmove((char *)mh,(char *)m1,c1*sizeof(double));
l=m2[c2-1];
if (l==0.0) wrong_arg();
for (i=c1-c2; i>=0; i--)
{ x=mh[c2+i-1]/l; mr[i]=x;
for(j=0; j<c2; j++) mh[i+j]-=m2[j]*x;
}
memmove((char *)matrixof(rest),(char *)mh,c2*sizeof(double));
}
else wrong_arg();
moveresult(st,result);
moveresult(nextof(st),rest);
}
BOOLEAN isarithmetic(TYPE *tp)
{
tp = basetype(tp);
return isint(tp) || isfloat(tp) || iscomplex(tp) || isimaginary(tp);
}
static void
oldwrite(char *name, bool app, struct plot *pl)
{
short four = 4, k;
struct dvec *v;
float f1, f2, zero = 0.0;
char buf[80];
int i, j, tp = VF_REAL, numpts = 0, numvecs = 0;
FILE *fp;
if (!(fp = fopen(name, app ? "a" : "w"))) {
perror(name);
return;
}
for (v = pl->pl_dvecs; v; v = v->v_next) {
if (v->v_length > numpts)
numpts = v->v_length;
numvecs++;
if (iscomplex(v))
tp = VF_COMPLEX;
}
/* This may not be a good idea... */
if (tp == VF_COMPLEX)
pl->pl_scale->v_type = SV_FREQUENCY;
for (i = 0; i < 80; i++)
buf[i] = ' ';
for (i = 0; i < 80; i++)
if (pl->pl_title[i] == '\0')
break;
else
buf[i] = pl->pl_title[i];
tfwrite(buf, 1, 80, fp);
for (i = 0; i < 80; i++)
buf[i] = ' ';
for (i = 0; i < 16; i++)
if (pl->pl_date[i] == '\0')
break;
else
buf[i] = pl->pl_date[i];
tfwrite(buf, 1, 16, fp);
tfwrite(&numvecs, sizeof (short), 1, fp);
tfwrite(&four, sizeof (short), 1, fp);
for (v = pl->pl_dvecs; v; v = v->v_next) {
for (j = 0; j < 80; j++)
buf[j] = ' ';
for (j = 0; j < 8; j++)
if (v->v_name[j] == '\0')
break;
else
buf[j] = v->v_name[j];
tfwrite(buf, 1, 8, fp);
}
for (v = pl->pl_dvecs; v; v = v->v_next) {
j = (short) v->v_type;
tfwrite(&j, sizeof (short), 1, fp);
}
for (k = 1; k < numvecs + 1; k++)
tfwrite(&k, sizeof (short), 1, fp);
for (j = 0; j < 80; j++)
buf[j] = ' ';
for (j = 0; j < 24; j++)
if (pl->pl_name[j] == '\0')
break;
else
buf[j] = pl->pl_name[j];
tfwrite(buf, 1, 24, fp);
for (i = 0; i < numpts; i++) {
for (v = pl->pl_dvecs; v; v = v->v_next) {
if ((tp == VF_REAL) && isreal(v)) {
if (i < v->v_length) {
tfwrite(&v->v_realdata[i], sizeof (double), 1, fp);
} else {
tfwrite(&v->v_realdata[v->v_length - 1], sizeof (double), 1, fp);
}
} else if ((tp == VF_REAL) && iscomplex(v)) {
fprintf(cp_err, "internal error, everything real, yet complex ...\n");
exit(1);
} else if ((tp == VF_COMPLEX) && isreal(v)) {
if (i < v->v_length)
f1 = (float) v->v_realdata[i];
else
f1 = (float) v->v_realdata[v->v_length - 1];
tfwrite(&f1, sizeof (float), 1, fp);
tfwrite(&zero, sizeof (float), 1, fp);
} else if ((tp == VF_COMPLEX) && iscomplex(v)) {
if (i < v->v_length) {
f1 = (float) realpart(v->v_compdata[i]);
f2 = (float) imagpart(v->v_compdata[i]);
} else {
f1 = (float) realpart(v->v_compdata[v-> v_length - 1]);
f2 = (float) imagpart(v->v_compdata[v-> v_length - 1]);
}
tfwrite(&f1, sizeof (float), 1, fp);
tfwrite(&f2, sizeof (float), 1, fp);
}
}
}
(void) fclose(fp);
return;
}
TObject* Scanner::extractNumber(char c){
//the oa
static enum PARTS{
VALUE,
DECIMAL,
EXPONENTIAL,
}CURRENT_PART=VALUE;
//then next and previous
char next, prev;
putback();
bool done = false, complex = false, exp_sign = false;
double value=0;
int power=1, e=0, esign=1;
//bool dot=(c=='.');
//check the dot
if(c=='.'){
CURRENT_PART = DECIMAL;
}
do{
prev = next;
next = getChar();
//check for the j
if(iscomplex(next)){
//make sure the previous is a number
if(!std::isdigit(prev)){
throw new YottaError(SYNTAX_ERROR, getLine(), line, char_line);
}
//get the next and make sure it's not something stupid
next = getChar();
complex = true;
break;
}
switch(CURRENT_PART){
case VALUE:
if(std::isdigit(next)){
value = (value*10) + (next-'0');
}else if(next=='.'){
//move to the decimal
CURRENT_PART = DECIMAL;
}else if(isexp(next)){
CURRENT_PART = EXPONENTIAL;
}else{
done = true;
}
break;
case DECIMAL:
if(std::isdigit(next)){
value = (value*10) + (next-'0');
//then increment the power
power *= 10;
}else if(isexp(next)){
//make sure the previous is not a decimal
if(prev==DECIMAL){
//throw a syntax error
throw new YottaError(SYNTAX_ERROR, getLine(), line, char_line);
}else{
CURRENT_PART = EXPONENTIAL;
}
}else if(next=='.'){
//then throw an exception
throw new YottaError(SYNTAX_ERROR, getLine(), line, char_line);
}else{
done = true;
}
break;
case EXPONENTIAL:
//then we need
if(std::isdigit(next)){
//then add it to the exponential stuff
e = (e*10)+(next-'0');
}else if((next=='-' || next=='+') && isexp(prev)){
if(exp_sign){
//then we throw an exception
throw new YottaError(SYNTAX_ERROR, getLine(), line, char_line);
done = true;
break;
}
exp_sign = true;
//then check
if(next=='-')
esign = -1;
else
esign = 1;
}else if(next=='.'){
throw new YottaError(SYNTAX_ERROR, getLine(), line, char_line);
}else{
done = true;
}
}
}while(!done);
TOKEN_TYPE type = token_type(next);
if(type==IDENTIFIER || type==NUMERIC){
//throw again an exception
throw new YottaError(SYNTAX_ERROR, getLine(), line, char_line);
}
if(next!=END_OF_BUFFER){
putback();
}
//final value
value = (value / power) * pow(10.0, esign*e);
Numeric* object = new Numeric(1, 1);
if(complex)
object->operator[](0) = Number(0, value);
else
object->operator[](0) = Number(value, 0);
//little did I know enums were static (if not done, it will maintain its last state)
CURRENT_PART = VALUE;
//if we reached here, it's cool
TObject* rv = new TObject(0, NUMERIC, line, char_line);
rv->obj = object;
return rv;
}
/* This is a strange function. What we do is fit a polynomial to the
* curve, of degree $polydegree, and then evaluate it at the points
* in the time scale. What we do is this: for every set of points that
* we fit a polynomial to, fill in as much of the new vector as we can
* (i.e, between the last value of the old scale we went from to this
* one). At the ends we just use what we have... We have to detect
* badness here too...
*
* Note that we pass arguments differently for this one cx_ function... */
void *
cx_interpolate(void *data, short int type, int length, int *newlength, short int *newtype, struct plot *pl, struct plot *newpl, int grouping)
{
struct dvec *ns, *os;
double *d;
int degree;
register int i, oincreasing = 1, nincreasing = 1;
int base;
if (grouping == 0)
grouping = length;
/* First do some sanity checks. */
if (!pl || !pl->pl_scale || !newpl || !newpl->pl_scale) {
fprintf(cp_err, "Internal error: cx_interpolate: bad scale\n");
return (NULL);
}
ns = newpl->pl_scale;
os = pl->pl_scale;
if (iscomplex(ns)) {
fprintf(cp_err, "Error: new scale has complex data\n");
return (NULL);
}
if (iscomplex(os)) {
fprintf(cp_err, "Error: old scale has complex data\n");
return (NULL);
}
if (length != os->v_length) {
fprintf(cp_err, "Error: lengths don't match\n");
return (NULL);
}
if (type != VF_REAL) {
fprintf(cp_err, "Error: argument has complex data\n");
return (NULL);
}
/* Now make sure that either both scales are strictly increasing
* or both are strictly decreasing. */
if (os->v_realdata[0] < os->v_realdata[1])
oincreasing = TRUE;
else
oincreasing = FALSE;
for (i = 0; i < os->v_length - 1; i++)
if ((os->v_realdata[i] < os->v_realdata[i + 1])
!= oincreasing) {
fprintf(cp_err, "Error: old scale not monotonic\n");
return (NULL);
}
if (ns->v_realdata[0] < ns->v_realdata[1])
nincreasing = TRUE;
else
nincreasing = FALSE;
for (i = 0; i < ns->v_length - 1; i++)
if ((ns->v_realdata[i] < ns->v_realdata[i + 1])
!= nincreasing) {
fprintf(cp_err, "Error: new scale not monotonic\n");
return (NULL);
}
*newtype = VF_REAL;
*newlength = ns->v_length;
d = alloc_d(ns->v_length);
if (!cp_getvar("polydegree", VT_NUM, (void *) °ree))
degree = 1;
for (base = 0; base < length; base += grouping) {
if (!ft_interpolate((double *) data + base, d + base,
os->v_realdata + base, grouping,
ns->v_realdata + base, grouping, degree))
{
tfree(d);
return (NULL);
}
}
return ((void *) d);
}
void
com_compose(wordlist *wl)
{
double start = 0.0;
double stop = 0.0;
double step = 0.0;
double lin = 0.0;
double center;
double span;
double mean, sd;
bool startgiven = FALSE, stopgiven = FALSE, stepgiven = FALSE;
bool lingiven = FALSE;
bool loggiven = FALSE, decgiven = FALSE, gaussgiven = FALSE;
bool randmgiven = FALSE;
bool spangiven = FALSE;
bool centergiven = FALSE;
bool meangiven = FALSE;
bool poolgiven = FALSE;
bool sdgiven = FALSE;
int log, dec, gauss, randm;
char *pool;
int i;
char *s, *var, *val;
double *td, tt;
double *data = NULL;
ngcomplex_t *cdata = NULL;
int length = 0;
int dim, type = SV_NOTYPE, blocksize;
bool realflag = TRUE;
int dims[MAXDIMS];
struct dvec *result, *vecs = NULL, *v, *lv = NULL;
struct pnode *pn, *names = NULL;
bool reverse = FALSE;
char *resname = cp_unquote(wl->wl_word);
vec_remove(resname);
wl = wl->wl_next;
if (eq(wl->wl_word, "values")) {
/* Build up the vector from the rest of the line... */
wl = wl->wl_next;
names = ft_getpnames(wl, TRUE);
if (!names)
goto done;
for (pn = names; pn; pn = pn->pn_next) {
if ((v = ft_evaluate(pn)) == NULL)
goto done;
if (!vecs)
vecs = lv = v;
else
lv->v_link2 = v;
for (lv = v; lv->v_link2; lv = lv->v_link2)
;
}
/* Now make sure these are all of the same dimensionality. We
* can coerce the sizes...
*/
dim = vecs->v_numdims;
if (dim < 2)
dim = (vecs->v_length > 1) ? 1 : 0;
if (dim == MAXDIMS) {
fprintf(cp_err, "Error: max dimensionality is %d\n",
MAXDIMS);
goto done;
}
for (v = vecs; v; v = v->v_link2)
if (v->v_numdims < 2)
v->v_dims[0] = v->v_length;
for (v = vecs->v_link2, length = 1; v; v = v->v_link2) {
i = v->v_numdims;
if (i < 2)
i = (v->v_length > 1) ? 1 : 0;
if (i != dim) {
fprintf(cp_err,
"Error: all vectors must be of the same dimensionality\n");
goto done;
}
length++;
if (iscomplex(v))
realflag = FALSE;
}
for (i = 0; i < dim; i++) {
dims[i] = vecs->v_dims[i];
for (v = vecs->v_link2; v; v = v->v_link2)
if (v->v_dims[i] > dims[i])
dims[i] = v->v_dims[i];
}
dim++;
dims[dim - 1] = length;
for (i = 0, blocksize = 1; i < dim - 1; i++)
blocksize *= dims[i];
if (realflag)
data = TMALLOC(double, length * blocksize);
else