Skip to content

Commit c0a26d3

Browse files
stephaniereindersstephaniereinders
authored
Merge pull request #68 from CSAFE-ISU/63-test-report-mod
tests: don't render snapshots in shiny test mode
2 parents 4784e31 + 73cfc92 commit c0a26d3

File tree

2 files changed

+188
-162
lines changed

2 files changed

+188
-162
lines changed

‎R/app.R‎

Lines changed: 78 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -136,25 +136,25 @@ bulletAnalyzrApp <- function(run_interactive = TRUE, sample_m = 10, ...){
136136
))),
137137
shiny::mainPanel(
138138
shiny::tabsetPanel(id="prevreport",
139-
140-
## Welcome
141-
shiny::tabPanel("Welcome",
142-
shiny::h3("WELCOME TO BULLETANALYZR!"),
143-
shiny::p("Our innovation combines 3D imagery and sophisticated algorithms to revolutionize bullet analysis. This prototype demonstrates how our methods can calculate the likelihood of the observed similarity if two bullets originated from the same firearm versus different firearms. It's a work in progress, evolving through feedback from diverse communities."),
144-
),
145-
146-
## Upload Bullet RGL Windows
147-
shiny::tabPanel("Upload Bullet", shiny::uiOutput("lpupload")),
148-
149-
## Upload Bullet RGL Windows
150-
shiny::tabPanel("Preview Bullet",shiny::uiOutput("lpreview")),
151-
152-
## Comparison Report
153-
shiny::tabPanel("Comparison Report",
154-
shinycssloaders::withSpinner(shiny::uiOutput("CCBullLand")),
155-
shinycssloaders::withSpinner(shiny::uiOutput("groovePlotsUI")),
156-
shinycssloaders::withSpinner(reportMainUI("report1"))
157-
)
139+
140+
## Welcome
141+
shiny::tabPanel("Welcome",
142+
shiny::h3("WELCOME TO BULLETANALYZR!"),
143+
shiny::p("Our innovation combines 3D imagery and sophisticated algorithms to revolutionize bullet analysis. This prototype demonstrates how our methods can calculate the likelihood of the observed similarity if two bullets originated from the same firearm versus different firearms. It's a work in progress, evolving through feedback from diverse communities."),
144+
),
145+
146+
## Upload Bullet RGL Windows
147+
shiny::tabPanel("Upload Bullet", shiny::uiOutput("lpupload")),
148+
149+
## Upload Bullet RGL Windows
150+
shiny::tabPanel("Preview Bullet",shiny::uiOutput("lpreview")),
151+
152+
## Comparison Report
153+
shiny::tabPanel("Comparison Report",
154+
shinycssloaders::withSpinner(shiny::uiOutput("CCBullLand")),
155+
shinycssloaders::withSpinner(shiny::uiOutput("groovePlotsUI")),
156+
shinycssloaders::withSpinner(reportMainUI("report1"))
157+
)
158158
)
159159
)
160160
)
@@ -185,6 +185,9 @@ bulletAnalyzrApp <- function(run_interactive = TRUE, sample_m = 10, ...){
185185
# Server--------------------------------------------------------------
186186
server <- function(input, output, session) {
187187

188+
# Skip rendering during tests
189+
is_testing <- isTRUE(getOption("shiny.testmode"))
190+
188191
# OUTPUT - Session Info - Report versions of packages used
189192
output$sessionInfo <- render_session_info(session)
190193

@@ -311,23 +314,25 @@ bulletAnalyzrApp <- function(run_interactive = TRUE, sample_m = 10, ...){
311314
}
312315

313316
# Render bullet
314-
progress$set(message = "Rendering Previews", value = .75)
315-
for(idx in 1:nrow(cbull)) {
316-
local({
317-
cidx <- idx
318-
# OUTPUT RGL - Bullet
319-
output[[paste0("x3prgl",idx)]] <- rgl::renderRglwidget({
320-
render_land(
321-
x3p = cbull$x3p[[cidx]],
322-
ccut = NULL,
323-
sample_m = sample_m,
324-
rotate = TRUE,
325-
img_size = 500,
326-
img_zoom = 0.4
327-
)
328-
rgl::rglwidget()
317+
if (!is_testing) {
318+
progress$set(message = "Rendering Previews", value = .75)
319+
for(idx in 1:nrow(cbull)) {
320+
local({
321+
cidx <- idx
322+
# OUTPUT RGL - Bullet
323+
output[[paste0("x3prgl",idx)]] <- rgl::renderRglwidget({
324+
render_land(
325+
x3p = cbull$x3p[[cidx]],
326+
ccut = NULL,
327+
sample_m = sample_m,
328+
rotate = TRUE,
329+
img_size = 500,
330+
img_zoom = 0.4
331+
)
332+
rgl::rglwidget()
333+
})
329334
})
330-
})
335+
}
331336
}
332337

333338
# Enable upload button
@@ -476,7 +481,7 @@ bulletAnalyzrApp <- function(run_interactive = TRUE, sample_m = 10, ...){
476481
}
477482
})
478483

479-
484+
480485
# SECTION: PREVIEW BULLET TAB----------------------------------------
481486

482487
# OUTPUT UI - Preview Bullet sidebar
@@ -514,23 +519,25 @@ bulletAnalyzrApp <- function(run_interactive = TRUE, sample_m = 10, ...){
514519
)
515520

516521
# Render selected bullet
517-
progress$set(message = "Rendering Previews", value = .75)
518-
for(idx in 1:nrow(bull)) {
519-
local({
520-
cidx <- idx
521-
# OUTPUT RGL - Bullet
522-
output[[paste0("x3prglprev",idx)]] <- rgl::renderRglwidget({
523-
render_land(
524-
x3p = bull$x3p[[cidx]],
525-
ccut = NULL,
526-
sample_m = sample_m,
527-
rotate = TRUE,
528-
img_size = 500,
529-
img_zoom = 0.4
530-
)
531-
rgl::rglwidget()
522+
if (!is_testing) {
523+
progress$set(message = "Rendering Previews", value = .75)
524+
for(idx in 1:nrow(bull)) {
525+
local({
526+
cidx <- idx
527+
# OUTPUT RGL - Bullet
528+
output[[paste0("x3prglprev",idx)]] <- rgl::renderRglwidget({
529+
render_land(
530+
x3p = bull$x3p[[cidx]],
531+
ccut = NULL,
532+
sample_m = sample_m,
533+
rotate = TRUE,
534+
img_size = 500,
535+
img_zoom = 0.4
536+
)
537+
rgl::rglwidget()
538+
})
532539
})
533-
})
540+
}
534541
}
535542

536543
# Display selected bullet
@@ -590,22 +597,24 @@ bulletAnalyzrApp <- function(run_interactive = TRUE, sample_m = 10, ...){
590597
temp_refresh <- input$prevreport
591598

592599
# Render lands with crosscuts
593-
for(idx in 1:nrow(bullets)) {
594-
local({
595-
cidx <- idx
596-
# OUTPUT RGL - Render lands with crosscuts
597-
output[[paste0("CC_Sel_",idx)]] <- rgl::renderRglwidget({
598-
render_land(
599-
x3p = bullets$x3p[[cidx]],
600-
ccut = input[[paste0("CCsl", cidx)]],
601-
rotate = TRUE,
602-
sample_m = sample_m,
603-
img_size = 500,
604-
img_zoom = 0.4
605-
)
606-
rgl::rglwidget()
600+
if (!is_testing) {
601+
for(idx in 1:nrow(bullets)) {
602+
local({
603+
cidx <- idx
604+
# OUTPUT RGL - Render lands with crosscuts
605+
output[[paste0("CC_Sel_",idx)]] <- rgl::renderRglwidget({
606+
render_land(
607+
x3p = bullets$x3p[[cidx]],
608+
ccut = input[[paste0("CCsl", cidx)]],
609+
rotate = TRUE,
610+
sample_m = sample_m,
611+
img_size = 500,
612+
img_zoom = 0.4
613+
)
614+
rgl::rglwidget()
615+
})
607616
})
608-
})
617+
}
609618
}
610619

611620
# Display lands with crosscuts
@@ -801,7 +810,7 @@ bulletAnalyzrApp <- function(run_interactive = TRUE, sample_m = 10, ...){
801810
left_groove = input$grooveL,
802811
right_groove = input$grooveR
803812
)
804-
813+
805814
})
806815

807816
# OUTPUT UI - Display Crosscut (Profiles) with Grooves
@@ -919,7 +928,7 @@ bulletAnalyzrApp <- function(run_interactive = TRUE, sample_m = 10, ...){
919928
comp_bul2 = shiny::reactive(input$comp_bul2),
920929
phase_test_results = phase$test_results
921930
)
922-
931+
923932
}
924933

925934
shiny::shinyApp(ui, server, ...)

0 commit comments

Comments
 (0)