элегантный способ зациклить функцию для матрицы перехода в 2 измерениях в R - PullRequest
1 голос
/ 11 марта 2012

Представьте, что у меня есть функция, которая дает вероятность перехода из состояния {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 loop

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) )))) 

работает более эффективно, но возвращает объект неправильной формы.Превращение внешнего применения в лапы, а затем выполнение cbind для его элементов исправляет это, но кажется очень грубым.

Ответы [ 2 ]

3 голосов
/ 11 марта 2012

Вот дикий выстрел в темноте. Я надеюсь, что это полезно:

#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
0 голосов
/ 11 марта 2012

Это создает матрицу переходов, в которой вероятность перехода из одного состояния в другое определяется как '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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...