Hi
My graph was responding in real time when sliders were used. Ive since changed the ui.R file to use the htmlTemplate() function and now my graph doesnt react!
Can anyone offer a clue why this might be?
Thanks
To help us help you, could you please prepare a reproducible example (reprex) illustrating your issue? Please have a look at this guide, to see how to create one for a shiny app
Of course @andresrcs . thanks
In my ui.R I did have:
library(shiny)
library(plotly)
library(viridis)
ui <- shinyUI(fluidPage(
tags$head(includeScript("google-analytics.js")),
titlePanel("Type 1 diabetes prediction"),
sidebarLayout(
sidebarPanel(
sliderInput(
"id_Age",
"Current age of the child",
min = 0,
max = 7,
value = 1,
step = 0.5,
post = " years",
sep = ","
),
sliderInput(
"id_Age_hor",
"Age of interest to predict type 1 diabetes",
min = 2,
max = 14,
value = 2,
step = 1,
post = " years",
sep = ","
),
radioButtons(
"id_FH",
"Parents or siblings with type one diabetes?",
c("No" = 0, "Yes" = 1)
),
sliderInput(
"id_GRS",
"Genetic risk score",
min = 00,
max = 100,
value = 75,
step = 0.01,
sep = ","
),
radioButtons(
"id_AB",
"Number of autoantibody detected",
c(
"0" = 0,
"1" = 1,
"2" = 2,
"3" = 3
)
),
shiny::img(src='JDRF-logo.png', align = "right", height = 200)
),
mainPanel(
column(12, align = "center", textOutput("pred_text",)),
column(12, align = "center", plotOutput("waffle"))
)
)
)
)
Which I changed to:
library(shiny)
library(plotly)
library(viridis)
htmlTemplate("www/index.html",
slider = sliderInput(
"id_Age",
"Current age of the child",
min = 0,
max = 7,
value = 1,
step = 0.5,
post = " years",
sep = ","
),
slider2 = sliderInput(
"id_Age_hor",
"Age of interest to predict type 1 diabetes",
min = 2,
max = 14,
value = 2,
step = 1,
post = " years",
sep = ","
),
radio = radioButtons(
"id_FH",
"Parents or siblings with type one diabetes?",
c("No" = 0, "Yes" = 1)
),
sliderInput = sliderInput(
"id_GRS",
"Genetic risk score",
min = 00,
max = 100,
value = 75,
step = 0.01,
sep = ", "
),
radio2 = radioButtons(
"id_AB",
"Number of autoantibody detected",
c(
"0" = 0,
"1" = 1,
"2" = 2,
"3" = 3
)
),
table = textOutput("pred_text",),
waffle = column(12, align = "center", plotOutput("waffle"))
)
In my server.R file I have:
library(akima)
library(dplyr)
library(ggplot2)
library(waffle)
library(survival)
nrows <- 10
size_waffle <- 4
pathSaveModels <- "models/"
choice_of_model <- c(60,365.25,365.25 + 183,365.25*2 + seq(0,5*365.25,365)) + 45
for (day in choice_of_model){
names_tAUC <- paste0("Cox_model_","_complexity_abn_grs_fdr_day_begin_",day)
load(file = paste0(pathSaveModels,names_tAUC,".RData"))
assign(paste0("res.cox",day),res.cox)
}
UKBio <- read.csv(paste0(pathSaveModels,"UK_biobank.csv"))
shinyServer(
function(input, output,session) {
observe({
val <- input$id_Age
updateSliderInput(session,"id_Age_hor", value = val + 3,
min = round(val+1), max = 13, step = 1)
})
prediction_l <- reactive({
age <- input$id_Age
age_hor <- input$id_Age_hor
fdr <- input$id_FH
GRS2 <- UKBio[which.min(abs(UKBio$centile-input$id_GRS/100)),"threshold"]
number_autoantibody <- input$id_AB
fdr <- c(fdr,rep(c(0,1,0,1), 4))
GRS2 <- c(GRS2,rep(c(13.25386,13.25386,15.60408,15.60408),4))
number_autoantibody <- c(number_autoantibody,rep(c(0,1,2,3),each = 4))
peopleID <- 1:17
dataset_ml <- data.frame(peopleID,fdr, GRS2, number_autoantibody) %>% mutate(fdr = factor(fdr), number_autoantibody = factor(number_autoantibody))
child_to_predict <- dataset_ml[1,]
choice_of_model <- c(60,365.25,365.25 + 183,365.25*2 + seq(0,5*365.25,365)) + 45
day <- choice_of_model[which.min(abs(choice_of_model-365.25 * age + 45))]
res.cox <- get(paste0("res.cox",day))
prediction_1Y <- summary(survfit(res.cox,child_to_predict),times = day + (age_hor-age)*365.25)
prediction_3Y <- summary(survfit(res.cox,child_to_predict),times = day + 3*365.25)
prediction_5Y <- summary(survfit(res.cox,child_to_predict),times = day + 5*365.25)
p_1y <- 1-prediction_1Y$surv
p_1y_low <- 1-prediction_1Y$upper
p_1y_up <- 1-prediction_1Y$low
p_3y_low <- 1-prediction_3Y$upper
p_3y <- 1-prediction_3Y$surv
p_3y_up <- 1-prediction_3Y$low
p_5y_low <- 1-prediction_5Y$upper
p_5y <- 1-prediction_5Y$surv
p_5y_up <- 1-prediction_5Y$low
list(p_1y = p_1y, p_1y_low = p_1y_low, p_1y_up = p_1y_up, p_3y_low = p_3y_low, p_3y = p_3y, p_3y_up = p_3y_up, p_5y_low = p_5y_low, p_5y = p_5y, p_5y_up = p_5y_up,year_hor = (age_hor-age))
})
output$pred_text <- renderText({
data_pred_l <- prediction_l()
parts <- c(`Type 1 diabetes` = round(data_pred_l[["p_1y"]]*1000), `Type 1 diabetes free` = round((1-data_pred_l[["p_1y"]])*1000))
str <- paste0("Probability to develop Type 1 diabetes in the next ", ifelse(data_pred_l[["year_hor"]] == 1," year is ",paste0(data_pred_l[["year_hor"]]," years is ")) , round(data_pred_l[["p_1y"]],digits = 3),
"\nwith a confidence interval at 95% of [ ", round(data_pred_l[["p_1y_low"]],digits = 3)," - ", round(data_pred_l[["p_1y_up"]],digits = 3)," ].\nThis represents ",round(data_pred_l[["p_1y"]]*1000) , " cases for 1000 people.")
str
})
output$waffle <- renderPlot({
data_pred_l <- prediction_l()
parts <- c(`Type 1 diabetes` = round(data_pred_l[["p_1y"]]*100), `Type 1 diabetes free` = round((1-data_pred_l[["p_1y"]])*100))
str <- paste0("This represents ",round(data_pred_l[["p_1y"]]*100,1) , " cases for 100 people.")
chart <- waffle(parts, rows=nrows,colors = c("blue","orange"), size = size_waffle,title = str)
chart
})
}
)
In my html file I have:
<!DOCTYPE html>
<html>
<head>
{{ headContent() }}
{{ bootstrapLib() }}
<style>
footer img{width:150px;}
</style>
</head>
<body>
<div class="container">
<div class="row">
<div class="col-md-12">
<h1>Type 1 diabetes prediction calculator</h1>
<img src="JDRF-logo.png" width="200" height="100">
<i class="fas fa-child"></i>
<p>This calculator aims to predict the probability of a child to develop type 1 diabetes given its age, its genetic risk score, its family history and its autoantibody status, more details can be found in Ferrat et al. about the model and in Sharp et al. for the genetic risk score. Please note work on this model is still in progress and further validation needs to be undertaken.</p>
</div>
</div>
<div class="row">
<div class="col-md-4">
<div class="well">
{{ slider }}
</div>
<div class="well">
{{ slider2 }}
</div>
<div class="well">
{{ radio }}
</div>
<div class="well">
{{ sliderInput }}
</div>
<div class="well">
{{ radio2 }}
</div>
</div>
<div class="col-md-8">
{{pred_text}}
{{ waffle }}
</div>
</div>
</div> <!-- /container -->
</body>
</html>
As I say, in my orginal ui.R file its working, but changing it to use my html template it stopped being reactive.
Many thanks
This topic was automatically closed 21 days after the last reply. New replies are no longer allowed.