Извлечение данных из вложенного списка в R

[Alm99]

Добрый вечер, уважаемые форумчане! Есть вопрос, который не могу уже решить в теччение 4 дней. Суть проблемы заключается в следующем.
У меня есть некоторые датафреймы q1[[i]] и q2[[i]] содержащие некоторые $(i = 19)$ списки. Например (это часть данных):

Используется синтаксис Perl

q1
[[1]]
  [1] 240.13777778 273.73777778 172.73555556  53.70444444 141.80000000 582.93333333 
[[2]]
 [1] 2.409867e+02 2.731156e+02 1.680622e+02 5.300222e+01 5.112444e+01 1.048476e+03
...
q2
[[1]]
  [1]  70.29000000  69.57666667  48.82000000  22.19000000  31.44666667 143.34000000 
[[2]]
 [1]  70.2066667  69.5533333  47.9766667  22.0866667  14.0000000 270.3766667
 

Я хочу создать список, который будет содержать следующие блоки:

Используется синтаксис Perl

qw1
[[1]]
  [1] 240.13777778
  [1]  70.29000000
[[1]]
  [2] 273.73777778
  [2]  69.57666667

qw2
[[2]]
  [1] 2.409867e+02
  [1]  70.2066667
[[2]]
  [2] 2.731156e+02
  [2]  69.5533333
...
 

и рассчитать норму для каждого блока (например для qw2):

Используется синтаксис Perl

qw2
[[2]]
  [1] 2.409867e+02   -> norm
  [1]  70.2066667
...
[[2]]
  [2] 2.731156e+02   -> norm
  [2]  69.5533333
 

и создаю новый список норм для построения графиков(19 списков должно получиться, поскольку $i = 19$). Я пытаюсь создать тот же список, но получаю только последний список (т.е. для 19 файла) норм:

Используется синтаксис Perl

for (i in 1:19){
  q1[[i]] <- dfL_F[[assemble_normal[i]]]/0.000450
  q2[[i]] <- dfL_RMF[[assemble_normal[i]]]/0.000300
  q3[[i]] <- dfL_D[[assemble_normal[i]]]/0.001800
  q4[[i]] <- dfL_RMD[[assemble_normal[i]]]/0.001200
  
  length(q1[[i]])
  length(q2[[i]])
  length(q3[[i]])
  length(q4[[i]])
  qw1 <- lapply(q1[[i]], `[[`, 1)
  qw2 <- lapply(q2[[i]], `[[`, 1)
  qw3 <- lapply(q3[[i]], `[[`, 1)
  qw4 <- lapply(q4[[i]], `[[`, 1)
  
  nn <- list()
  for (j in 1:length(q1[[i]])){
    nn[[j]] <- c(qw1[j],qw2[j],qw3[j],qw4[j])
  }
  
  qnorm1 <- list()
  for (k in 1:length(nn)){
    qnorm1[[k]] <- norm(do.call(rbind, lapply(nn[k], as.numeric)),type = "i")    
  }
}
 

И я не знаю, как получить 19 списков по два поля для каждого списка q1[[i]] и q2[[i]] (на самом деле в блоке 4 поля, но для примера приведено два), которые образуют блок, должна быть такая длина блоков (q1[[i]]) для каждого i (length (q1[[i]]) equal length(q2[[i]]))?

Я попробовал использовать такую конструкцию (однако, как опять же сформировать правильные 19 списков норм для каждого блока, т.е. список состоит из такиз блоков), но не получил необходимого результата:

Используется синтаксис Perl

list2env(
  setNames(
    Map(function(x, y) apply(rbind(x, y), 2, function(v) norm(t(v)), simplify = FALSE), q1, q2),
    c("qw1", "qw2")
  ),
  envir = .GlobalEnv
)
 

Полный код скрипта представлен ниже. Так же я прикреплю примеры файлов исходников (ссылка), откуда извлекаются данные.

Используется синтаксис Perl

library(RColorBrewer)
library(stringr)
library(pracma)


# function get data from out files for molecular params
get.tables <- function(lines) { 
   start_tbl <- grep('^ +Item', lines)
   end_tbl <- grep('^ +Predicted', lines)
   stopifnot(length(start_tbl) == length(end_tbl))

   lapply(seq_along(start_tbl), function(i) {
      read.table( 
         text = lines[start_tbl[i]:(end_tbl[i]-1)],
         row.names = NULL, check.names = FALSE
                )
   })
}


# function get data from out files for energy and steps
get.done <- function(lines) {
   t(simplify2array(Map(function(x) as.numeric(x[2:3]),
      Filter(length, regmatches(lines, regexec(
         '^ *SCF Done: *E\\([^)]*\\) *= *([\\d.-]+) *A.U. *after *(\\d+) *cycles *$',
         lines, perl = TRUE
      )))
   )))
}


# get lines and tables from out files
my_fl <- list.files(pattern = ".*.out")
my_fl_s <- (str_sort(my_fl, numeric = TRUE))
df_out <- list()
for (i in seq_along(my_fl)) {
    df_out[[i]] <- readLines(my_fl_s[i])
}


# convert extracted data to dataframes and vectors (list)
dfL_F <- list()
dfL_RMF <- list()
dfL_D <- list()
dfL_RMD <- list()

for (j in seq_along(my_fl_s)){

dfL_F[[j]] <- sapply( get.tables(df_out[[j]]),
function(x) subset(x, row.names == 'Maximum' & Item == 'Force')$Value)

dfL_RMF[[j]] <- sapply( get.tables(df_out[[j]]),
function(x) subset(x, row.names == 'RMS' & Item == 'Force')$Value)

dfL_D[[j]] <- sapply( get.tables(df_out[[j]]),
function(x) subset(x, row.names == 'Maximum' & Item == 'Displacement')$Value)

dfL_RMD[[j]] <- sapply( get.tables(df_out[[j]]),
function(x) subset(x, row.names == 'RMS' & Item == 'Displacement')$Value)
}

dfQ_steps <- list()
dfQ_energy <- list()
for (i in seq_along(my_fl_s)){
dfQ_steps[[i]] <- get.done(df_out[[i]])[,2]
dfQ_energy[[i]] <- get.done(df_out[[i]])[,1]
}

# numbers of *.out files success and abnormal termination
assemble_normal <- c(2,3,10,11,14,16,17,26,27,28,30,31,33,34,35,38,43,45,49) # nums of normal termination
assemble_abnormal <- c(1,4,5,6,7,8,9,12,13,15,18,19,20,21,22,23,24,25,29,32,36,37,39,40,41,42,44,46,47,48) # nums of abnormal termination


#### simple plotting for convergence (use n last steps) ####
par(las = 1)
plot(0, 0, xlim = c(0, 32), ylim = c(0,0.01),xlab = 'Steps of iteration', ylab = '')
for (i in 1:19){
lines(movavg(dfL_F[[assemble_normal[i]]][1:length(dfL_F[[assemble_normal[i]]])],3,type = "m"),
type= "o",pch=16,lwd=0.4, lty=3, xlab = 'Steps of iteration', ylab = '',cex = 0.6,
col = "darkblue")
abline(h=c(0.000450), lwd=2, lty=1, col="red")
mtext("MAX F A.U.", col = "black", adj=-0.05, padj=-0.1, cex=0.8)
grid(nx = NULL, ny = NULL,lty = 2, col = "gray", lwd = 1)
title(main = "CONVERGE vs Steps of iteration",sub = "Moving average,size window - 3")
}


#### simple calculate and plotting for ACF and CCF fucntions for each iterate (choose type for graph covar/corr) ####
par(las = 4)
plot(0, 0, xlim = c(0, 100),xlab = '', ylab = ' ', main = "ACF MAX F")
q <- acf(dfL_F[[assemble1[i]]], type = "covariance",main = "ACF F" )
for (i in 1:19){ 
plot(q,type= "o",pch=16,lwd=0.4, lty=3,col = "black",main = "ACF MAX F NO CONVERGE" )
grid(nx = NULL, ny = NULL,lty = 2, col = "gray", lwd = 1)
}


#### plotting energy convergence -- energy values with norm L2 ####
en <- list()
windows()
par(mar = rep(2, 4))
par(mfrow = c(5, 4))
par(las = 1)
# plot(0, 0, xlim = c(0, 120),ylim = c(-0.5,-0.05),xlab = ' ', ylab = '')
for (i in 1:19){
  en[[i]] <- dfQ_energy[[assemble_normal[i]]]/norm(dfQ_energy[[assemble_normal[i]]], type = "2")
  plot(c(1:length(en[[i]])),en[[i]],type= "o",pch=16,lwd=0.4, lty=3, 
       xlab = ' ', ylab = '',
       col = "darkblue")
  mtext("Energy A.U.", col = "black", adj=-0.05, padj=-0.1, cex=0.8)
  grid(nx = NULL, ny = NULL,lty = 2, col = "gray", lwd = 1)
  title(main = "CONVERGE vs Steps of iteration")
}

q1 <- list()
q2 <- list()
q3 <- list()
q4 <- list()

for (i in 1:19){
  q1[[i]] <- dfL_F[[assemble_normal[i]]]/0.000450
  q2[[i]] <- dfL_RMF[[assemble_normal[i]]]/0.000300
  q3[[i]] <- dfL_D[[assemble_normal[i]]]/0.001800
  q4[[i]] <- dfL_RMD[[assemble_normal[i]]]/0.001200
  
  length(q1[[i]])
  length(q2[[i]])
  length(q3[[i]])
  length(q4[[i]])
  qw1 <- lapply(q1[[i]], `[[`, 1)
  qw2 <- lapply(q2[[i]], `[[`, 1)
  qw3 <- lapply(q3[[i]], `[[`, 1)
  qw4 <- lapply(q4[[i]], `[[`, 1)
  
  nn <- list()
  for (j in 1:length(q1[[i]])){
    nn[[j]] <- c(qw1[j],qw2[j],qw3[j],qw4[j])
  }
  
  qnorm1 <- list()
  for (k in 1:length(nn)){
    qnorm1[[k]] <- norm(do.call(rbind, lapply(nn[k], as.numeric)),type = "i")    
  }
}
 

https://drive.google.com/file/d/1jkUX920XMpdrjX7FHmTJMBJqtrKPMoVK/view?usp=sharing

Может есть идеи, как в данном случае взаимодействовать в случае такой вложенности списков? Заранее, выражаю огромную благодарность!

[aitap]

Вы правильно решили использовать Map. Для перебора каждого элемента группы списков он подходит идеально:

# Ваш пример
q1 <- list(
   c(240.13777778, 273.73777778, 172.73555556, 53.70444444, 141.80000000, 582.93333333),
   c(2.409867e+02, 2.731156e+02, 1.680622e+02, 5.300222e+01, 5.112444e+01, 1.048476e+03)
)
q2 <- list(
   c(70.29000000, 69.57666667, 48.82000000, 22.19000000, 31.44666667, 143.34000000),
   c(70.2066667, 69.5533333, 47.9766667, 22.0866667, 14.0000000, 270.3766667)
)
stopifnot(length(q1) == length(q2))
qw <- Map(
   function(q1i, q2i) {
      stopifnot(length(q1i) == length(q2i))
      Map(c, q1i, q2i) # j-й элемент i-го блока - пары q1[[i]][j], q2[[i]][j]
   },
   q1, q2 # каждый блок содержит элементы q1[[i]], q2[[i]]
)
# список qw содержит блоки qw1, qw2

Если все списки имеют одинаковый размер, а также все вектора внутри списков (а иначе как строить блоки?), возможно, проще будет работать с многомерным массивом вместо вложенного списка:

# превратить каждый список в матрицу; объединить матрицы в куб данных
q <- sapply(list(q1, q2), simplify2array, simplify = 'array')

Тогда, например, третья пара блока qw2 - это q[3,2,], а нормы их можно посчитать при помощи apply с MARGIN = 1:2.

[Alm99]

aitap
А если q1,q2,q3,q4 имеем, то функция map также сработает? просто для случая 4 параметров здесь будет условие:

stopifnot(length(q1) == length(q2)== length(q3)== length(q4))

-- 08.03.2022, 23:05 --

aitap в сообщении #1550042 писал(а):

а нормы их можно посчитать при помощи apply с MARGIN 1:2.

Ну здесь мне надо будет считать нормы нескольких типов скорее всего, потому я и обратился к функции norm.

[Alm99]

aitap
Спасибо огромное за помощь и объяснение работы функции! Но есть такой момент: дял вычисления нормы для каждого i-го блока qw[[i]][j] данная функция не сработает:

qnorm11 <- Map(
  function(qw1, qw2, qw3, qw4) 
  {
    Map(c, (norm(as.matrix(unlist(qw1),type = "1"))), 
        (norm(as.matrix(unlist(qw2),type = "1"))), 
        (norm(as.matrix(unlist(qw3),type = "1"))), 
        (norm(as.matrix(unlist(qw4),type = "1"))))
  }, qw1, qw2, qw3, qw4)

Не могу понять, почему на выходе пустой список...

[aitap]

Alm99 в сообщении #1550044 писал(а):

здесь мне надо будет считать нормы нескольких типов скорее всего, потому я и обратился к функции norm

Одно другому не мешает, apply как раз подходит для того, чтобы запускать разные функции от срезов многомерных массивов.

Alm99 в сообщении #1550089 писал(а):

Не могу понять, почему на выходе пустой список...

Аргументы Map являются списками, содержащими элементы разных блоков, вызывать от них norm не стоит: нормы индивидуальных блоков в результате не получатся. Вам нужны нормы каждого элемента списка, который возвращает Map. Добиться этого можно двумя способами:

• Вместо c передать функцию, которая делает norm() от того, что возвращает c(...). (На языке функционального программирования это называется function composition, и на CRAN есть пакеты, которые позволяют сказать "дай мне композицию c и norm", но ничто не мешает сделать это и вручную.)
• Возвращаемое Map значение (напомню, это список блоков, от каждого из которых мы хотим посчитать норму) пропустить через lapply(FUN = norm), чтобы он от каждого элемента списка вызвал функцию norm.

Возня с древовидными структурами - это не очень удобно. Я думаю, что если собрать их в многомерный массив и работать с его срезами, дело пойдёт веселее.

[Alm99]

aitap
Спасибо Вам огромное, метод lapply(FUN = norm) работает! Очень долго возился с этим!