Using a model in R shiny, trying to vary one parameter and check how the output changes

Question

I am trying to output a table with a select few percentile outcomes based on changing one parameter in Shiny. When I run the app, I get the same model output every time (look at the predicted_stress column). Here is a screen shot of what I am talking about:

shiny app

Attached below is my code

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)

I think that you need to use reactive objects. Here is some info: https://shiny.rstudio.com/tutorial/written-tutorial/lesson6/ — bstrain, Mar 02 '20 at 22:57
I wonder about your `mod = ifelse...` - if you intend to have a vector of length 1000 to be returned (instead of a single number) then this needs to be changed. See this [question/answer](https://stackoverflow.com/questions/1335830/why-cant-rs-ifelse-statements-return-vectors). You could do `ifelse(age >35 && age <= 45) mod <- mod * .9...` That might explain why you see same number for all percentiles... — Ben, Mar 02 '20 at 23:09
Or better yet just split up `if` and `else` instead of vectorized `ifelse` since you don't need to use that in this case. — Ben, Mar 03 '20 at 03:00

StupidWolf · Answer 1 · 2020-03-02T23:08:19.027

0

Use eventReactive, because you need to pass it to output. See example below, I do not have glm.fit so I replaced the stress with some random numbers from 0 to 1. Ideally you should return also the Age in your table as a sanity check. And you don't need to add rows 4 times. Just make a data.frame with the quantile values from the start.

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()

    })
}

edited Mar 02 '20 at 23:08

answered Mar 02 '20 at 23:02

StupidWolf

45,075
17
40
72

The predicted stress value is still the same for each percentile, which should not be the case – Carmen Ciardiello Mar 11 '20 at 20:27
hey the value changes on mine. without the fit we can reproduce anything right – StupidWolf Mar 11 '20 at 20:59
Where in the app should I put the construction of the mode? Outside the ui and server? Inside one of them? – Carmen Ciardiello Mar 11 '20 at 21:45
in this case, I guess the server? I normally have them in one script – StupidWolf Mar 11 '20 at 21:46
I have the server and ui in one script. I was just wondering in which part I should put it in. Right now I have the model fit on the outside – Carmen Ciardiello Mar 11 '20 at 21:49

Using a model in R shiny, trying to vary one parameter and check how the output changes

1 Answers1