00001
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032 #if HAVE_CONFIG_H
00033 #include <config.h>
00034 #endif
00035 #include <tcl.h>
00036 #include <tk.h>
00037 #include <stdio.h>
00038 #include <string.h>
00039 #include <sadie.h>
00040 #include "tclsadie.h"
00041 #include "Sadie_Index.h"
00042 #include "tclSadie_ROI.h"
00043 #if WITH_DMALLOC
00044 #include <dmalloc.h>
00045 #endif
00046
00048 extern sad_doclistp_t global_doclist;
00049
00054 static const char atitle[] = DEFAULT_TCL_ARRAY_TITLE;
00055 static const char ixaddr[] = DEFAULT_IN_IMAGE_ADDR_INDEX;
00056 static const char ixname[] = DEFAULT_OUT_IMAGE_NAME_INDEX;
00057 static const char roiprop[] = ROI_PROPERTY_NAME;
00083 static int
00084 set_class_summary_vec (Tcl_Interp *interp, Tcl_Obj *tclimgarray,
00085 int ixclass, IMAGE *img, ROIPtr regionlisthead,
00086 double *mean_vec, double *sd_vec)
00087 {
00088 uint32_t nreg, iband, jband, kband;
00089 uint64_t m;
00090 int included;
00091 ROIPtr region;
00092 char index[SLEN];
00093
00094 if ((!interp) || (!tclimgarray) || (!img) || (!regionlisthead)
00095 || (!mean_vec) || (!sd_vec))
00096 return TCL_ERROR;
00097 m = 0;
00098 for (iband = 0; iband < img->nbnd; iband++)
00099 {
00100 mean_vec[iband] = 0;
00101 sd_vec[iband] = 0;
00102 }
00103 for (nreg = 1, region = regionlisthead;
00104 region != NULL;
00105 region = region->next, nreg++)
00106 {
00107
00108 snprintf (index, SLEN - 1, "class,%d,%u", ixclass, nreg);
00109 if (GetSadieBooleanFromObj2 (interp, tclimgarray, (const char *) index,
00110 &included) != TCL_OK)
00111 return TCL_ERROR;
00112 if (included)
00113 {
00114 for (jband = 0; jband < img->nbnd; jband++)
00115 {
00116 mean_vec[jband] += region->nval * region->mean[jband];
00117 sd_vec[jband] += region->nval
00118 * ((region->mean[jband] * region->mean[jband])
00119 + (region->dev[jband] * region->dev[jband]));
00120 }
00121 m += region->nval;
00122 }
00123 }
00124 if (m == 0)
00125 return TCL_ERROR;
00126 for (kband = 0; kband < img->nbnd; kband++)
00127 {
00128 mean_vec[kband] /= m;
00129 sd_vec[kband] = sqrt ((sd_vec[kband] / m)
00130 - (mean_vec[kband] * mean_vec[kband]));
00131 }
00132 return TCL_OK;
00133 }
00134
00159 int
00160 Sadie_Classify_LvlSliceCmd (ClientData client_data, Tcl_Interp *interp,
00161 int objc, Tcl_Obj * const objv[])
00162 {
00163 Tcl_Obj *tclindexname = NULL;
00164 Tcl_Obj *tclimgarray = NULL;
00165 IMAGE *inimg = NULL;
00166 IMAGE *outimg = NULL;
00167 int numclasses, iclass;
00168 uint32_t iband;
00169 PIXEL thresh;
00170 PIXEL *grng = NULL;
00171 PIXEL *base = NULL;
00172 ROIPtr regionlist = NULL;
00173 double *mean = NULL;
00174 double *sd = NULL;
00175 char msg[SLEN];
00176 const char *dkey;
00177 int err = TCL_OK;
00178
00179 if (objc != 2)
00180 {
00181 Tcl_WrongNumArgs (interp, 1, objv, atitle);
00182 return TCL_ERROR;
00183 }
00184 if ((GetSadieImageFromObj2 (interp, objv[1], ixaddr, &inimg)
00185 != TCL_OK)
00186 || (GetSadieDkeyFromObj2 (interp, objv[1], ixaddr, &dkey)
00187 != TCL_OK)
00188 || (GetSadieIntFromObj2 (interp, objv[1], "numclasses", &numclasses)
00189 != TCL_OK)
00190 || (GetSadiePixelFromObj2 (interp, objv[1], "thresh", &thresh)
00191 != TCL_OK))
00192 return TCL_ERROR;
00193 if (numclasses == 0)
00194 {
00195 MESSAGE ('E', " No classes defined.");
00196 return TCL_OK;
00197 }
00198
00199 tclindexname = Tcl_NewStringObj ("inimg,array", -1);
00200 Tcl_IncrRefCount (tclindexname);
00201 tclimgarray = Tcl_ObjGetVar2 (interp, objv[1], tclindexname,
00202 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00203 Tcl_DecrRefCount (tclindexname);
00204 if (tclimgarray == NULL)
00205 return TCL_ERROR;
00206 else
00207 Tcl_IncrRefCount (tclimgarray);
00208
00209 grng = calloc (((size_t)numclasses * inimg->nbnd * 2), sizeof (PIXEL));
00210 if (grng != NULL)
00211 {
00212 mean = calloc (inimg->nbnd, sizeof (double));
00213 if (mean == NULL)
00214 free (grng);
00215 else
00216 {
00217 sd = calloc (inimg->nbnd, sizeof (double));
00218 if (sd == NULL)
00219 {
00220 free (mean);
00221 free (grng);
00222 }
00223 }
00224 }
00225 if (sd == NULL)
00226 {
00227 Tcl_DecrRefCount (tclimgarray);
00228 Tcl_SetStringObj (Tcl_GetObjResult (interp),
00229 "Could not allocate memory!", -1);
00230 return TCL_ERROR;
00231 }
00232 regionlist = sad_get_doc_property (global_doclist, dkey, roiprop);
00233 if (regionlist == NULL)
00234 {
00235 free (sd);
00236 free (mean);
00237 free (grng);
00238 Tcl_DecrRefCount (tclimgarray);
00239 Tcl_SetStringObj (Tcl_GetObjResult (interp),
00240 "Could not find training areas.", -1);
00241 return TCL_ERROR;
00242 }
00243 for (iclass = 0; (err == TCL_OK) && (iclass < numclasses); iclass++)
00244 {
00245 err = set_class_summary_vec (interp, tclimgarray, iclass + 1,
00246 inimg, regionlist, mean, sd);
00247 if (err != TCL_OK)
00248 {
00249 snprintf (msg, SLEN - 1,
00250 " No training area defined for class %d.", iclass + 1);
00251 MESSAGE ('E', msg);
00252 }
00253 else
00254 {
00255 for (iband = 0; iband < inimg->nbnd; iband++)
00256 {
00257 base
00258 = (grng
00259 + (((size_t) iclass * inimg->nbnd * 2) + (iband * 2)));
00260 *base
00261 = (PIXEL) (mean[iband] - (thresh * sd[iband]));
00262 *(base + 1)
00263 = (PIXEL) (mean[iband] + (thresh * sd[iband]));
00264 }
00265 }
00266 }
00267 free (mean);
00268 free (sd);
00269 if (err == TCL_OK)
00270 LVLSLICE (inimg, grng, numclasses, &outimg);
00271 Tcl_DecrRefCount (tclimgarray);
00272 free (grng);
00273 return (err == TCL_OK)
00274 ? SetSadieImageObj2 (interp, objv[1], ixname, outimg)
00275 : TCL_OK;
00276 }
00277
00309 int
00310 Sadie_Classify_MinDistCmd (ClientData client_data, Tcl_Interp *interp,
00311 int objc, Tcl_Obj * const objv[])
00312 {
00313 int iclass, nreg;
00314 uint32_t jband, kband;
00315 uint64_t m, n;
00316 size_t a, b;
00317 Tcl_Obj *tclindexname = NULL;
00318 Tcl_Obj *tclimgarray = NULL;
00319 char msg[SLEN];
00320 const char *dkey;
00321 IMAGE *inimg = NULL;
00322 IMAGE *outimg = NULL;
00323 int numclasses, option, included;
00324 char index[SLEN];
00325 ROIPtr region = NULL;
00326 ROIPtr regionlist = NULL;
00327 double *mean = NULL;
00328 double *cov = NULL;
00329
00330 if (objc != 2)
00331 {
00332 Tcl_WrongNumArgs (interp, 1, objv, atitle);
00333 return TCL_ERROR;
00334 }
00335 if ((GetSadieImageFromObj2 (interp, objv[1], ixaddr, &inimg)
00336 != TCL_OK)
00337 || (GetSadieDkeyFromObj2 (interp, objv[1], ixaddr, &dkey)
00338 != TCL_OK)
00339 || (GetSadieIntFromObj2 (interp, objv[1], "numclasses", &numclasses)
00340 != TCL_OK)
00341 || (GetSadieIntFromObj2 (interp, objv[1], "option", &option)
00342 != TCL_OK))
00343 return TCL_ERROR;
00344 if (numclasses == 0)
00345 {
00346 MESSAGE ('E', " No classes defined.");
00347 return TCL_OK;
00348 }
00349
00350 tclindexname = Tcl_NewStringObj ("inimg,array", -1);
00351 Tcl_IncrRefCount (tclindexname);
00352 tclimgarray = Tcl_ObjGetVar2 (interp, objv[1], tclindexname,
00353 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00354 Tcl_DecrRefCount (tclindexname);
00355 if (tclimgarray == NULL)
00356 return TCL_ERROR;
00357 else
00358 Tcl_IncrRefCount (tclimgarray);
00359 mean = calloc (((size_t)inimg->nbnd * numclasses), sizeof (double));
00360 if (mean != NULL)
00361 {
00362 cov = calloc (((size_t)inimg->nbnd * inimg->nbnd), sizeof (double));
00363 if (cov == NULL)
00364 free (mean);
00365 }
00366 if (cov == NULL)
00367 {
00368 Tcl_DecrRefCount (tclimgarray);
00369 Tcl_SetStringObj (Tcl_GetObjResult (interp),
00370 "Memory request failed!", -1);
00371 return TCL_ERROR;
00372 }
00373 regionlist = sad_get_doc_property (global_doclist, dkey, roiprop);
00374 if (regionlist == NULL)
00375 {
00376 free (cov);
00377 free (mean);
00378 Tcl_DecrRefCount (tclimgarray);
00379 Tcl_SetStringObj (Tcl_GetObjResult (interp),
00380 "Could not find training areas.", -1);
00381 return TCL_ERROR;
00382 }
00383 m = 0;
00384 for (iclass = 0; iclass < numclasses; iclass++)
00385 {
00386 n = 0;
00387 for (nreg = 1, region = regionlist;
00388 region != NULL;
00389 region = region->next, nreg++)
00390 {
00391
00392 snprintf (index, SLEN - 1, "class,%d,%d", iclass + 1, nreg);
00393 if (GetSadieBooleanFromObj2 (interp, tclimgarray,
00394 (const char *) index, &included)
00395 != TCL_OK)
00396 {
00397 free (cov);
00398 free (mean);
00399 Tcl_DecrRefCount (tclimgarray);
00400 return TCL_ERROR;
00401 }
00402 if (included)
00403 {
00404 for (jband = 0; jband < inimg->nbnd; jband++)
00405 mean[jband + iclass * inimg->nbnd]
00406 += region->nval * region->mean[jband];
00407 for (a = 0; a < (inimg->nbnd * inimg->nbnd); a++)
00408 cov[a] += region->nval * region->cov[a];
00409 n += region->nval;
00410 }
00411 }
00412 if (n > 0)
00413 {
00414 for (kband = 0; kband < inimg->nbnd; kband++)
00415 mean[kband + iclass * inimg->nbnd] /= n;
00416 m += n;
00417 }
00418 else
00419 {
00420 free (cov);
00421 free (mean);
00422 Tcl_DecrRefCount (tclimgarray);
00423 snprintf (msg, SLEN - 1, " No training area defined for class %d.",
00424 iclass + 1);
00425 MESSAGE ('E', msg);
00426 return TCL_OK;
00427 }
00428 }
00429 Tcl_DecrRefCount (tclimgarray);
00430 for (b = 0; b < (inimg->nbnd * inimg->nbnd); b++)
00431 cov[b] /= m;
00432 MINDIST (inimg, option, numclasses, mean, cov, &outimg);
00433 free (mean);
00434 free (cov);
00435 return SetSadieImageObj2 (interp, objv[1], ixname, outimg);
00436 }
00437
00438
00444 int
00445 Sadie_Classify_MaxLikeCmd (ClientData client_data, Tcl_Interp *interp,
00446 int objc, Tcl_Obj * const objv[])
00447 {
00448 int iclass, nreg;
00449 uint64_t n;
00450 size_t a, b;
00451 Tcl_Obj *tclindexname = NULL;
00452 Tcl_Obj *tclimgarray = NULL;
00453 IMAGE *inimg = NULL;
00454 IMAGE *outimg = NULL;
00455 int numclasses, included;
00456 double theprob;
00457 double *prob = NULL;
00458 double *cov = NULL;
00459 ROIPtr region = NULL;
00460 ROIPtr regionlist = NULL;
00461 char msg[SLEN];
00462 char index[SLEN];
00463 const char *dkey;
00464
00465 if (objc != 2)
00466 {
00467 Tcl_WrongNumArgs (interp, 1, objv, atitle);
00468 return TCL_ERROR;
00469 }
00470 if ((GetSadieImageFromObj2 (interp, objv[1], ixaddr, &inimg)
00471 != TCL_OK)
00472 || (GetSadieDkeyFromObj2 (interp, objv[1], ixaddr, &dkey)
00473 != TCL_OK)
00474 || (GetSadieIntFromObj2 (interp, objv[1], "numclasses", &numclasses)
00475 != TCL_OK)
00476 || (GetSadieDoubleFromObj2 (interp, objv[1], "prob", &theprob)
00477 != TCL_OK))
00478 return TCL_ERROR;
00479 if (numclasses == 0)
00480 {
00481 MESSAGE ('E', " No classes defined.");
00482 return TCL_OK;
00483 }
00484
00485 tclindexname = Tcl_NewStringObj ("inimg,array", -1);
00486 Tcl_IncrRefCount (tclindexname);
00487 tclimgarray = Tcl_ObjGetVar2 (interp, objv[1], tclindexname,
00488 TCL_GLOBAL_ONLY | TCL_LEAVE_ERR_MSG);
00489 Tcl_DecrRefCount (tclindexname);
00490 if (tclimgarray == NULL)
00491 return TCL_ERROR;
00492 else
00493 Tcl_IncrRefCount (tclimgarray);
00494 prob = calloc ((size_t)numclasses, sizeof (double));
00495 if (prob != NULL)
00496 {
00497 cov = calloc(((size_t)numclasses * inimg->nbnd * inimg->nbnd),
00498 sizeof (double));
00499 if (cov == NULL)
00500 free (prob);
00501 }
00502 if (cov == NULL)
00503 {
00504 Tcl_SetStringObj (Tcl_GetObjResult (interp),
00505 "Memory request failed!", -1);
00506 Tcl_DecrRefCount (tclimgarray);
00507 return TCL_ERROR;
00508 }
00509 regionlist = sad_get_doc_property (global_doclist, dkey, roiprop);
00510 if (regionlist == NULL)
00511 {
00512 free (cov);
00513 free (prob);
00514 Tcl_DecrRefCount (tclimgarray);
00515 Tcl_SetStringObj (Tcl_GetObjResult (interp),
00516 "Could not find training areas.", -1);
00517 return TCL_ERROR;
00518 }
00519 for (iclass = 0; iclass < numclasses; iclass++)
00520 {
00521 prob[iclass] = theprob;
00522 n = 0;
00523 for (nreg = 1, region = regionlist;
00524 region != NULL;
00525 region = region->next, nreg++)
00526 {
00527
00528 snprintf (index, SLEN - 1, "class,%d,%d", iclass + 1, nreg);
00529 if (GetSadieBooleanFromObj2 (interp, tclimgarray,
00530 (const char *) index, &included)
00531 != TCL_OK)
00532 {
00533 free (prob);
00534 free (cov);
00535 Tcl_DecrRefCount (tclimgarray);
00536 return TCL_ERROR;
00537 }
00538 if (included)
00539 {
00540 n += region->nval;
00541 for (a = 0; a < (inimg->nbnd * inimg->nbnd); a++)
00542 cov[a + iclass * inimg->nbnd * inimg->nbnd]
00543 += region->nval * region->cov[a];
00544 }
00545 }
00546 if (n > 0)
00547 {
00548 for (b = 0; b < (inimg->nbnd * inimg->nbnd); b++)
00549 cov[b + iclass * inimg->nbnd * inimg->nbnd] /= n;
00550 }
00551 else
00552 {
00553 free (prob);
00554 free (cov);
00555 Tcl_DecrRefCount (tclimgarray);
00556 snprintf (msg, SLEN - 1, " No training area defined for class %d.",
00557 iclass + 1);
00558 MESSAGE ('E', msg);
00559 return TCL_OK;
00560 }
00561 }
00562 Tcl_DecrRefCount (tclimgarray);
00563 MAXLIKE (inimg, numclasses, cov, prob, &outimg);
00564 free (prob);
00565 free (cov);
00566 return SetSadieImageObj2 (interp, objv[1], ixname, outimg);
00567 }
00568
00594 int
00595 Sadie_Classify_ClusterCmd (ClientData client_data, Tcl_Interp *interp,
00596 int objc, Tcl_Obj * const objv[])
00597 {
00598 IMAGE *inimg = NULL;
00599 IMAGE *outimg = NULL;
00600 int iter, classes, min, incr;
00601 PIXEL merging, outlier;
00602
00603 if (objc != 2)
00604 {
00605 Tcl_WrongNumArgs (interp, 1, objv, atitle);
00606 return TCL_ERROR;
00607 }
00608 if ((GetSadieImageFromObj2 (interp, objv[1], ixaddr, &inimg)
00609 != TCL_OK)
00610 || (GetSadieIntFromObj2 (interp, objv[1], "iter", &iter)
00611 != TCL_OK)
00612 || (GetSadieIntFromObj2 (interp, objv[1], "classes", &classes)
00613 != TCL_OK)
00614 || (GetSadieIntFromObj2 (interp, objv[1], "min", &min)
00615 != TCL_OK)
00616 || (GetSadieIntFromObj2 (interp, objv[1], "incr", &incr)
00617 != TCL_OK)
00618 || (GetSadiePixelFromObj2 (interp, objv[1], "merging", &merging)
00619 != TCL_OK)
00620 || (GetSadiePixelFromObj2 (interp, objv[1], "outlier", &outlier)
00621 != TCL_OK))
00622 return TCL_ERROR;
00623 CLUSTER (inimg, iter, classes, min, merging, 1, incr, incr, outlier,
00624 &outimg);
00625 return SetSadieImageObj2 (interp, objv[1], ixname, outimg);
00626 }
00627
00647 int
00648 Sadie_Classify_SegmentCmd (ClientData client_data, Tcl_Interp *interp,
00649 int objc, Tcl_Obj * const objv[])
00650 {
00651 IMAGE *inimg = NULL;
00652 IMAGE *outimg = NULL;
00653 int steps;
00654 double sigma;
00655 PIXEL thresh;
00656
00657 if (objc != 2)
00658 {
00659 Tcl_WrongNumArgs (interp, 1, objv, atitle);
00660 return TCL_ERROR;
00661 }
00662 if ((GetSadieImageFromObj2 (interp, objv[1], ixaddr, &inimg)
00663 != TCL_OK)
00664 || (GetSadieIntFromObj2 (interp, objv[1], "steps", &steps)
00665 != TCL_OK)
00666 || (GetSadieDoubleFromObj2 (interp, objv[1], "sigma", &sigma)
00667 != TCL_OK)
00668 || (GetSadiePixelFromObj2 (interp, objv[1], "thresh", &thresh)
00669 != TCL_OK))
00670 return TCL_ERROR;
00671 SEGMENT (inimg, steps, sigma, thresh, &outimg);
00672 return SetSadieImageObj2 (interp, objv[1], ixname, outimg);
00673 }
00674
00692 int
00693 Sadie_Classify_SigMapCmd (ClientData client_data, Tcl_Interp *interp,
00694 int objc, Tcl_Obj * const objv[])
00695 {
00696 IMAGE *lblmap = NULL;
00697 IMAGE *origimg = NULL;
00698 IMAGE *outimg = NULL;
00699
00700 if (objc != 2)
00701 {
00702 Tcl_WrongNumArgs (interp, 1, objv, atitle);
00703 return TCL_ERROR;
00704 }
00705 if ((GetSadieImageFromObj2 (interp, objv[1], "lblmap,addr", &lblmap)
00706 != TCL_OK)
00707 || (GetSadieImageFromObj2 (interp, objv[1], "origimg,addr", &origimg)
00708 != TCL_OK))
00709 return TCL_ERROR;
00710 SIGMAP (lblmap, origimg, &outimg);
00711 return SetSadieImageObj2 (interp, objv[1], ixname, outimg);
00712 }
00713
00720 int
00721 Sadie_Classify_Init (Tcl_Interp *interp)
00722 {
00723 Tcl_CreateObjCommand (interp, "Sadie_Classify_LvlSlice",
00724 Sadie_Classify_LvlSliceCmd, NULL, NULL);
00725 Tcl_CreateObjCommand (interp, "Sadie_Classify_MinDist",
00726 Sadie_Classify_MinDistCmd, NULL, NULL);
00727 Tcl_CreateObjCommand (interp, "Sadie_Classify_MaxLike",
00728 Sadie_Classify_MaxLikeCmd, NULL, NULL);
00729 Tcl_CreateObjCommand (interp, "Sadie_Classify_Cluster",
00730 Sadie_Classify_ClusterCmd, NULL, NULL);
00731 Tcl_CreateObjCommand (interp, "Sadie_Classify_Segment",
00732 Sadie_Classify_SegmentCmd, NULL, NULL);
00733 Tcl_CreateObjCommand (interp, "Sadie_Classify_SigMap",
00734 Sadie_Classify_SigMapCmd, NULL, NULL);
00735 return TCL_OK;
00736 }
00737