Catch singularities when fitting 4pl, SCRUM jobs listed
This commit is contained in:
@@ -44,11 +44,11 @@ ui <- dashboardPage(
|
||||
# menuSubItem(icon = NULL, tags$li(a("Document", target="self",href="UserManual.pdf")))
|
||||
# ),
|
||||
menuItem("EXCEL upload", tabName="Dataupload", icon=icon("magnet", lib="glyphicon")),
|
||||
menuItem("4PL metadata + report", tabName="fourPL", icon=icon("chart-line", lib="font-awesome")),
|
||||
menuItem("4PL simulation", tabName="fourPL", icon=icon("chart-line", lib="font-awesome")),
|
||||
#menuItem("XLSX diagnostics", tabName="XLdiagn", icon=icon("chart-bar", lib="font-awesome")),
|
||||
# menuItem("Linear regression + report", tabName="pla", icon=icon("pencil", lib="glyphicon")),
|
||||
menuItem("Wizard", tabName="wizard", icon=icon("chart-column", lib="font-awesome")),
|
||||
menuItem("Documentation", tabName="documentation", icon=icon("chart-area", lib="font-awesome"))
|
||||
menuItem("Wizard", tabName="wizard", icon=icon("chart-column", lib="font-awesome"))#,
|
||||
#menuItem("Documentation", tabName="documentation", icon=icon("chart-area", lib="font-awesome"))
|
||||
),
|
||||
tags$footer(HTML(paste(tags$strong(tags$u("InnerAnalytics")), paste(rep(" ",9), collapse=""),
|
||||
"Developer:", paste(rep(" ",9), collapse=""),
|
||||
@@ -64,9 +64,9 @@ ui <- dashboardPage(
|
||||
tabItem(tabName = "Dataupload", uiOutput("Dataupload")),
|
||||
tabItem(tabName = "fourPL", uiOutput("fourPL")),
|
||||
#tabItem(tabName = "XLdiagn", uiOutput("XLdiagn")),
|
||||
tabItem(tabName = "pla", uiOutput("pla")),
|
||||
tabItem(tabName = "wizard", uiOutput("wizard")),
|
||||
tabItem(tabName = "documentation", uiOutput("docu"))
|
||||
#tabItem(tabName = "pla", uiOutput("pla")),
|
||||
tabItem(tabName = "wizard", uiOutput("wizard"))#,
|
||||
#tabItem(tabName = "documentation", uiOutput("docu"))
|
||||
)
|
||||
|
||||
)
|
||||
@@ -82,11 +82,11 @@ server <- function(input, output, session) {
|
||||
#### renderUIs ----
|
||||
output$homePage <- renderUI({
|
||||
navbarPage("Home",
|
||||
tabPanel("Introduction",
|
||||
tabPanel("Limit setting",
|
||||
tags$img(src="logo.png", class="adv_logo"),
|
||||
h4("Introduction to the bioassay software"),
|
||||
tags$mark("linear regression"), br(),
|
||||
column(4,
|
||||
column(3,
|
||||
tags$table(id="dose-table",
|
||||
numericInput("lEACdiffla","lower EAC for diff. of LA", -0.175, step=0.001),
|
||||
numericInput("uEACdiffla","upper EAC for diff. of LA", 0.189, step=0.001),
|
||||
@@ -153,7 +153,9 @@ server <- function(input, output, session) {
|
||||
"F-test on slope A"= "5", "F-test on slope B"="6",
|
||||
"F-test on non-parallelism"= "7", "F-test on preparation"="8"),
|
||||
selected= c("1","2","3","4","5","6","7","8"))
|
||||
)
|
||||
),
|
||||
column(4,
|
||||
plotOutput("plotSing", width="400px", height="300px"))
|
||||
|
||||
),
|
||||
tabPanel("4pl-Analysis",
|
||||
@@ -514,7 +516,7 @@ server <- function(input, output, session) {
|
||||
)))
|
||||
})
|
||||
|
||||
|
||||
#output$sessioninfo <- renderPrint(sessioninfo())
|
||||
|
||||
v <- reactiveValues(num_dose=0, next.dose.t=0)
|
||||
|
||||
@@ -629,7 +631,43 @@ server <- function(input, output, session) {
|
||||
#### XLSX eval ----
|
||||
if (CORro<0) SLOPE <- -1 else SLOPE <- 1
|
||||
FITs <- Fitting_FUNC(XLdat2, TransFlag = FALSE)
|
||||
|
||||
|
||||
#### if no 4pl fit is possible ----
|
||||
if (!is.null(FITs)) {
|
||||
if (is.character(FITs)) {
|
||||
|
||||
Dat$FITsFlag <- TRUE
|
||||
|
||||
pSing <- plotSingularity(XLdat2)
|
||||
|
||||
output$plotSing <- renderPlot({
|
||||
pSing
|
||||
})
|
||||
|
||||
output$XLplot <- renderPlot({
|
||||
|
||||
REP$XLplotSing <- pSing
|
||||
|
||||
pSing
|
||||
})
|
||||
|
||||
output$relpotTestTab <- renderTable({ NULL })
|
||||
output$relpotTestPlot<- renderPlot({ NULL })
|
||||
|
||||
output$AIC <- renderTable({ NULL })
|
||||
output$VarDiagn <- renderTable({ NULL })
|
||||
|
||||
output$pottab4plXL <- renderDT({ NULL })
|
||||
output$diagnplot <- renderPlot({ NULL })
|
||||
output$EQtests <- renderDT({ NULL })
|
||||
#
|
||||
output$pottab4plTransXL <- renderDT({ NULL })
|
||||
output$ANOVAXLS <- renderTable({ NULL })
|
||||
#)
|
||||
|
||||
return(NULL)
|
||||
}
|
||||
}
|
||||
|
||||
Smr <- FITs[[1]] # summary(mr)
|
||||
Smu <- FITs[[2]] # summary(mu)
|
||||
@@ -767,7 +805,7 @@ server <- function(input, output, session) {
|
||||
colnames(logpotUest) <- c("estimate", "lowerCI", "upperCI")
|
||||
#browser()
|
||||
cnXL <- colnames(XLdat2)
|
||||
Filesample <- data.frame(Test = c("FFILE NAME:", "SAMPLES"), Test2=c(Dat$FileName, paste(cnXL[1], " vs ", cnXL[4])))
|
||||
Filesample <- data.frame(Test = c("FILE NAME:", "SAMPLES"), Test2=c(Dat$FileName, paste(cnXL[1], " vs ", cnXL[4])))
|
||||
colnames(Filesample) <- c("", "")
|
||||
output$Filesampl <- renderTable({ Filesample }, rownames = F)
|
||||
|
||||
@@ -932,83 +970,7 @@ server <- function(input, output, session) {
|
||||
}
|
||||
})
|
||||
|
||||
#### updateSlider on XLSX ----
|
||||
# observe({
|
||||
# if (!is.null(Dat$potDiffXL)) {
|
||||
# updateSliderInput(session, "potencydiff",
|
||||
# value=round(as.numeric(Dat$potDiffXL[[1]]),5))
|
||||
# }
|
||||
# })
|
||||
# observeEvent(input$potencydiff, {
|
||||
# if (!is.null(Dat$potDiffXL)) {
|
||||
# updateSliderInput(session, "potencydiff",
|
||||
# value=round(as.numeric(input$potencydiff),5))
|
||||
# }
|
||||
# })
|
||||
# observe({
|
||||
# if (!is.null(Dat$ProzSD_XL)) {
|
||||
# updateSliderInput(session, "sdfac",
|
||||
# value=round(as.numeric(Dat$ProzSD_XL[[1]]),5))
|
||||
# }
|
||||
# })
|
||||
# observeEvent(input$sdfac, {
|
||||
# if (!is.null(Dat$ProzSD_XL)) {
|
||||
# updateSliderInput(session, "sdfac",
|
||||
# value=round(as.numeric(Dat$ProzSD_XL[[1]]),5))
|
||||
# }
|
||||
# })
|
||||
|
||||
#### updaterNumeric Input ----
|
||||
# observe({
|
||||
# if(!is.null(Dat$coeffs_UN)) {
|
||||
# updateNumericInput(session, "lowAsymptREF",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[3]),5), min=0)
|
||||
# updateNumericInput(session, "lowAsymptTEST",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[4]),5), min=0)
|
||||
# updateNumericInput(session, "uppAsymptREF",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[5]),5), min=0)
|
||||
# updateNumericInput(session, "uppAsymptTEST",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[6]),5), min=0)
|
||||
# updateNumericInput(session, "slopeREF",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[1]),5))
|
||||
# updateNumericInput(session, "slopeTEST",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[2]),5))
|
||||
# updateNumericInput(session, "EC50",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[7]),5))
|
||||
# updateNumericInput(session, "potDiff",
|
||||
# value=round(as.numeric(Dat$coeffs_UN[7])- as.numeric(Dat$coeffs_UN[8]),5))
|
||||
# }
|
||||
# })
|
||||
#
|
||||
# observe({
|
||||
# if(!is.null(Dat$dilution)) {
|
||||
# updateNumericInput(session, "CONC1",
|
||||
# value=as.numeric(Dat$dilution[1]))
|
||||
# updateNumericInput(session, "CONC2",
|
||||
# value=as.numeric(Dat$dilution[2]))
|
||||
# updateNumericInput(session, "CONC3",
|
||||
# value=as.numeric(Dat$dilution[3]))
|
||||
# updateNumericInput(session, "CONC4",
|
||||
# value=as.numeric(Dat$dilution[4]))
|
||||
# updateNumericInput(session, "CONC5",
|
||||
# value=as.numeric(Dat$dilution[5]))
|
||||
# updateNumericInput(session, "CONC6",
|
||||
# value=as.numeric(Dat$dilution[6]))
|
||||
# updateNumericInput(session, "CONC7",
|
||||
# value=as.numeric(Dat$dilution[7]))
|
||||
# updateNumericInput(session, "CONC8",
|
||||
# value=as.numeric(Dat$dilution[8]))
|
||||
# updateNumericInput(session, "CONC9",
|
||||
# value=as.numeric(Dat$dilution[9]))
|
||||
# updateNumericInput(session, "CONC10",
|
||||
# value=as.numeric(Dat$dilution[10]))
|
||||
# updateNumericInput(session, "CONC11",
|
||||
# value=as.numeric(Dat$dilution[11]))
|
||||
# updateNumericInput(session, "CONC12",
|
||||
# value=as.numeric(Dat$dilution[12]))
|
||||
#
|
||||
# }
|
||||
# })
|
||||
|
||||
|
||||
observe({
|
||||
if(!is.null(Dat$MetaConc)) {
|
||||
@@ -1161,10 +1123,12 @@ server <- function(input, output, session) {
|
||||
|
||||
}) # observe
|
||||
|
||||
#### Testergebnisse für XLSX ----
|
||||
#### Testergebnisse 4PL für XLSX ----
|
||||
observe({
|
||||
if (is.null(Dat$EXCEL)) return(NULL)
|
||||
if (is.null(input$PureErr)) return(NULL)
|
||||
if (!is.null(Dat$FITsFlag)) return(NULL)
|
||||
|
||||
#observeEvent(input$StartCalc,{
|
||||
PureErrFlag <- input$PureErr
|
||||
warning_text3 <- reactive({
|
||||
@@ -1691,6 +1655,7 @@ server <- function(input, output, session) {
|
||||
observe({
|
||||
#browser()
|
||||
if (is.null(Dat$EXCEL)) return(NULL)
|
||||
if (!is.null(Dat$FITsFlag)) return(NULL)
|
||||
ro_new <- Dat$EXCEL
|
||||
|
||||
noDilSer <- Dat$noDilSeriesXL
|
||||
|
||||
Reference in New Issue
Block a user