Создайте несколько графиков в базе R с помощью функции цикла, затем объедините путем сопоставления групповых переменных - PullRequest
Новая
       8

Создайте несколько графиков в базе R с помощью функции цикла, затем объедините путем сопоставления групповых переменных

0 голосов
/ 23 июня 2018

У меня есть фрейм данных (ниже, мои извинения за подробный код, это моя первая попытка создания воспроизводимых случайных данных), который я хотел бы просмотреть и сгенерировать отдельные графики в базе R (в частности, этограммы) длядень каждого субъекта и видеоклип (например, subj-1 / day1 / clipB).После генерации n графиков я бы хотел объединить PDF для каждого subj, который включает все дни + клипы, и чтобы каждая строка соответствовала одному дню.Я не смог пройти мимо создания отдельных графиков, поэтому любая помощь будет принята с благодарностью!

Фрейм данных 

n <- 20000

library(stringi)

test <- as.data.frame(sprintf("%s", stri_rand_strings(n, 2, '[A-Z]')))

colnames(test)<-c("Subj")

test$Day <- sample(1:3, size=length(test$Subj), replace=TRUE)

test$Time <- sample(0:600, size=length(test$Subj), replace=TRUE)

test$Behavior <- as.factor(sample(c("peck", "eat", "drink", "fly", "sleep"), size = length(test$Time), replace=TRUE))

test$Vid_Clip <- sample(c("Clip_A", "Clip_B", "Clip_C"), size = length(test$Time), replace=TRUE)

Пример данных из фрейма данных: 

> head(test)
  Subj Day Time Behavior Vid_Clip
1   BX   1  257    drink   Clip_B
2   NP   2  206    sleep   Clip_B
3   ZF   1  278     peck   Clip_B
4   MF   2  391    sleep   Clip_A
5   VE   1  253      fly   Clip_C
6   ID   2  359      eat   Clip_C

После адаптации этого кода я могу успешно сгенерировать один график (по одному за раз):

Подмножество одного subj / day / clip: 

single_subj_day_clip <- test[test$Vid_Clip == "Clip_B" & test$Subj == "AA" & test$Day == 1,]

После этого я могу сгенерировать нужный мне график, запустив следующие строки: 

beh_numb <- nlevels(single_subj_day_clip$Behavior)

mar.default <- c(5,4,4,2) + 0.1
par(mar = mar.default + c(0, 4, 0, 0))
plot(single_subj_day_clip$Time, 
     xlim=c(0,max(single_subj_day_clip$Time)), ylim=c(0, beh_numb), type="n",
     ann=F, yaxt="n", frame.plot=F)

for (i in 1:length(single_subj_day_clip$Behavior))  {
  ytop <- as.numeric(single_subj_day_clip$Behavior[i])
  ybottom <- ytop - 0.5
  rect(xleft=single_subj_day_clip$Subj[i], xright=single_subj_day_clip$Time[i+1],
       ybottom=ybottom, ytop=ytop, col = ybottom)}

axis(side=2, at = (1:beh_numb -0.25), labels=levels(single_subj_day_clip$Behavior), las = 1) 
mtext(text="Time (sec)", side=1, line=3, las=1)

Пример графика случайной генерации данных (извините за ссылку - новый пользователь SO, так что пока я не наберу 10 очков репутации, я не могу встроить изображение напрямую)

Пример графика из фактических данных

Идеально для каждого графика графика

Спасибо всемзаранее для вашего ввода.

Ура, Дан

1 Ответ

0 голосов
/ 24 июня 2018

Новый и, надеюсь, правильный ответ

Код слишком длинный, чтобы разместить его здесь, поэтому есть ссылка на папку Dropbox с данными и кодом. Вы можете проверить этот HTML-документ или запустить этот .Rmd файл на своем компьютере. Пожалуйста, проверьте, установлены ли все необходимые пакеты. Есть выход скрипта.

Есть дополнительная проблема в анализе - некоторые события регистрируются только один раз, в один момент времени между другими событиями. Таким образом, нет "ширины" таких баров. Я назначил ширину таких событий 1000 мс, поэтому некоторые из них (около 100 на 20000 наблюдений) не соответствуют масштабу, если они находятся в начале или в конце эксперимента (и , если ширина для такие события равны нулю). Вы можете поиграть с кодом, чтобы исправить это поведение.

Другая проблема - это разные цвета для одних и тех же факторов на разных участках. Мне нужно немного свежего воздуха, чтобы исправить это.

Глядя на графики, вы можете заметить, что иногда кажется, что некоторые наблюдения с очень коротким временем совпадают с другими наблюдениями. Но если вы увеличите pdf до максимума - вы увидите, что это не так, и есть «дыры» в базовых интервалах, где они должны быть.

Линии, соединяющие интервалы для разных типов поведения, помогают следить за ходом эксперимента. Вы можете раскомментировать соответствующие части кода, если хотите.

Пожалуйста, дайте мне знать, если это работает.

Старый ответ

Я не уверен, что это лучший способ сделать это, но, вероятно, вы можете использовать split() и после этого lapply через ваши таблицы:

Разделите ваш data.frame на Subj, Day и Vid_clip: 

testl <- split(test, test[, c(1, 2, 5)], drop = T)

testl[[1123]]
#      Subj Day Time Behavior Vid_Clip
#8220    ST   2  303      fly   Clip_A
#9466    ST   2  463      fly   Clip_A
#9604    ST   2   32     peck   Clip_A
#10659   ST   2  136     peck   Clip_A
#13126   ST   2   47      fly   Clip_A
#14458   ST   2  544     peck   Clip_A

Прокрутите список с вашими данными и подготовьте график .pdf: 

mar.default <- c(5,4,4,2) + 0.1
par(mar = mar.default + c(0, 4, 0, 0))

nbeh = nlevels(test$Behavior)

pdf("plots.pdf")
invisible(
  lapply(testl, function(l){
    plot(x = l$Time, xlim = c(0, max(l$Time)), ylim = c(0, nbeh),
         type = "n", ann = F, yaxt = "n", frame.plot = F)
    lapply(1:nbeh, function(i){
      ytop <- as.numeric(l$Behavior[i]); ybot <- ytop - .5
      rect(l$Subj[i], ybot, l$Time[i + 1], ytop, col = ybot)
    })
    axis(side = 2, at = 1:nbeh - .25, labels = levels(l$Behavior), las = 1)
    mtext(text = "Time (sec)", side = 1, line = 3, las = 1)
  })
  )
dev.off()

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

...