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

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 从这 3 个元素 lists，使用 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

OP 的函数 wrapped 'f1' 可以通过 outer

简化来修改

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

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

Dividing a list of matrices by different sets of matrices

r

matrix

lubridate

tidyverse