14 Shiny
Point and click any point:
::include_app("https://jkylearmstrong.shinyapps.io/Shiny/", height = "600px") knitr
After the yaml which looks like this:
There are four main components this app: setup
, ui
, server
, & runapp
14.1 setup
code chuck
::opts_chunk$set(echo = TRUE)
knitrlibrary('tidyverse')
<- readRDS(paste0(getwd(), '/DATA/A_DATA_week_4_cont_EDA.RDS')) %>%
A_DATA_TBL_2.t_ks_result.furrr select(Feature, mean_diff_est , ttest.pvalue, kstest.pvalue, N_Target, mean_Target, sd_Target, N_Control, mean_Control, sd_Control)
<- readRDS(paste0(getwd(),'/DATA/A_DATA.RDS'))
A_DATA_2 <- colnames(A_DATA_2)[!colnames(A_DATA_2) %in% c('SEQN', 'DIABETES','AGE_AT_DIAG_DM2')]
features
<- A_DATA_2 %>%
numeric_cols select_if(is.numeric) %>%
colnames()
<- intersect(features, numeric_cols)
numeric_features
source(paste0(getwd(),"/FUNCTIONS/wrapper_t_ks_test.R"))
We then have a pair a ui
chunk and server
chunk:
14.2 ui
code chunk:
<- fluidPage(
ui
sidebarLayout(
# input
sidebarPanel(
plotOutput("plot1", click = "plot_click")
),
# Show a plot of the generated distribution
mainPanel(
tableOutput("info"),
plotOutput("plot2")
)
)
)
14.3 sever
code chunk:
<- function(input, output) {
server $plot1 <- renderPlot({
output%>%
A_DATA_TBL_2.t_ks_result.furrr ggplot(aes(x=round(ttest.pvalue,4) , y= round(kstest.pvalue,4), color = Feature)) +
geom_point() +
theme(legend.position='none')
})
$info <- renderTable({
outputnearPoints(A_DATA_TBL_2.t_ks_result.furrr,
$plot_click,
inputxvar = "ttest.pvalue",
yvar = "kstest.pvalue") %>%
as.data.frame()
})
$plot2 <- renderPlot({
output<- (nearPoints(A_DATA_TBL_2.t_ks_result.furrr,
my_feature $plot_click,
inputxvar = "ttest.pvalue",
yvar = "kstest.pvalue"))$Feature
%>%
A_DATA_2 filter(!is.na(DIABETES))%>%
mutate(DIABETES_factor = as.factor(DIABETES)) %>%
ggplot(aes_string(x = my_feature , fill='DIABETES_factor')) +
geom_density()
}) }
14.4 runapp
code chunk
shinyApp(ui, server)