Libraries

library(tidyverse)
library(readxl)
library(here)
library(gt)
library(rayshader)
library(knitr)
library(av)

• Libraries
• Solidworks Design Study
  • Creating the Solid Model
    • Sketch the Sweep Path that will Define Vessel Shape
    • Sketch the Sweep Profile that will Define Vessel Diameter
    • Sweep the Circular Profile along the Path From Sketch 1
    • Add Reference Geometry Planes
    • Add Reference Axis for Cutting Plane
    • Add Angled Cutting Plane
    • Sketch Cutting Circle on Angled Cutting Plane
    • Extuded Cut from Angled Plane
    • Set Up Design Study by Adding Variables
    • Set Ranges for Variables of Interest
    • Add Measurement Sensor
    • Design Study at Work
• R Analyis and Visualization
  • CSV Output from Design Study
  • Load Data
• Clean Data
  • Reformat and clean in wide format
• Reshape Data
  • Convert to long format in preparation for visualization
• Visualize
  • ggplot
  • rayshader
• Takeaways and Conclusions
• Final Thought
• sessionInfo

Solidworks Design Study

R Analyis and Visualization

data_raw_tbl <- read_csv(here("tilt_vessel_output_02apr2021.csv"), skip = 2)

data_raw_tbl %>%
  gt_preview()

Clean Data

Now a series of initial cleaning steps:

• clean_names() to convert the column names to snake_case and remove any other weirdness
• remove the format and unit columns using select
• drop_na() to remove the useless row containing just “calculated”
• rename the first column header to something shorter “param”
• recode the value “Measurement7” as just “measurement” in a way that would work for other numeric suffixes
• convert the param column to be a factor

study_1_wide_tbl <- data_raw_tbl %>%
  janitor::clean_names() %>%
  select(-c(format, unit)) %>%
  drop_na() %>%
  rename(param = parameter_constraint_or_goal) %>%
  mutate(across(contains(match = "_"), as.double)) %>%
  mutate(param = case_when(
    str_detect(param, "Measurement") ~ "measurement",
    TRUE ~ param
  )) %>%
  mutate(param = param %>% as_factor())

study_1_wide_tbl %>%
  gt_preview()

Reshape Data

study_1_long_tbl <- study_1_wide_tbl %>%
  pivot_longer(cols = -param) %>%
  separate(col = name, into = c("delete", "scenario"), sep = "_") %>%
  filter(scenario != "value") %>%
  mutate(scenario = scenario %>% as.double()) %>%
  select(-delete) %>%
  select(scenario, param, value) %>%
  pivot_wider(id_cols = c(param, scenario), names_from = param) %>%
  mutate(measurement = measurement %>% round(digits = 2))

study_1_long_tbl %>%
  gt_preview()

Visualize

surface_plt <- study_1_long_tbl %>%
  ggplot(aes(x = vessel_roc, y = vessel_angulation)) +
  geom_raster(aes(fill = measurement), interpolate = TRUE) +
  scale_fill_viridis_c(option = "A") +
  labs(
    x = "Vessel Inner Radius of Curvature (mm)",
    y = "Vessel Centerline Angulation (degrees)",
    title = "Vessel Perimeter as a Function of Angulation and Radius of Curvature",
    subtitle = "Measured at 10 mm below onset of angulation, Vessel ID = 20 mm",
    fill = "Perimeter (mm)"
  )


surface_plt

surface_plt_2 <- study_1_long_tbl %>%
  filter(vessel_roc < 15) %>%
  ggplot(aes(x = vessel_roc, y = vessel_angulation)) +
  geom_raster(aes(fill = measurement), interpolate = TRUE) +
  scale_fill_viridis_c(option = "A") +
  labs(
    x = "Vessel Inner Radius of Curvature (mm)",
    y = "Vessel Centerline Angulation (degrees)",
    title = "Vessel Perimeter as a Function of Angulation and Radius of Curvature",
    subtitle = "Measured at 10 mm below onset of angulation, Vessel ID = 20 mm",
    fill = "Perimeter (mm)"
  )

surface_plt_2

# plot_gg(surface_plt_2, width=7, height = 5, multicore = TRUE, windowsize = c(1400,866), sunangle=225,
#         zoom = 0.60, phi = 30, theta = 45)

Takeaways and Conclusions

The figure tells an interesting story: as long as the vessel angulation is less than about 20 degrees and the radius of curvature less than about 15 mm then the perimeter at the plane of interest is relatively low. But if the radius of curvature is less than 15 mm and the angulation greater than 20 degree, the perimeter will increase relative to baseline with the largest increases occurring at higher values of angulation and lower values of radius of curvature. Let’s look at a couple of cases as a gut-check, using this little helper tibble to plot lines in some regions of interest.

Case 1:

• Radius of Curvature = 5, Angulation = 20, 70: we can see that when both variables are on the low end of their range, the cut plane is actually below the angulation and the perimeter will be relatively low. As the Angulation goes up to 70, the perimeter is affected and will be larger.

vlines_tbl <- tibble(
  vessel_roc = c(5, 5, 13, 13),
  vessel_angulation = c(20, 70, 20, 70),
  plot = c(1, 1, 2, 2)
)

surface_plt_2 +
  geom_line(data = vlines_tbl %>% filter(plot == 1), color = "white", linetype = "dashed") +
  geom_point(data = vlines_tbl %>% filter(plot == 1), color = "white", size = 2)

Case 2:

• Radius of Curvature = 13, Angulation = 20, 70: when the radius of curvature is sufficiently large, the perimeter measurement at the cutting plane is relatively insensitive the angulation.

surface_plt_2 +
  geom_line(data = vlines_tbl %>% filter(plot == 2), color = "white", linetype = "dashed") +
  geom_point(data = vlines_tbl %>% filter(plot == 2), color = "white", size = 2)

Final Thought

This provides our hypothetical clinical imaging team with some important insight about patient screening that will hopefully improve outcomes. If you’ve made it this far, I thank you for your attention and hope this walkthrough was useful!

sessionInfo

sessionInfo()
## R version 4.0.3 (2020-10-10)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18363)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=English_United States.1252 
## [2] LC_CTYPE=English_United States.1252   
## [3] LC_MONETARY=English_United States.1252
## [4] LC_NUMERIC=C                          
## [5] LC_TIME=English_United States.1252    
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
##  [1] av_0.5.1         knitr_1.30       rayshader_0.19.2 gt_0.2.2        
##  [5] here_1.0.0       readxl_1.3.1     forcats_0.5.0    stringr_1.4.0   
##  [9] dplyr_1.0.2      purrr_0.3.4      readr_1.4.0      tidyr_1.1.2     
## [13] tibble_3.0.4     ggplot2_3.3.2    tidyverse_1.3.0 
## 
## loaded via a namespace (and not attached):
##  [1] fs_1.5.0                lubridate_1.7.9.2       doParallel_1.0.16      
##  [4] webshot_0.5.2           progress_1.2.2          httr_1.4.2             
##  [7] rprojroot_2.0.2         tools_4.0.3             backports_1.2.0        
## [10] R6_2.5.0                DBI_1.1.0               colorspace_2.0-0       
## [13] manipulateWidget_0.10.1 withr_2.3.0             tidyselect_1.1.0       
## [16] prettyunits_1.1.1       compiler_4.0.3          cli_2.2.0              
## [19] rvest_0.3.6             xml2_1.3.2              labeling_0.4.2         
## [22] bookdown_0.21           sass_0.3.1              scales_1.1.1           
## [25] checkmate_2.0.0         digest_0.6.27           rmarkdown_2.5          
## [28] pkgconfig_2.0.3         htmltools_0.5.0         dbplyr_2.0.0           
## [31] fastmap_1.0.1           htmlwidgets_1.5.2       rlang_0.4.9            
## [34] rstudioapi_0.13         shiny_1.5.0             generics_0.1.0         
## [37] farver_2.0.3            jsonlite_1.7.1          crosstalk_1.1.0.1      
## [40] magrittr_2.0.1          Rcpp_1.0.5              munsell_0.5.0          
## [43] fansi_0.4.1             lifecycle_0.2.0         stringi_1.5.3          
## [46] yaml_2.2.1              snakecase_0.11.0        grid_4.0.3             
## [49] parallel_4.0.3          promises_1.1.1          crayon_1.3.4           
## [52] miniUI_0.1.1.1          haven_2.3.1             hms_0.5.3              
## [55] ps_1.4.0                pillar_1.4.7            codetools_0.2-18       
## [58] reprex_0.3.0            glue_1.4.2              evaluate_0.14          
## [61] blogdown_0.15           modelr_0.1.8            vctrs_0.3.5            
## [64] httpuv_1.5.4            foreach_1.5.1           cellranger_1.1.0       
## [67] gtable_0.3.0            assertthat_0.2.1        xfun_0.19              
## [70] mime_0.9                janitor_2.0.1           xtable_1.8-4           
## [73] broom_0.7.2             later_1.1.0.1           viridisLite_0.3.0      
## [76] iterators_1.0.13        rgl_0.103.5             ellipsis_0.3.1