Fixing mismatched matrices-CodePudding

I have a data set df that has been split into int1 and int2. In int1andint2, there is two elements for the IDA and three elements for theID` B.

My goal is to create a 2x2 matrix for ID A and 3x3 for ID B, and have it divided from my example list of matrices l1. Currently, my code is creating a 3x3 matrix for ID A and 2x2 matrix for ID B using a combination of the product from g1 and f2 using map2() resulting to lstmat.

Any suggestions on how I can get the desired output of a 2x2 matrix for ID A and 3x3 matrix for ID B?

Example data:

library(lubridate)
library(tidyverse)
date <- rep_len(seq(dmy("26-12-2010"), dmy("20-12-2011"), by = "days"), 500)
ID <- rep(c("A","B"), 5000)
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)
df$year <- year(df$date)

t1 <- c(100,150)
t2 <- c(200,250)
mat <- cbind(t1,t2)

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

names(int1) <- sapply(int1, function(x) paste(x$ID[1], 
                                             sep = '_'))
names(int2) <- sapply(int2, function(x) paste(x$ID[1], 
                                              sep = '_'))
int1 <- int1[-1]
int2 <- int2[-1]

Any suggestions for changes to this code for the desired result? :

g1 <- as.integer(gl(length(int1), 3, length(int1)))

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 <- map2(split(int1, g1), split(int2, g1), f2)
map2(l1, lstMat, `/`)

CodePudding user response：

As the 'int1', 'int2' have duplicated names, split on the names instead of creating a grouping index with gl

lstMat <- map2(split(int1, names(int1)), split(int2, names(int2)), f2)
map2(l1, lstMat, `/`)

-output

[[1]]
           t1       t2
[1,] 3.571429 5.263158
[2,] 8.333333 8.928571

[[2]]
            t1        t2        t3
[1,]  5.357143  6.578947  7.291667
[2,]  8.333333  8.928571  9.210526
[3,] 25.000000 19.444444 14.285714