Skip to content

Commit 2d3930d

Browse files
Handle features of origin of plasmid (#11)
* inital detection over split origin * add R-cmd-check * add pkgdown * add offset if over origin * fix _pkgdown.yml * cleanup * more robust fix and tests * update GHA workflows * fix tests
1 parent 244ab7c commit 2d3930d

16 files changed

Lines changed: 574 additions & 92 deletions

.github/workflows/R-CMD-check.yaml

Lines changed: 5 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,13 @@
11
# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
22
# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
3-
#
4-
# NOTE: This workflow is overkill for most R packages and
5-
# check-standard.yaml is likely a better choice.
6-
# usethis::use_github_action("check-standard") will install it.
73
on:
84
push:
95
branches: [main, master]
106
pull_request:
11-
branches: [main, master]
127

13-
name: R-CMD-check
8+
name: R-CMD-check.yaml
9+
10+
permissions: read-all
1411

1512
jobs:
1613
R-CMD-check:
@@ -23,11 +20,7 @@ jobs:
2320
matrix:
2421
config:
2522
- {os: macos-latest, r: 'release'}
26-
2723
- {os: windows-latest, r: 'release'}
28-
# use 4.1 to check with rtools40's older compiler
29-
- {os: windows-latest, r: '4.1'}
30-
3124
- {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'}
3225
- {os: ubuntu-latest, r: 'release'}
3326
- {os: ubuntu-latest, r: 'oldrel-1'}
@@ -37,7 +30,7 @@ jobs:
3730
R_KEEP_PKG_SOURCE: yes
3831

3932
steps:
40-
- uses: actions/checkout@v3
33+
- uses: actions/checkout@v4
4134

4235
- uses: r-lib/actions/setup-pandoc@v2
4336

@@ -55,3 +48,4 @@ jobs:
5548
- uses: r-lib/actions/check-r-package@v2
5649
with:
5750
upload-snapshots: true
51+
build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")'

.github/workflows/pkgdown.yaml

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -19,6 +19,8 @@ jobs:
1919
group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }}
2020
env:
2121
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
22+
permissions:
23+
contents: write
2224
steps:
2325
- uses: actions/checkout@v3
2426

.github/workflows/test-coverage.yaml

Lines changed: 20 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -4,9 +4,10 @@ on:
44
push:
55
branches: [main, master]
66
pull_request:
7-
branches: [main, master]
87

9-
name: test-coverage
8+
name: test-coverage.yaml
9+
10+
permissions: read-all
1011

1112
jobs:
1213
test-coverage:
@@ -15,36 +16,47 @@ jobs:
1516
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
1617

1718
steps:
18-
- uses: actions/checkout@v3
19+
- uses: actions/checkout@v4
1920

2021
- uses: r-lib/actions/setup-r@v2
2122
with:
2223
use-public-rspm: true
2324

2425
- uses: r-lib/actions/setup-r-dependencies@v2
2526
with:
26-
extra-packages: any::covr
27+
extra-packages: any::covr, any::xml2
2728
needs: coverage
2829

2930
- name: Test coverage
3031
run: |
31-
covr::codecov(
32+
cov <- covr::package_coverage(
3233
quiet = FALSE,
3334
clean = FALSE,
34-
install_path = file.path(Sys.getenv("RUNNER_TEMP"), "package")
35+
install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
3536
)
37+
print(cov)
38+
covr::to_cobertura(cov)
3639
shell: Rscript {0}
3740

41+
- uses: codecov/codecov-action@v5
42+
with:
43+
# Fail if error if not on PR, or if on PR and token is given
44+
fail_ci_if_error: ${{ github.event_name != 'pull_request' || secrets.CODECOV_TOKEN }}
45+
files: ./cobertura.xml
46+
plugins: noop
47+
disable_search: true
48+
token: ${{ secrets.CODECOV_TOKEN }}
49+
3850
- name: Show testthat output
3951
if: always()
4052
run: |
4153
## --------------------------------------------------------------------
42-
find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true
54+
find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
4355
shell: bash
4456

4557
- name: Upload test results
4658
if: failure()
47-
uses: actions/upload-artifact@v3
59+
uses: actions/upload-artifact@v4
4860
with:
4961
name: coverage-test-failures
5062
path: ${{ runner.temp }}/package

.gitignore

Lines changed: 5 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
1-
.Rproj.user
2-
.Rhistory
3-
.RData
4-
.Ruserdata
1+
.Rproj.user
2+
.Rhistory
3+
.RData
4+
.Ruserdata
5+
docs

DESCRIPTION

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -33,6 +33,7 @@ Suggests:
3333
testthat (>= 3.0.0)
3434
VignetteBuilder: knitr
3535
Depends: R (>= 2.10)
36-
URL: https::/github.com/bradyajohnston/plasmapr
37-
BugReports: https://github.com/bradyajohnston/plasmapr/issues
36+
URL: https://github.com/BradyAJohnston/plasmapR, https://bradyajohnston.github.io/plasmapR/
37+
BugReports: https://github.com/BradyAJohnston/plasmapR/issues
3838
Config/testthat/edition: 3
39+
Config/testthat/parallel: true

NAMESPACE

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -5,4 +5,5 @@ export(StatArrow)
55
export(StatArrowLabel)
66
export(plot_plasmid)
77
export(read_gb)
8+
export(stat_arrow)
89
importFrom(rlang,.data)

R/dataframe.R

Lines changed: 47 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,4 @@
1-
.feature_list_to_df <- function(x) {
2-
# dat <- data.frame(
3-
# index = numeric(),
4-
# name = character(),
5-
# type = character(),
6-
# start = numeric(),
7-
# end = numeric(),
8-
# direction = numeric()
9-
# )
1+
.feature_list_to_df <- function(x, bp = NULL, ...) {
102

113
feats <- lapply(seq(length(x)), \(i) {
124
feat <- x[[i]]
@@ -22,13 +14,57 @@
2214
})
2315

2416
dat <- do.call(rbind, feats)
25-
# }
2617

2718
# turn certain features in to numeric columns
2819
dat$start <- as.numeric(dat$start)
2920
dat$end <- as.numeric(dat$end)
3021
dat$direction <- as.numeric(dat$direction)
3122

23+
over_origin <- dat$start > dat$end & dat$direction == 1
24+
25+
if (any(over_origin)) {
26+
if (is.null(bp)) {
27+
bp <- max(c(dat$start, dat$end))
28+
}
29+
30+
# For origin-spanning features like join(4891..5096,1..751):
31+
# - We need to offset the coordinate system so this becomes continuous
32+
# - The offset should be chosen so that the feature becomes [new_start..new_end]
33+
# - All other features get shifted by the same offset
34+
35+
# Find the origin-spanning feature with the smallest end coordinate
36+
# This determines our offset
37+
min_end <- min(dat$end[over_origin])
38+
offset <- min_end
39+
40+
# Apply offset to all coordinates
41+
dat$start <- dat$start - offset
42+
dat$end <- dat$end - offset
43+
44+
# For origin-spanning features, calculate the correct end position
45+
# Original: join(4891..5096, 1..751) with bp=5096
46+
# After offset by 751: start=4140, end=0
47+
# Correct end should be: start + ((5096-4891+1) + 751 - 1) = 4140 + 956 = 5096
48+
for (i in which(over_origin)) {
49+
original_start <- dat$start[i] + offset # Restore original start
50+
original_end <- dat$end[i] + offset # Restore original end
51+
52+
# Calculate total feature length: (bp - start + 1) + end
53+
part1_length <- bp - original_start + 1 # From start to end of plasmid
54+
part2_length <- original_end # From beginning to end position
55+
total_length <- part1_length + part2_length
56+
57+
# Set the new end position
58+
dat$end[i] <- dat$start[i] + total_length - 1
59+
}
60+
61+
# Handle any negative coordinates by wrapping them around
62+
negative_coords <- dat$start < 0 | dat$end < 0
63+
dat$start[negative_coords & dat$start < 0] <-
64+
dat$start[negative_coords & dat$start < 0] + bp
65+
dat$end[negative_coords & dat$end < 0] <-
66+
dat$end[negative_coords & dat$end < 0] + bp
67+
}
3268

3369
# only return features where a start was successfully parsed
3470
# dat[!is.na(dat$start), ]
@@ -46,5 +82,5 @@
4682
#' @rdname as.data.frame.plasmid
4783
#' @export
4884
as.data.frame.plasmid <- function(x, row.names, optional, ...) {
49-
.feature_list_to_df(x$features)
85+
.feature_list_to_df(x$features, bp = x$length)
5086
}

R/get.R

Lines changed: 8 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -13,15 +13,14 @@
1313
}
1414

1515
.get_start_end <- function(x) {
16-
vector <- stringr::str_extract(x, "\\d+\\.\\.\\d+") |>
17-
stringr::str_split("\\.\\.") |>
18-
unlist() |>
19-
as.numeric()
20-
if (length(vector) == 1) {
21-
c(vector, vector)
22-
} else {
23-
vector
24-
}
16+
start_stops <- stringr::str_extract_all(x, "\\d+\\.\\.\\d+")[[1]]
17+
numbers <- unlist(stringr::str_extract_all(start_stops, "\\d+"))
18+
numbers <- as.numeric(numbers)
19+
20+
# takes into account where there is a join(500..600, 1..100)
21+
# where the feature goes over the origin
22+
vector <- c(numbers[1], numbers[length(numbers)])
23+
vector
2524
}
2625

2726
.get_feature_type <- function(x) {

R/plot.R

Lines changed: 9 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,13 @@
11

22
#' @importFrom rlang .data
33
#' @noRd
4-
.plot_plasmid <- function(dat, bp, name = "Plasmid Name", label_wrap = 20) {
4+
.plot_plasmid <- function(
5+
dat,
6+
bp,
7+
name = "Plasmid Name",
8+
rotation = 0,
9+
label_wrap = 20
10+
) {
511
dat <- dat[dat$type != "source", ]
612

713
name_supplied <- !is.null(name) & name != ""
@@ -22,7 +28,7 @@
2228
)) +
2329
ggplot2::geom_hline(yintercept = yintercept) +
2430
ggplot2::coord_polar(
25-
start = pi / 4
31+
start = rotation
2632
) +
2733

2834

@@ -91,7 +97,7 @@
9197
#' @export
9298
plot_plasmid <- function(plasmid, name = "Plasmid Name", label_wrap = 20) {
9399
if (methods::is(plasmid, "plasmid")) {
94-
features <- as.data.frame(plasmid)
100+
features <- as.data.frame(plasmid, bp = plasmid$length)
95101
} else if (methods::is(plasmid, "data.frame")) {
96102
features <- plasmid
97103
} else {

R/stat_arrow.R

Lines changed: 54 additions & 30 deletions
Original file line numberDiff line numberDiff line change
@@ -154,34 +154,58 @@ StatArrowLabel <- ggplot2::ggproto('StatArrowLabel', StatArrow,
154154
# required_aes = c('start', 'end')
155155
)
156156

157-
stat_arrow <-
158-
function(mapping = NULL,
159-
data = NULL,
160-
geom = "polygon",
161-
position = "identity",
162-
na.rm = FALSE,
163-
show.legend = NA,
164-
inherit.aes = TRUE,
165-
...,
166-
bp = 6000,
167-
# middle = 4,
168-
arrowhead_size = 8
169-
) {
170-
ggplot2::layer(
171-
stat = "arrow",
172-
data = data,
173-
mapping = mapping,
174-
geom = geom,
175-
position = position,
176-
show.legend = show.legend,
177-
inherit.aes = inherit.aes,
178-
params = list(
179-
na.rm = na.rm,
180-
bp = bp,
181-
# middle = middle,
182-
arrowhead_size = arrowhead_size,
183-
# start = start,
184-
# end = end,
185-
...)
157+
#' Custom Stat: Arrow
158+
#'
159+
#' This stat creates arrow shapes in a ggplot.
160+
#'
161+
#' @param mapping The aesthetic mapping, usually constructed with aes().
162+
#' @param data The dataset to be used in the layer.
163+
#' @param geom The geometric object to use for the layer, default is "polygon".
164+
#' @param position Position adjustment, default is "identity".
165+
#' @param na.rm Should missing values be removed?
166+
#' @param show.legend Logical. Should this layer be included in the legends?
167+
#' @param inherit.aes Should inherit aesthetics from the parent plot?
168+
#' @param ... Other arguments passed to layer().
169+
#' @param bp The base parameter for the arrow shape.
170+
#' @param arrowhead_size The size of the arrowhead.
171+
#' @return A ggplot layer with arrow shapes.
172+
#' @export
173+
#'
174+
#' @seealso \code{\link[ggplot2]{geom_segment}}
175+
#'
176+
#' @details
177+
#' Used for drawing features for a plasmid that work in both cartesian and
178+
#' polad coordinate systems.
179+
#'
180+
#' @note
181+
#' The `bp` parameter determines the base parameter of the arrow shape.
182+
#' The `arrowhead_size` parameter controls the size of the arrowhead.
183+
#'
184+
#' @keywords plotting
185+
stat_arrow <- function(mapping = NULL,
186+
data = NULL,
187+
geom = "polygon",
188+
position = "identity",
189+
na.rm = FALSE,
190+
show.legend = NA,
191+
inherit.aes = TRUE,
192+
...,
193+
bp = 6000,
194+
arrowhead_size = 8
195+
) {
196+
ggplot2::layer(
197+
stat = "arrow",
198+
data = data,
199+
mapping = mapping,
200+
geom = geom,
201+
position = position,
202+
show.legend = show.legend,
203+
inherit.aes = inherit.aes,
204+
params = list(
205+
na.rm = na.rm,
206+
bp = bp,
207+
arrowhead_size = arrowhead_size,
208+
...
186209
)
187-
}
210+
)
211+
}

0 commit comments

Comments
 (0)