在R中以2维方式循环转换矩阵的函数的优雅方法

时间:2012-03-11 03:07:48

标签: r loops

想象一下,我有一个函数可以提供从状态{x,y}到状态{X,Y}的转换概率:transition <- function(x,y,X,Y)

想象一下,x值可以假设一组离散点x_grid上的值,y假设y_grid中的离散值,我想计算所有可能的转换,例如填写为这样的2D矩阵:

      X1Y1 X2Y1 X3Y1 X1Y2 .... X3Y3 
x1,y1
x2,y1
x3,y1
x1,y2
x2,y2
x3,y2
...
x3,y3

在R中循环我的函数以生成此矩阵的最简单方法是什么?

使用for循环的繁琐方法

x_grid <- 1:3
y_grid <- 1:3

## dummy function
transition <- function(x,y,X,Y)
    x == X && y == Y

nx <- length(x_grid)
ny <- length(y_grid)
T <- matrix(NA, ncol = nx * ny, nrow = nx * ny)
for(i in 1:nx)
  for(j in 1:ny)
    for(k in 1:nx)
      for(l in 1:ny)
        T[i+(j-1)*ny, k+(l-1)*ny] <- 
          transition(x_grid[i], y_grid[j], x_grid[k], y_grid[l])

当然,在R中有更高效,更优雅的方式吗?

例如,

sapply(x_grid, function(x) 
  sapply(y_grid, function(y) 
   sapply(x_grid, function(X) 
     sapply(y_grid, function(Y) 
       transition(x,y,X,Y) )))) 

工作效率更高但返回错误形状的对象。将最外面的应用变成一个lapply,然后对它进行cbind的元素纠正这一点,但感觉非常粗糙。

2 个答案:

答案 0 :(得分:3)

这是在黑暗中的狂野镜头。我希望它有用:

#Some simple data grid points
d <- expand.grid(1:3,1:3,1:3,1:3)
#Trivial function
f <- function(x,y,X,Y){x*y*X*Y}
#Wrap mapply in matrix; fills by column by default
matrix(mapply(f,d$Var1,d$Var2,d$Var3,d$Var4),nrow = 9)
      [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
 [1,]    1    2    3    2    4    6    3    6    9
 [2,]    2    4    6    4    8   12    6   12   18
 [3,]    3    6    9    6   12   18    9   18   27
 [4,]    2    4    6    4    8   12    6   12   18
 [5,]    4    8   12    8   16   24   12   24   36
 [6,]    6   12   18   12   24   36   18   36   54
 [7,]    3    6    9    6   12   18    9   18   27
 [8,]    6   12   18   12   24   36   18   36   54
 [9,]    9   18   27   18   36   54   27   54   81

答案 1 :(得分:0)

这创建了一个转换矩阵,其中从一个状态到另一个状态的概率被定义为“prob”,然后将这些概率分配给数据集。但我不确定这是否符合您的要求。

set.seed(1234)

tran <- expand.grid(x1  = c(1, 2, 3), y1  = c(1, 2, 3),
                    x2  = c(1, 2, 3), y2  = c(1, 2, 3))

lin.prob <- -1.75 - 1.18 * ((tran[,1] - tran[,3])^2 + 
                            (tran[,2] - tran[,4])^2) ^ 0.5

e <- exp(1)

prob <- e^lin.prob / (1+e^lin.prob)

tran <- cbind(tran, prob)
colnames(tran) = c("x1","y1","x2","y2", "transition.prob")



nsites <- 25

x1sites <- ceiling(runif(nsites, 0, 3))
y1sites <- ceiling(runif(nsites, 0, 3))
x2sites <- ceiling(runif(nsites, 0, 3))
y2sites <- ceiling(runif(nsites, 0, 3))
site    <- seq(1:nsites)

sites <- cbind(site, x1sites, y1sites, x2sites, y2sites)
colnames(sites) = c("site", "x1","y1","x2","y2")


my.data <- merge(sites, tran, 

by.x = c("x1", "y1", "x2", "y2"),    
by.y = c("x1", "y1", "x2", "y2"), 

all = F, sort=F )

my.data=my.data[order(my.data$site),]
my.data