use and do not ignore alpha in helper method
[trakem2.git] / lineage / identify.clj
blob5621894f165c72cecd4b705290763826dcc180de
1 (ns lineage.identify
2   (:import
3      (lineage LineageClassifier)
4      (java.io InputStreamReader FileInputStream PushbackReader)
5      (javax.vecmath Point3d)
6      (javax.swing JTable JFrame JScrollPane JPanel JLabel BoxLayout JPopupMenu JMenuItem)
7      (javax.swing.table AbstractTableModel DefaultTableCellRenderer)
8      (java.awt.event MouseAdapter ActionListener)
9      (java.awt Color Dimension Component)
10      (java.util Map)
11      (mpicbg.models AffineModel3D)
12      (ij.measure Calibration)
13      (ini.trakem2.utils Utils)
14      (ini.trakem2.display Display Display3D LayerSet)
15      (ini.trakem2.analysis Compare)
16      (ini.trakem2.vector VectorString3D Editions))
17   (:use [clojure.set :only (intersection)]))
19 (defmacro report
20   [& args]
21   `(ij.IJ/log (str ~@args)))
23 (defn- as-VectorString3D
24   "Convert a map of {\"name\" {:x (...) :y (...) :z (...)}} into a map of {\"name\" (VectorString3D. ...)}"
25   [SATs]
26   (map
27     (fn [e]
28       {(key e)
29        (let [data (val e)]
30          (VectorString3D. (into-array Double/TYPE (data :x))
31                           (into-array Double/TYPE (data :y))
32                           (into-array Double/TYPE (data :z))
33                           false))})
34     SATs))
36 (defn- load-SAT-lib-as-vs
37   "Returns the SATs library with VectorString3D instances"
38   [filepath]
39   (reduce
40     (fn [m e]
41       (let [label (key e)
42             data (val e)]
43         (assoc m
44                label
45                (assoc data :SATs (as-VectorString3D (data :SATs))))))
46     {}
47     (read
48       (PushbackReader.
49         (InputStreamReader. (FileInputStream. filepath))
50         4096))))
52 (defn- fids-as-Point3d
53   "Convert a map like {\"blva_joint\" [70.62114008906023 140.07819545137772 -78.72010436407604] ...}
54   into a sorted map of {\"blva_joint\" (Point3d ...)}"
55   [fids]
56   (reduce
57     (fn [m e]
58       (let [xyz (val e)]
59         (assoc m (key e) (Point3d. (double (get xyz 0))
60                                    (double (get xyz 1))
61                                    (double (get xyz 2))))))
62     {}
63     fids))
65 (defn- register-SATs
66   "Returns a map of SAT name vs VectorString3D,
67    where the VectorString3D is registered to the target fids."
68   [brain-label brain-data target-fids]
69   (let [source-fids (fids-as-Point3d (brain-data :fiducials))
70         SATs (into (sorted-map) (brain-data :SATs))
71         common-fid-keys (intersection (into #{} (keys source-fids)) (into #{} (keys target-fids)))
72         vs (Compare/transferVectorStrings (vals SATs)
73                                           (vals (into (sorted-map) (select-keys source-fids common-fid-keys)))
74                                           (vals (into (sorted-map) (select-keys target-fids common-fid-keys)))
75                                           AffineModel3D)]
76     (zipmap
77       (map #(str (.replaceAll % "\\[.*\\] " " [") \space brain-label \]) (keys SATs))
78       vs)))
80 (defn- load-mb
81   [SAT-lib reference-brain]
82   (let [r (re-pattern (str "peduncle . (dorsal|medial) lobe.*" reference-brain ".*"))]
83     (loop [sl SAT-lib
84            mb {}]
85       (if (= 2 (count mb))
86         mb
87         (if-let [[k v] (first sl)]
88           (recur (next sl)
89                  (if (re-matches r k)
90                    (into mb {k v})
91                    mb)))))))
93 (def ^:dynamic *libs* (ref {}))
95 (defn- load-SAT-lib
96   "Load the named SAT-lib from filepath into *libs* and returns it.
97   Will setup the reference set of fiducial points and the mushroom body lobes from the entry named by reference brain,
98   as we as register all SATs to the reference brain."
99   [lib]
100   (let [SAT-lib (load-SAT-lib-as-vs (lib "filepath"))
101         reference (let [r (SAT-lib (lib "reference"))]
102                     (if r
103                       r
104                       ; Else, use the first brain of the set as reference
105                       (let [rr (first (keys SAT-lib))]
106                         (println "Could not find reference brain '" (lib "reference") "'\n  Instead, using as reference brain: " rr)
107                         (SAT-lib rr))))
108         target-fids (fids-as-Point3d (reference :fiducials))
109         SATs (reduce
110                (fn [m e]
111                  (conj m (register-SATs (key e) (val e) target-fids)))
112                {}
113                SAT-lib)]
114     (dosync
115       (commute *libs* (fn [libs]
116                         (assoc libs (lib "title") {:filepath (lib "filepath")
117                                                    :SATs SATs
118                                                    :fids target-fids
119                                                    :mb (load-mb SATs (lib "reference"))})))))
120   (@*libs* (lib "title")))
123 (defn forget-libs
124   []
125   (dosync
126     (commute *libs* (fn [_] {}))))
128 (defn- register-vs
129   "Register a singe VectorString3D from source-fids to target-fids."
130   [vs source-fids target-fids]
131   (let [common-fid-keys (intersection (into #{} (keys source-fids)) (into #{} (keys target-fids)))]
132     (if (empty? common-fid-keys)
133       nil
134       (first (Compare/transferVectorStrings [vs]
135                                      (vals (into (sorted-map) (select-keys source-fids common-fid-keys)))
136                                      (vals (into (sorted-map) (select-keys target-fids common-fid-keys)))
137                                      AffineModel3D)))))
139 (defn resample
140   "Returns a resampled copy of vs."
141   [vs delta]
142   (let [copy (.clone vs)]
143     (.resample copy delta)
144     copy))
146 (defn- match-all
147   "Returns a vector of two elements; the first element is the list of matches
148   of the query-vs against all SAT vs in the library sorted by mean euclidean distance,
149   and labeled as correct of incorrect matches according to the Random Forest classifier.
150   The second element is a list of corresponding SAT names for each match.
151   Assumes the query-vs is already registered to the corresponding SAT-lib reference fiducials."
152   [SATs query-vs delta direct substring]
153   (let [vs1 (resample query-vs delta)   ; query-vs is already registered into FRT42-fids
154         matches (sort
155                   #(int (- (%1 :med) (%2 :med)))
156                   (doall (pmap
157                     (fn [e]
158                       (let [vs2 (let [copy (.clone (val e))]
159                                   (.resample copy delta)
160                                   copy)
161                             c (Compare/findBestMatch vs1 vs2
162                                                      (double delta) false (int 5) (float 0.5) Compare/AVG_PHYS_DIST
163                                                      direct substring
164                                                      (double 1.1) (double 1.1) (double 1))
165                             stats (.getStatistics (get c 0) false (int 0) (float 0) false)]
166                         {:SAT-name (key e)
167                          :stats stats
168                          :med (get stats 0)
169                          :correct (LineageClassifier/classify stats)}))
170                     SATs)))]
171     ; Cleanup thread table
172     (LineageClassifier/flush)
174     [matches
175      (map (fn [match]
176             (match :SAT-name))
177             matches)]))
179 (defn text-width
180   "Measure the width, in pixels, of the String text, by the Font and FontMetrics of component."
181   [#^String text #^Component component]
182   ; Get the int[] of widths of the first 256 chars
183   (let [#^ints ws (.getWidths (.getFontMetrics component (.getFont component)))]
184     (reduce (fn [sum c]
185               (if (< (int c) (int 256))
186                 (+ sum (aget ws (int c)))
187                 sum))
188             0
189             text)))
191 (defn- identify-SAT
192   "Takes a calibrated VectorString3D and a list of fiducial points, and checks against the library for identity.
193   For consistency in the usage of the Random Forest classifier, the registration is done into the FRT42D-BP106 brain."
194   [pipe SAT-lib query-vs fids delta direct substring]
195   (let [SATs (SAT-lib :SATs)
196         vs1 (register-vs query-vs fids (SAT-lib :fids))
197         [matches names] (match-all SATs vs1 delta direct substring)
198         SAT-names (vec names)
199         indexed (vec matches)
200         column-names ["SAT" "Match" "Seq sim %" "Lev Dist" "Med Dist" "Avg Dist" "Cum Dist" "Std Dev" "Prop Mut" "Prop Lengths" "Proximity" "Prox Mut" "Tortuosity"]
201         worker (agent nil) ; for event dispatch
202         table (JTable. (proxy [AbstractTableModel] []
203                 (getColumnName [col]
204                   (get column-names col))
205                 (getRowCount []
206                   (count matches))
207                 (getColumnCount []
208                   (count column-names))
209                 (getValueAt [row col]
210                   (let [match (get indexed row)
211                         stats (match :stats)]
212                     (cond
213                       (= col 0) (get SAT-names row)
214                       (= col 1) (str (match :correct))    ; Whether the classifier considered it correct or not
215                       true (Utils/cutNumber
216                             (cond
217                               (= col 2) (* 100 (get stats 6))       ; Similarity
218                               (= col 3) (get stats 5)       ; Levenshtein
219                               (= col 4) (get stats 3)       ; Median Physical Distance
220                               (= col 5) (get stats 0)       ; Average Physical Distance
221                               (= col 6) (get stats 1)       ; Cummulative Physical Distance
222                               (= col 7) (get stats 2)       ; Std Dev
223                               (= col 8) (get stats 4)       ; Prop Mut
224                               (= col 9) (get stats 9)       ; Prop Lengths
225                               (= col 10) (get stats 7)      ; Proximity
226                               (= col 11) (get stats 8)      ; Prox Mut
227                               (= col 12) (get stats 10))    ; Tortuosity
228                             2))))
229                 (isCellEditable [row col]
230                   false)
231                 (setValueAt [ob row col] nil)))
232         frame (JFrame. (str "Matches for " pipe))
233         dummy-ls (LayerSet. (.. Display getFront getProject) (long -1) "Dummy" (double 0) (double 0) (double 0) (double 0) (double 0) (double 512) (double 512) false (int 0) (java.awt.geom.AffineTransform.))]
234     (.setCellRenderer (.getColumn table "Match")
235                       (proxy [DefaultTableCellRenderer] []
236                         (getTableCellRendererComponent [t v sel foc row col]
237                           (proxy-super setText (str v))
238                           (proxy-super setBackground
239                                           (if (Boolean/parseBoolean v)
240                                             (Color. 166 255 166)
241                                             (if sel
242                                               (Color. 184 207 229)
243                                               Color/white)))
244                                               
245                           this)))
246     (.add frame (JScrollPane. table))
247     (.setSize frame (int 950) (int 550))
248     (.addMouseListener table
249                        (proxy [MouseAdapter] []
250                          (mousePressed [ev]
251                            (try
252                              (clear-agent-errors worker) ; I don't care what it was
253                              (catch Exception e))
254                            (send-off worker
255                              (fn [_]
256                                (let [match (indexed (.rowAtPoint table (.getPoint ev)))
257                                      show-match (fn []
258                                                   (Display3D/addMesh dummy-ls
259                                                                      (resample (.clone vs1) delta)
260                                                                      "Query"
261                                                                      Color/yellow)
262                                                   (Display3D/addMesh dummy-ls
263                                                                      (resample (SATs (match :SAT-name)) delta)
264                                                                      (match :SAT-name)
265                                                                      (if (match :correct)
266                                                                        Color/red
267                                                                        Color/blue)))]
268                                  (cond
269                                    ; On double-click, show 3D view of the match:
270                                    (= 2 (.getClickCount ev))
271                                      (show-match)
272                                    ; On right-click, show menu
273                                    (Utils/isPopupTrigger ev)
274                                      (let [popup (JPopupMenu.)
275                                            new-command (fn [title action]
276                                                          (let [item (JMenuItem. title)]
277                                                            (.addActionListener item (proxy [ActionListener] []
278                                                                                       (actionPerformed [evt]
279                                                                                         (send-off worker (fn [_] (action))))))
280                                                            item))]
281                                        (doto popup
282                                          (.add (new-command "Show match in 3D"
283                                                             show-match))
284                                          (.add (new-command "Show Mushroom body"
285                                                             #(doseq [[k v] (SAT-lib :mb)]
286                                                               (Display3D/addMesh dummy-ls v k Color/gray))))
287                                          (.add (new-command "Show interpolated"
288                                                             #(Display3D/addMesh dummy-ls
289                                                                                 (VectorString3D/createInterpolatedPoints
290                                                                                   (Editions. (SATs (match :SAT-name)) (.clone vs1) delta false (double 1.1) (double 1.1) (double 1)) (float 0.5))
291                                                                                 (str "Interpolated with " (match :SAT-name)) Color/magenta)))
292                                          (.add (new-command "Show stdDev plot"
293                                                             #(let [cp (ini.trakem2.analysis.Compare$CATAParameters.)]
294                                                               (if (.setup cp false nil true true)
295                                                                 (let [condensed (VectorString3D/createInterpolatedPoints
296                                                                                   (let [v1 (.clone vs1)
297                                                                                         v2 (SATs (match :SAT-name))]
298                                                                                         (.resample v1 delta true)
299                                                                                         (.resample v2 delta true)
300                                                                                         (Editions. v1 v2 delta false (double 1.1) (double 1.1) (double 1)))
301                                                                                   (float 0.5))
302                                                                       _ (let [c1 (Calibration.); Dummy default calibration but with same units as the pipe.
303                                                                                                ; VectorString3D instances are already calibrated.
304                                                                               c2 (.. pipe getLayerSet getCalibrationCopy)]
305                                                                           (.setUnit c1 (.getUnit c2))
306                                                                           (.calibrate condensed c1))
307                                                                       _ (set! (. cp plot_max_x) (.length condensed))
308                                                                       plot (Compare/makePlot cp (str "Query versus " (match :SAT-name)) condensed)]
309                                                                   ; There are lazy evaluations ... that need to be promoted: lets print some data:
310                                                                   (println "plot is" plot " and condensed has " (.getStdDevAtEachPoint condensed))
311                                                                   (if plot
312                                                                     (.show plot)
313                                                                     (report "ERROR: could not make a plot!")))))))
314                                          (.show table (.getX ev) (.getY ev)))))))))))
316     ; Enlarge the cell width of the first column
317     (.setMinWidth (.. table getColumnModel (getColumn 0)) (int 250))
318     (doto frame
319       ;(.pack)
320       (.setVisible true))))
322 (defn fetch-lib
323   "Returns the SAT lib for the given name, loading it if not there yet. Nil otherwise."
324   [lib]
325   (if-let [cached (@*libs* (lib "title"))]
326     cached
327     (try
328       (load-SAT-lib lib)
329       (catch Exception e
330         (do
331           (report "An error ocurred while loading the SAT library '" (lib "title") ": " e "\nCheck the terminal output.")
332           (.printStackTrace e))))))
335 (defn extract-fiducial-points
336   "Find a set of fiducial points in the project.
337   Will find the first node of type 'fiducial_points' and recursively inspect
338   its children nodes for nodes of type 'ball'. To each found 'ball', it will
339   assign the name of the ball node itself or the first superior node that
340   has a name different that this type.
341   Returns nil if none found."
342   [project]
343   (if-let [fp-node (.. project getRootProjectThing (findChildrenOfTypeR "fiducial_points"))]
344     (if-let [ball-nodes (.findChildrenOfTypeR (first fp-node) "ball")]
345       (let [fids (reduce
346                    (fn [fids pt-ball]
347                      (let [title (.. pt-ball getObject getTitle) ; the title of the Ball ob itself, if any
348                            b (.. pt-ball getObject getWorldBalls)]
349                        (if (= 0 (count b))
350                          (do
351                            (println "WARNING: empty ball object" (.getObject pt-ball))
352                            fids)
353                          (do
354                            (if (> (count b) 1)
355                              (println "WARNING: ball object with more than one ball:" (.getObject pt-ball)))
356                            (assoc fids
357                                   (-> (if (not (= title (.getType pt-ball)))
358                                         title
359                                         (.. pt-ball getParent getTitle))
360                                       (.toLowerCase)
361                                       (.replace \space \_))
362                                   (let [b0 (get b 0)]
363                                     (Point3d. (get b0 0) (get b0 1) (get b0 2))))))))
364                    {}
365                    ball-nodes)]
366         (println "Found" (count fids) "fiducial points:\n" fids)
367         fids)
368       (println "No ball objects found for" fp-node))
369     (println "No fiducial points found")))
371 (defn identify
372   "Identify a Pipe or Polyline (which implement Line3D) that represent a SAT."
373   ([p
374     ^Map lib]
375     (identify p lib 1.0 true false))
376   ([p
377     ^Map lib
378     delta direct substring]
379     (if p
380       (if-let [SAT-lib (fetch-lib (into {} lib))]
381         (if-let [fids (extract-fiducial-points (.getProject p))]
382           (identify-SAT
383             p
384             SAT-lib
385             (let [vs (.asVectorString3D p)]
386                   (.calibrate vs (.. p getLayerSet getCalibrationCopy))
387                   vs)
388             fids
389             delta
390             direct
391             substring)
392           (report "Cannot find fiducial points for project" (.getProject p)))
393         (report "Cannot find or parse SAT library at " (.get lib "title") " at " (.get lib "filepath")))
394       (report "Cannot identify a null pipe or polyline!"))))
397 (defn identify-without-gui
398   "Identify a Pipe or Polyline (which implement Line3D) that represent a SAT.
399   No GUI is shown. Returns the vector containing the list of matches and the list of names."
400   ([p
401     ^Map lib]
402     (identify-without-gui p lib 1.0 true false))
403   ([p
404     ^Map lib
405     delta direct substring]
406     (if p
407       (if-let [SAT-lib (fetch-lib (into {} lib))]
408         (let [SATs (SAT-lib :SATs)
409               query-vs (let [vs (.asVectorString3D p)]
410                          (.calibrate vs (.. p getLayerSet getCalibrationCopy))
411                          vs)
412               fids (extract-fiducial-points (.getProject p)) ; (first (.. p getProject getRootProjectThing (findChildrenOfTypeR "fiducial_points"))))
413               vs1 (register-vs query-vs fids (SAT-lib :fids))]
414           (match-all SATs vs1 delta direct substring)))
415       (report "Cannot identify a null pipe or polyline!"))))
418 ;(defn lib-stats
419 ;  "Returns a map with the number of SATs in the library, a list of names vs. sorted sequence lengths, the median length, the average length."
420 ;  [lib-name delta]
421 ;  (if-let [lib (fetch-lib lib-name)]
422 ;    (let [SATs (SAT-lib :SATs)
423 ;          lengths (reduce
424 ;                    (sorted-map-by
425 ;                      #(< 
428 ;      {:n (count SATs)
429 ;       :
430 ;    (report (str "Unknown library " lib-name))))
432 (defn- ready-vs
433   "Return a calibrate and registered VectorString3D from a chain."
434   [chain source-fids target-fids]
435   (let [vs (.clone (.vs chain))]
436     (.calibrate vs (.. chain getRoot getLayerSet getCalibrationCopy))
437     (register-vs vs source-fids target-fids)))
439 (defn quantify-all
440   "Take all pipes in project and score/classify them.
441   Returns a sorted map of name vs. a vector with:
442   - if the top 1,2,3,4,5 have a homonymous
443   - the number of positives: 'true' and homonymous
444   - the number of false positives: 'true' and not homonymous
445   - the number of false negatives: 'false' and homonymous
446   - the number of true negatives: 'false' and not homonymous
447   - the FPR: false positive rate: false positives / ( false positives + true negatives )
448   - the FNR: false negative rate: false negatives / ( false negatives + true positives )
449   - the TPR: true positive rate: 1 - FNR
450   - the length of the sequence queried"
451   [project lib regex-exclude delta direct substring]
452   (let [fids (extract-fiducial-points (first (.. project getRootProjectThing (findChildrenOfTypeR "fiducial_points"))))
453         tops (int 5)
454         SAT-lib (fetch-lib lib)]
455     (if SAT-lib
456       (reduce
457         (fn [m chain]
458           (let [vs (resample (ready-vs chain fids (SAT-lib :fids)) delta)
459                 [matches names] (match-all (SAT-lib :SATs) vs delta direct substring)
460                 names (vec (take tops names))
461                 #^String SAT-name (let [t (.getCellTitle chain)]
462                                     (.substring t (int 0) (.indexOf t (int \space))))
463                 ;has-top-match (fn [n] (some #(.startsWith % SAT-name) (take names n)))
464                 dummy (println "###\nSAT-name: " SAT-name   "\ntop 5 names: " names "\ntop 5 meds: " (map #(% :med) (take 5 matches)))
465                 top-matches (loop [i (int 0)
466                                    r []]
467                               (if (>= i tops)
468                                 r
469                                 (if (.startsWith (names i) SAT-name)
470                                   (into r (repeat (- tops i) true))  ; the rest are all true
471                                   (recur (inc i) (into [false] r)))))
472                 true-positives (filter #(and
473                                           (% :correct)
474                                           (.startsWith (% :SAT-name) SAT-name))
475                                        matches)
476                 true-negatives (filter #(and
477                                           (not (% :correct))
478                                           (not (.startsWith (% :SAT-name) SAT-name)))
479                                        matches)
480                 false-positives (filter #(and
481                                            (% :correct)
482                                            (not (.startsWith (% :SAT-name) SAT-name)))
483                                         matches)
484                 false-negatives (filter #(and
485                                            (not (% :correct))
486                                            (.startsWith (% :SAT-name) SAT-name))
487                                         matches)]
488             (println "top matches for " SAT-name " : " (count top-matches) top-matches)
489             (assoc m
490               SAT-name
491               [(top-matches 0)
492                (top-matches 1)
493                (top-matches 2)
494                (top-matches 3)
495                (top-matches 4)
496                (count true-positives)
497                (count false-positives)
498                (count true-negatives)
499                (count false-negatives)
500                (/ (count false-positives) (+ (count false-positives) (count true-negatives))) ; False positive rate
501                (let [divisor (+ (count false-negatives) (count true-positives))]
502                  (if (= 0 divisor)
503                    Double/MAX_VALUE
504                    (/ (count false-negatives) divisor))) ; False negative rate
505                (let [divisor (+ (count false-negatives) (count true-positives))]
506                  (if (= 0 divisor)
507                    Double/MAX_VALUE
508                    (- 1 (/ (count false-negatives) divisor)))) ; True positive rate
509                (.length vs)])))
510         (sorted-map)
511         (Compare/createPipeChains (.getRootProjectThing project) (.getRootLayerSet project) regex-exclude)))))
513 (defn summarize-as-confusion-matrix
514   "Takes the results of quantify-all and returns the confusion matrix as a map."
515   [qa]
516   (reduce
517     (fn [m results]
518       (merge-with + m {:true-positives (results 5)
519                        :false-positives (results 6)
520                        :true-negatives (results 7)
521                        :false-negatives (results 8)}))
522     {:true-positives 0
523      :false-positives 0
524      :true-negatives 0
525      :false-negatives 0}
526     (vals qa)))
528 (defn summarize-as-distributions
529   "Takes the results of quantify-all and returns four vectors representing four histograms,
530   one for each distribution of true-positives, false-positives, true-negatives and false-negatives."
531   [qa]
532   (reduce
533     (fn [m results]
534       (merge-with (fn [m1 m2]
535                     (merge-with + m1 m2))
536                   m
537                   {:true-positives {(results 5) 1}
538                    :false-positives {(results 6) 1}
539                    :true-negatives {(results 7) 1}
540                    :false-negatives {(results 8) 1}}))
541     {:true-positives (sorted-map)
542      :false-positives (sorted-map)
543      :true-negatives (sorted-map)
544      :false-negatives (sorted-map)}
545     (vals qa)))
547 (defn summarize-quantify-all
548   "Takes the results of quantify-all and returns a map of two maps,
549   one with the confusion matrix and one with the distribution of true/false-positive/negative matches."
550   [project lib regex-exclude delta direct substring]
551   (let [qa (quantify-all project lib regex-exclude delta direct substring)]
552     {:confusion-matrix (summarize-as-confusion-matrix qa)
553      :distributions (summarize-as-distributions)}))
556 (defn print-quantify-all [t]
557   (doseq [[k v] t]
558      (print k \tab)
559      (doseq [x (take 5 v)] (print x \tab))
560      (doseq [x (nthnext v 5)] (print (float x) \tab))
561      (print \newline)))
564 (defn find-rev-match
565   "Take a set of non-homonymous VectorString3D.
566   Do pairwise comparisons, in this fashion:
567   1. reverse vs2
568   2. substring length SL =  0.5 * max(len(vs1), len(vs2))
569   3. for all substrings of len SL of vs1, match against all of vs2.
570   4. Record best result in a set sorted by mean euclidean distance of the best match.
571   Assumes chains are registered and resampled.
572   Will ignore cases where the shorter chain is shorter than half the longer chain."
573   [chains delta]
574   (reduce
575     (fn [s chain1]
576       (let [rvs1 (let [v (.clone (.vs chain1))]
577                    (.reverse v)
578                    (.resample v delta)
579                    v)
580             len1 (.length rvs1)]
581         (conj s (reduce
582                     ; Find best reverse submatch for chain1 in chains
583                     (fn [best chain2]
584                       (println "Processing " (.getShortCellTitle chain1) " versus " (.getShortCellTitle chain2))
585                       (let [vs2 (.vs chain2)
586                             len2 (.length vs2)
587                             SL (int (/ (max len1 len2) 2))]
588                         (if (or (= chain1 chain2) (< len1 SL) (< len2 SL))
589                           best ; A chain has to be longer than half the length of the other to be worth looking at
590                           (let [b (reduce
591                                     ; Find best reverse submatch between chain1 and chain2
592                                     (fn [best-rsub start]
593                                       (let [bm (Compare/findBestMatch (.substring rvs1 start (+ start SL))
594                                                                       vs2
595                                                                       delta
596                                                                       false 0 0
597                                                                       Compare/AVG_PHYS_DIST   ; Also known as mean euclidean distance
598                                                                       true true
599                                                                       1.1 1.1 1.0)]
600                                         (if (and
601                                               best-rsub
602                                               (< (best-rsub :med) (get bm 1)))
603                                           best-rsub
604                                           {:chain1 chain1 :chain2 chain2 :med (get bm 1)})))
605                                     {:med Double/MAX_VALUE}
606                                     (range (- len1 SL)))]
607                             (if (and
608                                   best
609                                   (< (best :med) (b :med)))
610                               best
611                               b)))))
612                     {:med Double/MAX_VALUE} ; bogus initial element
613                     chains))))
614     (sorted-set-by
615       #(int (- (%1 :med) (%2 :med)))
616       {:med Double/MAX_VALUE}) ; adding a bogus initial element
617     chains))
620 (defn find-reverse-match
621   "Takes all the chains of a project and compares them all-to-all pairwise with one of the two reversed.
622   Will calibrate the chains and resample them to delta."
623   [project delta regex-exclude]
624   (let [cal (.. project getRootLayerSet getCalibrationCopy)]
625     (find-rev-match (map
626                         (fn [chain]
627                           (.calibrate (.vs chain) cal)
628                           (.resample (.vs chain) delta)
629                           chain)
630                         (Compare/createPipeChains (.getRootProjectThing project) (.getRootLayerSet project) regex-exclude))
631                       delta)))
633 (defn print-reversed-match
634   "Prints the sorted set returned by find-reversed-similar"
635   [s]
636   (doseq [m s]
637     (let [c1 (m :chain1)
638           c2 (m :chain2)]
639       (if c1
640         (println (.getShortCellTitle c1) (.getShortCellTitle c2) (m :med))))))
643 (defn print-stats
644   "Prints the number of unique SATs and the number of unique lineages in a library of SATs.
645   Returns the two sets in a map."
646   [lib]
647   (let [lib (fetch-lib lib)
648         unique-sats (reduce
649                       (fn [unique clone]
650                         (if (> (.indexOf clone (int \space)) -1)
651                           (conj unique (.substring clone 0 (.indexOf clone (int \space))))
652                           unique))
653                       (sorted-set)
654                       (keys (lib :SATs)))
655         unique-lineages (reduce
656                           (fn [unique clone]
657                             (if (> (.indexOf clone (int \:)) -1)
658                               (conj unique (.substring clone 0 (.indexOf clone (int \:))))
659                               unique))
660                           (sorted-set)
661                           unique-sats)]
662     (println "Unique SATs: " (count unique-sats) \newline "Unique lineages: " (count unique-lineages))
663     {:unique-sats unique-sats
664      :unique-lineages unique-lineages}))
666 (defn- test
667   []
668   (identify (first (ini.trakem2.display.Display/getSelected))
669             {"title" "3rd instar"
670              "reference" "FRT42 new"
671              "filepath" "/home/albert/Programming/fiji/plugins/SAT-lib-Drosophila-3rd-instar.clj"}))