R轴标记和标记标签之间的rgl距离
我正在使用plot3d()绘制一些点数据。 我想让我的y轴记号标签稍微靠近我的y轴记号标记 我能想到的最好的办法就是 1) 先绘制数据,不绘制轴 2) 调用axis3d()绘制y轴和记号,但禁止绘制标签 3) 查询每个记号在三维空间中的当前位置。在向量中存储位置 4) 使用mtext3d()在基于向量调整的位置添加标签 我在第3步遇到问题。我不知道如何查询每个记号的位置。 par3d()允许您查询许多图形参数,是否可以使用类似的工具来获取每个y轴刻度的位置 我是不是走错路了?可能吧 下面是一段示例代码,没有为y轴标签添加文本R轴标记和标记标签之间的rgl距离,r,rgl,R,Rgl,我正在使用plot3d()绘制一些点数据。 我想让我的y轴记号标签稍微靠近我的y轴记号标记 我能想到的最好的办法就是 1) 先绘制数据,不绘制轴 2) 调用axis3d()绘制y轴和记号,但禁止绘制标签 3) 查询每个记号在三维空间中的当前位置。在向量中存储位置 4) 使用mtext3d()在基于向量调整的位置添加标签 我在第3步遇到问题。我不知道如何查询每个记号的位置。 par3d()允许您查询许多图形参数,是否可以使用类似的工具来获取每个y轴刻度的位置 我是不是走错路了?可能吧 下面是一段示
require(rgl)
x <- rnorm(5)
y <- rnorm(5)
z <- rnorm(5)
open3d()
plot3d(x,y,z,axes=F,xlab="",ylab="",zlab="")
par3d(ignoreExtent=TRUE)
par3d(FOV=0)
par3d(userMatrix=rotationMatrix(0,1,0,0))
axis3d('y',nticks=5,labels = FALSE)
par3d(zoom=1)
par3d(windowRect=c(580,60,1380,900))
require(rgl)
一种方法是在绘制轴之前明确定义记号位置,而不是在绘制轴之后查询记号位置。然后,您可以使用mtext3d
的line=
选项控制刻度标签与轴的距离,如下所示:
require(rgl)
rgl.close()
x <- rnorm(5)
y <- rnorm(5)
z <- rnorm(5)
open3d()
plot3d(x,y,z,axes=F,xlab="",ylab="",zlab="")
par3d(ignoreExtent=TRUE)
par3d(FOV=0)
par3d(userMatrix=rotationMatrix(0,1,0,0))
par3d(zoom=1)
par3d(windowRect=c(580,60,1380,900))
# and here is the trick:
my.ticks <- pretty(y, n=5)
axis3d('y', at=my.ticks, labels=rep("", 5))
mtext3d(paste(my.ticks), at=my.ticks, edge='y', line=.6)
axis3 <- function (edge, at = NULL, labels = TRUE, tick = TRUE, line = 0,
pos = NULL, nticks = 5, ticksize = 0.05, lab_dist = 3, ...)
{
save <- par3d(skipRedraw = TRUE, ignoreExtent = TRUE)
on.exit(par3d(save))
ranges <- rgl:::.getRanges()
edge <- c(strsplit(edge, "")[[1]], "-", "-")[1:3]
coord <- match(toupper(edge[1]), c("X", "Y", "Z"))
if (coord == 2)
edge[1] <- edge[2]
else if (coord == 3)
edge[1:2] <- edge[2:3]
range <- ranges[[coord]]
if (is.null(at)) {
at <- pretty(range, nticks)
at <- at[at >= range[1] & at <= range[2]]
}
if (is.logical(labels)) {
if (labels)
labels <- format(at)
else labels <- NA
}
mpos <- matrix(NA, 3, length(at))
if (edge[1] == "+")
mpos[1, ] <- ranges$x[2]
else mpos[1, ] <- ranges$x[1]
if (edge[2] == "+")
mpos[2, ] <- ranges$y[2]
else mpos[2, ] <- ranges$y[1]
if (edge[3] == "+")
mpos[3, ] <- ranges$z[2]
else mpos[3, ] <- ranges$z[1]
ticksize <- ticksize * (mpos[, 1] - c(mean(ranges$x), mean(ranges$y),
mean(ranges$z)))
ticksize[coord] <- 0
if (!is.null(pos))
mpos <- matrix(pos, 3, length(at))
mpos[coord, ] <- at
x <- c(mpos[1, 1], mpos[1, length(at)])
y <- c(mpos[2, 1], mpos[2, length(at)])
z <- c(mpos[3, 1], mpos[3, length(at)])
if (tick) {
x <- c(x, as.double(rbind(mpos[1, ], mpos[1, ] + ticksize[1])))
y <- c(y, as.double(rbind(mpos[2, ], mpos[2, ] + ticksize[2])))
z <- c(z, as.double(rbind(mpos[3, ], mpos[3, ] + ticksize[3])))
}
result <- c(ticks = segments3d(x, y, z, ...))
if (!all(is.na(labels)))
result <- c(result, labels = text3d(mpos[1, ] + lab_dist * ticksize[1],
mpos[2, ] + lab_dist * ticksize[2],
mpos[3, ] + lab_dist * ticksize[3],
labels, ...))
lowlevel(result)
}
require(rgl)
rgl.close()
x我发现,在axis3d中控制标签位置和记号长度的最简单方法是重写函数,并添加两个额外的参数ticksize
和labu dist
,这些参数可用于覆盖函数中嵌入的默认值。默认值ticksize=0.05
和lab_dist=3
再现原始axis3d
的行为
要获得更小的刻度和更接近的标签,您可以使用例如
axis3('y', nticks=5, labels = FALSE, ticksize = 0.03, lab_dist = 2)
新函数如下所示:
require(rgl)
rgl.close()
x <- rnorm(5)
y <- rnorm(5)
z <- rnorm(5)
open3d()
plot3d(x,y,z,axes=F,xlab="",ylab="",zlab="")
par3d(ignoreExtent=TRUE)
par3d(FOV=0)
par3d(userMatrix=rotationMatrix(0,1,0,0))
par3d(zoom=1)
par3d(windowRect=c(580,60,1380,900))
# and here is the trick:
my.ticks <- pretty(y, n=5)
axis3d('y', at=my.ticks, labels=rep("", 5))
mtext3d(paste(my.ticks), at=my.ticks, edge='y', line=.6)
axis3 <- function (edge, at = NULL, labels = TRUE, tick = TRUE, line = 0,
pos = NULL, nticks = 5, ticksize = 0.05, lab_dist = 3, ...)
{
save <- par3d(skipRedraw = TRUE, ignoreExtent = TRUE)
on.exit(par3d(save))
ranges <- rgl:::.getRanges()
edge <- c(strsplit(edge, "")[[1]], "-", "-")[1:3]
coord <- match(toupper(edge[1]), c("X", "Y", "Z"))
if (coord == 2)
edge[1] <- edge[2]
else if (coord == 3)
edge[1:2] <- edge[2:3]
range <- ranges[[coord]]
if (is.null(at)) {
at <- pretty(range, nticks)
at <- at[at >= range[1] & at <= range[2]]
}
if (is.logical(labels)) {
if (labels)
labels <- format(at)
else labels <- NA
}
mpos <- matrix(NA, 3, length(at))
if (edge[1] == "+")
mpos[1, ] <- ranges$x[2]
else mpos[1, ] <- ranges$x[1]
if (edge[2] == "+")
mpos[2, ] <- ranges$y[2]
else mpos[2, ] <- ranges$y[1]
if (edge[3] == "+")
mpos[3, ] <- ranges$z[2]
else mpos[3, ] <- ranges$z[1]
ticksize <- ticksize * (mpos[, 1] - c(mean(ranges$x), mean(ranges$y),
mean(ranges$z)))
ticksize[coord] <- 0
if (!is.null(pos))
mpos <- matrix(pos, 3, length(at))
mpos[coord, ] <- at
x <- c(mpos[1, 1], mpos[1, length(at)])
y <- c(mpos[2, 1], mpos[2, length(at)])
z <- c(mpos[3, 1], mpos[3, length(at)])
if (tick) {
x <- c(x, as.double(rbind(mpos[1, ], mpos[1, ] + ticksize[1])))
y <- c(y, as.double(rbind(mpos[2, ], mpos[2, ] + ticksize[2])))
z <- c(z, as.double(rbind(mpos[3, ], mpos[3, ] + ticksize[3])))
}
result <- c(ticks = segments3d(x, y, z, ...))
if (!all(is.na(labels)))
result <- c(result, labels = text3d(mpos[1, ] + lab_dist * ticksize[1],
mpos[2, ] + lab_dist * ticksize[2],
mpos[3, ] + lab_dist * ticksize[3],
labels, ...))
lowlevel(result)
}
axis3