File: myplot.c

package info (click to toggle)
xlispstat 3.52.14-1
  • links: PTS
  • area: main
  • in suites: potato
  • size: 7,560 kB
  • ctags: 12,676
  • sloc: ansic: 91,357; lisp: 21,759; sh: 1,525; makefile: 521; csh: 1
file content (142 lines) | stat: -rw-r--r-- 3,422 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
/* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney                  */
/* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz    */
/* You may give out copies of this software; for conditions see the    */
/* file COPYING included with this distribution.                       */

#include "xlisp.h"
#include "xlstat.h"
#include "gnuplot.h"

extern LVAL coerce_to_list();
#ifndef ANSI
extern char *calloc();
#endif

static double NiceValue(x)
	double x;
{
  long ilx;
  double lx, v1, v2, v3, v4;
	
  if (x <= 0) return (0.0);
  else {
    lx = log(x) / log(10.0);
    ilx = floor(lx);
    v1 = pow(10.0, (float) ilx);
    v2 = pow(10.0, (float) ilx) * 2.0;
    v3 = pow(10.0, (float) ilx) * 5.0;
    v4 = pow(10.0, (float) ilx + 1);

    if ((fabs(x - v1) < fabs(x - v2))
	&& (fabs(x - v1) < fabs(x - v3))
	&& (fabs(x - v1) < fabs(x - v4)))
      return(v1);
    else if ((fabs(x - v2) < fabs(x - v3))
	     && (fabs(x - v2) < fabs(x - v4)))
      return(v2);
    else if (fabs(x - v3) < fabs(x - v4))
      return(v3);
    else
      return(v4);
	}
}

static SetNiceRange(xmin, xmax, ticks)
     double *xmin, *xmax;
     int *ticks;
{
  double delta;
	
  if ((*xmax <= *xmin) || (*ticks < 2)) return;
	
  delta = NiceValue((*xmax - *xmin) / (*ticks - 1));
	
  *xmin = floor(*xmin / delta) * delta;
  *xmax = ceil(*xmax / delta) * delta;
	
  *ticks = 1 + (.01 + (*xmax - *xmin) / delta);/* add .01 for rounding */
}

static set_range(low, high)
     double *low, *high;
{
  int ticks = 4;

  if (*low == *high) {
    (*low)--;
    (*high)++;
  }
  else SetNiceRange(low, high, &ticks);
}

static LVAL gnupointlineplot(plot_style)
     enum PLOT_STYLE plot_style;
{
  LVAL next, nextx, nexty;
  int n, i;
  struct curve_points *this_plot, real_plot;
  struct coordinate *pts;
  double xmin, xmax, ymin, ymax, dx, dy;
  LVAL x, y;
  
  xlstkcheck(2);
  xlsave(x);
  xlsave(y);

  x = xlgetarg();
  if (consp(x) && seqp(car(x))) {
    y = car(cdr(x));
    x = car(x);
  }
  else y = xlgetarg();
  x = coerce_to_list(x);
  y = coerce_to_list(y);

  n = llength(x);
  if (llength(y) != n) xlfail("lengths do not match");
  for (next = x; consp(next); next = cdr(next))
    if (! realp(car(next))) xlerror("not a real number", car(next));
  for (next = y; consp(next); next = cdr(next))
    if (! realp(car(next))) xlerror("not a real number", car(next));

  pts = (struct coordinate *) calloc(sizeof(struct coordinate), n);
  if (! pts) xlfail("allocation failed");

  this_plot = &real_plot;
  this_plot->points = (struct coordinate *) pts;
  this_plot->next_cp = 0;
  this_plot->plot_type = DATA;
  this_plot->plot_style = plot_style;
  this_plot->title = "";
  this_plot->p_count = n;

  xmin = HUGE;
  xmax = -HUGE;
  ymin = HUGE;
  ymax = -HUGE;
  for(i = 0, nextx = x, nexty = y; i < n;
      i++, nextx = cdr(nextx), nexty = cdr(nexty)) {
    dx = makefloat(car(nextx));
    dy = makefloat(car(nexty));
    this_plot->points[i].undefined = FALSE;
    this_plot->points[i].x = dx;
    this_plot->points[i].y = dy;
    if (dx > xmax) xmax = dx;
    if (dx < xmin) xmin = dx;
    if (dy > ymax) ymax = dy;
    if (dy < ymin) ymin = dy;
  }

  set_range(&xmin, &xmax);
  set_range(&ymin, &ymax);

  do_plot(this_plot, 1, xmin, xmax, ymin, ymax);

  free(pts);
  xlpopn(2);

  return(NIL);
}

LVAL gnupointplot() { return(gnupointlineplot(POINTS)); }
LVAL gnulineplot() { return(gnupointlineplot(LINES)); }