在格子中通过点绘制二次样条曲线

Question

在格子中通过点绘制二次样条曲线

7

在lattice中，应该如何做到呢？

plot(rnorm(120), rnorm(120), col="darkblue", pch=16, xlim=c(-3,3), ylim=c(-4,4))
points(rnorm(120,-1,1), rnorm(120,2,1), col="darkred", pch=16)
points(c(-1,-1.5,-3), c(4,2,0), pch=3, cex=3)
xspline(c(-1,-1.5,-3), c(4,2,0), shape = -1)

应该是这样的：

这里有类似的数据，更适合用于lattice绘图：

dat <- data.frame(x=c(rnorm(120), rnorm(120,-1,1)),
                  y=c(rnorm(120), rnorm(120,2,1)),
                  l=factor(rep(c('B','R'),each=120))
)
spl <- data.frame(x=c(-1,-1.5,-3), 
                  y=c(4,2,0)
)

以下是与链接问题相关的内容，翻译成“lattice”后的结果：

xyplot(y ~ x,
       data=dat,
       groups=l,
       col=c("darkblue", "darkred"),
       pch=16,
       panel = function(x, y, ...) {
         panel.xyplot(x=spl$x, y=spl$y, pch=3, cex=3)
         ## panel.spline(x=spl$x, y=spl$y)              ## Gives an error, need at least four 'x' values
         panel.superpose(x, y, ...,
                         panel.groups = function(x, y, ...) {
                           panel.xyplot(x, y, ...)
                         }
         )
       },
       xlim=c(-3,3), ylim=c(-4,4)
)

enter image description here

- Matthew Lundberg

1

这个问题得到了一些很好的答案。在“lattice”绘图中，一个棘手的问题是如何正确地注释现有的图形。可以在原始函数内或过度现有函数中应用各种技术。 - IRTFM

1

无论你是否采用我下面的具体实现方案，grid.xspline() 函数可能会非常有用... - Josh O'Brien

@JoshO'Brien确实，grid.xspline()也适用于普通的lattice代码。 - Matthew Lundberg

@MatthewLundberg 我添加了一个使用 grid.xspline() 的 ggplot2 解决方案。 - agstudy

5个回答

3

这有点棘手，但是行得通。

plot(rnorm(120), rnorm(120), col="darkblue", pch=16, xlim=c(-3,3), ylim=c(-4,4))
points(rnorm(120,-1,1), rnorm(120,2,1), col="darkred", pch=16)
points(c(-1,-1.5,-3), c(4,2,0), pch=3, cex=3)

在不生成绘图的情况下，我使用xspline

dd <- xspline(c(-1,-1.5,-3), c(4,2,0), shape = -1,draw=FALSE)

然后我使用由panel.lines产生的点。

library(lattice)
xyplot(y ~ x,
       data=dat,
       groups=l,
       col=c("darkblue", "darkred"),
       pch=16,
       panel = function(x, y, ...) {
         panel.xyplot(x=spl$x, y=spl$y, pch=3, cex=3)
         panel.lines(dd$x,dd$y)
         panel.superpose(x, y, ...,
                         panel.groups = function(x, y, ...) {
                           panel.xyplot(x, y, ...)
                         }
         )
       },
       xlim=c(-3,3), ylim=c(-4,4)
)

enter image description here

- agstudy

不错的解决方案，但我不喜欢它需要基本绘图函数才能工作。 - Matthew Lundberg

@MatthewLundberg 谢谢。但是为什么？我很好奇。因为它生成基础图形吗？如果我调用基本绘图（以“不可见”的方式）的xspline包装器对您来说是可接受的解决方案吗？ - agstudy

我想避免使用基本图形函数。如果没有比我自己的答案更好的选择，我会接受这个答案，因为它确实可以工作。 - Matthew Lundberg

@DWin 对不起，我的英语很差。我没有完全理解你的评论。我需要在我的回答中做出改变吗？ - agstudy

@DWin 它会根据活动图形设备的状态产生略微不同的结果（向量长度）。例如，在plot(-1,-1)之后再执行该命令，然后在plot(100, 100)之后再执行该命令并进行比较。如果没有活动图形设备，它也会失败。 - Matthew Lundberg

显示剩余2条评论

3

这不是一个解决方案，而是尝试在ggplot2中使用Josh解决方案的grid.xspline。我认为将ggplot2/lattice进行类比是很有趣的。

enter image description here

## prepare the data
dat <- data.frame(x=c(rnorm(120), rnorm(120,-1,1)),
                 y=c(rnorm(120), rnorm(120,2,1)),
                 l=factor(rep(c('B','R'),each=120))
)
spl <- data.frame(x=c(-2,-1.5,-3), 
                  y=c(4,2,0)
)
## prepare the scatter plot
library(ggplot(2))
p <- ggplot(data=dat,aes(x=x,y=y,color=l))+
  geom_point()+
  geom_point(data=spl,aes(x=x,y=y),color='darkred',size=5)
library(grid)
ff <- ggplot_build(p)

我的想法是使用由ggplot2生成的比例尺，在与散点图相同的面板中创建样条线。就我个人而言，我觉得这很棘手，希望有人能提出更好的解决方案。

xsp.grob <- xsplineGrob(spl$x, spl$y,
                        vp=viewport(xscale =ff$panel$ranges[[1]]$x.range,
                                    yscale = ff$panel$ranges[[1]]$y.range),
                        shape = -1, default.units="native")
p
grid.add(gPath='panel.3-4-3-4',child=xsp.grob)

- agstudy

2

我终于找到了一个解决方法，基于这个问题的答案：二次样条插值使用 splines 包

将上面注释掉的 panel.splines(...) 替换为以下代码：

         local({
           model <- lm(y ~ bs(x, degree=2), data=spl)
           x0 <- seq(min(spl$x), max(spl$x), by=.1)
           panel.lines(x0, predict(model, data.frame(x=x0)))
         })

enter image description here

根据Josh O'Brien的建议，grid.xspline()可以替换被注释掉的panel.splines(...)行，从而得到与上面链接的基本问题中完全相同的图形（除了边距）：

         grid.xspline(spl$x, spl$y, shape = -1, default.units="native")

enter image description here

- Matthew Lundberg

@agstudy 这不太易读，而且，接受我自己的答案也没有什么意义。 - Matthew Lundberg

哇，你从引用链接的答案或评论中找到了那个答案。你比我强多了。 - IRTFM

@DWin 特别是Josh的回答。 - Matthew Lundberg

0

这是Deepayan Sarkar的样条面板的变体。

panel.smooth.spline <-  function(x, y,
                                 w=NULL, df, spar = NULL, cv = FALSE,
                                 lwd=plot.line$lwd, lty=plot.line$lty,col, 
                                 col.line=plot.line$col,type, ... )
{
  x <- as.numeric(x)
  y <- as.numeric(y)
  ok <- is.finite(x) & is.finite(y)
  if (sum(ok) < 1)
    return()
  if (!missing(col)) {
    if (missing(col.line))
      col.line <- col
  }
  plot.line <- trellis.par.get("plot.line")
  spline <-   smooth.spline(x[ok], y[ok],
                            w=w, df=df, spar = spar, cv = cv)
  pred = predict(spline,x= seq(min(x),max(x),length.out=150))
  panel.lines(x = pred$x, y = pred$y, col = col.line,
              lty = lty, lwd = lwd, ...)
  panel.abline(h=y[which.min(x)],col=col.line,lty=2)
}

- Dieter Menne

这可能解决我实际想要解决的问题，但对于示例不起作用：Error using packet 1 need at least 4 unique 'x' values -- panel.spline也是如此。 - Matthew Lundberg

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Josh O'Brien · Accepted Answer

这是将基本图形解决方案直接转换为格子的逐行“翻译”。（由于+运算符由latticeExtra包提供，因此可以实现直接翻译。有关其用法的详细信息，请参见?layer。）

最后一行调用grid.xspline()，它是grid图形函数xspline()的精确对应物。

library(lattice)
library(grid)
library(latticeExtra)

xyplot(rnorm(120)~rnorm(120), pch=16, col="darkblue", 
       xlim = c(-3.1, 3.1), ylim = c(-4.1, 4.1)) +
xyplot(rnorm(120,2,1) ~ rnorm(120,-1,1), pch=16, col="darkred") +
xyplot(c(4,2,0) ~ c(-1,-1.5,-3), pch=3, cex=3) +
layer(grid.xspline(c(-1,-1.5,-3), c(4,2,0), shape = -1, default.units="native"))

在上面的最后一行中，grid 的一个奇特细节确实出现了: 像其它几个低级别的线条绘制函数一样，grid.xspline() 默认使用 "npc" 单位，而不是像 grid.points() 和许多其他 grid.*() 函数默认使用的 "native" 单位。显然，这很容易改变 --- 一旦你意识到它！

enter image description here