seqs tracks in list too; better track accessors

NAMESPACE

@@ -44,6 +44,7 @@ S3method(ggplot,gggenomes_layout)
 S3method(layout,gggenomes)
 S3method(layout,gggenomes_layout)
 S3method(makeContent,cdsarrowtree)
+S3method(print,gggenomes_layout)
 S3method(pull_features,gggenomes)
 S3method(pull_features,gggenomes_layout)
 S3method(pull_links,gggenomes)
@@ -67,6 +68,8 @@ S3method(strand_lgl,logical)
 S3method(strand_lgl,numeric)
 S3method(track_ids,gggenomes)
 S3method(track_ids,gggenomes_layout)
+S3method(track_info,gggenomes)
+S3method(track_info,gggenomes_layout)
 export("%<>%")
 export("%>%")
 export("seqs<-")
@@ -139,8 +142,8 @@ export(strand_chr)
 export(strand_int)
 export(strand_lgl)
 export(theme_gggenomes_clean)
-export(track)
 export(track_ids)
+export(track_info)
 export(use_bins)
 export(use_features)
 export(use_genes)

R/features.R

@@ -113,7 +113,7 @@ add_features.gggenomes_layout <- function(x, ...){
 }
 
 add_feature_tracks <- function(x, tracks){
-  x$features <- c(x$features, map(tracks, as_features, x$seqs))
+  x$features <- c(x$features, map(tracks, as_features, seqs(x)))
   x
 }
 

R/gggenomes.R

@@ -144,8 +144,10 @@ layout_genomes <- function(seqs=NULL, genes=NULL, features=NULL, links=NULL,
 #' and error because dim(gggenome_layout) is undefined. Return dim of primary
 #' table instead
 #' @export
-dim.gggenomes_layout <- function(x) dim(x$seqs)
+dim.gggenomes_layout <- function(x) dim(seqs(x))
 
+#' @export
+print.gggenomes_layout <- function(x) track_info(x)
 
 infer_seqs_from_features <- function(features, infer_bin_id = seq_id, infer_start = min(start,end),
     infer_end = max(start,end), infer_length = max(start,end)){

R/layout.R

@@ -16,12 +16,12 @@ layout.gggenomes <- function(x, ignore_seqs=FALSE, ...){
 layout.gggenomes_layout <- function(x, ignore_seqs=FALSE, args_seqs = list(),
     args_features = list(), args_links = list()){
   if(!ignore_seqs)
-    x$seqs <- exec(layout_seqs, x$seqs, !!!args_seqs, !!!x$args_seqs)
+    seqs(x) <- exec(layout_seqs, seqs(x), !!!args_seqs, !!!x$args_seqs)
   # note: tried this with map, but that somehow messes with !!!
   for(i in seq_along(x$features))
-    x$features[[i]] %<>% exec(layout_features, ., x$seqs, !!!args_features)
+    x$features[[i]] %<>% exec(layout_features, ., seqs(x), !!!args_features)
   for(i in seq_along(x$links))
-    x$links[[i]] <- exec(as_links, x$orig_links[[i]], x$seqs, !!!args_links)
+    x$links[[i]] <- exec(as_links, x$orig_links[[i]], seqs(x), !!!args_links)
   x
 }
 

R/links.R

@@ -122,7 +122,7 @@ add_links.gggenomes_layout <- function(x, ...){
 }
 
 add_link_tracks <- function(x, tracks){
-  x$links <- c(x$links, map(tracks, as_links, x$seqs)) # this is lossy, so
+  x$links <- c(x$links, map(tracks, as_links, seqs(x))) # this is lossy, so
   x$orig_links <- c(x$orig_links, tracks) # also store orig links for re-layout
   x
 }

R/pick.R

@@ -46,7 +46,7 @@ pick_by_tree <- function(x, tree, infer_seq_id = label){
   if(inherits(tree, "phylo")) tree <- ggtree(tree)
   seq_ids <- tree$data %>% filter(isTip) %>% arrange(-y) %>%
     transmute(seq_id = {{ infer_seq_id }}) %>% pull(seq_id)
-  tree_only <- setdiff(seq_ids, x$data$seqs)
+  tree_only <- setdiff(seq_ids, seqs(x))
   pick(x, all_of(seq_ids))
 }
 

R/pull_tracks.R

@@ -21,7 +21,7 @@ pull_seqs.gggenomes <- function(.x, ...){
 }
 #' @export
 pull_seqs.gggenomes_layout <- function(.x, ...){
-  filter(.x$seqs, ...)
+  filter(seqs(.x), ...)
 }
 #' @rdname pull_seqs
 #' @export
@@ -66,7 +66,7 @@ pull_track.gggenomes_layout <- function(.x, .track_id=1, ...){
   track_ids <- track_ids(.x)
   track_id <- tidyselect::vars_pull(track_ids, {{.track_id}})
   if(track_id == "seqs"){
-    filter(.x$seqs, ...)
+    filter(seqs(.x), ...)
   }else{
     track_type <- names(track_ids)[track_ids == track_id]
     filter(.x[[track_type]][[track_id]], ...)

R/seqs.R

@@ -145,7 +145,7 @@ add_seqs.gggenomes <- function(x, seqs, ...){
 }
 #' @export
 add_seqs.gggenomes_layout <- function(x, seqs, ...){
-  x$seqs <- as_seqs(seqs, ...)
+  seqs(x) <- as_seqs(seqs, ...)
   x
 }
 
@@ -163,7 +163,7 @@ seqs.gggenomes <- function(x){
 }
 #' @export
 seqs.gggenomes_layout <- function(x){
-  x$seqs
+  x$seqs[["seqs"]]
 }
 #' @export
 `seqs<-` <- function(x, value){
@@ -176,6 +176,6 @@ seqs.gggenomes_layout <- function(x){
 }
 #' @export
 `seqs<-.gggenomes_layout` <- function(x, value) {
-  x$seqs <- value
+  x$seqs[["seqs"]] <- value
   x
 }

R/subfeatures.R

@@ -110,6 +110,6 @@ add_subfeatures.gggenomes_layout <- function(x, parent_track_id, ...,
 add_subfeature_tracks <- function(x, parent_track_id, tracks, transform){
   features <- pull_track(x, {{parent_track_id}})
   x$features <- c(x$features, map(
-    tracks, as_subfeatures, x$seqs, features, transform = transform))
+    tracks, as_subfeatures, seqs(x), features, transform = transform))
   x
 }

R/sublinks.R

@@ -147,9 +147,9 @@ add_sublinks.gggenomes_layout <- function(x, parent_track_id, ...,
 
 add_sublink_tracks <- function(x, parent_track_id, tracks, transform){
   features <- pull_track(x, {{parent_track_id}})
-  links <- map(tracks, as_sublinks, x$seqs, features, transform = transform,
+  links <- map(tracks, as_sublinks, seqs(x), features, transform = transform,
                compute_layout=FALSE) # layout only keeps adjacent
-  x$links <- c(x$links, map(links, layout_links, x$seqs))
+  x$links <- c(x$links, map(links, layout_links, seqs(x)))
   x$orig_links <- c(x$orig_links, links)
   x
 }

R/tracks.R

@@ -1,21 +1,89 @@
+#' Named vector of track ids and types
+#' @param x A gggenomes or gggenomes_layout object
+#' @param types restrict to any combination of "seqs", "features" and "links".
 #' @export
 track_ids <- function(x, ...){
   UseMethod("track_ids")
 }
 
 #' @export
 track_ids.gggenomes <- function(x, ...){
-  track_ids(x$data)
+  track_ids(x$data, ...)
 }
 
 #' @export
-track_ids.gggenomes_layout <- function(x, ...){
-  track_ids <- c("seqs", names(x$features), names(x$links))
-  names(track_ids) <- c("seqs", rep("features", length(x$features)),
-                        rep("links", length(x$links)))
-  track_ids
+track_ids.gggenomes_layout <- function(x, types=c("seqs", "features", "links")){
+  types <- match.arg(types, several.ok = TRUE)
+  ids <- flatten_chr(unname(map(types, ~names(x[[.x]]))))
+  names(ids) <- track_types(x, types)
+  ids
 }
 
+#' Basic info on tracks in a gggenomes object
+#'
+#' Call on a gggenomes or gggenomes_layout object to get a short tibble
+#' with ids, types, index and size of loaded tracks.
+#' @export
+#' @inheritParams track_ids
+track_info <- function(x, ...){
+  UseMethod("track_info")
+}
+
+#' @export
+track_info.gggenomes <- function(x, ...){
+  track_info(x$data, ...)
+}
+
+#' @export
+track_info.gggenomes_layout <- function(x, types = c("seqs", "features", "links")){
+  types <- match.arg(types, several.ok = TRUE)
+  y <- tibble(
+    id = track_ids(x, types),
+    type = track_types(x, types),
+    n = track_nrows(x, types)
+  ) %>% group_by(type) %>%
+  mutate(
+    .after = type,
+    i = row_number()
+  )
+  filter(y, type %in% types)
+}
+
+#' All types of all tracks
+#' @inheritParams track_ids
+#' @return a vector of all types of all selected tracks
+track_types <- function(x, types = c("seqs", "features", "links")){
+  flatten_chr(unname(map(types, ~rep(.x, length(x[[.x]])))))
+}
+
+#' Number of rows of all tracks tables
+#' @inheritParams track_ids
+#' @return a vector of number of rows all selected tracks tables
+track_nrows <- function(x, types = c("seqs", "features", "links")){
+  flatten_int(unname(map(types, ~map_int(x[[.x]], nrow))))
+}
+
+#' Track type by track id
+#' @inheritParams track_ids
+#' @return a character string with the track type
+track_type <- function(x, track_id){
+  track_ids <- track_ids(x)
+  names(track_ids)[track_ids == track_id]
+}
+
+## questionable
+tracks <- function(x, ...){
+  UseMethod("tracks")
+}
+tracks.gggenomes <- function(x, ...){
+  tracks(x$data)
+}
+tracks.gggenomes_layout <- function(x, types = c("seqs", "features", "links")){
+  c(x$seqs, x$features, x$links)
+}
+
+
+#' Convert a list of tibbles into tracks with magic
 as_tracks <- function(tracks, tracks_exprs, reserved_ids=NULL){
   # capture for df naming before first eval of tracks
   track_name <- as_label(enexpr(tracks))
@@ -62,24 +130,3 @@ name_unnamed_from_values <- function(x){
   names(x)[unnamed] <- x[unnamed]
   names(x)
 }
-
-#' @export
-track <- function(x, ...){
-  UseMethod("track")
-}
-
-track.gggenomes <- function(x, track_id){
-  track(x$data, {{track_id}})
-}
-
-track.gggenomes_layout <- function(x, track_id){
-  track_ids <- track_ids(x)
-  track_id <-  tryCatch(
-    tidyselect::vars_pull(track_ids, {{track_id}}),
-    error = function(err){rlang::abort(paste("in get track()", err$message))})
-
-  track_type <- names(track_ids)[track_ids == track_id]
-  if(track_type == "seqs") track <- list(track_id)
-  else  track <- list(track_type, track_id)
-  pluck(x, !!! track)
-}

gggenomes.Rproj

@@ -5,8 +5,13 @@ SaveWorkspace: No
 AlwaysSaveHistory: Default
 
 EnableCodeIndexing: Yes
+UseSpacesForTab: Yes
+NumSpacesForTab: 2
 Encoding: UTF-8
 
+RnwWeave: Sweave
+LaTeX: pdfLaTeX
+
 AutoAppendNewline: Yes
 StripTrailingWhitespace: Yes