在R中使用模型,尝试改变一个参数并检查输出如何变化

在R中使用模型,尝试改变一个参数并检查输出如何变化,r,shiny,R,Shiny,我正在尝试输出一个表,其中包含基于在Shining中更改一个参数而选择的几个百分位数结果。当我运行应用程序时,每次查看预测的应力列时,我都会得到相同的模型输出。下面是我所说内容的屏幕截图: 下面是我的代码 ui=fluidPage( numericInput(inputId="Age", label="Enter Age", value=0,min=0, max=100000), numericInput(inputId="ImplantSize", la

我正在尝试输出一个表,其中包含基于在Shining中更改一个参数而选择的几个百分位数结果。当我运行应用程序时,每次查看预测的应力列时,我都会得到相同的模型输出。下面是我所说内容的屏幕截图:

下面是我的代码

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)

使用EventResponsive,因为您需要将其传递给输出。请参见下面的示例,我没有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()

    })
}

我认为您需要使用反应对象。这里有一些信息:我想知道你的mod=ifelse…-如果您希望返回长度为1000的向量,而不是单个数字,则需要对此进行更改。看这个。您可以执行ifelseage>35&&age或更好的操作,但只需拆分if和else而不是向量化的ifelse,因为在这种情况下您不需要使用它。就是这样!感谢您的帮助,每个百分位的预测应力值仍然相同,这不应该是我的情况,因为我的值会发生变化。如果没有拟合,我们可以复制任何正确的东西,我应该在应用程序中放置模式的构造?在ui和服务器之外?在其中一个里面?在这种情况下,我猜是服务器?我通常将它们放在一个脚本中我将服务器和ui放在一个脚本中。我只是想知道我应该把它放在哪一部分。现在我把模型放在外面了