เปลี่ยนการวิเคราะห์จุดโดยใช้ R's nls ()

ฉันกำลังพยายามใช้การวิเคราะห์ "จุดเปลี่ยน" หรือการถดถอยหลายเฟสที่ใช้nls()ในอาร์

นี่คือบางส่วนข้อมูลปลอมผมได้ทำ สูตรที่ฉันต้องการใช้เพื่อให้พอดีกับข้อมูลคือ:

$y = \beta_0 + \beta_1x + \beta_2\max(0,x-\delta)$

สิ่งนี้ควรจะทำคือพอดีกับข้อมูลได้ถึงจุดหนึ่งที่มีการตัดบางอย่างและความลาดชัน ( $\beta_0$และ$\beta_1$ ) แล้วหลังจากที่ค่า x บางอย่าง ( $\delta$ ) เพิ่มความลาดชันโดย\$\beta_2$นั่นคือสิ่งที่สูงสุดทั้งหมดเป็นเรื่องเกี่ยวกับ ก่อนจุด$\delta$มันจะเท่ากับ 0 และ$\beta_2$จะถูกทำให้เป็นศูนย์

ดังนั้นนี่คือหน้าที่ของฉันในการทำสิ่งนี้:

changePoint <- function(x, b0, slope1, slope2, delta){ 
   b0 + (x*slope1) + (max(0, x-delta) * slope2)
}

และฉันพยายามทำให้พอดีกับแบบนี้

nls(y ~ changePoint(x, b0, slope1, slope2, delta), 
    data = data, 
    start = c(b0 = 50, slope1 = 0, slope2 = 2, delta = 48))

ฉันเลือกพารามิเตอร์เริ่มต้นเหล่านั้นเพราะฉันรู้ว่าเป็นพารามิเตอร์เริ่มต้นเพราะฉันสร้างข้อมูลขึ้นมา

อย่างไรก็ตามฉันได้รับข้อผิดพลาดนี้:

Error in nlsModel(formula, mf, start, wts) : 
  singular gradient matrix at initial parameter estimates

ฉันเพิ่งทำข้อมูลที่โชคร้าย? ฉันลองปรับให้เหมาะสมกับข้อมูลจริงก่อนและได้รับข้อผิดพลาดเดียวกันและฉันเพิ่งคิดว่าพารามิเตอร์เริ่มต้นของฉันไม่ดีพอ

(ในตอนแรกที่ผมคิดว่ามันอาจจะมีปัญหาที่เกิดจากความจริงที่ว่าmaxจะไม่ vectorized แต่ที่ไม่เป็นความจริงมัน. ไม่ทำให้มันเจ็บปวดที่จะทำงานร่วมกับ changePoint ทำไมการปรับเปลี่ยนต่อไปนี้:

changePoint <- function(x, b0, slope1, slope2, delta) { 
   b0 + (x*slope1) + (sapply(x-delta, function (t) max(0, t)) * slope2)
}

การโพสต์รายชื่อผู้รับจดหมาย R-help นี้อธิบายถึงวิธีหนึ่งที่ข้อผิดพลาดนี้อาจเกิดขึ้น: rhs ของสูตรมีการทำพารามิเตอร์มากเกินไปเช่นการเปลี่ยนพารามิเตอร์สองตัวตามกันจะให้ความพอดีกับข้อมูล ฉันไม่เห็นว่ามันจะเป็นจริงสำหรับแบบจำลองของคุณ แต่อาจเป็นได้

ไม่ว่าในกรณีใดคุณสามารถเขียนฟังก์ชันวัตถุประสงค์ของคุณเองและย่อให้เล็กสุดได้ ฟังก์ชั่นต่อไปนี้ให้ข้อผิดพลาดกำลังสองสำหรับจุดข้อมูล (x, y) และค่าที่แน่นอนของพารามิเตอร์ (โครงสร้างอาร์กิวเมนต์แปลก ๆ ของฟังก์ชั่นคือการบัญชีสำหรับวิธีการoptimทำงาน):

sqerror <- function (par, x, y) {
  sum((y - changePoint(x, par[1], par[2], par[3], par[4]))^2)
}

จากนั้นเราพูดว่า:

optim(par = c(50, 0, 2, 48), fn = sqerror, x = x, y = data)

และดู:

$par
[1] 54.53436800 -0.09283594  2.07356459 48.00000006

โปรดทราบว่าสำหรับข้อมูลปลอมของฉัน ( x <- 40:60; data <- changePoint(x, 50, 0, 2, 48) + rnorm(21, 0, 0.5)) มีจำนวนสูงสุดในพื้นที่ขึ้นอยู่กับค่าพารามิเตอร์เริ่มต้นที่คุณให้ ฉันคิดว่าถ้าคุณต้องการทำสิ่งนี้อย่างจริงจังคุณจะเรียกเครื่องมือเพิ่มประสิทธิภาพหลาย ๆ ครั้งด้วยพารามิเตอร์เริ่มต้นแบบสุ่มและตรวจสอบการกระจายของผลลัพธ์

แค่อยากจะเพิ่มว่าคุณสามารถทำได้ด้วยแพ็คเกจอื่น ๆ หากคุณต้องการประเมินความไม่แน่นอนประมาณจุดเปลี่ยน (สิ่งที่ nls ทำไม่ได้) ให้ลองใช้mcpแพคเกจ

# Simulate the data
df = data.frame(x = 1:100)
df$y = c(rnorm(20, 50, 5), rnorm(80, 50 + 1.5*(df$x[21:100] - 20), 5))

# Fit the model
model = list(
  y ~ 1,  # Intercept
  ~ 0 + x  # Joined slope
)
library(mcp)
fit = mcp(model, df)

ลองพล็อตมันด้วยช่วงการทำนาย (เส้นสีเขียว) ความหนาแน่นของสีน้ำเงินคือการกระจายด้านหลังสำหรับตำแหน่งจุดเปลี่ยน:

# Plot it
plot(fit, q_predict = T)

คุณสามารถตรวจสอบแต่ละพารามิเตอร์ในรายละเอียดมากขึ้นโดยใช้และplot_pars(fit)summary(fit)