Заполненная кривая градиента R

У меня есть кривая, которую я использую для создания R (см. код ниже):

library(rgl)

y = seq(-5,25,by=0.01)
x = seq(5,20,by=0.02)

sd = 0.3*x
NAs <- rep(NA, length(x)*length(y))
z <- matrix(NAs, length(x), byrow = T)
for(i in seq(1,length(x))) {
    for(j in seq(1,length(y))) {
        val = dnorm(y[j],mean=7.5,sd=sd[i])     
        z[i,j] = val
        if(z[i,j] < 0.02) {
            z[i,j] = NA
        }
    }
}

col <- rainbow(length(x))[rank(x)]        

open3d()
persp3d(x,y,z,color=col,xlim=c(5,20),ylim=c(5,10),axes=F,box=F,xlab="exp",ylab="obs",zlab="p")

И вот что получается: введите здесь описание изображения

Если вы немного повернете его, вы сможете увидеть, что это фигура типа полой трубы.

введите здесь описание изображения

Но я пытаюсь сделать так, чтобы он был заполнен (градиентом цвета), чтобы он не был пустым. Представьте, что вы делаете срез в любом месте, и вы получите 2D-плоскость, а не 2D-кривую, если это имеет смысл. Как я могу это сделать?


r 3d
person CodeGuy    schedule 28.01.2013    source источник
comment
Вы хотите удалить затенение? Или вы хотите сплошную форму, чтобы ваша первая фигура была заполнена до основания?   -  person sebastian-c    schedule 14.02.2013
comment
Я думаю, вы хотите добавить элементы rgl, вероятно, используя rgl.quads, для определения трех других ограничивающих поверхностей (слева, справа, снизу).   -  person Ben Bolker    schedule 24.02.2013
comment
Более по-новому и более быстрый способ получить ваши данные — использовать sapply (строки, разделенные точкой с запятой): q ‹- t(sapply(x, function(i) dnorm(y, 7.5, .3*i))); q[q‹.02] ‹- нет данных; идентичный(z, q) # ИСТИНА   -  person driu    schedule 25.02.2013

Ответы (2)


arrow_upward
7
arrow_downward

Чтобы заполнить пробел (двухмерную форму) в трехмерном пространстве, вы не должны использовать линии, так как они являются одномерными объектами. Вместо этого заполните пробел треугольниками или четырехугольниками (плоскими объектами с четырьмя углами).

library(rgl)

y <- seq(-5,25,by=0.1)
x <- seq(5,20,by=0.2)
z <- outer(.3*x, y, function(my.sd, my.y) dnorm(my.y, mean=7.5, sd=my.sd))
z[z < .02] <- NA

col <- rainbow(length(x))[rank(x)]        
xn <- length(x)
yn <- length(y)

open3d()
persp3d(x, y, z, color=col, xlim=c(5,20), ylim=c(5,10), axes=F, box=F,
        xlab="exp", ylab="obs", zlab="p")
rgl.quads(rep(x[xn], (yn-1)*4),
          sapply(2:yn, function(i) y[i-c(0:1,1:0)]),
          sapply(2:yn, function(i) c(z[xn,i-0:1], 0, 0)),
          color=col[xn])

введите здесь описание изображения

Команды outer и sapply могут сбивать с толку, если вы не знакомы с R, но думайте о них как о векторизованных циклах for. Вызов outer выполняет внешнее объединение координат для создания всех z за один раз, а sapply извлекает координаты четырехугольников. Причина, по которой следует избегать циклов for в R (или любом другом некомпилируемом языке высокого уровня), заключается в том, что они ужасно медленные, а также делают код громоздким.

person Backlin    schedule 28.02.2013

arrow_upward
6
arrow_downward

Лучший способ сделать это, потратив много времени на выяснение чего-то более элегантного, — вручную добавить строки, чтобы заполнить пробел:

yy = seq(-5, 25, by=0.01)
xx = rep(5,length(yy))
sds = 0.7 * xx
val = rep(NA, length(xx))
for(i in seq(1,length(val))) {
    val[i] = dnorm(yy[i],mean=rep(7.5,length(xx[i])),sd=sds[i])
    t = 0.06
    if(val[i] > 0.02) {
        #val[i] = t
        lines3d(c(xx[i],xx[i]),c(yy[i],yy[i]),c(0.02,val[i]),color="red")
    }
}
person CodeGuy    schedule 24.02.2013