Commit f8767a44 authored by IZARD Lloyd's avatar IZARD Lloyd
Browse files

*changement des slider par des textInput pour les limites du plot (detection...

*changement des slider par des textInput pour les limites du plot (detection automatique des bornes par defaut)
*reorganisation du tabPanel pour le plot avec ajout d'un sideBar pour les parametres graphiques
*optimisation des fonctions de calcul (pour éviter une redondance)
parent d8801a30
......@@ -28,6 +28,22 @@ shinyServer(
return(df)
})
####### range x #######
init_range_x <- reactive({
x <- getData()[,1]
req(df)
return(round(max(x)+1, 0))
})
####### range y #######
init_range_y <- reactive({
y <- getData()[,2]
req(df)
return(round(max(y)+1, 0))
})
####### Calcul des estimateurs #######
calculate <- reactive({
......@@ -65,68 +81,78 @@ shinyServer(
return(params)
})
output$interaction_slider_x <- renderUI({
df <- getData()
req(df)
####### modele #######
calculated_data <- reactive({
sliderInput(
"slider_x",
"Select Range for x:",
min = 0,
max = round(max(df[,1], na.rm = T), 0) + 3,
value = c(min, max)
)
})
output$interaction_slider_y <- renderUI({
df <- getData()
req(df)
sliderInput(
"slider_y",
"Select Range for y:",
min = 0,
max = round(max(df[,2], na.rm = T), 0) + 3,
value = c(min, max)
)
})
####### Raw_plot #######
output$raw_plot <- renderPlot({
df <- getData()
req(df)
# This will change the value of input$xmax, based on xmax
updateTextInput(session, "xmax", value = init_range_x())
# This will change the value of input$ymax, based on ymax
updateTextInput(session, "ymax", value = init_range_y())
x <- rep(df[, 1], ncol(df) - 1)
y <- unlist(df[, 2:ncol(df)])
crssce <- data.frame(y, x)
# limit axes extended
maxx <- max(x, na.rm = T) + (max(x, na.rm = T) / 4)
maxy <- max(y, na.rm = T) + (max(y, na.rm = T) / 4)
w0 <- seq(0, maxx)
print(df)
print(x)
print(y)
print(crssce)
w0 <- seq(0, max(x), 1)
coef <- getInitial(y ~ SSlogis(x, asym, xmid, scal), data = cbind.data.frame(x, y))
mu <- 1 / coef[3]
# output plot
plot(x, y, xlab = input$xlabel, ylab = input$ylabel, xlim = input$slider_x,
ylim = input$slider_y, las = 1, pch = 22, bg = 1)
lines(w0, SSlogis(w0, coef[1], coef[2], coef[3]), lwd = 1.5)
grid()
q1b <- nlrq(y ~ SSlogis(x, K, xmid, r), tau = 0.25, data = crssce)
q3b <- nlrq(y ~ SSlogis(x, K, xmid, r), tau = 0.75, data = crssce)
q05b <- nlrq(y ~ SSlogis(x, K, xmid, r), tau = 0.025, data = crssce)
q95b <- nlrq(y ~ SSlogis(x, K, xmid, r), tau = 0.975, data = crssce)
result = data.frame(w0,
SSlogis(w0, coef[1], coef[2], coef[3]),
predict(q1b, newdata = list(x = w0)),
predict(q3b, newdata = list(x = w0)),
predict(q05b, newdata = list(x = w0)),
predict(q95b, newdata = list(x = w0)))
print(result)
# changerle header des data calculated
colnames(result) = c("w0", "SSlogis", "q1b", "q3b", "q05b", "q95b")
return(result)
})
####### Raw_plot #######
output$raw_plot <- renderPlot({
lines(w0, predict(q1b, newdata = list(x = w0)), col = "blue", lty=2)
lines(w0, predict(q3b, newdata = list(x = w0)), col = "blue", lty=2)
data <- getData()
req(data)
lines(w0, predict(q05b, newdata = list(x = w0)), col = "blue", lty=3)
lines(w0, predict(q95b, newdata = list(x = w0)), col = "blue", lty=3)
#
x <- data[,1]
y <- data[,2]
print(data)
df <- calculated_data()
req(df)
# output plot
plot(x, y, xlab = input$xlabel, ylab = input$ylabel, xlim = c(as.integer(input$xmin), as.integer(input$xmax)),
ylim = c(as.integer(input$ymin), as.integer(input$ymax)), las = 1, pch = 22, bg = 1)
grid()
lines(df$w0, df$SSlogis, lwd = 1.5)
lines(df$w0, df$q1b, col = "blue", lty=2)
lines(df$w0, df$q3b, col = "blue", lty=2)
lines(df$w0, df$q05b, col = "blue", lty=3)
lines(df$w0, df$q95b, col = "blue", lty=3)
})
####### Affichage du tableau des parametres #######
......@@ -136,6 +162,13 @@ shinyServer(
DT::datatable(params[,3:8])
#
})
####### Affichage du tableau du modele #######
output$data <- DT::renderDataTable({
paste("The table below gives the model results.")
DT::datatable(calculated_data())
#
})
####### Telecharger le fichier de demo
output$downloadDataDemo <- downloadHandler(
......@@ -302,37 +335,6 @@ Garel, M., Izard, L., Vienne, M., Nerini, D., Tamburini, C., & Martini, S. (2020
}
)
####### Calcul des estimateurs #######
calculated_data <- reactive({
df <- getData()
req(df)
x <- rep(df[, 1], ncol(df) - 1)
y <- unlist(df[, 2:ncol(df)])
crssce <- data.frame(y, x)
w0 <- seq(0, max(x), 1)
coef <- getInitial(y ~ SSlogis(x, asym, xmid, scal), data = cbind.data.frame(x, y))
mu <- 1 / coef[3]
q1b <- nlrq(y ~ SSlogis(x, K, xmid, r), tau = 0.25, data = crssce)
q3b <- nlrq(y ~ SSlogis(x, K, xmid, r), tau = 0.75, data = crssce)
q05b <- nlrq(y ~ SSlogis(x, K, xmid, r), tau = 0.025, data = crssce)
q95b <- nlrq(y ~ SSlogis(x, K, xmid, r), tau = 0.975, data = crssce)
result = data.frame(w0, c(0, y),
SSlogis(w0, coef[1], coef[2], coef[3]),
predict(q1b, newdata = list(x = w0)),
predict(q3b, newdata = list(x = w0)),
predict(q05b, newdata = list(x = w0)),
predict(q95b, newdata = list(x = w0)))
return(result)
})
output$downloadDataCalculated <- downloadHandler(
filename = function() {
paste('data-', Sys.Date(), '.txt', sep='')
......
......@@ -39,13 +39,7 @@ shinyUI(
#
radioButtons('dec', 'Decimal separator',
c(Point='.', Comma=','), selected="."),
#
textInput("xlabel", "xlabel", value = "Time (h)"),
#
textInput("ylabel", "ylabel", value = "Biomass")
c(Point='.', Comma=','), selected=".")
),
mainPanel(
helpText('This app is dedicated to estimate growth rate and maximum cells density using non lineare regression.
......@@ -57,17 +51,27 @@ shinyUI(
)
)
),
tabPanel("Uploaded data",
DT::dataTableOutput("raw_data")),
DT::dataTableOutput("raw_data")
),
tabPanel("Plot",
uiOutput("interaction_slider_x"),
uiOutput("interaction_slider_y"),
plotOutput("raw_plot"),
DT::dataTableOutput("parameters"),
downloadButton("downloadDataParameters", "Download parameters"),
DT::dataTableOutput("data"),
downloadButton("downloadDataCalculated", "Download plot data")
sidebarLayout(
sidebarPanel("",
textInput("xlabel", "xlabel", value = "Time (h)"),
textInput("ylabel", "ylabel", value = "Biomass"),
textInput("xmin", "xmin", value = 0),
textInput("xmax", "xmax", value = 100),
textInput("ymin", "ymin", value = 0),
textInput("ymax", "ymax", value = 100),
downloadButton("downloadDataParameters", "Download parameters"),
downloadButton("downloadDataCalculated", "Download plot data")
),
mainPanel(
plotOutput("raw_plot"),
DT::dataTableOutput("data"),
DT::dataTableOutput("parameters")
)
)
),
navbarMenu("Verify parameters estimation",
tabPanel("2D",
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment