aboutsummaryrefslogtreecommitdiff
path: root/pkg/obsolete/t_mkhgm.x
blob: 6bc906dcee5f7656e74032e050e1ff9003bc6660 (plain) (blame)
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
include	<mach.h>
include	<gset.h>

define	SZ_HISTBUF	512

# HISTOGRAM -- Compute and plot the histogram of an file.

procedure t_mkhistogram()

bool	listout
int	fd, ndata, nbins
pointer sp, file, device, data, hgm, hgmr, gp
real	z1, z2, zmin, zmax, dz, zval

bool	clgetb(), fp_equalr()
int	i, clgeti(), open(), get_histdata()
real	clgetr()
pointer	gopen()

begin
	call smark (sp)
	call salloc (file,   SZ_LINE,  TY_CHAR)
	call salloc (device,  SZ_FNAME, TY_CHAR)

	# Get the file name.
	call clgstr ("file", Memc[file], SZ_LINE)
	fd = open (Memc[file], READ_ONLY, TEXT_FILE)

	# Output can be either a list or a plot.
	listout = clgetb ("listout")
	if (! listout)
	    call clgstr ("device", Memc[device], SZ_FNAME)


	# Get histogram length and allocate buffer.
	nbins = clgeti ("nbins")
	if (nbins < 2) {
	    call eprintf ("Warning: Less than 2 bins in histogram.\n")
	    call sfree (sp)
	    return
	}
	call salloc (hgm,  nbins, TY_INT)
	call salloc (hgmr, nbins, TY_REAL)

	# Fetch the data.
	call malloc (data, SZ_HISTBUF, TY_REAL)
	ndata = get_histdata (fd, data, SZ_HISTBUF)
	if (ndata <= 0) {
	    call eprintf ("Warning: No input data for histogram.\n")
	    call mfree (data, TY_REAL)
	    call sfree (sp)
	    return
	}

	z1 = clgetr ("z1")
	z2 = clgetr ("z2")
	if (IS_INDEFR(z1) || IS_INDEFR(z2)) {
	    call alimr (Memr[data], ndata, zmin, zmax)
	    if (IS_INDEFR(z1))
		z1 = zmin
	    if (IS_INDEFR(z2))
		z2 = zmax
	}
	dz = (z2 - z1) / (nbins - 1)

	# Test for constant valued file, which causes zero divide in ahgm.
	if (fp_equalr (z1, z2)) {
	    call eprintf (
		"Warning: Constant valued file `%s' has no data range.\n")
		call pargstr (Memc[file])
	    call mfree (data, TY_REAL)
	    call sfree (sp)
	    return
	}

	# Initialize histogram and file line vector.
	call aclri (Memi[hgm], nbins)

	# Accumulate the histogram.
	call ahgmr (Memr[data], ndata, Memi[hgm], nbins,  z1,  z2)

	# List or plot the histogram.
	if (listout) {
	    zval = z1
	    do i = 1, nbins {
		call printf ("%4d  %g  %d\n")
		    call pargi (i)
		    call pargr (zval + dz / 2.)
		    call pargi (Memi[hgm+i-1])
		zval = zval + dz
	    }
	} else {
	    gp = gopen (Memc[device], NEW_FILE, STDGRAPH)
	    #call gseti (gp, G_YTRAN, GW_LOG)
	    call achtir (Memi[hgm], Memr[hgmr], nbins)
	    call gploto (gp, Memr[hgmr], nbins, z1 + dz / 2., z2 + dz / 2.,
	        Memc[file])
	    call gclose (gp)
	}

	# Shutdown.
	call close (fd)
	call sfree (sp)
end


# GET_HISTDATA -- Procedure to get data for the histogram

int procedure get_histdata (fd, data, buf_incr)

int	fd		# file descriptor of histogram data
pointer	data		# pointer to the data array
int	buf_incr	# increment for data buffer size

int	szbuf, ndata
int	fscan(), nscan()

begin
	szbuf = buf_incr
	ndata = 0
	while (fscan (fd) != EOF) {
	    call gargr (Memr[data+ndata])
	    if (nscan() != 1)
		next
	    ndata = ndata + 1
	    if (ndata == szbuf) {
		szbuf = szbuf + buf_incr
		call realloc (data, szbuf, TY_REAL)
	    }
	}

	# Fit the buffer size to the data.
	if (ndata > 0)
	    call realloc (data, ndata, TY_REAL)

	return (ndata)
end