R中的(S型)曲线拟合glm [英] (sigmoid) curve fitting glm in r

问题描述

我希望可视化我的响应变量，检测概率(P.det)和两个变量(发送器)的预测变量(距离)之间的关系，显示误差线并通过平均数据点绘制一条(S型)曲线.

数据集是这样的:

  df<-结构(list(距离= c(50L，100L，200L，300L，400L，50L，100L，200L，300L，400L)，变送器=结构(c(1L，1L，1L，1L，1L，2L，2L，2L，2L，2L)，. Label = c("CT"，"PT")，class ="factor")，P.det = c(0.918209097、0.88375438、0.709288774、0.534977488，0.341724516、0.828123952、0.822201191、0.543289433、0.352886247，0.10082457)，st.error = c(0.01261614、0.014990469、0.024136478，0.027311169、0.026941438、0.018663591、0.019420587、0.02754911，0.026809247、0.017041264)，ly = c(0.905592958、0.868763911，0.685152295、0.50766632、0.314783078、0.809460361、0.802780604，0.515740323、0.326077、0.083783306)，uy = c(0.930825237，0.898744849、0.733425252、0.562288657、0.368665955、0.846787544，0.841621778、0.570838544、0.379695494、0.117865833)，有效检测次数= c(18，12.5472973，8.608108108，4.287162162，2.158783784，12.46959459，7.956081081，4.550675676，1.682432432，0.39527027)，False.detections = c(0.388513514，0.550675676、0.368243243、0.263513514、0.131756757、0.533783784，0.385135135、0.277027027、0.182432432、0.14527027)).名称= c(距离"，发送器"，"P.det"，"st.error"，"ly"，"uy"，有效检测"，"False.detections")，类="data.frame"，row.names = c(NA，-10L)) 

我设法完成了前两个部分，但被困在最后一个部分.绘制带有误差线图的代码:

 库(晶格)prepanel.ci<-函数(x，y，ly，uy，下标，...){x<-as.numeric(x)ly<-as.numeric(ly [subscripts])uy<-as.numeric(uy [subscripts])list(ylim = range(y，uy，ly，finite = TRUE))}panel.ci<-function(x，y，ly，uy，下标，pch = 16，...){x<-as.numeric(x)y <-as.numeric(y)ly<-as.numeric(ly [subscripts])uy<-as.numeric(uy [subscripts])panel.arrows(x，ly，x，uy，col ="black"，长度= 0.25，单位=本机"，角度= 90，代码= 3)panel.xyplot(x，y，pch = pch，...)}xyplot(P.det〜distance，type = c("p"，"g")，ylim = c(0,1)，ylab =检测概率"，xlab =距离(m)"，group =发射器，数据= DFly = df $ ly，uy = df $ uy，prepanel = prepanel.ci，面板= panel.superpose，panel.groups = panel.ci，col = c(1,1)，layout = c(1,1)，之间=列表(x = 2)，scales = list(x = list(alternating = c(1,1)，tck = c(1,0))，y = list(alternating = c(1,1)，tck = c(1,0)))，#个内部滴答= tck = c(-1,0)方面= 1，main =检测概率与每种发射器类型的距离"，) 

之所以在标题中注明"glm"，是因为使用lme4软件包使用二项式glm()进行了数据分析.

我注意到另一个类似于我的线程:.

I wish to visualize the relationship between my response variable, detection probability (P.det) and predictor variable (distance) for two categories (transmitter), show error bars and draw a (sigmoidal) curve through the averaged data points.

The dataset is like this:

df <- structure(list(distance = c(50L, 100L, 200L, 300L, 400L, 50L, 
100L, 200L, 300L, 400L), Transmitter = structure(c(1L, 1L, 1L, 
1L, 1L, 2L, 2L, 2L, 2L, 2L), .Label = c("CT", "PT"), class = "factor"), 
    P.det = c(0.918209097, 0.88375438, 0.709288774, 0.534977488, 
    0.341724516, 0.828123952, 0.822201191, 0.543289433, 0.352886247, 
    0.10082457), st.error = c(0.01261614, 0.014990469, 0.024136478, 
    0.027311169, 0.026941438, 0.018663591, 0.019420587, 0.02754911, 
    0.026809247, 0.017041264), ly = c(0.905592958, 0.868763911, 
    0.685152295, 0.50766632, 0.314783078, 0.809460361, 0.802780604, 
    0.515740323, 0.326077, 0.083783306), uy = c(0.930825237, 
    0.898744849, 0.733425252, 0.562288657, 0.368665955, 0.846787544, 
    0.841621778, 0.570838544, 0.379695494, 0.117865833), Valid.detections = c(18, 
    12.5472973, 8.608108108, 4.287162162, 2.158783784, 12.46959459, 
    7.956081081, 4.550675676, 1.682432432, 0.39527027), False.detections = c(0.388513514, 
    0.550675676, 0.368243243, 0.263513514, 0.131756757, 0.533783784, 
    0.385135135, 0.277027027, 0.182432432, 0.14527027)), .Names = c("distance", 
"Transmitter", "P.det", "st.error", "ly", "uy", "Valid.detections", 
"False.detections"), class = "data.frame", row.names = c(NA, 
-10L))

I managed to get the first 2 parts done, but am stuck at the last part. The code to draw the graph with error bars:

library(lattice)
    prepanel.ci <- function(x, y, ly, uy, subscripts, ...)
    {
      x <- as.numeric(x)
      ly <- as.numeric(ly[subscripts])
      uy <- as.numeric(uy[subscripts])
      list(ylim = range(y, uy, ly, finite = TRUE))
    }

    panel.ci <- function(x, y, ly, uy, subscripts, pch = 16, ...)
    {
      x <- as.numeric(x)
      y <- as.numeric(y)
      ly <- as.numeric(ly[subscripts])
      uy <- as.numeric(uy[subscripts])
      panel.arrows(x, ly, x, uy, col = "black",
                   length = 0.25, unit = "native",
                   angle = 90, code = 3)
      panel.xyplot(x, y, pch = pch, ...)
    }

xyplot(P.det~distance, type=c("p","g"),
       ylim=c(0,1),
       ylab="Detection probability", xlab="Distance (m)", 
       group=Transmitter,
       data=df,
       ly = df$ly,
       uy = df$uy,
       prepanel = prepanel.ci,
       panel = panel.superpose,
       panel.groups = panel.ci,
       col=c(1,1),
       layout=c(1,1),
       between=list(x=2),
       scales=list(x=list(alternating=c(1,1), tck=c(1,0)),y=list(alternating=c(1,1), tck=c(1,0))), # ticks inside = tck=c(-1,0)
       aspect=1,
       main="Detection probability vs distance per transmitter type",
)

The reason why I state "glm" in the title is because the data analysis was carried out using a binomial glm() using the lme4 package.

I noticed another thread which is similar to mine: find the intersection of abline with fitted curve, however the difference is that while my graph is also based on 1 y per 1 x, my glm is based on a multitude of y's per x. So following the same codes in this thread returns an error stating that the lengths are not of equal length. It also doesn't seem to work for an "xyplot".

Thanks

解决方案

This is fairly straightforward using ggplot:

library(ggplot2)
ggplot(data = df, aes(x = distance, y = P.det, colour = Transmitter)) +
  geom_pointrange(aes(ymin = P.det - st.error, ymax = P.det + st.error)) +
  geom_smooth(method = "glm", family = binomial, se = FALSE)

Regarding the glmwarning message, see e.g. here.

这篇关于R中的(S型)曲线拟合glm的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！