Используя модель в R блестящий, пытаясь изменить один параметр и проверить, как изменяется выходной

Question

Я пытаюсь вывести таблицу с несколькими результатами в процентилях на основе изменения одного параметра в Shiny. Когда я запускаю приложение, я получаю один и тот же вывод модели каждый раз (посмотрите на столбец предсказанный_стресс). Вот снимок экрана, о котором я говорю:

Ниже приведен мой код

ui=fluidPage(
  numericInput(inputId="Age", label="Enter Age", 
               value=0,min=0, max=100000),
  numericInput(inputId="ImplantSize", label="Enter Implant Diameter Size (mm)", 
               value=0,min=0, max=20),
  numericInput(inputId="BiteForce", label="Enter Bite Force (N)", 
               value=0,min=0, max=100000),
  numericInput(inputId="CorticalBoneThickness", label="Enter Cortical Bone Thickness (mm)", 
               value=0,min=0, max=100000),


  actionButton("Enter", "Enter Values"),
  DT::dataTableOutput("failure")
)

server = function(input,output, session){
  observeEvent( input$Enter, {
    # set age as one value
    age = input$Age
    # make the modulus a normally distributed numerical vector
    # use the mean as the average of the max and min measured in most recent study on bookmarked page
    # choice of standard deivation is based on the different between the max and min values being 
    # 27.7 GPa. In a normal distribution, 99.99966% of the samples are within 3 standard deviations of the mean
    # If the range is 27.7 GPa, divide that by 6 to get an approximation of the standard deviation in a 
    # normally distributed sample of patients
    mod = rnorm(1000, mean = 32.25e9, sd = 4.62e9)
    # age adjust the modulus values based on losing 10% each decade after 35
    mod = ifelse(age <= 35, mod, ifelse(age <= 45, mod*.9, ifelse(age <= 55, mod*.8, mod*.7)))
    # set diameter as one value
    d = as.factor(ifelse(input$ImplantSize < 4.4, 'Small', 'Large'))
    # set force as one value
    bite = input$BiteForce
    # set cortical bone thickness as one value
    cb = input$CorticalBoneThickness
    # make the first row of the dataframe with 50th percentile outcome
    t <- tibble(force = bite, modulus = quantile(mod, probs = .5), diameter = d, cortical_bone = cb, 
                percentile = 50)
    # add the rest of the rows with 5th, 25th, 75th, and 95th percentile outcomes
    t <- add_row(t, force = bite, modulus = quantile(mod, probs = .05), 
            diameter = d, cortical_bone = cb, percentile = 5)
    t <- add_row(t, force = bite, modulus = quantile(mod, probs = .25), 
            diameter = d, cortical_bone = cb, percentile = 25)
    t <- add_row(t, force = bite, modulus = quantile(mod, probs = .75), 
            diameter = d, cortical_bone = cb, percentile = 75)
    t <- add_row(t, force = bite, modulus = quantile(mod, probs = .95), 
            diameter = d, cortical_bone = cb, percentile = 95)
    # apply the model to the dataframe
    t$x_stress <- predict.glm(glm.fit, t, type = 'response')
    t <- t %>% 
      mutate(failure = ifelse(x_stress > 114e6, 'Will Fail', 'Immediate Loading Feasible'), 
             x_stress = round(x_stress, digits = 0)) %>% 
      select(percentile, x_stress, failure) %>% 
      rename(predicted_stress = x_stress) %>% 
      arrange(percentile)

    # try to figure out a way to make one long string where all of the values are written out and can be printed
    # do something like "in the 50th percentile outcome, the stress will be x and immediate loading will fail" 
    # and so on and so forth

    output$failure <- DT::renderDataTable({
     t

    })
  })
}
shinyApp(ui=ui, server=server)

Answer 1

Используйте eventReactive, потому что вам нужно передать его на выход. Смотрите пример ниже, у меня нет glm.fit, поэтому я заменил ударение на несколько случайных чисел от 0 до 1. В идеале вы должны также указать возраст в вашей таблице в качестве проверки работоспособности. И вам не нужно добавлять строки 4 раза. Просто создайте data.frame со значениями квантилей с самого начала.

server = function(input,output, session){
  tab = eventReactive( input$Enter, {

    age = input$Age
    mod = rnorm(1000, mean = 32.25e9, sd = 4.62e9)
    mod = ifelse(age <= 35, mod, ifelse(age <= 45, mod*.9, ifelse(age <= 55, mod*.8, mod*.7)))
    d = as.factor(ifelse(input$ImplantSize < 4.4, 'Small', 'Large'))
    bite = input$BiteForce
    cb = input$CorticalBoneThickness
    P = c(.05,.25,.5,.75,.95)
    t <- data.frame(force = bite, modulus = quantile(mod, probs = P),
    diameter = d, cortical_bone = cb,percentile = P*100)
    t$x_stress <- runif(nrow(t))
    t <- t %>%
      mutate(failure = ifelse(x_stress > 114e6, 'Will Fail', 'Immediate Loading Feasible'),
             x_stress = round(x_stress, digits = 0)) %>%
      select(percentile, x_stress, failure) %>%
      rename(predicted_stress = x_stress) %>%
      arrange(percentile)
   return(t)
})

    output$failure <- DT::renderDataTable({
      tab()

    })
}