Skip to content

Commit dabed8c

Browse files
Copilotkeller-mark
Copilot
and
keller-mark
committed
Implement link_views_by_dict and hierarchical coordination APIs for feature parity with vitessce-python
Co-authored-by: keller-mark <7525285+keller-mark@users.noreply.github.com>
1 parent 8e8a720 commit dabed8c

File tree

2 files changed

+336
-8
lines changed

2 files changed

+336
-8
lines changed

‎R/config.R‎

Lines changed: 231 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,86 @@
1+
#' Helper function for processing coordination dictionaries
2+
#'
3+
#' @keywords internal
4+
#' @param scopes The coordination scopes to process.
5+
#' @param coordination_scopes The coordination scopes object to update.
6+
#' @param coordination_scopes_by The coordination scopes by object to update.
7+
#' @return A list containing updated coordination_scopes and coordination_scopes_by.
8+
use_coordination_by_dict_helper <- function(scopes, coordination_scopes, coordination_scopes_by) {
9+
# Recursive inner function
10+
process_level <- function(parent_type, parent_scope, level_type, level_val) {
11+
if(is.list(level_val) && !inherits(level_val, "VitessceConfigCoordinationScope")) {
12+
# Check if this is a list of coordination objects
13+
all_have_scope <- all(sapply(level_val, function(x) is.list(x) && "scope" %in% names(x)))
14+
if(all_have_scope) {
15+
# This is a list of coordination objects
16+
if(is.null(coordination_scopes_by[[parent_type]])) coordination_scopes_by[[parent_type]] <- list()
17+
if(is.null(coordination_scopes_by[[parent_type]][[level_type]])) coordination_scopes_by[[parent_type]][[level_type]] <- list()
18+
coordination_scopes_by[[parent_type]][[level_type]][[parent_scope$c_scope]] <- sapply(level_val, function(child_val) child_val[["scope"]]$c_scope)
19+
20+
for(child_val in level_val) {
21+
if("children" %in% names(child_val)) {
22+
# Continue recursion
23+
for(next_level_type in names(child_val[["children"]])) {
24+
next_level_val <- child_val[["children"]][[next_level_type]]
25+
process_level(level_type, child_val[["scope"]], next_level_type, next_level_val)
26+
}
27+
}
28+
}
29+
}
30+
} else {
31+
# Single coordination object
32+
if(is.null(coordination_scopes_by[[parent_type]])) coordination_scopes_by[[parent_type]] <- list()
33+
if(is.null(coordination_scopes_by[[parent_type]][[level_type]])) coordination_scopes_by[[parent_type]][[level_type]] <- list()
34+
coordination_scopes_by[[parent_type]][[level_type]][[parent_scope$c_scope]] <- level_val[["scope"]]$c_scope
35+
36+
if("children" %in% names(level_val)) {
37+
# Continue recursion
38+
for(next_level_type in names(level_val[["children"]])) {
39+
next_level_val <- level_val[["children"]][[next_level_type]]
40+
process_level(level_type, level_val[["scope"]], next_level_type, next_level_val)
41+
}
42+
}
43+
}
44+
}
45+
46+
# Process top-level coordination types
47+
for(top_level_type in names(scopes)) {
48+
top_level_val <- scopes[[top_level_type]]
49+
50+
if(is.list(top_level_val) && !inherits(top_level_val, "VitessceConfigCoordinationScope")) {
51+
# Check if this is a list of coordination objects
52+
all_have_scope <- all(sapply(top_level_val, function(x) is.list(x) && "scope" %in% names(x)))
53+
if(all_have_scope) {
54+
coordination_scopes[[top_level_type]] <- sapply(top_level_val, function(level_val) level_val[["scope"]]$c_scope)
55+
56+
for(level_val in top_level_val) {
57+
if("children" %in% names(level_val)) {
58+
# Begin recursion
59+
for(next_level_type in names(level_val[["children"]])) {
60+
next_level_val <- level_val[["children"]][[next_level_type]]
61+
process_level(top_level_type, level_val[["scope"]], next_level_type, next_level_val)
62+
}
63+
}
64+
}
65+
} else {
66+
# Single coordination object - handle the case where it's a simple list with scope
67+
if("scope" %in% names(top_level_val)) {
68+
coordination_scopes[[top_level_type]] <- top_level_val[["scope"]]$c_scope
69+
if("children" %in% names(top_level_val)) {
70+
# Begin recursion
71+
for(next_level_type in names(top_level_val[["children"]])) {
72+
next_level_val <- top_level_val[["children"]][[next_level_type]]
73+
process_level(top_level_type, top_level_val[["scope"]], next_level_type, next_level_val)
74+
}
75+
}
76+
}
77+
}
78+
}
79+
}
80+
81+
return(list(coordination_scopes = coordination_scopes, coordination_scopes_by = coordination_scopes_by))
82+
}
83+
184
#' Get next scope name
285
#'
386
#' @keywords internal
@@ -280,7 +363,7 @@ VitessceConfigMetaCoordinationScope <- R6::R6Class("VitessceConfigMetaCoordinati
280363
self$meta_by_scope = VitessceConfigCoordinationScope$new(CoordinationType$META_COORDINATION_SCOPES_BY, meta_by_scope)
281364
},
282365
use_coordination = function(c_scopes) {
283-
if(is.na(self$meta_scope4c_value)) {
366+
if(is.na(self$meta_scope$c_value)) {
284367
self$meta_scope$set_value(obj_list())
285368
}
286369

@@ -292,7 +375,23 @@ VitessceConfigMetaCoordinationScope <- R6::R6Class("VitessceConfigMetaCoordinati
292375
invisible(self)
293376
},
294377
use_coordination_by_dict = function(scopes) {
295-
# TODO
378+
if(is.na(self$meta_scope$c_value)) {
379+
self$meta_scope$set_value_raw(obj_list())
380+
}
381+
382+
if(is.na(self$meta_by_scope$c_value)) {
383+
self$meta_by_scope$set_value_raw(obj_list())
384+
}
385+
386+
result <- use_coordination_by_dict_helper(
387+
scopes,
388+
self$meta_scope$c_value,
389+
self$meta_by_scope$c_value
390+
)
391+
392+
self$meta_scope$set_value_raw(result$coordination_scopes)
393+
self$meta_by_scope$set_value_raw(result$coordination_scopes_by)
394+
296395
invisible(self)
297396
}
298397
)
@@ -384,11 +483,48 @@ VitessceConfigView <- R6::R6Class("VitessceConfigView",
384483
invisible(self)
385484
},
386485
use_coordination_by_dict = function(scopes) {
387-
# TODO
486+
if(is.null(private$view$coordinationScopes)) {
487+
private$view$coordinationScopes <- list()
488+
}
489+
490+
if(is.null(private$view$coordinationScopesBy)) {
491+
private$view$coordinationScopesBy <- list()
492+
}
493+
494+
result <- use_coordination_by_dict_helper(
495+
scopes,
496+
private$view$coordinationScopes,
497+
private$view$coordinationScopesBy
498+
)
499+
500+
private$view$coordinationScopes <- result$coordination_scopes
501+
private$view$coordinationScopesBy <- result$coordination_scopes_by
502+
388503
invisible(self)
389504
},
390505
use_meta_coordination = function(meta_scope) {
391-
# TODO
506+
if(is.null(private$view$coordinationScopes)) {
507+
private$view$coordinationScopes <- list()
508+
}
509+
510+
# Initialize as empty lists if they don't exist
511+
if(is.null(private$view$coordinationScopes[[CoordinationType$META_COORDINATION_SCOPES]])) {
512+
private$view$coordinationScopes[[CoordinationType$META_COORDINATION_SCOPES]] <- list()
513+
}
514+
if(is.null(private$view$coordinationScopes[[CoordinationType$META_COORDINATION_SCOPES_BY]])) {
515+
private$view$coordinationScopes[[CoordinationType$META_COORDINATION_SCOPES_BY]] <- list()
516+
}
517+
518+
# Append the new meta scope values
519+
private$view$coordinationScopes[[CoordinationType$META_COORDINATION_SCOPES]] <- c(
520+
private$view$coordinationScopes[[CoordinationType$META_COORDINATION_SCOPES]],
521+
meta_scope$meta_scope$c_scope
522+
)
523+
private$view$coordinationScopes[[CoordinationType$META_COORDINATION_SCOPES_BY]] <- c(
524+
private$view$coordinationScopes[[CoordinationType$META_COORDINATION_SCOPES_BY]],
525+
meta_scope$meta_by_scope$c_scope
526+
)
527+
392528
invisible(self)
393529
},
394530
#' @description
@@ -557,13 +693,100 @@ VitessceConfig <- R6::R6Class("VitessceConfig",
557693
result
558694
},
559695
add_meta_coordination = function() {
560-
# TODO
696+
prev_meta_scopes <- names(self$config$coordinationSpace[[CoordinationType$META_COORDINATION_SCOPES]])
697+
prev_meta_by_scopes <- names(self$config$coordinationSpace[[CoordinationType$META_COORDINATION_SCOPES_BY]])
698+
699+
if(is.null(prev_meta_scopes)) prev_meta_scopes <- character()
700+
if(is.null(prev_meta_by_scopes)) prev_meta_by_scopes <- character()
701+
702+
meta_container <- VitessceConfigMetaCoordinationScope$new(
703+
get_next_scope(prev_meta_scopes),
704+
get_next_scope(prev_meta_by_scopes)
705+
)
706+
707+
if(!is.element(CoordinationType$META_COORDINATION_SCOPES, names(self$config$coordinationSpace))) {
708+
self$config$coordinationSpace[[CoordinationType$META_COORDINATION_SCOPES]] <- list()
709+
}
710+
if(!is.element(CoordinationType$META_COORDINATION_SCOPES_BY, names(self$config$coordinationSpace))) {
711+
self$config$coordinationSpace[[CoordinationType$META_COORDINATION_SCOPES_BY]] <- list()
712+
}
713+
714+
self$config$coordinationSpace[[CoordinationType$META_COORDINATION_SCOPES]][[meta_container$meta_scope$c_scope]] <- meta_container$meta_scope
715+
self$config$coordinationSpace[[CoordinationType$META_COORDINATION_SCOPES_BY]][[meta_container$meta_by_scope$c_scope]] <- meta_container$meta_by_scope
716+
717+
meta_container
561718
},
562719
add_coordination_by_dict = function(input_val) {
563-
# TODO
720+
# Recursive function to process each level
721+
process_level <- function(level) {
722+
result <- list()
723+
if(is.null(level)) {
724+
return(result)
725+
}
726+
727+
for(c_type in names(level)) {
728+
next_level_or_initial_value <- level[[c_type]]
729+
730+
# Check if value is a CoordinationLevel instance
731+
if(inherits(next_level_or_initial_value, "CoordinationLevel")) {
732+
next_level <- next_level_or_initial_value$value
733+
if(is.list(next_level)) {
734+
if(next_level_or_initial_value$is_cached()) {
735+
result[[c_type]] <- next_level_or_initial_value$get_cached()
736+
} else {
737+
processed_level <- lapply(next_level, function(next_el) {
738+
dummy_scopes <- self$add_coordination(c_type)
739+
dummy_scope <- dummy_scopes[[1]]
740+
dummy_scope$set_value("__dummy__")
741+
list(
742+
scope = dummy_scope,
743+
children = process_level(next_el)
744+
)
745+
})
746+
next_level_or_initial_value$set_cached(processed_level)
747+
result[[c_type]] <- processed_level
748+
}
749+
} else {
750+
stop("Expected CoordinationLevel$value to be a list.")
751+
}
752+
} else {
753+
# Base case
754+
initial_value <- next_level_or_initial_value
755+
if(inherits(initial_value, "VitessceConfigCoordinationScope")) {
756+
result[[c_type]] <- list(scope = initial_value)
757+
} else {
758+
scopes <- self$add_coordination(c_type)
759+
scope <- scopes[[1]]
760+
scope$set_value(initial_value)
761+
result[[c_type]] <- list(scope = scope)
762+
}
763+
}
764+
}
765+
return(result)
766+
}
767+
768+
# Begin recursion
769+
output_val <- process_level(input_val)
770+
return(output_val)
564771
},
565-
link_views_by_dict = function(views, input_val, meta = TRUE) {
566-
# TODO
772+
link_views_by_dict = function(views, input_val, meta = TRUE, scope_prefix = NA) {
773+
# TODO: implement scope_prefix functionality similar to Python version
774+
scopes <- self$add_coordination_by_dict(input_val)
775+
776+
if(meta) {
777+
meta_scope <- self$add_meta_coordination()
778+
meta_scope$use_coordination_by_dict(scopes)
779+
780+
for(view in views) {
781+
view$use_meta_coordination(meta_scope)
782+
}
783+
} else {
784+
for(view in views) {
785+
view$use_coordination_by_dict(scopes)
786+
}
787+
}
788+
789+
invisible(self)
567790
},
568791
#' @description
569792
#' Define the layout of views.

‎tests/testthat/test-config.R‎

Lines changed: 105 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -423,3 +423,108 @@ test_that("VitessceConfig from list", {
423423
vc_list_orig[['coordinationSpace']][['spatialTargetX']][['A']] <- jsonlite::unbox(20)
424424
expect_equal(vc_list_loaded, vc_list_orig)
425425
})
426+
427+
test_that("VitessceConfig link_views_by_dict basic functionality", {
428+
vc <- VitessceConfig$new(schema_version = "1.0.16", name = "Test config")
429+
ds <- vc$add_dataset("Test dataset")
430+
v1 <- vc$add_view(ds, "spatial")
431+
v2 <- vc$add_view(ds, "scatterplot")
432+
433+
# Test simple coordination with meta = FALSE
434+
simple_input <- list()
435+
simple_input[[CoordinationType$SPATIAL_ZOOM]] <- 2
436+
simple_input[[CoordinationType$SPATIAL_TARGET_X]] <- 0
437+
simple_input[[CoordinationType$SPATIAL_TARGET_Y]] <- 0
438+
439+
vc$link_views_by_dict(list(v1, v2), simple_input, meta = FALSE)
440+
441+
vc_list <- vc$to_list()
442+
443+
# Check that coordination scopes were created
444+
expect_true("spatialZoom" %in% names(vc_list$coordinationSpace))
445+
expect_true("spatialTargetX" %in% names(vc_list$coordinationSpace))
446+
expect_true("spatialTargetY" %in% names(vc_list$coordinationSpace))
447+
448+
# Check that values were set correctly
449+
zoom_scope_name <- names(vc_list$coordinationSpace$spatialZoom)[1]
450+
expect_equal(vc_list$coordinationSpace$spatialZoom[[zoom_scope_name]], jsonlite::unbox(2))
451+
452+
x_scope_name <- names(vc_list$coordinationSpace$spatialTargetX)[1]
453+
expect_equal(vc_list$coordinationSpace$spatialTargetX[[x_scope_name]], jsonlite::unbox(0))
454+
455+
y_scope_name <- names(vc_list$coordinationSpace$spatialTargetY)[1]
456+
expect_equal(vc_list$coordinationSpace$spatialTargetY[[y_scope_name]], jsonlite::unbox(0))
457+
458+
# Check that views use the coordination scopes
459+
expect_equal(vc_list$layout[[1]]$coordinationScopes$spatialZoom, zoom_scope_name)
460+
expect_equal(vc_list$layout[[1]]$coordinationScopes$spatialTargetX, x_scope_name)
461+
expect_equal(vc_list$layout[[1]]$coordinationScopes$spatialTargetY, y_scope_name)
462+
463+
expect_equal(vc_list$layout[[2]]$coordinationScopes$spatialZoom, zoom_scope_name)
464+
expect_equal(vc_list$layout[[2]]$coordinationScopes$spatialTargetX, x_scope_name)
465+
expect_equal(vc_list$layout[[2]]$coordinationScopes$spatialTargetY, y_scope_name)
466+
})
467+
468+
test_that("VitessceConfig link_views_by_dict with meta coordination", {
469+
vc <- VitessceConfig$new(schema_version = "1.0.16", name = "Test config")
470+
ds <- vc$add_dataset("Test dataset")
471+
v1 <- vc$add_view(ds, "spatial")
472+
v2 <- vc$add_view(ds, "scatterplot")
473+
474+
# Test with meta coordination (default behavior)
475+
simple_input <- list()
476+
simple_input[[CoordinationType$SPATIAL_ZOOM]] <- 3
477+
478+
vc$link_views_by_dict(list(v1, v2), simple_input) # meta = TRUE by default
479+
480+
vc_list <- vc$to_list()
481+
482+
# Check that meta coordination scopes were created
483+
expect_true("metaCoordinationScopes" %in% names(vc_list$coordinationSpace))
484+
expect_true("metaCoordinationScopesBy" %in% names(vc_list$coordinationSpace))
485+
486+
# Check that views use meta coordination
487+
expect_true("metaCoordinationScopes" %in% names(vc_list$layout[[1]]$coordinationScopes))
488+
expect_true("metaCoordinationScopesBy" %in% names(vc_list$layout[[1]]$coordinationScopes))
489+
expect_true("metaCoordinationScopes" %in% names(vc_list$layout[[2]]$coordinationScopes))
490+
expect_true("metaCoordinationScopesBy" %in% names(vc_list$layout[[2]]$coordinationScopes))
491+
})
492+
493+
test_that("VitessceConfig add_coordination_by_dict", {
494+
vc <- VitessceConfig$new(schema_version = "1.0.16", name = "Test config")
495+
496+
# Test add_coordination_by_dict alone
497+
input_val <- list()
498+
input_val[[CoordinationType$SPATIAL_ZOOM]] <- 5
499+
input_val[[CoordinationType$SPATIAL_TARGET_X]] <- 10
500+
501+
result <- vc$add_coordination_by_dict(input_val)
502+
503+
# Check structure of result
504+
expect_true("spatialZoom" %in% names(result))
505+
expect_true("spatialTargetX" %in% names(result))
506+
expect_true("scope" %in% names(result$spatialZoom))
507+
expect_true("scope" %in% names(result$spatialTargetX))
508+
509+
# Check that scopes were created with correct values
510+
expect_equal(as.numeric(result$spatialZoom$scope$c_value), 5)
511+
expect_equal(as.numeric(result$spatialTargetX$scope$c_value), 10)
512+
expect_equal(result$spatialZoom$scope$c_type, "spatialZoom")
513+
expect_equal(result$spatialTargetX$scope$c_type, "spatialTargetX")
514+
})
515+
516+
test_that("VitessceConfig add_meta_coordination", {
517+
vc <- VitessceConfig$new(schema_version = "1.0.16", name = "Test config")
518+
519+
meta_scope <- vc$add_meta_coordination()
520+
521+
# Check that meta scope object was created
522+
expect_true(inherits(meta_scope, "VitessceConfigMetaCoordinationScope"))
523+
expect_true(inherits(meta_scope$meta_scope, "VitessceConfigCoordinationScope"))
524+
expect_true(inherits(meta_scope$meta_by_scope, "VitessceConfigCoordinationScope"))
525+
526+
# Check that coordination space was updated
527+
vc_list <- vc$to_list()
528+
expect_true("metaCoordinationScopes" %in% names(vc_list$coordinationSpace))
529+
expect_true("metaCoordinationScopesBy" %in% names(vc_list$coordinationSpace))
530+
})

0 commit comments

Comments
 (0)