DNBuilder Shinyapps：更改术语标签

问题描述 投票：0回答：1

我正在使用 DynNom::DNbuilder R 包通过对数回归构建一个闪亮的应用程序。我获得了 ui.R、server.R 和 global.R 代码，并且该应用程序可以运行。但是，我正在尝试更改滑块和标签的格式，但我无法做到这一点。

这是我的模型和我希望应用程序显示的标签：

data <- data.frame(
   x = c(0,1,0),
   y = c(3,6,2),
   z = c(1.3, 2.8, 3.1),
   w = c(1,0,0)
)

model <- lrm(x ~ y + z + w,   data = data)

modellabels <- c("ylabel", "zlabel", "wlabel")

这是 DNbuilder 代码：

model <- lrm(x ~ y + z + w, data =data
DNbuilder(model, data = data, clevel = 0.95, m.summary = c("raw"), covariate = c("numeric"))

这是我运行 DNbuilder 后得到的结果：

**ui.R**

ui = bootstrapPage(fluidPage(
  titlePanel('app'),
  
  
    sidebarLayout(sidebarPanel(uiOutput('manySliders'),
                               uiOutput('setlimits'),
                               actionButton('add', 'Predict'),
                               br(), br(),
                               helpText('Press Quit to exit the application'),
                               actionButton('quit', 'Quit')
    ),
    mainPanel(tabsetPanel(id = 'tabs',
                          tabPanel('Graphical Summary', plotlyOutput('plot')),
                          tabPanel('Numerical Summary', verbatimTextOutput('data.pred')),
                          tabPanel('Model Summary', verbatimTextOutput('summary'))
    )
    )
    )))




----------
**server.R**

server = function(input, output){
observe({if (input$quit == 1)
          stopApp()})

limits <- reactive({ if (input$limits) { limits <- c(input$lxlim, input$uxlim) } else {
                         limits <- limits0 } })

output$manySliders <- renderUI({
  slide.bars <- list()
               for (j in 1:length(preds)){
               if (terms[j+1] == "factor"){
               slide.bars[[j]] <- list(selectInput(paste("pred", j, sep = ""), names(preds)[j], preds[[j]]$v.levels, multiple = FALSE))
               }
               if (terms[j+1] == "numeric"){
               if (covariate == "slider") {
               slide.bars[[j]] <- list(sliderInput(paste("pred", j, sep = ""), names(preds)[j],
               min = preds[[j]]$v.min, max = preds[[j]]$v.max, value = preds[[j]]$v.mean))
               }
               if (covariate == "numeric") {
               slide.bars[[j]] <- list(numericInput(paste("pred", j, sep = ""), names(preds)[j], value = zapsmall(preds[[j]]$v.mean, digits = 4)))
               }}}
               do.call(tagList, slide.bars)
})

output$setlimits <- renderUI({
        if (is.null(DNlimits)){
               setlim <- list(checkboxInput("limits", "Set x-axis ranges"),
               conditionalPanel(condition = "input.limits == true",
               numericInput("uxlim", "x-axis upper", zapsmall(limits0[2], digits = 2)),
               numericInput("lxlim", "x-axis lower", zapsmall(limits0[1], digits = 2))))
        } else{ setlim <- NULL }
        setlim
})

a <- 0
new.d <- reactive({
               input$add
               input.v <- vector("list", length(preds))
               for (i in 1:length(preds)) {
               input.v[[i]] <- isolate({
               input[[paste("pred", i, sep = "")]]
               })
               names(input.v)[i] <- names(preds)[i]
               }
               out <- data.frame(lapply(input.v, cbind))
               if (a == 0) {
               input.data <<- rbind(input.data, out)
               }
               if (a > 0) {
               if (!isTRUE(compare(old.d, out))) {
               input.data <<- rbind(input.data, out)
               }}
               a <<- a + 1
               out
})

p1 <- NULL
old.d <- NULL
data2 <- reactive({
               if (input$add == 0)
               return(NULL)
               if (input$add > 0) {
               if (!isTRUE(compare(old.d, new.d()))) {
               isolate({
               mpred <- getpred.DN(model, new.d(), set.rms=T)$pred
               se.pred <- getpred.DN(model, new.d(), set.rms=T)$SEpred
               if (is.na(se.pred)) {
               lwb <- "No standard errors"
               upb <- "by 'lrm'"
               pred <- mlinkF(mpred)
               d.p <- data.frame(Prediction = zapsmall(pred, digits = 3),
               Lower.bound = lwb, Upper.bound = upb)
               } else {
               lwb <- sort(mlinkF(mpred + cbind(1, -1) * (qnorm(1 - (1 - clevel)/2) * se.pred)))[1]
               upb <- sort(mlinkF(mpred + cbind(1, -1) * (qnorm(1 - (1 - clevel)/2) * se.pred)))[2]
               pred <- mlinkF(mpred)
               d.p <- data.frame(Prediction = zapsmall(pred, digits = 3),
               Lower.bound = zapsmall(lwb, digits = 3),
               Upper.bound = zapsmall(upb, digits = 3))
               }
               old.d <<- new.d()
               data.p <- cbind(d.p, counter = 1, count=0)
               p1 <<- rbind(p1, data.p)
               p1$counter <- seq(1, dim(p1)[1])
               p1$count <- 0:(dim(p1)[1]-1) %% 11 + 1
               p1
               })
               } else {
               p1$count <- seq(1, dim(p1)[1])
               }}
               rownames(p1) <- c()
               p1
})

output$plot <- renderPlotly({
  if (input$add == 0)
               return(NULL)
               if (is.null(new.d()))
               return(NULL)
               coll=c("#0E0000", "#0066CC", "#E41A1C", "#54A552", "#FF8000", "#BA55D3",
               "#006400", "#994C00", "#F781BF", "#00BFFF", "#A9A9A9")
               lim <- limits()
               yli <- c(0 - 0.5, 10 + 0.5)
               dat2 <- data2()
               if (dim(data2())[1] > 11){
               input.data = input.data[-c(1:(dim(input.data)[1]-11)),]
               dat2 <- data2()[-c(1:(dim(data2())[1]-11)),]
               yli <- c(dim(data2())[1] - 11.5, dim(data2())[1] - 0.5)
               }
               in.d <- input.data
               xx <- matrix(paste(names(in.d), ": ", t(in.d), sep = ""), ncol = dim(in.d)[1])
               Covariates <- apply(xx, 2, paste, collapse = "<br />")
               p <- ggplot(data = dat2, aes(x = Prediction, y = counter - 1, text = Covariates,
               label = Prediction, label2 = Lower.bound, label3=Upper.bound)) +
               geom_point(size = 2, colour = coll[dat2$count], shape = 15) +
               ylim(yli[1], yli[2]) + coord_cartesian(xlim = lim) +
               labs(title = "95% Confidence Interval for Response",
               x = "Probability", y = "") + theme_bw() +
               theme(axis.text.y = element_blank(), text = element_text(face = "bold", size = 10))
               if (is.numeric(dat2$Upper.bound)){
               p <- p + geom_errorbarh(xmax = dat2$Upper.bound, xmin = dat2$Lower.bound,
               size = 1.45, height = 0.4, colour = coll[dat2$count])
               } else{
               message("Confidence interval is not available as there is no standard errors available by 'lrm' ")
               }
               gp <- ggplotly(p, tooltip = c("text", "label", "label2", "label3"))
               gp$elementId <- NULL
               gp
})

output$data.pred <- renderPrint({
  if (input$add > 0) {
               if (nrow(data2()) > 0) {
               if (dim(input.data)[2] == 1) {
               in.d <- data.frame(input.data)
               names(in.d) <- names(terms)[2]
               data.p <- cbind(in.d, data2()[1:3])
               }
               if (dim(input.data)[2] > 1) {
               data.p <- cbind(input.data, data2()[1:3])
               }}
               stargazer(data.p, summary = FALSE, type = "text")
}
})

output$summary <- renderPrint({
print(model)
})
}


----------
**global.R**

library(ggplot2)
library(shiny)
library(plotly)
library(stargazer)
library(compare)
library(prediction)
library(rms)


load('data.RData')
source('functions.R')
t.dist <- datadist(data)
options(datadist = 't.dist')
m.summary <- 'raw'
covariate <- 'numeric'
clevel <- 0.95
r shiny
1个回答
0
投票

我不太确定你指的是哪种类型的闪亮小部件（或标签），但我有一些评论。

首先，您需要确保正确定义变量的类（例如因子、数字等），例如，在拟合模型之前添加以下代码：

> data$y <- as.factor(data$y)

这对于因子尤其重要，因此它可以得到因子水平。对于数值变量，您可以获得闪亮的滑块（默认情况下）或数字输入（使用 covariate = c("numeric")）。

小部件的标签与变量名称相同。因此，调整它们的最简单方法是在拟合模型之前根据需要更改变量名称：

> names(data)
[1] "x" "y" "z"
> names(data)[2] <- 'ylabel'
> names(data)
[1] "x" "ylabel" "z"
> model <- lrm(x ~ ylabel + z, data = data)

或者，可以通过调整“data.RData”中的“preds”对象来更改标签。例如，您可以使用以下代码来更改标签：

> names(preds)
[1] "y" "z"         
> names(preds)[1] <- 'labelled y'
> names(preds)
[1] "labelled y" "z"         
> save.image(file = "data.RData")
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.