aboutsummaryrefslogtreecommitdiff
path: root/noao/digiphot/apphot/fitsky/aphistplot.x
blob: 49c000716d6fb96739574104fe8a1da33b7e36cf (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
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
include <gset.h>
include <pkg/gtools.h>
include "../lib/fitsky.h"

# AP_HISTPLOT -- Procedure to the sky value using a plot of the sky histogram
# and cursor readback.

int procedure ap_histplot (gd, gt, skypix, wgt, index, nskypix, k1, hwidth,
	binsize, smooth, sky_mode, sky_sigma, sky_skew, nsky, nsky_reject)

pointer	gd			# pointer to graphics stream
pointer	gt			# pointer to GTOOLS structure
real	skypix[ARB]		# array of unsorted sky pixels
real	wgt[ARB]		# array of weights for rejection
int	index[ARB]		# array of sort indices
int	nskypix			# number of sky pixels
real	k1			# rejection criterion
real	hwidth			# half width of histogram in k1 units
real	binsize			# histogram binsize in units of sigma
int	smooth			# smooth the histogram
real	sky_mode		# sky value
real	sky_sigma		# sigma of sky pixels
real	sky_skew		# skew of sky pixels
int	nsky			# number of sky pixels
int	nsky_reject		# number of rejected sky pixels

double	dsky, sumpx, sumsqpx, sumcbpx
int	i, nbins, nker, wcs, key
pointer	sp, x, hgm, shgm, cmd
real	dmin, dmax, hmin, hmax, dh, ymin, ymax, symin, symax, wx, wy
real	u1, u2, v1, v2, x1, x2, y1, y2, cut, sky_mean, sky_zero
int	clgcur(), aphigmr()
real	apmedr(), ap_asumr()

begin
	# Check for valid graphics stream.
	if (gd == NULL)
	    return (AP_NOGRAPHICS)

	# Initialize.
	nsky = nskypix
	nsky_reject = 0
	sky_mode = INDEFR
	sky_sigma = INDEFR
	sky_skew = INDEFR
	if (nskypix <= 0)
	    return (AP_SKY_OUTOFBOUNDS)

	# Compute an initial guess at the sky distribution.
	sky_zero = ap_asumr (skypix, index, nskypix) / nskypix
	call ap_ialimr (skypix, index, nskypix, dmin, dmax)
	call apfimoments (skypix, index, nskypix, sky_zero, sumpx, sumsqpx,
	    sumcbpx, sky_mean, sky_sigma, sky_skew)
	sky_mode = apmedr (skypix, index, nskypix)
	sky_mode = max (dmin, min (sky_mode, dmax))

	# Compute histogram width and binsize.
	if (! IS_INDEFR(hwidth) && hwidth > 0.0) {
	    hmin = sky_mode - k1 * hwidth
	    hmax = sky_mode + k1 * hwidth
	    dh = binsize * hwidth
	} else {
	    cut = min (sky_mode - dmin, dmax - sky_mode, k1 * sky_sigma)
	    hmin = sky_mode - cut
	    hmax = sky_mode + cut
	    dh = binsize * cut / k1
	}

	# Compute the number of histgram bins and the histogram resolution.
	if (dh <= 0.0) {
	    nbins = 1
	    dh = 0.0
	} else {
	    nbins = 2 * nint ((hmax - sky_mode) / dh) + 1
	    dh = (hmax - hmin) / (nbins - 1)
	}

	# Test for a valid histogram.
	if (dh <= 0.0 || k1 <= 0.0 || sky_sigma <= 0.0 || sky_sigma <= dh ||
	    nbins < 2) {
	    sky_mode = sky_mode
	    sky_sigma = 0.0
	    sky_skew = 0.0
	    return (AP_NOHISTOGRAM)
	}

	# Allocate temporary space.
	call smark (sp)
	call salloc (x, nbins, TY_REAL)
	call salloc (hgm, nbins, TY_REAL)
	call salloc (shgm, nbins, TY_REAL)
	call salloc (cmd, SZ_LINE, TY_CHAR)

	# Compute the x array and accumulate the histogram.
	do i = 1, nbins
	    Memr[x+i-1] = i
	call amapr (Memr[x], Memr[x], nbins, 1.0, real (nbins),
	    hmin + 0.5 * dh, hmax + 0.5 * dh) 
	call aclrr (Memr[hgm], nbins)
	nsky_reject = nsky_reject + aphigmr (skypix, wgt, index, nskypix,
	    Memr[hgm], nbins, hmin, hmax)
	nsky = nskypix - nsky_reject

	# Subtract rejected pixels and recompute the moments.
	if (nsky_reject > 0) {
	    do i = 1, nskypix {
	        if (wgt[index[i]] <= 0.0) {
		    dsky = skypix[index[i]] - sky_zero
		    sumpx = sumpx - dsky
		    sumsqpx = sumsqpx - dsky ** 2
		    sumcbpx = sumcbpx - dsky ** 3
	        }
	    }
	}
	call apmoments (sumpx, sumsqpx, sumcbpx, nsky, sky_zero, sky_mean,
	    sky_sigma, sky_skew)

	# Smooth the histogram and compute the histogram plot limits.
	if (smooth == YES) {
	    nker = max (1, nint (sky_sigma / dh))
	    #call ap_lucy_smooth (Memr[hgm], Memr[shgm], nbins, nker, 2)
	    call ap_bsmooth (Memr[hgm], Memr[shgm], nbins, nker, 2)
	    call alimr (Memr[hgm], nbins, ymin, ymax)
	    call alimr (Memr[shgm], nbins, symin, symax)
	    ymin = min (ymin, symin)
	    ymax = max (ymax, symax)
	} else
	    call alimr (Memr[hgm], nbins, ymin, ymax)

	# Store the old viewport and window coordinates.
	call greactivate (gd, 0)
	call ggview (gd, u1, u2, v1, v2)
	call ggwind (gd, x1, x2, y1, y2)

	# Plot the raw and smoothed histograms.
	call ap_set_hplot (gd, gt, hmin, hmax, ymin, ymax, nbins, smooth)
	if (smooth == YES) {
	    call ap_plothist (gd, gt, Memr[x], Memr[hgm], nbins, "histogram",
	        GL_SOLID)
	    call ap_plothist (gd, gt, Memr[x], Memr[shgm], nbins, "line",
	        GL_SOLID)
	} else
	    call ap_plothist (gd, gt, Memr[x], Memr[hgm], nbins, "histogram",
	        GL_SOLID)

	# Mark the peak of the histogram with the cursor.
	call printf (
	    "Mark histogram peak (%g) [space=mark,q=quit,:.help=help:]")
	    call pargr (sky_mode)
	call gscur (gd, sky_mode, (ymin + ymax) / 2.0)
	while (clgcur ("gcommands", wx, wy, wcs, key, Memc[cmd], SZ_LINE) !=
	    EOF) {
		if (key == 'q')
		    break
		else
		    sky_mode = max (hmin, min (wx, hmax))
	    call printf (
	        "Mark histogram peak (%g) [space=mark,q=quit,:.help=help:]")
	        call pargr (sky_mode)
	}

	# Store the old viewport and window coordinates.
	call gsview (gd, u1, u2, v1, v2)
	call gswind (gd, x1, x2, y1, y2)

	# Close up.
	call gflush (gd)
	call gdeactivate (gd, 0)
	call sfree (sp)
	return (AP_OK)
end


# AP_PLOTHIST -- Procedure plot the histogram.

procedure ap_plothist (gd, gt, x, hgm, nbins, plottype, polytype) 

pointer	gd		# pointer to graphics stream
pointer	gt		# GTOOLS pointer
real	x[ARB]		# the histogram bin values
real	hgm[ARB]	# histogram
int	nbins		# number of bins
char	plottype[ARB]	# the plot type "histogram" or "line"
int	polytype	# polyline type

begin
	call gt_sets (gt, GTTYPE, plottype)
	call gt_seti (gt, GTLINE, polytype)
	call gt_plot (gd, gt, x, hgm, nbins)
	call gflush (gd)
end


# AP_SET_HPLOT -- Procedure to set up the histogram plot.

procedure ap_set_hplot (gd, gt, xmin, xmax, ymin, ymax, nbins, smooth)

pointer	gd		# pointer to GRAPHICS stream
pointer	gt		# pointer to GTOOLS structure
real	xmin, xmax	# min and max of x vector
real	ymin, ymax	# min and max of y vector
int	nbins		# number of bins
int	smooth		# smooth histogram

pointer	sp, str

begin
	# Initialize
	call gclear (gd)
	call smark (sp)
	call salloc (str, SZ_LINE, TY_CHAR)

	# Set up the gtools parameter string.
	call sprintf (Memc[str], SZ_LINE,
	    "Sky Histogram: nbins = %d hmin = %g hmax = %g smooth=%b")
	    call pargi (nbins)
	    call pargr (xmin)
	    call pargr (xmax)
	    call pargi (smooth)
	call gt_sets (gt, GTPARAMS, Memc[str])

	# Set up the plot axes.
	call gt_sets (gt, GTXLABEL, "Sky Values")
	call gt_sets (gt, GTYLABEL, "Number of Pixels")
	call gt_setr (gt, GTXMIN, xmin)
	call gt_setr (gt, GTXMAX, xmax)
	call gt_setr (gt, GTYMIN, ymin)
	call gt_setr (gt, GTYMAX, ymax)
	call gt_swind (gd, gt)
	call gt_labax (gd, gt)

	call sfree (sp)
end