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

Question

我有一个矩阵列表，并且我有几个不同的矩阵，我想用它们来划分矩阵列表中的元素。我想按三组遍历列表，并计算 int1 和 int2 中的最小 jDate 之间的差异，如下所示对于 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

我们可以通过分组索引分割列表，根据OP创建矩阵的函数('f1')这 3 个元素 list，使用 purrr 中的 map2 循环遍历 split lists，

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