===================================================================
RCS file: /home/cvs/OpenXM_contrib2/asir2000/builtin/itvnum.c,v
retrieving revision 1.1
retrieving revision 1.10
diff -u -p -r1.1 -r1.10
--- OpenXM_contrib2/asir2000/builtin/itvnum.c	2000/12/22 09:58:32	1.1
+++ OpenXM_contrib2/asir2000/builtin/itvnum.c	2016/06/29 08:16:11	1.10
@@ -1,10 +1,13 @@
 /*
- * $OpenXM: $
+ * $OpenXM: OpenXM_contrib2/asir2000/builtin/itvnum.c,v 1.9 2015/08/14 13:51:54 fujimoto Exp $
  */
 
 #include "ca.h"
 #include "parse.h"
 #include "version.h"
+#if !defined(ANDROID)
+#include "../plot/ifplot.h"
+#endif
 
 #if defined(INTERVAL)
 
@@ -21,10 +24,19 @@ static void Pcup(NODE, Obj *);
 static void Pcap(NODE, Obj *);
 static void Pwidth(NODE, Obj *);
 static void Pdistance(NODE, Obj *);
-static void Pitvversion(Obj *);
+static void Pitvversion(Q *);
+void miditvp(Itv,Num *);
+void absitvp(Itv,Num *);
+int initvd(Num,IntervalDouble);
+int initvp(Num,Itv);
+int itvinitvp(Itv,Itv);
 #endif
 static void Pprintmode(NODE, Obj *);
 
+/* plot time check func */
+static void ccalc(double **, struct canvas *, int);
+static void Pifcheck(NODE, Obj *);
+
 #if	defined(__osf__) && 0
 int	end;
 #endif
@@ -50,17 +62,184 @@ struct ftab interval_tab[] = {
 	{"diam",Pwidth,1},
 	{"distance",Pdistance,2},
 	{"iversion",Pitvversion,0},
+/* plot time check */
+	{"ifcheck",Pifcheck,-7},
 #endif
 	{0,0,0},
 };
 
 #if defined(INTERVAL)
+
+/* plot time check */
 static void
-Pitvversion(Obj *rp)
+Pifcheck(NODE arg, Obj *rp)
 {
-	STOQ(ASIR_VERSION,(Q)*rp);
+	Q m2,p2,s_id;
+	NODE defrange;
+	LIST xrange,yrange,range[2],list,geom;
+	VL vl,vl0;
+	V v[2],av[2];
+	int ri,i,j,sign;
+	P poly;
+	P var;
+	NODE n,n0;
+	Obj t;
+
+	struct canvas *can;
+	MAT m;
+	pointer **mb;
+	double **tabe, *px, *px1, *px2;
+	Q one;
+	int width, height, ix, iy;
+	int id;
+
+	STOQ(-2,m2); STOQ(2,p2);
+	STOQ(1,one);
+	MKNODE(n,p2,0); MKNODE(defrange,m2,n);
+	poly = 0; vl = 0; geom = 0; ri = 0;
+	v[0] = v[1] = 0;
+	for ( ; arg; arg = NEXT(arg) ){
+		switch ( OID(BDY(arg)) ) {
+		case O_P:
+			poly = (P)BDY(arg);
+			get_vars_recursive((Obj)poly,&vl);
+			for(vl0=vl,i=0;vl0;vl0=NEXT(vl0)){
+				if(vl0->v->attr==(pointer)V_IND){
+					if(i>=2){
+						error("ifplot : invalid argument");
+					} else {
+						v[i++]=vl0->v;
+					}
+				}
+			}
+			break;
+		case O_LIST:
+			list = (LIST)BDY(arg);
+			if ( OID(BDY(BDY(list))) == O_P )
+				if ( ri > 1 )
+					error("ifplot : invalid argument");
+				else
+					range[ri++] = list;
+			else
+				geom = list;
+			break;
+		default:
+			error("ifplot : invalid argument"); break;
+		}
+	}
+	if ( !poly ) error("ifplot : invalid argument");
+	switch ( ri ) {
+		case 0:
+			if ( !v[1] ) error("ifplot : please specify all variables");
+			MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
+			MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
+			break;
+		case 1:
+			if ( !v[1] ) error("ifplot : please specify all variables");
+			av[0] = VR((P)BDY(BDY(range[0])));
+			if ( v[0] == av[0] ) {
+				xrange = range[0];
+				MKV(v[1],var); MKNODE(n,var,defrange); MKLIST(yrange,n);
+			} else if ( v[1] == av[0] ) {
+				MKV(v[0],var); MKNODE(n,var,defrange); MKLIST(xrange,n);
+				yrange = range[0];
+			} else
+				error("ifplot : invalid argument");
+			break;
+		case 2:
+			av[0] = VR((P)BDY(BDY(range[0])));
+			av[1] = VR((P)BDY(BDY(range[1])));
+			if ( ((v[0] == av[0]) && (!v[1] || v[1] == av[1])) ||
+				 ((v[0] == av[1]) && (!v[1] || v[1] == av[0])) ) {
+					xrange = range[0]; yrange = range[1];
+			} else error("ifplot : invalid argument");
+			break;
+		default:
+			error("ifplot : cannot happen"); break;
+	}
+	can = canvas[id = search_canvas()];
+	if ( !geom ) {
+		width = 300;
+		height = 300;
+		can->width = 300;
+		can->height = 300;
+	} else {
+		can->width = QTOS((Q)BDY(BDY(geom)));
+		can->height = QTOS((Q)BDY(NEXT(BDY(geom))));
+		width = can->width;
+		height = can->height;
+	}
+	if ( xrange ) {
+		n = BDY(xrange); can->vx = VR((P)BDY(n)); n = NEXT(n);
+		can->qxmin = (Q)BDY(n); n = NEXT(n); can->qxmax = (Q)BDY(n);
+		can->xmin = ToReal(can->qxmin); can->xmax = ToReal(can->qxmax); 
+	}
+	if ( yrange ) {
+		n = BDY(yrange); can->vy = VR((P)BDY(n)); n = NEXT(n);
+		can->qymin = (Q)BDY(n); n = NEXT(n); can->qymax = (Q)BDY(n);
+		can->ymin = ToReal(can->qymin); can->ymax = ToReal(can->qymax); 
+	}
+	can->wname = "ifcheck";
+	can->formula = poly;
+	tabe = (double **)ALLOCA((width+1)*sizeof(double *));
+	for ( i = 0; i <= width; i++ )
+		tabe[i] = (double *)ALLOCA((height+1)*sizeof(double));
+	for(i=0;i<=width;i++)for(j=0;j<=height;j++)tabe[i][j]=0;
+	ccalc(tabe,can,0);
+	MKMAT(m,width,height);
+	mb = BDY(m);
+	for( ix=0; ix<width; ix++ ){
+		for( iy=0; iy<height; iy++){
+			if ( tabe[ix][iy] >= 0 ){
+				if ( (tabe[ix+1][iy] <= 0) ||
+					(tabe[ix][iy+1] <= 0 ) ||
+					(tabe[ix+1][iy+1] <= 0 ) ) mb[ix][iy] = (Obj)one;
+			} else {
+				if ( (tabe[ix+1][iy] >= 0 ) ||
+					( tabe[ix][iy+1] >= 0 ) ||
+					( tabe[ix+1][iy+1] >= 0 )) mb[ix][iy] = (Obj)one;
+			}
+		}
+	}
+	*rp = (Obj)m;
 }
 
+void ccalc(double **tab,struct canvas *can,int nox)
+{
+	 double x,y,xmin,ymin,xstep,ystep;
+	 int ix,iy;
+	 Real r,rx,ry;
+	 Obj fr,g;
+	 int w,h;
+	 V vx,vy;
+	 Obj t,s;
+
+	 MKReal(1.0,r); mulr(CO,(Obj)can->formula,(Obj)r,&fr);
+	 vx = can->vx;
+	 vy = can->vy;
+	 w = can->width; h = can->height; 
+	 xmin = can->xmin; xstep = (can->xmax-can->xmin)/w;
+	 ymin = can->ymin; ystep = (can->ymax-can->ymin)/h;
+	 MKReal(1.0,rx); MKReal(1.0,ry);
+	 for( ix = 0, x = xmin; ix < w+1 ; ix++, x += xstep ) {
+	    BDY(rx) = x; substr(CO,0,fr,vx,x?(Obj)rx:0,&t);
+	    devalr(CO,t,&g);
+	    for( iy = 0, y = ymin; iy < h+1 ; iy++, y += ystep ) {
+	       BDY(ry) = y;
+	       substr(CO,0,g,vy,y?(Obj)ry:0,&t);
+	       devalr(CO,t,&s);
+	       tab[ix][iy] = ToReal(s);
+	    }
+	 }
+}
+/* end plot time check */
+
+static void
+Pitvversion(Q *rp)
+{
+	STOQ(ASIR_VERSION, *rp);
+}
+
 extern int	bigfloat;
 
 static void
@@ -86,20 +265,21 @@ Pitv(NODE arg, Obj *rp)
 			*rp = 0;
 			return;
 		}
-		else if ( NID(a) == N_IP || NID(a) == N_IF) {
+		else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat) {
 			*rp = (Obj)a;
 			return;
 		}
-		else if ( NID(a) == N_ID ) {
-			inf = INF((ItvD)a);
-			sup = SUP((ItvD)a);
+		else if ( NID(a) == N_IntervalDouble ) {
+			inf = INF((IntervalDouble)a);
+			sup = SUP((IntervalDouble)a);
 			double2bf(inf, (BF *)&i);
 			double2bf(sup, (BF *)&s);
 			istoitv(i,s,&c);
 		}
 		else istoitv(a,a,&c);
 	}
-	if ( NID( c ) == N_IF ) addulp((ItvF)c, (ItvF *)rp);
+	if ( NID( c ) == N_IntervalBigFloat )
+		addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
 	else *rp = (Obj)c;
 #endif
 }
@@ -132,13 +312,13 @@ Pitvbf(NODE arg, Obj *rp)
 			ToBf(s, &ss);
 			istoitv((Num)ii,(Num)ss,&c);
 		}
-		else if ( NID(a) == N_IF) {
+		else if ( NID(a) == N_IntervalBigFloat) {
 			*rp = (Obj)a;
 			return;
 		}
-		else if ( NID(a) == N_ID ) {
-			inf = INF((ItvD)a);
-			sup = SUP((ItvD)a);
+		else if ( NID(a) == N_IntervalDouble ) {
+			inf = INF((IntervalDouble)a);
+			sup = SUP((IntervalDouble)a);
 			double2bf(inf, (BF *)&i);
 			double2bf(sup, (BF *)&s);
 			istoitv(i,s,&c);
@@ -148,7 +328,8 @@ Pitvbf(NODE arg, Obj *rp)
 			istoitv(i,i,&c);
 		}
 	}
-	if ( c && OID( c ) == O_N && NID( c ) == N_IF ) addulp((ItvF)c, (ItvF *)rp);
+	if ( c && OID( c ) == O_N && NID( c ) == N_IntervalBigFloat )
+		addulp((IntervalBigFloat)c, (IntervalBigFloat *)rp);
 	else *rp = (Obj)c;
 }
 
@@ -158,7 +339,7 @@ Pitvd(NODE arg, Obj *rp)
 	double	inf, sup;
 	Num	a, a0, a1, t;
 	Itv	ia;
-	ItvD	d;
+	IntervalDouble	d;
 
 	asir_assert(ARG0(arg),O_N,"intvald");
 	a0 = (Num)ARG0(arg);
@@ -166,10 +347,10 @@ Pitvd(NODE arg, Obj *rp)
 		asir_assert(ARG1(arg),O_N,"intvald");
 		a1 = (Num)ARG1(arg);
 	} else {
-		if ( a0 && OID(a0)==O_N && NID(a0)==N_ID ) {
-			inf = INF((ItvD)a0);
-			sup = SUP((ItvD)a0);
-			MKItvD(inf,sup,d);
+		if ( a0 && OID(a0)==O_N && NID(a0)==N_IntervalDouble ) {
+			inf = INF((IntervalDouble)a0);
+			sup = SUP((IntervalDouble)a0);
+			MKIntervalDouble(inf,sup,d);
 			*rp = (Obj)d;
 			return;
 		}
@@ -180,7 +361,7 @@ Pitvd(NODE arg, Obj *rp)
 	}
 	inf = ToRealDown(a0);
 	sup = ToRealUp(a1);
-	MKItvD(inf,sup,d);
+	MKIntervalDouble(inf,sup,d);
 	*rp = (Obj)d;
 }
 
@@ -196,18 +377,18 @@ Pinf(NODE arg, Obj *rp)
 		*rp = 0;
 	} else if  ( OID(a) == O_N ) {
 		switch ( NID(a) ) {
-			case N_ID:
-				d = INF((ItvD)a);
+			case N_IntervalDouble:
+				d = INF((IntervalDouble)a);
 				MKReal(d, r);
 				*rp = (Obj)r;
 				break;
 			case N_IP:
-			case N_IF:
-			case N_IT:
+			case N_IntervalBigFloat:
+			case N_IntervalQuad:
 				itvtois((Itv)ARG0(arg),&i,&s);
 				*rp = (Obj)i;
 				break;
-			defaults:
+			default:
 				*rp = (Obj)a;
 				break;
 		}
@@ -228,18 +409,18 @@ Psup(NODE arg, Obj *rp)
 		*rp = 0;
 	} else if  ( OID(a) == O_N ) {
 		switch ( NID(a) ) {
-			case N_ID:
-				d = SUP((ItvD)a);
+			case N_IntervalDouble:
+				d = SUP((IntervalDouble)a);
 				MKReal(d, r);
 				*rp = (Obj)r;
 				break;
 			case N_IP:
-			case N_IF:
-			case N_IT:
+			case N_IntervalBigFloat:
+			case N_IntervalQuad:
 				itvtois((Itv)ARG0(arg),&i,&s);
 				*rp = (Obj)s;
 				break;
-			defaults:
+			default:
 				*rp = (Obj)a;
 				break;
 		}
@@ -260,14 +441,14 @@ Pmid(NODE arg, Obj *rp)
 		*rp = 0;
 	} else switch (OID(a)) {
 		case O_N:
-			if ( NID(a) == N_ID ) {
-				d = ( INF((ItvD)a)+SUP((ItvD)a) ) / 2.0;
+			if ( NID(a) == N_IntervalDouble ) {
+				d = ( INF((IntervalDouble)a)+SUP((IntervalDouble)a) ) / 2.0;
 				MKReal(d, r);
 				*rp = (Obj)r;
-			} else if ( NID(a) == N_IT ) {
+			} else if ( NID(a) == N_IntervalQuad ) {
 				error("mid: not supported operation");
 				*rp = 0;
-			} else if ( NID(a) == N_IP || NID(a) == N_IF ) {
+			} else if ( NID(a) == N_IP || NID(a) == N_IntervalBigFloat ) {
 				miditvp((Itv)ARG0(arg),&s);
 				*rp = (Obj)s;
 			} else {
@@ -281,7 +462,7 @@ Pmid(NODE arg, Obj *rp)
 		case O_VECT:
 		case O_MAT:
 #endif
-		defaults:
+		default:
 			*rp = (Obj)a;
 			break;
 	}
@@ -297,8 +478,8 @@ Pcup(NODE arg, Obj *rp)
 	asir_assert(ARG1(arg),O_N,"cup");
 	a = (Num)ARG0(arg);
 	b = (Num)ARG1(arg);
-	if ( a && NID(a) == N_ID && b && NID(b) == N_ID ) {
-		cupitvd((ItvD)a, (ItvD)b, (ItvD *)rp);
+	if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
+		cupitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
 	} else {
 		cupitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
 		*rp = (Obj)s;
@@ -315,8 +496,8 @@ Pcap(NODE arg, Obj *rp)
 	asir_assert(ARG1(arg),O_N,"cap");
 	a = (Num)ARG0(arg);
 	b = (Num)ARG1(arg);
-	if ( a && NID(a) == N_ID && b && NID(b) == N_ID ) {
-		capitvd((ItvD)a, (ItvD)b, (ItvD *)rp);
+	if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
+		capitvd((IntervalDouble)a, (IntervalDouble)b, (IntervalDouble *)rp);
 	} else {
 		capitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
 		*rp = (Obj)s;
@@ -335,8 +516,8 @@ Obj *rp;
 	a = (Num)ARG0(arg);
 	if ( ! a ) {
 		*rp = 0;
-	} else if ( NID(a) == N_ID ) {
-		widthitvd((ItvD)a, (Num *)rp);
+	} else if ( NID(a) == N_IntervalDouble ) {
+		widthitvd((IntervalDouble)a, (Num *)rp);
 	} else {
 		widthitvp((Itv)ARG0(arg),&s);
 		*rp = (Obj)s;
@@ -355,8 +536,8 @@ Obj *rp;
 	a = (Num)ARG0(arg);
 	if ( ! a ) {
 		*rp = 0;
-	} else if ( NID(a) == N_ID ) {
-		absitvd((ItvD)a, (Num *)rp);
+	} else if ( NID(a) == N_IntervalDouble ) {
+		absitvd((IntervalDouble)a, (Num *)rp);
 	} else {
 		absitvp((Itv)ARG0(arg),&s);
 		*rp = (Obj)s;
@@ -375,8 +556,8 @@ Obj *rp;
 	asir_assert(ARG1(arg),O_N,"distance");
 	a = (Num)ARG0(arg);
 	b = (Num)ARG1(arg);
-	if ( a && NID(a) == N_ID && b && NID(b) == N_ID ) {
-		distanceitvd((ItvD)a, (ItvD)b, (Num *)rp);
+	if ( a && NID(a) == N_IntervalDouble && b && NID(b) == N_IntervalDouble ) {
+		distanceitvd((IntervalDouble)a, (IntervalDouble)b, (Num *)rp);
 	} else {
 		distanceitvp((Itv)ARG0(arg),(Itv)ARG1(arg),&s);
 		*rp = (Obj)s;
@@ -397,10 +578,10 @@ Obj *rp;
 		if ( ! ARG0(arg) ) s = 1;
 		else s = 0;
 	}
-	else if ( NID(ARG1(arg)) == N_ID ) {
-		s = initvd((Num)ARG0(arg),(ItvD)ARG1(arg));
+	else if ( NID(ARG1(arg)) == N_IntervalDouble ) {
+		s = initvd((Num)ARG0(arg),(IntervalDouble)ARG1(arg));
 
-	} else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IF ) {
+	} else if ( NID(ARG1(arg)) == N_IP || NID(ARG1(arg)) == N_IntervalBigFloat ) {
 		if ( ! ARG0(arg) ) s = initvp((Num)ARG0(arg),(Itv)ARG1(arg));
 		else if ( NID(ARG0(arg)) == N_IP ) {
 			s = itvinitvp((Itv)ARG0(arg),(Itv)ARG1(arg));
@@ -459,8 +640,8 @@ Pprintmode(NODE arg, Obj *rp)
 	Q	a, r;
 
 	a = (Q)ARG0(arg);
-	if ( !a || NUM(a) && INT(a) ) {
-		l = QTOS(a);
+	if(!a||(NUM(a)&&INT(a))){
+		l=QTOS(a);
 		if ( l < 0 ) l = 0;
 #if defined(INTERVAL)
 		else if ( l > MID_PRINTF_E ) l = 0;