r - 将矩阵列表除以不同的矩阵集

Question

我有一个矩阵列表，我有几个不同的矩阵，我想将矩阵列表中的元素除以。我想按三组排列列表并计算最小值 jDate 之间的差值对于在 int1和 int2 ，如下图 n1 , n2 ，和 n3 .然后我想划分从这些值创建的矩阵 m1从列表中的矩阵之一。然后，我将向下移动到 int1 列表中的下一组三个元素。和 int2并计算它们之间的差异，并重复与第一组三个相同的过程。我该怎么做呢？

library(lubridate)
library(tidyverse)
date <- rep_len(seq(dmy("26-12-2010"), dmy("20-12-2013"), by = "days"), 500)
ID <- rep(seq(1, 5), 100)
df <- data.frame(date = date,
                 x = runif(length(date), min = 60000, max = 80000),
                 y = runif(length(date), min = 800000, max = 900000),
                 ID)

df$jDate <- julian(as.Date(df$date), origin = as.Date('1970-01-01'))
df$Month <- month(df$date)

t1 <- c(100,150,200)
t2 <- c(200,250,350)
t3 <- c(300,350, 400)
mat <- cbind(t1,t2, t3)

t1 <- c(150,150,200)
t2 <- c(250,250,350)
t3 <- c(350,350, 400)
mat2 <- cbind(t1,t2, t3)

l1 <- list(mat, mat2)

int1 <- df %>%
  # arrange(ID) %>%   # skipped for readability of result
  mutate(new = floor_date(date, '10 day')) %>%
  mutate(new = if_else(day(new) == 31, new - days(10), new)) %>% 
  group_by(ID, new) %>%
  filter(Month == "3") %>% 
  group_split()

int2 <- df %>%
  # arrange(ID) %>%   # skipped for readability of result
  mutate(new = floor_date(date, '10 day')) %>%
  mutate(new = if_else(day(new) == 31, new - days(10), new)) %>% 
  group_by(ID, new) %>%
  filter(Month == "2") %>% 
  group_split()

n1 <- c(((min(int1[[1]]$jDate))- min(int2[[1]]$jDate)),
        ((min(int1[[1]]$jDate))- min(int2[[2]]$jDate)),
        ((min(int1[[1]]$jDate))- min(int2[[3]]$jDate)))

n2 <- c(((min(int1[[2]]$jDate))- min(int2[[1]]$jDate)),
        ((min(int1[[2]]$jDate))- min(int2[[2]]$jDate)),
        ((min(int1[[2]]$jDate))- min(int2[[3]]$jDate)))

n3 <-  c(((min(int1[[3]]$jDate))- min(int2[[1]]$jDate)),
         ((min(int1[[3]]$jDate))- min(int2[[2]]$jDate)),
         ((min(int1[[3]]$jDate))- min(int2[[3]]$jDate)))
m1 <- cbind(n1,n2,n3)


l1[[1]]/m1

Answer 1

我们可以split list通过分组索引，基于 OP 创建的 matrix 创建一个函数('f1')来自这 3 个元素 list s，使用 map2来自 purrr循环遍历 split list ，

library(purrr)
g1 <- as.integer(gl(length(int1), 3, length(int1)))
f1 <- function(.int1 ,.int2) {

   n1 <- c(((min(.int1[[1]]$jDate))- min(.int2[[1]]$jDate)),
        ((min(.int1[[1]]$jDate))- min(.int2[[2]]$jDate)),
        ((min(.int1[[1]]$jDate))- min(.int2[[3]]$jDate)))

n2 <- c(((min(.int1[[2]]$jDate))- min(.int2[[1]]$jDate)),
        ((min(.int1[[2]]$jDate))- min(.int2[[2]]$jDate)),
        ((min(.int1[[2]]$jDate))- min(.int2[[3]]$jDate)))

n3 <-  c(((min(.int1[[3]]$jDate))- min(.int2[[1]]$jDate)),
         ((min(.int1[[3]]$jDate))- min(.int2[[2]]$jDate)),
         ((min(.int1[[3]]$jDate))- min(.int2[[3]]$jDate)))
out <- cbind(n1,n2,n3)
out}

应用该函数，然后将 'l1' 列表元素与 'lstMat' 的相应元素相除(此处可重现的示例显示了 'l1' 中的两个列表元素，因此我们对 'lstMat' ( [1:2] ) 进行子集化以进行除法

lstMat <- map2(split(int1, g1), split(int2, g1), ~  f1(.x, .y))
map2(l1, lstMat[1:2], `/`)
[[1]]
     t1        t2        t3
[1,]  4  5.714286  6.666667
[2,] 10 10.000000 10.000000
[3,] 40 23.333333 16.000000

[[2]]
       t1        t2       t3
[1,]  5.0  6.250000  7.00000
[2,]  7.5  8.333333  8.75000
[3,] 20.0 17.500000 13.33333

-首先检查 OP 的输出以应对第一种情况

l1[[1]]/m1
     t1        t2        t3
[1,]  4  5.714286  6.666667
[2,] 10 10.000000 10.000000
[3,] 40 23.333333 16.000000

可以通过使用 outer 进行简化来修改 OP 的函数包装 'f1'

f2 <- function(.int1, .int2) {
   t(outer(seq_along(.int1), seq_along(.int2), 
      FUN = Vectorize(function(i, j)  min(.int1[[i]]$jDate) - 
           min(.int2[[j]]$jDate))))
}

现在，尝试相同的代码来创建“lstMat”

lstMat <- map2(split(int1, g1), split(int2, g1), f2)
 map2(l1, lstMat[1:2], `/`)
[[1]]
     t1        t2        t3
[1,]  4  5.714286  6.666667
[2,] 10 10.000000 10.000000
[3,] 40 23.333333 16.000000

[[2]]
       t1        t2       t3
[1,]  5.0  6.250000  7.00000
[2,]  7.5  8.333333  8.75000
[3,] 20.0 17.500000 13.33333