2014 dxdy logo

Научный форум dxdy

Математика, Физика, Computer Science, Machine Learning, LaTeX, Механика и Техника, Химия,
Биология и Медицина, Экономика и Финансовая Математика, Гуманитарные науки




Начать новую тему Ответить на тему
 
 Извлечение данных из вложенного списка в R
Сообщение08.03.2022, 20:51 


17/03/20
183
Добрый вечер, уважаемые форумчане! Есть вопрос, который не могу уже решить в теччение 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

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

 Профиль  
                  
 
 Re: Извлечение данных из вложенного списка в R
Сообщение08.03.2022, 21:45 


09/05/16
138
Вы правильно решили использовать 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.

 Профиль  
                  
 
 Re: Извлечение данных из вложенного списка в R
Сообщение08.03.2022, 22:20 


17/03/20
183
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.

 Профиль  
                  
 
 Re: Извлечение данных из вложенного списка в R
Сообщение09.03.2022, 15:32 


17/03/20
183
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)


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

 Профиль  
                  
 
 Re: Извлечение данных из вложенного списка в R
Сообщение09.03.2022, 20:25 


09/05/16
138
Alm99 в сообщении #1550044 писал(а):
здесь мне надо будет считать нормы нескольких типов скорее всего, потому я и обратился к функции norm

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

Alm99 в сообщении #1550089 писал(а):
Не могу понять, почему на выходе пустой список...


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

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

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

 Профиль  
                  
 
 Re: Извлечение данных из вложенного списка в R
Сообщение09.03.2022, 22:39 


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

 Профиль  
                  
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 6 ] 

Модераторы: Karan, Toucan, PAV, maxal, Супермодераторы



Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group