-
Notifications
You must be signed in to change notification settings - Fork 0
/
consSTR_Results.Rmd
executable file
·3464 lines (2862 loc) · 156 KB
/
consSTR_Results.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
---
title: 'Memory consolidation promotes structured representation of visual objects'
author:
- name: "Taehoon Kim, Halim Jang, Seonhwa Park, Ghootae Kim"
affiliation: "Deep Memory Lab, Cognitive Science Research Group, Korea Brain Research Institute"
date: "`r Sys.Date()`"
output:
html_document:
code_folding: hide
highlight: tango
number_sections: true
theme: cosmo
toc: true
toc_depth: 5
toc_float:
collapse: false
smooth_scroll: false
pdf_document:
toc: true
toc_depth: 5
subtitle: Memory consolidation & Structured Representation - 10mm roi version, lr anova
mainfont: Noto Sans CJK K
editor_options:
chunk_output_type: console
---
<br><br>
# Abstract
<br>
Although objects in our daily experiences have high complexity, we recognize them easily. For this efficient object recognition, our brain needs to represent structures of visual objects: the brain needs to parse objects into essential constituents and identify their relationships. How does the brain represent structures? Based on memory consolidation theories, we tested a hypothesis that the visual cortex gets to represent structures of visual objects through a consolidation period using an fMRI study. In the first phase, participants were exposed to syllables made of a combination of two different artificial letters (GA = G +A, DO = D + O). In the second session, LOC activation patterns were recorded while participants were exposed to new syllables made of a novel combination of the familiar letters (GO, DA). Lastly, we collected LOC activation patterns of the individual letters (O, G, D, A). Crucially, there was a week delay between the first and the second phases for the consolidation condition, while the control condition had no such delay. Consistent with our hypothesis, we found a greater LOC activation level for the syllables of the consolidation vs. the control condition. More importantly, activation patterns for syllables of the consolidation condition were better explained by the patterns of their constituent letters compared to the control condition. These results support the hypothesis that the visual cortex figures out structures of visual objects through a consolidation process. More interestingly, our study suggests that the structured representation is the basis of efficient comprehension of novel experiences.
<Br>
Keywords: Structured representation, object recognition, memory consolidation, fMRI
<br>
***
<br>
# Results
<br>
```{r, echo=FALSE}
rm(list=ls())
#getwd()
setwd("/Users/taehoonkim/Desktop/Workspace/git_project/consSTR_R_raw/")
options(scipen=4)
```
```{css, echo=FALSE}
pre code, pre, code {
white-space: pre !important;
overflow-x: scroll !important;
word-break: keep-all !important;
word-wrap: initial !important;
}
```
```{r setup, message=FALSE}
set.seed(12345) # for reproducibility
options(knitr.kable.NA = '')
# install // load packages
# Some packages need to be loaded.
# We use `pacman` as a package manager, which takes care of the other packages.
if (!require("distill", quietly = TRUE)) install.packages("distill")
if (!require("devtools", quietly = TRUE)) install.packages("devtools")
if (!require("papaja", quietly = TRUE)) devtools::install_github("crsh/papaja")
if (!require("patchwork", quietly = TRUE)) devtools::install_github("thomasp85/patchwork")
if (!require("klippy", quietly = TRUE)) devtools::install_github("RLesur/klippy")
if (!require("pacman", quietly = TRUE)) install.packages("pacman")
if (!require("Rmisc", quietly = TRUE)) install.packages("Rmisc")
if (!require("rstatix", quietly = TRUE)) install.packages("rstatix")
if (!require("effsize", quietly = TRUE)) install.packages("effsize")
if (!require("lsr", quietly = TRUE)) install.packages("lsr")
if (!require("effectsize", quietly = TRUE)) install.packages("effectsize")
if (!require("ggbeeswarm", quietly = TRUE)) install.packages("ggbeeswarm") # Never load it directly.
pacman::p_load(tidyverse, papaja, knitr, dplyr, car, psych, afex, lme4, lmerTest,
emmeans, ggplot2, ggpubr, lattice, latticeExtra, parallel,
effects, psycho, caret, sjPlot, ppcor, rstatix)
library("patchwork"); library("klippy")
klippy::klippy()
```
<br>
**참가자**. 인근 지역 대학에서 모집된 정상 시력의 성인 26명이 연구에 참여하였다. 2명의 참가자가 실험 도중 취소로 인해 제외되어 24명의 참가자(13명 여성, 오른손잡이, 연령 M = 23.83, SD = 3.31)의 데이터가 분석에 포함되었다.
<br>
**물체 자극**. 본 연구에서는 물체에 대한 구조적 지식을 추출하는 통합 과정을 통해 새로운 객체의 구조화된 표상이 촉진되는지 여부를 검증하고자 하였다. Consolidation을 통한 새로운 지식 형성에 의한 구조화된 표상의 효과를 검증하기 위해서는 사전 지식이 없는 낯선 물체들을 사용해야 한다. 또한 구조화된 표상의 형성을 살펴보기 위해서는 대상 물체 자극이 대상을 구성하는 구성요소로 명확하게 분해될 수 있어야 한다. 따라서 [옴니글롯의 인공문자/알파벳](https://omniglot.com/)을 참고하여 참가자들에게 친숙하지 않은 요소 자극들을 구성하였다. 그리고 이러한 요소 자극을 조합하여 대상 자극을 생성하였다.
<br>
이러한 작업을 통해 5개의 요소 범주, 각 범주 내 12개의 요소 자극이 구성되었다. 물체 자극은 각 범주의 12개 요소들을 2개씩 조합하여 구성하였다. 구체적으로 두 개의 요소 자극을 수평적으로 결합하여 하나의 물체처럼 보이게 하여 조합을 생성하였으며, 하나의 오브젝트를 구성하는 요소들이 서로 겹치지 않도록 하였다. 이를 통해 각 범주 내에서 12개의 요소로 총 66개의 대상 물체 자극(12C2)을 생성하였다. 5개 범주 중 4개는 행동 학습 과제 및 fMRI 스캔 단계의 신경 패턴 측정에서 대상 범주로 사용되었으며 나머지는 스캔 단계에서 1-백 캐치 시도에 대한 물체 자극으로 활용되었다.
<br>
목표 자극 범주 4개 각각에서 요소의 결합을 만들어진 66개의 물체 자극은 33개씩 구분되어 2개의 자극 세트를 구성하였다 두 자극 세트에 할당된 물체 자극들의 정체성은 서로 달랐으나, 물체를 구성하는 각 요소 자극은 5번 또는 6번씩 나누어져 유사하게 등장하도록 설정하였다. 예를 들어, 1번 요소를 기준으로, 1번 요소와 2~12번 요소들이 각각 결합하여 총 11개의 물체 자극이 만들어질 수 있다. 이 중 1번 요소가세트 1에5개, 세트 2에 6개가 할당되어 각 세트에서 요소들이 노출되는 빈도를 유사하게 맞추었다. 유사하게 2번 요소에서도 11개의 물체 자극이 구성되며 11개의 물체 자극도 세트 1에 6개, 세트 2에 5개를 할당하여 요소들이 노출되는 빈도를 유사하게 맞추었다. 이 때, 1번 요소와 2번 요소가 결합되어 생성된 물체 자극이 각 세트 내에 이미 존재할 수 있으며, 이 경우 이 자극이 어떤 세트에 미리 할당되었는지를 고려하여 새로운 자극을 할당하였다. 이러한 과정을 통해 12 개 요소 중 1번 세트에서 총 5번씩 노출되는 요소가 6개, 6번씩 노출되는 요소가 6개 있도록 물체 자극을 할당하였으며, 어떤 요소가 각 세트에 몇 번씩 할당되는지는 전체 참가자에 걸쳐 무선화되었다. 결과적으로 목표 범주인 4개 물체 범주 자극에서 각각 33개의 물체로 이루어진 2개의 자극 세트(세트 1과 세트 2)가 만들어졌다.
<br>
<br>
**실험 절차**. 실험은 2개의 공고화 조건(Consolidated vs. Immediate)을 요인으로 한 Within-subject Design으로 진행하였다. Consolidation의 효과를 검증하기 위한 일반적인 실험 패러다임을 따라 5일 간격으로 2일에 걸쳐 진행하였다.
<br>
절차는 아래 그림과 같다: Session 1 - 1st learning (행동, Objects, Consolidated); Session 2 - 1st learning (행동, Objects, Immediate), 2nd learning (In scanner, New objects, Consolidated & Immediate), Snapshot (In scanner, Constituents, Consolidated & Immediate) 단계, LOC localizer (In scanner, Object vs. Scrambled)
<br>
<br>
## Behavioral Results
<br>
1일차 1st learing과 2일차 1st learning은 할당된 물체 자극을 제외하고는 동일한 절차로 수행되었다. 1일차 학습이 진행된 후 5일이 지난 뒤 2일차 학습 및 스캔 단계가 진행하여 1일차에 학습한 물체들이 충분히 공고화 될 수 있도록 유도하고자 하였다. 학습의 목적은 참가자들에게 각 범주의 물체 자극들을 반복적으로 노출시켜 물체 자극들에 대해 친숙해지도록 하는 것이었다. 이를 통해 물체들을 이루는 요소와 그 요소들 간의 결합 관계를 자연스럽게 학습할 수 있도록 하고, 그 과정이 휴지기의 유무에 따라 달라지는지 검증하여 공고화의 효과를 확인하고자 하였다.
<br>
두 학습 단계에서 자극 할당은 다음과 같이 이루어졌다. 참가자 내에서 공고화 조건을 조작하기 위해 4개의 물체 범주 자극을 2개씩 구분하였다. 그리고 2개씩 구분된 범주 각각에서 첫 번째 자극 세트(물체 33개)를 1일차 및 2일차 학습 단계에 각각 할당하였다. 예를 들어, 1일차 학습 단계에 1번과 2번 자극 범주의 첫 번째 세트(물체 33개)가 할당됨에 따라 총 66개의 1일차 물체 자극이 구성되었다. 2일차 학습 단계에는 동일하게 3번과 4번 자극 범주의 첫 번째 세트가 할당되어 66개의 2일차 물체 자극이 구성되었다. 결과적으로 Consolidated 조건의 물체 범주 자극과 Immediate 조건의 물체 범주 자극이 구성되었다. 각 일차에 어떤 자극 범주들이 할당되는지는 참가자에 걸쳐 역균형화 하였다.
<br>
참가자들이 물체와 범주를 주의 깊게 학습하고, 충분히 친숙해질 수 있도록 하기 위해 피드백 기반 범주 판단 과제를 5번 반복 수행하였다. 구체적으로, 66개의 물체를 하나씩 보면서 이 물체가 해당 일차에 할당된 두 가지 범주 중 어떤 범주에 속하는지 구분하도록 하였다.
<br>
각 시행은 0.5초의 응시점으로 시작하였다. 이어서 물체 자극 1개와 범주를 지칭하는 선택지 2개를 4초간 제시되었고 참가자는 4초의 시간 내에서 해당 물체가 어떤 범주에 속하는지 판단하였다. 4초가 모두 지나면 참가자의 반응이 맞았는지 틀렸는지 여부와 해당 물체가 실제로 어떤 범주에 속하는지를 1.5초간 피드백으로 제공되었다. 0.5초의 빈 화면 이후 다음 시행 시작되었다.
<br>
이러한 절차로 2개 범주의 66개의 물체를 보여주어 66개의 시행이 구성되었으며, 참가자들은 이 과제를 총 5번 반복 수행하였다. 결과적으로, 66개의 물체에 대한 범주 판단을 총 5 블록으로 반복 수행되었다. 블록 간 휴식 시간 부여되었으며 모든 절차에는 약 1시간의 시간이 소요되었다. 참가자들이 각 범주와 물체를 잘 학습하였는지 확인하기위해 참가자들의 범주 판단 정확률과 반응 시간을 측정하였다.
<br>
### Feedback-based Learning - Session 1 & 2
<br>
```{r, collapse=TRUE}
b1d1 <- read.csv("data/b1d1_v1.csv", header = T)
b1d2 <- read.csv("data/b1d2_v1.csv", header = T)
b1 <- rbind(b1d1, b1d2)
# check number of trials for each condition/sn
table(b1$sn)
table(b1$cL_num, b1$sn)
# change class of main factors: double to factor
b1$sn = factor(b1$sn)
b1$task = factor(b1$task)
b1$cCons = factor(b1$cCons, levels=c(1,2), labels=c("cons","imm"))
b1$cL_num = factor(b1$cL_num)
b1$cL_num = factor(b1$cL_num)
b1$dIm_Name = factor(b1$dIm_Name)
b1$dComp1 = factor(b1$dComp1)
b1$dComp2 = factor(b1$dComp2)
b1$dCorr <- as.numeric(b1$dCorr==1)
b1 <- b1 %>% dplyr::select(sn, task, blk, cCons, cL_num, cL_num, cSet, dIm_Name, dComp1, dComp2, cCat, dResp, dRt, dCorr)
headTail(b1)
glimpse(b1, width = 70)
length(unique(b1$sn))
```
<br>
#### RT analysis
<br>
1일차 1st learing과 2일차 1st learning에서 참가자 들의 반복 학습에 따라 반응 시간이 빨라지는지 분석하였다. 분석에는 올바르게 반응한 시행만 포함되었다. 자동적 반응(<200ms)과 과도하게 늦은 반응(>10000ms)을 제거하였고, 평균으로부터 +-3SD를 넘는 시행을 가외치로 판단하여 제거하였다. 아래에 두 조건과 블록 반복에 따른 반응시간 변화를 요약하였다.
<br>
```{r, collapse=TRUE}
cb1 <- b1 %>% filter(dCorr == 1) # filter(dCorr == 1) # remove incorrect trial
# check accuracy
100-100*(nrow(cb1)/nrow(b1))
# 0.00% indCorrect trials were not analyzed
# trimming 3sd outlier trials
tb1 <- cb1
tb1 <- cb1 %>% filter(dRt > .200 & dRt < 10.000) %>%
group_by(sn) %>% # grouping by padRticipants
nest() %>%
mutate(lbound = map(data, ~mean(.$dRt)-3*sd(.$dRt)),
ubound = map(data, ~mean(.$dRt)+3*sd(.$dRt))) %>% # make new data (3sd cut)
unnest(c(lbound, ubound))%>%
unnest(data) %>%
mutate(Outlier = (dRt < lbound)|(dRt > ubound)) %>% # set outlier
filter(Outlier == FALSE) %>% # filtering outlier
ungroup() %>%
dplyr::select(sn, task, blk, cCons, cL_num, cL_num, cSet, dIm_Name, dComp1, dComp2, cCat, dResp, dRt, dCorr) # select variables to analyze
# outlier trial ratio
100-100*(nrow(tb1)/nrow(cb1))
# mean number of trials for each conditions
tb1 %>% group_by(sn, cCons, cL_num) %>%
dplyr::summarise(NumTrial = length(dRt)) %>%
ungroup() %>%
group_by(cCons, cL_num) %>%
dplyr::summarise(Mean = mean(NumTrial),
Median = median(NumTrial),
Min = min(NumTrial),
Max = max(NumTrial)) %>%
ungroup %>%
kable(digits=2)
# check Distribution
# before trimming
den1 <- ggplot(cb1, aes(x=dRt)) +
geom_density() +
theme_bw(base_size = 18) +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
# after trimming
den2 <- ggplot(tb1, aes(x=dRt)) +
geom_density() +
theme_bw(base_size = 18) +
labs(x = "Trimmed dRt") +
theme(panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.text.y = element_blank(),
axis.ticks.y = element_blank())
den1 + den2
# subject-level, long format
b1dRtL <- tb1 %>% group_by(sn, cCons, blk) %>%
dplyr::summarise(dRt = mean(dRt)) %>%
ungroup()
# b1dRtL %>% kable(digits=2)
# subject-level, wide format (sn/Btw/cL_num)
b1dRtW <- b1dRtL %>% spread(key=cCons, value = dRt)
# b1dRtW %>% kable(digits=2)
# summary table: grand mean (eyerep/locrep)
b1dRtG <- b1dRtL %>% group_by(cCons, blk) %>%
dplyr::summarise(dRt.m = mean(dRt), dRt.sd = sd(dRt)) %>%
ungroup()
b1dRtG$dRt.se <- Rmisc::summarySEwithin(data = b1dRtL, measurevar = "dRt",
idvar = "sn", withinvars = c("cCons", "blk"))$se
b1dRtG$dRt.ci <- Rmisc::summarySEwithin(data = b1dRtL, measurevar = "dRt",
idvar = "sn", withinvars = c("cCons", "blk"))$ci
b1dRtG <- b1dRtG %>%
mutate(lower.ci = dRt.m-dRt.ci,
upper.ci = dRt.m+dRt.ci)
b1dRtG %>% dplyr::select(cCons, blk, dRt.m) %>%
spread(key=blk, value=dRt.m) %>% kable(digits=2)
b1dRtG %>% kable(digits=2)
```
#### Accuracy analysis
<br>
1일차 1st learing과 2일차 1st learning에서 참가자 들의 반복 학습에 따라 정확도가 향상되는지 분석하였다. 아래에 두 조건과 블록 반복에 따른 정확도 변화를 요약하였다.
<br>
```{r, collapse=TRUE}
b1acc.sn <- b1 %>% filter(blk>=4) %>% group_by(sn) %>%
dplyr::summarise(Acc = mean(dCorr)*100) %>%
ungroup()
# b1acc.sn %>% spread(sn, Acc) %>% kable(digits=2)
# subject-level, long format (sn/Btw/cL_num)
b1accL <- b1 %>% group_by(sn, blk, cCons) %>%
dplyr::summarise(Acc = mean(dCorr)*100) %>%
ungroup()
# b1accL %>% kable(digits=2)
# subject-level, wide format (sn/Btw/cL_num)
b1accW1 <- b1accL %>% spread(key=cCons, value = Acc)
# b1accW1 %>% kable(digits=2)
# summary table: grand mean (eyerep/locrep)
b1accG <- b1accL %>% group_by(cCons, blk) %>%
dplyr::summarise(Acc.m = mean(Acc), Acc.sd = sd(Acc)) %>%
ungroup()
b1accG$Acc.se <- Rmisc::summarySEwithin(data = b1accL, measurevar = "Acc",
idvar = "sn", withinvars = c("cCons","blk"))$se
b1accG$Acc.ci <- Rmisc::summarySEwithin(data = b1accL, measurevar = "Acc",
idvar = "sn", withinvars = c("cCons","blk"))$ci
b1accG <- b1accG %>%
mutate(lower.ci = Acc.m-Acc.ci,
upper.ci = Acc.m+Acc.ci)
# for between-subject design. check help(summarySE)
b1accG %>% dplyr::select(cCons, blk, Acc.m) %>%
spread(key=blk, value=Acc.m) %>%
kable(digits=2)
b1accG %>% kable(digits=2)
```
<br>
#### Plot
<Br>
두 조건의 블록 반복에 따른 반응 시간 & 정확도 변화를 그래프로 나타내었다. 두 조건 모두 블록 반복에 따라 학습이 잘 진행되어 반응 시간이 빨라지고 정확도가 향상되었다. 마지막 블록에서 두 조건 간 차이는 관찰되지 않았다.
<br>
```{r, fig.width= 14, fig.height=6}
# values = c("#F17402", "#2C57AA")
# values = c("darkred", "darkblue")
b1.dRt.plot0 <- ggplot(b1dRtG, mapping=aes(x=blk, y=dRt.m, group=cCons)) +
geom_ribbon(b1dRtG, mapping=aes(ymin=lower.ci, ymax=upper.ci, fill=cCons), alpha=0.3) +
geom_line(b1dRtG, mapping=aes(x=blk, y=dRt.m, colour=cCons), size = 2, show.legend = F) +
scale_fill_manual(values = c("#F17402", "#2C57AA"), labels = c("Consolidated","Immediate")) +
scale_color_manual(values = c("#F17402", "#2C57AA")) + # "#feb24c", "#91bfdb"
coord_cartesian(ylim = c(1, 2), clip = "on") +
labs(x = "Block", y = "Response Time (s)", fill="Condition") +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
# strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="top")
b1.acc.plot0 <- ggplot(b1accG, mapping=aes(x=blk, y=Acc.m, group=cCons)) +
geom_ribbon(b1accG, mapping=aes(ymin=lower.ci, ymax=upper.ci, fill=cCons), alpha=0.3) +
geom_line(b1accG, mapping=aes(x=blk, y=Acc.m, colour=cCons), size = 2, show.legend = F) +
scale_fill_manual(values = c("#F17402", "#2C57AA"), labels = c("Consolidated","Immediate")) +
scale_color_manual(values = c("#F17402", "#2C57AA")) + # "#feb24c", "#91bfdb"
coord_cartesian(ylim = c(50, 100), clip = "on") +
labs(x = "Block", y = "Accuracy (%)", fill="Condition") +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
# strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="top")
# b1.acc.plot0
fig1_1.behav <- ggarrange(b1.dRt.plot0, b1.acc.plot0)
fig1_1.behav
# plot-control 1
#ggsave("s.fig.1.jpg", plot = fig1_1.behav, width=8, height=5, unit='in', dpi=600)
```
<br>
```{r, fig.width= 14, fig.height=6}
# values = c("#E1812B", "#3173A1")
b1dRtL.1 <- b1dRtL %>% filter(blk==5)
b1dRtG.1 <- b1dRtG %>% filter(blk==5)
b1dRtW.1 <- b1dRtW %>% filter(blk==5)
b1.dRt.plot0.1 <- ggplot(data=b1dRtL.1, aes(x=cCons, y=dRt, fill=cCons)) +
stat_summary(fun = mean, geom = "bar", position="dodge", na.rm = TRUE, alpha = .9,
width = 0.8, size = 0.3, color='black') + # , show.legend = FALSE, colour="black",
# geom_pointrange(data=b1dRtG.1, aes(x = cCons, y=dRt.m, ymin = dRt.m-dRt.ci, ymax = dRt.m+dRt.ci),
# position = position_dodge(0.80), color = "darkred", size = 1, show.legend = FALSE) +
geom_segment(data=filter(b1dRtW.1), inherit.aes = FALSE,
aes(x=1, y=filter(b1dRtW.1)$cons,
xend=2, yend=filter(b1dRtW.1)$imm),
color="gray90", alpha = .7) +
geom_point(data=b1dRtL.1, aes(x=cCons, y=dRt, fill=cCons),
position=position_dodge(width = 0.8),
size=2, show.legend = FALSE, color="gray80") + # ,
geom_errorbar(data=b1dRtG.1, aes(x=cCons, y=dRt.m, ymin=lower.ci, ymax=upper.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_x_discrete(labels=c("Consolidated", "Immediate")) +
scale_fill_manual(values = c("#F17402", "#2C57AA"),
labels = c("Consolidated", "Immediate")) +
coord_cartesian(ylim = c(0, 3), clip = "on") +
labs(x = "Condition", y = "Block 5 Response Time (s)", fill ="Condition") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
# strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="top")
# b1.dRt.plot0.1
b1accL.1 <- b1accL %>% filter(blk==5)
b1accG.1 <- b1accG %>% filter(blk==5)
b1accW1.1 <- b1accW1 %>% filter(blk==5)
b1.acc.plot0.1 <- ggplot(data=b1accL.1, aes(x=cCons, y=Acc, fill=cCons)) +
stat_summary(fun = mean, geom = "bar", position="dodge", na.rm = TRUE, alpha = .9,
width = 0.8, size = 0.3, color='black') +
geom_segment(data=filter(b1accW1.1), inherit.aes = FALSE,
aes(x=1, y=filter(b1accW1.1)$cons,
xend=2, yend=filter(b1accW1.1)$imm),
color="gray90", alpha = .7) +
geom_point(data=b1accL.1, aes(x=cCons, y=Acc, fill=cCons),
position=position_dodge(width = 0.8),
size=2, show.legend = FALSE, color="gray80") + # ,
geom_errorbar(data=b1accG.1, aes(x=cCons, y=Acc.m, ymin=lower.ci, ymax=upper.ci), width=.2,
position=position_dodge(.8), color = "black") +
scale_x_discrete(labels=c("Consolidated", "Immediate")) +
scale_fill_manual(values = c("#F17402", "#2C57AA"),
labels = c("Consolidated", "Immediate")) +
coord_cartesian(ylim = c(25, 100), clip = "on") +
labs(x = "Condition", y = "Block 5 Accuracy (s)", fill ="Condition") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
# strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="top")
# b1.acc.plot0.1
fig1_2.behav <- ggarrange(b1.dRt.plot0.1, b1.acc.plot0.1)
fig1_2.behav
# plot-control 2
# ggsave("s.fig.2.jpg", plot = fig1_2.behav, width=8, height=5, unit='in', dpi=600)
```
<br>
#### Statistic Inference
<br>
두 조건의 블록 반복에 따른 반응 시간 & 정확도 변화를 통계 분석 하였다.
<br>
##### RT ANOVA
<br>
마지막 블록에서 두 조건 간 반응 시간 차이는 유의하지 않았다.
<br>
```{r, echo=T}
b1dRtL.tmp <- b1dRtL %>% filter(blk == 5)
b1dRt.aov1 <- aov_ez(id="sn", dv="dRt", data = b1dRtL.tmp, within = c("cCons"))
# summary(r1.aov1)
nice(b1dRt.aov1, es="pes") %>% kable(digits=2)
```
<br>
```{r, echo=T}
b1dRt.aov1.m1 <- emmeans(b1dRt.aov1 , pairwise ~ cCons, adjust = "bon", infer = c(TRUE, TRUE)) # adjust="bon" , "tukey", "none"
a = summary(b1dRt.aov1.m1$contrasts)
b = t_to_d(t= a$t.ratio, df_error = a$df, paired = T) %>% dplyr::select(d)
cbind(a,b) %>% dplyr::select(contrast, estimate, lower.CL, upper.CL, df, t.ratio, p.value, d) %>% kable(digits=3)
p_h1 <- b1dRtL.tmp %>% rstatix::pairwise_t_test(dRt ~ cCons,
p.adjust.method="bonferroni",
paired=T, detailed=T) %>%
dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- b1dRtL.tmp %>% rstatix::cohens_d(dRt ~ cCons, paired=T, ci = ) %>%
dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)
```
<br>
##### Accuracy ANOVA
<br>
마지막 블록에서 두 조건 간 정확도 차이는 유의하지 않았다.
<br>
```{r, echo=T}
b1accL.tmp <- b1accL %>% filter(blk == 5)
b1acc.aov1 <- aov_ez(id="sn", dv="Acc", data = b1accL.tmp, within = c("cCons"))
# summary(r1.aov1)
nice(b1acc.aov1, es="pes") %>% kable(digits=2)
```
<br>
```{r, echo=T}
b1acc.aov1.m1 <- emmeans(b1acc.aov1, pairwise ~ cCons, adjust = "bon", infer = c(TRUE, TRUE)) # adjust="bon" , "tukey", "none"
a = summary(b1acc.aov1.m1$contrasts)
b = t_to_d(t= a$t.ratio, df_error = a$df, paired = T) %>% dplyr::select(d)
cbind(a,b) %>% dplyr::select(contrast, estimate, lower.CL, upper.CL, df, t.ratio, p.value, d) %>% kable(digits=3)
p_h1 <- b1accL.tmp%>% rstatix::pairwise_t_test(Acc ~ cCons,
p.adjust.method="bonferroni",
paired=T, detailed=T) %>%
dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- b1accL.tmp %>% rstatix::cohens_d(Acc ~ cCons, paired=T, ci = F) %>%
dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)
```
<br>
##### Category Accuracy
<Br>
본 실험에는 4개의 물체 범주가 사용되었다. 마지막 블록에서 물체 범주 간 학습 차이가 있는지 확인하기 위한 분석을 수행하였다.
<br>
```{r, collapse=TRUE}
b1acc.sn <- b1 %>% filter(blk==5) %>% group_by(sn, cL_num) %>%
dplyr::summarise(Acc = mean(dCorr)*100) %>%
ungroup()
# b1acc.sn %>% spread(cL_num, Acc) %>% kable(digits=2)
# subject-level, long format (sn/Btw/cL_num)
b1accL <- b1 %>% group_by(sn, blk, cL_num) %>%
dplyr::summarise(Acc = mean(dCorr)*100) %>%
ungroup()
# b1accL %>% kable(digits=2)
# subject-level, wide format (sn/Btw/cL_num)
b1accW1 <- b1accL %>% spread(key=cL_num, value = Acc)
# b1accW1 %>% kable(digits=2)
# summary table: grand mean (eyerep/locrep)
b1accG <- b1accL %>% group_by(cL_num, blk) %>%
dplyr::summarise(Acc.m = mean(Acc), Acc.sd = sd(Acc)) %>%
ungroup()
b1accG$Acc.se <- Rmisc::summarySEwithin(data = b1accL, measurevar = "Acc",
idvar = "sn", withinvars = c("cL_num","blk"))$se
b1accG$Acc.ci <- Rmisc::summarySEwithin(data = b1accL, measurevar = "Acc",
idvar = "sn", withinvars = c("cL_num","blk"))$ci
b1accG <- b1accG %>%
mutate(lower.ci = Acc.m-Acc.ci,
upper.ci = Acc.m+Acc.ci)
# for between-subject design. check help(summarySE)
b1accG %>% dplyr::select(cL_num, blk, Acc.m) %>%
spread(key=blk, value=Acc.m) %>%
kable(digits=2)
```
<br>
물체 범주 3이 다른 범주들보다 요약치 상에서 더 우수한 정확도를 보이긴 했으나 통계적 차이는 유의하지 않았다. 따라서 본 실험의 결과에 물체 범주 간 차이가 큰 영향을 줄 가능성은 적어보인다.
<br>
```{r, fig.width= 14, fig.height=6}
b1accL.1 <- b1accL %>% filter(blk==5)
b1accG.1 <- b1accG %>% filter(blk==5)
b1accW1.1 <- b1accW1 %>% filter(blk==5)
b1.acc.plot0.1 <- ggplot(data=b1accL.1, aes(x=cL_num, y=Acc, fill=cL_num)) +
stat_summary(fun = mean, geom = "bar", position="dodge", na.rm = TRUE, alpha = .9,
width = 0.8, size = 0.3, color='black') + # , show.legend = FALSE, colour="black",
geom_point(data=b1accL.1, aes(x=cL_num, y=Acc, fill=cL_num),
position=position_dodge(width = 0.8),
size=2, show.legend = FALSE, color="gray80") + # ,
geom_errorbar(data=b1accG.1, aes(x=cL_num, y=Acc.m, ymin=lower.ci, ymax=upper.ci), width=.2,
position=position_dodge(.8), color = "black") +
# geom_pointrange(data=b1accG.1, aes(x = cL_num, y=Acc.m, ymin = lower.ci, ymax = upper.ci),
# position = position_dodge(0.80), color = "darkred", size = 1, show.legend = FALSE) +
scale_x_discrete(labels=c("L1", "L2","L3", "L4")) +
scale_fill_manual(values = c("#D99694", "#FAC090", "#C3D69B", "#93CDDD"),
labels = c("L1", "L2","L3", "L4")) +
coord_cartesian(ylim = c(25, 100), clip = "on") +
labs(x = "Language", y = "Block 5 Accuracy (s)", fill ="Language") +
theme_bw(base_size = 18) +
theme(axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
# strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="top")
b1.acc.plot0.1
```
<br>
```{r, echo=T}
b1accL.tmp <- b1accL %>% filter(blk == 5)
b1acc.aov1 <- aov_ez(id="sn", dv="Acc", data = b1accL.tmp, within = c("cL_num"))
# summary(r1.aov1)
nice(b1acc.aov1, es="pes") %>% kable(digits=2)
```
<br>
```{r, echo=T}
b1acc.aov1.m1 <- emmeans(b1acc.aov1, pairwise ~ cL_num, adjust = "bon", infer = c(TRUE, TRUE)) # adjust="bon" , "tukey", "none"
a = summary(b1acc.aov1.m1$contrasts)
b = t_to_d(t= a$t.ratio, df_error = a$df, paired = T) %>% dplyr::select(d)
cbind(a,b) %>% dplyr::select(contrast, estimate, lower.CL, upper.CL, df, t.ratio, p.value, d) %>% kable(digits=3)
p_h1 <- b1accL.tmp%>% rstatix::pairwise_t_test(Acc ~ cL_num,
p.adjust.method="bonferroni",
paired=T, detailed=T) %>%
dplyr::select(group1, group2, estimate, conf.low, conf.high, df, statistic, p.adj, p.adj.signif)
p_h2 <- b1accL.tmp %>% rstatix::cohens_d(Acc ~ cL_num, paired=T, ci = F) %>%
dplyr::select(group1, group2, effsize, magnitude)
merge(p_h1, p_h2, by=c("group1", "group2")) %>% kable(digits=3)
```
<br>
****
<br>
## fMRI Results
<br>
Session 2의 Scan Phase로 2nd Learning, Snapshot, LOC localizer phase가 진행되었다.
<Br>
**2nd Learning Phase**의 목적은 1일차 및 2일차 학습과 공고화 과정을 걸쳐 이루어진 범주 물체에 대한 학습과 구조적 지식의 획득으로 동일 범주의 새로운 물체들에 대한 구조화된 표상을 할 수 있는지를 측정하고자 하는 것이었다. 이를 위해 2nd Learning Phase에서는 Session 1 & 2에서 학습한 물체들과 구성 요소는 동일하나 새롭게 결합된 New Objects 들이 제시되었다. 여기서 Session 1 1st Learning에서 학습한 물체 범주의 요소로 구성된 New objects는 Consolidated 조건이었고, Session 2 1st Learning에서 학습한 물체 범주의 요소로 구성된 New objects는 Immediate 조건이었다. 각 조건의 물체들은 event-related design과 block design이 결합된 mixed 디자인으로 제시되었다. 전체 과정에서 참가자들의 주의를 유지하기 위해 1-back task가 진행되었다. 단변량 분석을 위해 각 조건의 전반적인 신경 활성화 정도를 측정하였고, 다변량 패턴 분석을 위해 각 조건의 개별 물체에 대한 신경 패턴을 측정하였다.
<Br>
**Snapshot Phase**는 2nd Learning Phase에 제시된 물체들을 구성하는 Consituents 각각의 신경 패턴을 측정하기위해 수행되었다. Consolidated 조건과 Immediate 조건을 이루는 물체들을 구성하는 물체 범주의 요소 자극들이 event-related 디자인으로 제시되었다. 참가자들은 1-back task를 수행하였다. 마찬가지로 각 조건의 전반적인 신경 활성화 정도와 개별 요소들에 대한 신경 패턴을 측정하였다.
<br>
**LOC localizer Phase**의 목적은 물체 선택적 시각 영역인 LOC를 참가자별로 특정하기 위함이었다. intact 물체과 scrambled 물체가 블록 디자인으로 제시되었으며 참가자들은 1-back task를 수행하였다. 각 조건의 전반적인 신경활성화를 측정 후 조건 간 비교를 통해 시각 피질 내에서 LOC를 참가자별로 특정하였다. 아래의 주요 분석들의 핵심 ROI는 식별된 LOC였다.
<br>
수집된 fMRI 데이터는 단변량 분석과 다변량 분석을 위한 표준 절차를 통해 전처리되었다. 전처리 과정에 대한 자세한 내용은 생략한다. 전처리된 EPI 데이터는 MNI template brain으로 Registration 되었다. 이에 따라 모든 분석은 Standard Space에서 수행되었다.
<br>
**Regions of interest**는 물체의 구조화된 표현을 측정하기 위한 물체 선택적 시각 영역, 그리고 Consolidation과 Schema proecess와 관련된 내측두엽 영역, 내측 전두영역으로 설정되었다. 구체적으로, 물체 선택적 시각 영역으로는 앞선 Localizer를 통해 식별된 bilateral LOC가 설정 되었으며, Consolidation & Schema 관련으로는 Freesurfer로 식별된 Anterior - Posterior Hippocampus와 functional connectivity analysis로 식별된 mPFC 영역이 설정되었다.
<br>
실험의 주요 가설은 아래와 같다.
구체적으로, 기존 경험의 Consolidation를 통해 기존 물체에 대한 구조화된 지식이 획득됨에 따라 이와 요소나 결합 관계를 공유하는 새로운 물체에 대한 구조화된 표상이 가능케 될 것으로 예상하였다. 이에 따른 세 가지 하위 가설은 다음과 같다.
<br>
1) 물체에 대한 구조화된 표상으로 물체를 복합한 잡음 집합이 아닌 구조화된 물체로 지각함에 따른 Objectness 증가, 이에 따른 LOC 신경 반응 증가;
<br>
2) 물체에 대한 구조화된 표상으로 인해 물체에서 물체를 이루는 구성 요소가 더 뚜렷하게 표상, 이에 따라 물체 표상이 구성 요소의 표상으로 설명되는 정도가 증가;
<br>
3) 물체에 대한 구조화된 표상으로 물체 범주의 공통된 구성요소와 결합 관계가 더 효과적으로 표상, 이에 따라 동일한 요소와 결합 관계를 공유하는 물체 범주의 물체들간 신경 표상의 유사성이 증가;
<br>
아래에는 이 세 가지 가설을 검증하기 위한 세 가지 분석을 수행한 결과를 나타내었다.
<Br>
***
<br>
### Results 1 - Univariate Contrast
<br>
첫 번째 가설은 공고화로 대상에 대한 구조적 지식이 획득됨에 따라, 유사한 대상에 대한 구조화된 표상이 촉진되어 대상이 잡음 집합이 아닌 완결된 물체로 지각되는 objectness 가 증가하고, 결과적으로 LOC의 활성화 정도가 증가한다는 것이었다. 이를 검증하기 위해, 2nd learning phase에서 수집된 신경 데이터를 대상으로 Object-selective ROI인 LOC 의 신경 신호가 Consolidated 조건에서 Immediate 조건보다 더 크게 나타나는지 단변량 비교 분석을 수행하였다. 분석의 주요 ROI는 LOC, left LOC, right LOC 였고, 추가로 Posterior Hippocampus, Anterior Hippocampus, mPFC에서도 동일한 분석을 수행하였다.
<br>
```{r, collapse=TRUE}
r1p1 <- read.csv("data/r1_p1_sum.csv", header = T)
r1 <- r1p1
glimpse(r1, width = 70)
# subj : 참가자 번호
# cond : condtiion, consolidation vs. immediate
# roi : 관심 상위 영역. rloc vs. lvwfa
# z : 활성화 정도를 나타내는 z statistics
r1_l <- r1
r1_l$subj = factor(r1_l$subj)
# targ_roi<- c("loc", "lloc", "rloc",
# "pf", "lpf", "rpf",
# "lloc31", "rloc31",
# "v1", "v2", "v3", "v4",
# "bhpp", "lhpp", "rhpp", "la_hpp", "lp_hpp",
# "ra_hpp", "rp_hpp", "p_hpp", "a_hpp",
# "mpfc")
targ_roi<- c("loc", "lloc", "rloc",
"p_hpp", "a_hpp", "mpfc")
r1_l <- r1_l %>% filter(roi %in% targ_roi)
# r1_l <- r1_l %>% filter(subj!=99)
r1_l$cond = factor(r1_l$cond, levels=c("cons","imm"),labels=c("cons","imm"))
r1_l$roi = factor(r1_l$roi,
levels=c("loc", "lloc", "rloc",
"p_hpp", "a_hpp", "mpfc"),
labels=c("loc", "lloc", "rloc",
"p_hpp", "a_hpp", "mpfc"))
r1_l <- r1_l %>% dplyr::select(subj,roi,cond,z)
length(unique(r1_l$subj))
# check number of trials for each condition/subj
table(r1_l$subj)
table(r1_l$cond, r1_l$subj)
table(r1_l$roi, r1_l$subj)
```
<br>
각 ROI 에서 조건에 따른 신경 활성화 정도를 요약하였다.
<br>
```{r, collapse=TRUE}
# subject-level, long format
r1_allL <- r1_l %>% group_by(subj, roi, cond) %>%
dplyr::summarise(z=mean(z)) %>%
ungroup()
# r1_allL %>% kable(digits=2)
# subject-level, wide format
r1_allW <- r1_allL %>% spread(key=cond, value = z)
# r1_allW %>% kable(digits=2)
r1_allW1 <- r1_allL %>% spread(key=roi, value=z)
# r1_allW1 %>% kable(digits=2)
r1_allW2 <- r1_allL %>% spread(key=cond, value=z)
# r1_allW2 %>% filter(phase ==1, roi=="loc") %>% kable(digits=2)
# summary table: grand mean
r1_allG <- r1_allL %>% group_by(roi, cond) %>%
dplyr::summarise(z.m = mean(z), z.sd = sd(z)) %>%
ungroup()
r1_allG$z.se <- Rmisc::summarySEwithin(data = r1_allL, measurevar = "z",
idvar = "subj", withinvars = c("roi","cond"))$se
r1_allG$z.ci <- Rmisc::summarySEwithin(data = r1_allL, measurevar = "z",
idvar = "subj", withinvars = c("roi", "cond"))$ci
r1_allG <- r1_allG %>%
mutate(lower.ci = z.m-z.ci,
upper.ci = z.m+z.ci,
lower.se = z.m-z.se,
upper.se = z.m+z.se)
r1_allG %>% dplyr::select(roi, cond, z.m) %>%
spread(key=roi, value=z.m) %>% kable(digits=2)
```
<br>
```{r, fig.width= 14, fig.height=10}
# phase 1
targ_roi = c("loc")
r1_allL.p1 <- r1_allL %>% filter(roi %in% targ_roi)
r1_allW.p1 <- r1_allW %>% filter(roi %in% targ_roi)
r1_allG.p1 <- r1_allG %>% filter(roi %in% targ_roi)
r1.p1.all.plot1 <- ggplot(data=r1_allL.p1, aes(x=cond, y=z, fill=cond, shpae=cond)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, size = 0.3, color='black') +
# geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
facet_grid(.~roi, scales="free_x", space = "free",
labeller = labeller(roi = c("loc" = "LOC",
"lloc" = "left LOC",
"rloc" = "right LOC",
"pf" = "pF",
"lpf" = "left pF",
"rpf" = "right pF",
"lloc31" = "left LOC31",
"rloc31" = "right LOC31",
"v1" = "V1",
"v2" = "V2",
"v3" = "V3",
"v4" = "V4"))) +
# geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
# color = "black", alpha = 0.5, #position = "nudge",
# position = position_jitter(0.15),
# inherit.aes = TRUE, binwidth = 0.4) +
# geom_jitter(aes(x=cond, y=z, fill=cond,color = cond),
# position=position_jitter(0.1), cex=2
# ) +
geom_point(data=r1_allL.p1, aes(x=cond, y=z, fill=cond), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=filter(r1_allW.p1), inherit.aes = FALSE,
aes(x=1, y=filter(r1_allW.p1)$cons,
xend=2, yend=filter(r1_allW.p1)$imm),
color="gray90") +
geom_errorbar(data=r1_allG.p1, aes(x=cond, y= z.m, ymin=lower.se, ymax=upper.se), width=.2,
position=position_dodge(.8), color = "black") +
# geom_pointrange(data=r1_allG.p1, aes(x = cond, y=z.m, ymin = z.m-z.se, ymax = z.m+z.se),
# position = position_dodge(0.80), color = "darkred", size = 1, show.legend = FALSE) +
scale_x_discrete(labels=c("Cons","Imm")) +
scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Consolidated", "Immediate")) +
# scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
# labels = c("Consolidated", "Immediate")) +
coord_cartesian(ylim = c(0, 15), clip = "on") +
labs(x = "Condition", y = "Parameter Estimation (Z)") +
ggtitle("Objects") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
#ggsave("fig1_1.fmri.jpg", plot = r1.p1.all.plot1, width=4, height=6, unit='in', dpi=600)
r1.p1.all.plot1
targ_roi = c("lloc", "rloc")
r1_allL.p1 <- r1_allL %>% filter(roi %in% targ_roi)
r1_allW.p1 <- r1_allW %>% filter(roi %in% targ_roi)
r1_allG.p1 <- r1_allG %>% filter(roi %in% targ_roi)
r1.p1.all.plot2 <- ggplot(data=r1_allL.p1, aes(x=cond, y=z, fill=cond, shpae=cond)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, size = 0.3, color='black') +
# geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
facet_grid(.~roi, scales="free_x", space = "free",
labeller = labeller(roi = c("loc" = "LOC",
"lloc" = "left LOC",
"rloc" = "right LOC",
"pf" = "pF",
"lpf" = "left pF",
"rpf" = "right pF",
"lloc31" = "left LOC31",
"rloc31" = "right LOC31",
"v1" = "V1",
"v2" = "V2",
"v3" = "V3",
"v4" = "V4"))) +
# geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.5,
# color = "black", alpha = 0.5, #position = "nudge",
# position = position_jitter(0.15),
# inherit.aes = TRUE, binwidth = 0.4) +
# geom_jitter(aes(x=cond, y=z, fill=cond,color = cond),
# position=position_jitter(0.1), cex=2
# ) +
geom_point(data=r1_allL.p1, aes(x=cond, y=z, fill=cond), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=filter(r1_allW.p1), inherit.aes = FALSE,
aes(x=1, y=filter(r1_allW.p1)$cons,
xend=2, yend=filter(r1_allW.p1)$imm),
color="gray90") +
geom_errorbar(data=r1_allG.p1, aes(x=cond, y= z.m, ymin=lower.se, ymax=upper.se), width=.2,
position=position_dodge(.8), color = "black") +
# geom_pointrange(data=r1_allG.p1, aes(x = cond, y=z.m, ymin = z.m-z.se, ymax = z.m+z.se),
# position = position_dodge(0.80), color = "darkred", size = 1, show.legend = FALSE) +
scale_x_discrete(labels=c("Cons","Imm")) +
scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Consolidated", "Immediate")) +
# scale_color_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
# labels = c("Consolidated", "Immediate")) +
coord_cartesian(ylim = c(0, 15), clip = "on") +
labs(x = "Condition", y = "Parameter Estimation (Z)") +
ggtitle("Objects") +
theme_bw(base_size = 18) +
theme(axis.text.x=element_blank(),
axis.ticks.x=element_blank(),
axis.title = element_text(face = "bold", size = 16, color = "black"),
axis.text = element_text(face = "plain", hjust = 0.5, size = 15, color = "black"),
axis.line=element_line(),
strip.text.x = element_text(face = "plain", size = 15, color = "black"),
strip.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
panel.border = element_blank(),
panel.spacing=unit(1, "lines"),
plot.margin = margin(1, 0.3, 1, 0.3, "cm"),
legend.title = element_blank(),
legend.position="bottom")
r1.p1.all.plot2
targ_roi = c("p_hpp", "a_hpp", "mpfc")
r1_allL.p1 <- r1_allL %>% filter(roi %in% targ_roi)
r1_allW.p1 <- r1_allW %>% filter(roi %in% targ_roi)
r1_allG.p1 <- r1_allG %>% filter(roi %in% targ_roi)
r1.p1.all.plot2 <- ggplot(data=r1_allL.p1, aes(x=cond, y=z, fill=cond)) +
stat_summary(fun = mean, geom = "bar", position="dodge",
na.rm = TRUE, alpha = .9, width = 0.8, size = 0.3, color='black') +
geom_hline(yintercept=0, linetype='solid', color='black', alpha =1, size=1) +
facet_grid(.~roi, scales="free_x", space = "free",
labeller = labeller(roi = c("bhpp" = "HIP",
"lhpp" = "left\nHIP",
"rhpp" = "right\nHIP",
"a_hpp" = "anterior\nHIP",
"p_hpp" = "posterior\nHIP",
"la_hpp" = "l-a HIP",
"lp_hpp" = "l-p HIP",
"ra_hpp" = "r-a HIP",
"rp_hpp" = "r-p HIP",
"mpfc" = "mPFC"))) +
# geom_dotplot(binaxis = "y", stackdir = "center", stackratio = 0.7,
# color = "black", alpha = 0.5, position = "dodge",
# inherit.aes = TRUE, binwidth = 0.008) +
geom_point(data=r1_allL.p1, aes(x=cond, y=z, fill=cond), position = position_dodge(width=0.8),
size=2, show.legend=F, color="gray90") +
geom_segment(data=filter(r1_allW.p1), inherit.aes = FALSE,
aes(x=1, y=filter(r1_allW.p1)$cons,
xend=2, yend=filter(r1_allW.p1)$imm),
color="gray90") +
geom_errorbar(data=r1_allG.p1, aes(x=cond, y= z.m, ymin=lower.se, ymax=upper.se), width=.2,
position=position_dodge(.8), color = "black") +
# geom_pointrange(data=r1_allG.p1, aes(x = cond, y=z.m, ymin = z.m-z.se, ymax = z.m+z.se),
# position = position_dodge(0.80), color = "darkred", size = 1, show.legend = FALSE) +
scale_x_discrete(labels=c("Cons","Imm")) +
scale_fill_manual(values = c("#F17402", "#2C57AA"), # c("#F17402", "#2C57AA"), c("#feb24c", "#91bfdb")
labels = c("Consolidated", "Immediate")) +
# coord_cartesian(ylim = c(-5, 15), clip = "on") +
labs(x = "Condition", y = "Parameter Estimation (Z)") +
ggtitle("Objects") +
theme_bw(base_size = 18) +
theme(#axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank(),