diff options
Diffstat (limited to 'noao/onedspec/identify')
42 files changed, 9711 insertions, 0 deletions
diff --git a/noao/onedspec/identify/autoid/aidautoid.x b/noao/onedspec/identify/autoid/aidautoid.x new file mode 100644 index 00000000..7c213b4a --- /dev/null +++ b/noao/onedspec/identify/autoid/aidautoid.x @@ -0,0 +1,314 @@ +include <mach.h> +include <gset.h> +include <math/iminterp.h> +include <smw.h> +include "../identify.h" +include "autoid.h" + + +# List of debug key letters. +# Debug a: Print candidate line assignments. +# Debug b: Print search limits. +# Debug c: Print list of line ratios. +# Debug d: Graph dispersions. +# Debug f: Print final result. +# Debug i: Show ICFIT iterations. +# Debug l: Graph lines and spectra. +# Debug m: Print miscellaneous debug information +# Debug n: Show non-linearity constraint +# Debug r: Print list of reference lines. +# Debug s: Print search iterations. +# Debug t: Print list of target lines. +# Debug v: Print vote array. +# Debug w: Print wavelength bin limits. + + +# AID_AUTOID -- Automatically identify spectral features. +# This routine is main entry to the autoidentify algorithms. +# The return value is true if the ID pointer contains a new solution +# and false if the ID pointer is the original solution. + +bool procedure aid_autoid (id, aid) + +pointer id #I ID pointer +pointer aid #U AID pointer + +bool cdflip +int i, j, k, l, iev, nbins, bin, nbest +double best, dval1, dval2 +pointer sp, str, idr, ev, evf, sid + +bool streq(), strne() +int stridxs() +double dcveval(), aid_eval() +pointer gopen(), aid_evalloc(), id_getid() +errchk id_mapll, aid_reference, aid_target, aid_autoid1, aid_evalutate + +define done_ 10 +define redo_ 20 + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Save original data. + call id_saveid (id, "autoidentify backup") + + # Initialize. + AID_IDT(aid) = id + call ic_putr (AID_IC1(aid), "xmin", real (PIXDATA(id,1))) + call ic_putr (AID_IC1(aid), "xmax", real (PIXDATA(id,ID_NPTS(id)))) + AID_IC2(aid) = ID_IC(id) + + if (stridxs ("ild", AID_DEBUG(aid,1)) != 0 && ID_GP(id) == NULL) { + call clgstr ("graphics", Memc[str], SZ_LINE) + ID_GP(id) = gopen (Memc[str], NEW_FILE+AW_DEFER, STDGRAPH) + } else if (AID_DEBUG(aid,1) != EOS && ID_GP(id) != NULL) + call gdeactivate (ID_GP(id), 0) + + idr = AID_IDR(aid) + if (idr == NULL) { + call id_init (AID_IDR(aid)) + idr = AID_IDR(aid) + } + + # Set reference coordinate list. + if (strne (AID_REFLIST(aid), ID_COORDLIST(idr)) || + streq (AID_REFLIST(aid), "FEATURES")) { + call id_unmapll (idr) + ID_COORDLIST(idr) = EOS + + if (streq (AID_REFLIST(aid), "FEATURES")) { + if (ID_NFEATURES(id) >= 10) { + call strcpy (AID_REFLIST(aid), ID_COORDLIST(idr), + ID_LENSTRING) + i = ID_NFEATURES(id) + ID_NLL(idr) = i + call calloc (ID_LL(idr), i+1, TY_DOUBLE) + call calloc (ID_LLL(idr), i+1, TY_POINTER) + call amovd (USER(id,1), Memd[ID_LL(idr)], i) + Memd[ID_LL(idr)+i] = INDEFD + } + } else if (AID_REFLIST(aid) != EOS) { + call strcpy (AID_REFLIST(aid), ID_COORDLIST(idr), ID_LENSTRING) + call id_mapll (idr) + } + } + + # Get reference spectrum. + if (AID_REFSPEC(aid) != EOS) + call strcpy (AID_REFSPEC(aid), ID_COORDSPEC(idr), ID_LENSTRING) + else if (ID_COORDSPEC(idr) == EOS) + call strcpy (ID_COORDSPEC(id), ID_COORDSPEC(idr), ID_LENSTRING) + if (strne (ID_COORDSPEC(idr), ID_IMAGE(idr))) { + if (ID_SH(idr) != NULL) { + call smw_close (MW(ID_SH(idr))) + call imunmap (IM(ID_SH(idr))) + call shdr_close (ID_SH(idr)) + } + call strcpy (ID_COORDSPEC(idr), ID_IMAGE(idr), ID_LENSTRING) + ifnoerr (call id_map (idr)) + call id_gdata(idr) + else { + ID_COORDSPEC(idr) = EOS + ID_IMAGE(idr) = EOS + } + } + + ID_MAXFEATURES(idr) = AID_NRMAX(aid) + ID_MINSEP(idr) = ID_MINSEP(id) + ID_FTYPE(idr) = ID_FTYPE(id) + ID_FWIDTH(idr) = ID_FWIDTH(id) + ID_CRADIUS(idr) = ID_CRADIUS(id) + ID_THRESHOLD(idr) = ID_THRESHOLD(id) + ID_MATCH(idr) = ID_MATCH(id) + + # Use faster, less accurate centering for the search. + call c1d_params (II_LINEAR, 0.02) + + # Set target lines and dispersion limits. + call aid_target (aid) + cdflip = (AID_CDDIR(aid) == CDUNKNOWN || + (IS_INDEFD(AID_CDELT(aid)) && AID_CDDIR(aid) == CDSIGN)) + + # Now search for the dispersion function and line identifications. + # The reference spectrum is broken up into a varying number of + # pieces and each is searched. The order in which the reference + # spectrum is divided is from the middle outward and overlapping + # bins are tried as a second pass. The hope is to find a + # piece that is close enough to the target spectrum as quickly + # as possible. + + AID_BEST(aid) = MAX_REAL + nbest = 0 + iev = 0 +redo_ + do i = 0, 1 { + do j = 1, AID_NB(aid) { + if (j == 1) + nbins = (AID_NB(aid) + 2) / 2 + else if (mod (j, 2) == 0) + nbins = (AID_NB(aid) + 2 - j) / 2 + else + nbins = (AID_NB(aid) + 1 + j) / 2 + nbins = 2 * nbins - 1 + do k = 1, nbins { + if (k == 1) + bin = (nbins + 2) / 2 + else if (mod (k, 2) == 0) + bin = (nbins + 2 - k) / 2 + else + bin = (nbins + 1 + k) / 2 + if (mod ((nbins-1)/2, 2) == 0) { + if (mod (bin, 2) == i) + next + } else { + if (mod (bin, 2) != i) + next + } + + iferr { + iev = iev + 1 + ev = aid_evalloc (aid, iev) + AID_BIN1(ev) = nbins + AID_BIN2(ev) = bin + call aid_reference (aid, ev, NO) + call aid_autoid1 (aid, ev) + } then { + AID_ND(ev) = 0 + } + if (cdflip) { + iferr { + iev = iev + 1 + evf = aid_evalloc (aid, iev) + AID_BIN1(evf) = nbins + AID_BIN2(evf) = bin + call aid_reference (aid, evf, YES) + call aid_autoid1 (aid, evf) + } then { + AID_ND(evf) = 0 + } + } + + # Search the candidates with the highest weights. + # Terminate the search if the number of best fit values + # less than 1. is equal to the specified number. + do l = 1, 5 { + best = aid_eval (aid, ev, l) + if (!IS_INDEFD(best) && best < 1.) { + nbest = nbest + 1 + if (nbest >= AID_NBEST(aid)) + goto done_ + } + if (cdflip) { + best = aid_eval (aid, evf, l) + if (!IS_INDEFD(best) && best < 1.) { + nbest = nbest + 1 + if (nbest >= AID_NBEST(aid)) + goto done_ + } + } + } + } + } + } + + # Go back and evaluate candidates with lower weights. + # Terminate the search if the number of best fit values + # less than 1. is equal to the specified number. + do j = 6, AID_ND(ev) { + do i = 1, iev { + ev = aid_evalloc (aid, i) + best = aid_eval (aid, ev, j) + if (!IS_INDEFD(best) && best < 1.) { + nbest = nbest + 1 + if (nbest >= AID_NBEST(aid)) + goto done_ + } + } + } + + # Add other loops here. + if (AID_BEST(aid) > 1.) { + if (AID_NP(aid) > 3) { + AID_NP(aid) = AID_NP(aid) - 1 + goto redo_ + } + } + +done_ + do i = 1, iev + call aid_evfree (aid, i) + + # Evaluate the final solution with the full dispersion function. + # Save the final solution. If the final solution has a merit + # greater than one restore the original solution. + + sid = id_getid (id, "autoidentify") + if (sid != NULL) { + call dcvfree (ID_CV(id)) + iferr (call aid_dofitf (aid, id)) + ; + call id_sid (id, sid) + } else { + ID_NFEATURES(id) = 0 + call dcvfree (ID_CV(id)) + call id_saveid (id, "autoidentify") + } + + # Debug f: Print final result. + if (stridxs ("f", AID_DEBUG(aid,1)) != 0) { + if (AID_BEST(aid) == MAX_REAL) { + call eprintf ("%s %8.5g %8.3g No solution found\n") + call pargstr (ID_IMAGE(id)) + call pargd (AID_CRVAL(aid)) + call pargd (AID_CDELT(aid)) + } else { + call eprintf ( + "%s %8.5g %8.3g %8.5g %8.3g %3d %3d %6.3f %5.2f\n") + call pargstr (ID_IMAGE(id)) + call pargd (AID_CRVAL(aid)) + call pargd (AID_CDELT(aid)) + if (ID_CV(id) == NULL) { + dval1 = FITDATA(id,1) + dval2 = FITDATA(id,2) - FITDATA(id,1) + } else { + dval1 = dcveval (ID_CV(id), AID_CRPIX(aid)+1D0) + dval2 = dcveval (ID_CV(id), AID_CRPIX(aid)-1D0) + dval2 = (dval1 - dval2) / 2D0 + dval1 = dcveval (ID_CV(id), AID_CRPIX(aid)) + } + call pargd (dval1) + call pargd (FITDATA(id,2) - FITDATA(id,1)) + call pargi (nint(100.*AID_FMATCH(aid))) + call pargi (nint(100.*AID_FTMATCH(aid))) + call pargr (AID_RMS(aid)) + call pargr (AID_BEST(aid)) + call eprintf ( + " dCRVAL = %.4g (%.3g), dCDELT = %.4g (%.3g)\n") + call pargd (dval1 - AID_CRVAL(aid)) + call pargd (abs((dval1-AID_CRVAL(aid))/ + (ID_NPTS(id)*AID_CDELT(aid)))) + call pargd (dval2 - AID_CDELT(aid)) + call pargd (abs((dval2-AID_CDELT(aid))/AID_CDELT(aid))) + } + } + + if (AID_BEST(aid) > 1.) { + ID_NFEATURES(id) = 0 + ID_CURRENT(id) = 0 + call dcvfree (ID_CV(id)) + sid = id_getid (id, "autoidentify backup") + ID_NEWFEATURES(id) = NO + ID_NEWCV(id) = NO + ID_NEWGRAPH(id) = NO + } + call id_fitdata (id) + + # Restore centering. + call c1d_params (II_SPLINE3, 0.001) + + call sfree (sp) + + return (AID_BEST(aid) <= 1.) +end diff --git a/noao/onedspec/identify/autoid/aidget.x b/noao/onedspec/identify/autoid/aidget.x new file mode 100644 index 00000000..ba3c9342 --- /dev/null +++ b/noao/onedspec/identify/autoid/aidget.x @@ -0,0 +1,21 @@ +include "autoid.h" + +define AIDGET "|best|" + + +# AID_GETR -- Get AID parameters by name. + +real procedure aid_getr (aid, param) + +pointer aid #I AID object +char param[ARB] #I Parameter name + +char temp[10] +int strdic() + +begin + switch (strdic (param, temp, 10, AIDGET)) { + case 1: + return (AID_BEST(aid)) + } +end diff --git a/noao/onedspec/identify/autoid/aidgraph.x b/noao/onedspec/identify/autoid/aidgraph.x new file mode 100644 index 00000000..35494004 --- /dev/null +++ b/noao/onedspec/identify/autoid/aidgraph.x @@ -0,0 +1,240 @@ +include <mach.h> +include <gset.h> +include <pkg/gtools.h> +include <smw.h> +include "../identify.h" +include "autoid.h" + + +# AID_LGRAPH -- Graph target and reference spectra and associated lines. +# This is only used for debugging. + +procedure aid_lgraph (aid, x1, n1, x2, n2) + +pointer aid #I AID pointer +double x1[n1] #I Reference lines +int n1 #I Number of reference lines +double x2[n2] #I Target lines +int n2 #I Number of target lines + +int i, wcs, key, nr, nt, redraw, clgcur(), stridxs() +real wx, wy, wz, a, b, c, d, dy, ytmin, ytmax +pointer sp, cmd, id, sht, shr, gp, gt, xr, yr, yt, y, gt_init() +double shdr_lw() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + id = AID_IDT(aid) + sht = ID_SH(id) + shr = ID_SH(AID_IDR(aid)) + + gp = ID_GP(id) + if (gp == NULL) + return + gt = gt_init() + call gt_sets (gt, GTTYPE, "line") + call gt_seti (gt, GTSYSID, NO) + if (DC(sht) == DCNO || WP(sht) * AID_CDSIGN(aid) < 0.) { + call gt_setr (gt, GTXMIN, AID_W1(aid)) + call gt_setr (gt, GTXMAX, AID_W2(aid)) + } else { + call gt_setr (gt, GTXMIN, W0(sht)) + call gt_setr (gt, GTXMAX, W1(sht)) + } + + if (shr != NULL) { + xr = SX(shr) + AID_X1R(aid) - 1 + yr = AID_SPECR(aid) + nr = AID_X2R(aid) - AID_X1R(aid) + 1 + } + + nt = ID_NPTS(id) + yt = ID_IMDATA(id) + call alimr (Memr[yt], nt, ytmin, ytmax) + + call malloc (y, max(nr,nt), TY_REAL) + + key = 'r' + repeat { + switch (key) { + case ':': + call gt_colon (Memc[cmd], gp, gt, redraw) + case 'Q': + i = stridxs ("l", AID_DEBUG(aid,1)) + AID_DEBUG(aid,i) = ' ' + break + case 'q': + break + case 'r': + redraw = YES + case 'w': + call gt_window (gt, gp, "gcur", redraw) + } + + if (redraw == YES) { + call gclear (gp) + call gseti (gp, G_YDRAWTICKS, NO) + if (shr != NULL) { + call gascale (gp, Memr[xr], nr, 1) + call gascale (gp, Memr[yr], nr, 2) + } else { + call gswind (gp, real(x1[1]), real(x1[n1]), 0., 1.) + } + call gt_swind (gp, gt) + call ggwind (gp, a, b, c, d) + dy = 2 * (d - c) + call gswind (gp, a, b, c, c + dy) + call gt_labax(gp, gt) + + if (shr != NULL) { + call aminkr (Memr[yr], c + 0.44 * dy, Memr[y], nr) + call gt_plot (gp, gt, Memr[xr], Memr[y], nr) + } + + wy = c + 0.46 * dy + wz = c + 0.49 * dy + do i = 1, n1 { + wx = x1[i] + if (wx < min (a,b) || wx > max (a,b)) + next + call gline (gp, wx, wy, wx, wz) + } + + call amapr (Memr[yt], Memr[y], nt, + ytmin, ytmax, c+0.55*dy, c+0.99*dy) + wy = c + 0.50 * dy + wz = c + 0.53 * dy + + if (DC(sht) == DCNO || WP(sht) * AID_CDSIGN(aid) < 0.) { + call gvline (gp, Memr[y], nt, a, b) + do i = 1, n2 { + wx = a + (x2[i] - 1) / (nt - 1) * (b - a) + call gline (gp, wx, wy, wx, wz) + } + } else { + call gpline (gp, Memr[SX(sht)], Memr[y], nt) + do i = 1, n2 { + wx = shdr_lw (sht, double (x2[i])) + call gline (gp, wx, wy, wx, wz) + } + } + + redraw = NO + } + } until (clgcur ("gcur", wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF) + + call gdeactivate (gp, 0) + call mfree (y, TY_REAL) + call gt_free (gt) + call sfree (sp) +end + + +# AID_DGRAPH -- Graph candidate dispersions. +# This routine is only used for debugging. + +procedure aid_dgraph (aid, x, y, n, w1, dw, nd) + +pointer aid #I AID pointer +real x[n] #I Array of candidate reference coordinates (sorted) +real y[n] #I Array of candidate target coordinates +int n #I Number of candidate pairs +real w1[nd] #I Dispersion origin +real dw[nd] #I Dispersion slope +int nd #I Number of dispersions + +int i, ndplot, wcs, key, redraw, clgcur(), stridxs(), ctoi() +real wx, wy, a, b, c, d, dy, crpix, crval, cdelt +pointer sp, cmd, sh, gp, gt, gt_init() + +begin + call smark (sp) + call salloc (cmd, SZ_LINE, TY_CHAR) + + sh = ID_SH(AID_IDT(aid)) + gp = ID_GP(AID_IDT(aid)) + if (gp == NULL) + return + gt = gt_init() + call gt_seti (gt, GTSYSID, NO) + if (DC(sh) != DCNO) { + call gt_setr (gt, GTXMIN, W0(sh)) + call gt_setr (gt, GTXMAX, W1(sh)) + call gt_setr (gt, GTYMIN, 1.) + call gt_setr (gt, GTYMAX, real(SN(sh))) + } + + ndplot = nd + key = 'r' + repeat { + switch (key) { + case ':': + if (Memc[cmd] == '/') + call gt_colon (Memc[cmd], gp, gt, redraw) + else { + i = 1 + if (ctoi (Memc[cmd], i, ndplot) == 0) + ndplot = nd + } + case 'Q': + i = stridxs ("d", AID_DEBUG(aid,1)) + AID_DEBUG(aid,i) = ' ' + break + case 'q': + break + case 'r': + redraw = YES + case 'w': + call gt_window (gt, gp, "gcur", redraw) + } + + if (redraw == YES) { + call gclear (gp) + call gascale (gp, x, n, 1) + call gascale (gp, y, n, 2) + call gt_swind (gp, gt) + call gt_labax(gp, gt) + + call gt_plot (gp, gt, x, y, n) + + call ggwind (gp, a, b, c, d) + dy = (b - a) / 500. + do i = 1, ndplot { + crval = w1[i] + cdelt = dw[i] + wy = c + wx = crval + wy * cdelt + call gamove (gp, wx, wy) + for (wy=wy+dy; wy<d+dy; wy=wy+dy) { + wx = crval + wy * cdelt + call gadraw (gp, wx, wy) + } + } + + if (AID_CRMIN(aid) > -MAX_DOUBLE / 10. && + AID_CRMAX(aid) < MAX_DOUBLE / 10.) { + crpix = AID_CRPIX(aid) + crval = AID_CDSIGN(aid) * AID_CDMIN(aid) + cdelt = AID_CDSIGN(aid) * AID_CDMAX(aid) + for (wy=c; wy<d+dy; wy=wy+dy) { + wx = AID_CRMIN(aid) + + min ((wy-crpix)*crval, (wy-crpix)*cdelt) + call gmark (gp, wx, wy, GM_POINT, 2, 2) + } + for (wy=c; wy<d+dy; wy=wy+dy) { + wx = AID_CRMAX(aid) + + max ((wy-crpix)*crval, (wy-crpix)*cdelt) + call gmark (gp, wx, wy, GM_POINT, 2, 2) + } + } + + redraw = NO + } + } until (clgcur ("gcur", wx, wy, wcs, key, Memc[cmd], SZ_LINE) == EOF) + + call gdeactivate (gp, 0) + call gt_free (gt) + call sfree (sp) +end diff --git a/noao/onedspec/identify/autoid/aidinit.x b/noao/onedspec/identify/autoid/aidinit.x new file mode 100644 index 00000000..ac86b34d --- /dev/null +++ b/noao/onedspec/identify/autoid/aidinit.x @@ -0,0 +1,93 @@ +include <smw.h> +include "../identify.h" +include "autoid.h" + + +# AID_INIT -- Create AID object and initialize algorithm parameters. + +procedure aid_init (aid, pset) + +pointer aid #O AID object +char pset[ARB] #I Pset for parameters + +pointer pp, clopset() +int clgpseti(), strdic() +double clgpsetd() + +begin + call calloc (aid, AID_LEN, TY_STRUCT) + + # Set default parameters. This can be overridden later by + # the application. + + pp = clopset (pset) + + #call clgpseta (pp, "crval", AID_CR(aid), AID_SZLINE) + #call clgpseta (pp, "cdelt", AID_CD(aid), AID_SZLINE) + call strcpy ("INDEF", AID_CR(aid), AID_SZLINE) + call strcpy ("INDEF", AID_CD(aid), AID_SZLINE) + + call clgpseta (pp, "reflist", AID_REFLIST(aid), AID_SZLINE) + call clgpseta (pp, "refspec", AID_REFSPEC(aid), AID_SZLINE) + call clgpseta (pp, "crpix", AID_CP(aid), AID_SZLINE) + call clgpseta (pp, "crquad", AID_CQ(aid), AID_SZLINE) + call clgpseta (pp, "cddir", AID_DEBUG(aid,1), AID_SZLINE) + AID_CDDIR(aid) = strdic (AID_DEBUG(aid,1), AID_DEBUG(aid,1), + AID_SZLINE, CDDIR) + call clgpseta (pp, "crsearch", AID_CRS(aid), AID_SZLINE) + call clgpseta (pp, "cdsearch", AID_CDS(aid), AID_SZLINE) + AID_NTMAX(aid) = clgpseti (pp, "ntarget") + #AID_NRMAX(aid) = clgpseti (pp, "nreference") + AID_NRMAX(aid) = 2 * AID_NTMAX(aid) + AID_ORD(aid) = clgpseti (pp, "aidord") + AID_MAXNL(aid) = clgpsetd (pp, "maxnl") + AID_NB(aid) = clgpseti (pp, "nbins") + AID_NN(aid) = clgpseti (pp, "nneighbors") + AID_NP(aid) = clgpseti (pp, "npattern") + AID_SIG(aid) = clgpsetd (pp, "sigma") + AID_NFOUND(aid) = clgpseti (pp, "nfound") + AID_RMSG(aid) = clgpsetd (pp, "rms") + AID_FMATCHG(aid) = clgpsetd (pp, "fmatch") + AID_FTMATCHG(aid) = clgpsetd (pp, "fmatch") + AID_MINRATIO(aid) = clgpsetd (pp, "minratio") + AID_NDMAX(aid) = clgpseti (pp, "ndmax") + call clgpseta (pp, "debug", AID_DEBUG(aid,1), AID_SZLINE) + AID_NBEST(aid) = 3 + AID_WRMS(aid) = 0.34 + AID_WFMATCH(aid) = 0.33 + AID_WFTMATCH(aid) = 0.33 + call clcpset (pp) + + call ic_open (AID_IC1(aid)) + call ic_pstr (AID_IC1(aid), "function", "chebyshev") + call ic_puti (AID_IC1(aid), "order", AID_ORD(aid)) + call ic_puti (AID_IC1(aid), "niterate", 5) + call ic_putr (AID_IC1(aid), "low", 2.) + call ic_putr (AID_IC1(aid), "high", 2.) +end + + +# AID_FREE -- Free memory associated with the AID algorithms. + +procedure aid_free (aid) + +pointer aid #U AID object + +begin + if (AID_IDR(aid) != NULL) { + if (ID_SH(AID_IDR(aid)) != NULL) { + call smw_close (MW(ID_SH(AID_IDR(aid)))) + call imunmap (IM(ID_SH(AID_IDR(aid)))) + call shdr_close (ID_SH(AID_IDR(aid))) + } + } + + call ic_closed (AID_IC1(aid)) + call mfree (AID_SPECR(aid), TY_REAL) + call mfree (AID_XR(aid), TY_DOUBLE) + call mfree (AID_XT(aid), TY_DOUBLE) + call mfree (AID_XTF(aid), TY_DOUBLE) + call id_free (AID_IDR(aid)) + call mfree (AID_EVS(aid), TY_POINTER) + call mfree (aid, TY_STRUCT) +end diff --git a/noao/onedspec/identify/autoid/aidlog.x b/noao/onedspec/identify/autoid/aidlog.x new file mode 100644 index 00000000..b0247d00 --- /dev/null +++ b/noao/onedspec/identify/autoid/aidlog.x @@ -0,0 +1,57 @@ +include "../identify.h" + + +# AID_LOG -- Log final solution. + +procedure aid_log (id, fd, hdr) + +pointer id #I ID object +int fd #I Log file descriptor +int hdr #U Print header? + +double wc, dw, id_fitpt(), id_rms() +pointer str +bool fp_equald() + +begin + if (fd == NULL) + return + + if (fd == STDOUT && ID_GP(id) != NULL) + call gdeactivate (ID_GP(id), 0) + + if (hdr == YES) { + call malloc (str, SZ_LINE, TY_CHAR) + call sysid (Memc[str], SZ_LINE) + call fprintf (fd, "\nAUTOIDENTIFY: %s\n") + call pargstr (Memc[str]) + call mfree (str, TY_CHAR) + + call fprintf (fd, " %-20s %10s %10s %10s %10s\n") + call pargstr ("Spectrum") + call pargstr ("# Found") + call pargstr ("Midpoint") + call pargstr ("Dispersion") + call pargstr ("RMS") + + hdr = NO + } + + call fprintf (fd, " %s%s%24t ") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + if (ID_CV(id) == NULL) + call fprintf (fd, " No solution found\n") + else { + wc = id_fitpt (id, (ID_NPTS(id) + 1D0) / 2D0) + dw = wc - id_fitpt (id, (ID_NPTS(id) - 1D0) / 2D0) + if (!fp_equald (dw, 0D0)) { + call fprintf (fd, "%10d %10.*g %10.3g %10.3g\n") + call pargi (ID_NFEATURES(id)) + call pargi (int (log10 (abs (wc / dw)) + 3)) + call pargd (wc) + call pargd (dw) + call pargd (id_rms(id)) + } + } +end diff --git a/noao/onedspec/identify/autoid/aidset.x b/noao/onedspec/identify/autoid/aidset.x new file mode 100644 index 00000000..5905002b --- /dev/null +++ b/noao/onedspec/identify/autoid/aidset.x @@ -0,0 +1,162 @@ +include "autoid.h" + +define AIDSET "|reflist|refspec|crval|cdelt|crpix|crquad|crsearch|cdsearch\ + |cddir|ntarget|nreference|aidord|maxnl|nbins|nneighbors\ + |npattern|sigma|nfound|rms|fmatch|ftmatch|minratio|ndmax\ + |debug|nbest|wrms|wfmatch|wftmatch|" + + +# AID_SETS -- Set AID parameters by name. +# If the first word of the value field is "CL" or "ENV" then the second +# word is the CL parameter name or environment variable name to use +# for the value. + +procedure aid_sets (aid, param, value) + +pointer aid #I AID object +char param[ARB] #I Parameter name +char value[ARB] #I Value + +int i, j, strdic(), strncmp(), envfind(), nowhite(), ctoi(), ctor(), ctod() +pointer sp, str + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + i = strdic (param, Memc[str], SZ_LINE, AIDSET) + + if (strncmp ("CL ", value, 3) == 0) + call clgstr (value[4], Memc[str], SZ_LINE) + else if (strncmp ("ENV ", value, 4) == 0) { + if (envfind (value[5], Memc[str], SZ_LINE) <= 0) + Memc[str] = EOS + } else + call strcpy (value, Memc[str], SZ_LINE) + j = nowhite (Memc[str], Memc[str], SZ_LINE) + + j = 1 + switch (i) { + case 1: + call strcpy (Memc[str], AID_REFLIST(aid), AID_SZLINE) + case 2: + call strcpy (Memc[str], AID_REFSPEC(aid), AID_SZLINE) + case 3: + call strcpy (Memc[str], AID_CR(aid), AID_SZLINE) + case 4: + call strcpy (Memc[str], AID_CD(aid), AID_SZLINE) + case 5: + call strcpy (Memc[str], AID_CP(aid), AID_SZLINE) + case 6: + i = ctod (Memc[str], j, AID_CRQUAD(aid)) + case 7: + call strcpy (Memc[str], AID_CRS(aid), AID_SZLINE) + case 8: + call strcpy (Memc[str], AID_CDS(aid), AID_SZLINE) + case 9: + AID_CDDIR(aid) = strdic (Memc[str], Memc[str], SZ_LINE, CDDIR) + if (AID_CDDIR(aid) == 0) + AID_CDDIR(aid) = CDUNKNOWN + case 10: + i = ctoi (Memc[str], j, AID_NTMAX(aid)) + case 11: + i = ctoi (Memc[str], j, AID_NRMAX(aid)) + case 12: + i = ctoi (Memc[str], j, AID_ORD(aid)) + call ic_puti (AID_IC1(aid), "order", AID_ORD(aid)) + case 13: + i = ctor (Memc[str], j, AID_MAXNL(aid)) + case 14: + i = ctoi (Memc[str], j, AID_NB(aid)) + case 15: + i = ctoi (Memc[str], j, AID_NN(aid)) + case 16: + i = ctoi (Memc[str], j, AID_NP(aid)) + case 17: + i = ctor (Memc[str], j, AID_SIG(aid)) + case 18: + i = ctoi (Memc[str], j, AID_NFOUND(aid)) + case 19: + i = ctor (Memc[str], j, AID_RMSG(aid)) + case 20: + i = ctor (Memc[str], j, AID_FMATCHG(aid)) + case 21: + i = ctor (Memc[str], j, AID_FTMATCHG(aid)) + case 22: + i = ctor (Memc[str], j, AID_MINRATIO(aid)) + case 23: + i = ctoi (Memc[str], j, AID_NDMAX(aid)) + case 24: + call strcpy (Memc[str], AID_DEBUG(aid,1), AID_SZLINE) + case 25: + i = ctoi (Memc[str], j, AID_NBEST(aid)) + case 26: + i = ctor (Memc[str], j, AID_WRMS(aid)) + case 27: + i = ctor (Memc[str], j, AID_WFMATCH(aid)) + case 28: + i = ctor (Memc[str], j, AID_WFTMATCH(aid)) + } + + call sfree (sp) +end + + +# AID_SETI -- Set integer AID parameters. + +procedure aid_seti (aid, param, ival) + +pointer aid #I AID object +char param[ARB] #I Parameter name +int ival #I Value + +pointer sp, str + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + call sprintf (Memc[str], SZ_FNAME, "%d") + call pargi (ival) + call aid_sets (aid, param, Memc[str]) + call sfree (sp) +end + + +# AID_SETR -- Set real AID parameters. + +procedure aid_setr (aid, param, rval) + +pointer aid #I AID object +char param[ARB] #I Parameter name +real rval #I Value + +pointer sp, str + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + call sprintf (Memc[str], SZ_FNAME, "%g") + call pargr (rval) + call aid_sets (aid, param, Memc[str]) + call sfree (sp) +end + + +# AID_SETD -- Set double AID parameters. + +procedure aid_setd (aid, param, dval) + +pointer aid #I AID object +char param[ARB] #I Parameter name +double dval #I Value + +pointer sp, str + +begin + call smark (sp) + call salloc (str, SZ_FNAME, TY_CHAR) + call sprintf (Memc[str], SZ_FNAME, "%g") + call pargd (dval) + call aid_sets (aid, param, Memc[str]) + call sfree (sp) +end diff --git a/noao/onedspec/identify/autoid/aidshift.x b/noao/onedspec/identify/autoid/aidshift.x new file mode 100644 index 00000000..1b910338 --- /dev/null +++ b/noao/onedspec/identify/autoid/aidshift.x @@ -0,0 +1,67 @@ +include "../identify.h" + + +# AID_SHIFT -- Find a new shifted dispersion solution assuming (nearly) the +# same dispersion per pixel and the same dispersion direction. The shift is +# assumed to be less than or equal to the dispersion range of the input +# dispersion. The input is an ID pointer have the previous dispersion +# solution and features but with the new spectrum. If there are more than 10 +# features then the list of user feature coordinates is used as the reference +# list. If there are not enough features or the previous search fails then +# the the coordinate list is used as the reference. The returned result is a +# new ID pointer if the algorithm succeeds or the original ID pointer if it +# fails along with an error status. + +procedure aid_shift (id, crsearch, cdsearch) + +pointer id #I ID object +double crsearch #I Search range +double cdsearch #I Search range + +pointer aid +bool found, aid_autoid() +double crpix, crval, cdelt, id_fitpt() + +begin + # Set approximate dispersion from input dispersion solution. + crpix = ID_NPTS(id) / 2 + 1 + crval = id_fitpt (id, crpix) + cdelt = (FITDATA(id,ID_NPTS(id)) - FITDATA(id,1)) / + (ID_NPTS(id) - 1) + + # Initialize AUTOID. + call aid_init (aid, "aidpars") + call aid_setd (aid, "crval", crval) + call aid_setd (aid, "cdelt", cdelt) + call aid_setd (aid, "crpix", crpix) + call aid_sets (aid, "cddir", "sign") + call aid_setd (aid, "crsearch", crsearch) + call aid_setd (aid, "cdsearch", cdsearch) + call aid_seti (aid, "nbest", 5) + + found = false + if (ID_NFEATURES(id) > 10) { + # Try shift using features. + call aid_seti (aid, "ntarget", ID_NFEATURES(id)) + call aid_seti (aid, "nreference", ID_NFEATURES(id)) + call aid_setr (aid, "wrms", 0.5) + call aid_setr (aid, "wfmatch", 0.5) + call aid_setr (aid, "wftmatch", 0.) + call aid_sets (aid, "refspec", "FEATURES") + found = aid_autoid (id, aid) + } + if (!found) { + # Try shift using coordinate list. + call aid_seti (aid, "ntarget", max (ID_NFEATURES(id),20)) + call aid_seti (aid, "nreference", max (ID_NFEATURES(id),40)) + call aid_setr (aid, "wrms", 0.5) + call aid_setr (aid, "wfmatch", 0.25) + call aid_setr (aid, "wftmatch", 0.25) + call aid_sets (aid, "refspec", "COORDLIST") + found = aid_autoid (id, aid) + } + + call aid_free (aid) + if (!found) + call error (1, "No solution not found") +end diff --git a/noao/onedspec/identify/autoid/autoid.h b/noao/onedspec/identify/autoid/autoid.h new file mode 100644 index 00000000..304d675a --- /dev/null +++ b/noao/onedspec/identify/autoid/autoid.h @@ -0,0 +1,90 @@ +# AUTOIDENTIFY data structure. + +define AID_SZLINE 99 +define AID_LEN 512 + +# Algorithm input parameters. +define AID_REFLIST Memc[P2C($1)] # Reference coordinate list +define AID_REFSPEC Memc[P2C($1+50)] # Reference spectrum +define AID_CR Memc[P2C($1+100)] # Coordinate reference value +define AID_CD Memc[P2C($1+150)] # Coordinate reference value +define AID_CP Memc[P2C($1+200)] # Coordinate reference value +define AID_CQ Memc[P2C($1+250)] # Coordinate quad distortion +define AID_CRS Memc[P2C($1+300)] # Coordinate reference value +define AID_CDS Memc[P2C($1+350)] # Coordinate reference value +define AID_DEBUG Memc[P2C($1+400)+ 2-1] # Debug flags (19 chars) +define AID_CDDIR Memi[$1+450] # Coordinate direction +define AID_NTMAX Memi[$1+451] # Maximum number of target lines +define AID_NRMAX Memi[$1+452] # Maximum number of reference lines +define AID_ORD Memi[$1+453] # Maximum fitting order +define AID_MAXNL Memr[P2R($1+454)] # Maximum non-linearity +define AID_NB Memi[$1+455] # Number of sub-bins +define AID_NN Memi[$1+456] # Number of neighbor lines +define AID_NP Memi[$1+457] # Number of lines in pattern +define AID_SIG Memr[P2R($1+458)] # Target line centering sigma +define AID_NFOUND Memi[$1+459] # Minimum number to be found +define AID_RMSG Memr[P2R($1+460)] # Pixel RMS (goal) +define AID_FMATCHG Memr[P2R($1+461)] # Frac of unmatched lines (goal) +define AID_FTMATCHG Memr[P2R($1+462)] # Frac of unmatched target lines (goal) + +define AID_IDT Memi[$1+463] # Target ID pointer +define AID_IDR Memi[$1+464] # Reference ID pointer +define AID_IC1 Memi[$1+465] # ICFIT pointer +define AID_IC2 Memi[$1+466] # ICFIT pointer + +define AID_XR Memi[$1+467] # Reference lines (ptr) +define AID_NR Memi[$1+468] # Number of reference lines +define AID_XTF Memi[$1+469] # Full target lines sorted by peak +define AID_NTF Memi[$1+470] # Full number of target lines +define AID_XT Memi[$1+471] # Target lines to use sorted by pix +define AID_XTL Memi[$1+472] # Linearized target lines sort by pix +define AID_NT Memi[$1+473] # Number of target lines to use + +define AID_CDSIGN Memi[$1+474] # Sign of coordinate interval +define AID_CRVAL Memd[P2D($1+476)] # Reference coordinate value +define AID_CDELT Memd[P2D($1+478)] # Coordinate interval per pixel +define AID_CRPIX Memd[P2D($1+480)] # Reference pixel +define AID_CRQUAD Memd[P2D($1+482)] # Quadratic distortion +define AID_CRSEARCH Memd[P2D($1+484)] # Search radius for ref value +define AID_CDSEARCH Memd[P2D($1+486)] # Search radius for coord int +define AID_CRMIN Memd[P2D($1+488)] # Min for central coordinate +define AID_CRMAX Memd[P2D($1+490)] # Max for central coordinate +define AID_CDMIN Memd[P2D($1+492)] # Min for coordinate interval +define AID_CDMAX Memd[P2D($1+494)] # Max for coordinate interval + +define AID_MINRATIO Memr[P2R($1+496)] # Minimum ratio +define AID_NDMAX Memi[$1+497] # Max number of dispersions to check +define AID_RMS Memr[P2R($1+498)] # Pixel RMS (best) +define AID_FMATCH Memr[P2R($1+499)] # Fraction of unmatched linelist lines +define AID_FTMATCH Memr[P2R($1+500)] # Fraction of unmatched target lines +define AID_WRMS Memr[P2R($1+501)] # Weight for RMS +define AID_WFMATCH Memr[P2R($1+502)] # Weight for FMATCH +define AID_WFTMATCH Memr[P2R($1+503)] # Weight for FTMATCH +define AID_NBEST Memi[$1+504] # Number of best values < 1 to check +define AID_BEST Memr[P2R($1+505)] # Best fit parameter +define AID_EVS Memi[$1+506] # Evaluate structure + +define AID_SPECR Memi[$1+507] # Reference spectrum (ptr) +define AID_X1R Memi[$1+508] # First pixel of full ref spectrum +define AID_X2R Memi[$1+509] # Last pixel of full ref spectrum +define AID_W1 Memr[P2R($1+510)] # Tentative wavelength of first pixel +define AID_W2 Memr[P2R($1+511)] # Tentative wavelength of last pixel + + +# Evaluation structure. +define AID_EVLEN 8 +define AID_BIN1 Memi[$1] # Reference sample bin +define AID_BIN2 Memi[$1+1] # Reference sample bin +define AID_X Memi[$1+2] # Pixel coordinates +define AID_Y Memi[$1+3] # Dispersion coordinates +define AID_N Memi[$1+4] # Number of coordinate pairs +define AID_A Memi[$1+5] # Trial dispersion start +define AID_B Memi[$1+6] # Trial dispersion step +define AID_ND Memi[$1+7] # Number of trial dispersions + +# Dispersion direction options. +define CDDIR "|sign|increasing|decreasing|unknown|" +define CDSIGN 1 +define CDINC 2 +define CDDEC 3 +define CDUNKNOWN 4 diff --git a/noao/onedspec/identify/autoid/autoid.x b/noao/onedspec/identify/autoid/autoid.x new file mode 100644 index 00000000..3f169ca7 --- /dev/null +++ b/noao/onedspec/identify/autoid/autoid.x @@ -0,0 +1,1600 @@ +include <mach.h> +include <error.h> +include <smw.h> +include "../identify.h" +include "autoid.h" + + +# AID_TARGET -- Select target lines and the dispersion limits to be searched. +# The dispersion limits may be based on header parameters. + +procedure aid_target (aid) + +pointer aid #I AID pointer + +int i, j, l, nt, n +double dw, dwmin, dwmax, pix, aid_imgd(), id_center() +pointer sp, x, y, idt, idr, im, xt, xtl +int id_upeaks(), stridxs() +errchk id_upeaks, id_center + +begin + call smark (sp) + call salloc (x, ID_NPTS(AID_IDT(aid)), TY_REAL) + + idt = AID_IDT(aid) + idr = AID_IDR(aid) + im = IM(ID_SH(idt)) + nt = ID_NPTS(idt) + + # Set the approximate coordinate information. + AID_CRVAL(aid) = aid_imgd (im, AID_CR(aid)) + AID_CDELT(aid) = aid_imgd (im, AID_CD(aid)) + AID_CRPIX(aid) = aid_imgd (im, AID_CP(aid)) + AID_CRQUAD(aid) = aid_imgd (im, AID_CQ(aid)) + AID_CRSEARCH(aid) = aid_imgd (im, AID_CRS(aid)) + AID_CDSEARCH(aid) = aid_imgd (im, AID_CDS(aid)) + + if (IS_INDEFD(AID_CRPIX(aid))) + AID_CRPIX(aid) = (nt+1) / 2. + + if (IS_INDEFD(AID_CRQUAD(aid))) + AID_CRQUAD(aid) = 0D0 + + if (!IS_INDEFD(AID_CRVAL(aid)) && !IS_INDEFD(AID_CDELT(aid))) { + dw = nt * AID_CDELT(aid) + if (IS_INDEFD(AID_CRSEARCH(aid))) + AID_CRSEARCH(aid) = abs (0.1 * dw) + else if (AID_CRSEARCH(aid) < 0.) + AID_CRSEARCH(aid) = abs (AID_CRSEARCH(aid) * dw) + if (IS_INDEFD(AID_CDSEARCH(aid))) + AID_CDSEARCH(aid) = abs (0.1 * AID_CDELT(aid)) + else if (AID_CDSEARCH(aid) < 0.) + AID_CDSEARCH(aid) = abs (AID_CDSEARCH(aid) * AID_CDELT(aid)) + AID_CRSEARCH(aid) = max (abs (0.0001 * dw), + AID_CRSEARCH(aid)) + AID_CDSEARCH(aid) = max (abs (0.0001 * AID_CDELT(aid)), + AID_CDSEARCH(aid)) + dwmax = 2 * AID_CRSEARCH(aid) + (nt - 1) * + (abs (AID_CDELT(aid)) + AID_CDSEARCH(aid)) + dwmin = (abs (AID_CDELT(aid)) - AID_CDSEARCH(aid)) * (nt - 1) + dwmin = max (1.0D-1, dwmin / dwmax) + AID_NB(aid) = nint (1. / dwmin) + } + + # Find the peaks in the target spectrum. + if (ID_FTYPE(idt) == ABSORPTION) { + call anegr (IMDATA(idt,1), IMDATA(idt,1), nt) + n = id_upeaks (idt, IMDATA(idt,1), Memr[x], nt, INDEF, + int (ID_MINSEP(idt)), 0, AID_NTMAX(aid), 5, INDEF, false) + call anegr (IMDATA(idt,1), IMDATA(idt,1), nt) + } else { + n = id_upeaks (idt, IMDATA(idt,1), Memr[x], nt, INDEF, + int (ID_MINSEP(idt)), 0, AID_NTMAX(aid), 5, INDEF, false) + } + call salloc (y, n, TY_REAL) + do i = 1, n + Memr[y+i-1] = -IMDATA(idt,nint(Memr[x+i-1])) + call xt_sort2 (Memr[y], Memr[x], n) + + # Center and sort the lines. + if (AID_XTF(aid) == NULL) + call malloc (AID_XTF(aid), n, TY_DOUBLE) + else + call realloc (AID_XTF(aid), n, TY_DOUBLE) + xt = AID_XTF(aid) + + j = 0 + do i = 1, n { + pix = Memr[x+i-1] + pix = id_center (idt, pix, ID_FWIDTH(idt), ID_FTYPE(idt)) + if (IS_INDEFD(pix)) + next + if (IS_INDEFD(pix)) + next + do l = 1, j { + if (abs (pix-Memd[xt+l-1]) < 1.) + break + } + if (l <= j) + next + Memd[xt+j] = pix + j = j + 1 + } + AID_NTF(aid) = j + + # Sort the lines. + if (AID_XT(aid) == NULL) + call malloc (AID_XT(aid), j, TY_DOUBLE) + else + call realloc (AID_XT(aid), j, TY_DOUBLE) + xt = AID_XT(aid) + if (j > 0) + call asrtd (Memd[AID_XTF(aid)], Memd[xt], j) + else { + call salloc (x, SZ_LINE, TY_CHAR) + call sprintf (Memc[x], SZ_LINE, "No target lines found in `%s'") + call pargstr (ID_IMAGE(idt)) + call error (1, Memc[x]) + } + + # Linearize the lines. + if (AID_XTL(aid) == NULL) + call malloc (AID_XTL(aid), j, TY_DOUBLE) + else + call realloc (AID_XTL(aid), j, TY_DOUBLE) + xt = AID_XT(aid) + xtl = AID_XTL(aid) + do i = 1, j + Memd[xtl+i-1] = Memd[xt+i-1] + + AID_CRQUAD(aid) * (Memd[xt+i-1]-AID_CRPIX(aid))**2 + + # Debug t: Print list of target lines. + if (stridxs ("t", AID_DEBUG(aid,1)) != 0) { + call eprintf ("# Selected target lines:\n") + call eprintf ("#%10s %11s\n") + call pargstr ("Measured") + call pargstr ("Undistorted") + do i = 1, j { + call eprintf ("%11.6g %11.6g\n") + call pargd (Memd[xt+i-1]) + call pargd (Memd[xtl+i-1]) + } + call eprintf ("\n") + } + + call sfree (sp) +end + + +# AID_REFERENCE -- Set reference lines from spectrum or line list. + +procedure aid_reference (aid, ev, flip) + +pointer aid #I AID pointer +pointer ev #I EV pointer +int flip #I Flip dispersion? + +int i, j, i1, i2, npts, nr, nt, nll, id_peaks(), stridxs() +double w, w0, w1, wp, cdelt, wa, wb +real sig, wt, center1d() +pointer sp, x, idt, idr, specr, xr, sh, label, ll +double shdr_wl(), shdr_lw() +errchk id_peaks, center1d + +begin + call smark (sp) + + idr = AID_IDR(aid) + npts = ID_NPTS(idr) + sh = ID_SH(idr) + specr = AID_SPECR(aid) + idt = AID_IDT(aid) + nt = ID_NPTS(idt) + + # Set reference parameters. + if (sh != NULL) { + w0 = min (W0(sh), W1(sh)) + w1 = max (W0(sh), W1(sh)) + wp = abs (WP(sh)) + } else { + ll = ID_LL(idr) + nll = ID_NLL(idr) + if (ll == NULL) { + ll = ID_LL(idt) + nll = ID_NLL(idt) + } + x = ll + w0 = Memd[x] + w1 = Memd[x+nll-1] + wp = INDEFD + } + + # Set limits for reference coordinate and dispersion values. + AID_CRMIN(aid) = -MAX_DOUBLE + AID_CRMAX(aid) = MAX_DOUBLE + AID_CDMIN(aid) = 0D0 + AID_CDMAX(aid) = MAX_DOUBLE + if (IS_INDEFD(AID_CDELT(aid))) { + switch (AID_CDDIR(aid)) { + case CDINC: + AID_CDSIGN(aid) = 1 + case CDDEC: + AID_CDSIGN(aid) = -1 + default: + if (flip == YES) + AID_CDSIGN(aid) = -1 + else + AID_CDSIGN(aid) = 1 + } + + if (!IS_INDEFD(AID_CRVAL(aid))) { + AID_CRMIN(aid) = AID_CRVAL(aid) - AID_CRSEARCH(aid) + AID_CRMAX(aid) = AID_CRVAL(aid) + AID_CRSEARCH(aid) + } + + if (sh != NULL) { + i1 = 1 + i2 = npts + sig = 0. + } else { + wa = -MAX_DOUBLE + wb = MAX_DOUBLE + } + + AID_W1(aid) = INDEF + AID_W2(aid) = INDEF + } else if (IS_INDEFD(AID_CRVAL(aid))) { + switch (AID_CDDIR(aid)) { + case CDINC: + cdelt = abs (AID_CDELT(aid)) + AID_CDSIGN(aid) = 1 + case CDDEC: + cdelt = -abs (AID_CDELT(aid)) + AID_CDSIGN(aid) = -1 + default: + if (flip == YES) + cdelt = -AID_CDELT(aid) + else + cdelt = AID_CDELT(aid) + if (cdelt < 0.) + AID_CDSIGN(aid) = -1 + else + AID_CDSIGN(aid) = 1 + } + + AID_CDMIN(aid) = abs (cdelt) - AID_CDSEARCH(aid) + AID_CDMAX(aid) = abs (cdelt) + AID_CDSEARCH(aid) + + if (sh != NULL) { + i1 = 1 + i2 = npts + sig = abs (AID_CDELT(aid)) / wp + } else { + wa = -MAX_DOUBLE + wb = MAX_DOUBLE + } + + AID_W1(aid) = INDEF + AID_W2(aid) = INDEF + } else { + switch (AID_CDDIR(aid)) { + case CDINC: + cdelt = abs (AID_CDELT(aid)) + AID_CDSIGN(aid) = 1 + case CDDEC: + cdelt = -abs (AID_CDELT(aid)) + AID_CDSIGN(aid) = -1 + default: + if (flip == YES) + cdelt = -AID_CDELT(aid) + else + cdelt = AID_CDELT(aid) + if (cdelt < 0.) + AID_CDSIGN(aid) = -1 + else + AID_CDSIGN(aid) = 1 + } + + AID_CRMIN(aid) = AID_CRVAL(aid) - AID_CRSEARCH(aid) + AID_CRMAX(aid) = AID_CRVAL(aid) + AID_CRSEARCH(aid) + AID_CDMIN(aid) = abs (cdelt) - AID_CDSEARCH(aid) + AID_CDMAX(aid) = abs (cdelt) + AID_CDSEARCH(aid) + + if (cdelt > 0.) { + wa = AID_CRMIN(aid) + (cdelt + AID_CDSEARCH(aid)) * + (1 - AID_CRPIX(aid)) + wb = AID_CRMAX(aid) + (cdelt + AID_CDSEARCH(aid)) * + (nt - AID_CRPIX(aid)) + } else { + wa = AID_CRMIN(aid) + (cdelt - AID_CDSEARCH(aid)) * + (nt - AID_CRPIX(aid)) + wb = AID_CRMAX(aid) + (cdelt - AID_CDSEARCH(aid)) * + (1 - AID_CRPIX(aid)) + } + + if (stridxs ("m", AID_DEBUG(aid,1)) != 0) { + call eprintf ("wa=%g wb=%g\n") + call pargd (wa) + call pargd (wb) + } + + if (sh != NULL) { + i1 = max (1, min (npts, nint (shdr_wl (sh, wa)))) + i2 = max (1, min (npts, nint (shdr_wl (sh, wb)))) + sig = abs (AID_CDELT(aid)) / wp + } + + AID_W1(aid) = AID_CRVAL(aid) + (1-AID_CRPIX(aid)) * cdelt + AID_W2(aid) = AID_CRVAL(aid) + (nt-AID_CRPIX(aid)) * cdelt + } + + # Select lines from line list. + if (ID_IMAGE(idr) == EOS) { + ll = ID_LL(idr) + if (ll == NULL) + ll = ID_LL(idt) + x = ll + npts = 0 + while (!IS_INDEFD(Memd[x])) { + if (Memd[x] > wb) + break + if (Memd[x] >= wa) + npts = npts + 1 + x = x + 1 + } + x = x - npts + if (npts == 0) { + call salloc (x, SZ_LINE, TY_CHAR) + call sprintf (Memc[x], SZ_LINE, "No reference lines found") + call error (1, Memc[x]) + } + + wa = Memd[x] + wb = Memd[x+npts-1] - Memd[x] + wb = wb / ((AID_BIN1(ev) + 1) / 2) + wa = wa + wb / 2 * (AID_BIN2(ev) - 1) + wb = wa + wb + + x = ll + npts = 0 + while (!IS_INDEFD(Memd[x])) { + if (Memd[x] > wb) + break + if (Memd[x] >= wa) + npts = npts + 1 + x = x + 1 + } + x = x - npts + if (npts == 0) { + call salloc (x, SZ_LINE, TY_CHAR) + call sprintf (Memc[x], SZ_LINE, "No reference lines found") + call error (1, Memc[x]) + } + + AID_NRMAX(aid) = npts + nr = AID_NRMAX(aid) + AID_NR(aid) = nr + if (AID_XR(aid) == NULL) + call malloc (AID_XR(aid), nr, TY_DOUBLE) + else + call realloc (AID_XR(aid), nr, TY_DOUBLE) + xr = AID_XR(aid) + + if (nr < npts) { + w = real (npts) / nr + do i = 0, nr { + j = i * w + Memd[xr+i] = Memd[x+j] + } + } else { + do i = 0, nr-1 + Memd[xr+i] = Memd[x+i] + } + + # Select lines using reference spectrum. + } else { + wb = (i2 - i1) / ((AID_BIN1(ev) + 1) / 2) + i1 = max (i1, nint (i1 + wb / 2 * (AID_BIN2(ev) - 1))) + i2 = min (i2, nint (i1 + wb)) + + if (i2 - i1 + 1 < 100) { + i1 = 1 + i2 = npts + } + npts = i2 - i1 + 1 + + if (specr == NULL) + call malloc (specr, npts, TY_REAL) + else + call realloc (specr, npts, TY_REAL) + AID_SPECR(aid) = specr + AID_X1R(aid) = i1 + AID_X2R(aid) = i2 + wa = Memr[SX(sh)+i1-1] + wb = Memr[SX(sh)+i2-1] + call amovr (IMDATA(idr,i1), Memr[specr], npts) + + if (sig > 1.) { + ID_MINSEP(idr) = sig * ID_MINSEP(idt) + ID_FWIDTH(idr) = sig * ID_FWIDTH(idt) + sig = sig / 1.1774 + j = nint (3 * sig) + call malloc (x, npts, TY_REAL) + call malloc (xr, npts+2*j+1, TY_REAL) + xr = xr + j + call amovr (Memr[specr], Memr[xr], npts) + do i = 1, j { + wt = exp (-0.5 * (i / sig) ** 2) + call amulkr (Memr[specr], wt, Memr[x], npts) + call aaddr (Memr[x], Memr[xr+i], Memr[xr+i], npts) + call aaddr (Memr[x], Memr[xr-i], Memr[xr-i], npts) + } + call amovr (Memr[xr], Memr[specr], npts) + call mfree (x, TY_REAL) + call mfree (xr-j, TY_REAL) + } + + call salloc (x, npts, TY_REAL) + + # Find the peaks in the reference spectrum. + AID_NRMAX(aid) = 2 * AID_NTF(aid) + if (ID_FTYPE(idr) == ABSORPTION) { + call anegr (Memr[specr], Memr[specr], nt) + nr = id_peaks (idr, Memr[specr], Memr[x], npts, INDEF, + int (ID_MINSEP(idr)), 0, AID_NRMAX(aid), INDEF, false) + call anegr (Memr[specr], Memr[specr], nt) + } else { + nr = id_peaks (idr, Memr[specr], Memr[x], npts, INDEF, + int (ID_MINSEP(idr)), 0, AID_NRMAX(aid), INDEF, false) + } + + # Center and sort the lines. + if (AID_XR(aid) == NULL) + call malloc (AID_XR(aid), nr, TY_DOUBLE) + else + call realloc (AID_XR(aid), nr, TY_DOUBLE) + xr = AID_XR(aid) + + j = 0 + label = NULL + do i = 1, nr { + wt = center1d (Memr[x+i-1], Memr[specr], npts, ID_FWIDTH(idr), + ID_FTYPE(idr), ID_CRADIUS(idt), 0.) + if (IS_INDEF(wt)) + next + w = shdr_lw (sh, double(wt+i1-1)) + Memd[xr+j] = w + call id_match (idt, w, Memd[xr+j], label, -2.) + if (IS_INDEFD(Memd[xr+j]) || (j>0 && Memd[xr+j]==Memd[xr+j-1])) + next + j = j + 1 + } + call mfree (label, TY_CHAR) + nr = j + AID_NR(aid) = nr + + # Sort the lines. + if (j > 0) + call asrtd (Memd[xr], Memd[xr], nr) + else { + call salloc (x, SZ_LINE, TY_CHAR) + call sprintf (Memc[x], SZ_LINE, + "No reference lines found in `%s'") + call pargstr (ID_IMAGE(idr)) + call error (1, Memc[x]) + } + } + + #AID_NT(aid) = min (2 * AID_NR(aid), AID_NTF(aid)) + AID_NT(aid) = AID_NTF(aid) + call asrtd (Memd[AID_XTF(aid)], Memd[AID_XT(aid)], AID_NT(aid)) + + # Debug w: Print wavelength bin limits. + if (stridxs ("w", AID_DEBUG(aid,1)) != 0) { + call eprintf ("%2d/%-2d %g %g\n") + call pargi (AID_BIN1(ev)) + call pargi (AID_BIN2(ev)) + call pargd (wa) + call pargd (wb) + } + + # Debug b: Print search limits. + if (stridxs ("b", AID_DEBUG(aid,1)) != 0) { + if (ev == AID_EVS(aid)) { + call eprintf ("Search: CRVAL = %.8g - %.8g, CDELT = %.5g - %.5g\n\n") + call pargd (AID_CRMIN(aid)) + call pargd (AID_CRMAX(aid)) + call pargd (AID_CDMIN(aid)) + call pargd (AID_CDMAX(aid)) + } + } + + # Debug r: Print list of reference lines. + if (stridxs ("r", AID_DEBUG(aid,1)) != 0) { + call eprintf ("# Selected reference lines:\n") + do i = 1, nr { + call eprintf ("%10.6g\n") + call pargd (Memd[xr+i-1]) + } + call eprintf ("\n") + } + + call sfree (sp) +end + + +# AID_AUTOID1 -- Automatically identify lines. +# This routine takes preset target and reference line lists and tries to +# find correspondences. It returns lists of possible correspondences +# and dispersions. + +procedure aid_autoid1 (aid, ev) + +pointer aid #I AID pointer +pointer ev #I EV pointer + +int i, nn, n1, n2, nr1, nr2, n, nd +pointer sp, idt, x1, x2, x3, r1, s1, r2, s2, votes, svotes +pointer x, y, w, w1, dw, nw, nv + +int aid_rsort(), aid_vsort(), stridxs() +extern aid_rsort, aid_vsort +errchk aid_select, aid_disp + +begin + call smark (sp) + + idt = AID_IDT(aid) + nn = AID_NN(aid) + x1 = AID_XR(aid) + n1 = AID_NR(aid) + x2 = AID_XTL(aid) + x3 = AID_XT(aid) + n2 = AID_NT(aid) + + # Debug l: Graph lines and spectra. + if (stridxs ("l", AID_DEBUG(aid,1)) != 0) + call aid_lgraph (aid, Memd[x1], n1, Memd[x2], n2) + + # Make ratio lists. + i = min (nn, n1-1) + nr1 = (n1-i) * i * (i - 1) / 2 + i * (i - 1) * (i - 2) / 6 + call salloc (r1, nr1, TY_REAL) + call aid_ratios (aid, Memd[x1], n1, 1, Memr[r1], nr1, 1) + call salloc (s1, nr1, TY_INT) + do i = 1, nr1 + Memi[s1+i-1] = i + call gqsort (Memi[s1], nr1, aid_rsort, r1) + + i = min (nn, n2-1) + nr2 = (n2-i) * i * (i - 1) / 2 + i * (i - 1) * (i - 2) / 6 + call salloc (r2, 2*nr2, TY_REAL) + call aid_ratios (aid, Memd[x2], n2, AID_CDSIGN(aid), Memr[r2], nr2, 2) + call salloc (s2, nr2, TY_INT) + do i = 1, nr2 + Memi[s2+i-1] = i + call gqsort (Memi[s2], nr2, aid_rsort, r2) + + call salloc (votes, n1 * n2, TY_INT) + call aid_votes (aid, Memr[r1], Memi[s1], nr1, Memr[r2], Memi[s2], + nr2, Memd[x1], Memd[x2], Memi[votes], n1, n2) + + call salloc (svotes, n1 * n2, TY_INT) + do i = 1, n1 * n2 + Memi[svotes+i-1] = i + call gqsort (Memi[svotes], n1*n2, aid_vsort, votes) + + do n = 1, n1 * n2 + if (Memi[votes+Memi[svotes+n-1]-1] < 1) + break + n = max (3 * n2, n-1) + + call malloc (x, n, TY_REAL) + call malloc (y, n, TY_REAL) + call salloc (w, n, TY_REAL) + iferr (call aid_select (aid, Memd[x1], Memd[x2], Memd[x3], Memi[votes], + Memi[svotes], n1, n2, Memr[x], Memr[y], Memr[w], n)) { + call sfree (sp) + call erract (EA_ERROR) + } + + nd = AID_NDMAX(aid) + call malloc (w1, nd, TY_REAL) + call malloc (dw, nd, TY_REAL) + call salloc (nw, nd, TY_INT) + call salloc (nv, nd, TY_INT) + call aid_disp (aid, Memr[y], Memr[x], Memr[w], n, Memr[w1], Memr[dw], + Memi[nw], Memi[nv], nd) + + AID_X(ev) = x + AID_Y(ev) = y + AID_N(ev) = n + AID_A(ev) = w1 + AID_B(ev) = dw + AID_ND(ev) = nd + + call sfree (sp) +end + + +# AID_RATIOS -- Generate list of spacing ratios from list of lines. + +procedure aid_ratios (aid, x, n, cdsign, r, nr, nv) + +pointer aid #I AID pointer +double x[n] #I Line positions (sorted) +int n #I Number of lines +int cdsign #I Sign of dispersion +real r[nr,nv] #O Ratios +int nr #O Number of ratios +int nv #I Number of values + +int i, j, k, l, nn, stridxs() +real minr, maxr, xi, xj, xk, xij, xjk, sig, ratio, err + +begin + nn = AID_NN(aid) + sig = AID_SIG(aid) + minr = AID_MINRATIO(aid) + maxr = 1 / AID_MINRATIO(aid) + + # Compute ratios. + l = 0 + if (cdsign == 1) { + do i = 1, n-2 { + xi = x[i] + do j = i+1, min (i+nn-1, n-1) { + xj = x[j] + xij = xj - xi + do k = j+1, min (i+nn, n) { + xk = x[k] + xjk = xk - xj + ratio = xij / xjk + + l = l + 1 + if (nv == 1) { + if (ratio < minr || ratio > maxr) + r[l,1] = 1000. + else + r[l,1] = ratio + } else { + if (ratio < minr || ratio > maxr) { + r[l,1] = 1000. + r[l,2] = 1000. + } else { + err = sig * sqrt (2*(1+ratio+ratio**2)) / xjk + r[l,1] = ratio - err + r[l,2] = ratio + err + } + } + } + } + } + } else { + do i = n, 3, -1 { + xi = x[i] + do j = i-1, max (i-nn+1, 2), -1 { + xj = x[j] + xij = xi - xj + do k = j-1, max (i-nn, 1), -1 { + xk = x[k] + xjk = xj - xk + ratio = xij / xjk + + l = l + 1 + if (nv == 1) { + if (ratio < minr || ratio > maxr) + r[l,1] = 1000. + else + r[l,1] = ratio + } else { + if (ratio < minr || ratio > maxr) { + r[l,1] = 1000. + r[l,2] = 1000. + } else { + err = sig * sqrt (2*(1+ratio+ratio**2)) / xjk + r[l,1] = ratio - err + r[l,2] = ratio + err + } + } + } + } + } + } + nr = l + + # Debug c: Print list of line ratios. + if (stridxs ("c", AID_DEBUG(aid,1)) != 0) { + do l = 1, nr { + call aid_lines (l, n, nn, i, j, k) + if (nv == 1) + call printf ("%2d %2d %2d %8.2f %8.2f %8.2f %6.4f\n") + else + call printf ("%2d %2d %2d %8.2f %8.2f %8.2f %6.4f %6.4f\n") + call pargi (i) + call pargi (j) + call pargi (k) + if (cdsign == 1) { + call pargd (x[i]) + call pargd (x[j]) + call pargd (x[k]) + } else { + call pargd (x[n-i+1]) + call pargd (x[n-j+1]) + call pargd (x[n-k+1]) + } + call pargr (r[l,1]) + if (nv == 2) + call pargr (r[l,2]) + } + } +end + + +# AID_LINES -- Convert ratio index to line indices. + +procedure aid_lines (s, n, nn, i, j, k) + +int s # Index into ratio array +int n # Number of lines +int nn # Number of neigbhors +int i #O Index of first line +int j #O Index of second line +int k #O Index of third line + +int l + +begin + k = s + for (i=1;;i=i+1) { + l = min (nn, n-i) + l = l * (l-1) / 2 + if (k <= l) + break + k = k - l + } + for (j=i+1;;j=j+1) { + l = min (nn-1, n-j) + if (k <= l) + break + k = k - l + } + k = k + j +end + + +# AID_RSORT -- Compare ratio array with smallest first. + +int procedure aid_rsort (ptr, i, j) + +pointer ptr #I Pointer to array to be sorted. +int i #I Index 1 +int j #I Index 2 + +real a, b + +begin + a = Memr[ptr+i-1] + b = Memr[ptr+j-1] + + if (a < b) + return (-1) + else if (b < a) + return (1) + else + return (0) +end + + +# AID_VSORT -- Compare vote array with biggest first. + +int procedure aid_vsort (ptr, i, j) + +pointer ptr #I Pointer to array to be sorted. +int i #I Index 1 +int j #I Index 2 + +int a, b + +begin + a = Memi[ptr+i-1] + b = Memi[ptr+j-1] + + if (a < b) + return (1) + else if (b < a) + return (-1) + else + return (0) +end + + +# AID_VOTES -- Find ratio matches and increment the vote array. + +procedure aid_votes (aid, r1, s1, nr1, r2, s2, nr2, x1, x2, votes, n1, n2) + +pointer aid #I AID pointer +real r1[nr1] #I Ratio array (reference) +int s1[nr1] #I Sort array +int nr1 #I Number of ratios +real r2[nr2,2] #I Ratio array (target) +int s2[nr2] #I Sort array +int nr2 #I Number of ratios +double x1[n1] #I Reference lines +double x2[n2] #I Target lines +int votes[n1,n2] #O Votes +int n1, n2 #I Size of votes array + +int i, j, nn, np, start, stridxs() +real maxr, ra, rb1, rb2 +pointer sp, a, b + +begin + nn = AID_NN(aid) + np = max (3, min (AID_NP(aid), n1 - 5)) + maxr = 1. / AID_MINRATIO(aid) + + call smark (sp) + call salloc (a, np, TY_INT) + call salloc (b, np, TY_INT) + + call aclri (votes, n1*n2) + + start = 1 + do j = 1, nr2 { + rb1 = r2[s2[j],1] + if (rb1 > maxr) + break + rb2 = r2[s2[j],2] + do i = start, nr1 { + ra = r1[s1[i]] + if (ra > rb2) + break + if (ra < rb1) { + start = i + 1 + next + } + call aid_lines (s1[i], n1, nn, Memi[a], Memi[a+1], Memi[a+2]) + call aid_lines (s2[j], n2, nn, Memi[b], Memi[b+1], Memi[b+2]) + call aid_addlines (aid, r1, nr1, s1[i], r2, nr2, s2[j], nn, + Memi[a], Memi[b], np, votes, n1, n2) + } + } + + # Debug v: Print vote array. + if (stridxs ("v", AID_DEBUG(aid,1)) != 0) { + call printf ("%4w") + do i = 1, n2 { + call printf (" %3d") + call pargi (nint (x2[i])) + } + call printf ("\n") + do i = 1, n1 { + call printf ("%4d") + call pargi (nint (x1[i])) + do j = 1, n2 { + call printf (" %3d") + call pargi (votes[i,j]) + } + call printf ("\n") + } + call printf ("\n") + call flush (STDOUT) + } + + call sfree (sp) +end + + +# AID_ADDLINES -- Starting with a matching triplets add more lines. +# The lines are added recursively. To avoid recursive calls this +# routine is repeated to a maximum depth. The indentation is intentionally +# non-standard. + +procedure aid_addlines (aid, r1, nr1, s1, r2, nr2, s2, nn, a, b, npattern, + votes, n1, n2) + +pointer aid #I AID pointer +real r1[nr1] #I Reference ratios +int nr1 #I Number of ratios +int s1 #I Ratio index +real r2[nr2,2] #I Target ratios +int nr2 #I Number of ratios +int s2 #I Ratio index +int nn #I Number of neighbors +int a[npattern] #I Reference lines (indices) +int b[npattern] #I Target lines (indices) +int npattern #I Number of lines in pattern +int votes[n1,n2] #O Vote array +int n1, n2 #O Number of reference and target lines + +int i, j, i1, j1, na, nb + +begin + na = min (a[1] + nn, n1) + nb = min (b[1] + nn, n2) + i1 = s1 - a[3] + j1 = s2 - b[3] + + if (npattern > 3) { + for (a[4]=a[3]+1; a[4]<=na; a[4]=a[4]+1) { + for (b[4]=b[3]+1; b[4]<=nb; b[4]=b[4]+1) { + i = i1 + a[4] + j = j1 + b[4] + if (r1[i] < r2[j,1] || r1[i] > r2[j,2]) + next + if (npattern > 4) { + for (a[5]=a[4]+1; a[5]<=na; a[5]=a[5]+1) { + for (b[5]=b[4]+1; b[5]<=nb; b[5]=b[5]+1) { + i = i1 + a[5] + j = j1 + b[5] + if (r1[i] < r2[j,1] || r1[i] > r2[j,2]) + next + if (npattern > 5) { + for (a[6]=a[5]+1; a[6]<=na; a[6]=a[6]+1) { + for (b[6]=b[5]+1; b[6]<=nb; b[6]=b[6]+1) { + i = i1 + a[6] + j = j1 + b[6] + if (r1[i] < r2[j,1] || r1[i] > r2[j,2]) + next + if (npattern > 6) { + for (a[7]=a[6]+1; a[7]<=na; a[7]=a[7]+1) { + for (b[7]=b[6]+1; b[7]<=nb; b[7]=b[7]+1) { + i = i1 + a[7] + j = j1 + b[7] + if (r1[i] < r2[j,1] || r1[i] > r2[j,2]) + next + if (npattern > 7) { + for (a[8]=a[7]+1; a[8]<=na; a[8]=a[8]+1) { + for (b[8]=b[7]+1; b[8]<=nb; b[8]=b[8]+1) { + i = i1 + a[8] + j = j1 + b[8] + if (r1[i] < r2[j,1] || r1[i] > r2[j,2]) + next + if (npattern > 8) { + for (a[9]=a[8]+1; a[9]<=na; a[9]=a[9]+1) { + for (b[9]=b[8]+1; b[9]<=nb; b[9]=b[9]+1) { + i = i1 + a[9] + j = j1 + b[9] + if (r1[i] < r2[j,1] || r1[i] > r2[j,2]) + next + if (npattern > 9) { + for (a[10]=a[9]+1; a[10]<=na; a[10]=a[10]+1) { + for (b[10]=b[9]+1; b[10]<=nb; b[10]=b[10]+1) { + i = i1 + a[10] + j = j1 + b[10] + if (r1[i] < r2[j,1] || r1[i] > r2[j,2]) + next + call aid_vote (aid, a, b, 10, votes, n1, n2) + } + } + } else { + call aid_vote (aid, a, b, npattern, votes, n1, n2) + } + } + } + } else { + call aid_vote (aid, a, b, npattern, votes, n1, n2) + } + } + } + } else { + call aid_vote (aid, a, b, npattern, votes, n1, n2) + } + } + } + } else { + call aid_vote (aid, a, b, npattern, votes, n1, n2) + } + } + } + } else { + call aid_vote (aid, a, b, npattern, votes, n1, n2) + } + } + } + } else { + call aid_vote (aid, a, b, npattern, votes, n1, n2) + } + } + } + } else { + call aid_vote (aid, a, b, npattern, votes, n1, n2) + } +end + + +# AID_VOTE -- Add votes for the lines in the pattern to the vote array. + +procedure aid_vote (aid, a, b, npattern, votes, n1, n2) + +pointer aid #I AID pointer +int a[npattern] #I Reference lines (indices) +int b[npattern] #I Target lines (indices) +int npattern #I Number of lines in pattern +int votes[n1,n2] #O Vote array +int n1, n2 #O Number of reference and target lines + +int i, stridxs() +pointer xr, xt + +begin + if (AID_CDSIGN(aid) == 1) { + do i = 1, npattern + votes[a[i],b[i]] = votes[a[i],b[i]] + 1 + } else { + do i = 1, npattern + votes[a[i],n2-b[i]+1] = votes[a[i],n2-b[i]+1] + 1 + } + + # Debug a: Print line assignments. + if (stridxs ("a", AID_DEBUG(aid,1)) != 0) { + xr = AID_XR(aid)-1 + xt = AID_XT(aid)-1 + if (AID_CDSIGN(aid) == 1) { + do i = 1, npattern { + call eprintf (" %6g %6g %5d") + call pargd (Memd[xr+a[i]]) + call pargd (Memd[xt+b[i]]) + call pargi (b[i]) + } + } else { + xt = xt+n2+1 + do i = 1, npattern { + call eprintf (" %6g %6g %5d") + call pargd (Memd[xr+a[i]]) + call pargd (Memd[xt-b[i]]) + call pargi (n2-b[i]+1) + } + } + call eprintf ("\n") + } +end + + +# AID_SELECT -- Select top vote getters. + +procedure aid_select (aid, x1, x2, x3, votes, svotes, n1, n2, x, y, w, ns) + +pointer aid #I AID pointer +double x1[n1] #I Reference lines +double x2[n2] #I Linearized target lines +double x3[n2] #I Target lines +int votes[n1,n2] #I Vote array +int svotes[ARB] #I Sort indices for vote array +int n1, n2 #I Number of lines +real x[ns] #O Selected target coordinates +real y[ns] #O Selected reference coordinates +real w[ns] #O Weight (votes) +int ns #U Maximum number on input, number selected on output + +int i, j, k, n +double a, b +bool check + +begin + check = (AID_CRMIN(aid) > -MAX_DOUBLE / 10. && + AID_CRMAX(aid) < MAX_DOUBLE / 10.) + + # Select the highest votes. + n = 0 + for (k=1; k<=n1*n2 && n<ns; k=k+1) { + i = mod (svotes[k]-1, n1) + 1 + j = (svotes[k]-1) / n1 + 1 + if (votes[i,j] < 1) + break + if (check) { + a = (x2[j] - AID_CRPIX(aid)) * AID_CDSIGN(aid) * AID_CDMIN(aid) + b = (x2[j] - AID_CRPIX(aid)) * AID_CDSIGN(aid) * AID_CDMAX(aid) + if (x1[i] < AID_CRMIN(aid) + min (a,b)) + next + if (x1[i] > AID_CRMAX(aid) + max (a,b)) + next + } + n = n + 1 + x[n] = x3[j] + y[n] = x1[i] + w[n] = votes[i,j] + } + ns = n + + if (ns < 1) + call error (1, "No matches found") +end + + +# AID_DISP -- Given a set of candidate identifications (pixel, wavelength) +# find all linear dispersions between two or more identifications which +# satisfy the dispersion constraints. The list of ranked dispersions with +# higher rankings for higher number of points the dispersion goes through +# higher total votes for the points. Hopefully the true dispersion will be +# in the highest ranked dispersions. + +procedure aid_disp (aid, x, y, v, n, w1, dw, nw, nv, nd) + +pointer aid #I AID pointer +real x[n] #I Array of candidate reference coordinates +real y[n] #I Array of candidate target coordinates +real v[n] #I Votes +int n #I Number of candidate pairs +real w1[nd] #O Dispersion origin +real dw[nd] #O Dispersion slope +int nw[nd] #O Number of points +int nv[nd] #O Sum of votes +int nd #U Number of dispersions + +bool debug, skip +int i, j, k, l, m, ii, sumn, sumv, stridxs() +double aw, bw, cw, sumx, sumy, sumyy, sumxy +pointer iii + +begin + # Sort the candidates by reference coordinate. + call xt_sort2 (x, y, n) + + debug = (stridxs ("m", AID_DEBUG(aid,1)) != 0) + if (debug) { + call eprintf ("# Selected pairs with votes.\n") + do i = 1, n { + call eprintf ("%4d %8.6g %8.6g %d\n") + call pargi (i) + call pargr (x[i]) + call pargr (y[i]) + call pargr (v[i]) + } + call eprintf ("# Dispersions to check up to %d.\n") + call pargi (nd) + } + + m = 0 + ii = 0 + call malloc (iii, nd, TY_INT) + do i = 1, n-2 { + do j = i+1, n-1 { + if (x[j] == x[i] || y[j] == y[i]) + next + + bw = (x[j] - x[i]) / (y[j] - y[i]) + aw = x[i] - bw * y[i] + cw = aw + bw * AID_CRPIX(aid) + + # Check dispersion ranges. + skip = false + if (abs (bw) < AID_CDMIN(aid) || abs (bw) > AID_CDMAX(aid)) + skip = true + else if (cw < AID_CRMIN(aid) || cw > AID_CRMAX(aid)) + skip = true + if (AID_CDSIGN(aid) * bw < 0.) + skip = true + if (skip) + next + + sumn = 2 + sumv = v[i] + v[j] + sumx = x[i] + x[j] + sumy = y[i] + y[j] + sumyy = y[i]*y[i] + y[j]*y[j] + sumxy = x[i]*y[i] + x[j]*y[j] + + do k = j+1, n { + if (abs ((x[k] - aw - bw * y[k]) / bw) > 2.) + next + + sumn = sumn + 1 + sumv = sumv + v[k] + sumx = sumx + x[k] + sumy = sumy + y[k] + sumyy = sumyy + y[k]*y[k] + sumxy = sumxy + x[k]*y[k] + } + + aw = (sumx*sumyy - sumy*sumxy) / (sumn * sumyy - sumy * sumy) + bw = (sumn*sumxy - sumx*sumy) / (sumn * sumyy - sumy * sumy) + cw = aw + bw * AID_CRPIX(aid) + ii = ii + 1 + + if (debug) { + call eprintf (" %4d %4d %4d %8.5g %8.3g %8d %8d") + call pargi (ii) + call pargi (i) + call pargi (j) + call pargd (aw+bw*(ID_NPTS(AID_IDT(aid))/2.+1)) + call pargd (bw) + call pargi (sumn) + call pargi (sumv) + } + + # Check if already found. + for (k = 1; k <= m; k = k + 1) + if (abs ((x[1]-aw)/bw - (x[1]-w1[k])/dw[k]) < 2. && + abs ((x[n]-aw)/bw - (x[n]-w1[k])/dw[k]) < 2.) + break + if (k <= m) { + if (sumn > nw[k] || (sumn == nw[k] && sumv > nv[k])) { + for (l = k; l > 1; l = l - 1) { + if (sumn<nw[l-1] || (sumn==nw[l-1] && sumv<nv[l-1])) + break + w1[l] = w1[l-1] + dw[l] = dw[l-1] + nw[l] = nw[l-1] + nv[l] = nv[l-1] + Memi[iii+l-1] = Memi[iii+l-2] + } + if (debug) { + call eprintf (" replace %4d\n") + call pargi (Memi[iii+l-1]) + } + w1[l] = aw + dw[l] = bw + nw[l] = sumn + nv[l] = sumv + Memi[iii+l-1] = ii + } else if (debug) { + call eprintf (" use %4d\n") + call pargi (Memi[iii+k-1]) + } + next + } + + # Check dispersion ranges. + if (abs (bw) < AID_CDMIN(aid) || abs (bw) > AID_CDMAX(aid)) + skip = true + else if (cw < AID_CRMIN(aid) || cw > AID_CRMAX(aid)) + skip = true + if (AID_CDSIGN(aid) * bw < 0.) + skip = true + if (skip) { + if (debug) + call eprintf (" out of range\n") + next + } + + # Add to ordered list. + for (k = 1; k <= m; k = k + 1) + if (sumn > nw[k] || (sumn == nw[k] && sumv > nv[k])) + break + if (k <= nd) { + if (m < nd) { + m = m + 1 + if (debug) + call eprintf (" add\n") + } else if (debug) { + call eprintf (" bump %4d\n") + call pargi (Memi[iii+m-1]) + } + for (l = m; l > k; l = l - 1) { + w1[l] = w1[l-1] + dw[l] = dw[l-1] + nw[l] = nw[l-1] + nv[l] = nv[l-1] + Memi[iii+l-1] = Memi[iii+l-2] + } + w1[k] = aw + dw[k] = bw + nw[k] = sumn + nv[k] = sumv + Memi[iii+k-1] = ii + } else if (debug) + call eprintf (" failed\n") + } + } + + nd = m + + if (debug) { + call eprintf ("# Final ordered dispersions to try.\n") + do i = 1, nd { + call eprintf (" %4d %8.5g %8.3g %8d %8d\n") + call pargi (Memi[iii+i-1]) + call pargr (w1[i]+dw[i]*(ID_NPTS(AID_IDT(aid))/2.+1)) + call pargr (dw[i]) + call pargi (nw[i]) + call pargi (nv[i]) + } + } + call mfree (iii, TY_INT) + + # Debug d: Graph dispersions. + if (stridxs ("d", AID_DEBUG(aid,1)) != 0) + call aid_dgraph (aid, x, y, n, w1, dw, nd) +end + + +# AID_EVAL -- Evaluate possible solutions. + +double procedure aid_eval (aid, ev, nd) + +pointer aid #I AID pointer +pointer ev #I EV pointer +int nd #I Dispersion candidate to evaluate +double best #O Best statistic + +int i, n +pointer idt, x, y +double a, b, c, d, rms, fmatch, ftmatch +int stridxs() + +int ncandidate, nmatch1, nmatch2 +common /llstat/ ncandidate, nmatch1, nmatch2 + +define done_ 90 + +begin + best = INDEFD + if (nd > AID_ND(ev)) + return (best) + + idt = AID_IDT(aid) + x = AID_X(ev) - 1 + y = AID_Y(ev) - 1 + n = AID_N(ev) + + a = Memr[AID_A(ev)+nd-1] + b = Memr[AID_B(ev)+nd-1] + c = ID_NPTS(AID_IDT(aid)) / 2. + 1 + if (IS_INDEFD(AID_CDELT(aid))) + d = b + else + d = AID_CDELT(aid) + + ID_IC(idt) = AID_IC1(aid) + ID_NFEATURES(idt) = 0 + do i = 1, n { + if (abs ((Memr[y+i] - a - b * Memr[x+i]) / b) < 2.) + call id_newfeature (idt, double(Memr[x+i]), double(Memr[x+i]), + double(Memr[y+i]), 1.0D0, ID_FWIDTH(idt), ID_FTYPE(idt), + NULL) + } + if (ID_NFEATURES(idt) <= 1) + goto done_ + + call dcvfree (ID_CV(idt)) + iferr (call aid_dofit (aid, idt, d, rms, fmatch, ftmatch, best)) + goto done_ + + # Debug s: Print search iterations. + if (stridxs ("s", AID_DEBUG(aid,1)) != 0) { + call eprintf ( + "%2d/%-2d %8.2f %8.3f %3d %3d/%-3d %3d/%-3d %3d %3d %6.3f %5.2f\n") + call pargi (AID_BIN1(ev)) + call pargi (AID_BIN2(ev)) + call pargd (a+c*b) + call pargd (b) + call pargi (ID_NFEATURES(idt)) + call pargi (nmatch2) + call pargi (ncandidate) + call pargi (nint(min (ncandidate, AID_NT(aid))*(1-ftmatch))) + call pargi (min (ncandidate, AID_NT(aid))) + call pargi (nint(100.*fmatch)) + call pargi (nint(100.*ftmatch)) + call pargd (rms) + call pargd (best) + } + + if (best < AID_BEST(aid)) { + AID_FMATCH(aid) = fmatch + AID_FTMATCH(aid) = ftmatch + AID_RMS(aid) = rms + AID_BEST(aid) = best + ID_IC(idt) = AID_IC2(aid) + call id_saveid (idt, "autoidentify") + } + +done_ + ID_IC(idt) = AID_IC2(aid) + return (best) +end + + +# AID_DOFIT -- From a set of candidate identifications fit and evaluate +# a dispersion solution. + +procedure aid_dofit (aid, id, cdelt, rms, fmatch, ftmatch, best) + +pointer aid #I AID pointer +pointer id #I ID pointer +double cdelt #I Dispersion to use in pixel rms conversion +double rms #O Final RMS in pixels +double fmatch #O Line list non-matching fraction +double ftmatch #O Target line non-matching fraction +double best #O Best fit parameter + +int i, j, k, l, nmin, nfound, nt, ntmatch, maxfeatures, stridxs() +double fit, user, dcveval(), id_fitpt() +pointer cv, xt, label + +int ncandidate, nmatch1, nmatch2 +common /llstat/ ncandidate, nmatch1, nmatch2 + +errchk id_dofit, id_fitdata, id_fitfeatures, id_linelist, id_match + +begin + maxfeatures = ID_MAXFEATURES(id) + ID_MAXFEATURES(id) = 1000 + iferr { + do k = 1, 3 { + if (ID_NFEATURES(id) < 2) + call error (0, "aid_dofit: not enough features") + if (k > 1) + call id_linelist (id) + + if (stridxs ("i", AID_DEBUG(aid,1)) != 0) + call id_dofit (id, YES) + else + call id_dofit (id, NO) + do l = AID_ORD(aid)-1, 2, -1 { + cv = ID_CV(id) + user = dcveval (cv, 1D0) + fit = (dcveval (cv, double (ID_NPTS(id)/2)) - user) / + (dcveval (cv, double (ID_NPTS(id))) - user) + if (abs (fit - 0.5) <= AID_MAXNL(aid)) + break + if (stridxs ("n", AID_DEBUG(aid,1)) != 0) { + call eprintf ( + "order %d: non-linearity of %.1f%% > %.1f%%\n") + call pargi (l+1) + call pargd (100*abs(fit-0.5)) + call pargr (100*AID_MAXNL(aid)) + } + call ic_puti (ID_IC(id), "order", l) + if (stridxs ("i", AID_DEBUG(aid,1)) != 0) + call id_dofit (id, YES) + else + call id_dofit (id, NO) + call ic_puti (ID_IC(id), "order", AID_ORD(aid)) + } + call id_fitdata (id) + call id_fitfeatures (id) + + j = 0 + do i = 1, ID_NFEATURES(id) { + if (IS_INDEFD(USER(id,i)) || WTS(id,i) != 0.) { + j = j + 1 + PIX(id,j) = PIX(id,i) + FIT(id,j) = FIT(id,i) + USER(id,j) = USER(id,i) + WTS(id,j) = WTS(id,i) + FWIDTH(id,j) = FWIDTH(id,i) + FTYPE(id,j) = FTYPE(id,i) + } + } + ID_NFEATURES(id) = j + } + ID_MAXFEATURES(id) = maxfeatures + } then { + ID_MAXFEATURES(id) = maxfeatures + call erract (EA_ERROR) + } + if (IS_INDEFD(cdelt)) + return + + nmin = 2 + nfound = AID_NFOUND(aid) + if (ID_NFEATURES(id) < nfound) + call error (0, "aid_dofit: not enough features") + + # Compute fwidth rms. + rms = 0. + for (i=1; i<=ID_NFEATURES(id); i=i+1) + rms = rms + (FIT(id,i) - USER(id,i)) ** 2 + rms = sqrt (rms/ max (1, ID_NFEATURES(id)-nmin)) / abs (cdelt) + rms = rms / ID_FWIDTH(id) + + # Compute line list matching fraction. + ncandidate = max (nfound, (ncandidate-(nmatch1-nmatch2))) + fmatch = 1 - real (nmatch2) / ncandidate + + # Compute target line matching fraction. + xt = AID_XT(aid) + nt = AID_NT(aid) + label = NULL + ntmatch = 0 + do i = 1, nt { + fit = id_fitpt (id, Memd[xt+i-1]) + user = INDEFD + call id_match (id, fit, user, label, ID_MATCH(id)) + if (!IS_INDEFD(user)) + ntmatch = ntmatch + 1 + } + ftmatch = 1 - real (ntmatch) / min (nt, ncandidate) + call mfree (label, TY_CHAR) + + if (AID_RMSG(aid) > 0. && AID_FMATCHG(aid) > 0.) { + best = AID_WRMS(aid) * rms / AID_RMSG(aid) + best = best + AID_WFMATCH(aid) * fmatch / AID_FMATCHG(aid) + best = best + AID_WFTMATCH(aid) * ftmatch / AID_FMATCHG(aid) + } else + best = MAX_DOUBLE +end + + +# AID_DOFITF -- From a set of candidate identifications fit and evaluate +# a final dispersion solution. + +procedure aid_dofitf (aid, id) + +pointer aid #I AID pointer +pointer id #I ID pointer + +int i, j, k, maxfeatures + +errchk id_dofit, id_fitdata, id_fitfeatures, id_linelist + +begin + maxfeatures = ID_MAXFEATURES(id) + ID_MAXFEATURES(id) = 1000 + iferr { + do k = 1, 3 { + if (ID_NFEATURES(id) < 2) + call error (0, "aid_dofit: not enough features") + if (k > 1) + call id_linelist (id) + + call id_dofit (id, NO) + call id_fitdata (id) + call id_fitfeatures (id) + if (k < 3) { + j = 0 + do i = 1, ID_NFEATURES(id) { + if (IS_INDEFD(USER(id,i)) || WTS(id,i) != 0.) { + j = j + 1 + PIX(id,j) = PIX(id,i) + FIT(id,j) = FIT(id,i) + USER(id,j) = USER(id,i) + WTS(id,j) = WTS(id,i) + FWIDTH(id,j) = FWIDTH(id,i) + FTYPE(id,j) = FTYPE(id,i) + } + } + ID_NFEATURES(id) = j + } + } + ID_MAXFEATURES(id) = maxfeatures + } then { + ID_MAXFEATURES(id) = maxfeatures + call erract (EA_ERROR) + } +end + + +# AID_EVALLOC -- Allocate memory to save the candidate identifications +# and dispersions to be evaluated. + +pointer procedure aid_evalloc (aid, index) + +pointer aid #I AID pointer +int index #I Reference sample index + +begin + if (AID_EVS(aid) == NULL) + call calloc (AID_EVS(aid), (index+49)*AID_EVLEN, TY_POINTER) + else if (index > 1 && mod (index-1, 50) == 0) { + call realloc (AID_EVS(aid), (index+49)*AID_EVLEN, TY_POINTER) + call aclri (Memi[AID_EVS(aid)+(index-1)*AID_EVLEN], 50*AID_EVLEN) + } + return (AID_EVS(aid)+(index-1)*AID_EVLEN) +end + + +# AID_EVFREE -- Free memory from the evaluation step. + +procedure aid_evfree (aid, index) + +pointer aid #I AID pointer +int index #I Reference sample index + +pointer ev, aid_evalloc() + +begin + ev = aid_evalloc (aid, index) + call mfree (AID_X(ev), TY_REAL) + call mfree (AID_Y(ev), TY_REAL) + call mfree (AID_A(ev), TY_REAL) + call mfree (AID_B(ev), TY_REAL) +end + + +# AID_IMGD -- Get value from image header or parameter string. + +double procedure aid_imgd (im, param) + +pointer im #I IMIO pointer +char param[ARB] #I Parameter + +int i, ctod() +double dval, imgetd() + +begin + if (param[1] == '!') { + iferr (dval = imgetd (im, param[2])) + dval = INDEFD + } else { + iferr (dval = imgetd (im, param)) { + i = 1 + if (ctod (param, i, dval) == 0) + dval = INDEFD + } + } + return (dval) +end diff --git a/noao/onedspec/identify/autoid/mkpkg b/noao/onedspec/identify/autoid/mkpkg new file mode 100644 index 00000000..7d46d183 --- /dev/null +++ b/noao/onedspec/identify/autoid/mkpkg @@ -0,0 +1,17 @@ +$checkout libpkg.a ../../ +$update libpkg.a +$checkin libpkg.a ../../ +$exit + +libpkg.a: + aidautoid.x autoid.h <gset.h> ../identify.h <mach.h>\ + <math/iminterp.h> <smw.h> + aidget.x autoid.h + aidgraph.x autoid.h <gset.h> ../identify.h <mach.h> <pkg/gtools.h>\ + <smw.h> + aidinit.x autoid.h ../identify.h <smw.h> + aidlog.x ../identify.h + aidset.x autoid.h + aidshift.x ../identify.h + autoid.x autoid.h <error.h> ../identify.h <mach.h> <smw.h> + ; diff --git a/noao/onedspec/identify/idcenter.x b/noao/onedspec/identify/idcenter.x new file mode 100644 index 00000000..6b6dba06 --- /dev/null +++ b/noao/onedspec/identify/idcenter.x @@ -0,0 +1,37 @@ +include <smw.h> +include "identify.h" + +# ID_CENTER -- Locate the center of a feature. + +double procedure id_center (id, x, width, type) + +pointer id # ID pointer +double x # Initial guess +real width # Feature width +int type # Feature type + +int np1 +real value +double dvalue + +real center1d() +double smw_c1trand() + +begin + if (IS_INDEFD(x)) + return (x) + + dvalue = smw_c1trand (ID_PL(id), x) + if (IS_INDEFD(dvalue)) + return (dvalue) + + np1 = NP1(ID_SH(id)) - 1 + value = dvalue - np1 + value = center1d (value, IMDATA(id,1), ID_NPTS(id), + width, type, ID_CRADIUS(id), ID_THRESHOLD(id)) + + if (IS_INDEF(value)) + return (INDEFD) + else + return (smw_c1trand (ID_LP(id), double(value+np1))) +end diff --git a/noao/onedspec/identify/idcolon.x b/noao/onedspec/identify/idcolon.x new file mode 100644 index 00000000..0bd68042 --- /dev/null +++ b/noao/onedspec/identify/idcolon.x @@ -0,0 +1,284 @@ +include <gset.h> +include <error.h> +include <smw.h> +include "identify.h" + +# List of colon commands. +define CMDS "|show|features|image|nsum|database|read|write|add|coordlist|match\ + |maxfeatures|minsep|zwidth|labels|fwidth|ftype|cradius|threshold|" + +define SHOW 1 # Show parameters +define FEATURES 2 # Show list of features +define IMAGE 3 # Set new image +define NSUM 4 # Set the number of lines or columns to sum +define DATABASE 5 # Set new database +define READ 6 # Read database entry +define WRITE 7 # Write database entry +define ADD 8 # Add features from database +define COORDLIST 9 # Set new coordinate list +define MATCH 10 # Set coordinate list matching distance +define MAXFEATURES 11 # Set maximum number of features for auto find +define MINSEP 12 # Set minimum separation distance +define ZWIDTH 13 # Set zoom window width +define LABEL 14 # Set label type +define WIDTH 15 # Set centering width +define TYPE 16 # Set centering type +define RADIUS 17 # Set centering radius +define THRESHOLD 18 # Set the centering threshold + +# ID_COLON -- Respond to colon command. + +procedure id_colon (id, cmdstr, newimage, prfeature) + +pointer id # ID pointer +char cmdstr[ARB] # Colon command +char newimage[ARB] # New image name +int prfeature # Print current feature on status line + +char cmd[SZ_LINE] +int i, ncmd, ival[2] +real rval[2] +pointer im + +int nscan(), strdic() +pointer immap() +errchk immap, id_dbread, id_dbwrite, id_log + +begin + # Scan the command string and get the first word. + call sscan (cmdstr) + call gargwrd (cmd, SZ_LINE) + ncmd = strdic (cmd, cmd, SZ_LINE, CMDS) + + switch (ncmd) { + case SHOW: # :show - show values of parameters + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) { + call gdeactivate (ID_GP(id), AW_CLEAR) + call id_show (id, "STDOUT") + call greactivate (ID_GP(id), AW_PAUSE) + } else { + iferr (call id_show (id, cmd)) { + call erract (EA_WARN) + prfeature = NO + } + } + case FEATURES: # :features - list features + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) { + call gdeactivate (ID_GP(id), AW_CLEAR) + call id_log (id, "STDOUT") + call greactivate (ID_GP(id), AW_PAUSE) + } else { + iferr (call id_log (id, cmd)) { + call erract (EA_WARN) + prfeature = NO + } + } + case IMAGE: # :image - set image to identify + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) { + call printf ("image %s\n") + call pargstr (ID_IMAGE(id)) + prfeature = NO + } else { + call strcpy (cmd, newimage, SZ_FNAME) + iferr { + im = immap (newimage, READ_ONLY, 0) + call imunmap (im) + } then { + newimage[1] = EOS + call erract (EA_WARN) + prfeature = NO + } + } + case NSUM: # :nsum - set number of lines or columns to sum in image + call gargi (ival[1]) + if (nscan() == 1) { + call printf ("nsum %d %d\n") + call pargi (ID_NSUM(id,1)) + call pargi (ID_NSUM(id,2)) + prfeature = NO + } else { + ID_NSUM(id,1) = ival[1] + call gargi (ival[2]) + if (nscan() == 3) + ID_NSUM(id,2) = ival[2] + call smw_daxis (NULL, NULL, SMW_PAXIS(MW(ID_SH(id)),1), + ID_NSUM(id,1), ID_NSUM(id,2)) + } + case DATABASE: # :database - set database + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) { + call printf ("database %s\n") + call pargstr (ID_DATABASE(id)) + prfeature = NO + } else { + call strcpy (cmd, ID_DATABASE(id), ID_LENSTRING) + ID_NEWDBENTRY(id) = YES + } + case READ: # :read - read database entry + prfeature = NO + iferr { + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) + call id_dbread (id, ID_IMAGE(id), ID_AP(id,1), + NO, YES) + else { + call gargi (ival[1]) + if (nscan() < 3) + ival[1] = ID_AP(id,1) + call gargi (ival[2]) + if (nscan() < 4) + ival[2] = ID_AP(id,2) + call id_dbread (id, cmd, ival, NO, YES) + } + } then + call erract (EA_WARN) + case WRITE: # :write - write database entry + prfeature = NO + iferr { + ival[1] = ID_AP(id,1) + ival[2] = ID_AP(id,2) + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) + call id_dbwrite (id, ID_IMAGE(id), ival, YES) + else { + call gargi (ival[1]) + if (nscan() < 3) + ival[1] = ID_AP(id,1) + call gargi (ival[2]) + if (nscan() < 4) + ival[2] = ID_AP(id,2) + call id_dbwrite (id, cmd, ival, YES) + } + } then + call erract (EA_WARN) + case ADD: # :add - add features from database entry + prfeature = NO + iferr { + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) + call id_dbread (id, ID_IMAGE(id), ID_AP(id,1), + YES, YES) + else { + call gargi (ival[1]) + if (nscan() < 3) + ival[1] = ID_AP(id,1) + call gargi (ival[2]) + if (nscan() < 4) + ival[2] = ID_AP(id,2) + call id_dbread (id, cmd, ival, YES, YES) + } + } then + call erract (EA_WARN) + case COORDLIST: # :coordlist - set coordinate list + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) { + call printf ("coordlist %s\n") + call pargstr (ID_COORDLIST(id)) + prfeature = NO + } else { + call strcpy (cmd, ID_COORDLIST(id), ID_LENSTRING) + call id_unmapll (id) + call id_mapll (id) + } + case MATCH: # :match - set matching distance for coordinate list + call gargr (rval[1]) + if (nscan() == 1) { + call printf ("match %g\n") + call pargr (ID_MATCH(id)) + prfeature = NO + } else + ID_MATCH(id) = rval[1] + case MAXFEATURES: # :maxfeatures - set max num features for auto find + call gargi (ival[1]) + if (nscan() == 1) { + call printf ("maxfeatures %d\n") + call pargi (ID_MAXFEATURES(id)) + prfeature = NO + } else + ID_MAXFEATURES(id) = ival[1] + case MINSEP: # :minsep - set minimum feature separation allowed + call gargr (rval[1]) + if (nscan() == 1) { + call printf ("minsep %g\n") + call pargr (ID_MINSEP(id)) + prfeature = NO + } else + ID_MINSEP(id) = rval[1] + case ZWIDTH: # :zwidth - set zoom window width + call gargr (rval[1]) + if (nscan() == 1) { + call printf ("zwidth %g\n") + call pargr (ID_ZWIDTH(id)) + prfeature = NO + } else { + ID_ZWIDTH(id) = rval[1] + if (ID_GTYPE(id) == 2) + ID_NEWGRAPH(id) = YES + } + case LABEL: # :labels - set label type + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) { + switch (ID_LABELS(id)) { + case 2: + call printf ("labels index\n") + case 3: + call printf ("labels pixel\n") + case 4: + call printf ("labels coord\n") + case 5: + call printf ("labels user\n") + case 6: + call printf ("labels both\n") + default: + call printf ("labels none\n") + } + prfeature = NO + } else { + ID_LABELS(id) = strdic (cmd, cmd, SZ_LINE, LABELS) + do i = 1, ID_NFEATURES(id) + call id_mark (id, i) + } + case WIDTH: # :fwidth - set centering width + call gargr (rval[1]) + if (nscan() == 1) { + call printf ("fwidth %g\n") + call pargr (ID_FWIDTH(id)) + prfeature = NO + } else + ID_FWIDTH(id) = rval[1] + case TYPE: # :ftype - set centering type + call gargwrd (cmd, SZ_LINE) + if (nscan() == 1) { + switch (ID_FTYPE(id)) { + case EMISSION: + call printf ("ftype emission\n") + case ABSORPTION: + call printf ("ftype absorption\n") + } + prfeature = NO + } else + ID_FTYPE(id) = strdic (cmd, cmd, SZ_LINE, FTYPES) + case RADIUS: # :cradius - set centering radius + call gargr (rval[1]) + if (nscan() == 1) { + call printf ("cradius %g\n") + call pargr (ID_CRADIUS(id)) + prfeature = NO + } else + ID_CRADIUS(id) = rval[1] + case THRESHOLD: # :threshold - set centering threshold + call gargr (rval[1]) + if (nscan() == 1) { + call printf ("threshold %g\n") + call pargr (ID_THRESHOLD(id)) + prfeature = NO + } else + ID_THRESHOLD(id) = rval[1] + default: + call printf ("Unrecognized or ambiguous command\007") + prfeature = NO + } +end diff --git a/noao/onedspec/identify/iddb.x b/noao/onedspec/identify/iddb.x new file mode 100644 index 00000000..e354d1c4 --- /dev/null +++ b/noao/onedspec/identify/iddb.x @@ -0,0 +1,515 @@ +include <imset.h> +include <math/curfit.h> +include <smw.h> +include <units.h> +include "identify.h" +include <pkg/dttext.h> + + +# ID_DBREAD -- Read features data from the database. + +procedure id_dbread (id, name, ap, add, verbose) + +pointer id # ID pointer +char name[SZ_LINE] # Image name +int ap[2] # Aperture number +int add # Add features? +int verbose # Verbose flag + +int rec, dtlocate() +pointer sp, line, str +errchk dtremap, dtlocate, id_dbread_rec + +begin + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + call strcpy ("id", Memc[line], SZ_LINE) + call imgcluster (name, Memc[line+2], SZ_LINE) + call dtremap (ID_DT(id), ID_DATABASE(id), Memc[line], READ_ONLY) + + call id_dbsection (id, name, ap, ID_SECTION(id), ID_LENSTRING) + call sprintf (Memc[line], SZ_LINE, "identify %s%s") + call pargstr (name) + call pargstr (ID_SECTION(id)) + + iferr (rec = dtlocate (ID_DT(Id), Memc[line])) { + call salloc (str, SZ_LINE, TY_CHAR) + call sprintf (Memc[str], SZ_LINE, "Entry not found: %s") + call pargstr (Memc[line]) + call error (0, Memc[str]) + } + + call id_dbread_rec (id, rec, add) + + if (ID_NFEATURES(id) > 0) { + ID_NEWGRAPH(id) = YES + ID_NEWFEATURES(id) = YES + ID_CURRENT(id) = 1 + } else + ID_CURRENT(id) = 0 + + if (verbose == YES) { + call printf ("identify %s%s\n") + call pargstr (name) + call pargstr (ID_SECTION(id)) + } + + call sfree (sp) +end + + +# ID_DBSAVE -- Read all entries from a database and save. + +procedure id_dbsave (id, name) + +pointer id # ID pointer +char name[SZ_LINE] # Image name + +int rec, dtgeti() +pointer sp, line, dt +errchk dtremap, dtgeti, id_dbread_rec, id_saveap + +begin + call smark (sp) + call salloc (line, SZ_FNAME, TY_CHAR) + + call strcpy ("id", Memc[line], SZ_FNAME) + call imgcluster (name, Memc[line+2], SZ_FNAME) + call dtremap (ID_DT(id), ID_DATABASE(id), Memc[line], READ_ONLY) + + dt = ID_DT(id) + do rec = 1, DT_NRECS(dt) { + ID_AP(id,1) = dtgeti (dt, rec, "aperture") + ID_AP(id,2) = 1 + call id_dbread_rec (id, rec, NO) + call id_saveap (id) + } + + call sfree (sp) +end + + +# ID_DBREAD_REC -- Read specified record from the database. + +procedure id_dbread_rec (id, rec, add) + +pointer id # ID pointer +int rec # Database record +int add # Add features? + +double pix +int i, j, k, ncoeffs +pointer dt, sh, un, sp, line, coeffs + +int dtgeti(), dcvstati(), dtscan(), nscan() +real dtgetr() +double dcvstatd() +bool un_compare() +pointer un_open() +errchk un_open, dtgeti(), dtgad() + +begin + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + + dt = ID_DT(id) + sh = ID_SH(id) + + if (add == YES) { + j = dtgeti (dt, rec, "features") + k = j + ID_NFEATURES(id) + ID_NALLOC(id) = k + + call realloc (ID_PIX(id), k, TY_DOUBLE) + call realloc (ID_FIT(id), k, TY_DOUBLE) + call realloc (ID_USER(id), k, TY_DOUBLE) + call realloc (ID_WTS(id), k, TY_DOUBLE) + call realloc (ID_FWIDTHS(id), k, TY_REAL) + call realloc (ID_FTYPES(id), k, TY_INT) + call realloc (ID_LABEL(id), k, TY_POINTER) + + do i = 1, j { + k = dtscan (dt) + call gargd (pix) + + ID_NFEATURES(id) = ID_NFEATURES(id) + 1 + for (k=ID_NFEATURES(id); (k>1)&&(pix<PIX(id,k-1)); k=k-1) { + PIX(id,k) = PIX(id,k-1) + FIT(id,k) = FIT(id,k-1) + USER(id,k) = USER(id,k-1) + WTS(id,k) = WTS(id,k-1) + FWIDTH(id,k) = FWIDTH(id,k-1) + FTYPE(id,k) = FTYPE(id,k-1) + Memi[ID_LABEL(id)+k-1] = Memi[ID_LABEL(id)+k-2] + } + PIX(id,k) = pix + call gargd (FIT(id,k)) + call gargd (USER(id,k)) + call gargr (FWIDTH(id,k)) + call gargi (FTYPE(id,k)) + call gargd (WTS(id,k)) + call gargstr (Memc[line], SZ_LINE) + Memi[ID_LABEL(id)+k-1] = NULL + call id_label (Memc[line], Memi[ID_LABEL(id)+k-1]) + + # The following initialization is for backwards compatibility. + if (nscan() < 5) { + FWIDTH(id,k) = ID_FWIDTH(id) + FTYPE(id,k) = ID_FTYPE(id) + } else if (nscan() < 6) + WTS(id,k) = 1. + } + + if (ID_UN(id) != NULL) { + ifnoerr (call dtgstr (dt, rec, "units", Memc[line], SZ_LINE)) { + un = un_open (Memc[line]) + if (!un_compare (un, ID_UN(id)) && j > 0) { + k = ID_NFEATURES(id) - j + call un_ctrand (un, ID_UN(id), FIT(id,k), FIT(id,k), j) + call un_ctrand (un, ID_UN(id), USER(id,k), USER(id,k),j) + } + call un_close (un) + } + } + + } else { + if (sh != NULL) { + if (SMW_FORMAT(MW(sh))==SMW_ES || SMW_FORMAT(MW(sh))==SMW_MS) { + iferr (APLOW(sh,1) = dtgetr (dt, rec, "aplow")) + APLOW(sh,1) = INDEF + iferr (APHIGH(sh,1) = dtgetr (dt, rec, "aphigh")) + APHIGH(sh,1) = INDEF + } + } + + do i = 1, ID_NFEATURES(id) + call mfree (Memi[ID_LABEL(id)+i-1], TY_CHAR) + + k = dtgeti (dt, rec, "features") + ID_NFEATURES(id) = k + ID_NALLOC(id) = k + call realloc (ID_PIX(id), k, TY_DOUBLE) + call realloc (ID_FIT(id), k, TY_DOUBLE) + call realloc (ID_USER(id), k, TY_DOUBLE) + call realloc (ID_WTS(id), k, TY_DOUBLE) + call realloc (ID_FWIDTHS(id), k, TY_REAL) + call realloc (ID_FTYPES(id), k, TY_INT) + call realloc (ID_LABEL(id), k, TY_POINTER) + + do i = 1, ID_NFEATURES(id) { + k = dtscan (dt) + call gargd (PIX(id,i)) + call gargd (FIT(id,i)) + call gargd (USER(id,i)) + call gargr (FWIDTH(id,i)) + call gargi (FTYPE(id,i)) + call gargd (WTS(id,i)) + call gargstr (Memc[line], SZ_LINE) + Memi[ID_LABEL(id)+i-1] = NULL + call id_label (Memc[line], Memi[ID_LABEL(id)+i-1]) + + # The following initialization is for backwards compatibility. + if (nscan() < 5) { + FWIDTH(id,i) = ID_FWIDTH(id) + FTYPE(id,i) = ID_FTYPE(id) + } else if (nscan() < 6) + WTS(id,i) = 1. + } + + iferr (ID_SHIFT(id) = dtgetr (dt, rec, "shift")) + ID_SHIFT(id) = 0. + + iferr { + ncoeffs = dtgeti (dt, rec, "coefficients") + call salloc (coeffs, ncoeffs, TY_DOUBLE) + call dtgad (dt, rec, "coefficients", Memd[coeffs], ncoeffs, + ncoeffs) + + if (ID_CV(id) != NULL) + call dcvfree (ID_CV(id)) + call dcvrestore (ID_CV(id), Memd[coeffs]) + + call ic_putr (ID_IC(id), "xmin", real (dcvstatd(ID_CV(id), + CVXMIN))) + call ic_putr (ID_IC(id), "xmax", real (dcvstatd(ID_CV(id), + CVXMAX))) + ifnoerr (call dtgstr (dt,rec,"function",Memc[line],SZ_LINE)) { + call ic_pstr (ID_IC(id), "function", Memc[line]) + call ic_puti (ID_IC(id), "order", dtgeti (dt, rec, "order")) + call dtgstr (dt, rec, "sample", Memc[line], SZ_LINE) + call ic_pstr (ID_IC(id), "sample", Memc[line]) + call ic_puti (ID_IC(id), "naverage", + dtgeti (dt, rec, "naverage")) + call ic_puti (ID_IC(id), "niterate", + dtgeti (dt, rec, "niterate")) + call ic_putr (ID_IC(id), "low", + dtgetr (dt, rec, "low_reject")) + call ic_putr (ID_IC(id), "high", + dtgetr (dt, rec, "high_reject")) + call ic_putr (ID_IC(id), "grow", dtgetr (dt, rec, "grow")) + } else { + call ic_puti (ID_IC(id), "order", dcvstati (ID_CV(id), + CVORDER)) + switch (dcvstati (ID_CV(id), CVTYPE)) { + case LEGENDRE: + call ic_pstr (ID_IC(id), "function", "legendre") + case CHEBYSHEV: + call ic_pstr (ID_IC(id), "function", "chebyshev") + case SPLINE1: + call ic_pstr (ID_IC(id), "function", "spline1") + case SPLINE3: + call ic_pstr (ID_IC(id), "function", "spline3") + } + } + + ID_NEWCV(id) = YES + ID_CURRENT(id) = min (1, ID_NFEATURES(id)) + } then + ; + + ifnoerr (call dtgstr (dt, rec, "units", Memc[line], SZ_LINE)) { + if (ID_UN(id) == NULL) + ID_UN(id) = un_open (Memc[line]) + else { + un = un_open (Memc[line]) + if (!un_compare (un, ID_UN(id))) { + call id_unitsll (id, Memc[line]) + call un_close (ID_UN(id)) + ID_UN(id) = un + } else + call un_close (un) + } + } + } + + call sfree (sp) +end + + +# ID_DBWRITE -- Write features data to the database. + +procedure id_dbwrite (id, name, ap, verbose) + +pointer id # ID pointer +char name[ARB] # Image name +int ap[2] # Aperture number +int verbose # Verbose flag + +int i, ncoeffs +pointer dt, sp, coeffs, root, sh, im + +int dcvstati(), ic_geti() +real ic_getr() + +errchk dtremap + +begin + call smark (sp) + call salloc (root, SZ_FNAME, TY_CHAR) + + call strcpy ("id", Memc[root], SZ_FNAME) + call imgcluster (name, Memc[root+2], SZ_FNAME) + call dtremap (ID_DT(id), ID_DATABASE(id), Memc[root], APPEND) + + call id_dbsection (id, name, ap, ID_SECTION(id), ID_LENSTRING) + + sh = ID_SH(id) + dt = ID_DT(id) + call dtptime (dt) + call dtput (dt, "begin\tidentify %s%s\n") + call pargstr (name) + call pargstr (ID_SECTION(id)) + call dtput (dt, "\tid\t%s\n") + call pargstr (name) + call dtput (dt, "\ttask\tidentify\n") + call dtput (dt, "\timage\t%s%s\n") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + if (SMW_FORMAT(MW(sh)) == SMW_ES || SMW_FORMAT(MW(sh)) == SMW_MS) { + call dtput (dt, "\taperture\t%d\n") + call pargi (ID_AP(id,1)) + call dtput (dt, "\taplow\t%g\n") + call pargr (APLOW(sh,1)) + call dtput (dt, "\taphigh\t%g\n") + call pargr (APHIGH(sh,1)) + } + + if (ID_UN(id) != NULL) { + call dtput (dt, "\tunits\t%s\n") + call pargstr (UN_USER(ID_UN(id))) + } + call dtput (dt, "\tfeatures\t%d\n") + call pargi (ID_NFEATURES(id)) + do i = 1, ID_NFEATURES(id) { + call dtput (dt, "\t %10.2f %10.9g %10.9g %5.1f %d %d %s\n") + call pargd (PIX(id,i)) + call pargd (FIT(id,i)) + call pargd (USER(id,i)) + call pargr (FWIDTH(id,i)) + call pargi (FTYPE(id,i)) + call pargd (WTS(id,i)) + if (Memi[ID_LABEL(id)+i-1] != NULL) + call pargstr (Memc[Memi[ID_LABEL(id)+i-1]]) + else + call pargstr ("") + } + + if (ID_SHIFT(id) != 0.) { + call dtput (dt, "\tshift\t%g\n") + call pargd (ID_SHIFT(id)) + } + + if (ID_CV(id) != NULL) { + call dtput (dt, "\tfunction %s\n") + call ic_gstr (ID_IC(id), "function", Memc[root], SZ_FNAME) + call pargstr (Memc[root]) + call dtput (dt, "\torder %d\n") + call pargi (ic_geti (ID_IC(id), "order")) + call dtput (dt, "\tsample %s\n") + call ic_gstr (ID_IC(id), "sample", Memc[root], SZ_FNAME) + call pargstr (Memc[root]) + call dtput (dt, "\tnaverage %d\n") + call pargi (ic_geti (ID_IC(id), "naverage")) + call dtput (dt, "\tniterate %d\n") + call pargi (ic_geti (ID_IC(id), "niterate")) + call dtput (dt, "\tlow_reject %g\n") + call pargr (ic_getr (ID_IC(id), "low")) + call dtput (dt, "\thigh_reject %g\n") + call pargr (ic_getr (ID_IC(id), "high")) + call dtput (dt, "\tgrow %g\n") + call pargr (ic_getr (ID_IC(id), "grow")) + + ncoeffs = dcvstati (ID_CV(id), CVNSAVE) + call salloc (coeffs, ncoeffs, TY_DOUBLE) + call dcvsave (ID_CV(id), Memd[coeffs]) + call dtput (dt, "\tcoefficients\t%d\n") + call pargi (ncoeffs) + do i = 1, ncoeffs { + call dtput (dt, "\t\t%g\n") + call pargd (Memd[coeffs+i-1]) + } + } + + call dtput (dt, "\n") + + ID_NEWFEATURES(id) = NO + ID_NEWCV(id) = NO + ID_NEWDBENTRY(id) = NO + + if (verbose == YES) { + call printf ("identify %s%s\n") + call pargstr (name) + call pargstr (ID_SECTION(id)) + } + + # Enter reference spectrum name in image header. + im = IM(sh) + call imseti (im, IM_WHEADER, YES) + call imastr (im, "REFSPEC1", ID_IMAGE(id)) + iferr (call imdelf (im, "REFSPEC2")) + ; + + call sfree (sp) +end + + +# ID_DBCHECK -- Check if there is an entry in the database. +# This does not actually read the database entry. It also assumes that +# if a database is already open it is for the same image (the image +# names are not checked) and the database has been scanned. + +int procedure id_dbcheck (id, name, ap) + +pointer id # ID pointer +char name[SZ_LINE] # Image name +int ap[2] # Aperture number + +int rec, stat +pointer sp, line, sec + +int dtlocate() + +errchk dtremap(), dtlocate() + +begin + call smark (sp) + call salloc (line, SZ_LINE, TY_CHAR) + call salloc (sec, SZ_LINE, TY_CHAR) + + if (ID_DT(id) == NULL) { + call strcpy ("id", Memc[line], SZ_LINE) + call imgcluster (name, Memc[line+2], SZ_LINE) + iferr (call dtremap (ID_DT(id), ID_DATABASE(id), Memc[line], + READ_ONLY)) { + call sfree (sp) + return (NO) + } + } + + call id_dbsection (id, name, ap, Memc[sec], SZ_LINE) + call sprintf (Memc[line], SZ_LINE, "identify %s%s") + call pargstr (name) + call pargstr (Memc[sec]) + + iferr (rec = dtlocate (ID_DT(id), Memc[line])) + stat = NO + else + stat = YES + + call sfree (sp) + return (stat) +end + + +# ID_DBSECTION -- Make the IDENTIFY section. + +procedure id_dbsection (id, name, ap, section, sz_section) + +pointer id #I ID pointer +char name[SZ_LINE] #I Image name +int ap[2] #I Aperture number +char section[sz_section] #O IDENTIFY section +int sz_section #I Size of section string + +pointer sh, smw +bool streq() + +begin + sh = ID_SH(id) + smw = MW(sh) + + switch (SMW_FORMAT(smw)) { + case SMW_ND: + section[1] = EOS + if (streq (name, ID_IMAGE(id))) { + switch (SMW_LDIM(smw)) { + case 2: + switch (SMW_LAXIS(smw,1)) { + case 1: + call sprintf (section, sz_section, "[*,%d]") + case 2: + call sprintf (section, sz_section, "[%d,*]") + } + #call pargi (LINDEX(sh,1)) + call pargi (ap[1]) + case 3: + switch (SMW_LAXIS(smw,1)) { + case 1: + call sprintf (section, sz_section, "[*,%d,%d]") + case 2: + call sprintf (section, sz_section, "[%d,*,%d]") + case 3: + call sprintf (section, sz_section, "[%d,%d,*]") + } + #call pargi (LINDEX(sh,1)) + #call pargi (LINDEX(sh,2)) + call pargi (ap[1]) + call pargi (ap[2]) + } + } + case SMW_ES, SMW_MS: + call sprintf (section, sz_section, " - Ap %d") + call pargi (ap[1]) + } +end diff --git a/noao/onedspec/identify/iddelete.x b/noao/onedspec/identify/iddelete.x new file mode 100644 index 00000000..cd96abb1 --- /dev/null +++ b/noao/onedspec/identify/iddelete.x @@ -0,0 +1,26 @@ +include "identify.h" + +# ID_DELETE -- Delete a feature. + +procedure id_delete (id, feature) + +pointer id # ID pointer +int feature # Feature to be deleted + +int i + +begin + call mfree (Memi[ID_LABEL(id)+feature-1], TY_CHAR) + do i = feature + 1, ID_NFEATURES(id) { + PIX(id,i-1) = PIX(id,i) + FIT(id,i-1) = FIT(id,i) + USER(id,i-1) = USER(id,i) + WTS(id,i-1) = WTS(id,i) + FWIDTH(id,i-1) = FWIDTH(id,i) + FTYPE(id,i-1) = FTYPE(id,i) + Memi[ID_LABEL(id)+i-2] = Memi[ID_LABEL(id)+i-1] + } + Memi[ID_LABEL(id)+ID_NFEATURES(id)-1] = NULL + ID_NFEATURES(id) = ID_NFEATURES(id) - 1 + ID_NEWFEATURES(id) = YES +end diff --git a/noao/onedspec/identify/iddofit.x b/noao/onedspec/identify/iddofit.x new file mode 100644 index 00000000..8e6558e9 --- /dev/null +++ b/noao/onedspec/identify/iddofit.x @@ -0,0 +1,108 @@ +include <units.h> +include "identify.h" + +# ID_DOFIT -- Fit a function to the features. Eliminate INDEF points. + +procedure id_dofit (id, interactive) + +pointer id # ID pointer +int interactive # Interactive fit? + +int i, j, k, nfit, ic_geti() +pointer gt1, sp, x, y, wts, rejpts, str, gt_init() + +begin + if (ID_NFEATURES(id) == 0) { + if (ID_CV(id) != NULL) { + call dcvfree (ID_CV(id)) + ID_SHIFT(id) = 0. + ID_NEWGRAPH(id) = YES + ID_NEWCV(id) = YES + } + return + } + + call smark (sp) + call salloc (x, ID_NFEATURES(id), TY_DOUBLE) + call salloc (y, ID_NFEATURES(id), TY_DOUBLE) + call salloc (wts, ID_NFEATURES(id), TY_DOUBLE) + + nfit = 0 + do i = 1, ID_NFEATURES(id) { + if (IS_INDEFD (PIX(id,i)) || IS_INDEFD (USER(id,i))) + next + Memd[x+nfit] = PIX(id,i) + Memd[y+nfit] = USER(id,i) + Memd[wts+nfit] = max (1D0, WTS(id,i)) + nfit = nfit + 1 + } + + if (nfit > 1) { + if (ID_UN(id) != NULL) { + call ic_pstr (ID_IC(id), "ylabel", UN_LABEL(ID_UN(id))) + call ic_pstr (ID_IC(id), "yunits", UN_UNITS(ID_UN(id))) + } + if (interactive == YES) { + call salloc (str, SZ_LINE, TY_CHAR) + gt1 = gt_init() + call icg_fitd (ID_IC(id), ID_GP(id), "cursor", gt1, ID_CV(id), + Memd[x], Memd[y], Memd[wts], nfit) + call gt_free (gt1) + } else + call ic_fitd (ID_IC(id), ID_CV(id), Memd[x], Memd[y], Memd[wts], + nfit, YES, YES, YES, YES) + + if (ic_geti (ID_IC(id), "nreject") > 0 && + ic_geti (ID_IC(id), "nfit") == nfit) + rejpts = ic_geti (ID_IC(id), "rejpts") + else + rejpts = NULL + + j = 0 + k = 0 + do i = 1, ID_NFEATURES(id) { + if (IS_INDEFD (PIX(id,i)) || IS_INDEFD (USER(id,i))) { + j = j + 1 + PIX(id,j) = PIX(id,i) + FIT(id,j) = FIT(id,i) + USER(id,j) = USER(id,i) + WTS(id,j) = WTS(id,i) + FWIDTH(id,j) = FWIDTH(id,i) + FTYPE(id,j) = FTYPE(id,i) + call mfree (Memi[ID_LABEL(id)+j-1], TY_CHAR) + Memi[ID_LABEL(id)+j-1] = Memi[ID_LABEL(id)+i-1] + } else { + if (Memd[wts+k] != 0.) { + j = j + 1 + PIX(id,j) = Memd[x+k] + FIT(id,j) = FIT(id,i) + USER(id,j) = Memd[y+k] + WTS(id,j) = Memd[wts+k] + if (rejpts != NULL) + if (Memi[rejpts+k] == YES) + WTS(id,j) = 0. + FWIDTH(id,j) = FWIDTH(id,i) + FTYPE(id,j) = FTYPE(id,i) + Memi[ID_LABEL(id)+j-1] = Memi[ID_LABEL(id)+i-1] + } + k = k + 1 + } + } + do i = j+1, ID_NFEATURES(id) + Memi[ID_LABEL(id)+i-1] = NULL + ID_NFEATURES(id) = j + + ID_SHIFT(id) = 0. + ID_NEWCV(id) = YES + ID_NEWGRAPH(id) = YES + } else { + if (ID_CV(id) != NULL) { + call dcvfree (ID_CV(id)) + ID_SHIFT(id) = 0. + ID_NEWCV(id) = YES + ID_NEWGRAPH(id) = YES + } + } + + call sfree (sp) +end diff --git a/noao/onedspec/identify/iddoshift.x b/noao/onedspec/identify/iddoshift.x new file mode 100644 index 00000000..2dfdff74 --- /dev/null +++ b/noao/onedspec/identify/iddoshift.x @@ -0,0 +1,41 @@ +include "identify.h" + +# ID_DOSHIFT -- Minimize residuals by constant shift. + +procedure id_doshift (id, interactive) + +pointer id # ID pointer +int interactive # Called interactively? + +int i, j +double shft, delta, rms, id_fitpt() + +begin + shft = 0. + rms = 0. + j = 0 + for (i=1; i <= ID_NFEATURES(id); i = i + 1) { + if (IS_INDEFD (USER(id,i)) || WTS(id,i) == 0.) + next + delta = USER(id,i) - id_fitpt (id, PIX(id,i)) + shft = shft + delta + rms = rms + delta * delta + j = j + 1 + } + + if (j > 0) { + shft = shft / j + rms = rms / j + if (interactive == YES) { + call printf ("%s%s: Coordinate shift=%5f, rms=%5f, npts=%3d\n") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + call pargd (shft) + call pargd (sqrt (rms - shft ** 2)) + call pargi (j) + } + ID_SHIFT(id) = ID_SHIFT(id) + shft + ID_NEWCV(id) = YES + ID_NEWGRAPH(id) = YES + } +end diff --git a/noao/onedspec/identify/identify.h b/noao/onedspec/identify/identify.h new file mode 100644 index 00000000..0af2d58b --- /dev/null +++ b/noao/onedspec/identify/identify.h @@ -0,0 +1,90 @@ +# Task parameters + +define ID_LENSTRING 99 # Length of strings in ID structure +define ID_LENSTRUCT 354 # Length ID structure + +define ID_IMAGE Memc[P2C($1)] # Image +define ID_SECTION Memc[P2C($1+50)] # Section for 2D and 3D images +define ID_DATABASE Memc[P2C($1+100)] # Name of database +define ID_COORDLIST Memc[P2C($1+150)] # Name of coordinate list +define ID_COORDSPEC Memc[P2C($1+200)] # Name of coordinate spectrum +define ID_SAVEID Memc[P2C($1+250)] # ID for save structure +define ID_LINE Memi[$1+$2+299] # Image line or column [2] +define ID_MAXLINE Memi[$1+$2+301] # Maximum line or column [2] +define ID_AP Memi[$1+$2+303] # Aperture if appropriate [2] +define ID_APS Memi[$1+306] # Array of apertures (pointer) +define ID_NSUM Memi[$1+$2+306] # Number of lines to sum [2] +define ID_MAXFEATURES Memi[$1+309] # Maximum number of features +define ID_FTYPE Memi[$1+310] # Feature type +define ID_MINSEP Memr[P2R($1+311)] # Minimum pixel separation +define ID_MATCH Memr[P2R($1+312)] # Maximum matching separation +define ID_FWIDTH Memr[P2R($1+313)] # Feature width in pixels +define ID_CRADIUS Memr[P2R($1+314)] # Centering radius in pixels +define ID_THRESHOLD Memr[P2R($1+315)] # Centering threshold +define ID_ZWIDTH Memr[P2R($1+316)] # Zoom window width in fit units +define ID_LL Memi[$1+317] # Pointer to coordinate list lines +define ID_LLL Memi[$1+318] # Pointer to coordinate list labels +define ID_NLL Memi[$1+319] # Number of coordinate list lines +define ID_LABELS Memi[$1+320] # Type of feature labels +define ID_LOGFILES Memi[$1+321] # List of logfiles + +# Common image data + +define ID_SHIFT Memd[P2D($1+322)]# Wavelength shift +define ID_IMDATA Memi[$1+324] # Image data (pointer) +define ID_PIXDATA Memi[$1+325] # Pixel coordinates (pointer) +define ID_FITDATA Memi[$1+326] # Fit coordinates (pointer) +define ID_NPTS Memi[$1+327] # Number of points + +# Features + +define ID_NFEATURES Memi[$1+328] # Number of features +define ID_NALLOC Memi[$1+329] # Length of allocated feature arrays +define ID_PIX Memi[$1+330] # Feature pixel coordinates (pointer) +define ID_FIT Memi[$1+331] # Feature fit coordinates (pointer) +define ID_USER Memi[$1+332] # Feature user coordinates (pointer) +define ID_WTS Memi[$1+333] # Feature weights (pointer) +define ID_FWIDTHS Memi[$1+334] # Feature width (pointer) +define ID_FTYPES Memi[$1+335] # Feature type (pointer) +define ID_LABEL Memi[$1+336] # Feature label (pointer) +define ID_CURRENT Memi[$1+337] # Current feature + +# Pointers for other packages and to save data + +define ID_SH Memi[$1+338] # SHDR pointer +define ID_LP Memi[$1+339] # Logical to physical transformation +define ID_PL Memi[$1+340] # Physical to logical transformation +define ID_IC Memi[$1+341] # ICFIT pointer +define ID_CV Memi[$1+342] # Curfit pointer +define ID_GP Memi[$1+343] # GIO pointer +define ID_GT Memi[$1+344] # Gtools pointer +define ID_STP Memi[$1+345] # Symbol table of saved data +define ID_DT Memi[$1+346] # Database pointer +define ID_UN Memi[$1+347] # Units pointer + +# Flags + +define ID_NEWFEATURES Memi[$1+348] # Has feature list changed? +define ID_NEWCV Memi[$1+349] # Has fitting function changed? +define ID_NEWGRAPH Memi[$1+350] # Has graph changed? +define ID_NEWDBENTRY Memi[$1+351] # Has database entry changed? +define ID_REFIT Memi[$1+352] # Refit feature data? +define ID_GTYPE Memi[$1+353] # Graph type + +# End of structure ---------------------------------------------------------- + +define LABELS "|none|index|pixel|coord|user|both|" +define FTYPES "|emission|absorption|" +define EMISSION 1 # Emission feature +define ABSORPTION 2 # Absorption feature + +define IMDATA Memr[ID_IMDATA($1)+$2-1] +define PIXDATA Memd[ID_PIXDATA($1)+$2-1] +define FITDATA Memd[ID_FITDATA($1)+$2-1] + +define PIX Memd[ID_PIX($1)+$2-1] +define FIT Memd[ID_FIT($1)+$2-1] +define USER Memd[ID_USER($1)+$2-1] +define WTS Memd[ID_WTS($1)+$2-1] +define FWIDTH Memr[ID_FWIDTHS($1)+$2-1] +define FTYPE Memi[ID_FTYPES($1)+$2-1] diff --git a/noao/onedspec/identify/identify.key b/noao/onedspec/identify/identify.key new file mode 100644 index 00000000..95b44c32 --- /dev/null +++ b/noao/onedspec/identify/identify.key @@ -0,0 +1,90 @@ +1. IDENTIFY CURSOR KEY SUMMARY + +? Help k Next line u Enter coordinate +a Affect all features l Match list (refit) v Weight +b Auto identification m Mark feature w Window graph +c Center feature(s) n Next feature x Find shift +d Delete feature(s) o Go to line y Find peaks +e Add lines (no refit) p Pan graph z Zoom graph +f Fit positions q Quit . Nearest feature +g Fit zero point shift r Redraw graph + Next feature +i Initialize s Shift feature - Previous feature +j Preceding line t Reset position I Interrupt + +2. IDENTIFY COLON COMMAND SUMMARY + +:add [image [ap]] :fwidth [value] :read [image [ap]] +:coordlist [file] :image [image] :show [file] +:cradius [value] :labels [type] :threshold [value] +:database [file] :match [value] :write [image [ap]] +:features [file] :maxfeatures [value] :zwidth [value] +:ftype [type] :minsep [value] + +3. IDENTIFY CURSOR KEYS + +? Clear the screen and print menu of options +a Apply next (c)enter or (d)elete operation to (a)ll features +b Automatic line identifications: queries for approx. coordinate and dispersion +c (C)enter the feature nearest the cursor +d (D)elete the feature nearest the cursor +e Add features from coordinate list with no automatic refit +f (F)it a function of pixel coordinate to the user coordinates +g Fit a zero point shift to the user coordinates +i (I)nitialize (delete features and coordinate fit) +j Go to the preceding image line or column in a 2D or multispec image +k Go to the next image line or column in a 2D or multispec image +l Add features from coordinate (l)ist with automatic refit +m (M)ark a new feature near the cursor and enter coordinate and label +n Move the cursor or zoom to the (n)ext feature (same as +) +o Go to the specified image line or column in a 2D or multispec image +p (P)an to user defined window after (z)ooming on a feature +q (Q)uit and continue with next image (also carriage return) +r (R)edraw the graph +s (S)hift the current feature to the position of the cursor +t Reset the position of a feature without centering +u Enter a new (u)ser coordinate and label for the current feature +v Modify weight of line in fitting +w (W)indow the graph. Use '?' to window prompt for more help. +x Find zero point shift by matching lines with peaks +y Automatically find "maxfeatures" strongest peaks and identify them +z (Z)oom on the feature nearest the cursor +. Move the cursor or zoom to the feature nearest the cursor ++ Move the cursor or zoom to the next feature +- Move the cursor or zoom to the previous feature +I Interrupt task and exit immediately. Database information is not saved. + + +4. IDENTIFY COLON COMMANDS + +The parameters are listed or set with the following commands which may be +abbreviated. To list the value of a parameter type the command alone. + +:show file Show the values of all the parameters +:features file Write feature list to file (default is STDOUT) + +:coordlist file Coordinate list file +:cradius value Centering radius in pixels +:threshold value Detection threshold for feature centering +:database name Database for recording feature records +:ftype value Feature type (emission or absorption) +:fwidth value Feature width in pixels +:image imagename Set a new image or show the current image +:labels value Feature label type (none|index|pixel|coord|user|both) +:match value Coordinate list matching distance +:maxfeatures value Maximum number of features automatically found +:minsep value Minimum separation allowed between features +:read name ap Read a record from the database + (name and ap default to the current spectrum) +:write name ap Write a record to the database + (name and ap default to the current spectrum) +:add name ap Add features from the database + (name and ap default to the current spectrum) +:zwidth value Zoom width in user units + +Labels: + none - No labels + index - Sequential numbers in order of increasing pixel position + pixel - Pixel coordinates + coord - User coordinates such as wavelength + user - User labels + both - Combination of coord and user diff --git a/noao/onedspec/identify/idfitdata.x b/noao/onedspec/identify/idfitdata.x new file mode 100644 index 00000000..2d86163c --- /dev/null +++ b/noao/onedspec/identify/idfitdata.x @@ -0,0 +1,177 @@ +include <math/curfit.h> +include <pkg/gtools.h> +include <smw.h> +include <units.h> +include "identify.h" + +# ID_FITDATA -- Compute fit coordinates from pixel coordinates. + +procedure id_fitdata (id) + +pointer id # ID pointer +int i + +begin + if (ID_SH(id) == NULL || ID_PIXDATA(id) == NULL) + return + + call mfree (ID_FITDATA(id), TY_DOUBLE) + call malloc (ID_FITDATA(id), ID_NPTS(id), TY_DOUBLE) + + if (ID_CV(id) == NULL) { + if (DC(ID_SH(id)) != DCNO && ID_UN(id) != NULL) + iferr (call shdr_units (ID_SH(id), UN_UNITS(ID_UN(id)))) + ; + call achtrd (Memr[SX(ID_SH(id))], FITDATA(id,1), ID_NPTS(id)) + call gt_sets (ID_GT(id), GTXLABEL, LABEL(ID_SH(id))) + call gt_sets (ID_GT(id), GTXUNITS, UNITS(ID_SH(id))) + } else { + call dcvvector (ID_CV(id), PIXDATA(id,1), FITDATA(id,1), + ID_NPTS(id)) + if (FITDATA(id,2) > FITDATA(id,1)) { + do i = 3, ID_NPTS(id) + if (FITDATA(id,i) < FITDATA(id,i-1)) + call error (1, "Coordinate solution is not monotonic") + } else { + do i = 3, ID_NPTS(id) + if (FITDATA(id,i) > FITDATA(id,i-1)) + call error (1, "Coordinate solution is not monotonic") + } + if (ID_UN(id) == NULL) { + call gt_sets (ID_GT(id), GTXLABEL, LABEL(ID_SH(id))) + call gt_sets (ID_GT(id), GTXUNITS, UNITS(ID_SH(id))) + } else { + call gt_sets (ID_GT(id), GTXLABEL, UN_LABEL(ID_UN(id))) + call gt_sets (ID_GT(id), GTXUNITS, UN_UNITS(ID_UN(id))) + } + } + if (ID_SHIFT(id) != 0.) + call aaddkd (FITDATA(id,1), ID_SHIFT(id), FITDATA(id,1),ID_NPTS(id)) + +end + + +# ID_FITFEATURES -- Compute fit coordinates for features. + +procedure id_fitfeatures (id) + +pointer id # ID pointer +int i + +double id_fitpt() + +begin + if (ID_NFEATURES(id) < 1) + return + + if (ID_CV(id) == NULL) + do i = 1, ID_NFEATURES(id) + FIT(id,i) = id_fitpt (id, PIX(id,i)) + else { + call dcvvector (ID_CV(id), PIX(id,1), FIT(id,1), ID_NFEATURES(id)) + if (ID_SHIFT(id) != 0.) + call aaddkd (FIT(id,1), ID_SHIFT(id), FIT(id,1), ID_NFEATURES(id)) + } +end + + +# ID_FITPT -- Compute fit coordinates from pixel coordinates. + +double procedure id_fitpt (id, pix) + +pointer id # ID pointer +double pix # Pixel coordinate + +double fit + +double smw_c1trand(), shdr_lw(), dcveval() + +begin + if (ID_CV(id) == NULL) { + fit = smw_c1trand (ID_PL(id), pix) + fit = shdr_lw (ID_SH(id), fit) + } else + fit = dcveval (ID_CV(id), pix) + fit = fit + ID_SHIFT(id) + + return (fit) +end + + +# FIT_TO_PIX -- Transform fit coordinate to pixel coordinate. + +define DXMIN .01 + +double procedure fit_to_pix (id, fitcoord) + +pointer id # ID pointer +double fitcoord # Fit coordinate to be transformed +double pixcoord # Pixel coordinate returned + +int i, np1 +double dx + +int dcvstati() +double shdr_wl(), smw_c1trand(), id_fitpt() + +begin + if (ID_CV(id) == NULL) { + pixcoord = fitcoord - ID_SHIFT(id) + pixcoord = shdr_wl (ID_SH(id), pixcoord) + pixcoord = smw_c1trand (ID_LP(id), pixcoord) + return (pixcoord) + } + + np1 = NP1(ID_SH(id)) - 1 + if (dcvstati (ID_CV(id), CVORDER) == 2) { + i = dcvstati (ID_CV(id), CVTYPE) + if (i == LEGENDRE || i == CHEBYSHEV) { + dx = FITDATA(id,1) + pixcoord = (fitcoord - dx) / (FITDATA(id,2) - dx) + 1 + np1 + pixcoord = smw_c1trand (ID_LP(id), pixcoord) + return (pixcoord) + } + } + + if (FITDATA(id,1) < FITDATA(id,ID_NPTS(id))) { + if ((fitcoord<FITDATA(id,1)) || (fitcoord>FITDATA(id,ID_NPTS(id)))) + return (INDEFD) + + for (i = 1; fitcoord > FITDATA(id,i); i = i + 1) + ; + + if (FITDATA(id,i) == fitcoord) + return (PIXDATA(id,i)) + + pixcoord = smw_c1trand (ID_LP(id), double(i+np1-.5)) + dx = smw_c1trand (ID_LP(id), double(i+np1+.5)) - pixcoord + while (dx > DXMIN) { + dx = dx / 2 + if (id_fitpt (id, pixcoord) < fitcoord) + pixcoord = pixcoord + dx + else + pixcoord = pixcoord - dx + } + } else { + if ((fitcoord<FITDATA(id,ID_NPTS(id))) || (fitcoord>FITDATA(id,1))) + return (INDEFD) + + for (i = 1; fitcoord < FITDATA(id,i); i = i + 1) + ; + + if (FITDATA(id,i) == fitcoord) + return (PIXDATA(id,i)) + + pixcoord = smw_c1trand (ID_LP(id), double(i+np1-.5)) + dx = smw_c1trand (ID_LP(id), double(i+np1+.5)) - pixcoord + while (dx > DXMIN) { + dx = dx / 2 + if (id_fitpt (id, pixcoord) < fitcoord) + pixcoord = pixcoord - dx + else + pixcoord = pixcoord + dx + } + } + + return (pixcoord) +end diff --git a/noao/onedspec/identify/idgdata.x b/noao/onedspec/identify/idgdata.x new file mode 100644 index 00000000..92bd65eb --- /dev/null +++ b/noao/onedspec/identify/idgdata.x @@ -0,0 +1,67 @@ +include <imhdr.h> +include <imio.h> +include <pkg/gtools.h> +include <smw.h> +include <units.h> +include "identify.h" + +define SZ_TITLE 320 # Size of long string for title. + +# ID_GDATA -- Get image data. + +procedure id_gdata (id) + +pointer id # ID pointer + +int i, np1 +pointer sp, str, im, mw, sh + +double smw_c1trand() +errchk shdr_open + +begin + call smark (sp) + call salloc (str, SZ_TITLE, TY_CHAR) + + sh = ID_SH(id) + im = IM(sh) + mw = MW(sh) + + # If format is multispec then header info depends on line. + if (SMW_FORMAT(mw) == SMW_ES || SMW_FORMAT(mw) == SMW_MS) + ID_LINE(id,2) = 1 + call shdr_open (im, mw, ID_LINE(id,1), ID_LINE(id,2), + INDEFI, SHDATA, sh) + if (ID_UN(id) != NULL) { + iferr (call shdr_units (sh, UN_UNITS(ID_UN(id)))) + ; + } + ID_AP(id,1) = AP(sh) + ID_AP(id,2) = ID_LINE(id,2) + ID_NPTS(id) = SN(sh) + call id_dbsection (id, ID_IMAGE(id), ID_AP(id,1), + ID_SECTION(id), ID_LENSTRING) + call sprintf (Memc[str], SZ_TITLE, "identify %s%s\n%s") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + call pargstr (TITLE(sh)) + call gt_sets (ID_GT(id), GTTITLE, Memc[str]) + + # Free previous vectors and allocate new vectors. + call mfree (ID_PIXDATA(id), TY_DOUBLE) + + call malloc (ID_PIXDATA(id), ID_NPTS(id), TY_DOUBLE) + + # Set the physical coordinates. + np1 = NP1(sh) - 1 + do i = 1, ID_NPTS(id) + PIXDATA(id,i) = smw_c1trand (ID_LP(id), double(i+np1)) + + # Set the image data + ID_IMDATA(id) = SY(sh) + + ID_NEWGRAPH(id) = YES + ID_NEWCV(id) = YES + + call sfree (sp) +end diff --git a/noao/onedspec/identify/idgraph.x b/noao/onedspec/identify/idgraph.x new file mode 100644 index 00000000..2c38efb4 --- /dev/null +++ b/noao/onedspec/identify/idgraph.x @@ -0,0 +1,111 @@ +include <gset.h> +include <pkg/gtools.h> +include <smw.h> +include "identify.h" + +# ID_GRAPH -- Graph image vector in which features are to be identified. + +procedure id_graph (id, gtype) + +pointer id # ID pointer +int gtype # Graph type + +begin + switch (gtype) { + case 1: + call id_graph1 (id) + case 2: + call id_graph2 (id) + default: + call id_graph1 (id) + } +end + + +procedure id_graph1 (id) + +pointer id # ID pointer + +int i, n +real xmin, xmax, ymin, ymax, dy, gt_getr() +pointer sh, x, y + +begin + sh = ID_SH(id) + call malloc (x, SN(sh), TY_REAL) + y = SY(sh) + n = SN(sh) + + call achtdr (FITDATA(id,1), Memr[x], n) + + call gclear (ID_GP(id)) + xmin = min (Memr[x], Memr[x+n-1]) + xmax = max (Memr[x], Memr[x+n-1]) + ymin = gt_getr (ID_GT(id), GTXMIN) + ymax = gt_getr (ID_GT(id), GTXMAX) + if ((!IS_INDEF(ymin) && xmax<ymin) || (!IS_INDEF(ymax) && xmin>ymax)) { + call gt_setr (ID_GT(id), GTXMIN, INDEF) + call gt_setr (ID_GT(id), GTXMAX, INDEF) + } + call alimr (Memr[y], n, ymin, ymax) + dy = ymax - ymin + call gswind (ID_GP(id), xmin, xmax, ymin - .2 * dy, ymax + .2 * dy) + call gt_swind (ID_GP(id), ID_GT(id)) + call gt_labax (ID_GP(id), ID_GT(id)) + call gt_plot (ID_GP(id), ID_GT(id), Memr[x], Memr[y], n) + + do i = 1, ID_NFEATURES(id) + call id_mark (id, i) + + call mfree (x, TY_REAL) +end + + +# ID_GRAPH2 -- Make review graph for current feature. + +procedure id_graph2 (id) + +pointer id # ID pointer + +int i, j, k, n +real xmin, xmax, ymin, ymax, dy +pointer sh, x, y + +begin + sh = ID_SH(id) + call malloc (x, SN(sh), TY_REAL) + y = SY(sh) + n = SN(sh) + + call achtdr (FITDATA(id,1), Memr[x], n) + + xmin = real (FIT(id,ID_CURRENT(id))) - ID_ZWIDTH(id) / 2. + xmax = real (FIT(id,ID_CURRENT(id))) + ID_ZWIDTH(id) / 2. + + i = 0 + do k = 1, n { + if ((Memr[x+k-1] < xmin) || (Memr[x+k-1] > xmax)) + next + if (i == 0) + i = k + j = k + } + k = j - i + 1 + + call alimr (Memr[y+i-1], k, ymin, ymax) + dy = ymax - ymin + + call gclear (ID_GP(id)) + call gswind (ID_GP(id), xmin, xmax, ymin - .2 * dy, ymax + .2 * dy) +# if (ID_GT(id) != NULL) { +# call gseti (ID_GP(id), G_XTRAN, GT_XTRAN(ID_GT(id))) +# call gseti (ID_GP(id), G_YTRAN, GT_YTRAN(ID_GT(id))) +# } + call gt_labax (ID_GP(id), ID_GT(id)) + call gt_plot (ID_GP(id), ID_GT(id), Memr[x], Memr[y], n) + + do i = 1, ID_NFEATURES(id) + call id_mark (id, i) + + call mfree (x, TY_REAL) +end diff --git a/noao/onedspec/identify/ididentify.x b/noao/onedspec/identify/ididentify.x new file mode 100644 index 00000000..1b13643c --- /dev/null +++ b/noao/onedspec/identify/ididentify.x @@ -0,0 +1,631 @@ +include <error.h> +include <imhdr.h> +include <gset.h> +include <smw.h> +include "identify.h" + +define HELP "noao$onedspec/identify/identify.key" +define ICFITHELP "noao$lib/scr/idicgfit.key" +define PROMPT "identify options" + +define PAN 1 # Pan graph +define ZOOM 2 # Zoom graph + +# ID_IDENTIFY -- Identify features in an image. +# This is the main interactive loop. + +procedure id_identify (id) + +pointer id # ID pointer + +real wx, wy +int wcs, key +char cmd[SZ_LINE] + +char newimage[SZ_FNAME] +int i, j, last, all, prfeature, nfeatures1, npeaks, newline[2] +bool answer +double pix, fit, user, shift, pix_shift, z_shift +pointer peaks, label, aid, stp, sid + +bool clgetb(), aid_autoid() +pointer gopen(), id_getap(), sthead(), stnext() +int clgcur(), scan(), nscan(), id_peaks(), errcode(), strncmp +double id_center(), fit_to_pix(), id_fitpt(), id_shift(), id_rms() +errchk id_gdata(), id_graph(), id_dbread(), xt_mk1d() + +define newim_ 10 +define newkey_ 20 +define beep_ 99 + +begin +newim_ + # Open the image and return if there is an error. + iferr (call id_map (id)) { + call erract (EA_WARN) + return + } + + # Get the image data and return if there is an error. + iferr (call id_gdata (id)) { + call erract (EA_WARN) + return + } + + # Get the database entry for the image if it exists. + iferr { + call id_dbread (id, ID_IMAGE(id), ID_AP(id,1), NO, YES) + ID_NEWDBENTRY(id) = NO + } then + if ((ID_NFEATURES(id) > 0) || (ID_CV(id) != NULL)) + ID_NEWDBENTRY(id) = YES + + # Set the coordinate information. + iferr (call id_fitdata (id)) + ; + + # Set fitting limits. + call ic_putr (ID_IC(id), "xmin", real (PIXDATA(id,1))) + call ic_putr (ID_IC(id), "xmax", real (PIXDATA(id,ID_NPTS(id)))) + call ic_pstr (ID_IC(id), "help", ICFITHELP) + + # Open graphics. + call clgstr ("graphics", newimage, SZ_FNAME) + ID_GP(id) = gopen (newimage, NEW_FILE, STDGRAPH) + + # Initialize. + ID_GTYPE(id) = PAN + all = 0 + last = ID_CURRENT(id) + newimage[1] = EOS + newline[1] = ID_LINE(id,1) + newline[2] = ID_LINE(id,2) + ID_REFIT(id) = NO + ID_NEWFEATURES(id) = NO + ID_NEWCV(id) = NO + wy = INDEF + key = 'r' + + repeat { + prfeature = YES + if (all != 0) + all = mod (all + 1, 3) + + switch (key) { + case '?': # Print help + call gpagefile (ID_GP(id), HELP, PROMPT) + case ':': # Process colon commands + if (cmd[1] == '/') + call gt_colon (cmd, ID_GP(id), ID_GT(id), ID_NEWGRAPH(id)) + else + call id_colon (id, cmd, newimage, prfeature) + case ' ': # Go to current feature + case '.': # Go to nearest feature + if (ID_NFEATURES(id) == 0) + goto beep_ + call id_nearest (id, double (wx)) + case '-': # Go to previous feature + if (ID_CURRENT(id) == 1) + goto beep_ + ID_CURRENT(id) = ID_CURRENT(id) - 1 + case '+', 'n': # Go to next feature + if (ID_CURRENT(id) == ID_NFEATURES(id)) + goto beep_ + ID_CURRENT(id) = ID_CURRENT(id) + 1 + case 'a': # Set all flag for next key + all = 1 + case 'b': # Autoidentify + call aid_init (aid, "aidpars") + call aid_sets (aid, "crval", "CL crval") + call aid_sets (aid, "cdelt", "CL cdelt") + if (aid_autoid (id, aid)) { + ID_NEWCV(id) = YES + ID_NEWFEATURES(id) = YES + ID_NEWGRAPH(id) = YES + } else { + prfeature = 0 + call printf ("No solution found\n") + } + call aid_free (aid) + case 'c': # Recenter features + if (all != 0) { + for (i = 1; i <= ID_NFEATURES(id); i = i + 1) { + call gseti (ID_GP(id), G_PLTYPE, 0) + call id_mark (id, i) + call gseti (ID_GP(id), G_PLTYPE, 1) + FWIDTH(id,i) = ID_FWIDTH(id) + PIX(id,i) = id_center (id, PIX(id,i), FWIDTH(id,i), + FTYPE(id,i)) + if (!IS_INDEFD (PIX(id,i))) { + FIT(id,i) = id_fitpt (id, PIX(id,i)) + call id_mark (id, i) + } else { + call id_delete (id, i) + i = i - 1 + } + } + ID_NEWFEATURES(id) = YES + } else { + if (ID_NFEATURES(id) < 1) + goto beep_ + call id_nearest (id, double (wx)) + pix = PIX(id,ID_CURRENT(id)) + pix = id_center (id, pix, ID_FWIDTH(id), + FTYPE(id,ID_CURRENT(id))) + if (!IS_INDEFD (pix)) { + call gseti (ID_GP(id), G_PLTYPE, 0) + call id_mark (id, ID_CURRENT(id)) + PIX(id,ID_CURRENT(id)) = pix + FWIDTH(id,ID_CURRENT(id)) = ID_FWIDTH(id) + FIT(id,ID_CURRENT(id)) = id_fitpt (id, pix) + call gseti (ID_GP(id), G_PLTYPE, 1) + call id_mark (id, ID_CURRENT(id)) + ID_NEWFEATURES(id) = YES + } else { + call printf ("Centering failed\n") + prfeature = NO + } + } + case 'd': # Delete features + if (all != 0) { + ID_NFEATURES(id) = 0 + ID_CURRENT(id) = 0 + ID_NEWFEATURES(id) = YES + ID_NEWGRAPH(id) = YES + } else { + if (ID_NFEATURES(id) < 1) + goto beep_ + call id_nearest (id, double (wx)) + call gseti (ID_GP(id), G_PLTYPE, 0) + call id_mark (id, ID_CURRENT(id)) + call gseti (ID_GP(id), G_PLTYPE, 1) + call id_delete (id, ID_CURRENT(id)) + ID_CURRENT(id) = min (ID_NFEATURES(id), ID_CURRENT(id)) + last = 0 + } + case 'e': # Find features from line list with no fitting + call id_linelist (id) + if (ID_NEWFEATURES(id) == YES) + ID_NEWGRAPH(id) = YES + case 'f': # Fit dispersion function + call id_dofit (id, YES) + case 'g': # Fit shift + call id_doshift (id, YES) + prfeature = NO + case 'i': # Initialize + call dcvfree (ID_CV(id)) + ID_SHIFT(id) = 0. + ID_NEWCV(id) = YES + ID_NFEATURES(id) = 0 + ID_CURRENT(id) = 0 + ID_NEWFEATURES(id) = YES + ID_NEWGRAPH(id) = YES + case 'j': # Go to previous line + newline[1] = ID_LINE(id,1) - ID_NSUM(id,1) + if (newline[1] < 1) { + newline[1] = newline[1] + ID_MAXLINE(id,1) + newline[2] = ID_LINE(id,2) - ID_NSUM(id,2) + if (newline[2] < 1) + newline[2] = newline[2] + ID_MAXLINE(id,2) + } + case 'k': # Go to next line + newline[1] = ID_LINE(id,1) + ID_NSUM(id,1) + if (newline[1] > ID_MAXLINE(id,1)) { + newline[1] = newline[1] - ID_MAXLINE(id,1) + newline[2] = ID_LINE(id,2) + ID_NSUM(id,2) + if (newline[2] > ID_MAXLINE(id,2)) + newline[2] = newline[2] - ID_MAXLINE(id,2) + } + case 'l': # Find features from line list + if (ID_NFEATURES(id) >= 2) + call id_dofit (id, NO) + if (ID_NEWCV(id) == YES) { + iferr (call id_fitdata(id)) + ; + call id_fitfeatures(id) + ID_NEWCV(id) = NO + } + call id_linelist (id) + if (ID_NEWFEATURES(id) == YES) + ID_REFIT(id) = YES + case 'm': # Mark new feature + fit = wx + pix = fit_to_pix (id, fit) + pix = id_center (id, pix, ID_FWIDTH(id), ID_FTYPE(id)) + if (IS_INDEFD (pix)) { + prfeature = NO + call printf ("Center not found: check cursor position") + if (ID_THRESHOLD(id) > 0.) + call printf (" and threshold value") + goto beep_ + } + fit = id_fitpt (id, pix) + user = fit + call id_newfeature (id, pix, fit, user, 1.0D0, ID_FWIDTH(id), + ID_FTYPE(id), NULL) + USER(id,ID_CURRENT(id)) = INDEFD + call id_match (id, FIT(id,ID_CURRENT(id)), + USER(id,ID_CURRENT(id)), + Memi[ID_LABEL(id)+ID_CURRENT(id)-1], ID_MATCH(id)) + call id_mark (id, ID_CURRENT(id)) + call printf ("%10.2f %10.8g (%10.8g %s): ") + call pargd (PIX(id,ID_CURRENT(id))) + call pargd (FIT(id,ID_CURRENT(id))) + call pargd (USER(id,ID_CURRENT(id))) + label = Memi[ID_LABEL(id)+ID_CURRENT(id)-1] + if (label != NULL) + call pargstr (Memc[label]) + else + call pargstr ("") + call flush (STDOUT) + if (scan() != EOF) { + call gargd (user) + call gargwrd (cmd, SZ_LINE) + i = nscan() + if (i > 0) { + USER(id,ID_CURRENT(id)) = user + call id_match (id, user, USER(id,ID_CURRENT(id)), + Memi[ID_LABEL(id)+ID_CURRENT(id)-1], ID_MATCH(id)) + } + if (i > 1) { + call reset_scan () + call gargd (user) + call gargstr (cmd, SZ_LINE) + call id_label (cmd, Memi[ID_LABEL(id)+ID_CURRENT(id)-1]) + } + } + case 'o': # Go to a specified line + call printf ("Line/Column/Band (%d %d): ") + call pargi (ID_LINE(id,1)) + call pargi (ID_LINE(id,2)) + call flush (STDOUT) + if (scan() != EOF) { + call gargi (j) + if (nscan() == 1) { + if (j < 1 || j > ID_MAXLINE(id,1)) + goto beep_ + newline[1] = j + call gargi (j) + if (nscan() == 2) { + if (j < 1 || j > ID_MAXLINE(id,2)) + goto beep_ + newline[2] = j + } + } + } + case 'p': # Switch to pan mode + if (ID_GTYPE(id) != PAN) { + ID_GTYPE(id) = PAN + ID_NEWGRAPH(id) = YES + } + case 'q': # Exit loop + break + case 'r': # Redraw the graph + ID_NEWGRAPH(id) = YES + case 's', 'x': # Shift or correlate features + # Get coordinate shift. + switch (key) { + case 's': + call printf ("User coordinate (%10.8g): ") + call pargr (wx) + call flush (STDOUT) + if (scan() != EOF) { + call gargd (user) + if (nscan() == 1) + shift = wx - user + } else + shift = 0. + case 'x': + shift = id_shift (id, -1D0, -0.05D0) + if (IS_INDEFD(shift)) { + call printf ("No solution found\n") + goto beep_ + } + } + + ID_NEWFEATURES(id) = YES + ID_NEWCV(id) = YES + ID_NEWGRAPH(id) = YES + prfeature = NO + + if (ID_NFEATURES(id) < 1) { + call printf ("User coordinate shift=%5f\n") + call pargd (shift) + ID_SHIFT(id) = ID_SHIFT(id) + shift + goto newkey_ + } + + # Recenter features. + pix_shift = 0. + z_shift = 0. + nfeatures1 = ID_NFEATURES(id) + + j = 0. + do i = 1, ID_NFEATURES(id) { + pix = fit_to_pix (id, FIT(id,i) + shift) + pix = id_center (id, pix, FWIDTH(id,i), FTYPE(id,i)) + if (IS_INDEFD (pix)) { + if (ID_CURRENT(id) == i) + ID_CURRENT(id) = i + 1 + next + } + fit = id_fitpt (id, pix) + + pix_shift = pix_shift + pix - PIX(id,i) + if (FIT(id,i) != 0.) + z_shift = z_shift + (fit - FIT(id,i)) / FIT(id,i) + + j = j + 1 + PIX(id,j) = pix + FIT(id,j) = FIT(id,i) + USER(id,j) = USER(id,i) + WTS(id,j) = WTS(id,i) + FWIDTH(id,j) = FWIDTH(id,i) + FTYPE(id,j) = FTYPE(id,i) + if (ID_CURRENT(id) == i) + ID_CURRENT(id) = j + } + if (j != ID_NFEATURES(id)) { + ID_NFEATURES(id) = j + ID_CURRENT(id) = min (ID_CURRENT(id), ID_NFEATURES(id)) + } + + if (ID_NFEATURES(id) < 1) { + call printf ("User coordinate shift=%5f") + call pargd (shift) + call printf (", No features found during recentering\n") + ID_SHIFT(id) = ID_SHIFT(id) + shift + goto newkey_ + } + + # Adjust shift. + pix = ID_SHIFT(id) + call id_doshift (id, NO) + call id_fitfeatures (id) + + # Print results. + call printf ("Recentered=%d/%d") + call pargi (ID_NFEATURES(id)) + call pargi (nfeatures1) + call printf ( + ", pixel shift=%.2f, user shift=%5f, z=%7.3g, rms=%5g\n") + call pargd (pix_shift / ID_NFEATURES(id)) + call pargd (pix - ID_SHIFT(id)) + call pargd (z_shift / ID_NFEATURES(id)) + call pargd (id_rms(id)) + case 't': # Move the current feature + if (ID_CURRENT(id) < 1) + goto beep_ + pix = fit_to_pix (id, double (wx)) + call gseti (ID_GP(id), G_PLTYPE, 0) + call id_mark (id, ID_CURRENT(id)) + PIX(id,ID_CURRENT(id)) = pix + FIT(id,ID_CURRENT(id)) = id_fitpt (id, pix) + call gseti (ID_GP(id), G_PLTYPE, 1) + call id_mark (id, ID_CURRENT(id)) + ID_NEWFEATURES(id) = YES + case 'u': # Set user coordinate + if (ID_NFEATURES(id) < 1) + goto beep_ + call printf ("%10.2f %10.8g (%10.8g %s): ") + call pargd (PIX(id,ID_CURRENT(id))) + call pargd (FIT(id,ID_CURRENT(id))) + call pargd (USER(id,ID_CURRENT(id))) + label = Memi[ID_LABEL(id)+ID_CURRENT(id)-1] + if (label != NULL) + call pargstr (Memc[label]) + else + call pargstr ("") + call flush (STDOUT) + if (scan() != EOF) { + call gargd (user) + call gargwrd (cmd, SZ_LINE) + i = nscan() + if (i > 0) { + USER(id,ID_CURRENT(id)) = user + ID_NEWFEATURES(id) = YES + } + if (i > 1) { + call reset_scan () + call gargd (user) + call gargstr (cmd, SZ_LINE) + call id_label (cmd, Memi[ID_LABEL(id)+ID_CURRENT(id)-1]) + } + } + case 'v': # Modify weight + if (ID_NFEATURES(id) < 1) + goto beep_ + call printf ("Weight (%d): ") + call pargd (WTS(id,ID_CURRENT(id))) + call flush (STDOUT) + if (scan() != EOF) { + call gargi (i) + if (nscan() > 0) { + WTS(id,ID_CURRENT(id)) = i + ID_NEWFEATURES(id) = YES + } + } + case 'w': # Window graph + call gt_window (ID_GT(id), ID_GP(id), "cursor", ID_NEWGRAPH(id)) + case 'y': # Find peaks + call malloc (peaks, ID_NPTS(id), TY_REAL) + npeaks = id_peaks (id, IMDATA(id,1), Memr[peaks], ID_NPTS(id), + 0., int (ID_MINSEP(id)), 0, ID_MAXFEATURES(id), 0., false) + for (j = 1; j <= ID_NFEATURES(id); j = j + 1) { + for (i = 1; i <= npeaks; i = i + 1) { + if (!IS_INDEF (Memr[peaks+i-1])) { + pix = Memr[peaks+i-1] + if (abs (pix - PIX(id,j)) < ID_MINSEP(id)) + Memr[peaks+i-1] = INDEF + } + } + } + for (i = 1; i <= npeaks; i = i + 1) { + if (IS_INDEF(Memr[peaks+i-1])) + next + pix = Memr[peaks+i-1] + pix = id_center (id, pix, ID_FWIDTH(id), ID_FTYPE(id)) + if (IS_INDEFD (pix)) + next + fit = id_fitpt (id, pix) + user = INDEFD + call id_match (id, fit, user, label, ID_MATCH(id)) + call id_newfeature (id, pix, fit, user, 1.0D0, + ID_FWIDTH(id), ID_FTYPE(id), label) + call id_mark (id, ID_CURRENT(id)) + } + call mfree (peaks, TY_REAL) + case 'z': # Go to zoom mode + if (ID_NFEATURES(id) < 1) + goto beep_ + if (ID_GTYPE(id) == PAN) + ID_NEWGRAPH(id) = YES + ID_GTYPE(id) = ZOOM + call id_nearest (id, double (wx)) + case 'I': + call fatal (0, "Interrupt") + default: +beep_ call printf ("\007") + } + +newkey_ + # Set update flag if anything has changed. + if ((ID_NEWFEATURES(id) == YES) || (ID_NEWCV(id) == YES)) + ID_NEWDBENTRY(id) = YES + + # If a new image exit loop, update database, and start over. + if (newimage[1] != EOS) + break + + # If a new line, save features and set new line. + if (newline[1] != ID_LINE(id,1) || newline[2] != ID_LINE(id,2)) { + call id_saveap (id) + ID_LINE(id,1) = newline[1] + ID_LINE(id,2) = newline[2] + call id_gdata (id) + if (id_getap (id) == NULL) { + iferr { + call id_dbread (id, ID_IMAGE(id), ID_AP(id,1), + NO, NO) + ID_NEWDBENTRY(id) = NO + ID_NEWFEATURES(id) = NO + } then + if ((ID_NFEATURES(id) > 0) || (ID_CV(id) != NULL)) + ID_NEWDBENTRY(id) = YES + } + ID_NEWCV(id) = YES + ID_NEWGRAPH(id) = YES + wy = INDEF + } + + # Refit dispersion function + if (ID_REFIT(id) == YES) { + call id_dofit (id, NO) + ID_REFIT(id) = NO + } + + # If there is a new dispersion solution evaluate the coordinates + if (ID_NEWCV(id) == YES) { + iferr (call id_fitdata (id)) + ; + call id_fitfeatures (id) + ID_NEWCV(id) = NO + } + + # Draw new graph in zoom mode if current feature has changed. + if ((ID_GTYPE(id) == ZOOM) && (last != ID_CURRENT(id))) + ID_NEWGRAPH(id) = YES + + # Draw new graph. + if (ID_NEWGRAPH(id) == YES) { + call id_graph (id, ID_GTYPE(id)) + ID_NEWGRAPH(id) = NO + } + + # Set cursor and print status of current feature (unless canceled). + if (ID_CURRENT(id) > 0) { + if (IS_INDEF (wy)) { + i = max (1, min (ID_NPTS(id), int (PIX(id,ID_CURRENT(id))))) + wy = IMDATA(id,i) + } + + call gscur (ID_GP(id), real (FIT(id,ID_CURRENT(id))), wy) + if (errcode() == OK && prfeature == YES) { + call printf ("%10.2f %10.8g %10.8g %s\n") + call pargd (PIX(id,ID_CURRENT(id))) + call pargd (FIT(id,ID_CURRENT(id))) + call pargd (USER(id,ID_CURRENT(id))) + if (Memi[ID_LABEL(id)+ID_CURRENT(id)-1] != NULL) + call pargstr ( + Memc[Memi[ID_LABEL(id)+ID_CURRENT(id)-1]]) + else + call pargstr ("") + } + } + + # Print delayed error message + if (errcode() != OK) + call erract (EA_WARN) + + last = ID_CURRENT(id) + } until (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF) + call gclose (ID_GP(id)) + + # Warn user that feature data is newer than database entry. + if (ID_NEWDBENTRY(id) == YES) + answer = true + else { + answer = false + stp = ID_STP(id) + for (sid=sthead(stp); sid!=NULL; sid=stnext(stp,sid)) { + if (strncmp (ID_SAVEID(sid), "aperture", 8) != 0) + next + if (ID_NEWDBENTRY(sid) == YES) { + answer = true + break + } + } + } + if (answer) { + if (!clgetb ("autowrite")) { + call printf ("Write feature data to the database (yes)? ") + call flush (STDOUT) + if (scan() != EOF) + call gargb (answer) + } + if (answer) { + newline[1] = ID_LINE(id,1) + newline[2] = ID_LINE(id,2) + if (ID_NEWDBENTRY(id) == YES) + call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO) + stp = ID_STP(id) + for (sid=sthead(stp); sid!=NULL; sid=stnext(stp, sid)) { + if (strncmp (ID_SAVEID(sid), "aperture", 8) != 0) + next + if (ID_NEWDBENTRY(sid) == YES && + (ID_LINE(sid,1) != newline[1] || + ID_LINE(sid,2) != newline[2])) { + call id_gid (id, sid) + call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO) + } + } + } + } + + call flush (STDOUT) + + # Free image data. + call mfree (ID_PIXDATA(id), TY_DOUBLE) + call mfree (ID_FITDATA(id), TY_DOUBLE) + call id_free1 (id) + + call smw_close (MW(ID_SH(id))) + call imunmap (IM(ID_SH(id))) + call shdr_close (ID_SH(id)) + + # If a new image was requested with colon command start over. + if (newimage[1] != EOS) { + call strcpy (newimage, ID_IMAGE(id), ID_LENSTRING) + goto newim_ + } +end diff --git a/noao/onedspec/identify/idinit.x b/noao/onedspec/identify/idinit.x new file mode 100644 index 00000000..128f0cc0 --- /dev/null +++ b/noao/onedspec/identify/idinit.x @@ -0,0 +1,368 @@ +include <gset.h> +include <math/curfit.h> +include "identify.h" + +# ID_INIT -- Allocate identify structure + +procedure id_init (id) + +pointer id #O ID pointer + +pointer stopen() +errchk stopen + +begin + call calloc (id, ID_LENSTRUCT, TY_STRUCT) + + ID_NALLOC(id) = 20 + ID_NFEATURES(id) = 0 + ID_CURRENT(id) = 0 + ID_DT(id) = NULL + ID_STP(id) = stopen ("identify", 100, 10*ID_LENSTRUCT, 10*SZ_LINE) + + if (ID_NALLOC(id) > 0) { + call malloc (ID_PIX(id), ID_NALLOC(id), TY_DOUBLE) + call malloc (ID_FIT(id), ID_NALLOC(id), TY_DOUBLE) + call malloc (ID_USER(id), ID_NALLOC(id), TY_DOUBLE) + call malloc (ID_WTS(id), ID_NALLOC(id), TY_DOUBLE) + call malloc (ID_FWIDTHS(id), ID_NALLOC(id), TY_REAL) + call malloc (ID_FTYPES(id), ID_NALLOC(id), TY_INT) + call calloc (ID_LABEL(id), ID_NALLOC(id), TY_POINTER) + } +end + + +# ID_FREE -- Free identify structure. + +procedure id_free (id) + +pointer id #I ID pointer + +int i +pointer ptr + +begin + if (id == NULL) + return + + call id_free1 (id) + + call mfree (ID_APS(id), TY_INT) + + ptr = ID_LABEL(id) + do i = 1, ID_NFEATURES(id) { + call mfree (Memi[ptr], TY_CHAR) + ptr = ptr + 1 + } + + call mfree (ID_PIX(id), TY_DOUBLE) + call mfree (ID_FIT(id), TY_DOUBLE) + call mfree (ID_USER(id), TY_DOUBLE) + call mfree (ID_WTS(id), TY_DOUBLE) + call mfree (ID_FWIDTHS(id), TY_REAL) + call mfree (ID_FTYPES(id), TY_INT) + call mfree (ID_LABEL(id), TY_POINTER) + + if (ID_DT(id) != NULL) + call dtunmap (ID_DT(id)) + call id_unmapll (id) + call stclose (ID_STP(id)) + call gt_free (ID_GT(id)) + call dcvfree (ID_CV(id)) + call ic_closed (ID_IC(id)) + if (ID_UN(id) != NULL) + call un_close (ID_UN(id)) + + call mfree (id, TY_STRUCT) +end + + +# ID_FREE1 -- Free saved identify structures. + +procedure id_free1 (id) + +pointer id # ID pointer + +int i +pointer stp, sid, ptr, sthead(), stnext(), stopen() + +begin + stp = ID_STP(id) + for (sid = sthead(stp); sid != NULL; sid = stnext (stp, sid)) { + ptr = ID_LABEL(sid) + do i = 1, ID_NFEATURES(sid) { + call mfree (Memi[ptr], TY_CHAR) + ptr = ptr + 1 + } + + call mfree (ID_PIX(sid), TY_DOUBLE) + call mfree (ID_FIT(sid), TY_DOUBLE) + call mfree (ID_USER(sid), TY_DOUBLE) + call mfree (ID_WTS(sid), TY_DOUBLE) + call mfree (ID_FWIDTHS(sid), TY_REAL) + call mfree (ID_FTYPES(sid), TY_INT) + call mfree (ID_LABEL(sid), TY_POINTER) + if (ID_CV(sid) != NULL) + call dcvfree (ID_CV(sid)) + if (ID_IC(sid) != NULL) + call ic_closed (ID_IC(sid)) + } + if (sthead(stp) != NULL) { + call stclose (stp) + ID_STP(id) = stopen ("identify", 100, 10*ID_LENSTRUCT, 10*SZ_LINE) + } +end + + +# ID_SAVEID -- Save identify information by key. + +procedure id_saveid (id, key) + +pointer id #I IDENTIFY structure +char key[ARB] #I Key to use in saving information + +pointer sid, stfind(), stenter() + +begin + sid = stfind (ID_STP(id), key) + if (sid == NULL) { + sid = stenter (ID_STP(id), key, ID_LENSTRUCT) + call aclri (Memi[sid], ID_LENSTRUCT) + } + call strcpy (key, ID_SAVEID(id), ID_LENSTRING) + call id_sid (id, sid) +end + + +# ID_GETID -- Get saved identify information by key. +# Return NULL if not found. + +pointer procedure id_getid (id, key) + +pointer id #I IDENTIFY structure +char key[ARB] #I Key to use in saving information + +int sid, stfind() + +begin + sid = stfind (ID_STP(id), key) + if (sid != NULL) + call id_gid (id, sid) + + return (sid) +end + + +# ID_SAVEAP -- Save identify information by aperture. + +procedure id_saveap (id) + +pointer id # IDENTIFY structure + +begin + call sprintf (ID_SAVEID(id), ID_LENSTRING, "aperture %d %d") + call pargi (ID_AP(id,1)) + call pargi (ID_AP(id,2)) + call id_saveid (id, ID_SAVEID(id)) +end + + +# ID_GETAP -- Get saved identify information by aperture. +# Return NULL if not found. + +pointer procedure id_getap (id) + +pointer id # IDENTIFY structure + +int sid, stfind() + +begin + call sprintf (ID_SAVEID(id), ID_LENSTRING, "aperture %d %d") + call pargi (ID_AP(id,1)) + call pargi (ID_AP(id,2)) + + # Check if saved. + sid = stfind (ID_STP(id), ID_SAVEID(id)) + if (sid != NULL) + call id_gid (id, sid) + + return (sid) +end + + +# ID_SID -- Save parts of IDENTIFY structure. + +procedure id_sid (id, sid) + +pointer id #I IDENTIFY structure +pointer sid #I IDENTIFY save structure + +int i, j, dcvstati(), strlen() +pointer sp, coeffs, ptr1, ptr2 + +begin + if (sid == NULL) + return + + # Allocate or reallocate memory for features and copy them. + if (ID_NFEATURES(id) > 0) { + if (ID_NALLOC(sid) == 0) { + call malloc (ID_PIX(sid), ID_NFEATURES(id), TY_DOUBLE) + call malloc (ID_FIT(sid), ID_NFEATURES(id), TY_DOUBLE) + call malloc (ID_USER(sid), ID_NFEATURES(id), TY_DOUBLE) + call malloc (ID_WTS(sid), ID_NFEATURES(id), TY_DOUBLE) + call malloc (ID_FWIDTHS(sid), ID_NFEATURES(id), TY_REAL) + call malloc (ID_FTYPES(sid), ID_NFEATURES(id), TY_INT) + call calloc (ID_LABEL(sid), ID_NFEATURES(id), TY_POINTER) + } else if (ID_NALLOC(sid) != ID_NFEATURES(id)) { + call realloc (ID_PIX(sid), ID_NFEATURES(id), TY_DOUBLE) + call realloc (ID_FIT(sid), ID_NFEATURES(id), TY_DOUBLE) + call realloc (ID_USER(sid), ID_NFEATURES(id), TY_DOUBLE) + call realloc (ID_WTS(sid), ID_NFEATURES(id), TY_DOUBLE) + call realloc (ID_FWIDTHS(sid), ID_NFEATURES(id), TY_REAL) + call realloc (ID_FTYPES(sid), ID_NFEATURES(id), TY_INT) + call realloc (ID_LABEL(sid), ID_NFEATURES(id), TY_POINTER) + + j = ID_NALLOC(sid) + i = ID_NFEATURES(id) - j + if (i > 0) + call aclri (Memi[ID_LABEL(sid)+j], i) + } + call amovd (PIX(id,1), PIX(sid,1), ID_NFEATURES(id)) + call amovd (FIT(id,1), FIT(sid,1), ID_NFEATURES(id)) + call amovd (USER(id,1), USER(sid,1), ID_NFEATURES(id)) + call amovd (WTS(id,1), WTS(sid,1), ID_NFEATURES(id)) + call amovr (FWIDTH(id,1), FWIDTH(sid,1), ID_NFEATURES(id)) + call amovi (FTYPE(id,1), FTYPE(sid,1), ID_NFEATURES(id)) + + ptr1 = ID_LABEL(id) + ptr2 = ID_LABEL(sid) + do i = 1, ID_NFEATURES(id) { + call mfree (Memi[ptr2], TY_CHAR) + if (Memi[ptr1] != NULL) { + j = strlen (Memc[Memi[ptr1]]) + call malloc (Memi[ptr2], j, TY_CHAR) + call strcpy (Memc[Memi[ptr1]], Memc[Memi[ptr2]], j) + } + ptr1 = ptr1 + 1 + ptr2 = ptr2 + 1 + } + + ID_NALLOC(sid) = ID_NFEATURES(id) + } + + # Use a SAVE and RESTORE to copy the CURFIT data. + if (ID_CV(sid) != NULL) + call dcvfree (ID_CV(sid)) + if (ID_CV(id) != NULL) { + call smark (sp) + i = dcvstati (ID_CV(id), CVNSAVE) + call salloc (coeffs, i, TY_DOUBLE) + call dcvsave (ID_CV(id), Memd[coeffs]) + call dcvrestore (ID_CV(sid), Memd[coeffs]) + call sfree (sp) + + if (ID_IC(sid) == NULL) + call ic_open (ID_IC(sid)) + call ic_copy (ID_IC(id), ID_IC(sid)) + } + + call strcpy (ID_SAVEID(id), ID_SAVEID(sid), ID_LENSTRING) + ID_LINE(sid,1) = ID_LINE(id,1) + ID_LINE(sid,2) = ID_LINE(id,2) + ID_AP(sid,1) = ID_AP(id,1) + ID_AP(sid,2) = ID_AP(id,2) + ID_NFEATURES(sid) = ID_NFEATURES(id) + ID_SHIFT(sid) = ID_SHIFT(id) + ID_CURRENT(sid) = ID_CURRENT(id) + + ID_NEWFEATURES(sid) = ID_NEWFEATURES(id) + ID_NEWCV(sid) = ID_NEWCV(id) + ID_NEWDBENTRY(sid) = ID_NEWDBENTRY(id) +end + + +# ID_GID -- Restore saved identify information. + +procedure id_gid (id, sid) + +pointer id #I IDENTIFY structure +int sid #I IDENTIFY save structure + +int i, j, dcvstati(), strlen() +pointer sp, coeffs, ptr1, ptr2 + +begin + if (sid == NULL) + return + + # Reallocate memory for features and copy them. + if (ID_NFEATURES(sid) > 0) { + if (ID_NALLOC(sid) != ID_NALLOC(id)) { + call realloc (ID_PIX(id), ID_NALLOC(sid), TY_DOUBLE) + call realloc (ID_FIT(id), ID_NALLOC(sid), TY_DOUBLE) + call realloc (ID_USER(id), ID_NALLOC(sid), TY_DOUBLE) + call realloc (ID_WTS(id), ID_NALLOC(sid), TY_DOUBLE) + call realloc (ID_FWIDTHS(id), ID_NALLOC(sid), TY_REAL) + call realloc (ID_FTYPES(id), ID_NALLOC(sid), TY_INT) + call realloc (ID_LABEL(id), ID_NALLOC(sid), TY_POINTER) + + j = ID_NALLOC(id) + i = ID_NALLOC(sid) - j + if (i > 0) + call aclri (Memi[ID_LABEL(id)+j], i) + } + call amovd (PIX(sid,1), PIX(id,1), ID_NFEATURES(sid)) + call amovd (FIT(sid,1), FIT(id,1), ID_NFEATURES(sid)) + call amovd (USER(sid,1), USER(id,1), ID_NFEATURES(sid)) + call amovd (WTS(sid,1), WTS(id,1), ID_NFEATURES(sid)) + call amovr (FWIDTH(sid,1), FWIDTH(id,1), ID_NFEATURES(sid)) + call amovi (FTYPE(sid,1), FTYPE(id,1), ID_NFEATURES(sid)) + + ptr1 = ID_LABEL(sid) + ptr2 = ID_LABEL(id) + do i = 1, ID_NFEATURES(sid) { + call mfree (Memi[ptr2], TY_CHAR) + if (Memi[ptr1] != NULL) { + j = strlen (Memc[Memi[ptr1]]) + call malloc (Memi[ptr2], j, TY_CHAR) + call strcpy (Memc[Memi[ptr1]], Memc[Memi[ptr2]], j) + } + ptr1 = ptr1 + 1 + ptr2 = ptr2 + 1 + } + + ID_NALLOC(id) = ID_NALLOC(sid) + ID_NFEATURES(id) = ID_NFEATURES(sid) + ID_NEWFEATURES(id) = ID_NEWFEATURES(sid) + ID_CURRENT(id) = ID_CURRENT(sid) + ID_NEWDBENTRY(id) = ID_NEWDBENTRY(sid) + } + + # Use a SAVE and RESTORE to copy the CURFIT data. + ID_SHIFT(id) = ID_SHIFT(sid) + if (ID_CV(sid) != NULL) { + if (ID_CV(id) != NULL) + call dcvfree (ID_CV(id)) + call smark (sp) + i = dcvstati (ID_CV(sid), CVNSAVE) + call salloc (coeffs, i, TY_DOUBLE) + call dcvsave (ID_CV(sid), Memd[coeffs]) + call dcvrestore (ID_CV(id), Memd[coeffs]) + call sfree (sp) + + call ic_copy (ID_IC(sid), ID_IC(id)) + + ID_NEWCV(id) = ID_NEWCV(sid) + ID_NEWDBENTRY(id) = ID_NEWDBENTRY(sid) + + call id_fitdata (id) + call id_fitfeatures (id) + } + + call strcpy (ID_SAVEID(sid), ID_SAVEID(id), ID_LENSTRING) + ID_LINE(id,1) = ID_LINE(sid,1) + ID_LINE(id,2) = ID_LINE(sid,2) + ID_AP(id,1) = ID_AP(sid,1) + ID_AP(id,2) = ID_AP(sid,2) +end diff --git a/noao/onedspec/identify/idlabel.x b/noao/onedspec/identify/idlabel.x new file mode 100644 index 00000000..cb5fa439 --- /dev/null +++ b/noao/onedspec/identify/idlabel.x @@ -0,0 +1,30 @@ +define SKIP ($1==' '||$1=='\t'||$1=='"'||$1=='\'') + +# ID_LABEL -- Set label + +procedure id_label (str, label) + +char str[ARB] # String to be set +pointer label # Label pointer to be set + +int i, j, strlen() +pointer cp + +begin + call mfree (label, TY_CHAR) + + for (i=1; str[i]!=EOS && SKIP(str[i]); i=i+1) + ; + for (j=strlen(str); j>=i && SKIP(str[j]); j=j-1) + ; + + if (i <= j) { + call malloc (label, j-i+1, TY_CHAR) + cp = label + for (; i<=j; i=i+1) { + Memc[cp] = str[i] + cp = cp + 1 + } + Memc[cp] = EOS + } +end diff --git a/noao/onedspec/identify/idlinelist.x b/noao/onedspec/identify/idlinelist.x new file mode 100644 index 00000000..d7772a40 --- /dev/null +++ b/noao/onedspec/identify/idlinelist.x @@ -0,0 +1,385 @@ +include <error.h> +include <mach.h> +include <units.h> +include "identify.h" + +# ID_MAPLL -- Read the line list into memory. +# Convert to desired units. + +procedure id_mapll (id) + +pointer id # Identify structure + +int i, j, fd, nalloc, nlines +pointer ll, lll, ill +pointer sp, str, units +double value + +bool streq(), fp_equald() +int open(), fscan(), nscan(), nowhite(), id_compare() +pointer un_open() +errchk open, fscan, malloc, realloc, un_open +extern id_compare() + +begin + call id_unmapll (id) + + if (nowhite (ID_COORDLIST(id), ID_COORDLIST(id), ID_LENSTRING) == 0) + return + iferr (fd = open (ID_COORDLIST(id), READ_ONLY, TEXT_FILE)) { + call erract (EA_WARN) + return + } + + ID_COORDSPEC(id) = EOS + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (units, SZ_LINE, TY_CHAR) + call strcpy ("Angstroms", Memc[units], SZ_LINE) + nalloc = 0 + nlines = 0 + while (fscan (fd) != EOF) { + call gargwrd (Memc[str], SZ_LINE) + if (nscan() != 1) + next + if (Memc[str] == '#') { + call gargwrd (Memc[str], SZ_LINE) + call strlwr (Memc[str]) + if (streq (Memc[str], "spectrum")) + call gargwrd (ID_COORDSPEC(id), ID_LENSTRING) + if (streq (Memc[str], "units")) { + call gargstr (Memc[units], SZ_LINE) + call xt_stripwhite (Memc[units]) + } + next + } + call reset_scan () + + call gargd (value) + if (nscan() != 1) + next + + if (nalloc == 0) { + nalloc = 100 + call malloc (ll, nalloc, TY_DOUBLE) + call calloc (lll, nalloc, TY_POINTER) + } else if (nlines == nalloc) { + nalloc = nalloc + 100 + call realloc (ll, nalloc, TY_DOUBLE) + call realloc (lll, nalloc, TY_POINTER) + call aclri (Memi[lll+nalloc-100], 100) + } + + Memd[ll+nlines] = value + call gargstr (Memc[str], SZ_LINE) + call id_label (Memc[str], Memi[lll+nlines]) + + nlines = nlines + 1 + } + call close (fd) + + # Sort the lines, eliminate identical lines, and convert units. + if (nlines > 0) { + call malloc (ID_LL(id), nlines + 1, TY_DOUBLE) + call malloc (ID_LLL(id), nlines + 1, TY_POINTER) + + call malloc (ill, nlines, TY_INT) + do i = 0, nlines-1 + Memi[ill+i] = i + call gqsort (Memi[ill], nlines, id_compare, ll) + + Memd[ID_LL(id)] = Memd[ll+Memi[ill]] + Memi[ID_LLL(id)] = Memi[lll+Memi[ill]] + j = 1 + do i = 1, nlines-1 { + if (fp_equald (Memd[ll+Memi[ill+i]], Memd[ID_LL(id)+j-1])) + next + Memd[ID_LL(id)+j] = Memd[ll+Memi[ill+i]] + Memi[ID_LLL(id)+j] = Memi[lll+Memi[ill+i]] + j = j + 1 + } + Memd[ID_LL(id)+j] = INDEFD + ID_NLL(id) = j + + call mfree (ll, TY_DOUBLE) + call mfree (lll, TY_POINTER) + call mfree (ill, TY_INT) + + if (ID_UN(id) == NULL && Memc[units] != EOS) + ID_UN(id) = un_open (Memc[units]) + call id_unitsll (id, Memc[units]) + } + + call sfree (sp) +end + + +# ID_UNMAPLL -- Unmap the linelist. + +procedure id_unmapll (id) + +pointer id # Identify structure + +pointer lll + +begin + if (ID_LL(id) == NULL) + return + + do lll = ID_LLL(id), ID_LLL(id)+ID_NLL(id)-1 + call mfree (Memi[lll], TY_CHAR) + + call mfree (ID_LL(id), TY_DOUBLE) + call mfree (ID_LLL(id), TY_POINTER) +end + + +# ID_UNITSLL -- Change the line list units from the input units to the +# units given by ID_UN. This may involve reversing the order of the list. + +procedure id_unitsll (id, units) + +pointer id # Identify structure +char units[ARB] # Input units + +int i, nll +double value +pointer un, ll, lll, llend, lllend, un_open() +bool un_compare() +errchk un_open + +begin + if (ID_LL(id) == NULL) + return + if (ID_NLL(id) < 1) + return + if (units[1] == EOS || ID_UN(id) == NULL) + return + if (UN_CLASS(ID_UN(id)) == UN_UNKNOWN) + return + + un = un_open (units) + if (un_compare (un, ID_UN(id))) { + call un_close (un) + return + } + + ll = ID_LL(id) + lll = ID_LLL(id) + nll = ID_NLL(id) + call un_ctrand (un, ID_UN(id), Memd[ll], Memd[ll], nll) + call un_close (un) + + if (Memd[ll] > Memd[ll+nll-1]) { + llend = ll + nll - 1 + lllend = lll + nll - 1 + do i = 0, nll / 2 - 1 { + value = Memd[ll+i] + Memd[ll+i] = Memd[llend-i] + Memd[llend-i] = value + un = Memi[lll+i] + Memi[lll+i] = Memi[lllend-i] + Memi[lllend-i] = un + } + } +end + + + +# ID_MATCH -- Match current feature against a line list. +# +# This is extremely inefficient. It can be greatly improved. + +procedure id_match (id, in, out, label, diff) + +pointer id # Identify structure +double in # Coordinate to be matched +double out # Matched coordinate +pointer label # Pointer to label +real diff # Maximum difference + +int i, j, nll +double delta +pointer ll +int strlen() + +begin + call mfree (label, TY_CHAR) + + if (ID_LL(id) == NULL) { + out = in + return + } + + if (diff < 0.) + delta = abs (diff * (FITDATA(id,1) - FITDATA(id,ID_NPTS(id))) / + (ID_NPTS(id) - 1)) + else + delta = diff + + ll = ID_LL(id) + nll = ID_NLL(id) + j = max (1, nint (sqrt (real (nll)))) + for (i = 0; i < nll && in > Memd[ll+i]; i = i + j) + ; + for (i = max (0, min (i-1, nll-1)); i > 0 && in < Memd[ll+i]; i = i - 1) + ; + + ll = ll + i + if (i < nll-1) { + if (abs (in - Memd[ll]) > abs (in - Memd[ll+1])) { + i = i + 1 + ll = ll + 1 + } + } + + if (abs (in - Memd[ll]) <= delta) { + out = Memd[ll] + ll = Memi[ID_LLL(id)+i] + if (ll != NULL) { + call malloc (label, strlen (Memc[ll]), TY_CHAR) + call strcpy (Memc[ll], Memc[label], ARB) + } + } +end + +# ID_LINELIST -- Add features from a line list. + +procedure id_linelist (id) + +pointer id # Identify structure + +int i, nfound, nextpix, lastpix, cursave +double cd, pix, fit, fit1, fit2, user, peak, minval, diff, diff1 +pointer sp, pixes, fits, users, labels, ll, lll, label + +double id_center(), fit_to_pix(), id_fitpt(), id_peak(), smw_c1trand() + +int ncandidate, nmatch1, nmatch2 +common /llstat/ ncandidate, nmatch1, nmatch2 + +begin + if (ID_LL(id) == NULL) + return + + call smark (sp) + call salloc (pixes, ID_MAXFEATURES(id), TY_DOUBLE) + call salloc (fits, ID_MAXFEATURES(id), TY_DOUBLE) + call salloc (users, ID_MAXFEATURES(id), TY_DOUBLE) + call salloc (labels, ID_MAXFEATURES(id), TY_POINTER) + + ncandidate = 0 + nmatch1 = 0 + nmatch2 = 0 + nfound = 0 + lastpix = 0 + minval = MAX_REAL + + if (ID_MATCH(id) < 0.) + cd = (FITDATA(id,1) - FITDATA(id,ID_NPTS(id))) / (ID_NPTS(id) - 1) + else + cd = 1 + + fit1 = min (FITDATA(id,1), FITDATA(id,ID_NPTS(id))) + fit2 = max (FITDATA(id,1), FITDATA(id,ID_NPTS(id))) + ll = ID_LL(id) + lll = ID_LLL(id) + while (!IS_INDEFD(Memd[ll])) { + user = Memd[ll] + label = Memi[lll] + ll = ll + 1 + lll = lll + 1 + if (user < fit1) + next + if (user > fit2) + break + + ncandidate = ncandidate + 1 + pix = id_center (id, fit_to_pix (id, user), ID_FWIDTH(id), + ID_FTYPE(id)) + if (!IS_INDEFD(pix)) { + fit = id_fitpt (id, pix) + diff = abs ((fit - user) / cd) + if (diff > abs (ID_MATCH(id))) + next + + nmatch1 = nmatch1 + 1 + if (lastpix > 0) { + if (abs (pix - Memd[pixes+lastpix-1]) < 0.01) { + diff1 = abs (Memd[fits+lastpix-1]-Memd[users+lastpix-1]) + if (diff < diff1) { + Memd[pixes+lastpix-1] = pix + Memd[fits+lastpix-1] = fit + Memd[users+lastpix-1] = user + Memi[labels+lastpix-1] = label + } + next + } + } + + nmatch2 = nmatch2 + 1 + peak = abs (id_peak (id, smw_c1trand (ID_PL(id), pix))) + if (nfound < ID_MAXFEATURES(id)) { + nfound = nfound + 1 + if (peak < minval) { + nextpix = nfound + minval = peak + } + Memd[pixes+nfound-1] = pix + Memd[fits+nfound-1] = fit + Memd[users+nfound-1] = user + Memi[labels+nfound-1] = label + lastpix = nfound + } else if (peak > minval) { + Memd[pixes+nextpix-1] = pix + Memd[fits+nextpix-1] = fit + Memd[users+nextpix-1] = user + Memi[labels+nextpix-1] = label + lastpix = nextpix + + minval = MAX_REAL + do i = 1, nfound { + pix = Memd[pixes+i-1] + peak = abs (id_peak (id, smw_c1trand (ID_PL(id), pix))) + peak = abs (id_peak (id, pix)) + if (peak < minval) { + nextpix = i + minval = peak + } + } + } + } + } + + do i = 1, nfound { + pix = Memd[pixes+i-1] + fit = Memd[fits+i-1] + user = Memd[users+i-1] + label = Memi[labels+i-1] + call id_newfeature (id, pix, fit, user, 1.0D0, ID_FWIDTH(id), + ID_FTYPE(id), label) + if (i == 1) + cursave = ID_CURRENT(id) + } + ID_CURRENT(id) = cursave + + call sfree (sp) +end + + +# ID_COMPARE - Routine to compare line list coordinates for sorting. +# Zero indexing is used. + +int procedure id_compare (ll, x1, x2) + +pointer ll #I Pointer to array of line list coordinates +int x1, x2 #I Indices to array of line list coordinates + +begin + if (Memd[ll+x1] < Memd[ll+x2]) + return (-1) + else if (Memd[ll+x1] > Memd[ll+x2]) + return (1) + else + return (0) +end diff --git a/noao/onedspec/identify/idlog.x b/noao/onedspec/identify/idlog.x new file mode 100644 index 00000000..d893f671 --- /dev/null +++ b/noao/onedspec/identify/idlog.x @@ -0,0 +1,72 @@ +include <time.h> +include "identify.h" + +# ID_LOG -- Write log + +procedure id_log (id, file) + +pointer id # ID pointer +char file[ARB] # Log file + +char str[SZ_TIME] +int i, fd, nrms +double resid, rms + +int open() +long clktime() +errchk open() + +begin + if (ID_NFEATURES(id) == 0) + return + + fd = open (file, APPEND, TEXT_FILE) + + call cnvtime (clktime (0), str, SZ_TIME) + call fprintf (fd, "\n%s\n") + call pargstr (str) + call fprintf (fd, "Features identified in image %s.\n") + call pargstr (ID_IMAGE(id)) + + call fprintf (fd, " %8s %10s %10s %10s %6s %2s %s\n") + call pargstr ("Pixel") + call pargstr ("Fit") + call pargstr ("User") + call pargstr ("Residual") + call pargstr ("Fwidth") + call pargstr ("Wt") + call pargstr ("Label") + + rms = 0. + nrms = 0 + do i = 1, ID_NFEATURES(id) { + call fprintf (fd, "%2d %8.2f %10.8g %10.8g %10.8g %6.2f %2d %s\n") + call pargi (i) + call pargd (PIX(id,i)) + call pargd (FIT(id,i)) + call pargd (USER(id,i)) + if (IS_INDEFD (USER(id,i))) + call pargd (USER(id,i)) + else { + resid = FIT(id,i) - USER(id,i) + call pargd (resid) + if (WTS(id,i) > 0.) { + rms = rms + resid ** 2 + nrms = nrms + 1 + } + } + call pargr (FWIDTH(id,i)) + call pargd (WTS(id,i)) + if (Memi[ID_LABEL(id)+i-1] != NULL) + call pargstr (Memc[Memi[ID_LABEL(id)+i-1]]) + else + call pargstr ("") + } + + if (nrms > 1) { + call fprintf (fd, "RMS = %0.8g\n") + call pargd (sqrt (rms / nrms)) + } + + call close (fd) +end diff --git a/noao/onedspec/identify/idmap.x b/noao/onedspec/identify/idmap.x new file mode 100644 index 00000000..c5f113ff --- /dev/null +++ b/noao/onedspec/identify/idmap.x @@ -0,0 +1,375 @@ +include <ctype.h> +include <imhdr.h> +include <smw.h> +include <units.h> +include "identify.h" + +# Sepcial section words. +define SPECIAL "|first|middle|x|y|z|last|column|line|band|" +define FIRST 1 +define MIDDLE 2 +define X 3 +define Y 4 +define Z 5 +define LAST 6 +define COLUMN 7 +define LINE 8 +define BAND 9 + +# ID_MAP -- Map an image for IDENTIFY/REIDENTIFY +# The image must 1, 2, or 3 dimensional. An image section may be given with +# the image name or with the CL parameter "section". The CL parameter can +# have one of the following formats: +# 1. An IMIO image section +# 2. [line|column|x|y|z] [#|middle|last] [#|middle|last] +# 3. [#|middle|last] [#|middle|last] [line|column|x|y|z] +# where # is a line or column number. The strings may be abbreviated. +# The task returns and error if it cannot map the image or determine +# the 1D line or column desired. + +procedure id_map (id) + +pointer id # IDENTIFY data structure pointer + +int i, j, k, l, a, b, c, x1[3], x2[3], xs[3] +pointer sp, wrd1, wrd2, wrd3, im + +int imaccess(), strdic(), ctoi(), nscan() +pointer immap() +errchk immap, id_maphdr + +begin + # Separate the image name and image section and map the full image. + call imgsection (ID_IMAGE(id), ID_SECTION(id), ID_LENSTRING) + call imgimage (ID_IMAGE(id), ID_IMAGE(id), ID_LENSTRING) + im = immap (ID_IMAGE(id), READ_ONLY, 0) + + # If no image section is found use the "section" parameter. + if (ID_SECTION(id) == EOS && IM_NDIM(im) > 1) { + call clgstr ("section", ID_SECTION(id), ID_LENSTRING) + call xt_stripwhite (ID_SECTION(id)) + + # If not an image section construct one. + if (ID_SECTION(id) != '[') { + call smark (sp) + call salloc (wrd1, SZ_FNAME, TY_CHAR) + call salloc (wrd2, SZ_FNAME, TY_CHAR) + call salloc (wrd3, SZ_FNAME, TY_CHAR) + + call sscan (ID_SECTION(id)) + + # Parse axis and elements. + call gargwrd (Memc[wrd1], SZ_FNAME) + call gargwrd (Memc[wrd2], SZ_FNAME) + call gargwrd (Memc[wrd3], SZ_FNAME) + switch (nscan()) { + case 0: + a = X + b = MIDDLE + c = MIDDLE + case 1: + a = strdic (Memc[wrd1], Memc[wrd1], SZ_FNAME, SPECIAL) + b = MIDDLE + c = MIDDLE + case 2: + a = strdic (Memc[wrd1], Memc[wrd1], SZ_FNAME, SPECIAL) + if (a >= X) + b = strdic (Memc[wrd2], Memc[wrd2], SZ_FNAME, SPECIAL) + else { + b = a + a = strdic (Memc[wrd2], Memc[wrd2], SZ_FNAME, SPECIAL) + call strcpy (Memc[wrd1], Memc[wrd2], SZ_FNAME) + } + c = MIDDLE + call strcpy (Memc[wrd2], Memc[wrd3], SZ_FNAME) + case 3: + a = strdic (Memc[wrd1], Memc[wrd1], SZ_FNAME, SPECIAL) + if (a >= X) { + b = strdic (Memc[wrd2], Memc[wrd2], SZ_FNAME, SPECIAL) + c = strdic (Memc[wrd3], Memc[wrd3], SZ_FNAME, SPECIAL) + } else { + b = a + a = strdic (Memc[wrd2], Memc[wrd2], SZ_FNAME, SPECIAL) + if (a >= X) { + c = strdic (Memc[wrd3], Memc[wrd3],SZ_FNAME,SPECIAL) + call strcpy (Memc[wrd1], Memc[wrd2], SZ_FNAME) + } else { + c = b + b = a + a = strdic (Memc[wrd3], Memc[wrd3],SZ_FNAME,SPECIAL) + call strcpy (Memc[wrd2], Memc[wrd3], SZ_FNAME) + call strcpy (Memc[wrd1], Memc[wrd2], SZ_FNAME) + } + } + } + + switch (a) { + case X, LINE: + i = 1 + j = 2 + k = 3 + case Y, COLUMN: + i = 2 + j = 1 + k = 3 + case Z, BAND: + i = 3 + j = 1 + k = 2 + default: + call imunmap (im) + call error (1, + "Error in section specification or non-unique abbreviation") + } + + switch (b) { + case FIRST: + ID_LINE(id,1) = 1 + case MIDDLE: + ID_LINE(id,1) = (1 + IM_LEN(im,j)) / 2 + case LAST: + ID_LINE(id,1) = IM_LEN(im,j) + default: + l = 1 + if (ctoi (Memc[wrd2], l, ID_LINE(id,1)) == 0) + call error (1, "Error in section specification") + } + + switch (c) { + case FIRST: + ID_LINE(id,2) = 1 + case MIDDLE: + ID_LINE(id,2) = (1 + IM_LEN(im,k)) / 2 + case LAST: + ID_LINE(id,2) = IM_LEN(im,k) + default: + l = 1 + if (ctoi (Memc[wrd3], l, ID_LINE(id,2)) == 0) + call error (1, "Error in section specification") + } + + # Format section. + switch (IM_NDIM(im)) { + case 2: + switch (i) { + case 1: + call sprintf (ID_SECTION(id), ID_LENSTRING, "[*,%d]") + case 2: + call sprintf (ID_SECTION(id), ID_LENSTRING, "[%d,*]") + default: + call error (1, "Error in section specification") + } + call pargi (ID_LINE(id,1)) + case 3: + switch (i) { + case 1: + call sprintf (ID_SECTION(id), ID_LENSTRING, "[*,%d,%d]") + case 2: + call sprintf (ID_SECTION(id), ID_LENSTRING, "[%d,*,%d]") + case 3: + call sprintf (ID_SECTION(id), ID_LENSTRING, "[%d,%d,*]") + } + call pargi (ID_LINE(id,1)) + call pargi (ID_LINE(id,2)) + case 4: + call error (1, "Image dimension greater than 3 not allowed") + } + } + } + + # Parse the image section. + x1[1] = 1; x2[1] = IM_LEN(im,1); xs[1] = 1 + x1[2] = 1; x2[2] = IM_LEN(im,2); xs[2] = 1 + x1[3] = 1; x2[3] = IM_LEN(im,3); xs[3] = 1 + call id_section (ID_SECTION(id), x1, x2, xs, 3) + + # Set the axes. The axis to be identified is the longest one. + i = 1 + if (IM_NDIM(im) > 1 && abs (x1[2]-x2[2]) >= abs (x1[i]-x2[i])) + i = 2 + if (IM_NDIM(im) > 2 && abs (x1[3]-x2[3]) >= abs (x1[i]-x2[i])) + i = 3 + if (IM_NDIM(im) > 3) + call error (1, "Image dimension greater than 3 not allowed") + + switch (i) { + case 1: + j = 2 + k = 3 + case 2: + j = 1 + k = 3 + case 3: + j = 1 + k = 2 + } + + ID_LINE(id,1) = (x1[j] + x2[j]) / 2 + ID_LINE(id,2) = (x1[k] + x2[k]) / 2 + ID_MAXLINE(id,1) = IM_LEN(im, j) + ID_MAXLINE(id,2) = IM_LEN(im, k) + ID_NSUM(id,1) = min (ID_MAXLINE(id,1), ID_NSUM(id,1)) + ID_NSUM(id,2) = min (ID_MAXLINE(id,2), ID_NSUM(id,2)) + call smw_daxis (NULL, NULL, i, ID_NSUM(id,1), ID_NSUM(id,2)) + + call id_maphdr (id, im) + + # Open the image READ_WRITE if possible in order to add REFSPEC. + # This is not done earlier to avoid updating of the WCS. + + call imunmap (im) + if (imaccess (ID_IMAGE(id), READ_WRITE) == YES) + im = immap (ID_IMAGE(id), READ_WRITE, 0) + else + im = immap (ID_IMAGE(id), READ_ONLY, 0) + call id_noextn (ID_IMAGE(id)) + IM(ID_SH(id)) = im +end + + +# ID_MAPHDR -- Map image header. + +procedure id_maphdr (id, im) + +pointer id # ID pointer +pointer im # IMIO pointer + +int i +pointer mw, sh, smw_openim(), smw_sctran() +errchk smw_openim(), shdr_open(), smw_sctran + +begin + mw = smw_openim (im) + if (SMW_TRANS(mw) == YES) { + if (SMW_PAXIS(mw,1) == 1) + call smw_daxis (mw, im, 2, INDEFI, INDEFI) + else + call smw_daxis (mw, im, 1, INDEFI, INDEFI) + call smw_saxes (mw, NULL, im) + } + call shdr_open (im, mw, ID_LINE(id,1), ID_LINE(id,2), + INDEFI, SHHDR, ID_SH(id)) + if (ID_UN(id) != NULL) + iferr (call shdr_units (ID_SH(id), UN_UNITS(ID_UN(id)))) + ; + sh = ID_SH(id) + + if (SMW_FORMAT(mw) == SMW_MS || SMW_FORMAT(mw) == SMW_ES) { + ID_MAXLINE(id,1) = IM_LEN(im,2) + ID_MAXLINE(id,2) = IM_LEN(im,3) + ID_NSUM(id,1) = 1 + ID_NSUM(id,2) = 1 + ID_LINE(id,1) = max (1, min (ID_MAXLINE(id,1), ID_LINE(id,1))) + ID_LINE(id,2) = 1 + call mfree (ID_APS(id), TY_INT) + call malloc (ID_APS(id), ID_MAXLINE(id,1), TY_INT) + do i = 1, ID_MAXLINE(id,1) { + call shdr_open (im, mw, i, 1, INDEFI, SHHDR, sh) + Memi[ID_APS(id)+i-1] = AP(sh) + } + ID_AP(id,1) = Memi[ID_APS(id)+ID_LINE(id,1)-1] + ID_AP(id,2) = 1 + } else { + call mfree (ID_APS(id), TY_INT) + ID_AP(id,1) = ID_LINE(id,1) + ID_AP(id,2) = ID_LINE(id,2) + } + ID_NPTS(id) = IM_LEN(im, SMW_LAXIS(mw,1)) + + # Set logical / physical transformations + i = 2 ** (SMW_PAXIS(mw,1) - 1) + ID_LP(id) = smw_sctran (mw, "logical", "physical", i) + ID_PL(id) = smw_sctran (mw, "physical", "logical", i) +end + + +# ID_SECTION -- Parse an image section into its elements. +# 1. The default values must be set by the caller. +# 2. A null image section is OK. +# 3. The first nonwhitespace character must be '['. +# 4. The last interpreted character must be ']'. +# +# This procedure should be replaced with an IMIO procedure at some +# point. + +procedure id_section (section, x1, x2, xs, ndim) + +char section[ARB] # Image section +int x1[ndim] # Starting pixel +int x2[ndim] # Ending pixel +int xs[ndim] # Step +int ndim # Number of dimensions + +int i, ip, a, b, c, temp, ctoi() +define error_ 99 + +begin + # Decode the section string. + ip = 1 + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == '[') + ip = ip + 1 + else if (section[ip] == EOS) + return + else + goto error_ + + do i = 1, ndim { + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == ']') + break + + # Default values + a = x1[i] + b = x2[i] + c = xs[i] + + # Get a:b:c. Allow notation such as "-*:c" + # (or even "-:c") where the step is obviously negative. + + if (ctoi (section, ip, temp) > 0) { # a + a = temp + if (section[ip] == ':') { + ip = ip + 1 + if (ctoi (section, ip, b) == 0) # a:b + goto error_ + } else + b = a + } else if (section[ip] == '-') { # -* + temp = a + a = b + b = temp + ip = ip + 1 + if (section[ip] == '*') + ip = ip + 1 + } else if (section[ip] == '*') # * + ip = ip + 1 + if (section[ip] == ':') { # ..:step + ip = ip + 1 + if (ctoi (section, ip, c) == 0) + goto error_ + else if (c == 0) + goto error_ + } + if (a > b && c > 0) + c = -c + + x1[i] = a + x2[i] = b + xs[i] = c + + while (IS_WHITE(section[ip])) + ip = ip + 1 + if (section[ip] == ',') + ip = ip + 1 + } + + if (section[ip] != ']') + goto error_ + + return +error_ + call error (0, "Error in image section specification") +end diff --git a/noao/onedspec/identify/idmark.x b/noao/onedspec/identify/idmark.x new file mode 100644 index 00000000..ac888c91 --- /dev/null +++ b/noao/onedspec/identify/idmark.x @@ -0,0 +1,98 @@ +include <gset.h> +include <smw.h> +include "identify.h" + +procedure id_mark (id, feature) + +pointer id # ID pointer +int feature + +int pix, color, markcolor, gstati() +real x, y +real mx, my, x1, x2, y1, y2, tick, gap +pointer sp, format, label, ptr +double smw_c1trand() + +define TICK .03 # Tick size in NDC +define GAP .02 # Gap size in NDC + +begin + call ggwind (ID_GP(id), x1, x2, y1, y2) + + x = FIT(id,feature) + + if ((x < min (x1, x2)) || (x > max (x1, x2))) + return + + pix = smw_c1trand (ID_PL(id), PIX(id,feature)) - NP1(ID_SH(id)) + 1 + pix = max (1, min (pix, ID_NPTS(id)-1)) + + call smark (sp) + call salloc (format, SZ_LINE, TY_CHAR) + call salloc (label, SZ_LINE, TY_CHAR) + switch (FTYPE(id,feature)) { + case EMISSION: + y = max (IMDATA(id,pix), IMDATA(id,pix+1)) + tick = TICK + gap = GAP + call strcpy ("u=180;h=c;v=b;s=0.5", Memc[format], SZ_LINE) + case ABSORPTION: + y = min (IMDATA(id,pix), IMDATA(id,pix+1)) + tick = -TICK + gap = -GAP + call strcpy ("u=0;h=c;v=t;s=0.5", Memc[format], SZ_LINE) + } + + call gctran (ID_GP(id), x, y, mx, my, 1, 0) + call gctran (ID_GP(id), mx, my + gap, x1, y1, 0, 1) + call gctran (ID_GP(id), mx, my + gap + tick, x1, y2, 0, 1) + color = gstati (ID_GP(id), G_PLCOLOR) + markcolor = gstati (ID_GP(id), G_TICKLABELCOLOR) + call gseti (ID_GP(id), G_PLCOLOR, markcolor) + call gline (ID_GP(id), x1, y1, x1, y2) + call gseti (ID_GP(id), G_PLCOLOR, color) + + call gctran (ID_GP(id), mx, my + tick + 2 * gap, x1, y2, 0, 1) + color = gstati (ID_GP(id), G_TXCOLOR) + call gseti (ID_GP(id), G_TXCOLOR, markcolor) + switch (ID_LABELS(id)) { + case 2: + call sprintf (Memc[label], SZ_LINE, "%d") + call pargi (feature) + call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format]) + case 3: + call sprintf (Memc[label], SZ_LINE, "%0.2f") + call pargd (PIX(id,feature)) + call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format]) + case 4: + if (!IS_INDEFD (USER(id,feature))) { + call sprintf (Memc[label], SZ_LINE, "%0.4f") + call pargd (USER(id,feature)) + call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format]) + } + case 5: + label = Memi[ID_LABEL(id)+feature-1] + if (label != NULL) + call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format]) + case 6: + Memc[label] = EOS + ptr = Memi[ID_LABEL(id)+feature-1] + if (!IS_INDEFD (USER(id,feature))) { + if (ptr != NULL) { + call sprintf (Memc[label], SZ_LINE, "%0.4f %s") + call pargd (USER(id,feature)) + call pargstr (Memc[ptr]) + } else { + call sprintf (Memc[label], SZ_LINE, "%0.4f") + call pargd (USER(id,feature)) + } + } else if (ptr != NULL) + call strcpy (Memc[ptr], Memc[label], SZ_LINE) + if (Memc[label] != EOS) + call gtext (ID_GP(id), x1, y2, Memc[label], Memc[format]) + } + call gseti (ID_GP(id), G_TXCOLOR, color) + + call sfree (sp) + call gflush (ID_GP(id)) +end diff --git a/noao/onedspec/identify/idnearest.x b/noao/onedspec/identify/idnearest.x new file mode 100644 index 00000000..41aa4c61 --- /dev/null +++ b/noao/onedspec/identify/idnearest.x @@ -0,0 +1,29 @@ +include "identify.h" + +# ID_NEAREST -- Find the nearest feature to a given coordinate. + +procedure id_nearest (id, fitnear) + +pointer id # ID pointer +double fitnear # Coordinate to find nearest feature + +int i +double delta, delta1 + +begin + if (ID_NFEATURES(id) < 1) { + ID_CURRENT(id) = 0 + return + } + + ID_CURRENT(id) = 1 + delta = abs (FIT(id,1) - fitnear) + + do i = 2, ID_NFEATURES(id) { + delta1 = abs (FIT(id,i) - fitnear) + if (delta1 < delta) { + ID_CURRENT(id) = i + delta = delta1 + } + } +end diff --git a/noao/onedspec/identify/idnewfeature.x b/noao/onedspec/identify/idnewfeature.x new file mode 100644 index 00000000..efa489b4 --- /dev/null +++ b/noao/onedspec/identify/idnewfeature.x @@ -0,0 +1,87 @@ +include <mach.h> +include "identify.h" + +# ID_NEWFEATURE -- Allocate and initialize memory for a new feature. + +procedure id_newfeature (id, pix, fit, user, wt, width, type, label) + +pointer id # ID pointer +double pix # Pixel coordinate +double fit # Fit coordinate +double user # User coordinate +double wt # Feature weight +real width # Feature width +int type # Feature type +pointer label # Pointer to feature label + +int i, current, strlen() +double delta + +define NALLOC 20 # Length of additional allocations + +begin + if (IS_INDEFD (pix)) + return + + delta = MAX_REAL + do i = 1, ID_NFEATURES(id) { + if (abs (pix - PIX(id,i)) < delta) { + delta = abs (pix - PIX(id,i)) + current = i + } + } + + if (delta >= ID_MINSEP(id)) { + ID_NFEATURES(id) = ID_NFEATURES(id) + 1 + if (ID_NALLOC(id) < ID_NFEATURES(id)) { + ID_NALLOC(id) = ID_NALLOC(id) + NALLOC + call realloc (ID_PIX(id), ID_NALLOC(id), TY_DOUBLE) + call realloc (ID_FIT(id), ID_NALLOC(id), TY_DOUBLE) + call realloc (ID_USER(id), ID_NALLOC(id), TY_DOUBLE) + call realloc (ID_WTS(id), ID_NALLOC(id), TY_DOUBLE) + call realloc (ID_FWIDTHS(id), ID_NALLOC(id), TY_REAL) + call realloc (ID_FTYPES(id), ID_NALLOC(id), TY_INT) + call realloc (ID_LABEL(id), ID_NALLOC(id), TY_POINTER) + call aclri (Memi[ID_LABEL(id)+ID_NALLOC(id)-NALLOC], NALLOC) + } + for (current=ID_NFEATURES(id); (current>1)&&(pix<PIX(id,current-1)); + current=current-1) { + PIX(id,current) = PIX(id,current-1) + FIT(id,current) = FIT(id,current-1) + USER(id,current) = USER(id,current-1) + WTS(id,current) = WTS(id,current-1) + FWIDTH(id,current) = FWIDTH(id,current-1) + FTYPE(id,current) = FTYPE(id,current-1) + Memi[ID_LABEL(id)+current-1] = Memi[ID_LABEL(id)+current-2] + } + PIX(id,current) = pix + FIT(id,current) = fit + USER(id,current) = user + WTS(id,current) = wt + FWIDTH(id,current) = width + FTYPE(id,current) = type + if (label != NULL) { + i = strlen (Memc[label]) + call malloc (Memi[ID_LABEL(id)+current-1], i, TY_CHAR) + call strcpy (Memc[label], Memc[Memi[ID_LABEL(id)+current-1]], i) + } else + Memi[ID_LABEL(id)+current-1] = NULL + ID_NEWFEATURES(id) = YES + } else if (abs (fit-user) < abs (FIT(id,current)-USER(id,current))) { + PIX(id,current) = pix + FIT(id,current) = fit + USER(id,current) = user + WTS(id,current) = wt + FWIDTH(id,current) = width + FTYPE(id,current) = type + if (label != NULL) { + i = strlen (Memc[label]) + call malloc (Memi[ID_LABEL(id)+current-1], i, TY_CHAR) + call strcpy (Memc[label], Memc[Memi[ID_LABEL(id)+current-1]], i) + } else + Memi[ID_LABEL(id)+current-1] = NULL + ID_NEWFEATURES(id) = YES + } + + ID_CURRENT(id) = current +end diff --git a/noao/onedspec/identify/idnoextn.x b/noao/onedspec/identify/idnoextn.x new file mode 100644 index 00000000..6c82d778 --- /dev/null +++ b/noao/onedspec/identify/idnoextn.x @@ -0,0 +1,11 @@ +# ID_NOEXTN -- Remove standard image extensions. + +procedure id_noextn (image) + +char image[ARB] # Image name + +int strlen() + +begin + call xt_imroot (image, image, strlen (image)) +end diff --git a/noao/onedspec/identify/idpeak.x b/noao/onedspec/identify/idpeak.x new file mode 100644 index 00000000..c3e7559d --- /dev/null +++ b/noao/onedspec/identify/idpeak.x @@ -0,0 +1,95 @@ +include <smw.h> +include "identify.h" + +# ID_PEAK -- Find the peak value above continuum. + +double procedure id_peak (id, pix) + +pointer id # ID pointer +double pix # Pixel position +double peak # Peak value + +int c, l, u + +begin + if (IS_INDEFD(pix)) + return (INDEFD) + + c = nint (pix) + l = max (1, nint (pix - ID_FWIDTH(id))) + u = min (ID_NPTS(id), nint (pix + ID_FWIDTH(id))) + peak = IMDATA(id,c) - (IMDATA(id,l) + IMDATA(id,u)) / 2. + + return (peak) +end + + +# ID_PEAKS -- Find peaks in the data. This just calls find_peaks but does +# the logical to physical pixel conversion. + +int procedure id_peaks (id, data, x, npoints, contrast, separation, edge, nmax, + threshold, debug) + +pointer id #I Identify pointer +real data[npoints] #I Input data array +real x[npoints] #O Output peak position array +int npoints #I Number of data points +real contrast #I Maximum contrast between strongest and weakest +int separation #I Minimum separation between peaks +int edge #I Minimum distance from the edge +int nmax #I Maximum number of peaks to be returned +real threshold #I Minimum threshold level for peaks +bool debug #I Print diagnostic information? + +int i, n, np1, find_peaks() +double smw_c1trand() +errchk find_peaks + +begin + # Find the peaks in logical coordinates. + n = find_peaks (data, x, npoints, contrast, separation, edge, + nmax, threshold, debug) + + # Convert to physical coordinates. + np1 = NP1(ID_SH(id)) - 1 + do i = 1, n + x[i] = smw_c1trand (ID_LP(id), double (x[i]+np1)) + + return (n) +end + + +# ID_UPEAKS -- Find uniformly distributed peaks in the data. This just calls +# find_upeaks but does the logical to physical pixel conversion. + +int procedure id_upeaks (id, data, x, npoints, contrast, separation, edge, + nmax, nbins, threshold, debug) + +pointer id #I Identify pointer +real data[npoints] #I Input data array +real x[npoints] #O Output peak position array +int npoints #I Number of data points +real contrast #I Maximum contrast between strongest and weakest +int separation #I Minimum separation between peaks +int edge #I Minimum distance from the edge +int nmax #I Maximum number of peaks to be returned +int nbins #I Number of bins across the data array +real threshold #I Minimum threshold level for peaks +bool debug #I Print diagnostic information? + +int i, n, np1, find_upeaks() +double smw_c1trand() +errchk find_upeaks + +begin + # Find the peaks in logical coordinates. + n = find_upeaks (data, x, npoints, contrast, separation, edge, + nmax, nbins, threshold, debug) + + # Convert to physical coordinates. + np1 = NP1(ID_SH(id)) - 1 + do i = 1, n + x[i] = smw_c1trand (ID_LP(id), double (x[i]+np1)) + + return (n) +end diff --git a/noao/onedspec/identify/idrms.x b/noao/onedspec/identify/idrms.x new file mode 100644 index 00000000..82916f1a --- /dev/null +++ b/noao/onedspec/identify/idrms.x @@ -0,0 +1,28 @@ +include "identify.h" + +# ID_RMS -- Compute RMS of fit about the user coordinates + +double procedure id_rms (id) + +pointer id # ID pointer + +int i, nrms +double rms + +begin + rms = 0. + nrms = 0 + for (i=1; i<=ID_NFEATURES(id); i=i+1) { + if (!IS_INDEFD (USER(id,i)) && WTS(id,i) != 0.) { + rms = rms + (FIT(id,i) - USER(id,i)) ** 2 + nrms = nrms + 1 + } + } + + if (nrms > 0) + rms = sqrt (rms / nrms) + else + rms = INDEFD + + return (rms) +end diff --git a/noao/onedspec/identify/idshift.x b/noao/onedspec/identify/idshift.x new file mode 100644 index 00000000..1aedad69 --- /dev/null +++ b/noao/onedspec/identify/idshift.x @@ -0,0 +1,106 @@ +include "identify.h" + +define NBIN 10 # Bin parameter for mode determination + +# ID_SHIFT1 -- Determine a shift by correlating feature user positions +# with peaks in the image data. + +double procedure id_shift1 (id) + +pointer id # ID pointer + +int i, j, npeaks, ndiff, id_peaks() +real d, dmin +double pix, id_center(), id_fitpt() +pointer x, y, diff +errchk malloc, id_peaks + +begin + # Find the peaks in the image data and center. + call malloc (x, ID_NPTS(id), TY_REAL) + npeaks = id_peaks (id, IMDATA(id,1), Memr[x], ID_NPTS(id), 0., + int (ID_MINSEP(id)), 0, ID_MAXFEATURES(id), 0., false) + + # Center the peaks and convert to user coordinates. + call malloc (y, npeaks, TY_DOUBLE) + j = 0 + do i = 1, npeaks { + pix = id_center (id, double(Memr[x+i-1]), ID_FWIDTH(id), + ID_FTYPE(id)) + if (!IS_INDEFD (pix)) { + Memd[y+j] = id_fitpt (id, pix) + j = j + 1 + } + } + npeaks = j + + # Compute differences with feature list. + ndiff = npeaks * ID_NFEATURES(id) + call malloc (diff, ndiff, TY_REAL) + ndiff = 0 + do i = 1, ID_NFEATURES(id) { + do j = 1, npeaks { + Memr[diff+ndiff] = Memd[y+j-1] - FIT(id,i) + ndiff = ndiff + 1 + } + } + call mfree (x, TY_REAL) + call mfree (y, TY_DOUBLE) + + # Sort the differences and find the mode. + call asrtr (Memr[diff], Memr[diff], ndiff) + + dmin = Memr[diff+ndiff-1] - Memr[diff] + do i = 0, ndiff-NBIN-1 { + j = i + NBIN + d = Memr[diff+j] - Memr[diff+i] + if (d < dmin) { + dmin = d + pix = Memr[diff+i] + d / 2. + } + } + call mfree (diff, TY_REAL) + + return (pix) +end + + +# ID_SHIFT -- Determine a shift using the AID_SHIFT algorithm. This +# differs from AID_SHIFT in that the input ID pointer is unchanged +# (same dispersion function and features) but a shift is computed and +# returned. + +double procedure id_shift (id, crsearch cdsearch) + +pointer id #I ID pointer +double crsearch #I Search range +double cdsearch #I Search range + +int marker +double shift, asumd() +pointer new, id_getid() +errchk aid_shift + +begin + call stmark (ID_STP(id), marker) + call id_saveid (id, "backup") + + # Find the shift. + shift = INDEFD + iferr { + call aid_shift (id, crsearch, cdsearch) + call malloc (new, ID_NPTS(id), TY_DOUBLE) + call amovd (FITDATA(id,1), Memd[new], ID_NPTS(id)) + if (id_getid (id, "backup") == NULL) + call error (1, "Error getting saved record") + call asubd (FITDATA(id,1), Memd[new], Memd[new], ID_NPTS(id)) + shift = asumd (Memd[new], ID_NPTS(id)) / ID_NPTS(id) + call mfree (new, TY_DOUBLE) + } then { + if (id_getid (id, "backup") == NULL) + call error (1, "Error getting saved record") + } + + call stfree (ID_STP(id), marker) + return (shift) +end diff --git a/noao/onedspec/identify/idshow.x b/noao/onedspec/identify/idshow.x new file mode 100644 index 00000000..16f4d9df --- /dev/null +++ b/noao/onedspec/identify/idshow.x @@ -0,0 +1,79 @@ +include "identify.h" + +# ID_SHOW -- Show parameter information. + +procedure id_show (id, file) + +pointer id # ID pointer +char file[ARB] # File + +char line[SZ_LINE] +int fd + +int open(), ic_geti() +errchk open() + +begin + fd = open (file, APPEND, TEXT_FILE) + + call sysid (line, SZ_LINE) + call fprintf (fd, "%s\n") + call pargstr (line) + + call fprintf (fd, "image %s\n") + call pargstr (ID_IMAGE(id)) + call fprintf (fd, "nsum %d\n") + call pargi (ID_NSUM(id,1)) + switch (ID_FTYPE(id)) { + case EMISSION: + call fprintf (fd, "ftype emission\n") + case ABSORPTION: + call fprintf (fd, "ftype absorption\n") + } + switch (ID_LABELS(id)) { + case 2: + call fprintf (fd, "labels index\n") + case 3: + call fprintf (fd, "labels pixel\n") + case 4: + call fprintf (fd, "labels coords\n") + case 5: + call fprintf (fd, "labels user\n") + case 6: + call fprintf (fd, "labels both\n") + default: + call fprintf (fd, "labels none\n") + } + call fprintf (fd, "maxfeatures %d\n") + call pargi (ID_MAXFEATURES(id)) + call fprintf (fd, "match %g\n") + call pargr (ID_MATCH(id)) + call fprintf (fd, "zwidth %g\n") + call pargr (ID_ZWIDTH(id)) + call fprintf (fd, "fwidth %g\n") + call pargr (ID_FWIDTH(id)) + call fprintf (fd, "database %s\n") + call pargstr (ID_DATABASE(id)) + call fprintf (fd, "coordlist %s\n") + call pargstr (ID_COORDLIST(id)) + call fprintf (fd, "cradius %g\n") + call pargr (ID_CRADIUS(id)) + call fprintf (fd, "threshold %g\n") + call pargr (ID_THRESHOLD(id)) + call fprintf (fd, "minsep %g\n") + call pargr (ID_MINSEP(id)) + if (ID_CV(id) != NULL) { + call fprintf (fd, "function = %s\n") + call ic_gstr (ID_IC(id), "function", line, SZ_LINE) + call pargstr (line) + call fprintf (fd, "order = %d\n") + call pargi (ic_geti (ID_IC(id), "order")) + call fprintf (fd, "Fit at first pixel = %0.8g\n") + call pargd (FITDATA(id,1)) + call fprintf (fd, "Average fit interval = %0.8g\n") + call pargd ((FITDATA(id,ID_NPTS(id))-FITDATA(id,1))/ + (ID_NPTS(id)-1)) + } + + call close (fd) +end diff --git a/noao/onedspec/identify/mkpkg b/noao/onedspec/identify/mkpkg new file mode 100644 index 00000000..7b568269 --- /dev/null +++ b/noao/onedspec/identify/mkpkg @@ -0,0 +1,48 @@ +# IDENTIFY Task + +$checkout libpkg.a .. +$update libpkg.a +$checkin libpkg.a .. +$exit + +libpkg.a: + @autoid + + $ifeq (USE_GENERIC, yes) + $ifolder (peaks.x, peaks.gx) + $generic -k peaks.gx -o peaks.x $endif $endif + + idcenter.x identify.h <smw.h> + idcolon.x identify.h <error.h> <gset.h> <smw.h> + iddb.x identify.h <imset.h> <math/curfit.h> <pkg/dttext.h>\ + <smw.h> <units.h> + iddelete.x identify.h + iddofit.x identify.h <units.h> + iddoshift.x identify.h + idfitdata.x identify.h <pkg/gtools.h> <smw.h> <units.h>\ + <math/curfit.h> + idgdata.x identify.h <imhdr.h> <imio.h> <pkg/gtools.h> <smw.h>\ + <units.h> + idgraph.x identify.h <gset.h> <pkg/gtools.h> <smw.h> + ididentify.x identify.h <error.h> <gset.h> <imhdr.h> <smw.h> + idinit.x identify.h <gset.h> <math/curfit.h> + idlabel.x + idlinelist.x identify.h <error.h> <mach.h> <units.h> + idlog.x identify.h <time.h> + idmap.x identify.h <ctype.h> <imhdr.h> <smw.h> <units.h> + idmark.x identify.h <gset.h> <smw.h> + idnearest.x identify.h + idnewfeature.x identify.h <mach.h> + idnoextn.x + idpeak.x identify.h <smw.h> + idrms.x identify.h + idshift.x identify.h + idshow.x identify.h + peaks.x + reidentify.x identify.h <error.h> <gset.h> <imhdr.h> + t_autoid.x identify.h <error.h> <fset.h> <gset.h> <pkg/gtools.h>\ + <smw.h> + t_identify.x identify.h <mach.h> <pkg/gtools.h> + t_reidentify.x identify.h <error.h> <fset.h> <gset.h> <pkg/gtools.h>\ + <smw.h> + ; diff --git a/noao/onedspec/identify/peaks.gx b/noao/onedspec/identify/peaks.gx new file mode 100644 index 00000000..571948c6 --- /dev/null +++ b/noao/onedspec/identify/peaks.gx @@ -0,0 +1,578 @@ +# PEAKS -- The following procedures are general numerical functions +# dealing with finding peaks in a data array. +# +# FIND_PEAKS Find the NMAX peaks in the data array. +# FIND_UPEAKS Find the uniformly distrib. peaks in the data array. +# FIND_IPEAKS Find all the isolated peaks in the data array. +# FIND_LOCAL_MAXIMA Find the local maxima in the data array. +# IS_LOCAL_MAX Test a point to determine if it is a local maximum. +# FIND_THRESHOLD Find the peaks with positions satisfying threshold +# and contrast constraints. +# FIND_ISOLATED Flag peaks which are within separation of a peak +# with a higher peak value. +# FIND_NMAX Select up to the nmax highest ranked peaks. +# FIND_UNMAX Select up to the nmax ranked peaks in bins. +# COMPARE Compare procedure for sort used in FIND_PEAKS. + + +# FIND_PEAKS -- Find the NMAX peaks in the data array. +# +# The peaks are found using the following algorithm: +# +# 1. Find the local maxima. +# 2. Reject peaks below the threshold. +# 3. Determine the ranks of the remaining peaks. +# 4. Flag weaker peaks within separation of a stronger peak. +# 5. Accept at most the nmax strongest peaks. +# +# Indefinite points are ignored. The peak positions are returned in the +# array x. + +$for (r) +int procedure find_peaks (data, x, npoints, contrast, separation, edge, nmax, + threshold, debug) + +# Procedure parameters: +PIXEL data[npoints] # Input data array +PIXEL x[npoints] # Output peak position array +int npoints # Number of data points +real contrast # Maximum contrast between strongest and weakest +int separation # Minimum separation between peaks +int edge # Minimum distance from the edge +int nmax # Maximum number of peaks to be returned +real threshold # Minimum threshold level for peaks +bool debug # Print diagnostic information? + +int nrank, npeaks, find_nmax() +pointer rank + +begin + # Find all isolated peaks and their rank. + call find_ipeaks (data, x, npoints, contrast, separation, edge, + threshold, rank, nrank, debug) + + # Select the strongest nmax peaks. + npeaks = find_nmax (data, x, Memi[rank], nrank, nmax, debug) + + call mfree (rank, TY_INT) + return (npeaks) +end + + +# FIND_UPEAKS -- Find the uniformly distrib. peaks in the data array. +# +# The peaks are found using the following algorithm: +# +# 1. Find the local maxima. +# 2. Reject peaks below the threshold. +# 3. Determine the ranks of the remaining peaks. +# 4. Flag weaker peaks within separation of a stronger peak. +# 5. Accept at most the nmax uniformly distributed peaks. +# +# Indefinite points are ignored. The peak positions are returned in the +# array x. + +int procedure find_upeaks (data, x, npoints, contrast, separation, edge, + nmax, nbins, threshold, debug) + +# Procedure parameters: +PIXEL data[npoints] # Input data array +PIXEL x[npoints] # Output peak position array +int npoints # Number of data points +real contrast # Maximum contrast between strongest and weakest +int separation # Minimum separation between peaks +int edge # Minimum distance from the edge +int nmax # Maximum number of peaks to be returned +int nbins # Number of bins across the data array +real threshold # Minimum threshold level for peaks +bool debug # Print diagnostic information? + +int npts, nrank, npeaks, find_unmax() +pointer rank + +begin + npts = npoints + + # Find all isolated peaks and their rank. + call find_ipeaks (data, x, npoints, contrast, separation, edge, + threshold, rank, nrank, debug) + + # Select the peaks. + npeaks = find_unmax (data, npts, x, Memi[rank], nrank, nmax, nbins, + debug) + + call mfree (rank, TY_INT) + return (npeaks) +end + + +# FIND_IPEAKS -- Find the all the isolated peaks in the data array. +# +# The peaks are found using the following algorithm: +# +# 1. Find the local maxima. +# 2. Reject peaks below the threshold. +# 3. Determine the ranks of the remaining peaks. +# 4. Flag weaker peaks within separation of a stronger peak. +# 5. Return a rank array +# +# Indefinite points are ignored. The peak positions are returned in the +# array x. + +procedure find_ipeaks (data, x, npoints, contrast, separation, edge, threshold, + rank, nrank, debug) + +# Procedure parameters: +PIXEL data[npoints] # Input data array +PIXEL x[npoints] # Output peak position array +int npoints # Number of data points +real contrast # Maximum contrast between strongest and weakest +int separation # Minimum separation between peaks +int edge # Minimum distance from the edge +real threshold # Minimum threshold level for peaks +pointer rank # Rank array +int nrank # Size of rank array +bool debug # Print diagnostic information? + +int i, j +int nlmax, nisolated +pointer sp, y + +int find_local_maxima(), find_threshold(), find_isolated() +int compare() + +extern compare() + +common /sort/ y + +begin + # Find the local maxima in data and put column positions in x.. + nlmax = find_local_maxima (data, x, npoints, debug) + + # Reject local maxima near the edge. + if (edge > 0) { + j = 0 + do i = 1, nlmax { + if ((x[i] > edge) && (x[i] <= npoints - edge)) { + j = j + 1 + x[j] = x[i] + } + } + nlmax = j + } + + # Allocate a working array y. + call smark (sp) + call salloc (y, npoints, TY_PIXEL) + + # Reject the local maxima which do not satisfy the thresholds. + # The array y is set to the peak values of the remaining peaks. + nrank = find_threshold (data, x, Mem$t[y], nlmax, + contrast, threshold, debug) + + # Rank the peaks by peak value. + call malloc (rank, nrank, TY_INT) + do i = 1, nrank + Memi[rank + i - 1] = i + call qsort (Memi[rank], nrank, compare) + + # Reject the weaker peaks within sep of a stronger peak. + nisolated = find_isolated (x, Memi[rank], nrank, separation, debug) + + call sfree (sp) +end + + +# FIND_LOCAL_MAXIMA -- Find the local maxima in the data array. +# +# A data array is input and the local maxima positions array is output. +# The number of local maxima found is returned. + +int procedure find_local_maxima (data, x, npoints, debug) + +PIXEL data[npoints] # Input data array +PIXEL x[npoints] # Output local maxima positions array +int npoints # Number of input points +bool debug # Print debugging information? + +int i, nlmax + +bool is_local_max() + +begin + nlmax = 0 + do i = 1, npoints { + if (is_local_max (i, data, npoints)) { + nlmax = nlmax + 1 + x[nlmax] = i + } + } + + if (debug) { + call printf (" Number of local maxima found = %d.\n") + call pargi (nlmax) + } + + return (nlmax) +end + + +# IS_LOCAL_MAX -- Test a point to determine if it is a local maximum. +# +# Indefinite points are ignored. + +bool procedure is_local_max (index, data, npoints) + +# Procedure parameters: +int index # Index to test for local maximum +PIXEL data[npoints] # Data values +int npoints # Number of points in the data vector + +int i, j, nright, nleft + +begin + # INDEF points cannot be local maxima. + if (IS_INDEF (data[index])) + return (FALSE) + + # Find the left and right indices where data values change and the + # number of points with the same value. Ignore INDEF points. + nleft = 0 + for (i = index - 1; i >= 1; i = i - 1) { + if (!IS_INDEF (data[i])) { + if (data[i] != data[index]) + break + nleft = nleft + 1 + } + } + nright = 0 + for (j = index + 1; j <= npoints; j = j + 1) { + if (!IS_INDEF (data[j])) { + if (data[j] != data[index]) + break + nright = nright + 1 + } + } + + # Test for failure to be a local maxima + if ((i == 0) && (j == npoints+1)) { + return (FALSE) # Data is constant + } else if (i == 0) { + if (data[j] > data[index]) + return (FALSE) # Data increases to right + } else if (j == npoints+1) { + if (data[i] > data[index]) # Data increase to left + return (FALSE) + } else if ((data[i] > data[index]) || (data[j] > data[index])) { + return (FALSE) # Not a local maximum + } else if (!((nleft - nright == 0) || (nleft - nright == 1))) { + return (FALSE) # Not center of plateau + } + + # Point is a local maxima + return (TRUE) +end + + +# FIND_THRESHOLD -- Find the peaks with positions satisfying threshold +# and contrast constraints. +# +# The input is the data array, data, and the peak positions array, x. +# The x array is resorted to the nthreshold peaks satisfying the constraints. +# The corresponding nthreshold data values are returned the y array. +# The number of peaks satisfying the constraints (nthreshold) is returned. + +int procedure find_threshold (data, x, y, npoints, contrast, threshold, debug) + +PIXEL data[ARB] # Input data values +PIXEL x[npoints] # Input/Output peak positions +PIXEL y[npoints] # Output peak data values +int npoints # Number of peaks input +real contrast # Contrast constraint +real threshold # Threshold constraint +bool debug # Print debugging information? + +int i, j, nthreshold +PIXEL minval, maxval, lcut + +begin + # Set the y array to be the values at the peak positions. + do i = 1, npoints { + j = x[i] + y[i] = data[j] + } + + # Determine the min and max values of the peaks. + call alim$t (y, npoints, minval, maxval) + + # Set the threshold based on the max of the absolute threshold and the + # contrast. Use arlt to set peaks below threshold to INDEF. + if (!IS_INDEFR(threshold) || !IS_INDEFR(contrast)) { + if (IS_INDEFR(threshold)) + lcut = PIXEL (contrast * maxval) + else if (IS_INDEFR(contrast)) + lcut = PIXEL (threshold) + else + lcut = max (PIXEL (threshold), PIXEL (contrast * maxval)) + call arlt$t (y, npoints, lcut, INDEFR) + } + + if (debug) { + call printf (" Highest peak value = %g.\n") + call parg$t (maxval) + call printf (" Peak cutoff threshold = %g.\n") + call parg$t (lcut) + do i = 1, npoints { + if (IS_INDEF (y[i])) { + j = x[i] + call printf ( + " Peak at column %d with value %g below threshold.\n") + call pargi (j) + call parg$t (data[j]) + } + } + } + + # Determine the number of acceptable peaks & resort the x and y arrays. + nthreshold = 0 + do i = 1, npoints { + if (IS_INDEF (y[i])) + next + nthreshold = nthreshold + 1 + x[nthreshold] = x[i] + y[nthreshold] = y[i] + } + + if (debug) { + call printf (" Number of peaks above the threshold = %d.\n") + call pargi (nthreshold) + } + + return (nthreshold) +end + +# FIND_ISOLATED -- Flag peaks which are within separation of a peak +# with a higher peak value. +# +# The peak positions, x, and their ranks, rank, are input. +# The rank array contains the indices of the peak positions in order from +# the highest peak value to the lowest peak value. Starting with +# highest rank (rank[1]) all peaks of lower rank within separation +# are marked by setting their positions to INDEF. The number of +# unflaged peaks is returned. + +int procedure find_isolated (x, rank, npoints, separation, debug) + +# Procedure parameters: +PIXEL x[npoints] # Positions of points +int rank[npoints] # Rank of peaks +int npoints # Number of peaks +int separation # Minimum allowed separation +bool debug # Print diagnostic information + +int i, j +int nisolated + +begin + # Eliminate close neighbors. The eliminated + # peaks are marked by setting their positions to INDEF. + nisolated = 0 + do i = 1, npoints { + if (IS_INDEF (x[rank[i]])) + next + nisolated = nisolated + 1 + do j = i + 1, npoints { + if (IS_INDEF (x[rank[j]])) + next + if (abs (x[rank[i]] - x[rank[j]]) < separation) { + if (debug) { + call printf ( + " Peak at column %d too near peak at column %d.\n") + call pargi (int (x[rank[j]])) + call pargi (int (x[rank[i]])) + } + x[rank[j]] = INDEF + } + } + } + + if (debug) { + call printf (" Number of peaks separated by %d pixels = %d.\n") + call pargi (separation) + call pargi (nisolated) + } + + # Return number of isolated peaks. + return (nisolated) +end + + +# FIND_NMAX -- Select up to the nmax highest ranked peaks. +# +# The data values, data, peak positions, x, and their ranks, rank, are input. +# The data values are used only in printing debugging information. +# Peak positions previously eliminated are flaged by the value INDEF. +# The rank array contains the indices to the peak positions in order from +# the highest peak value to the lowest peak value. +# First all but the nmax highest ranked peaks (which have not been previously +# eliminated) are eliminated by marking their positions with the value INDEF. +# Then the remaining peaks are resorted to contain only the unflaged +# peaks and the number of such peaks is returned. + +int procedure find_nmax (data, x, rank, npoints, nmax, debug) + +PIXEL data[ARB] # Input data values +PIXEL x[npoints] # Peak positions +int rank[npoints] # Ranks of peaks +int npoints # Number of input peaks +int nmax # Max number of peaks to be selected +bool debug # Print debugging information? + +int i, j, npeaks + +begin + # Only mark peaks to reject if the number peaks is greater than nmax. + if (nmax < npoints) { + npeaks = 0 + do i = 1, npoints { + if (IS_INDEF (x[rank[i]])) + next + npeaks = npeaks + 1 + if (npeaks > nmax) { + if (debug) { + j = x[rank[i]] + call printf ( + " Reject peak at column %d with rank %d and value %g.\n") + call pargi (j) + call pargi (i) + call parg$t (data[j]) + } + x[rank[i]] = INDEF + } + } + } + + # Eliminate INDEF points and determine the number of spectra found. + npeaks = 0 + do i = 1, npoints { + if (IS_INDEF (x[i])) + next + npeaks = npeaks + 1 + x[npeaks] = x[i] + } + + return (npeaks) +end + + +# FIND_UNMAX -- Select up to the nmax highest ranked peaks in bins. +# +# The data values, data, peak positions, x, and their ranks, rank, are input. +# The data values are used only in printing debugging information. +# Peak positions previously eliminated are flaged by the value INDEF. +# The rank array contains the indices to the peak positions in order from +# the highest peak value to the lowest peak value. +# First all but the nmax highest ranked peaks (which have not been previously +# eliminated) are eliminated by marking their positions with the value INDEF. +# Then the remaining peaks are resorted to contain only the unflaged +# peaks and the number of such peaks is returned. + +int procedure find_unmax (data, npts, x, rank, npoints, nmax, nbins, debug) + +PIXEL data[npts] # Input data values +int npts # Number of input data points +PIXEL x[npoints] # Peak positions +int rank[npoints] # Ranks of peaks +int npoints # Number of input peaks +int nmax # Max number of peaks to be selected +int nbins # Number of sample bins +bool debug # Print debugging information? + +int i, j, npeaks, width, x1, x2 +PIXEL a + +begin + # Only mark peaks to reject if the number peaks is greater than nmax. + if (nmax < npoints) { + + # Set up circular bins and select highest peak in each bin + # until the desired number of peaks is selected. + + width = min (npts-1, nint ((npts-1) / (nbins-.5))) + x2 = 1 + npeaks = 0 + repeat { + x1 = x2 + x2 = mod (x1 + width, npts) + 1 + j = 0 + do i = 1, npoints { + a = x[rank[i]] + if (IS_INDEF (a) || a < 0) { + j = j + 1 + next + } + if (x1 < x2) { + if (a >= x1 && a <= x2) { + x[rank[i]] = -a + npeaks = npeaks + 1 + break + } + } else { + if (a <= x2 || a >= x1) { + x[rank[i]] = -a + npeaks = npeaks + 1 + break + } + } + } + } until (npeaks >= nmax || j == npoints) + + # Now eliminate all unused peaks and reset the selected peaks. + do i = 1, npoints { + if (!IS_INDEF (x[i]) && x[i] < 1) + x[i] = -x[i] + else + x[i] = INDEF + } + } + + # Eliminate INDEF points and determine the number of peaks found. + npeaks = 0 + do i = 1, npoints { + if (IS_INDEF (x[i])) + next + npeaks = npeaks + 1 + x[npeaks] = x[i] + } + + return (npeaks) +end + + +# COMPARE -- Compare procedure for sort used in FIND_PEAKS. +# Larger values are indexed first. INDEF values are indexed last. + +int procedure compare (index1, index2) + +# Procedure parameters: +int index1 # Comparison index +int index2 # Comparison index + +pointer y + +common /sort/ y + +begin + # INDEF points are considered to be smallest possible values. + if (IS_INDEF (Mem$t[y - 1 + index1])) + return (1) + else if (IS_INDEF (Mem$t[y - 1 + index2])) + return (-1) + else if (Mem$t[y - 1 + index1] < Mem$t[y - 1 + index2]) + return (1) + else if (Mem$t[y - 1 + index1] > Mem$t[y - 1 + index2]) + return (-1) + else + return (0) +end +$endfor diff --git a/noao/onedspec/identify/peaks.x b/noao/onedspec/identify/peaks.x new file mode 100644 index 00000000..0ebda9f7 --- /dev/null +++ b/noao/onedspec/identify/peaks.x @@ -0,0 +1,578 @@ +# PEAKS -- The following procedures are general numerical functions +# dealing with finding peaks in a data array. +# +# FIND_PEAKS Find the NMAX peaks in the data array. +# FIND_UPEAKS Find the uniformly distrib. peaks in the data array. +# FIND_IPEAKS Find all the isolated peaks in the data array. +# FIND_LOCAL_MAXIMA Find the local maxima in the data array. +# IS_LOCAL_MAX Test a point to determine if it is a local maximum. +# FIND_THRESHOLD Find the peaks with positions satisfying threshold +# and contrast constraints. +# FIND_ISOLATED Flag peaks which are within separation of a peak +# with a higher peak value. +# FIND_NMAX Select up to the nmax highest ranked peaks. +# FIND_UNMAX Select up to the nmax ranked peaks in bins. +# COMPARE Compare procedure for sort used in FIND_PEAKS. + + +# FIND_PEAKS -- Find the NMAX peaks in the data array. +# +# The peaks are found using the following algorithm: +# +# 1. Find the local maxima. +# 2. Reject peaks below the threshold. +# 3. Determine the ranks of the remaining peaks. +# 4. Flag weaker peaks within separation of a stronger peak. +# 5. Accept at most the nmax strongest peaks. +# +# Indefinite points are ignored. The peak positions are returned in the +# array x. + + +int procedure find_peaks (data, x, npoints, contrast, separation, edge, nmax, + threshold, debug) + +# Procedure parameters: +real data[npoints] # Input data array +real x[npoints] # Output peak position array +int npoints # Number of data points +real contrast # Maximum contrast between strongest and weakest +int separation # Minimum separation between peaks +int edge # Minimum distance from the edge +int nmax # Maximum number of peaks to be returned +real threshold # Minimum threshold level for peaks +bool debug # Print diagnostic information? + +int nrank, npeaks, find_nmax() +pointer rank + +begin + # Find all isolated peaks and their rank. + call find_ipeaks (data, x, npoints, contrast, separation, edge, + threshold, rank, nrank, debug) + + # Select the strongest nmax peaks. + npeaks = find_nmax (data, x, Memi[rank], nrank, nmax, debug) + + call mfree (rank, TY_INT) + return (npeaks) +end + + +# FIND_UPEAKS -- Find the uniformly distrib. peaks in the data array. +# +# The peaks are found using the following algorithm: +# +# 1. Find the local maxima. +# 2. Reject peaks below the threshold. +# 3. Determine the ranks of the remaining peaks. +# 4. Flag weaker peaks within separation of a stronger peak. +# 5. Accept at most the nmax uniformly distributed peaks. +# +# Indefinite points are ignored. The peak positions are returned in the +# array x. + +int procedure find_upeaks (data, x, npoints, contrast, separation, edge, + nmax, nbins, threshold, debug) + +# Procedure parameters: +real data[npoints] # Input data array +real x[npoints] # Output peak position array +int npoints # Number of data points +real contrast # Maximum contrast between strongest and weakest +int separation # Minimum separation between peaks +int edge # Minimum distance from the edge +int nmax # Maximum number of peaks to be returned +int nbins # Number of bins across the data array +real threshold # Minimum threshold level for peaks +bool debug # Print diagnostic information? + +int npts, nrank, npeaks, find_unmax() +pointer rank + +begin + npts = npoints + + # Find all isolated peaks and their rank. + call find_ipeaks (data, x, npoints, contrast, separation, edge, + threshold, rank, nrank, debug) + + # Select the peaks. + npeaks = find_unmax (data, npts, x, Memi[rank], nrank, nmax, nbins, + debug) + + call mfree (rank, TY_INT) + return (npeaks) +end + + +# FIND_IPEAKS -- Find the all the isolated peaks in the data array. +# +# The peaks are found using the following algorithm: +# +# 1. Find the local maxima. +# 2. Reject peaks below the threshold. +# 3. Determine the ranks of the remaining peaks. +# 4. Flag weaker peaks within separation of a stronger peak. +# 5. Return a rank array +# +# Indefinite points are ignored. The peak positions are returned in the +# array x. + +procedure find_ipeaks (data, x, npoints, contrast, separation, edge, threshold, + rank, nrank, debug) + +# Procedure parameters: +real data[npoints] # Input data array +real x[npoints] # Output peak position array +int npoints # Number of data points +real contrast # Maximum contrast between strongest and weakest +int separation # Minimum separation between peaks +int edge # Minimum distance from the edge +real threshold # Minimum threshold level for peaks +pointer rank # Rank array +int nrank # Size of rank array +bool debug # Print diagnostic information? + +int i, j +int nlmax, nisolated +pointer sp, y + +int find_local_maxima(), find_threshold(), find_isolated() +int compare() + +extern compare() + +common /sort/ y + +begin + # Find the local maxima in data and put column positions in x.. + nlmax = find_local_maxima (data, x, npoints, debug) + + # Reject local maxima near the edge. + if (edge > 0) { + j = 0 + do i = 1, nlmax { + if ((x[i] > edge) && (x[i] <= npoints - edge)) { + j = j + 1 + x[j] = x[i] + } + } + nlmax = j + } + + # Allocate a working array y. + call smark (sp) + call salloc (y, npoints, TY_REAL) + + # Reject the local maxima which do not satisfy the thresholds. + # The array y is set to the peak values of the remaining peaks. + nrank = find_threshold (data, x, Memr[y], nlmax, + contrast, threshold, debug) + + # Rank the peaks by peak value. + call malloc (rank, nrank, TY_INT) + do i = 1, nrank + Memi[rank + i - 1] = i + call qsort (Memi[rank], nrank, compare) + + # Reject the weaker peaks within sep of a stronger peak. + nisolated = find_isolated (x, Memi[rank], nrank, separation, debug) + + call sfree (sp) +end + + +# FIND_LOCAL_MAXIMA -- Find the local maxima in the data array. +# +# A data array is input and the local maxima positions array is output. +# The number of local maxima found is returned. + +int procedure find_local_maxima (data, x, npoints, debug) + +real data[npoints] # Input data array +real x[npoints] # Output local maxima positions array +int npoints # Number of input points +bool debug # Print debugging information? + +int i, nlmax + +bool is_local_max() + +begin + nlmax = 0 + do i = 1, npoints { + if (is_local_max (i, data, npoints)) { + nlmax = nlmax + 1 + x[nlmax] = i + } + } + + if (debug) { + call printf (" Number of local maxima found = %d.\n") + call pargi (nlmax) + } + + return (nlmax) +end + + +# IS_LOCAL_MAX -- Test a point to determine if it is a local maximum. +# +# Indefinite points are ignored. + +bool procedure is_local_max (index, data, npoints) + +# Procedure parameters: +int index # Index to test for local maximum +real data[npoints] # Data values +int npoints # Number of points in the data vector + +int i, j, nright, nleft + +begin + # INDEF points cannot be local maxima. + if (IS_INDEFR (data[index])) + return (FALSE) + + # Find the left and right indices where data values change and the + # number of points with the same value. Ignore INDEF points. + nleft = 0 + for (i = index - 1; i >= 1; i = i - 1) { + if (!IS_INDEFR (data[i])) { + if (data[i] != data[index]) + break + nleft = nleft + 1 + } + } + nright = 0 + for (j = index + 1; j <= npoints; j = j + 1) { + if (!IS_INDEFR (data[j])) { + if (data[j] != data[index]) + break + nright = nright + 1 + } + } + + # Test for failure to be a local maxima + if ((i == 0) && (j == npoints+1)) { + return (FALSE) # Data is constant + } else if (i == 0) { + if (data[j] > data[index]) + return (FALSE) # Data increases to right + } else if (j == npoints+1) { + if (data[i] > data[index]) # Data increase to left + return (FALSE) + } else if ((data[i] > data[index]) || (data[j] > data[index])) { + return (FALSE) # Not a local maximum + } else if (!((nleft - nright == 0) || (nleft - nright == 1))) { + return (FALSE) # Not center of plateau + } + + # Point is a local maxima + return (TRUE) +end + + +# FIND_THRESHOLD -- Find the peaks with positions satisfying threshold +# and contrast constraints. +# +# The input is the data array, data, and the peak positions array, x. +# The x array is resorted to the nthreshold peaks satisfying the constraints. +# The corresponding nthreshold data values are returned the y array. +# The number of peaks satisfying the constraints (nthreshold) is returned. + +int procedure find_threshold (data, x, y, npoints, contrast, threshold, debug) + +real data[ARB] # Input data values +real x[npoints] # Input/Output peak positions +real y[npoints] # Output peak data values +int npoints # Number of peaks input +real contrast # Contrast constraint +real threshold # Threshold constraint +bool debug # Print debugging information? + +int i, j, nthreshold +real minval, maxval, lcut + +begin + # Set the y array to be the values at the peak positions. + do i = 1, npoints { + j = x[i] + y[i] = data[j] + } + + # Determine the min and max values of the peaks. + call alimr (y, npoints, minval, maxval) + + # Set the threshold based on the max of the absolute threshold and the + # contrast. Use arlt to set peaks below threshold to INDEF. + if (!IS_INDEFR(threshold) || !IS_INDEFR(contrast)) { + if (IS_INDEFR(threshold)) + lcut = real (contrast * maxval) + else if (IS_INDEFR(contrast)) + lcut = real (threshold) + else + lcut = max (real (threshold), real (contrast * maxval)) + call arltr (y, npoints, lcut, INDEFR) + } + + if (debug) { + call printf (" Highest peak value = %g.\n") + call pargr (maxval) + call printf (" Peak cutoff threshold = %g.\n") + call pargr (lcut) + do i = 1, npoints { + if (IS_INDEFR (y[i])) { + j = x[i] + call printf ( + " Peak at column %d with value %g below threshold.\n") + call pargi (j) + call pargr (data[j]) + } + } + } + + # Determine the number of acceptable peaks & resort the x and y arrays. + nthreshold = 0 + do i = 1, npoints { + if (IS_INDEFR (y[i])) + next + nthreshold = nthreshold + 1 + x[nthreshold] = x[i] + y[nthreshold] = y[i] + } + + if (debug) { + call printf (" Number of peaks above the threshold = %d.\n") + call pargi (nthreshold) + } + + return (nthreshold) +end + +# FIND_ISOLATED -- Flag peaks which are within separation of a peak +# with a higher peak value. +# +# The peak positions, x, and their ranks, rank, are input. +# The rank array contains the indices of the peak positions in order from +# the highest peak value to the lowest peak value. Starting with +# highest rank (rank[1]) all peaks of lower rank within separation +# are marked by setting their positions to INDEF. The number of +# unflaged peaks is returned. + +int procedure find_isolated (x, rank, npoints, separation, debug) + +# Procedure parameters: +real x[npoints] # Positions of points +int rank[npoints] # Rank of peaks +int npoints # Number of peaks +int separation # Minimum allowed separation +bool debug # Print diagnostic information + +int i, j +int nisolated + +begin + # Eliminate close neighbors. The eliminated + # peaks are marked by setting their positions to INDEF. + nisolated = 0 + do i = 1, npoints { + if (IS_INDEFR (x[rank[i]])) + next + nisolated = nisolated + 1 + do j = i + 1, npoints { + if (IS_INDEFR (x[rank[j]])) + next + if (abs (x[rank[i]] - x[rank[j]]) < separation) { + if (debug) { + call printf ( + " Peak at column %d too near peak at column %d.\n") + call pargi (int (x[rank[j]])) + call pargi (int (x[rank[i]])) + } + x[rank[j]] = INDEFR + } + } + } + + if (debug) { + call printf (" Number of peaks separated by %d pixels = %d.\n") + call pargi (separation) + call pargi (nisolated) + } + + # Return number of isolated peaks. + return (nisolated) +end + + +# FIND_NMAX -- Select up to the nmax highest ranked peaks. +# +# The data values, data, peak positions, x, and their ranks, rank, are input. +# The data values are used only in printing debugging information. +# Peak positions previously eliminated are flaged by the value INDEF. +# The rank array contains the indices to the peak positions in order from +# the highest peak value to the lowest peak value. +# First all but the nmax highest ranked peaks (which have not been previously +# eliminated) are eliminated by marking their positions with the value INDEF. +# Then the remaining peaks are resorted to contain only the unflaged +# peaks and the number of such peaks is returned. + +int procedure find_nmax (data, x, rank, npoints, nmax, debug) + +real data[ARB] # Input data values +real x[npoints] # Peak positions +int rank[npoints] # Ranks of peaks +int npoints # Number of input peaks +int nmax # Max number of peaks to be selected +bool debug # Print debugging information? + +int i, j, npeaks + +begin + # Only mark peaks to reject if the number peaks is greater than nmax. + if (nmax < npoints) { + npeaks = 0 + do i = 1, npoints { + if (IS_INDEFR (x[rank[i]])) + next + npeaks = npeaks + 1 + if (npeaks > nmax) { + if (debug) { + j = x[rank[i]] + call printf ( + " Reject peak at column %d with rank %d and value %g.\n") + call pargi (j) + call pargi (i) + call pargr (data[j]) + } + x[rank[i]] = INDEFR + } + } + } + + # Eliminate INDEF points and determine the number of spectra found. + npeaks = 0 + do i = 1, npoints { + if (IS_INDEFR (x[i])) + next + npeaks = npeaks + 1 + x[npeaks] = x[i] + } + + return (npeaks) +end + + +# FIND_UNMAX -- Select up to the nmax highest ranked peaks in bins. +# +# The data values, data, peak positions, x, and their ranks, rank, are input. +# The data values are used only in printing debugging information. +# Peak positions previously eliminated are flaged by the value INDEF. +# The rank array contains the indices to the peak positions in order from +# the highest peak value to the lowest peak value. +# First all but the nmax highest ranked peaks (which have not been previously +# eliminated) are eliminated by marking their positions with the value INDEF. +# Then the remaining peaks are resorted to contain only the unflaged +# peaks and the number of such peaks is returned. + +int procedure find_unmax (data, npts, x, rank, npoints, nmax, nbins, debug) + +real data[npts] # Input data values +int npts # Number of input data points +real x[npoints] # Peak positions +int rank[npoints] # Ranks of peaks +int npoints # Number of input peaks +int nmax # Max number of peaks to be selected +int nbins # Number of sample bins +bool debug # Print debugging information? + +int i, j, npeaks, width, x1, x2 +real a + +begin + # Only mark peaks to reject if the number peaks is greater than nmax. + if (nmax < npoints) { + + # Set up circular bins and select highest peak in each bin + # until the desired number of peaks is selected. + + width = min (npts-1, nint ((npts-1) / (nbins-.5))) + x2 = 1 + npeaks = 0 + repeat { + x1 = x2 + x2 = mod (x1 + width, npts) + 1 + j = 0 + do i = 1, npoints { + a = x[rank[i]] + if (IS_INDEFR (a) || a < 0) { + j = j + 1 + next + } + if (x1 < x2) { + if (a >= x1 && a <= x2) { + x[rank[i]] = -a + npeaks = npeaks + 1 + break + } + } else { + if (a <= x2 || a >= x1) { + x[rank[i]] = -a + npeaks = npeaks + 1 + break + } + } + } + } until (npeaks >= nmax || j == npoints) + + # Now eliminate all unused peaks and reset the selected peaks. + do i = 1, npoints { + if (!IS_INDEFR (x[i]) && x[i] < 1) + x[i] = -x[i] + else + x[i] = INDEFR + } + } + + # Eliminate INDEF points and determine the number of peaks found. + npeaks = 0 + do i = 1, npoints { + if (IS_INDEFR (x[i])) + next + npeaks = npeaks + 1 + x[npeaks] = x[i] + } + + return (npeaks) +end + + +# COMPARE -- Compare procedure for sort used in FIND_PEAKS. +# Larger values are indexed first. INDEF values are indexed last. + +int procedure compare (index1, index2) + +# Procedure parameters: +int index1 # Comparison index +int index2 # Comparison index + +pointer y + +common /sort/ y + +begin + # INDEF points are considered to be smallest possible values. + if (IS_INDEFR (Memr[y - 1 + index1])) + return (1) + else if (IS_INDEFR (Memr[y - 1 + index2])) + return (-1) + else if (Memr[y - 1 + index1] < Memr[y - 1 + index2]) + return (1) + else if (Memr[y - 1 + index1] > Memr[y - 1 + index2]) + return (-1) + else + return (0) +end + diff --git a/noao/onedspec/identify/reidentify.x b/noao/onedspec/identify/reidentify.x new file mode 100644 index 00000000..e29fa163 --- /dev/null +++ b/noao/onedspec/identify/reidentify.x @@ -0,0 +1,482 @@ +include <error.h> +include <imhdr.h> +include <gset.h> +include "identify.h" + +define HELP "noao$onedspec/identify/identify.key" +define ICFITHELP "noao$lib/scr/idicgfit.key" +define PROMPT "identify options" + +define PAN 1 # Pan graph +define ZOOM 2 # Zoom graph + +# REIDENTIFY -- Reidentify features in an image. + +procedure reidentify (id) + +pointer id # ID pointer + +real wx, wy +int wcs, key +char cmd[SZ_LINE] + +char newimage[SZ_FNAME] +int i, j, last, all, prfeature, nfeatures1, npeaks +double pix, fit, user, shift, pix_shift, z_shift +pointer peaks, label, aid + +bool aid_autoid() +int clgcur(), scan(), nscan(), id_peaks(), errcode() +double id_center(), fit_to_pix(), id_fitpt(), id_shift(), id_rms() +errchk id_graph() + +define newim_ 10 +define newkey_ 20 +define beep_ 99 + +begin + # Initialize. + if (ID_GP(id) == NULL) + return + ID_GTYPE(id) = PAN + all = 0 + last = ID_CURRENT(id) + newimage[1] = EOS + ID_REFIT(id) = NO + wy = INDEF + key = 'r' + + repeat { + prfeature = YES + if (all != 0) + all = mod (all + 1, 3) + + switch (key) { + case '?': # Print help + call gpagefile (ID_GP(id), HELP, PROMPT) + case ':': # Process colon commands + if (cmd[1] == '/') + call gt_colon (cmd, ID_GP(id), ID_GT(id), ID_NEWGRAPH(id)) + else + call id_colon (id, cmd, newimage, prfeature) + case ' ': # Go to current feature + case '.': # Go to nearest feature + if (ID_NFEATURES(id) == 0) + goto beep_ + call id_nearest (id, double (wx)) + case '-': # Go to previous feature + if (ID_CURRENT(id) == 1) + goto beep_ + ID_CURRENT(id) = ID_CURRENT(id) - 1 + case '+', 'n': # Go to next feature + if (ID_CURRENT(id) == ID_NFEATURES(id)) + goto beep_ + ID_CURRENT(id) = ID_CURRENT(id) + 1 + case 'a': # Set all flag for next key + all = 1 + case 'b': # Autoidentify + call aid_init (aid, "aidpars") + call aid_sets (aid, "crval", "CL crval") + call aid_sets (aid, "cdelt", "CL cdelt") + if (aid_autoid (id, aid)) { + ID_NEWCV(id) = YES + ID_NEWFEATURES(id) = YES + ID_NEWGRAPH(id) = YES + } else { + prfeature = 0 + call printf ("No solution found\n") + } + call aid_free (aid) + case 'c': # Recenter features + if (all != 0) { + for (i = 1; i <= ID_NFEATURES(id); i = i + 1) { + call gseti (ID_GP(id), G_PLTYPE, 0) + call id_mark (id, i) + call gseti (ID_GP(id), G_PLTYPE, 1) + FWIDTH(id,i) = ID_FWIDTH(id) + PIX(id,i) = id_center (id, PIX(id,i), FWIDTH(id,i), + FTYPE(id,i)) + if (!IS_INDEFD (PIX(id,i))) { + FIT(id,i) = id_fitpt (id, PIX(id,i)) + call id_mark (id, i) + } else { + call id_delete (id, i) + i = i - 1 + } + } + ID_NEWFEATURES(id) = YES + } else { + if (ID_NFEATURES(id) < 1) + goto beep_ + call id_nearest (id, double (wx)) + pix = PIX(id,ID_CURRENT(id)) + pix = id_center (id, pix, ID_FWIDTH(id), + FTYPE(id,ID_CURRENT(id))) + if (!IS_INDEFD (pix)) { + call gseti (ID_GP(id), G_PLTYPE, 0) + call id_mark (id, ID_CURRENT(id)) + PIX(id,ID_CURRENT(id)) = pix + FWIDTH(id,ID_CURRENT(id)) = ID_FWIDTH(id) + FIT(id,ID_CURRENT(id)) = id_fitpt (id, pix) + call gseti (ID_GP(id), G_PLTYPE, 1) + call id_mark (id, ID_CURRENT(id)) + ID_NEWFEATURES(id) = YES + } else { + call printf ("Centering failed\n") + prfeature = NO + } + } + case 'd': # Delete features + if (all != 0) { + ID_NFEATURES(id) = 0 + ID_CURRENT(id) = 0 + ID_NEWFEATURES(id) = YES + ID_NEWGRAPH(id) = YES + } else { + if (ID_NFEATURES(id) < 1) + goto beep_ + call id_nearest (id, double (wx)) + call gseti (ID_GP(id), G_PLTYPE, 0) + call id_mark (id, ID_CURRENT(id)) + call gseti (ID_GP(id), G_PLTYPE, 1) + call id_delete (id, ID_CURRENT(id)) + ID_CURRENT(id) = min (ID_NFEATURES(id), ID_CURRENT(id)) + last = 0 + } + case 'e': # Find features from line list with no fitting + call id_linelist (id) + if (ID_NEWFEATURES(id) == YES) + ID_NEWGRAPH(id) = YES + case 'f': # Fit dispersion function + call id_dofit (id, YES) + case 'g': # Fit shift + call id_doshift (id, YES) + prfeature = NO + case 'i': # Initialize + call dcvfree (ID_CV(id)) + ID_SHIFT(id) = 0. + ID_NEWCV(id) = YES + ID_NFEATURES(id) = 0 + ID_CURRENT(id) = 0 + ID_NEWFEATURES(id) = YES + ID_NEWGRAPH(id) = YES + case 'j', 'k', 'o': + call printf ("Command not available in REIDENTIFY") + prfeature = NO + case 'l': # Find features from line list + if (ID_NFEATURES(id) >= 2) + call id_dofit (id, NO) + if (ID_NEWCV(id) == YES) { + iferr (call id_fitdata(id)) + ; + call id_fitfeatures(id) + ID_NEWCV(id) = NO + } + call id_linelist (id) + if (ID_NEWFEATURES(id) == YES) + ID_REFIT(id) = YES + case 'm': # Mark new feature + fit = wx + pix = fit_to_pix (id, fit) + pix = id_center (id, pix, ID_FWIDTH(id), ID_FTYPE(id)) + if (IS_INDEFD (pix)) { + prfeature = NO + call printf ("Center not found: check cursor position") + if (ID_THRESHOLD(id) > 0.) + call printf (" and threshold value") + goto beep_ + } + fit = id_fitpt (id, pix) + user = fit + call id_newfeature (id, pix, fit, user, 1.0D0, ID_FWIDTH(id), + ID_FTYPE(id), NULL) + USER(id,ID_CURRENT(id)) = INDEFD + call id_match (id, FIT(id,ID_CURRENT(id)), + USER(id,ID_CURRENT(id)), + Memi[ID_LABEL(id)+ID_CURRENT(id)-1], ID_MATCH(id)) + call id_mark (id, ID_CURRENT(id)) + call printf ("%10.2f %10.8g (%10.8g %s): ") + call pargd (PIX(id,ID_CURRENT(id))) + call pargd (FIT(id,ID_CURRENT(id))) + call pargd (USER(id,ID_CURRENT(id))) + label = Memi[ID_LABEL(id)+ID_CURRENT(id)-1] + if (label != NULL) + call pargstr (Memc[label]) + else + call pargstr ("") + call flush (STDOUT) + if (scan() != EOF) { + call gargd (user) + call gargwrd (cmd, SZ_LINE) + i = nscan() + if (i > 0) { + USER(id,ID_CURRENT(id)) = user + call id_match (id, user, USER(id,ID_CURRENT(id)), + Memi[ID_LABEL(id)+ID_CURRENT(id)-1], ID_MATCH(id)) + } + if (i > 1) { + call reset_scan () + call gargd (user) + call gargstr (cmd, SZ_LINE) + call id_label (cmd, Memi[ID_LABEL(id)+ID_CURRENT(id)-1]) + } + } + case 'p': # Switch to pan mode + if (ID_GTYPE(id) != PAN) { + ID_GTYPE(id) = PAN + ID_NEWGRAPH(id) = YES + } + case 'q': # Exit loop + break + case 'r': # Redraw the graph + ID_NEWGRAPH(id) = YES + case 's', 'x': # Shift or correlate features + # Get coordinate shift. + switch (key) { + case 's': + call printf ("User coordinate (%10.8g): ") + call pargr (wx) + call flush (STDOUT) + if (scan() != EOF) { + call gargd (user) + if (nscan() == 1) + shift = wx - user + } else + shift = 0. + case 'x': + shift = id_shift (id, -1D0, -0.05D0) + if (IS_INDEFD(shift)) { + call printf ("No solution found\n") + goto beep_ + } + } + + ID_NEWFEATURES(id) = YES + ID_NEWCV(id) = YES + ID_NEWGRAPH(id) = YES + prfeature = NO + + if (ID_NFEATURES(id) < 1) { + call printf ("User coordinate shift=%5f\n") + call pargd (shift) + ID_SHIFT(id) = ID_SHIFT(id) + shift + goto newkey_ + } + + # Recenter features. + pix_shift = 0. + z_shift = 0. + nfeatures1 = ID_NFEATURES(id) + + j = 0. + do i = 1, ID_NFEATURES(id) { + pix = fit_to_pix (id, FIT(id,i) + shift) + pix = id_center (id, pix, FWIDTH(id,i), FTYPE(id,i)) + if (IS_INDEFD (pix)) { + if (ID_CURRENT(id) == i) + ID_CURRENT(id) = i + 1 + next + } + fit = id_fitpt (id, pix) + + pix_shift = pix_shift + pix - PIX(id,i) + if (FIT(id,i) != 0.) + z_shift = z_shift + (fit - FIT(id,i)) / FIT(id,i) + + j = j + 1 + PIX(id,j) = pix + FIT(id,j) = FIT(id,i) + USER(id,j) = USER(id,i) + WTS(id,j) = WTS(id,i) + FWIDTH(id,j) = FWIDTH(id,i) + FTYPE(id,j) = FTYPE(id,i) + if (ID_CURRENT(id) == i) + ID_CURRENT(id) = j + } + if (j != ID_NFEATURES(id)) { + ID_NFEATURES(id) = j + ID_CURRENT(id) = min (ID_CURRENT(id), ID_NFEATURES(id)) + } + + if (ID_NFEATURES(id) < 1) { + call printf ("User coordinate shift=%5f") + call pargd (shift) + call printf (", No features found during recentering\n") + ID_SHIFT(id) = ID_SHIFT(id) + shift + goto newkey_ + } + + # Adjust shift. + pix = ID_SHIFT(id) + call id_doshift (id, NO) + call id_fitfeatures (id) + + # Print results. + call printf ("Recentered=%d/%d") + call pargi (ID_NFEATURES(id)) + call pargi (nfeatures1) + call printf ( + ", pixel shift=%.2f, user shift=%5f, z=%7.3g, rms=%5g\n") + call pargd (pix_shift / ID_NFEATURES(id)) + call pargd (pix - ID_SHIFT(id)) + call pargd (z_shift / ID_NFEATURES(id)) + call pargd (id_rms(id)) + case 't': # Move the current feature + if (ID_CURRENT(id) < 1) + goto beep_ + pix = fit_to_pix (id, double (wx)) + call gseti (ID_GP(id), G_PLTYPE, 0) + call id_mark (id, ID_CURRENT(id)) + PIX(id,ID_CURRENT(id)) = pix + FIT(id,ID_CURRENT(id)) = id_fitpt (id, pix) + call gseti (ID_GP(id), G_PLTYPE, 1) + call id_mark (id, ID_CURRENT(id)) + ID_NEWFEATURES(id) = YES + case 'u': # Set user coordinate + if (ID_NFEATURES(id) < 1) + goto beep_ + call printf ("%10.2f %10.8g (%10.8g %s): ") + call pargd (PIX(id,ID_CURRENT(id))) + call pargd (FIT(id,ID_CURRENT(id))) + call pargd (USER(id,ID_CURRENT(id))) + label = Memi[ID_LABEL(id)+ID_CURRENT(id)-1] + if (label != NULL) + call pargstr (Memc[label]) + else + call pargstr ("") + call flush (STDOUT) + if (scan() != EOF) { + call gargd (user) + call gargwrd (cmd, SZ_LINE) + i = nscan() + if (i > 0) { + USER(id,ID_CURRENT(id)) = user + ID_NEWFEATURES(id) = YES + } + if (i > 1) { + call reset_scan () + call gargd (user) + call gargstr (cmd, SZ_LINE) + call id_label (cmd, Memi[ID_LABEL(id)+ID_CURRENT(id)-1]) + } + } + case 'v': # Modify weight + if (ID_NFEATURES(id) < 1) + goto beep_ + call printf ("Weight (%d): ") + call pargd (WTS(id,ID_CURRENT(id))) + call flush (STDOUT) + if (scan() != EOF) { + call gargi (i) + if (nscan() > 0) { + WTS(id,ID_CURRENT(id)) = i + ID_NEWFEATURES(id) = YES + } + } + case 'w': # Window graph + call gt_window (ID_GT(id), ID_GP(id), "cursor", ID_NEWGRAPH(id)) + case 'y': # Find peaks + call malloc (peaks, ID_NPTS(id), TY_REAL) + npeaks = id_peaks (id, IMDATA(id,1), Memr[peaks], ID_NPTS(id), + 0., int (ID_MINSEP(id)), 0, ID_MAXFEATURES(id), 0., false) + for (j = 1; j <= ID_NFEATURES(id); j = j + 1) { + for (i = 1; i <= npeaks; i = i + 1) { + if (!IS_INDEF (Memr[peaks+i-1])) { + pix = Memr[peaks+i-1] + if (abs (pix - PIX(id,j)) < ID_MINSEP(id)) + Memr[peaks+i-1] = INDEF + } + } + } + for (i = 1; i <= npeaks; i = i + 1) { + if (IS_INDEF(Memr[peaks+i-1])) + next + pix = Memr[peaks+i-1] + pix = id_center (id, pix, ID_FWIDTH(id), ID_FTYPE(id)) + if (IS_INDEFD (pix)) + next + fit = id_fitpt (id, pix) + user = INDEFD + call id_match (id, fit, user, label, ID_MATCH(id)) + call id_newfeature (id, pix, fit, user, 1.0D0, + ID_FWIDTH(id), ID_FTYPE(id), label) + call id_mark (id, ID_CURRENT(id)) + } + call mfree (peaks, TY_REAL) + case 'z': # Go to zoom mode + if (ID_NFEATURES(id) < 1) + goto beep_ + if (ID_GTYPE(id) == PAN) + ID_NEWGRAPH(id) = YES + ID_GTYPE(id) = ZOOM + call id_nearest (id, double (wx)) + case 'I': + call fatal (0, "Interrupt") + default: +beep_ call printf ("\007") + } + +newkey_ + # Set update flag if anything has changed. + if ((ID_NEWFEATURES(id) == YES) || (ID_NEWCV(id) == YES)) + ID_NEWDBENTRY(id) = YES + + # If a new image exit loop, update database, and start over. + if (newimage[1] != EOS) { + call printf ("Can't change image in REIDENTIFY") + newimage[1] = EOS + prfeature = NO + } + + # Refit dispersion function + if (ID_REFIT(id) == YES) { + call id_dofit (id, NO) + ID_REFIT(id) = NO + } + + # If there is a new dispersion solution evaluate the coordinates + if (ID_NEWCV(id) == YES) { + iferr (call id_fitdata (id)) + ; + call id_fitfeatures (id) + ID_NEWCV(id) = NO + } + + # Draw new graph in zoom mode if current feature has changed. + if ((ID_GTYPE(id) == ZOOM) && (last != ID_CURRENT(id))) + ID_NEWGRAPH(id) = YES + + # Draw new graph. + if (ID_NEWGRAPH(id) == YES) { + call id_graph (id, ID_GTYPE(id)) + ID_NEWGRAPH(id) = NO + } + + # Set cursor and print status of current feature (unless canceled). + if (ID_CURRENT(id) > 0) { + if (IS_INDEF (wy)) { + i = max (1, min (ID_NPTS(id), int (PIX(id,ID_CURRENT(id))))) + wy = IMDATA(id,i) + } + + call gscur (ID_GP(id), real (FIT(id,ID_CURRENT(id))), wy) + if (errcode() == OK && prfeature == YES) { + call printf ("%10.2f %10.8g %10.8g %s\n") + call pargd (PIX(id,ID_CURRENT(id))) + call pargd (FIT(id,ID_CURRENT(id))) + call pargd (USER(id,ID_CURRENT(id))) + if (Memi[ID_LABEL(id)+ID_CURRENT(id)-1] != NULL) + call pargstr ( + Memc[Memi[ID_LABEL(id)+ID_CURRENT(id)-1]]) + else + call pargstr ("") + } + } + + # Print delayed error message + if (errcode() != OK) + call erract (EA_WARN) + + last = ID_CURRENT(id) + } until (clgcur ("cursor", wx, wy, wcs, key, cmd, SZ_LINE) == EOF) +end diff --git a/noao/onedspec/identify/t_autoid.x b/noao/onedspec/identify/t_autoid.x new file mode 100644 index 00000000..fbdaa0cd --- /dev/null +++ b/noao/onedspec/identify/t_autoid.x @@ -0,0 +1,252 @@ +include <error.h> +include <fset.h> +include <gset.h> +include <pkg/gtools.h> +include <smw.h> +include "identify.h" + +define ICFITHELP "noao$lib/scr/idicgfit.key" + + +# T_AUTOIDENTIFY -- Automatically identify spectral features. + +procedure t_autoidentify () + +int list # List of images +int interactive # Examine identifications interactively? +int dbwrite # Write database results? + +int i, fd, hdr, hdr1 +pointer sp, str, aid, id + +int clgeti(), clgwrd(), nscan(), open(), nowhite() +int imtopenp(), imtgetim(), id_dbcheck() +bool clgetb(), aid_autoid() +real clgetr() +pointer gopen(), gt_init(), un_open() +errchk open, id_mapll, aid_autoid, aid_init, reidentify + +define done_ 10 + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Initialize data structures. Note the AID structure is initialized + # with CL queries to the AIDPARS pset. + + aid = NULL + call aid_init (aid, "aidpars") + call id_init (id) + + # Get query parameters. + list = imtopenp ("images") + call aid_sets (aid, "crval", "CL crval") + call aid_sets (aid, "cdelt", "CL cdelt") + + # Get other parameters and IDENITFY set data structures. + ID_NSUM(id,1) = clgeti ("nsum") + call gargi (ID_NSUM(id,2)) + if (nscan() != 2) + ID_NSUM(id,2) = ID_NSUM(id,1) + ID_NSUM(id,1) = max (1, ID_NSUM(id,1)) + ID_NSUM(id,2) = max (1, ID_NSUM(id,2)) + ID_MAXFEATURES(id) = clgetr ("aidpars.ntarget") + ID_MINSEP(id) = clgetr ("minsep") + ID_FTYPE(id) = clgwrd ("ftype", Memc[str], SZ_LINE, FTYPES) + ID_FWIDTH(id) = clgetr ("fwidth") + ID_CRADIUS(id) = clgetr ("cradius") + ID_THRESHOLD(id) = clgetr ("threshold") + ID_MATCH(id) = clgetr ("match") + ID_ZWIDTH(id) = clgetr ("identify.zwidth") + ID_LABELS(id) = 1 + + call clgstr ("database", ID_DATABASE(id), ID_LENSTRING) + dbwrite = clgwrd ("dbwrite", Memc[str], SZ_FNAME, "|no|yes|NO|YES|") + if (dbwrite == 1) + dbwrite = 3 + + call clgstr ("coordlist", ID_COORDLIST(id), ID_LENSTRING) + if (nowhite (ID_COORDLIST(id), ID_COORDLIST(id), ID_LENSTRING) == 0) { + call clgstr ("coordlist.p_prompt", Memc[str], SZ_LINE) + call printf (Memc[str]) + call flush (STDOUT) + call clgstr ("query", ID_COORDLIST(id), ID_LENSTRING) + } + call clgstr ("units", Memc[str], SZ_LINE) + call xt_stripwhite (Memc[str]) + if (Memc[str] != EOS) + ID_UN(id) = un_open (Memc[str]) + call id_mapll (id) + if (ID_LL(id) == NULL) + call error (0, "Required coordinate line list not found") + + # Dispersion fitting parameters. + call ic_open (ID_IC(id)) + call clgstr ("function", Memc[str], SZ_LINE) + call ic_pstr (ID_IC(id), "function", Memc[str]) + call ic_puti (ID_IC(id), "order", clgeti ("order")) + call clgstr ("sample", Memc[str], SZ_LINE) + call ic_pstr (ID_IC(id), "sample", Memc[str]) + call ic_puti (ID_IC(id), "naverage", 1) + call ic_puti (ID_IC(id), "niterate", clgeti ("niterate")) + call ic_putr (ID_IC(id), "low", clgetr ("low_reject")) + call ic_putr (ID_IC(id), "high", clgetr ("high_reject")) + call ic_putr (ID_IC(id), "grow", clgetr ("grow")) + + call ic_pstr (ID_IC(id), "xlabel", "Feature positions") + call ic_pstr (ID_IC(id), "xunits", "pixels") + call ic_pstr (ID_IC(id), "ylabel", "") + call ic_pkey (ID_IC(id), 1, 'y', 'x') + call ic_pkey (ID_IC(id), 2, 'y', 'v') + call ic_pkey (ID_IC(id), 3, 'y', 'r') + call ic_pkey (ID_IC(id), 4, 'y', 'd') + call ic_pkey (ID_IC(id), 5, 'y', 'n') + call ic_puti (ID_IC(id), "key", 5) + call ic_pstr (ID_IC(id), "help", ICFITHELP) + + # Interactive, graphics, and output parameters. + interactive = clgwrd ("interactive", Memc[str], SZ_FNAME, + "|no|yes|NO|YES|") + switch (interactive) { + case 1, 3: + ID_GP(id) = NULL + interactive = 3 + case 2, 4: + # Open graphics + call clgstr ("graphics", Memc[str], SZ_LINE) + ID_GP(id) = gopen (Memc[str], NEW_FILE+AW_DEFER, STDGRAPH) + } + + ID_GT(id) = gt_init() + call gt_sets (ID_GT(id), GTTYPE, "line") + call fseti (STDOUT, F_FLUSHNL, YES) + hdr = YES + hdr1 = YES + + # Log and plot files. + call calloc (ID_LOGFILES(id), 4, TY_INT) + if (clgetb ("verbose")) + Memi[ID_LOGFILES(id)] = STDOUT + call clgstr ("logfile", Memc[str], SZ_LINE) + if (nowhite (Memc[str], Memc[str], SZ_FNAME) > 0) { + fd = open (Memc[str], APPEND, TEXT_FILE) + Memi[ID_LOGFILES(id)+1] = fd + } + call clgstr ("plotfile", Memc[str], SZ_LINE) + if (nowhite (Memc[str], Memc[str], SZ_FNAME) > 0) { + fd = open (Memc[str], APPEND, BINARY_FILE) + Memi[ID_LOGFILES(id)+2] = fd + } + + # Expand the image template and identify features. + while (imtgetim (list, ID_IMAGE(id), ID_LENSTRING) != EOF) { + # Initialize. + iferr (call id_map(id)) { + call erract (EA_WARN) + next + } + if (!clgetb ("overwrite")) { + if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES) { + if (Memi[ID_LOGFILES(id)] != NULL) { + if (ID_GP(id) != NULL) + call gdeactivate (ID_GP(id), 0) + call fprintf (Memi[ID_LOGFILES(id)], + " %s%s%24t Database entry already exists\n") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + } + goto done_ + } + } + + call id_gdata(id) + call id_fitdata(id) + call ic_putr (ID_IC(id), "xmin", real (PIXDATA(id,1))) + call ic_putr (ID_IC(id), "xmax", real (PIXDATA(id,ID_NPTS(id)))) + + call dcvfree (ID_CV(id)) + ID_SHIFT(id) = 0. + ID_NFEATURES(id) = 0 + + # Automatically identify the features. + if (aid_autoid (id, aid)) + ID_NEWDBENTRY(id) = YES + else if (Memi[ID_LOGFILES(id)] == NULL) + call aid_log (id, STDOUT, NO) + call aid_log (id, Memi[ID_LOGFILES(id)], hdr) + call aid_log (id, Memi[ID_LOGFILES(id)+1], hdr1) + + # Enter interactive identification mode if desired. + if (interactive != 3) { + if (interactive != 4) { + repeat { + call clgstr ("interactive.p_prompt", Memc[str], + SZ_FNAME) + call printf ("%s%s: %s") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + call pargstr (Memc[str]) + call flush (STDOUT) + if (interactive == 1) + call clpstr ("query", "no") + else + call clpstr ("query", "yes") + ifnoerr (interactive = clgwrd ("query", Memc[str], + SZ_FNAME, "|no|yes|NO|YES|")) + break + } + } + if (interactive == 2 || interactive == 4) { + call reidentify (id) + call gdeactivate (ID_GP(id), 0) + } + } + + # Write results to the database. + if (ID_NEWDBENTRY(id) == YES) { + if (dbwrite == 1 || dbwrite == 2) { + repeat { + call clgstr ("dbwrite.p_prompt", Memc[str], SZ_FNAME) + call printf ("%s%s: %s") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + call pargstr (Memc[str]) + call flush (STDOUT) + if (dbwrite == 1) + call clpstr ("query", "no") + else + call clpstr ("query", "yes") + ifnoerr (dbwrite = clgwrd ("query", Memc[str], + SZ_FNAME, "|no|yes|NO|YES|")) + break + } + } + if (dbwrite == 2 || dbwrite == 4) + call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO) + } + +done_ # Close the database, image, and spectrum data structures. + if (ID_DT(id) != NULL) + call dtunmap (ID_DT(id)) + call smw_close (MW(ID_SH(id))) + call imunmap (IM(ID_SH(id))) + call shdr_close (ID_SH(id)) + } + + # Finish up. + do i = 1, 3 { + fd = Memi[ID_LOGFILES(id)+i-1] + if (fd != NULL) + call close (fd) + } + call mfree (ID_LOGFILES(id), TY_INT) + if (ID_GP(id) != NULL) + call gclose (ID_GP(id)) + call smw_daxis (NULL, NULL, 0, 0, 0) + call imtclose (list) + if (aid != NULL) + call aid_free (aid) + call id_free (id) + call sfree (sp) +end diff --git a/noao/onedspec/identify/t_identify.x b/noao/onedspec/identify/t_identify.x new file mode 100644 index 00000000..96e5034e --- /dev/null +++ b/noao/onedspec/identify/t_identify.x @@ -0,0 +1,89 @@ +include <mach.h> +include <pkg/gtools.h> +include "identify.h" + +# T_IDENTIFY -- Identify features + +procedure t_identify () + +int list, clscan(), clgeti(), clgwrd(), nscan(), imtopenp(), imtgetim() +real clgetr() +pointer sp, str, id, gt_init(), un_open() + +begin + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + + # Allocate the basic data structure. + call id_init (id) + + # Get task parameters. + list = imtopenp ("images") + if (clscan ("nsum") != EOF) { + call gargi (ID_NSUM(id,1)) + call gargi (ID_NSUM(id,2)) + if (nscan() == 0) + call error (1, "Error in 'nsum' parameter") + if (nscan() == 1) + ID_NSUM(id,2) = ID_NSUM(id,1) + ID_NSUM(id,1) = max (1, ID_NSUM(id,1)) + ID_NSUM(id,2) = max (1, ID_NSUM(id,2)) + } + ID_MAXFEATURES(id) = clgeti ("maxfeatures") + ID_MINSEP(id) = clgetr ("minsep") + ID_MATCH(id) = clgetr ("match") + ID_ZWIDTH(id) = clgetr ("zwidth") + ID_FTYPE(id) = clgwrd ("ftype", Memc[str], SZ_LINE, FTYPES) + ID_FWIDTH(id) = clgetr ("fwidth") + ID_CRADIUS(id) = clgetr ("cradius") + ID_THRESHOLD(id) = clgetr ("threshold") + call clgstr ("database", ID_DATABASE(id), ID_LENSTRING) + call clgstr ("coordlist", ID_COORDLIST(id), ID_LENSTRING) + call clgstr ("units", Memc[str], SZ_LINE) + call xt_stripwhite (Memc[str]) + if (Memc[str] != EOS) + ID_UN(id) = un_open (Memc[str]) + ID_LABELS(id) = 1 + + # Initialize features data structure. + ID_GT(id) = gt_init() + call gt_sets (ID_GT(id), GTTYPE, "line") + ID_CV(id) = NULL + ID_CURRENT(id) = 0 + ID_SHIFT(id) = 0. + + # Initialize ICFIT + call ic_open (ID_IC(id)) + call clgstr ("function", Memc[str], SZ_LINE) + call ic_pstr (ID_IC(id), "function", Memc[str]) + call ic_puti (ID_IC(id), "order", clgeti ("order")) + call clgstr ("sample", Memc[str], SZ_LINE) + call ic_pstr (ID_IC(id), "sample", Memc[str]) + call ic_puti (ID_IC(id), "naverage", 1) + call ic_puti (ID_IC(id), "niterate", clgeti ("niterate")) + call ic_putr (ID_IC(id), "low", clgetr ("low_reject")) + call ic_putr (ID_IC(id), "high", clgetr ("high_reject")) + call ic_putr (ID_IC(id), "grow", clgetr ("grow")) + call ic_pstr (ID_IC(id), "xlabel", "Feature positions") + call ic_pstr (ID_IC(id), "xunits", "pixels") + call ic_pstr (ID_IC(id), "ylabel", "") + call ic_pkey (ID_IC(id), 1, 'y', 'x') + call ic_pkey (ID_IC(id), 2, 'y', 'v') + call ic_pkey (ID_IC(id), 3, 'y', 'r') + call ic_pkey (ID_IC(id), 4, 'y', 'd') + call ic_pkey (ID_IC(id), 5, 'y', 'n') + call ic_puti (ID_IC(id), "key", 3) + + # Get the line list. + call id_mapll (id) + + # Expand the image template and identify features in each image. + while (imtgetim (list, ID_IMAGE(id), ID_LENSTRING) != EOF) + call id_identify (id) + + # Finish up. + call smw_daxis (NULL, NULL, 0, 0, 0) + call id_free (id) + call imtclose (list) + call sfree (sp) +end diff --git a/noao/onedspec/identify/t_reidentify.x b/noao/onedspec/identify/t_reidentify.x new file mode 100644 index 00000000..e82951ee --- /dev/null +++ b/noao/onedspec/identify/t_reidentify.x @@ -0,0 +1,1083 @@ +include <error.h> +include <fset.h> +include <gset.h> +include <pkg/gtools.h> +include <smw.h> +include "identify.h" + +define ICFITHELP "noao$lib/scr/idicgfit.key" + +# T_REIDENTIFY -- Reidentify features starting from reference features. +# A reference spectrum is specified and the same features are identified +# in other images. Some lines may be lost due to bad centering. Additional +# lines may be excluded from a new fit to the dispersion function. Instead +# of refitting the dispersion function the user may elect to determine only +# a shift in the reference dispersion function. Additional features may +# be added given a coordinate list. +# +# In 2D images a starting line or column is selected. A number of lines +# or columns may be averaged before identifying features. If a positive step +# size is given then additional lines or columns may be reidentified in +# the reference image. This may be done either by tracing or by reidentifying +# starting from the same reference features. Reidentification between images +# is done by taking the same line or column from the reference image. +# The step and summing are ignored for multispec images. +# +# Multispec format images are matched by aperture number and the spectra +# need not be in the same order in each image. + +procedure t_reidentify () + +pointer reference # Reference image +int list # List of images +char ans[3] # Interactive? +double crsearch # Search radius + +int i, fd, nlogfd +pointer sp, logfile, str, id, logfd, pd + +int clscan(), clgeti(), clpopnu(), clgfil(), clgwrd() +int nscan(), open(), btoi(), nowhite(), imtopenp(), imtgetim() +bool clgetb(), strne() +double clgetd() +pointer gopen(), gt_init() + +begin + call smark (sp) + call salloc (reference, SZ_FNAME, TY_CHAR) + call salloc (logfile, SZ_FNAME, TY_CHAR) + call salloc (str, SZ_LINE, TY_CHAR) + + # Allocate the basic data structures. + call id_init (id) + call ic_open (ID_IC(id)) + + # Get task parameters. + call clgstr ("reference", Memc[reference], SZ_FNAME) + list = imtopenp ("images") + i = nowhite (Memc[reference], Memc[reference], SZ_FNAME) + + crsearch = clgetd ("search") + ID_REFIT(id) = btoi (clgetb ("refit")) + + if (clscan ("nsum") != EOF) { + call gargi (ID_NSUM(id,1)) + call gargi (ID_NSUM(id,2)) + if (nscan() == 0) + call error (1, "Error in 'nsum' parameter") + if (nscan() == 1) + ID_NSUM(id,2) = ID_NSUM(id,1) + ID_NSUM(id,1) = max (1, ID_NSUM(id,1)) + ID_NSUM(id,2) = max (1, ID_NSUM(id,2)) + } + ID_MAXFEATURES(id) = clgeti ("maxfeatures") + ID_MINSEP(id) = clgetd ("minsep") + ID_MATCH(id) = clgetd ("match") + ID_ZWIDTH(id) = clgetd ("identify.zwidth") + ID_FTYPE(id) = clgwrd ("identify.ftype", Memc[str], SZ_LINE, FTYPES) + ID_FWIDTH(id) = clgetd ("identify.fwidth") + ID_CRADIUS(id) = clgetd ("cradius") + ID_THRESHOLD(id) = clgetd ("threshold") + call clgstr ("database", ID_DATABASE(id), ID_LENSTRING) + call clgstr ("coordlist", ID_COORDLIST(id), ID_LENSTRING) + ID_LABELS(id) = 1 + + call id_mapll (id) + ID_LOGFILES(id) = clpopnu ("logfiles") + + switch (clgwrd ("interactive", ans, SZ_FNAME, "|no|yes|NO|YES|")) { + case 1, 3: + call strcpy ("NO", ans, 3) + ID_GP(id) = NULL + case 2, 4: + # Open graphics + call clgstr ("graphics", Memc[logfile], SZ_FNAME) + ID_GP(id) = gopen (Memc[logfile], NEW_FILE+AW_DEFER, STDGRAPH) + call ic_pstr (ID_IC(id), "help", ICFITHELP) + call ic_pstr (ID_IC(id), "xlabel", "Feature positions") + call ic_pstr (ID_IC(id), "xunits", "pixels") + call ic_pstr (ID_IC(id), "ylabel", "") + call ic_pkey (ID_IC(id), 1, 'y', 'x') + call ic_pkey (ID_IC(id), 2, 'y', 'v') + call ic_pkey (ID_IC(id), 3, 'y', 'r') + call ic_pkey (ID_IC(id), 4, 'y', 'd') + call ic_pkey (ID_IC(id), 5, 'y', 'n') + call ic_puti (ID_IC(id), "key", 3) + } + + # Open log and plot files. + nlogfd = 0 + if (clgetb ("verbose")) { + nlogfd = 1 + call malloc (logfd, nlogfd, TY_INT) + Memi[logfd] = STDOUT + } + while (clgfil (ID_LOGFILES(id), Memc[logfile], SZ_FNAME) != EOF) { + fd = open (Memc[logfile], APPEND, TEXT_FILE) + call fseti (fd, F_FLUSHNL, YES) + nlogfd = nlogfd + 1 + if (nlogfd == 1) + call malloc (logfd, nlogfd, TY_INT) + else + call realloc (logfd, nlogfd, TY_INT) + Memi[logfd+nlogfd-1] = fd + } + call ri_loghdr (id, Memc[reference], Memi[logfd], nlogfd, 1) + + call clgstr ("plotfile", Memc[logfile], SZ_FNAME) + if (nowhite (Memc[logfile], Memc[logfile], SZ_FNAME) > 0) { + fd = open (Memc[logfile], APPEND, BINARY_FILE) + pd = gopen ("stdvdm", NEW_FILE, fd) + } else + pd = NULL + + ID_GT(id) = gt_init() + call gt_sets (ID_GT(id), GTTYPE, "line") + + # Get and trace the reference solutions. + call ri_reference (id, Memc[reference], crsearch, ans, Memi[logfd], + nlogfd, pd) + + # Expand the image template and reidentify features. + while (imtgetim (list, ID_IMAGE(id), ID_LENSTRING) != EOF) + if (strne (Memc[reference], ID_IMAGE(id))) + call ri_image (id, Memc[reference], ID_IMAGE(id), crsearch, ans, + Memi[logfd], nlogfd, pd) + + # Finish up. + if (nlogfd > 0) { + do i = 1, nlogfd + call close (Memi[logfd+i-1]) + call mfree (logfd, TY_INT) + } + + if (ID_GP(id) != NULL) + call gclose (ID_GP(id)) + if (pd != NULL) { + call gclose (pd) + call close (fd) + } + call clpcls (ID_LOGFILES(id)) + call imtclose (list) + call id_free (id) + call smw_daxis (NULL, NULL, 0, 0, 0) + call sfree (sp) +end + + +# RI_REFERENCE -- Set reference features. Trace if needed. + +procedure ri_reference (id, reference, crsearch, ans, logfd, nlogfd, pd) + +pointer id # ID pointer +char reference[ARB] # Reference image +double crsearch # Search radius +char ans[3] # Interactive? +int logfd[ARB] # Logfiles +int nlogfd # Number of logfiles +pointer pd # Plot file pointer + +int step[2] +double shift[2] +int nreid +bool override +bool trace + +int i, apstart[2], start[2], line[2], loghdr +double fit_shift[2] +pointer ic, ic1 +bool clgetb() +int clscan(), clgeti(), nscan(), id_dbcheck() +pointer id_getap() +errchk id_dbread + +begin + # Open the image and return if there is an error. + call strcpy (reference, ID_IMAGE(id), ID_LENSTRING) + iferr (call id_map (id)) { + call erract (EA_WARN) + iferr (call id_dbsave (id, ID_IMAGE(id))) + call erract (EA_WARN) + return + } + + # Get and save the reference database entry. + call id_dbread (id, ID_IMAGE(id), ID_AP(id,1), NO, NO) + call id_saveap (id) + + # Set parameters + start[1] = ID_LINE(id,1) + start[2] = ID_LINE(id,2) + apstart[1] = ID_AP(id,1) + apstart[2] = ID_AP(id,2) + + if (clscan ("step") == EOF) + call error (1, "Error in 'step' parameter") + call gargi (step[1]) + call gargi (step[2]) + if (nscan() == 0) + call error (1, "Error in 'step' parameter") + if (nscan() == 1) + step[2] = step[1] + if (SMW_FORMAT(MW(ID_SH(id))) != SMW_ND) { + step[1] = min (step[1], 1) + step[2] = min (step[2], 1) + } + if (step[1] == 0) + step[1] = ID_MAXLINE(id,1) + if (step[2] == 0) + step[2] = ID_MAXLINE(id,2) + + if (clscan ("shift") != EOF) { + call gargd (shift[1]) + call gargd (shift[2]) + if (nscan() == 0) + call error (1, "Error in 'shift' parameter") + if (nscan() == 1) + shift[2] = shift[1] + } + + nreid = max (1, ID_NFEATURES(id) - clgeti ("nlost")) + override = clgetb ("override") + trace = clgetb ("trace") + + # Get and save other entries. + if (!override) { + for (line[2]=start[2]; line[2]>0; line[2]=line[2]-step[2]) { + ID_LINE(id,2) = line[2] + ID_AP(id,2) = line[2] + for (line[1]=start[1]; line[1]>0; line[1]=line[1]-step[1]) { + if (line[1]==start[1] && line[2]==start[2]) + next + ID_LINE(id,1) = line[1] + ID_AP(id,1) = line[1] + if (ID_APS(id) != NULL) + ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1] + ifnoerr ( + call id_dbread (id, ID_IMAGE(id), ID_AP(id,1), + NO, NO)) { + call id_saveap (id) + } + } + for (line[1]=start[1]+step[1]; line[1]<=ID_MAXLINE(id,1); + line[1]=line[1]+step[1]) { + ID_LINE(id,1) = line[1] + ID_AP(id,1) = line[1] + if (ID_APS(id) != NULL) + ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1] + ifnoerr (call id_dbread (id, ID_IMAGE(id), + ID_AP(id,1), NO, NO)) { + call id_saveap (id) + } + } + } + for (line[2]=start[2]+step[2]; line[2]<=ID_MAXLINE(id,2); + line[2]=line[2]+step[2]) { + ID_LINE(id,2) = line[2] + ID_AP(id,2) = line[2] + for (line[1]=start[1]-step[1]; line[1]>0; + line[1]=line[1]-step[1]) { + ID_LINE(id,1) = line[1] + ID_AP(id,1) = line[1] + if (ID_APS(id) != NULL) + ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1] + ifnoerr ( + call id_dbread (id, ID_IMAGE(id), ID_AP(id,1), + NO, NO)) { + call id_saveap (id) + } + } + for (line[1]=start[1]+step[1]; line[1]<=ID_MAXLINE(id,1); + line[1]=line[1]+step[1]) { + ID_LINE(id,1) = line[1] + ID_AP(id,1) = line[1] + if (ID_APS(id) != NULL) + ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1] + ifnoerr (call id_dbread (id, ID_IMAGE(id), + ID_AP(id,1), NO, NO)) { + call id_saveap (id) + } + } + } + } + + # Reidentify. + loghdr = 2 + ic = ID_IC(id) + if (ans[1] == 'N') + ic1 = ic + else { + call ic_open (ic1) + call ic_copy (ic, ic1) + } + + fit_shift[2] = shift[2] + for (line[2]=start[2]; line[2]>0; line[2]=line[2]-step[2]) { + ID_LINE(id,2) = line[2] + ID_AP(id,2) = line[2] + ID_IC(id) = ic + + if (IS_INDEFD(shift[2])) + fit_shift[2] = INDEFD + else { + if (!trace) + fit_shift[2] = fit_shift[2] - shift[2] + else + fit_shift[2] = -shift[2] + } + + fit_shift[1] = fit_shift[2] + for (line[1]=start[1]; line[1]>0; line[1]=line[1]-step[1]) { + if (line[1]==start[1] && line[2]==start[2]) + next + ID_LINE(id,1) = line[1] + ID_AP(id,1) = line[1] + ID_IC(id) = ic + if (ID_APS(id) != NULL) + ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1] + if (!override) + if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES) + next + + if (!trace) { + ID_NFEATURES(id) = 0 + ID_AP(id,1) = apstart[1] + ID_AP(id,2) = apstart[2] + i = id_getap (id) + ID_LINE(id,1) = line[1] + ID_LINE(id,2) = line[2] + } + + if (IS_INDEFD(shift[1])) + fit_shift[1] = INDEFD + else { + if (!trace) + fit_shift[1] = fit_shift[1] - shift[1] + else + fit_shift[1] = -shift[1] + } + + ID_IC(id) = ic1 + call id_gdata (id) + iferr (call id_fitdata (id)) + ; + + call ri_loghdr (id, reference, logfd, nlogfd, loghdr) + loghdr = 0 + call ri_reidentify (id, fit_shift, crsearch, ans, logfd, + nlogfd, pd) + + if (ID_NFEATURES(id) < nreid) { + call ri_loghdr (id, reference, logfd, nlogfd, 3) + ID_NFEATURES(id) = 0 + if (trace) + break + } + + if (ID_NFEATURES(id) > 0) { + call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO) + call id_saveap (id) + } + } + + ID_IC(id) = ic + ID_NFEATURES(id) = 0 + ID_AP(id,1) = apstart[1] + ID_AP(id,2) = apstart[2] + i = id_getap (id) + fit_shift[1] = fit_shift[2] + for (line[1]=start[1]+step[1]; line[1]<=ID_MAXLINE(id,1); + line[1]=line[1]+step[1]) { + ID_LINE(id,1) = line[1] + ID_AP(id,1) = line[1] + ID_IC(id) = ic + if (ID_APS(id) != NULL) + ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1] + if (!override) + if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES) + next + + if (!trace) { + ID_NFEATURES(id) = 0 + ID_AP(id,1) = apstart[1] + ID_AP(id,2) = apstart[2] + i = id_getap (id) + ID_LINE(id,1) = line[1] + ID_LINE(id,2) = line[2] + } + + if (IS_INDEFD(shift[1])) + fit_shift[1] = INDEFD + else { + if (!trace) + fit_shift[1] = fit_shift[1] + shift[1] + else + fit_shift[1] = shift[1] + } + + ID_IC(id) = ic1 + call id_gdata (id) + iferr (call id_fitdata (id)) + ; + + call ri_loghdr (id, reference, logfd, nlogfd, loghdr) + loghdr = 0 + call ri_reidentify (id, fit_shift, crsearch, ans, logfd, + nlogfd, pd) + + if (ID_NFEATURES(id) < nreid) { + call ri_loghdr (id, reference, logfd, nlogfd, 3) + ID_NFEATURES(id) = 0 + if (trace) + break + } + + if (ID_NFEATURES(id) > 0) { + call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO) + call id_saveap (id) + } + } + } + + + fit_shift[2] = 0. + for (line[2]=start[2]+step[2]; line[2]<=ID_MAXLINE(id,2); + line[2]=line[2]+step[2]) { + ID_LINE(id,2) = line[2] + ID_AP(id,2) = line[2] + ID_IC(id) = ic + + if (IS_INDEFD(shift[2])) + fit_shift[2] = INDEFD + else { + if (!trace) + fit_shift[2] = fit_shift[2] + shift[2] + else + fit_shift[2] = shift[2] + } + + fit_shift[1] = fit_shift[2] + for (line[1]=start[1]; line[1]>0; line[1]=line[1]-step[1]) { + ID_LINE(id,1) = line[1] + ID_AP(id,1) = line[1] + ID_IC(id) = ic + if (ID_APS(id) != NULL) + ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1] + if (!override) + if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES) + next + + if (!trace) { + ID_NFEATURES(id) = 0 + ID_AP(id,1) = apstart[1] + ID_AP(id,2) = apstart[2] + i = id_getap (id) + ID_LINE(id,1) = line[1] + ID_LINE(id,2) = line[2] + } + + if (IS_INDEFD(shift[1])) + fit_shift[1] = INDEFD + else { + if (!trace) + fit_shift[1] = fit_shift[1] - shift[1] + else + fit_shift[1] = -shift[1] + } + + ID_IC(id) = ic1 + call id_gdata (id) + iferr (call id_fitdata (id)) + ; + + call ri_loghdr (id, reference, logfd, nlogfd, loghdr) + loghdr = 0 + call ri_reidentify (id, fit_shift, crsearch, ans, logfd, + nlogfd, pd) + + if (ID_NFEATURES(id) < nreid) { + call ri_loghdr (id, reference, logfd, nlogfd, 3) + ID_NFEATURES(id) = 0 + if (trace) + break + } + + if (ID_NFEATURES(id) > 0) { + call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO) + call id_saveap (id) + } + } + + ID_IC(id) = ic + ID_NFEATURES(id) = 0 + ID_AP(id,1) = apstart[1] + ID_AP(id,2) = apstart[2] + i = id_getap (id) + fit_shift[1] = fit_shift[2] + for (line[1]=start[1]+step[1]; line[1]<=ID_MAXLINE(id,1); + line[1]=line[1]+step[1]) { + ID_LINE(id,1) = line[1] + ID_AP(id,1) = line[1] + ID_IC(id) = ic + if (ID_APS(id) != NULL) + ID_AP(id,1) = Memi[ID_APS(id)+line[1]-1] + if (!override) + if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES) + next + + if (!trace) { + ID_NFEATURES(id) = 0 + ID_AP(id,1) = apstart[1] + ID_AP(id,2) = apstart[2] + i = id_getap (id) + ID_LINE(id,1) = line[1] + ID_LINE(id,2) = line[2] + } + + if (IS_INDEFD(shift[1])) + fit_shift[1] = INDEFD + else { + if (!trace) + fit_shift[1] = fit_shift[1] + shift[1] + else + fit_shift[1] = shift[1] + } + + ID_IC(id) = ic1 + call id_gdata (id) + iferr (call id_fitdata (id)) + ; + + call ri_loghdr (id, reference, logfd, nlogfd, loghdr) + loghdr = 0 + call ri_reidentify (id, fit_shift, crsearch, ans, logfd, + nlogfd, pd) + + if (ID_NFEATURES(id) < nreid) { + call ri_loghdr (id, reference, logfd, nlogfd, 3) + ID_NFEATURES(id) = 0 + if (trace) + break + } + + if (ID_NFEATURES(id) > 0) { + call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO) + call id_saveap (id) + } + } + } + + ID_IC(id) = ic + if (ic != ic1) + call ic_closed (ic1) + + call smw_close (MW(ID_SH(id))) + call imunmap (IM(ID_SH(id))) + call shdr_close (ID_SH(id)) +end + + +# RI_IMAGE -- Reidentify an image. + +procedure ri_image (id, reference, image, crsearch, ans, logfd, nlogfd, pd) + +pointer id # ID pointer +char reference[ARB] # Reference image +char image[ARB] # Image to be reidentified +double crsearch # Search radius +char ans[3] # Interactive? +int logfd[ARB] # Logfiles +int nlogfd # Number of logfiles +pointer pd # Plot file pointer + +bool newaps # Add new apertures not in reference? +bool override # Override previous identifications? +bool verbose # Verbose output? + +int i, loghdr, id_dbcheck() +double shift, fit_shift, clgetd() +pointer sp, key, ic, ic1, stp, sid, stpmark +pointer sthead(), stnext(), stname(), stfind(), id_getap() +bool clgetb() + +begin + call smark (sp) + call salloc (key, SZ_LINE, TY_CHAR) + + # Open the image and return if there is an error. + call strcpy (image, ID_IMAGE(id), ID_LENSTRING) + iferr (call id_map (id)) { + call erract (EA_WARN) + return + } + if (ID_DT(id) != NULL) + call dtunmap (ID_DT(id)) + + newaps = clgetb ("newaps") + override = clgetb ("override") + verbose = clgetb ("verbose") + + ic = ID_IC(id) + if (ans[1] == 'N') + ic1 = ic + else { + call ic_open (ic1) + call ic_copy (ic, ic1) + } + + loghdr = 2 + shift = clgetd ("shift") + + # For MULTISPEC search the reference list of each aperture. If + # a reference of the same aperture is not found and the newaps + # flag is set use the initial reference and then add the + # reidentification to the reference list. + # For NDSPEC apply each reference to the image. + + stp = ID_STP(id) + call stmark (stp, stpmark) + if (SMW_FORMAT(MW(ID_SH(id))) == SMW_ES || + SMW_FORMAT(MW(ID_SH(id))) == SMW_MS) { + for (i=1; i<=ID_MAXLINE(id,1); i=i+1) { + ID_AP(id,1) = Memi[ID_APS(id)+i-1] + ID_AP(id,2) = 1 + sid = id_getap (id) + if (sid == NULL) { + if (!newaps) { + if (verbose) { + call printf ( + "%s: Reference for aperture %d not found\n") + call pargstr (image) + call pargi (ID_AP(id,1)) + } + next + } + if (crsearch != 0.) + ID_NFEATURES(id) = 0 + } + ID_LINE(id,1) = i + + if (i == 1 && ic != ic1) + call ic_copy (ic, ic1) + + if (!override) + if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES) + next + + ID_IC(id) = ic1 + call id_gdata (id) + iferr (call id_fitdata (id)) + ; + + call ri_loghdr (id, reference, logfd, nlogfd, loghdr) + loghdr = 0 + + fit_shift = shift + call ri_reidentify (id, fit_shift, crsearch, ans, logfd, + nlogfd, pd) + + if (ID_NFEATURES(id) > 0) { + call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO) + if (sid == NULL && newaps) { + call id_saveap (id) + if (verbose) { + call printf ( + "%s: New reference for aperture %d\n") + call pargstr (image) + call pargi (ID_AP(id,1)) + } + } + } + ID_IC(id) = ic + } + + } else { + + # Go through the stored reference solutions. + # Because the symbol table might be changed in ri_reidentify + # save the key to restore the symbol pointer. + + for (sid=sthead(stp); sid!=NULL; sid=stnext(stp,sid)) { + call strcpy (Memc[stname(stp,sid)], Memc[key], SZ_LINE) + call id_gid (id, sid) + if (i == 1 && ic != ic1) + call ic_copy (ic, ic1) + + if (!override) + if (id_dbcheck (id, ID_IMAGE(id), ID_AP(id,1)) == YES) + next + + ID_IC(id) = ic1 + call id_gdata (id) + iferr (call id_fitdata (id)) + ; + + call ri_loghdr (id, reference, logfd, nlogfd, loghdr) + loghdr = 0 + + fit_shift = shift + call ri_reidentify (id, fit_shift, crsearch, ans, logfd, + nlogfd, pd) + + if (ID_NFEATURES(id) > 0) + call id_dbwrite (id, ID_IMAGE(id), ID_AP(id,1), NO) + ID_IC(id) = ic + sid = stfind (stp, Memc[key]) + } + if (sid == NULL) + ID_NFEATURES(id) = 0 + } + + ID_IC(id) = ic + if (ic != ic1) + call ic_closed (ic1) + call stfree (stp, stpmark) + call smw_close (MW(ID_SH(id))) + call imunmap (IM(ID_SH(id))) + call shdr_close (ID_SH(id)) + call sfree (sp) +end + + +# RI_REIDENTIFY -- Reidentify features using a reference image database entry. + +procedure ri_reidentify (id, fit_shift, crsearch, ans, logfd, nlogfd, pd) + +pointer id # ID pointer +double fit_shift # Shift in fit coords (input and output) +double crsearch # Search radius +char ans[3] # Interactive? +int logfd[ARB] # Logfiles +int nlogfd # Number of logfiles +pointer pd # Plot file pointer + +int i, j, nfeatures1, nfeatures2, nfit, iden, mono, clgwrd() +double shift, pix_shift, z_shift +double clgetd(), id_fitpt(), fit_to_pix() +double id_shift(), id_shift1(), id_center(), id_rms() +pointer sp, str, pix, fit +bool clgetb() +errchk id_shift, id_shift1 + +begin + call smark (sp) + + # Add features or determine a shift. + nfeatures1 = ID_NFEATURES(id) + if (nfeatures1 == 0) { + call salloc (str, SZ_LINE, TY_CHAR) + ID_FTYPE(id) = + clgwrd ("identify.ftype", Memc[str], SZ_LINE, FTYPES) + ID_FWIDTH(id) = clgetd ("identify.fwidth") + if (crsearch != 0.) + shift = id_shift (id, crsearch, -0.05D0) + else if (clgetb ("addfeatures")) { + call id_linelist (id) + shift = 0. + } + } else if (IS_INDEFD(fit_shift)) { + ID_FWIDTH(id) = FWIDTH(id,1) + ID_FTYPE(id) = FTYPE(id,1) + if (IS_INDEFD(crsearch)) + shift = id_shift1 (id) + else if (crsearch != 0.) + shift = id_shift (id, crsearch, -0.02D0) + else + shift = 0. + } else + shift = fit_shift + + nfeatures1 = ID_NFEATURES(id) + if (nfeatures1 == 0) + call error (0, "No features in reference") + call salloc (pix, nfeatures1, TY_DOUBLE) + call salloc (fit, nfeatures1, TY_DOUBLE) + call amovd (PIX(id,1), Memd[pix], nfeatures1) + call amovd (FIT(id,1), Memd[fit], nfeatures1) + + # For each reference feature a shift is added to bring the pixel + # position near that for the image being identified and then the + # centering algorithm is used. If the centering algorithm fails + # the feature is discarded. A mean shift is computed for the + # features which have been reidentified. + + do i = 1, ID_NFEATURES(id) { + PIX(id,i) = fit_to_pix (id, FIT(id,i) + shift) + PIX(id,i) = id_center (id, PIX(id,i), FWIDTH(id,i), FTYPE(id,i)) + if (!IS_INDEFD(PIX(id,i))) + FIT(id,i) = id_fitpt (id, PIX(id,i)) + } + for (i=1; i<ID_NFEATURES(id); i=i+1) { + if (IS_INDEFD(PIX(id,i))) + next + for (j=i+1; j<=ID_NFEATURES(id); j=j+1) { + if (IS_INDEFD(PIX(id,j))) + next + if (abs (PIX(id,i)-PIX(id,j)) < ID_MINSEP(id)) { + if (abs (FIT(id,i)-USER(id,i)) < abs (FIT(id,j)-USER(id,j))) + PIX(id,j) = INDEFD + else { + PIX(id,i) = INDEFD + break + } + } + } + } + + pix_shift = 0. + fit_shift = 0. + z_shift = 0. + j = 0 + do i = 1, ID_NFEATURES(id) { + if (IS_INDEFD(PIX(id,i))) + next + + pix_shift = pix_shift + PIX(id,i) - Memd[pix+i-1] + fit_shift = fit_shift + FIT(id,i) - Memd[fit+i-1] + if (Memd[fit+i-1] != 0.) + z_shift = z_shift + (FIT(id,i) - Memd[fit+i-1]) / Memd[fit+i-1] + + j = j + 1 + PIX(id,j) = PIX(id,i) + FIT(id,j) = FIT(id,i) + USER(id,j) = USER(id,i) + WTS(id,j) = WTS(id,i) + FWIDTH(id,j) = FWIDTH(id,i) + FTYPE(id,j) = FTYPE(id,i) + } + ID_NFEATURES(id) = j + + nfeatures2 = j + pix_shift = pix_shift / max (1, ID_NFEATURES(id)) + fit_shift = fit_shift / max (1, ID_NFEATURES(id)) + z_shift = z_shift / max (1, ID_NFEATURES(id)) + + # If refitting the coordinate function is requested and there is + # more than one feature and there is a previously defined + # coordinate function then refit. Otherwise compute a coordinate + # shift. + + mono = YES + if (ID_REFIT(id)==YES && ID_CV(id)!=NULL && ID_NFEATURES(id)>1) { + if (clgetb("addfeatures") && abs(pix_shift) > 0.1*ID_NPTS(id)) { + call id_doshift (id, NO) + ID_NEWFEATURES(id) = YES + } else + call id_dofit (id, NO) + } else + call id_doshift (id, NO) + if (ID_NEWCV(id) == YES) { + iferr (call id_fitdata (id)) + mono = NO + call id_fitfeatures (id) + } + + if (clgetb ("addfeatures")) { + ID_FWIDTH(id) = FWIDTH(id,1) + ID_FTYPE(id) = FTYPE(id,1) + call id_linelist (id) + if (ID_NEWFEATURES(id) == YES) { + if (ID_REFIT(id) == YES && ID_CV(id) != NULL) + call id_dofit (id, NO) + else + call id_doshift (id, NO) + if (ID_NEWCV(id) == YES) { + iferr (call id_fitdata (id)) + mono = NO + call id_fitfeatures (id) + } + } + } + + # Enter fitting interactively. + iden = NO + if ((ID_NFEATURES(id)>1) && (ID_CV(id)!=NULL)) { + if (ans[1] != 'N') { + if (ans[1] != 'Y') { + nfit = 0 + for (j=1; j<=ID_NFEATURES(id); j=j+1) + if (WTS(id,j) > 0.) + nfit = nfit + 1 + call printf ( + "%s%s%23t%3d/%-3d %3d/%-3d %9.3g %10.3g %7.3g %7.3g\n") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + call pargi (nfeatures2) + call pargi (nfeatures1) + call pargi (nfit) + call pargi (ID_NFEATURES(id)) + call pargd (pix_shift) + call pargd (fit_shift) + call pargd (z_shift) + call pargd (id_rms(id)) + call flush (STDOUT) + repeat { + ifnoerr (i = clgwrd ("answer", ans, SZ_FNAME, + "|no|yes|NO|YES|")) + break + } + call clpstr ("answer", ans) + } + switch (ans[1]) { + case 'y', 'Y': + mono = YES + i = ID_REFIT(id) + call reidentify (id) + ID_REFIT(id) = i + iden = YES + } + if (ans[1] != 'Y') + call gdeactivate (ID_GP(id), 0) + } + } + + # Record log information if a log file descriptor is given. + for (i = 1; i <= nlogfd; i = i + 1) { + if (ans[1] == 'n' && logfd[i] == STDOUT) + next + nfit = 0 + for (j=1; j<=ID_NFEATURES(id); j=j+1) + if (WTS(id,j) > 0.) + nfit = nfit + 1 + call fprintf (logfd[i], + "%s%s%23t%3d/%-3d %3d/%-3d %9.3g %10.3g %7.3g %7.3g\n") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + call pargi (nfeatures2) + call pargi (nfeatures1) + call pargi (nfit) + call pargi (ID_NFEATURES(id)) + call pargd (pix_shift) + call pargd (fit_shift) + call pargd (z_shift) + call pargd (id_rms(id)) + if (mono == NO) + call fprintf (logfd[i], "Non-monotonic dispersion function") + call flush (logfd[i]) + if (logfd[i] == STDOUT) + iden = NO + } + # Print log if STDOUT is not used but if the IDENTIFY is done. + if (iden == YES) { + call printf ( + "%s%s%23t%3d/%-3d %3d/%-3d %9.3g %10.3g %7.3g %7.3g\n") + call pargstr (ID_IMAGE(id)) + call pargstr (ID_SECTION(id)) + call pargi (nfeatures2) + call pargi (nfeatures1) + call pargi (nfit) + call pargi (ID_NFEATURES(id)) + call pargd (pix_shift) + call pargd (fit_shift) + call pargd (z_shift) + call pargd (id_rms(id)) + if (mono == NO) + call printf ("Non-monotonic dispersion function") + call flush (STDOUT) + } + + # Make log plot. + call ri_plot (id, pd) + + call sfree (sp) +end + + +# RI_LOGHDR -- Print a log header in the log files. + +procedure ri_loghdr (id, reference, logfd, nlogfd, flag) + +pointer id # Identify structure +char reference[ARB] # Reference image +int logfd[ARB] # Log file descriptors +int nlogfd # Number of log files +int flag # Header type flag (1=banner, 2=Column labels, 3=Error) + +int i +pointer str + +begin + for (i = 1; i <= nlogfd; i = i + 1) { + switch (flag) { + case 1: # Print ID + call malloc (str, SZ_LINE, TY_CHAR) + call sysid (Memc[str], SZ_LINE) + call fprintf (logfd[i], "\nREIDENTIFY: %s\n") + call pargstr (Memc[str]) + call mfree (str, TY_CHAR) + case 2: # Print labels + call fprintf (logfd[i], + " Reference image = %s, New image = %s, Refit = %b\n") + call pargstr (reference) + call pargstr (ID_IMAGE(id)) + call pargb (ID_REFIT(id) == YES) + call fprintf (logfd[i], + "%20s %7s %7s %9s %10s %7s %7s\n") + call pargstr ("Image Data") + call pargstr ("Found") + call pargstr ("Fit") + call pargstr ("Pix Shift") + call pargstr ("User Shift") + call pargstr ("Z Shift") + call pargstr ("RMS") + case 3: # Error + call fprintf (logfd[i], " ** Too many features lost **\n") + } + } +end + + +# RI_PLOT -- Plot residual graph of reidentified lines. + +procedure ri_plot (id, pd) + +pointer id # ID pointer +pointer pd # GIO pointer + +int i, j +pointer sp, str, x, y, gt, gt_init() + +begin + # Check if there is anything to plot. + if (pd == NULL || ID_NFEATURES(id) == 0) + return + + call smark (sp) + call salloc (str, SZ_LINE, TY_CHAR) + call salloc (x, ID_NFEATURES(id), TY_REAL) + call salloc (y, ID_NFEATURES(id), TY_REAL) + + # Set plot points. + j = 0 + do i = 1, ID_NFEATURES(id) { + if (IS_INDEFD(USER(id,i))) + break + + Memr[x+j] = USER(id,i) + Memr[y+j] = FIT(id,i) - USER(id,i) + j = j + 1 + } + + if (j == 0) { + call sfree (sp) + return + } + + # Make the plot. + call sprintf (Memc[str], SZ_LINE, "Reidentify: %s") + call pargstr (ID_IMAGE(id)) + gt = gt_init () + call gt_sets (gt, GTTYPE, "mark") + call gt_sets (gt, GTXLABEL, "user coordinates") + call gt_sets (gt, GTYLABEL, "residuals (fit - user)") + call gt_sets (gt, GTTITLE, Memc[str]) + call gclear (pd) + call gascale (pd, Memr[x], j, 1) + call gascale (pd, Memr[y], j, 2) + call gt_swind (pd, gt) + call gt_labax (pd, gt) + call gt_plot (pd, gt, Memr[x], Memr[y], j) + call gt_free (gt) + + call sfree (sp) +end |