Skip to content

Commit 39cf9d4

Browse files
dfornikaCopilotCopilot
authored
Re root tree (#50)
* Initial implementation of re-rooting * Remove old use-memo definition * Added ladderization button * Ladderize both ways * reimplement re-rooting on branches * Update src/main/app/components/toolbar.cljs Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> * Update src/main/app/components/tree.cljs Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> * whitespace * whitespace * Add test coverage for ladderize function (#51) * Initial plan * Add tests for ladderize function Co-authored-by: dfornika <145659+dfornika@users.noreply.github.com> --------- Co-authored-by: copilot-swe-agent[bot] <198982749+Copilot@users.noreply.github.com> Co-authored-by: dfornika <145659+dfornika@users.noreply.github.com> --------- Co-authored-by: Copilot <175728472+Copilot@users.noreply.github.com> Co-authored-by: Copilot <198982749+Copilot@users.noreply.github.com> Co-authored-by: dfornika <145659+dfornika@users.noreply.github.com>
1 parent 08d8b61 commit 39cf9d4

7 files changed

Lines changed: 703 additions & 112 deletions

File tree

‎src/main/app/components/toolbar.cljs‎

Lines changed: 40 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,9 @@
1212
[app.export.html :as export-html]
1313
[app.export.svg :as export-svg]
1414
[app.layout :refer [LAYOUT]]
15-
[app.io :as io]))
15+
[app.io :as io]
16+
[app.newick :as newick]
17+
[app.tree :as tree]))
1618

1719
;; ===== Style constants =====
1820

@@ -55,7 +57,10 @@
5557
Reads all state from [[app.state/app-context]] via [[app.state/use-app-state]],
5658
so this component requires no props."
5759
[_props]
58-
(let [{:keys [x-mult set-x-mult!
60+
(let [{:keys [newick-str set-newick-str!
61+
parsed-tree set-parsed-tree!
62+
positioned-tree set-positioned-tree!
63+
x-mult set-x-mult!
5964
y-mult set-y-mult!
6065
col-spacing set-col-spacing!
6166
tree-metadata-gap-px set-tree-metadata-gap-px!
@@ -64,10 +69,9 @@
6469
show-distance-from-origin set-show-distance-from-origin!
6570
scale-origin set-scale-origin!
6671
show-pixel-grid set-show-pixel-grid! ;; Temporarily disabled pixel grid, these aren't needed but will be if pixel grid is re-enabled.
67-
set-newick-str!
68-
set-parsed-tree!
6972
set-metadata-rows! set-active-cols!
70-
set-selected-ids! set-highlights!]} (state/use-app-state)]
73+
set-selected-ids! set-highlights!
74+
active-reroot-node-id set-active-reroot-node-id!]} (state/use-app-state)]
7175
($ :div {:style {:padding "6px 8px"
7276
:background "#ffffff"
7377
:border-bottom "2px solid #e2e6ea"
@@ -198,7 +202,37 @@
198202
:background "#ffffff"}
199203
:on-change #(set-scale-origin! (keyword (.. % -target -value)))}
200204
($ :option {:value "tips"} "Tips")
201-
($ :option {:value "root"} "Root"))))
205+
($ :option {:value "root"} "Root")))
206+
($ :button {:disabled (nil? active-reroot-node-id)
207+
:on-click (fn [_]
208+
(when (and active-reroot-node-id positioned-tree)
209+
(let [rerooted (tree/reroot-on-branch positioned-tree active-reroot-node-id)]
210+
(when rerooted
211+
(set-parsed-tree! rerooted)
212+
(set-newick-str! (newick/map->newick rerooted))
213+
(set-active-reroot-node-id! nil)))))
214+
:style {}}
215+
"Re-root Tree")
216+
($ :button {:disabled (not (or newick-str parsed-tree))
217+
:on-click (fn [_]
218+
(let [current-tree (or parsed-tree
219+
(when newick-str
220+
(newick/newick->map newick-str)))
221+
ladderized (tree/ladderize current-tree :ascending)]
222+
(set-parsed-tree! ladderized)
223+
(set-newick-str! (newick/map->newick ladderized))))
224+
:style {}}
225+
"Ladderize ↓")
226+
($ :button {:disabled (not (or newick-str parsed-tree))
227+
:on-click (fn [_]
228+
(let [current-tree (or parsed-tree
229+
(when newick-str
230+
(newick/newick->map newick-str)))
231+
ladderized (tree/ladderize current-tree :descending)]
232+
(set-parsed-tree! ladderized)
233+
(set-newick-str! (newick/map->newick ladderized))))
234+
:style {}}
235+
"Ladderize ↑"))
202236
;; Temporarily disabled this toggle for the PixelGrid.
203237
;; only intended as dev-time troubleshooting tool.
204238
#_($ :label {:style (merge label-style {:display "flex" :align-items "center" :gap "4px" :cursor "pointer"})}

‎src/main/app/components/tree.cljs‎

Lines changed: 37 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,9 @@
6464
:opt-un [:app.specs/highlights
6565
:app.specs/selected-ids
6666
:app.specs/on-toggle-selection
67-
:app.specs/on-select-subtree]))
67+
:app.specs/on-select-subtree
68+
:app.specs/active-reroot-node-id
69+
:app.specs/on-set-reroot-node]))
6870

6971
(declare TreeNode)
7072

@@ -77,6 +79,8 @@
7779
7880
Clicking a leaf's marker or label toggles its selection state
7981
via the `:on-toggle-selection` callback.
82+
Ctrl+clicking any node (leaf or internal) selects it for rerooting
83+
via `:on-set-reroot-node`.
8084
8185
Rendering priority for leaf markers:
8286
1. **Highlighted** (in `highlights` map) — filled circle in the
@@ -103,7 +107,7 @@
103107
- `:on-select-subtree` - `(fn [node])` callback to add a subtree's leaf names"
104108
[{:keys [node parent-x parent-y x-scale y-scale show-internal-markers show-distance-from-origin
105109
scale-origin max-depth marker-radius marker-fill highlights selected-ids on-toggle-selection
106-
on-select-subtree]}]
110+
on-select-subtree active-reroot-node-id on-set-reroot-node]}]
107111
(let [scaled-x (* (:x node) x-scale)
108112
scaled-y (* (:y node) y-scale)
109113
p-x (* parent-x x-scale)
@@ -130,9 +134,20 @@
130134
" internal-node-marker--deselect"
131135
" internal-node-marker--select"))
132136
leaf-click (when (and is-leaf? on-toggle-selection)
133-
(fn [_e] (on-toggle-selection node-name)))
134-
internal-click (when (and internal-node? on-select-subtree)
135-
(fn [_e] (on-select-subtree node)))
137+
(fn [e]
138+
(if (and (.-ctrlKey e) on-set-reroot-node)
139+
(on-set-reroot-node (:id node))
140+
(on-toggle-selection node-name))))
141+
internal-click (when internal-node?
142+
(fn [e]
143+
(if (and (.-ctrlKey e) on-set-reroot-node)
144+
;; Ctrl+click and handler exists: select for re-rooting
145+
(on-set-reroot-node (:id node))
146+
;; Otherwise: try subtree selection
147+
(when on-select-subtree
148+
(on-select-subtree node)))))
149+
active-reroot? (and active-reroot-node-id
150+
(= (:id node) active-reroot-node-id))
136151
internal-class (str "internal-node-marker"
137152
(when (not show-internal-markers)
138153
" internal-node-marker--hidden")
@@ -179,6 +194,12 @@
179194
:stroke-dasharray "3 2"
180195
:style {:pointer-events "none"}}))
181196

197+
(when active-reroot?
198+
($ :circle {:cx scaled-x :cy scaled-y :r (+ marker-radius 6)
199+
:fill "none"
200+
:stroke "#d9534f" ;; Red to indicate "this will be new root"
201+
:stroke-width 2}))
202+
182203
;; Internal node distance label
183204
(when distance-label
184205
($ :text {:x (- scaled-x 6)
@@ -214,6 +235,8 @@
214235
:marker-fill marker-fill
215236
:highlights highlights
216237
:selected-ids selected-ids
238+
:active-reroot-node-id active-reroot-node-id
239+
:on-set-reroot-node on-set-reroot-node
217240
:on-toggle-selection on-toggle-selection
218241
:on-select-subtree on-select-subtree})))))
219242

@@ -235,7 +258,9 @@
235258
:opt-un [:app.specs/highlights
236259
:app.specs/selected-ids
237260
:app.specs/on-toggle-selection
238-
:app.specs/on-select-subtree]))
261+
:app.specs/on-select-subtree
262+
:app.specs/active-reroot-node-id
263+
:app.specs/on-set-reroot-node]))
239264

240265
(defui PhylogeneticTree*
241266
"Renders the phylogenetic tree as a positioned SVG group.
@@ -253,10 +278,13 @@
253278
- `:marker-fill` - fill color for node markers
254279
- `:highlights` - map of {leaf-name -> color-string} for highlighted nodes
255280
- `:selected-ids` - set of leaf names currently selected in the grid
281+
- `:active-reroot-node-id` - ID of the node selected for rerooting (or nil)
282+
- `set-active-reroot-node-id!` - setter for reroot node selection
256283
- `:on-toggle-selection` - `(fn [leaf-name])` callback to toggle selection
257284
- `:on-select-subtree` - `(fn [node])` callback to add a subtree's leaf names"
285+
258286
[{:keys [tree x-scale y-scale show-internal-markers show-distance-from-origin scale-origin max-depth marker-radius marker-fill
259-
highlights selected-ids on-toggle-selection on-select-subtree]}]
287+
highlights selected-ids active-reroot-node-id set-active-reroot-node-id! on-toggle-selection on-select-subtree]}]
260288
($ :g {:transform (str "translate(" (:svg-padding-x LAYOUT) ", " (:svg-padding-y LAYOUT) ")")}
261289
($ TreeNode {:node tree
262290
:parent-x 0
@@ -271,6 +299,8 @@
271299
:marker-fill marker-fill
272300
:highlights highlights
273301
:selected-ids selected-ids
302+
:active-reroot-node-id active-reroot-node-id
303+
:on-set-reroot-node set-active-reroot-node-id!
274304
:on-toggle-selection on-toggle-selection
275305
:on-select-subtree on-select-subtree})))
276306

‎src/main/app/components/viewer.cljs‎

Lines changed: 77 additions & 31 deletions
Original file line numberDiff line numberDiff line change
@@ -212,17 +212,38 @@
212212
- `:metadata-panel-last-drag-height` - last height set by dragging
213213
- `:set-metadata-panel-height!` - setter for panel height
214214
- `:set-metadata-panel-last-drag-height!` - setter for last drag height"
215-
[{:keys [tree tips max-depth active-cols x-mult y-mult
216-
show-internal-markers show-distance-from-origin scale-origin width-px component-height-px
217-
show-scale-gridlines show-pixel-grid col-spacing left-shift-px tree-metadata-gap-px
218-
highlights selected-ids metadata-rows metadata-panel-collapsed
219-
metadata-panel-height metadata-panel-last-drag-height
220-
color-by-enabled? color-by-field color-by-palette color-by-type-override
221-
legend-pos legend-collapsed? legend-labels legend-visible?
222-
set-legend-pos! set-legend-collapsed! set-legend-labels! set-legend-visible!
223-
set-left-shift-px! set-tree-metadata-gap-px!
224-
set-active-cols! set-selected-ids! set-metadata-rows!
225-
set-metadata-panel-height! set-metadata-panel-last-drag-height!]}]
215+
[{:keys [tree
216+
tips
217+
max-depth
218+
x-mult
219+
y-mult
220+
show-internal-markers
221+
show-distance-from-origin
222+
scale-origin
223+
width-px
224+
component-height-px
225+
show-scale-gridlines
226+
show-pixel-grid
227+
col-spacing
228+
highlights
229+
metadata-panel-collapsed
230+
color-by-enabled?
231+
color-by-field
232+
color-by-palette
233+
color-by-type-override
234+
active-cols set-active-cols!
235+
selected-ids set-selected-ids!
236+
metadata-rows set-metadata-rows!
237+
metadata-panel-height set-metadata-panel-height!
238+
metadata-panel-last-drag-height set-metadata-panel-last-drag-height!
239+
tree-metadata-gap-px set-tree-metadata-gap-px!
240+
left-shift-px set-left-shift-px!
241+
legend-pos set-legend-pos!
242+
legend-collapsed? set-legend-collapsed!
243+
legend-labels set-legend-labels!
244+
legend-visible? set-legend-visible!
245+
active-reroot-node-id set-active-reroot-node-id!
246+
positioned-tree set-positioned-tree!]}]
226247
(let [;; Dynamic layout math
227248
current-x-scale (if (pos? max-depth)
228249
(* (/ (- width-px 400) max-depth) x-mult)
@@ -482,6 +503,8 @@
482503
:marker-fill (:node-marker-fill LAYOUT)
483504
:highlights merged-highlights
484505
:selected-ids selected-ids
506+
:active-reroot-node-id active-reroot-node-id
507+
:set-active-reroot-node-id! set-active-reroot-node-id!
485508
:on-toggle-selection toggle-selection
486509
:on-select-subtree select-subtree})
487510

@@ -620,32 +643,53 @@
620643
metadata changes don't re-parse the Newick string.
621644
When no tree is available, renders [[EmptyState]] instead."
622645
[{:keys [width-px component-height-px]}]
623-
(let [{:keys [newick-str parsed-tree metadata-rows active-cols
624-
x-mult y-mult show-internal-markers show-distance-from-origin
625-
scale-origin show-scale-gridlines show-pixel-grid
626-
col-spacing left-shift-px tree-metadata-gap-px highlights selected-ids metadata-panel-collapsed
627-
metadata-panel-height metadata-panel-last-drag-height
628-
color-by-enabled? color-by-field color-by-palette color-by-type-override
629-
legend-pos legend-collapsed? legend-labels legend-visible?
630-
set-legend-pos! set-legend-collapsed! set-legend-labels! set-legend-visible!
631-
set-left-shift-px! set-tree-metadata-gap-px!
632-
set-metadata-panel-height! set-metadata-panel-last-drag-height!
633-
set-active-cols! set-selected-ids! set-metadata-rows!]} (state/use-app-state)
646+
(let [{:keys [newick-str
647+
parsed-tree
648+
metadata-rows set-metadata-rows!
649+
active-cols set-active-cols!
650+
x-mult
651+
y-mult
652+
show-internal-markers
653+
show-distance-from-origin
654+
scale-origin
655+
show-scale-gridlines
656+
show-pixel-grid
657+
col-spacing
658+
left-shift-px set-left-shift-px!
659+
tree-metadata-gap-px set-tree-metadata-gap-px!
660+
highlights
661+
selected-ids set-selected-ids!
662+
metadata-panel-collapsed
663+
metadata-panel-height set-metadata-panel-height!
664+
metadata-panel-last-drag-height set-metadata-panel-last-drag-height!
665+
color-by-enabled?
666+
color-by-field
667+
color-by-palette
668+
color-by-type-override
669+
legend-pos set-legend-pos!
670+
legend-collapsed? set-legend-collapsed!
671+
legend-labels set-legend-labels!
672+
legend-visible? set-legend-visible!
673+
active-reroot-node-id set-active-reroot-node-id!
674+
positioned-tree set-positioned-tree!]} (state/use-app-state)
634675

635676
;; Stage 1: parse + position — re-runs when newick-str or parsed-tree changes.
636677
;; When parsed-tree is available (e.g. Nextstrain import), uses it directly
637678
;; via position-tree, skipping the Newick parse step.
638679
{:keys [tree raw-tips max-depth]}
639680
(uix/use-memo
640-
(fn [] (cond
641-
parsed-tree
642-
(let [{:keys [tree tips max-depth]} (tree/position-tree parsed-tree)]
643-
{:tree tree :raw-tips tips :max-depth max-depth})
644-
645-
(and (string? newick-str) (not (str/blank? newick-str)))
646-
(let [{:keys [tree tips max-depth]} (tree/parse-and-position newick-str)]
647-
{:tree tree :raw-tips tips :max-depth max-depth})))
648-
[newick-str parsed-tree])
681+
(fn []
682+
(cond
683+
parsed-tree
684+
(let [{:keys [tree tips max-depth]} (tree/position-tree parsed-tree)]
685+
(set-positioned-tree! tree) ;; <-- Save it
686+
{:tree tree :raw-tips tips :max-depth max-depth})
687+
688+
(and (string? newick-str) (not (str/blank? newick-str)))
689+
(let [{:keys [tree tips max-depth]} (tree/parse-and-position newick-str)]
690+
(set-positioned-tree! tree) ;; <-- Save it
691+
{:tree tree :raw-tips tips :max-depth max-depth})))
692+
[newick-str parsed-tree set-positioned-tree!])
649693

650694
;; Stage 2: enrich leaves with metadata — re-runs when metadata or cols change
651695
tips (uix/use-memo
@@ -682,6 +726,8 @@
682726
:set-legend-collapsed! set-legend-collapsed!
683727
:set-legend-labels! set-legend-labels!
684728
:set-legend-visible! set-legend-visible!
729+
:active-reroot-node-id active-reroot-node-id
730+
:set-active-reroot-node-id! set-active-reroot-node-id!
685731
:selected-ids selected-ids
686732
:metadata-rows metadata-rows
687733
:metadata-panel-collapsed metadata-panel-collapsed

‎src/main/app/specs.cljs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -195,6 +195,10 @@
195195
(s/def ::selected-ids (s/nilable (s/coll-of string? :kind set?)))
196196
(s/def ::set-selected-ids! fn?)
197197

198+
(s/def ::active-reroot-node-id (s/nilable nat-int?))
199+
(s/def ::set-active-reroot-node-id! fn?)
200+
(s/def ::on-set-reroot-node (s/nilable fn?))
201+
198202
(s/def ::highlights (s/nilable (s/map-of string? string?)))
199203
(s/def ::set-highlights! fn?)
200204

@@ -389,6 +393,10 @@
389393
:active-cols (s/coll-of ::metadata-header))
390394
:ret (s/keys :req-un [::tree ::tips ::max-depth]))
391395

396+
(s/fdef app.tree/reroot-on-branch
397+
:args (s/cat :tree ::positioned-node :target-id nat-int?)
398+
:ret (s/nilable ::tree-node))
399+
392400
;; ----- Scale (additional) -----
393401

394402
(s/fdef app.scale/get-ticks

0 commit comments

Comments
 (0)