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

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

我们可以通过分组索引splitlist，根据OP从这三个元素lists创建matrix创建一个函数（'f1'），使用map2来自@987654327 @ 循环遍历 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