基于设定的R^2阈值选择样条函数阶数
我正在开发一个闪亮的应用程序，其中我正在绘制散点图和样条曲线拟合函数，样条曲线函数的阶数可以通过一个值在2-12之间变化的滑块进行更改，如下所示：基于设定的R^2阈值选择样条函数阶数,r,ggplot2,shiny,plotly,R,Ggplot2,Shiny,Plotly,我正在开发一个闪亮的应用程序，其中我正在绘制散点图和样条曲线拟合函数，样条曲线函数的阶数可以通过一个值在2-12之间变化的滑块进行更改，如下所示： ui <- tabPanel(sidebarLayout( sidebarPanel(sliderInput('degree', 'Degree of the Polynomial:', min = 2, max = 12, value = 3, step = 1)),
ui <- tabPanel(sidebarLayout(
sidebarPanel(sliderInput('degree', 'Degree of the Polynomial:', min = 2, max = 12, value = 3, step = 1)),
mainPanel(plotlyOutput("plot"))))
ui如果没有一些示例数据，这很棘手，但是假设我们有以下数据集：
set.seed（1）
df4 x y
#> 1 1 -0.5264538
#> 2 2 0.3836433
#> 3 3 -0.5356286
#> 4 4 1.9952808
#> 5 5 0.8295078
#> 6 6 -0.2204684
#> 7 7 1.1874291
#> 8 8 1.5383247
#> 9 9 1.4757814
#> 10 10 0.6946116
绘制时，它如下所示：
plot(df)
所以它有轻微的上升趋势
如果我们想找到拟合r平方>0.8的样条线数，我们可以：
库（样条曲线）
我呼吁：
#>lm（公式=y~样条线：：bs（x，df=i），数据=df4）
#>
#>残差：
#> 1 2 3 4 5 6 7 8
#> 0.00008 -0.00216 0.01512 -0.04776 0.08208 -0.08208 0.04776 -0.01512
#> 9 10
#> 0.00216 -0.00008
#>
#>系数：
#>估计标准误差t值Pr（>t）
#>（截距）-0.5265 0.1360-3.871 0.1609
#>样条曲线：：bs（x，df=i）14.4178 0.4344 10.170 0.0624。
#>样条曲线：：bs（x，df=i）2-4.1409 0.4194-9.874 0.0643。
#>样条曲线：：bs（x，df=i）35.2151 0.3247 16.064 0.0396*
#>样条曲线：：bs（x，df=i）4-1.3020 0.3068-4.244 0.1473
#>样条曲线：：bs（x，df=i）52.3384 0.3245 7.206 0.0878。
#>样条曲线：：bs（x，df=i）6 1.9458 0.4199 4.634 0.1353
#>样条曲线：：bs（x，df=i）7 2.0650 0.4309 4.792 0.1310
#>样条曲线：：bs（x，df=i）81.22120.19246.3490.0995。
#> ---
#>签名。代码：0'***'0.001'***'0.01'*'0.05'.'0.1''1
#>
#>剩余标准误差：1个自由度上的0.136
#>倍数R平方：0.9974，调整后的R平方：0.9769
#>F-统计量：8和1 DF的48.6，p-值：0.1105
及
由（v0.3.0）于2020年11月30日创建，如果没有一些样本数据，这很棘手，但假设我们有以下数据集：
set.seed（1）
df4 x y
#> 1 1 -0.5264538
#> 2 2 0.3836433
#> 3 3 -0.5356286
#> 4 4 1.9952808
#> 5 5 0.8295078
#> 6 6 -0.2204684
#> 7 7 1.1874291
#> 8 8 1.5383247
#> 9 9 1.4757814
#> 10 10 0.6946116
绘制时，它如下所示：
plot(df)
所以它有轻微的上升趋势
如果我们想找到拟合r平方>0.8的样条线数，我们可以：
库（样条曲线）
我呼吁：
#>lm（公式=y~样条线：：bs（x，df=i），数据=df4）
#>
#>残差：
#> 1 2 3 4 5 6 7 8
#> 0.00008 -0.00216 0.01512 -0.04776 0.08208 -0.08208 0.04776 -0.01512
#> 9 10
#> 0.00216 -0.00008
#>
#>系数：
#>估计标准误差t值Pr（>t）
#>（截距）-0.5265 0.1360-3.871 0.1609
#>样条曲线：：bs（x，df=i）14.4178 0.4344 10.170 0.0624。
#>样条曲线：：bs（x，df=i）2-4.1409 0.4194-9.874 0.0643。
#>样条曲线：：bs（x，df=i）35.2151 0.3247 16.064 0.0396*
#>样条曲线：：bs（x，df=i）4-1.3020 0.3068-4.244 0.1473
#>样条曲线：：bs（x，df=i）52.3384 0.3245 7.206 0.0878。
#>样条曲线：：bs（x，df=i）6 1.9458 0.4199 4.634 0.1353
#>样条曲线：：bs（x，df=i）7 2.0650 0.4309 4.792 0.1310
#>样条曲线：：bs（x，df=i）81.22120.19246.3490.0995。
#> ---
#>签名。代码：0'***'0.001'***'0.01'*'0.05'.'0.1''1
#>
#>剩余标准误差：1个自由度上的0.136
#>倍数R平方：0.9974，调整后的R平方：0.9769
#>F-统计量：8和1 DF的48.6，p-值：0.1105
及
由（v0.3.0）于2020年11月30日创建。这应该可以做到。您需要估计渲染输出之外的模型，以便识别正确的阶数。然后，您需要使用renderUI（）
构建滑块，以便可以将已识别的度值传递给值
参数。然后，您可以在不在事件观察器内部的情况下进行绘图，因为它已经是一个反应函数，并且可以观察度输入滑块
ui <- fluidPage(sidebarLayout(
sidebarPanel(uiOutput("slider")),
mainPanel(plotlyOutput("plot"))))
server <- function(input, output, session){
library(ggplot2)
library(plotly)
library(splines)
set.seed(1)
## set number of observations
n <- 400
## generate x in [0,1]
x <- 0:(n-1)/(n-1)
## create compled function of x
f <- 0.2*x^11*(10*(1-x))^6+10*(10*x)^3*(1-x)^10
## create y = f(x) + random noise
y <- f + rnorm(n, 0, sd = 2)
df4 <- data.frame(x=x, y=y)
deg <- 2
r2 <- 0
while(r2 < .8){
deg <- deg + 1
m <- lm(formula = y ~ splines::bs(x, df = deg), df4)
r2 <- summary(m)$r.squared
}
output$slider <- renderUI(sliderInput('degree',
'Degree of the Polynomial:',
min = 2,
max = 300,
value = deg,
step = 1) )
output$plot <- renderPlotly({
#plot
m <- lm(formula = y ~ splines::bs(x, df = input$degree), df4)
g <- ggplot(data = df4, aes(x = x, y = y)) + theme_bw() +
geom_point(colour = "blue", size = 0.1)+
geom_smooth(formula = y ~ splines::bs(x, df = input$degree), method = "lm", color = "green3", level = 1, size = 1)
h <- g + xlab("X (mm)") + ylab("Z (um)")
ggplotly(h) %>% add_annotations(text= sprintf("R^2: %f", summary(m)[8]), xref="paper", yref="paper", x=0.05,y=0.9)
})
}
shinyApp(ui, server)
ui这应该可以做到。您需要估计渲染输出之外的模型，以便识别正确的阶数。然后，您需要使用renderUI（）
构建滑块，以便可以将已识别的度值传递给值
参数。然后，您可以在不在事件观察器内部的情况下进行绘图，因为它已经是一个反应函数，并且可以观察度输入滑块
ui <- fluidPage(sidebarLayout(
sidebarPanel(uiOutput("slider")),
mainPanel(plotlyOutput("plot"))))
server <- function(input, output, session){
library(ggplot2)
library(plotly)
library(splines)
set.seed(1)
## set number of observations
n <- 400
## generate x in [0,1]
x <- 0:(n-1)/(n-1)
## create compled function of x
f <- 0.2*x^11*(10*(1-x))^6+10*(10*x)^3*(1-x)^10
## create y = f(x) + random noise
y <- f + rnorm(n, 0, sd = 2)
df4 <- data.frame(x=x, y=y)
deg <- 2
r2 <- 0
while(r2 < .8){
deg <- deg + 1
m <- lm(formula = y ~ splines::bs(x, df = deg), df4)
r2 <- summary(m)$r.squared
}
output$slider <- renderUI(sliderInput('degree',
'Degree of the Polynomial:',
min = 2,
max = 300,
value = deg,
step = 1) )
output$plot <- renderPlotly({
#plot
m <- lm(formula = y ~ splines::bs(x, df = input$degree), df4)
g <- ggplot(data = df4, aes(x = x, y = y)) + theme_bw() +
geom_point(colour = "blue", size = 0.1)+
geom_smooth(formula = y ~ splines::bs(x, df = input$degree), method = "lm", color = "green3", level = 1, size = 1)
h <- g + xlab("X (mm)") + ylab("Z (um)")
ggplotly(h) %>% add_annotations(text= sprintf("R^2: %f", summary(m)[8]), xref="paper", yref="paper", x=0.05,y=0.9)
})
}
shinyApp(ui, server)
ui我通过在闪亮的应用程序中上传一些数据文件来获取df4数据。当我试着用你的方式做时，它显示了这样一个错误：“没有主动-被动上下文，不允许操作。”。（你试图做一些只能在反应式表达式或观察者内部完成的事情。）“那么，我应该将代码包含在反应式函数中吗？@kolas0202我编辑了答案，以包含文件上载按钮以及数据集名称中x和y变量的选择器。由于所有这些不同的规范可能会改变答案的性质（正如这里所做的那样），因此从一开始就了解解决方案的要求是非常有用的。我通过在Shining应用程序中上载一些数据文件来获取df4数据。当我试着用你的方式做时，它显示了这样一个错误：“没有主动-被动上下文，不允许操作。”。（你试图做一些只能在反应式表达式或观察者内部完成的事情。）“那么，我应该将代码包含在反应式函数中吗？@kolas0202我编辑了答案，以包含文件上载按钮以及数据集名称中x和y变量的选择器。因为所有这些
ui <- fluidPage(sidebarLayout(
sidebarPanel(
fileInput('file1', 'Choose file to upload',
accept = c(
'text/csv',
'text/comma-separated-values',
'text/tab-separated-values',
'text/plain',
'.csv',
'.tsv'
)
),
uiOutput("xvar"),
uiOutput("yvar"),
uiOutput("slider")),
mainPanel(plotlyOutput("plot"))))
server <- function(input, output, session){
library(ggplot2)
library(plotly)
library(splines)
df4 <- reactive({
req(input$file1)
inFile <- input$file1
read.csv(inFile$datapath, header = TRUE)
})
output$xvar <- renderUI({
req(df4())
selectInput("xvar", "X-variable", choices=names(df4()), selected = NULL)
})
output$yvar <- renderUI({
req(df4())
selectInput("yvar", "Y-variable", choices=names(df4()), selected = NULL)
})
deg <- reactive({
req(input$yvar)
degr <- 2
r2 <- 0
while(r2 < .8){
degr <- degr + 1
form <- paste(input$yvar, "~ splines::bs(", input$xvar, ", df = ", degr, ")")
m <- lm(formula = form, df4())
r2 <- summary(m)$r.squared
}
degr
})
output$slider <- renderUI({
req(deg())
sliderInput('degree',
'Degree of the Polynomial:',
min = 2,
max = 300,
value = deg(),
step = 1) })
output$plot <- renderPlotly({
req(deg())
#plot
form <- paste(input$yvar, "~ splines::bs(", input$xvar, ", df = ", input$degree, ")")
m <- lm(formula = form, df4())
g <- ggplot(data = df4(), aes_string(x = input$xvar, y = input$yvar)) + theme_bw() +
geom_point(colour = "blue", size = 0.1)+
geom_smooth(formula = y ~ splines::bs(x, df = input$degree), method = "lm", color = "green3", level = 1, size = 1)
h <- g + xlab("X (mm)") + ylab("Z (um)")
ggplotly(h) %>% add_annotations(text= sprintf("R^2: %f", summary(m)[8]), xref="paper", yref="paper", x=0.05,y=0.9)
})
}
shinyApp(ui, server)