Skip to content

Commit

Permalink
feat: start AnchoredPinnedGInteractions and anchor methods
Browse files Browse the repository at this point in the history
  • Loading branch information
js2264 committed Sep 10, 2023
1 parent 73ff43f commit adeb762
Show file tree
Hide file tree
Showing 12 changed files with 680 additions and 8 deletions.
5 changes: 5 additions & 0 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -47,6 +47,8 @@ RoxygenNote: 7.2.3
Collate:
'ginteractions-getters.R'
'DelegatingGInteractions-class.R'
'PinnedGInteractions-class.R'
'AnchoredPinnedGInteractions-class.R'
'GroupedGInteractions-class.R'
'arrange.R'
'count.R'
Expand All @@ -61,9 +63,12 @@ Collate:
'internals.R'
'methods-show.R'
'mutate.R'
'pin.R'
'plyranges-anchor.R'
'reexports-dplyr.R'
'reexports.R'
'rename.R'
'replace-anchors.R'
'select.R'
'slice.R'
'summarize.R'
22 changes: 22 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
# Generated by roxygen2: do not edit by hand

S3method(.DollarNames,GInteractions)
S3method(anchor,PinnedGInteractions)
S3method(arrange,GInteractions)
S3method(as_ginteractions,data.frame)
S3method(as_ginteractions,default)
Expand All @@ -25,6 +26,11 @@ S3method(summarize,GroupedGInteractions)
S3method(tally,GroupedGInteractions)
S3method(tbl_vars,GInteractions)
S3method(ungroup,GInteractions)
export(anchor_3p.PinnedGInteractions)
export(anchor_5p.PinnedGInteractions)
export(anchor_center.PinnedGInteractions)
export(anchor_end.PinnedGInteractions)
export(anchor_start.PinnedGInteractions)
export(anchors1)
export(anchors2)
export(arrange)
Expand All @@ -43,9 +49,17 @@ export(group_vars)
export(groups)
export(mutate)
export(n_groups)
export(pin)
export(pin_anchors1)
export(pin_anchors2)
export(pin_by)
export(pin_first)
export(pin_second)
export(pinned_anchors)
export(ranges1)
export(ranges2)
export(rename)
export(replace_anchors)
export(select)
export(seqnames1)
export(seqnames2)
Expand All @@ -57,22 +71,28 @@ export(strand2)
export(summarise)
export(summarize)
export(tally)
export(unanchor.PinnedGInteractions)
export(ungroup)
export(unpin)
export(width1)
export(width2)
exportMethods("$")
exportMethods(anchors1)
exportMethods(anchors2)
exportMethods(end1)
exportMethods(end2)
exportMethods(pin)
exportMethods(pinned_anchors)
exportMethods(ranges1)
exportMethods(ranges2)
exportMethods(replace_anchors)
exportMethods(seqnames1)
exportMethods(seqnames2)
exportMethods(start1)
exportMethods(start2)
exportMethods(strand1)
exportMethods(strand2)
exportMethods(unpin)
exportMethods(width1)
exportMethods(width2)
importFrom(BiocGenerics,end)
Expand Down Expand Up @@ -101,6 +121,7 @@ importFrom(dplyr,arrange)
importFrom(dplyr,bind_cols)
importFrom(dplyr,bind_rows)
importFrom(dplyr,count)
importFrom(dplyr,desc)
importFrom(dplyr,filter)
importFrom(dplyr,group_by)
importFrom(dplyr,group_data)
Expand Down Expand Up @@ -129,6 +150,7 @@ importFrom(methods,new)
importFrom(methods,selectMethod)
importFrom(methods,setMethod)
importFrom(methods,show)
importFrom(plyranges,anchor)
importFrom(rlang,"!!!")
importFrom(rlang,`:=`)
importFrom(rlang,enquo)
Expand Down
44 changes: 44 additions & 0 deletions R/AnchoredPinnedGInteractions-class.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,44 @@
#' @importFrom InteractionSet GInteractions
#' @importFrom S4Vectors DataFrame
#' @importFrom S4Vectors Rle
#' @importFrom utils capture.output
#' @importFrom methods show
#' @include PinnedGInteractions-class.R
setClass("AnchoredPinnedGInteractions",
slot = c(
anchor = "character"
),
contains = c("PinnedGInteractions")
)

#' @importFrom InteractionSet GInteractions
#' @importFrom methods setMethod initialize
setMethod("initialize", "AnchoredPinnedGInteractions", function(
.Object, delegate = InteractionSet::GInteractions(), pin, anchor
) {
stopifnot(
pin %in% c("anchors1", "first", "1", "anchors2", "second", "2")
)
pin <- switch(pin,
"anchors1" = 1L,
"first" = 1L,
"1" = 1L,
"anchors2" = 2L,
"second" = 2L,
"2" = 2L
)
.Object@delegate <- delegate
.Object@pin <- pin
.Object@anchor <- anchor
.Object
})

setMethod("show", "AnchoredPinnedGInteractions", function(object) {
output <- c("", utils::capture.output(show(object@delegate)))
output[1] <- output[2]
output[2] <- paste0(
"Pinned on: `anchors", object@pin,
"` (anchored on: `", object@anchor, "`)"
)
cat(output, sep = "\n")
})
7 changes: 1 addition & 6 deletions R/DelegatingGInteractions-class.R
Original file line number Diff line number Diff line change
Expand Up @@ -76,10 +76,5 @@ setMethod("seqinfo", "DelegatingGInteractions", function(x) seqinfo(x@delegate))
setMethod("mcols", "DelegatingGInteractions", function(x) mcols(x@delegate))
#' @rdname delegating-ginteractions-class
setMethod("show", "DelegatingGInteractions", function(object) {
groups <- colnames(object@group_keys)
groups <- paste(groups, collapse = ", ")
output <- c("", utils::capture.output(show(object@delegate)))
output[1] <- output[2]
output[2] <- paste("Groups:", groups, paste0("[", object@n, "]"))
cat(output, sep = "\n")
show(object@delegate)
})
15 changes: 13 additions & 2 deletions R/GroupedGInteractions-class.R
Original file line number Diff line number Diff line change
Expand Up @@ -12,10 +12,13 @@ setClass("GroupedGInteractions",
contains = c("DelegatingGInteractions")
)

#' @importFrom InteractionSet GInteractions
#' @importFrom methods setMethod initialize
setMethod("initialize", "GroupedGInteractions",
function(
.Object, delegate = GRanges(), group_keys = DataFrame(),
.Object,
delegate = InteractionSet::GInteractions(),
group_keys = DataFrame(),
group_indices = Rle(), n = integer()
) {
.Object@delegate <- delegate
Expand All @@ -26,11 +29,19 @@ setMethod("initialize", "GroupedGInteractions",
}
)

setMethod("show", "GroupedGInteractions", function(object) {
groups <- colnames(object@group_keys)
groups <- paste(groups, collapse = ", ")
output <- c("", utils::capture.output(show(object@delegate)))
output[1] <- output[2]
output[2] <- paste("Groups:", groups, paste0("[", object@n, "]"))
cat(output, sep = "\n")
})

#' @export
#' @keywords internal
group_by.GroupedGInteractions <- function(.data, ..., .add = FALSE) {
new_groups <- rlang::enquos(...)
if (.add) new_groups <- c(groups(.data), new_groups)
group_by(.data@delegate, !!!new_groups)
}

40 changes: 40 additions & 0 deletions R/PinnedGInteractions-class.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,40 @@
#' @importFrom InteractionSet GInteractions
#' @importFrom S4Vectors DataFrame
#' @importFrom S4Vectors Rle
#' @importFrom utils capture.output
#' @importFrom methods show
#' @include DelegatingGInteractions-class.R
setClass("PinnedGInteractions",
slot = c(
pin = "integer"
),
contains = c("DelegatingGInteractions")
)

#' @importFrom InteractionSet GInteractions
#' @importFrom methods setMethod initialize
setMethod("initialize", "PinnedGInteractions", function(
.Object, delegate = InteractionSet::GInteractions(), pin
) {
stopifnot(
pin %in% c("anchors1", "first", "1", "anchors2", "second", "2")
)
pin <- switch(pin,
"anchors1" = 1L,
"first" = 1L,
"1" = 1L,
"anchors2" = 2L,
"second" = 2L,
"2" = 2L
)
.Object@delegate <- delegate
.Object@pin <- pin
.Object
})

setMethod("show", "PinnedGInteractions", function(object) {
output <- c("", utils::capture.output(show(object@delegate)))
output[1] <- output[2]
output[2] <- paste0("Pinned on: anchors", object@pin)
cat(output, sep = "\n")
})
130 changes: 130 additions & 0 deletions R/pin.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,130 @@
#' Pin GInteractions by anchors set (anchors1 or anchors2).
#'
#' @param .data,x a (Grouped)GInteractions object
#' @param anchors Anchors to pin on ("first" or "second")
#'
#' @return a PinnedGInteractions object.
#'
#' @rdname ginteractions-pin
#'
#' @examples
#' gi <- read.table(text = "
#' chr1 11 20 chr1 21 30
#' chr1 11 20 chr1 51 50
#' chr1 11 30 chr1 51 50
#' chr1 11 30 chr2 51 60",
#' col.names = c("seqnames1", "start1", "end1", "seqnames2", "start2", "end2")) |>
#' as_ginteractions() |>
#' mutate(type = c('cis', 'cis', 'cis', 'trans'), score = runif(4))
#'
#' ####################################################################
#' # 1. Pin and modify anchors
#' ####################################################################
#'
#' gi |> pin("first")
#'
#' gi |> pin_by("first")
#'
#' gi |> pin_first()
#'
#' gi |> pin_anchors1()
#'
#' ####################################################################
#' # 2. Pin by second anchors
#' ####################################################################
#'
#' gi |> pin("second")
#'
#' gi |> pin_by("second")
#'
#' gi |> pin_second()
#'
#' gi |> pin_anchors2()
#'
#' ####################################################################
#' # 3. Unpin
#' ####################################################################
#'
#' gi |> pin("second") |> unpin()
#'
#' @export
setGeneric("pin", function(x, anchors) standardGeneric("pin"))

#' @rdname ginteractions-pin
#' @export
setMethod("pin", signature(x = "GInteractions", anchors = "character"), function(x, anchors) {
methods::new("PinnedGInteractions", x, anchors)
})

#' @rdname ginteractions-pin
#' @export
setMethod("pin", signature(x = "GInteractions", anchors = "numeric"), function(x, anchors) {
if (!anchors %in% c(1, 2)) stop("`anchors` can only be set to `1` or `2`")
methods::new("PinnedGInteractions", x, as.character(anchors))
})

#' @rdname ginteractions-pin
#' @export
setMethod("pin", signature(x = "PinnedGInteractions", anchors = "missing"), function(x, anchors) {
x@pin
})

#' @rdname ginteractions-pin
#' @export
setMethod("pin", signature(x = "PinnedGInteractions", anchors = "character"), function(x, anchors) {
methods::new("PinnedGInteractions", x@delegate, anchors)
})

#' @rdname ginteractions-pin
#' @export
setMethod("pin", signature(x = "PinnedGInteractions", anchors = "numeric"), function(x, anchors) {
if (!anchors %in% c(1, 2)) stop("`anchors` can only be set to `1` or `2`")
methods::new("PinnedGInteractions", x@delegate, as.character(anchors))
})

#' @export
#' @rdname ginteractions-pin
setGeneric("pin_by", function(x, anchors) pin(x, anchors))

#' @rdname ginteractions-pin
#' @export
pin_first <- function(x) pin(x, 1)

#' @rdname ginteractions-pin
#' @export
pin_second <- function(x) pin(x, 2)

#' @rdname ginteractions-pin
#' @export
pin_anchors1 <- function(x) pin(x, 1)

#' @rdname ginteractions-pin
#' @export
pin_anchors2 <- function(x) pin(x, 2)

#' @rdname ginteractions-pin
#' @export
setGeneric("unpin", function(x) standardGeneric("unpin"))

#' @rdname ginteractions-pin
#' @export
setMethod("unpin", signature(x = "PinnedGInteractions"), function(x) {
x@delegate
})

#' @rdname ginteractions-pin
#' @export
setMethod("unpin", signature(x = "GInteractions"), function(x) {
x
})

#' @rdname ginteractions-pin
#' @export
setGeneric("pinned_anchors", function(x) standardGeneric("pinned_anchors"))

#' @rdname ginteractions-pin
#' @export
setMethod("pinned_anchors", signature(x = "PinnedGInteractions"), function(x) {
id <- switch(pin(x), "1" = "first", "2" = "second")
InteractionSet::anchors(x@delegate, type = id)
})
Loading

0 comments on commit adeb762

Please sign in to comment.