How to store model coefficients to variables to be used in a concentration function?

Hello brilliant helpers,

I am trying to make a shiny app that calculations concentrations based on a 5 PL curve using the drc package by running a dose response model (drm) and storing the model parameter coefficients to variables which is then used in an equation to calculate concentration.

My problem is that I'm having trouble storing the model coefficients from the user input to a variable and then using a function to pass the variables through to get my concentrations.

That's kind of a lot to digest, so maybe let me show you what the original R code looks like:

#Sample data
dt <- structure(list(Sample = c("Std 0", "Std 0", "Std 1", "Std 1", 
"Std 2", "Std 2", "Std 3", "Std 3", "Std 4", "Std 4", "Std 5", 
"Std 5", "Cntrl", "Cntrl", "LRB", "LRB", "SMP_01", "SMP_01", 
"SMP_02", "SMP_02", "SMP_03", "SMP_03", "SMP_04", "SMP_04", "SMP_05", 
"SMP_05", "SMP_06", "SMP_06", "SMP_07", "SMP_07"), Absorbance = c(0.854, 
0.876, 0.736, 0.736, 0.551, 0.569, 0.46, 0.414, 0.312, 0.307, 
0.229, 0.22, 0.452, 0.464, 0.526, 0.593, 0.925, 0.865, 0.88, 
0.855, 0.871, 0.909, 0.718, 0.719, 0.377, 0.352, 0.243, 0.236, 
0, 0), Concentration = c(0, 0, 0.05, 0.05, 0.15, 0.15, 0.4, 0.4, 
1.5, 1.5, 5, 5, 0.75, 0.75, NA, NA, NA, NA, NA, NA, NA, NA, NA, 
NA, NA, NA, NA, NA, NA, NA)), row.names = c(NA, 30L), class = "data.frame")

# Load libraries
library(dplyr)
library(drc)

#Remove rows that contain 0 data for absorbance (wells that weren't run)
dta <- dt[!(dt$Absorbance==0),]
#Calculate mean absorbance 
data <- dta %>%
  group_by(Sample) %>%
  mutate(Mean_Absorbance = mean(Absorbance)) %>%
  distinct(Sample, .keep_all = T) %>%
  dplyr::select(Sample, Mean_Absorbance, Concentration)

#create a dataframe only of standards and their values
standards <- data[1:6,]

#fit 5PL model
fiveplc <- drm(Mean_Absorbance~Concentration, data=standards,
               fct = LL.5(names=c("b", "d", "a", "c", "e")))

sum.fiveplc <- summary(fiveplc)

#View estimated parameters
sum.fiveplc

# Save coefficient values to use as parameters in logistic equation
b <- sum.fiveplc$coefficients[1]
d <- sum.fiveplc$coefficients[2]
a <- sum.fiveplc$coefficients[3]
c <- sum.fiveplc$coefficients[4]
e <- sum.fiveplc$coefficients[5]

# Reaarange the formula to solve for x

concentration <- function(y){
  c*(((a-d)/(y-d))^(1/e)-1)^(1/b)
}

# Calculate uknown concentrations using above function
data$New_Concentration <- concentration(data$Mean_Absorbance)

# Print results
data

Okay, now that you have the original R code, here is where I'm stuck in my app.

library(shiny)
library(drc)

concentration <- function(y){
  c*(((a-d)/(y-d))^(1/m)-1)^(1/b)
}

ui <- fluidPage(
  titlePanel("Microcystin Concentrations from ELISA using 5 PL Curve"),
  fluidRow(
    h4("Upload Data"),
    column(6,
           fileInput("file", "Choose CSV File",
                     multiple = F,
                     accept = c("text/csv",
                                "text/comma-separated-values,text/plain",
                                ".csv"),
                     placeholder = "CSV files only",
                     width = "100%"))),
  fluidRow(
    h4("Preview Data"),
    column(6,
           numericInput("n", "Rows to Preview", value = 5, min=1, step = 1))),
  
  fluidRow(
    column(6,
           tableOutput("contents"))),
  
  fluidRow(
    column(6,
           actionButton("show", "Show/Hide Model Summary Statistics"),
           hidden(
             div(id="model_div",
                 verbatimTextOutput("model")))),
  
  fluidRow(
    column(6,
           actionButton("showplot", "Show/Hide 5 PLC Curve"),
           hidden(
             div(id="plot_div",
                 plotOutput("plcplot"))))),
  
  fluidRow(
    h4("Results"),
    column(6,
           tableOutput("results"))
  )
  )
)


server <- function(input, output, session) {
  
  data <- reactive({
    req(input$file)
    read.csv(input$file$datapath)
  })
  
  dt <- reactive({
    data() %>%
    filter(!Absorbance == 0) %>%
    group_by(Sample) %>%
    mutate(Mean_Absorbance = mean(Absorbance)) %>%
    distinct(Sample, .keep_all = T) %>%
    dplyr::select(Type, Sample, Mean_Absorbance, Concentration)})
  
  
  stds <- reactive({dt() %>%
      filter(Type == "Standard")})
  
  fiveplc <- reactive({drm(Mean_Absorbance ~ Concentration, data=stds(),
                 fct = LL.5(names = c("b", "d", "a", "c", "e")))})
  
  sum.fiveplc <- reactive({summary(fiveplc())})
  
  
  output$contents <- renderTable({
    
    head(dt(), input$n)
  })
  
  observeEvent(input$show, {
    toggle("model_div")
    output$model <- renderPrint({sum.fiveplc()
  })})
  
  observeEvent(input$showplot, {
    toggle("plot_div")
    output$plcplot <- renderPlot({
      plot(fiveplc(),
           xlab="Concentration (ppb)",
           ylab="Absorbance")
  })})
  
  
  output$results <- renderTable({ #this is where I am stuck, how do I store the model coefficients
# reactively so that I may use them in my concentration function?
    
    b <- sum.fiveplc()$coefficients[1]
    d <- sum.fiveplc()$coefficients[2]
    a <- sum.fiveplc()$coefficients[3]
    c <- sum.fiveplc()$coefficients[4]
    m <- sum.fiveplc()$coefficients[5]
    
    dt()$New_Concentration <- concentration(dt()$Mean_Absorbance)
    
    dt()
  })

}

shinyApp(ui, server)

Thank you SO much for any help you can provide!! If you store the sample in a .csv file, you will be able to play around in the app!

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.