Skip to content

Commit b48c575

Browse files
miyamot0miyamot0
authored
Merge pull request #1 from miyamot0/testing
Testing
2 parents 409ba42 + af303a4 commit b48c575

23 files changed

Lines changed: 607 additions & 92 deletions

‎.Rbuildignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2,3 +2,4 @@
22
^\.Rproj\.user$
33
^figs
44
^playground
5+
^\.github$

‎.github/.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
*.html

‎.github/workflows/test-coverage.yaml‎

Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
2+
# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
3+
on:
4+
push:
5+
branches: [main, master]
6+
pull_request:
7+
8+
name: test-coverage.yaml
9+
10+
permissions: read-all
11+
12+
jobs:
13+
test-coverage:
14+
runs-on: ubuntu-latest
15+
env:
16+
GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
17+
18+
steps:
19+
- uses: actions/checkout@v4
20+
21+
- uses: r-lib/actions/setup-r@v2
22+
with:
23+
use-public-rspm: true
24+
25+
- uses: r-lib/actions/setup-r-dependencies@v2
26+
with:
27+
extra-packages: any::covr, any::xml2
28+
needs: coverage
29+
30+
- name: Test coverage
31+
run: |
32+
cov <- covr::package_coverage(
33+
quiet = FALSE,
34+
clean = FALSE,
35+
install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package")
36+
)
37+
print(cov)
38+
covr::to_cobertura(cov)
39+
shell: Rscript {0}
40+
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+
50+
- name: Show testthat output
51+
if: always()
52+
run: |
53+
## --------------------------------------------------------------------
54+
find '${{ runner.temp }}/package' -name 'testthat.Rout*' -exec cat '{}' \; || true
55+
shell: bash
56+
57+
- name: Upload test results
58+
if: failure()
59+
uses: actions/upload-artifact@v4
60+
with:
61+
name: coverage-test-failures
62+
path: ${{ runner.temp }}/package

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
Package: ggsced
22
Type: Package
33
Title: Ggsced: Utilities and Helpers for SCED using ggplot2
4-
Version: 0.1.3
4+
Version: 0.1.4
55
Authors@R: person(given = "Shawn",
66
family = "Gilroy",
77
role = c("aut", "cre", "cph"),

‎R/ggsced.R‎

Lines changed: 53 additions & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -73,6 +73,7 @@ ggsced <- function(plt, legs,
7373

7474
# Grobs specific to data to be annotated
7575
lcl_panels <- ggsced_get_panels(lcl_ggplot_grobs)
76+
7677
# Number of panels as per the drawn figure
7778
lcl_n_panels = nrow(lcl_panels)
7879
assert::assert(!is.null(lcl_n_panels),
@@ -85,7 +86,6 @@ ggsced <- function(plt, legs,
8586
leg_lengths = unlist(lapply(legs, function(vec) {
8687
assert::assert(all(is.numeric(vec)),
8788
msg = "Phase change points must be of numeric type.")
88-
8989
length(vec)
9090
}), use.names = FALSE)
9191

@@ -94,149 +94,136 @@ ggsced <- function(plt, legs,
9494

9595
ggsced_output_console("\u2705 Phase Change Legs: list of vectors of uniform length", verbose)
9696

97+
if (!is.null(offs)) {
98+
# Assert: Must be uniform length legs
99+
offset_lengths = unlist(lapply(offs, function(vec) {
100+
assert::assert(all(is.logical(vec)),
101+
msg = "Phase change points must be of numeric type.")
102+
length(vec)
103+
}), use.names = FALSE)
104+
105+
assert::assert(length(unique(offset_lengths)) == 1,
106+
msg = "Phase change offset vectors in list are not of a uniform length.")
107+
108+
assert::assert(unique(leg_lengths) == unique(offset_lengths),
109+
length(leg_lengths) == length(offset_lengths),
110+
msg = "Phase change and offset vectors may be identical in dimension")
111+
112+
ggsced_output_console("\u2705 Phase Change Offsets: list of vectors of uniform length", verbose)
113+
}
114+
97115
n_leg = 0
98116

99117
for (pl in legs) {
100118
n_leg = n_leg + 1
101119

102120
for (row in seq_len(lcl_n_panels)) {
121+
# Reference respective panel pulled from gTree
103122
lcl_panel = lcl_panels[row,]
104123

124+
# Confirm if there are panels that follow this one
105125
has_more_rows = row < lcl_n_panels
106126

107-
params = lcl_ggplot_build$layout$panel_params[[row]]
108-
x_range <- params$x.range
109-
110-
x_lvl = pl[row]
111-
112-
npc_x <- ggsced_scale_units(x_lvl, x_range)
127+
# Extract range from grob (presuming uniform)
128+
x_range <- ggsced_extract_domain(lcl_ggplot_build$layout$panel_params[[row]])
113129

114-
# ggsced_output_console(paste("Draw", row, "of", lcl_n_panels,
115-
# "panels, x = ", x_lvl),
116-
# verbose)
117-
#
118-
# ggsced_output_console(paste("npc_x = ", npc_x),
119-
# verbose)
130+
# Scale x units to npc to derive desired location
131+
npc_x <- ggsced_scale_units(pl[row], x_range)
120132

133+
# Dynamic b = dynamic 'bottom' in the gTable object (i.e., t:b, common l/r)
134+
# If MORE ROWS, should extend JUST ABOVE next panel (i.e., n_2 - t)
135+
# If LAST ROW, the b should just t for current panel (i.e., n = n)
121136
dynamic_b = ifelse(has_more_rows == TRUE,
122137
lcl_panels[row + 1, "t"] - 1,
123138
lcl_panel$t)
124139

140+
# Dynamic offs = offsets to typical 'lateral' phase lines
141+
# Note: This is uncommon, so more of a special case
142+
# Generally, should be TRUE to notch up VERY SLIGHTLY
125143
dynamic_offs = ifelse(is.null(offs) == FALSE,
126144
offs[[n_leg]][row],
127-
0)
145+
FALSE)
128146

129-
draw_short = ifelse(dynamic_offs == 0, FALSE, TRUE)
147+
# TODO: Make this more clear/sane
148+
draw_short = dynamic_offs
130149

131150
if (draw_short == TRUE) {
132-
133151
dynamic_b = dynamic_b - 2
134152

135153
# Note: This is the full segment
136154
main_segment_name = ggsced_name_dogleg(lcl_panel, row, n_leg)
137-
main_segment = grid::segmentsGrob(x0 = grid::unit(npc_x, "npc"),
138-
x1 = grid::unit(npc_x, "npc"),
139-
y0 = grid::unit(1, "npc"),
140-
y1 = grid::unit(0, "npc"),
141-
name = main_segment_name)
142-
155+
main_segment = sced_phase_change_main_panel_grob(npc_x, main_segment_name)
143156
lcl_ggplot_grobs <- gtable::gtable_add_grob(lcl_ggplot_grobs,
144157
main_segment,
145158
t = lcl_panel$t,
146159
l = lcl_panel$l,
147-
#Note: this should connect to the upper portion
148160
b = dynamic_b,
149-
#clip = 'off',
150161
z = 1000,
151162
name = main_segment_name)
152163

153-
main_segment_pre = grid::segmentsGrob(x0 = grid::unit(npc_x, "npc"),
154-
x1 = grid::unit(npc_x, "npc"),
155-
y0 = grid::unit(1, "npc"),
156-
y1 = grid::unit(0.5, "npc"),
157-
name = paste(main_segment_name, 'pre'))
158-
164+
# Note: This is linking to full segment if in shortened space
165+
main_segment_pre = sced_phase_change_complex_lateral_pre_grob(npc_x,
166+
paste(main_segment_name,
167+
'pre-lateral'))
159168
lcl_ggplot_grobs <- gtable::gtable_add_grob(lcl_ggplot_grobs,
160169
main_segment_pre,
161170
t = dynamic_b + 1,
162171
l = lcl_panel$l,
163-
#clip = 'off',
164172
z = 1000,
165173
name = paste(main_segment_name, 'pre'))
166174

167-
168175
if (has_more_rows == TRUE) {
169176
main_segment_lateral_name = ggsced_name_dogleg_lateral(lcl_panel, row, n_leg)
170-
171177
npc_x2 <- ggsced_scale_units(pl[row + 1], x_range)
172178

173-
main_segment_post = grid::segmentsGrob(x0 = grid::unit(npc_x2, "npc"),
174-
x1 = grid::unit(npc_x2, "npc"),
175-
y0 = grid::unit(0.5, "npc"),
176-
y1 = grid::unit(0, "npc"),
177-
name = paste(main_segment_name, 'post'))
178-
179+
# Note: This is linking to full segment if in shortened space
180+
main_segment_post = sced_phase_change_complex_lateral_post_grob(npc_x2,
181+
paste(main_segment_lateral_name,
182+
'post-lateral'))
179183
lcl_ggplot_grobs <- gtable::gtable_add_grob(lcl_ggplot_grobs,
180184
main_segment_post,
181185
t = dynamic_b + 1,
182186
l = lcl_panel$l,
183-
#clip = 'off',
184187
z = 1000,
185-
name = paste(main_segment_name, 'post'))
186-
187-
lateral_segment2 = grid::segmentsGrob(x0 = grid::unit(npc_x, "npc"),
188-
x1 = grid::unit(npc_x2, "npc"),
189-
y0 = grid::unit(0.5, "npc"),
190-
y1 = grid::unit(0.5, "npc"),
191-
name = paste0(main_segment_lateral_name, 'asdf'))
188+
name = paste(main_segment_lateral_name,
189+
'post-lateral'))
192190

191+
lateral_segment2 = sced_phase_change_complex_lateral_grob(npc_x, npc_x2,
192+
paste0(main_segment_lateral_name,
193+
'lateral'))
193194
lcl_ggplot_grobs <- gtable::gtable_add_grob(lcl_ggplot_grobs,
194195
lateral_segment2,
195196
t = lcl_panels[row + 1,]$t - 2,
196197
l = lcl_panels[row + 1,]$l,
197-
#clip = 'off',
198198
z = 1000,
199-
name = paste0(main_segment_lateral_name, 'asdf'))
199+
name = paste0(main_segment_lateral_name,
200+
'lateral'))
200201
}
201-
202202
} else {
203-
204203
# Note: This is the full segment
205204
main_segment_name = ggsced_name_dogleg(lcl_panel, row, n_leg)
206-
main_segment = grid::segmentsGrob(x0 = grid::unit(npc_x, "npc"),
207-
x1 = grid::unit(npc_x, "npc"),
208-
y0 = grid::unit(1, "npc"),
209-
y1 = grid::unit(0, "npc"),
210-
name = main_segment_name)
205+
main_segment = sced_phase_change_main_panel_grob(npc_x, main_segment_name)
211206

212207
lcl_ggplot_grobs <- gtable::gtable_add_grob(lcl_ggplot_grobs,
213208
main_segment,
214209
t = lcl_panel$t,
215210
l = lcl_panel$l,
216211
b = dynamic_b,
217-
#clip = 'off',
218212
z = 1000,
219213
name = main_segment_name)
220214

221215
if (has_more_rows == TRUE) {
222216
main_segment_lateral_name = ggsced_name_dogleg_lateral(lcl_panel, row, n_leg)
223-
224217
npc_x2 <- ggsced_scale_units(pl[row + 1], x_range)
225-
226-
lateral_segment = grid::segmentsGrob(x0 = grid::unit(npc_x, "npc"),
227-
x1 = grid::unit(npc_x2, "npc"),
228-
y0 = grid::unit(1, "npc"),
229-
y1 = grid::unit(1, "npc"),
230-
name = main_segment_lateral_name)
218+
lateral_segment = sced_phase_change_simple_lateral_grob(npc_x, npc_x2,
219+
main_segment_lateral_name)
231220

232221
lcl_ggplot_grobs <- gtable::gtable_add_grob(lcl_ggplot_grobs,
233222
lateral_segment,
234223
t = lcl_panels[row + 1,]$t,
235224
l = lcl_panels[row + 1,]$l,
236-
#clip = 'off',
237225
z = 1000,
238226
name = main_segment_lateral_name)
239-
240227
}
241228
}
242229
}
@@ -256,5 +243,4 @@ ggsced <- function(plt, legs,
256243
ggsced_output_console("\u2705 Figure Output: Successfully output", verbose)
257244

258245
invisible(lcl_ggplot_grobs)
259-
260246
}

0 commit comments

Comments
 (0)