1 /* ======================================================= *
2 * Copyright 1998-2008 Stephen C. Grubb *
3 * http://ploticus.sourceforge.net *
4 * Covered by GPL; see the file ./Copyright for details. *
5 * ======================================================= */
6
7 #include "pl.h"
8
9 /* constants for clustering.. */
10 #define NOFS
PLP_rect()11 static double xofst[38] = { 0, 0, 4, 0, -4, 4, -4, -4, 4,
12 0, -8, 0, 8, 4, -8, 4, 8, -4, -8, -4, 8,
13 0, 0, 12, -12, 4, 4, 12, -12, -4, -4, 12, -12,
14 8, -8, -8, 8 };
15
16 static double yofst[38] = { 0, 4, 0, -4, 0, 4, -4, 4, -4,
17 -8, 0, 8, 0, -8, 4, 8, 4, -8, -4, 8, -4,
18 12, -12, 0, 0, 12, -12, 4, 4, 12, -12, -4, -4,
19 8, -8, 8, -8 };
20
21
22 #ifdef NONANSI
23 static int ptcompare();
24 #else
25 static int ptcompare(const void *a, const void *b);
26 #endif
27
28 int
29 PLP_scatterplot()
30 {
31 char attr[NAMEMAXLEN], *line, *lineval;
32 int lvp, first;
33
34 int i, nt, stat, align, result, cluster, dupcount, subdupcount, clustevery, verttext, nrow, realrow;
35 int clustermeth, symfield_userange, dupsleg, irow, dorect, rectoutline, flop2, maxdups, doing_alt;
36 int xfield, yfield, lblfield, sizefield, symfield;
37 char *symbol, *linedetails, *text, *textdetails, *selex, *legendlabel, *xrange, *yrange;
38 char *mapurl, *maplabel, *expandedurl, *expandedlabel, *labelword, *altsym, *altwhen;
39 char buf[512], symcode[80], rhi[40], rlo[40];
40 char linedir, reqlinedir;
41
42 double adjx, adjy, linelen, xloc, yloc, radius, x, y, cx, cy, hlinelen, sizescale;
43 double ox[38], oy[38], clusterfact, oldx, oldy, xlo, xhi, ylo, yhi, clusterdiff, ptx, pty, hw, txhi, rectw, recth, vennden;
44
45
46 TDH_errprog( "pl proc scatterplot" );
47
48
49 /* initialize */
50 xfield = -1; yfield = -1;
51 symbol = ""; linedetails = ""; text = ""; textdetails = ""; selex = ""; legendlabel = ""; xrange = ""; yrange = "";
52 mapurl = ""; maplabel = ""; altsym = ""; altwhen = "";
53 labelword = "@VAL";
54 linelen = -1.0;
55 xloc = 0.0; yloc = 0.0;
56 vennden = 0.0;
57 sizescale = 0.5/72.0; /* correspond roughly with pt size */
58 clusterfact = 0.01;
59 clusterdiff = 0.001;
60 lblfield = -1;
61 sizefield = -1;
62 symfield = -1;
63 cluster = 0; /* changed and added to "breakers" in docs, scg 5/29/06 */
64 verttext = 0; clustevery = 0; clustermeth = 0; dupsleg = 0; symfield_userange = 0; dorect = 0; rectoutline = 0; doing_alt = 0;
65 linedir = reqlinedir = '\0'; /* scg 3/4/03 */
66
67
68 /* get attributes.. */
69 first = 1;
70 while( 1 ) {
71 line = getnextattr( first, attr, &lvp );
72 if( line == NULL ) break;
73 first = 0;
74 lineval = &line[lvp];
75
76 if( strcmp( attr, "xfield" )==0 ) xfield = fref( lineval ) -1;
77 else if( strcmp( attr, "yfield" )==0 ) yfield = fref( lineval ) -1;
78 else if( strcmp( attr, "labelfield" )==0 ) lblfield = fref( lineval ) -1;
79 else if( strcmp( attr, "sizefield" )==0 ) sizefield = fref( lineval ) -1;
80 else if( strcmp( attr, "symbol" )==0 ) symbol = lineval;
81 else if( strcmp( attr, "text" )==0 ) text = lineval;
82 else if( strcmp( attr, "textdetails" )==0 ) textdetails = lineval;
83 else if( strcmp( attr, "sizescale" )==0 ) sizescale = ftokncpy( lineval ) * 0.5/72.0;
84 else if( strcmp( attr, "xrange" )==0 ) xrange = lineval;
85 else if( strcmp( attr, "yrange" )==0 ) yrange = lineval;
86 else if( strcmp( attr, "clickmapurl" )==0 ) mapurl = lineval;
87 else if( strcmp( attr, "clickmaplabel" )==0 ) maplabel = lineval;
88 else if( strcmp( attr, "clickmaplabeltext" )==0 ) maplabel = getmultiline( lineval, "get" );
89 else if( strcmp( attr, "linelen" )==0 ) {
90 if( lineval == "" ) linelen = -1.0;
91 else { linelen = ftokncpy( lineval ); if( PLS.usingcm ) linelen /= 2.54; }
92 }
93 else if( strcmp( attr, "linedir" )==0 ) reqlinedir = lineval[0];
94 else if( strcmp( attr, "linedetails" )==0 ) linedetails = lineval;
95 else if( strcmp( attr, "xlocation" )==0 ) {
96 Eposex( lineval, X, &xloc ); /* val -> lineval scg 5/3/99 */
97 if( Econv_error() ) Eerr( 2394, "invalid xlocation", lineval );
98 }
99 else if( strcmp( attr, "ylocation" )==0 ) {
100 Eposex( lineval, Y, &yloc ); /* val -> lineval 5/3/99 */
101 if( Econv_error() ) Eerr( 2395, "invalid ylocation", lineval );
102 }
103 else if( strcmp( attr, "select" )==0 ) selex = lineval;
104 else if( strcmp( attr, "legendlabel" )==0 ) legendlabel = lineval;
105 else if( strcmp( attr, "cluster" )==0 ) cluster = getyn( lineval );
106 else if( strcmp( attr, "clusterdiff" )==0 ) { cluster = 1; clusterdiff = ftokncpy( lineval ); }
107 else if( strcmp( attr, "clustermethod" )==0 ) { cluster = 1; clustermeth = lineval[0]; } /* h, v, 2, u, r, .. */
108 else if( strcmp( attr, "clusterfact" )==0 ) { cluster = 1; clusterfact = ftokncpy( lineval ) * .01; }
109 else if( strcmp( attr, "clustevery" )==0 ) { cluster = 1; clustevery = itokncpy( lineval ); if( clustevery < 1 ) clustevery = 1; }
110 else if( strcmp( attr, "dupsleg" )==0 ) {
111 dupsleg = getyn( lineval );
112 if( dupsleg ) { cluster = 1; clustermeth = 'l'; symbol = "sym6a"; } /* symbol set here and below to guarantee symbol mode */
113 }
114 else if( strcmp( attr, "symfield" )==0 ) { symbol = "sym6a"; symfield = fref( lineval ) -1; symfield_userange = 0; }
115 else if( strcmp( attr, "symrangefield" )==0 ) { symbol = "sym6a"; symfield = fref( lineval ) -1; symfield_userange = 1; }
116 else if( strcmp( attr, "verticaltext" )==0 ) verttext = getyn( lineval );
117 else if( strcmp( attr, "rectangle" )==0 ) {
118 nt = sscanf( lineval, "%lf %lf %s", &rectw, &recth, buf );
119 if( nt == 3 ) rectoutline = 1;
120 rectw *= 0.5;
121 recth *= 0.5;
122 rectw = Eax( rectw ) - Eax( 0.0 );
123 recth = Eay( recth ) - Eay( 0.0 );
124 dorect = 1;
125 }
126 else if( strcmp( attr, "labelword" ) == 0 ) labelword = lineval;
127 else if( strcmp( attr, "vennden" ) == 0 ) vennden = ftokncpy( lineval );
128 else if( strcmp( attr, "altsymbol" )==0 ) altsym = lineval;
129 else if( strcmp( attr, "altwhen" )==0 ) altwhen = lineval;
130 else Eerr( 1, "attribute not recognized", attr );
131 }
132
133
134 /* overrides and degenerate cases */
135 /* -------------------------- */
136 if( Nrecords < 1 ) return( Eerr( 17, "No data has been read yet w/ proc getdata", "" ) );
137 if( !scalebeenset() )
138 return( Eerr( 51, "No scaled plotting area has been defined yet w/ proc areadef", "" ) );
139
140 if( xfield < 0 && yfield < 0 ) return( Eerr( 2205, "Niether xfield nor yfield defined", "" ));
141
142 if( lblfield >= 0 ) cluster = 0; /* added scg 12/21/00 */
143
144 if( strcmp( legendlabel, "#usexname" )==0 ) getfname( xfield+1, legendlabel );
145 if( strcmp( legendlabel, "#useyname" )==0 ) getfname( yfield+1, legendlabel );
146
147 if( dorect ) symbol = "";
148
149
150 /* now do the plotting work.. */
151 /* -------------------------- */
152
153 if( cluster ) {
154 /* make offsets */
155 for( i = 0; i < 38; i++ ) {
156 ox[i] = xofst[i] * clusterfact;
157 oy[i] = yofst[i] * clusterfact;
158 }
159
160 /* determine cluster method */
161 if( clustermeth == 0 ) {
162 if( yfield < 0 ) clustermeth = 'v'; /* 1-d horizontal - cluster vertically (was 'h'-scg 4/21/05) */
163 else if( xfield < 0 ) clustermeth = 'h'; /* 1-d vertical - cluster horizontally (was 'v'-scg 4/21/05) */
164 else clustermeth = '2'; /* 2-d cluster */
165 }
166 }
167
168 /* ranges */
169 xlo = EDXlo;
170 xhi = EDXhi;
171 ylo = EDYlo;
172 yhi = EDYhi;
173 if( xrange[0] != '\0' ) {
174 nt = sscanf( xrange, "%s %s", rlo, rhi );
175 xlo = Econv( X, rlo );
176 if( Econv_error() ) { Eerr( 3958, "xrange bad format", rlo ); xlo = EDXlo; }
177 if( nt == 2 ) xhi = Econv( X, rhi );
178 if( Econv_error() ) { Eerr( 3958, "xrange bad format", rhi ); xhi = EDXhi; }
179 }
180 if( yrange[0] != '\0' ) {
181 nt = sscanf( yrange, "%s %s", rlo, rhi );
182 ylo = Econv( Y, rlo );
183 if( Econv_error() ) { Eerr( 3958, "yrange bad format", rlo ); ylo = EDYlo; }
184 if( nt == 2 ) yhi = Econv( Y, rhi );
185 if( Econv_error() ) { Eerr( 3958, "yrange bad format", rhi ); yhi = EDYhi; }
186 }
187
188
189
190
191
192 nrow = 0;
193 for( i = 0; i < Nrecords; i++ ) {
194
195 if( selex[0] != '\0' ) { /* process against selection condition if any.. */
196 stat = do_select( selex, i, &result );
197 if( stat != 0 ) { Eerr( stat, "Select error", selex ); continue; }
198 if( result == 0 ) continue; /* reject */
199 }
200
201 /* get x value.. */
202 if( xfield >= 0 ) {
203 x = fda( i, xfield, 'x' );
204 if( Econv_error() ) { conv_msg( i, xfield, "xfield" ); continue; }
205 if( x < xlo || x > xhi ) continue;
206 }
207
208 /* get y value.. */
209 if( yfield >= 0 ) {
210 y = fda( i, yfield, 'y' );
211 if( Econv_error() ) { conv_msg( i, yfield, "yfield" ); continue; }
212 if( y < ylo || y > yhi ) continue;
213 }
214
215 /* go to absolute units.. */
216 if( xfield < 0 ) x = xloc;
217 else x = Eax(x);
218 if( yfield < 0 ) y = yloc;
219 else y = Eay(y);
220
221
222 /* put (x,y) into PLV array so points can be sorted.. */
223 if( nrow >= PLVthirdsize ) {
224 fprintf( PLS.errfp, "point capacity exceeded, skipping data point (raise using -maxvector)\n" );
225 continue;
226 }
227 dat3d( nrow, 0 ) = x;
228 dat3d( nrow, 1 ) = y;
229 dat3d( nrow, 2 ) = (double)i; /* added scg 12/21/00 - went from dat2d to dat3d */
230 /* need to keep track of actual location in data array for labels, sizefield, etc.. */
231 nrow++;
232 }
233
234
235 /* if clustering and not using a label field, sort PLV array */
236 if( cluster && lblfield < 0 && sizefield < 0 ) {
237 if( PLS.debug ) fprintf( PLS.diagfp, "sorting points for scatterplot\n" );
238 qsort( PLV, nrow, sizeof(double)*3, ptcompare );
239 }
240
241
242
243 if( verttext ) Etextdir( 90 );
244
245 /* these are used in clustering.. */
246 oldx = NEGHUGE;
247 oldy = NEGHUGE;
248 dupcount = 0;
249 subdupcount = 0;
250 maxdups = 0;
251
252 strcpy( symcode, "sym6a" );
253 radius = 0.04;
254
255
256 /* in the following, text must come before symbol.. */
257 if( text[0] != '\0' || lblfield >= 0 ) textdet( "textdetails", textdetails, &align, &adjx, &adjy, -3, "R", 1.0 );
258
259 if( symbol != "" ) symdet( "symbol", symbol, symcode, &radius );
260
261 if( linelen > 0.0 || rectoutline ) linedet( "linedetails", linedetails, 0.5 );
262
263 cx = Ecurtextwidth * 0.3;
264 cy = Ecurtextheight * 0.3;
265 hlinelen = linelen * 0.5;
266 txhi = cy + cy;
267 if( text[0] != '\0' ) hw = strlen( text ) * Ecurtextwidth * 0.5;
268
269 /* now display points.. */
270 for( irow = 0; irow < nrow; irow++ ) {
271 x = dat3d( irow, 0 );
272 y = dat3d( irow, 1 );
273 realrow = (int)dat3d( irow, 2 ); /* added scg 12/21/00 */
274
275 /* in this loop, you MUST USE REALROW, NOT IROW for accessing ancillary data fields!! */
276
277 if( cluster ) {
278 if( GL_close_to( x, oldx, clusterdiff ) && GL_close_to( y, oldy, clusterdiff ) ) {
279 subdupcount++;
280 if( subdupcount >= clustevery ) {
281 dupcount++;
282 subdupcount = 0;
283 }
284
285 if( dupcount % 2 == 0 ) flop2 = 1;
286 else flop2 = -1;
287
288 if( clustermeth == '2' && dupcount > 37 ) {
289 maxdups = 37;
290 dupcount = 0; /* mod */
291 }
292
293 if( clustermeth == 'h' ) x += ((dupcount+1)/2) * clusterfact * 2.0 * flop2;
294 else if( clustermeth == 'v' ) y += ((dupcount+1)/2) * clusterfact * 2.0 * flop2;
295 else if( clustermeth == 'u' ) y += dupcount * clusterfact * 2.0; /* 1D upward */
296 else if( clustermeth == 'r' ) x += dupcount * clusterfact * 2.0; /* 1D rightward */
297 else if( clustermeth == 'l' ) ; /* legend lookup, no offset */
298 else if( clustermeth == '2' ) { x += ox[dupcount%38]; y += oy[dupcount%38]; } /* 2-D */
299
300 if( clustermeth == 'l' ) { /* if more duplicate points coming, skip.. */
301 if( irow < nrow-1 ) {
302 double nextx, nexty;
303 nextx = dat3d( irow+1, 0 );
304 nexty = dat3d( irow+1, 1 );
305 if( GL_close_to( x, nextx, clusterdiff ) &&
306 GL_close_to( y, nexty, clusterdiff ) ) continue;
307 }
308 }
309 }
310 else {
311 if( dupcount > maxdups ) maxdups = dupcount;
312 oldx = x;
313 oldy = y;
314 dupcount = 0;
315 subdupcount = 0;
316 }
317 }
318
319 /* allow @field substitutions into url */
320 if( PLS.clickmap && ( mapurl != "" || maplabel != "" )) {
321 expandedurl = &PL_bigbuf[0];
322 expandedlabel = &PL_bigbuf[2000];
323 do_subst( expandedurl, mapurl, realrow, URL_ENCODED );
324 do_subst( expandedlabel, maplabel, realrow, NORMAL );
325 }
326
327
328
329 /* render text, mark or line.. */
330 /* text can be combined with mark if text and symbol both specified */
331
332 /* symbol or rectangle.. */
333 if( symbol != "" || dorect || ( text[0] == '\0' && linelen <= 0.0 && lblfield < 0 ) ) {
334 if( symfield >= 0 ) { /* look it up in legend list.. */
335 if( symfield_userange ) symbol = PL_get_legent_rg( atof( da( realrow, symfield ) ) );
336 else symbol = PL_get_legent( da( realrow, symfield ));
337 if( symbol == "" ) Eerr( 7429, "warning: symfield: no matching legend entry tag found", da( realrow, symfield ) );
338 if( !dorect ) symdet( "symfield", symbol, symcode, &radius );
339 }
340 if( dupsleg ) { /* look it up in legend list.. */
341 symbol = PL_get_legent_rg( (double)dupcount+1 );
342 if( symbol == "" ) Eerr( 7692, "warning: dupsleg: no appropriate legend entry tag\n", da( realrow, symfield ) );
343 if( !dorect ) symdet( "symfield", symbol, symcode, &radius );
344 /* note: currently all marks will be rendered; the last one will be on "top" */
345 }
346 if( sizefield >= 0 )
347 radius = sqrt((atof( da( realrow, sizefield ) ) * sizescale)/3.1415927);
348 /* sizefield scales up the AREA of symbol, not the diameter */
349 if( dorect ) {
350 char *color;
351 color = ""; /* added scg 9/1/05 - heatmap bug */
352 if( symfield >=0 || dupsleg ) color = symbol; /* was: sscanf( symbol, "%s", color ); // strip off any trailing space */
353 Ecblock( x-rectw, y-recth, x+rectw, y+recth, color, rectoutline );
354 symbol = "";
355 }
356
357 else if( vennden > 0.0 ) { /* vennden (undocumented) repeats the symbol progressively bigger (bullseye pattern),
358 (early attempt at venn diagram.. not sure if good for anything) */
359 double urad;
360 for( urad = 0.01; urad < radius; urad += vennden ) Emark( x, y, symcode, urad );
361 }
362
363 else { /* standard scatterplot data point is done here.. */
364
365 if( altwhen[0] != '\0' ) { /* check for alternate */
366 stat = do_select( altwhen, realrow, &doing_alt );
367 if( stat != 0 ) { Eerr( stat, "Select error", altwhen ); continue; }
368 if( doing_alt == 1 ) symdet( "altsym", altsym, symcode, &radius );
369 }
370
371 Emark( x, y, symcode, radius );
372
373 if( doing_alt == 1 ) symdet( "symbol", symbol, symcode, &radius ); /* restore */
374 }
375
376 if( PLS.clickmap && (mapurl != "" || maplabel != "" )) {
377 if( dorect ) clickmap_entry( 'r', expandedurl, 0, x-rectw, y-recth, x+rectw, y+recth, 0, 0, expandedlabel );
378 else clickmap_entry( 'r', expandedurl, 0, x-radius, y-radius, x+radius, y+radius, 0, 0, expandedlabel );
379 }
380
381 }
382
383 /* text */
384 if( text[0] != '\0' ) {
385 if( symbol != "" ) /* set text color etc... */
386 textdet( "textdetails", textdetails, &align, &adjx, &adjy, -3, "R", 1.0 );
387 if( sizefield >= 0 ) Etextsize( (int) (atof( da( realrow, sizefield ) ) * sizescale) );
388 if( verttext ) { ptx = (x+cy)+adjx; pty = y; } /* cy puts midheight of character on point */
389 else { ptx = x+adjx; pty = (y-cy)+adjy; }
390
391 convertnl( text );
392 Emov( ptx, pty );
393 if( align == '?' ) Edotext( text, 'C' );
394 else Edotext( text, align );
395 if( symbol != "" ) /* restore symbol color etc... */
396 symdet( "symbol", symbol, symcode, &radius );
397
398 if( PLS.clickmap && ( mapurl != "" || maplabel != "" ))
399 clickmap_entry( 'r', expandedurl, 0, ptx-hw, pty, x+hw, y+txhi, 0, 0, expandedlabel );
400 }
401
402 /* label from data */
403 else if( lblfield >= 0 ) {
404 if( sizefield >= 0 ) Etextsize( (int) (atof( da( realrow, sizefield ) ) * sizescale) );
405 if( verttext) { ptx = (x+cy)+adjx; pty = y+adjy; } /* cy puts midheight of character on point */
406 else { ptx = x+adjx; pty = (y-cy)+adjy; }
407
408 strcpy( buf, labelword );
409 GL_varsub( buf, "@VAL", da( realrow, lblfield ) );
410
411 Emov( ptx, pty );
412 if( align == '?' ) Edotext( buf, 'C' );
413 else Edotext( buf, align );
414
415 if( PLS.clickmap && ( mapurl != "" || maplabel != "" )) {
416 hw = strlen( buf ) * Ecurtextwidth * 0.5;
417 if( GL_member( align, "C?" ))clickmap_entry( 'r', expandedurl, 0, ptx-hw, pty, x+hw, y+txhi, 0, 0, expandedlabel );
418 else if( align == 'L' ) clickmap_entry( 'r', expandedurl, 0, ptx, pty, x+(hw*2.0), y+txhi, 0, 0, expandedlabel );
419 else if( align == 'R' ) clickmap_entry( 'r', expandedurl, 0, ptx-(hw*2.0), pty, x, y+txhi, 0, 0, expandedlabel );
420 }
421 }
422
423 /* line */ /* (no clickmap support) */ /* no legend support either (?) */
424 else if( linelen > 0.0 ) {
425 if( sizefield >= 0 ) hlinelen = linelen * 0.5 * atof( da( realrow, sizefield ) );
426 /* sizefield acts as a scale factor to linelen */
427
428 if( reqlinedir != '\0' ) linedir = reqlinedir;
429 else if( xfield >= 0 && yfield >= 0 ) linedir = 'h'; /* arbitrary .. scg 5/16/03 */
430 else if( xfield >= 0 ) linedir = 'v';
431 else linedir = 'h'; /* scg 3/5/03 */
432
433 if( linedir == 'v' ) { Emov( x, y-hlinelen ); Elin( x, y+hlinelen ); }
434 else if( linedir == 'u' ) { Emov( x, y ); Elin( x, y+(hlinelen*2.0) ); }
435 else if( linedir == 'r' ) { Emov( x, y ); Elin( x+(hlinelen*2.0), y ); }
436 else { Emov( x-hlinelen, y ); Elin( x+hlinelen, y ); }
437 }
438
439 }
440 if( verttext ) Etextdir( 0 );
441
442 if( legendlabel[0] != '\0' ) {
443 char s[40];
444 sprintf( s, "%d", nrow );
445 GL_varsub( legendlabel, "@NVALUES", s );
446 if( linelen <= 0.0 && lblfield < 0 && text[0] == '\0' )
447 PL_add_legent( LEGEND_SYMBOL, legendlabel, "", symbol, "", "" );
448 else if( symbol != "" && text[0] != '\0' )
449 PL_add_legent( LEGEND_SYMBOL+LEGEND_TEXT, legendlabel, "", text, textdetails, symbol );
450 else if( linelen > 0.0 ) {
451 char dirstr[8];
452 sprintf( dirstr, "%c", linedir );
453 PL_add_legent( LEGEND_LINEMARK, legendlabel, "", linedetails, dirstr, "" );
454 }
455 }
456
457 setintvar( "NVALUES", nrow );
458 maxdups++;
459 setintvar( "MAXDUPS", maxdups );
460
461 return( 0 );
462 }
463 /* ======================= */
464
465 static int
466 ptcompare( a, b )
467 const void *a, *b;
468
469 /* static int ptcompare( f, g )
470 * double *f, *g;
471 */ /* changed to eliminate gcc warnings scg 5/18/06 */
472
473 {
474 double *f, *g;
475 double *f2, *g2;
476
477 f = (double *)a;
478 g = (double *)b;
479
480 if( *f > *g ) return( 1 );
481 else if( *f < *g ) return( -1 );
482 else {
483 /* advance to Y component */
484 f2 = f+1;
485 g2 = g+1;
486 if( *f2 > *g2 ) return( 1 );
487 else if( *f2 < *g2 ) return( -1 );
488 else return( 0 ); /* same */
489 }
490 }
491
492 /* ======================================================= *
493 * Copyright 1998-2008 Stephen C. Grubb *
494 * http://ploticus.sourceforge.net *
495 * Covered by GPL; see the file ./Copyright for details. *
496 * ======================================================= */
497