Не могу освободить память с помощью knitr - PullRequest
0 голосов
/ 10 сентября 2018

У меня проблема с knitr, когда я могу без проблем запустить код в консоли, но не хватает памяти, когда я вяжу документ. Документ по уценке похож на

---
title: "xyz"
output: 
  html_document: 
    toc: true
date: "`r format(Sys.time(), '%d %B, %Y')`"
author: Me
bibliography: ../ref.bib
---
```{r setup, include = FALSE, cache = FALSE}
options(width = 100, digits = 3, scipen = 8)
knitr::opts_chunk$set(
  error = FALSE, cache = FALSE, 
  cache.path = "some-path-cache/", fig.path = "some-path-fig/", 
  warnings = TRUE, message = TRUE, dpi = 128, cache.lazy = FALSE)
```

[некоторый код]

```{r load_dat}
big_dat <- func_to_get_big_dat()
some_subset <- func_to_get_subset()
```

[некоторый код, в котором используются big_dat и some_subset, некоторые объекты назначаются, а некоторые впоследствии удаляются с помощью rm]

```{r reduce_mem}
dat_fit <- big_dat[some_subset, ]
rm(big_dat)
```
```{r log_to_show}
sink("some-log-file")
print(gc())
print(sapply(ls(), function(x) paste0(class(get(x)), collapse = ";")))
print(sort(sapply(ls(), function(x) object.size(get(x)))))
sink()
```
```{r some_chunk_that_requires_a_lot_of_memory, cache = 1}
...
```

Когда я вяжу документ, используя knitr, мне не хватает памяти в some_chunk_that_requires_a_lot_of_memory, а содержание some-log-file равно

            used (Mb) gc trigger (Mb)  max used (Mb)
Ncells   3220059  172    5684620  304   5684620  304
Vcells 581359200 4436 1217211123 9287 981188369 7486    
[output abbreviated (the other variables are "function"s, "character"s, and "matrix"s] 
     dat_fit          X1   some_subset     
"data.frame"   "integer"     "integer"
[output abbreviated]
     X1   some_subset     dat_fit 
5235568       5235568   591631352

так что объекты в .GlobalEnv далеки от сумм до 4436 МБ (объектов не так много, и они намного меньше, чем 50 МБ каждый). Запуск кода в консоли не приводит к каким-либо проблемам, а print(gc()) показывает гораздо меньшую цифру.

Мои вопросы

  1. Могу ли я сделать что-нибудь, чтобы выяснить, почему я использую гораздо больше памяти при вязании документа? Очевидно, что где-то должны быть назначены некоторые объекты, которые занимают много места. Могу ли я найти все назначенные объекты и проверить их размер?
  2. У вас есть предложение, почему gc освобождает меньше памяти, когда я вяжу документ? Где-нибудь, где knitr назначает какой-либо объект, который может занимать много памяти?

Набор данных является частной собственностью, и я попытался, но не смог сделать небольшой пример, где я могу воспроизвести результат. Как примечание, я кеширую некоторый вывод от некоторых блоков между load_dat и reduce_mem. Я использую cache.lazy = FALSE, чтобы избежать этой проблемы . Вот мой sessionInfo

library(knitr)
sessionInfo()
#R R version 3.4.2 (2017-09-28)
#R Platform: x86_64-w64-mingw32/x64 (64-bit)
#R Running under: Windows 7 x64 (build 7601) Service Pack 1
#R 
#R Matrix products: default
#R 
#R locale:
#R [1] LC_COLLATE=English_United States.1252  LC_CTYPE=English_United States.1252    LC_MONETARY=English_United States.1252
#R [4] LC_NUMERIC=C                           LC_TIME=English_United States.1252    
#R 
#R attached base packages:
#R [1] stats     graphics  grDevices utils     datasets  methods   base     
#R 
#R other attached packages:
#R [1] knitr_1.17
#R 
#R loaded via a namespace (and not attached):
#R [1] compiler_3.4.2 tools_3.4.2    yaml_2.1.16 

По вопросу 1.

Я также добавил следующее к блоку log_to_show, чтобы выяснить, есть ли в сеансе объекты в других средах, которые занимают много места

# function to check if `this_env` is in `l`
is_env_in_list <- function(l, this_env){
  for(i in l)
    if(identical(i, this_env))
      return(TRUE)

  FALSE
}

# remove duplicates for environments 
remove_dup_envs <- function(objs){
  do_drop <- logical(length(objs))
  for(j in rev(seq_along(objs))){
    for(i in seq_len(j - 1L)){
      if(identical(objs[[i]], objs[[j]])){
        do_drop[j] <- TRUE
        break
      }
    }
  }
  objs[!do_drop]
}

# attempt to write function to get all unique environments 
get_env <- function(this_env = .GlobalEnv, out = NULL, only_new = FALSE){
  if(is_env_in_list(out, this_env))
    return(if(only_new) NULL else out)

  if(identical(this_env, emptyenv()))
    return(if(only_new) NULL else out)
  new. <- this_env # not emptyenv or in list so we add it

  # add parent env
  p_env <- parent.env(this_env)
  if(!is_env_in_list(out, p_env))
    new. <- c(new., get_env(p_env, out, only_new  = only_new))

  # look through assigned objects, find enviroments and add these
  objs <- lapply(ls(envir = this_env), function(x){
    o <- try(get(x, envir = this_env), silent = TRUE)
    if(inherits(o, "try-error"))
      NULL
    o
  })
  objs <- lapply(objs, function(x){
    if(is.function(x) && !is.null(environment(x)))
      return(environment(x))
    x
  })
  if(length(objs) == 0)
    return(if(only_new) new. else remove_dup_envs(c(new., out)))

  is_env <- which(sapply(objs, is.environment))
  if(length(is_env) == 0)
    return(if(only_new) new. else remove_dup_envs(c(new., out)))

  objs <- remove_dup_envs(objs[is_env])
  keep <- which(!sapply(objs, is_env_in_list, l = c(new., out)))
  if(length(keep) == 0L)
    return(if(only_new) new. else c(new., out))

  objs <- objs[keep]
  for(o in objs){
    ass_envs <- get_env(o, out = c(new., out), only_new = TRUE)
    new. <- c(new., ass_envs)
  }

  return(if(only_new) new. else remove_dup_envs(c(new., out)))
}

tmp <- get_env(asNamespace("knitr"))
names(tmp) <- sapply(tmp, environmentName)
print(tmp <- tmp[order(names(tmp))])
out <- lapply(tmp, function(x){
  o <- sapply(ls(envir = x), function(z){
    r <- try(object.size(get(z, envir = x)), silent = TRUE)
    if(inherits(r, "try-error"))
      return(0)
    r
  })
  if(length(o) == 0L)
    return(NULL)
  tail(sort(o))
})
max_val <- sapply(out, max)
keep <- which(max_val > 10^7)
out <- out[keep]
max_val <- max_val[keep]
tmp <- tmp[keep]

ord <- order(max_val)
print(tmp <- tmp[ord])
print(out <- out[ord])

На нем нет объектов размером больше dat_fit.

...