Shiny app produces error: "arguments imply differing number of rows: 0, 1"
Shiny app produces error: "arguments imply differing number of rows: 0, 1"
我正在尝试创建一个 R Shiny 应用程序，它使用岭回归计算分数，然后将其用于随机森林模型。我将两个模型都保存为 RDS，并将它们保存在 app.R 所在的同一文件夹中。
然后我读了预测概率的模型和数据，定义了一些函数：
# Reading data
phats <- read.csv("Predicted_probabilities_training.csv")
phats_graph <- phats %>% mutate(`PTD Event Status` = ifelse(Observed_Event=="PTD", "PTD Event", "No PTD Event"))
phats_event <- phats[phats$Observed_Event=="PTD",]
phats_nonevent <- phats[phats$Observed_Event=="No_PTD",]
# load the models
ridge_model <- readRDS("ridge_model.rds")
final_model <- readRDS("final_model.rds")
# Defining some functions
matrix.for.ILS.function <- function(input){
return(data.matrix(data.frame(input$MIP_1a,
input$MIP_3a,
input$RANTES,
input$sIL_6R,
input$ITAC,
input$IL_21,
input$Fractalkine,
input$TNF_a,
input$IL_1b,
input$IL_7,
input$IL_10,
input$GM_CSF,
input$MIP_1b)))
}
ILS.function <- function(input){
ILS.ridge = as.numeric(predict(ridge_model, matrix.for.ILS.function(input), s = 0.7414409, type="link"))
return(ILS.ridge)
}
test.data.function <- function(input){
test.data = data.frame(Age=input$Age,
Gender=input$Gender,
GCS_Bestin24=input$GCS_Bestin24,
Premorbid_depression=input$Premorbid_depression,
Antidep_first6m=input$Antidep_first6m)
return(cbind(test.data, ILS.ridge=ILS.function(input)))
}
pred_prob_func <- function(input){
pred_prob = predict(final_model, test.data.function(input), type="prob")[,"PTD"]
classification <- ifelse(pred_prob >= input$thresholdslider, "PTD Event", "No Event")
return(list(pred_prob=pred_prob, classification=classification))
}
然后在编写 UI 和服务器代码后，我尝试生成一个图表，但它向我显示错误：“arguments imply different number of rows: 0, 1”。我测试过 pred_prob_func 会产生该错误。虽然当我试图通过为变量创建一个随机值列表来创建一个名为 input 的列表并尝试查看 pred_prob_func(input) 是否产生一个值时，它实际上产生了一个值。但是当我尝试 运行 应用程序时，图表没有显示并给我这个错误。我在服务器部分使用以下代码来生成图表。
output$int_plot <- renderPlotly({
phats_graph$`Total Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,1])
phats_graph$`PTD Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,2])
phats_graph$`No PTD Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,3])
int_plot <- ggplot(phats_graph, aes(ptd_per=`No PTD Percentile`)) + geom_density(aes(x=Phat, fill = `PTD Event Status`), alpha=0.5) +
geom_vline(xintercept = input$thresholdslider, linetype = 'dashed') +
geom_vline(xintercept = pred_prob_func(input)$pred_prob) +
xlab('Threshold Percentage') + ylab('Density') +
theme_minimal() + scale_fill_manual(values=c("#5D3A9B", "#E66100"), name="")
ggplotly(int_plot, tooltip=c("x", "ptd_per"))
})
我定义函数的方式有问题吗？
编辑：
所有文件（数据，RDS模型）和应用程序都可以在这个Google Drive中找到以供测试。
我已经使用以下示例输入测试了函数（当我将其用作函数中的参数时产生了结果，但当我尝试 运行 应用程序时显示此错误）：
input=list(Age=20, Gender=1, GCS_Bestin24=4, Premorbid_depression=0, Antidep_first6m=0,
MIP_1a=1,
MIP_3a=1,
RANTES=1,
sIL_6R=1,
ITAC=1,
IL_21=1,
Fractalkine=1,
TNF_a=1,
IL_1b=1,
IL_7=1,
IL_10=1,
GM_CSF=1,
MIP_1b=1,
thresholdslider=0.5)
发生原始错误是因为您要求的 input$id 与您在 textInput 中分配的 id 不同。
textInput("MIPa", label = HTML("MIP-1\(\alpha\)") ##used in ui
input$MIP_1a ##used in server.
我认为 shiny 使用 input 变量有问题。
通过将输入列表创建为 input_list 并将您自己调用 input 的位置更改为 input()，这似乎可行。
我还需要在创建 test.data.function() 函数后立即删除 test.data.function(input)，以便让应用程序达到 运行。
input_list <- reactive({
input_list <- list( Age=as.numeric(input$Age),
Gender=ifelse(input$Gender == "Female", 1, 0),
GCS_Bestin24=as.numeric(input$GCS_Bestin24),
Premorbid_depression=as.numeric(input$Premorbid_depression),
Antidep_first6m=as.numeric(input$Antidep_first6m),
MIP_1a = as.numeric(input$MIPa),
MIP_3a = as.numeric(input$MIP_3a),
RANTES = as.numeric(input$RANTES),
sIL_6R = as.numeric(input$sIL_6R),
ITAC = as.numeric(input$ITAC),
IL_21 = as.numeric(input$IL_21),
Fractalkine = as.numeric(input$Fractalkine),
TNF_a = as.numeric(input$TNF_a),
IL_1b = as.numeric(input$ILb),
IL_7 = as.numeric(input$IL_7),
IL_10 = as.numeric(input$IL0),
GM_CSF = as.numeric(input$GM_CSF),
MIP_1b = as.numeric(input$MIPb))
input_list
})
##input changed to input_list()
##this needs to be done for each instance where input is used on its own.
geom_vline(xintercept = pred_prob_func(input_list())$pred_prob)
要删除最后的错误消息，您需要将 renderPlotly() 更改为 renderUI() 并在 input_list.[=31= 中包含对 NA 值的检查]
plotlyOutput 也需要在 ui 部分更改为 uiOutput()。
ui <- fluidPage(
uiOutput('int_plot') #changed from plotlyOutput('int_plot')
)
server <- (
output$int_plot <- renderUI({
if(anyNA(input_list())){
helpText("Input User data")
}else{
phats_graph$`Total Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,1])
phats_graph$`PTD Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,2])
phats_graph$`No PTD Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,3])
int_plot <- ggplot(phats_graph, aes(ptd_per=`No PTD Percentile`)) + geom_density(aes(x=Phat, fill = `PTD Event Status`), alpha=0.5) +
geom_vline(xintercept = input$thresholdslider, linetype = 'dashed') +
geom_vline(xintercept = pred_prob_func(input_list())$pred_prob) +
xlab('Threshold Percentage') + ylab('Density') +
theme_minimal() + scale_fill_manual(values=c("#5D3A9B", "#E66100"), name="")
renderPlotly( ggplotly(int_plot, tooltip=c("x", "ptd_per")))
}
})
)
当年龄为 10 且所有值均为 1（不知道这些应该是什么）时，这是输出：
我正在尝试创建一个 R Shiny 应用程序，它使用岭回归计算分数，然后将其用于随机森林模型。我将两个模型都保存为 RDS，并将它们保存在 app.R 所在的同一文件夹中。
然后我读了预测概率的模型和数据，定义了一些函数：
# Reading data
phats <- read.csv("Predicted_probabilities_training.csv")
phats_graph <- phats %>% mutate(`PTD Event Status` = ifelse(Observed_Event=="PTD", "PTD Event", "No PTD Event"))
phats_event <- phats[phats$Observed_Event=="PTD",]
phats_nonevent <- phats[phats$Observed_Event=="No_PTD",]
# load the models
ridge_model <- readRDS("ridge_model.rds")
final_model <- readRDS("final_model.rds")
# Defining some functions
matrix.for.ILS.function <- function(input){
return(data.matrix(data.frame(input$MIP_1a,
input$MIP_3a,
input$RANTES,
input$sIL_6R,
input$ITAC,
input$IL_21,
input$Fractalkine,
input$TNF_a,
input$IL_1b,
input$IL_7,
input$IL_10,
input$GM_CSF,
input$MIP_1b)))
}
ILS.function <- function(input){
ILS.ridge = as.numeric(predict(ridge_model, matrix.for.ILS.function(input), s = 0.7414409, type="link"))
return(ILS.ridge)
}
test.data.function <- function(input){
test.data = data.frame(Age=input$Age,
Gender=input$Gender,
GCS_Bestin24=input$GCS_Bestin24,
Premorbid_depression=input$Premorbid_depression,
Antidep_first6m=input$Antidep_first6m)
return(cbind(test.data, ILS.ridge=ILS.function(input)))
}
pred_prob_func <- function(input){
pred_prob = predict(final_model, test.data.function(input), type="prob")[,"PTD"]
classification <- ifelse(pred_prob >= input$thresholdslider, "PTD Event", "No Event")
return(list(pred_prob=pred_prob, classification=classification))
}
然后在编写 UI 和服务器代码后，我尝试生成一个图表，但它向我显示错误：“arguments imply different number of rows: 0, 1”。我测试过 pred_prob_func 会产生该错误。虽然当我试图通过为变量创建一个随机值列表来创建一个名为 input 的列表并尝试查看 pred_prob_func(input) 是否产生一个值时，它实际上产生了一个值。但是当我尝试 运行 应用程序时，图表没有显示并给我这个错误。我在服务器部分使用以下代码来生成图表。
output$int_plot <- renderPlotly({
phats_graph$`Total Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,1])
phats_graph$`PTD Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,2])
phats_graph$`No PTD Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,3])
int_plot <- ggplot(phats_graph, aes(ptd_per=`No PTD Percentile`)) + geom_density(aes(x=Phat, fill = `PTD Event Status`), alpha=0.5) +
geom_vline(xintercept = input$thresholdslider, linetype = 'dashed') +
geom_vline(xintercept = pred_prob_func(input)$pred_prob) +
xlab('Threshold Percentage') + ylab('Density') +
theme_minimal() + scale_fill_manual(values=c("#5D3A9B", "#E66100"), name="")
ggplotly(int_plot, tooltip=c("x", "ptd_per"))
})
我定义函数的方式有问题吗？
编辑：
所有文件（数据，RDS模型）和应用程序都可以在这个Google Drive中找到以供测试。
我已经使用以下示例输入测试了函数（当我将其用作函数中的参数时产生了结果，但当我尝试 运行 应用程序时显示此错误）：
input=list(Age=20, Gender=1, GCS_Bestin24=4, Premorbid_depression=0, Antidep_first6m=0,
MIP_1a=1,
MIP_3a=1,
RANTES=1,
sIL_6R=1,
ITAC=1,
IL_21=1,
Fractalkine=1,
TNF_a=1,
IL_1b=1,
IL_7=1,
IL_10=1,
GM_CSF=1,
MIP_1b=1,
thresholdslider=0.5)
发生原始错误是因为您要求的 input$id 与您在 textInput 中分配的 id 不同。
textInput("MIPa", label = HTML("MIP-1\(\alpha\)") ##used in ui
input$MIP_1a ##used in server.
我认为 shiny 使用 input 变量有问题。
通过将输入列表创建为 input_list 并将您自己调用 input 的位置更改为 input()，这似乎可行。
我还需要在创建 test.data.function() 函数后立即删除 test.data.function(input)，以便让应用程序达到 运行。
input_list <- reactive({
input_list <- list( Age=as.numeric(input$Age),
Gender=ifelse(input$Gender == "Female", 1, 0),
GCS_Bestin24=as.numeric(input$GCS_Bestin24),
Premorbid_depression=as.numeric(input$Premorbid_depression),
Antidep_first6m=as.numeric(input$Antidep_first6m),
MIP_1a = as.numeric(input$MIPa),
MIP_3a = as.numeric(input$MIP_3a),
RANTES = as.numeric(input$RANTES),
sIL_6R = as.numeric(input$sIL_6R),
ITAC = as.numeric(input$ITAC),
IL_21 = as.numeric(input$IL_21),
Fractalkine = as.numeric(input$Fractalkine),
TNF_a = as.numeric(input$TNF_a),
IL_1b = as.numeric(input$ILb),
IL_7 = as.numeric(input$IL_7),
IL_10 = as.numeric(input$IL0),
GM_CSF = as.numeric(input$GM_CSF),
MIP_1b = as.numeric(input$MIPb))
input_list
})
##input changed to input_list()
##this needs to be done for each instance where input is used on its own.
geom_vline(xintercept = pred_prob_func(input_list())$pred_prob)
要删除最后的错误消息，您需要将 renderPlotly() 更改为 renderUI() 并在 input_list.[=31= 中包含对 NA 值的检查]
plotlyOutput 也需要在 ui 部分更改为 uiOutput()。
ui <- fluidPage(
uiOutput('int_plot') #changed from plotlyOutput('int_plot')
)
server <- (
output$int_plot <- renderUI({
if(anyNA(input_list())){
helpText("Input User data")
}else{
phats_graph$`Total Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,1])
phats_graph$`PTD Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,2])
phats_graph$`No PTD Percentile` <- unlist(t(sapply(phats_graph$Phat, function(x) quantile_fun(value=x)))[,3])
int_plot <- ggplot(phats_graph, aes(ptd_per=`No PTD Percentile`)) + geom_density(aes(x=Phat, fill = `PTD Event Status`), alpha=0.5) +
geom_vline(xintercept = input$thresholdslider, linetype = 'dashed') +
geom_vline(xintercept = pred_prob_func(input_list())$pred_prob) +
xlab('Threshold Percentage') + ylab('Density') +
theme_minimal() + scale_fill_manual(values=c("#5D3A9B", "#E66100"), name="")
renderPlotly( ggplotly(int_plot, tooltip=c("x", "ptd_per")))
}
})
)
当年龄为 10 且所有值均为 1（不知道这些应该是什么）时，这是输出：