การประมาณความชันของส่วนตรงของส่วนโค้ง sigmoid

ฉันได้รับงานนี้แล้วก็นิ่งงัน เพื่อนร่วมงานขอให้ฉันประเมินและของแผนภูมิต่อไปนี้:$x_{upper}$$x_{lower}$

เส้นโค้งนั้นคือการแจกแจงแบบสะสมและ x เป็นการวัดแบบหนึ่ง เขาสนใจที่จะรู้ว่าอะไรคือค่าที่สอดคล้องกันของ x เมื่อฟังก์ชันสะสมเริ่มกลายเป็นเส้นตรงและเบี่ยงเบนจากการเป็นเส้นตรง

ฉันเข้าใจว่าเราสามารถใช้ความแตกต่างเพื่อค้นหาความชัน ณ จุดหนึ่ง แต่ฉันไม่แน่ใจว่าจะระบุได้อย่างไรว่าเราจะโทรหาเส้นตรงได้เมื่อไหร่ เขยิบต่อแนวทาง / วรรณกรรมที่มีอยู่แล้วบางส่วนจะได้รับการชื่นชมอย่างมาก

ฉันรู้ว่าอาร์เช่นกันถ้าคุณรู้แพคเกจหรือตัวอย่างที่เกี่ยวข้องในการสืบสวนประเภทนี้

ขอบคุณมาก.

UPDATE

ขอบคุณ Flounderer ฉันสามารถขยายงานเพิ่มเติมตั้งค่ากรอบงานและแก้ไขพารามิเตอร์ที่นี่และที่นั่น เพื่อจุดประสงค์ในการเรียนรู้นี่คือรหัสปัจจุบันของฉันและเอาต์พุตกราฟิก

library(ESPRESSO)

x <- skew.rnorm(800, 150, 5, 3)
x <- sort(x)
meanX <- mean(x)
sdX <- sd(x)
stdX <- (x-meanX)/sdX
y <- pnorm(stdX)

par(mfrow=c(2,2), mai=c(1,1,0.3,0.3))
hist(x, col="#03718750", border="white", main="")

nq <- diff(y)/diff(x)
plot.ts(nq, col="#6dc03480")

log.nq <- log(nq)
low <- lowess(log.nq)
cutoff <- .7
q <- quantile(low$y, cutoff)
plot.ts(log.nq, col="#6dc03480")
abline(h=q, col="#348d9e")

x.lower <- x[min(which(low$y > q))]
x.upper <- x[max(which(low$y > q))]
plot(x,y,pch=16,col="#03718750", axes=F)
axis(side=1)
axis(side=2)
abline(v=c(x.lower, x.upper),col="red")
text(x.lower, 1.0, round(x.lower,0))
text(x.upper, 1.0, round(x.upper,0))

นี่เป็นแนวคิดที่รวดเร็วและสกปรกตามคำแนะนำของ @ alex

#simulated data
set.seed(100)
x <- sort(exp(rnorm(1000, sd=0.6)))
y <- ecdf(x)(x)

ดูเหมือนข้อมูลของคุณเล็กน้อย ตอนนี้ความคิดคือการดูที่อนุพันธ์และพยายามที่จะดูว่ามันใหญ่ที่สุด นี่ควรเป็นส่วนหนึ่งของเส้นโค้งของคุณตรงที่สุดเพราะมันเป็นรูปตัว S

NQ <- diff(y)/diff(x)
plot.ts(NQ)

มันเป็น wiggly เพราะค่าบางค่าใกล้กันมาก อย่างไรก็ตามการใช้บันทึกช่วยแล้วคุณสามารถใช้เวอร์ชันที่ราบรื่น$x$

log.NQ <- log(NQ)
low <- lowess(log.NQ)
cutoff <- 0.75
q <- quantile(low$y, cutoff)
plot.ts(log.NQ)
abline(h=q)

ทีนี้คุณสามารถลองหาของแบบนี้:$x$

x.lower <- x[min(which(low$y > q))]
x.upper <- x[max(which(low$y > q))]
plot(x,y)
abline(v=c(x.lower, x.upper))

แน่นอนที่สุดสิ่งทั้งหมดนั้นไวต่อการเลือกcutoffและอัลกอริธึมการปรับให้เรียบและในที่สุดก็เกิดขึ้นในการบันทึกเมื่อเราสามารถทำการเปลี่ยนแปลงอื่น ๆ ได้ นอกจากนี้สำหรับข้อมูลจริงการเปลี่ยนแปลงแบบสุ่มในอาจทำให้เกิดปัญหากับวิธีนี้เช่นกัน ตราสารอนุพันธ์ไม่ได้มีความประพฤติดี แก้ไข: เพิ่มรูปภาพผลลัพธ์$y$