Question

根据这个问题和答案，我正在尝试使用未知的断点进行逐点线性回归。

区别在于，我需要如此限制断点两侧的倾斜度，直到我还不能做。

我的数据看起来像这样。我想要一个函数，因此可以将其映射到多个嵌套数据集。

dput(head(my_data, 30 ))
structure(list(vo2 = c(1.967, 3.113, 2.881, 2.931, 2.809, 2.802, 
2.937, 3.235, 3.238, 3.118, 3.177, 2.959, 2.741, 3.157, 2.975, 
2.986, 3.231, 2.448, 2.966, 2.834, 3.559, 3.37, 3.187, 3.079, 
3.076, 2.848, 3.16, 3.285, 3.159, 3.305), vco2 = c(1.552, 2.458, 
2.303, 2.372, 2.264, 2.284, 2.352, 2.566, 2.585, 2.506, 2.6, 
2.441, 2.251, 2.592, 2.418, 2.428, 2.665, 2.039, 2.437, 2.298, 
2.891, 2.733, 2.609, 2.514, 2.538, 2.286, 2.497, 2.59, 2.489, 
2.606)), row.names = c(NA, -30L), class = c("tbl_df", "tbl", 
"data.frame"))

我在用的答案在这里 https://stackoverflow.com/a/15877616/9368078 代码在这里

function (x,y) 
{
    f <- function (Cx) 
        {
        lhs <- function(x) ifelse(x < Cx,Cx-x,0)
        rhs <- function(x) ifelse(x < Cx,0,x-Cx)
        fit <- lm(y ~ lhs(x) + rhs(x))
        c(summary(fit)$r.squared, 
            summary(fit)$coef[1], summary(fit)$coef[2],
            summary(fit)$coef[3])
        }

    r2 <- function(x) -(f(x)[1])

    res <- optimize(r2,interval=c(min(x),max(x)))
    res <- c(res$minimum,f(res$minimum))

    best_Cx <- res[1]
    coef1 <- res[3]
    coef2 <- res[4]
    coef3 <- res[5]
    plot(x,y)
    abline(coef1+best_Cx*coef2,-coef2) #lhs  
    abline(coef1-best_Cx*coef3,coef3)  #rs

inspiration solution

已经尝试了以下替代方法，因此可以限制坡度。在这里，我尝试在优化中设置边界。

f <- function (Cx) {
  lhs <- function(x) ifelse(x < Cx,Cx-x,0)
  rhs <- function(x) ifelse(x < Cx,0,x-Cx)
  fit <- lm(y ~ lhs(x) + rhs(x))
  c(summary(fit)$r.squared, 
    summary(fit)$coef[1], summary(fit)$coef[2],
    summary(fit)$coef[3])
}
r2 <- function(x) -(f(x)[1])

res <- optimize(r2,interval=c(min(x),max(x), lower = c(-100,-100,1), upper = c(100,1,100)) )
res <- c(res$minimum,f(res$minimum))

best_Cx <- res[1]
coef1 <- res[3]
coef2 <- res[4]
coef3 <- res[5]
plot(x,y)
abline(coef1+best_Cx*coef2,-coef2) #lhs  
abline(coef1-best_Cx*coef3,coef3)  #rs

在这里，我尝试使用nls解决方案。我尝试在变量上设置边界的地方。

f <- function (Cx) {
  lhs <- function(x) ifelse(x < Cx,Cx-x,0)
  rhs <- function(x) ifelse(x < Cx,0,x-Cx)
  fit <- nls(y ~ lhs(x) + rhs(x), start = c(0,1.5), 
             algorithm = "port", 
             lower = c(-inf,-inf,1), 
             upper = c(inf,1,inf) )
  c(summary(fit)$r.squared, 
    summary(fit)$coef[1], summary(fit)$coef[2],
    summary(fit)$coef[3])
}
r2 <- function(x) -(f(x)[1])

res <- optimize(r2,interval=c(min(x),max(x)) )
res <- c(res$minimum,f(res$minimum))

best_Cx <- res[1]
coef1 <- res[3]
coef2 <- res[4]
coef3 <- res[5]

但是两种解决方案都不适合我。所以我肯定在做错事。

我正在研究体育科学，并试图学习一些统计数据。

有人可以指出我的解决方案的方向吗？

逐线性回归集约束

0 个答案: