-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathapp-deploy.R
1896 lines (1678 loc) · 89 KB
/
app-deploy.R
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
library(shiny)
library(shinyBS)
library(shinyjs)
library(shinyFeedback)
library(shinydashboard)
library(shinyWidgets)
library(waiter)
library(tidyverse)
library(lubridate)
library(viridis)
library(googledrive)
library(googlesheets4)
#----------------------------------------------------- SETTING UP
#----------------------------------------------------- Google Sheets
options(
# whenever there is one account token found, use the cached token
gargle_oauth_email = TRUE,
# specify auth tokens should be stored in a hidden directory ".secrets"
gargle_oauth_cache = "DIGIT SPAN/.secrets"
)
drive_auth()
gs4_auth()
# -------------- Creating GoogleSheets (Uncomment this section for the first time when these google sheets are not present to create them then comment it)
#gs4_create(name = "user_data", sheets = "main")
#gs4_create(name = "user_dig_seq", sheets = "main")
#gs4_create(name = "user_digit_click_time", sheets = "main")
#gs4_create(name = "user_restart_wrong", sheets = "main")
#----------------------------------------------------- END OF SETUP
# -------------- Get IDs
user_data_id <- drive_get("user_data")$id
user_dig_seq_id <- drive_get("user_dig_seq")$id
user_digit_click_time_id <- drive_get("user_digit_click_time")$id
user_restart_wrong_id <- drive_get("user_restart_wrong")$id
#----------------------------------------------------- Helpers
user_dig_seq <- tibble( # To store digit sequence
try = c(1, 2, 3)
)
user_dig_seq[,paste0("r",1:100)] = ""
user_restart_wrong_data <- tibble(
variable = c("n_restarts", "n_wrongs")
)
user_restart_wrong_data[,paste0("r",1:100)] <- 0
index_wrong <- rep(-1, 3*100) # index of each sequence starts from 1 assume
user_digit_click_time_data <- user_dig_seq %>%
gather(colnames(user_dig_seq)[2:ncol(user_dig_seq)], key = "rounds", value = "dig_seq") %>%
select(try, rounds)
user_digit_click_time_data[,paste0("c",1:102)] <- -1 # Here the c1 indicates the time difference(in secs) between guessing time start and a digit input(wrong/correct)
curr_user_data <- tibble(ID = 0, age = 0, sex = 0, educat = 0, job = 0, academic = 0, maths = 0, music = 0, env = 0)
#-------------------------------------------------- User Data/Info UI
educat_choices <- c(0, 1, 2, 3, 4)
educat_choices <- setNames(educat_choices, c("Still in school, below 12th Grade", "12th Grade", "Bachelors", "Masters", "PhD"))
job_choices <- c(0, 1, 2, 3)
job_choices <- setNames(job_choices, c("Academia", "Industry", "Business", "Not working yet"))
env_choices <- c(0, 1, 2, 3)
env_choices <- setNames(env_choices, c("Silent", "Normal", "Little Noisy", "Very Noisy"))
UserDataUI <- fluidPage(
titlePanel("YOUR INFO", "Digit Span Test"),
useShinyFeedback(),
numericInput("age", "Enter your Age", value = 19, min = 5, max = 100),
radioButtons("sex", "Gender", choiceNames = c("Male", "Female"), choiceValues = c(0, 1)),
selectInput("educat", "Education Qualification", choices = educat_choices, selected = 2),
bsTooltip("educat", "Select the one you are currently pursuing. If not in Academia, select the one last completed."),
selectInput("job", "Current Profession", choices = job_choices, selected = 0),
bsTooltip("job", "Select Academia if you are Student/Professor/Teacher/Researcher"),
sliderInput("academic", "Your Academic Performance", value = 3, min = 1, max = 5),
bsTooltip("academic", "1 indicating bad and 5 indicating excellent"),
radioButtons("maths", "Are you constantly in touch with Mathematics?", choiceNames = c("Yes", "No"), choiceValues = c(1, 0), selected = 1),
bsTooltip("maths", "Select yes, if your work or study heavily uses Mathematics"),
radioButtons("music", "Do you regularly play any Musical Intrument?", choiceNames = c("Yes", "No"), choiceValues = c(1, 0), selected = 0),
selectInput("env", "Current Environment", choices = env_choices),
bsTooltip("env", "Right now, what environment are you in?"),
fluidRow(
column(1, actionButton("start", "TAKE TEST")),
column(1, span(textOutput("start_ok"), style = "color:#2383cc"), offset = 4)
)
)
#------------------------------ Digit Pad UI
DigitPadUI <- fluidPage(
fluidRow(
column(12, align = "center",
actionButton("one", "1", style='padding-left:25px; padding-right:25px; font-size: 500%; margin: 25px'),
actionButton("two", "2", style='padding-left:25px; padding-right:25px; font-size:500%; margin: 25px'),
actionButton("three", "3", style='padding-left:25px; padding-right:25px; font-size:500%; margin: 25px')
)
),
fluidRow(
column(12, align = "center",
actionButton("four", "4", style='padding-left:25px; padding-right:25px; font-size:500%; margin: 25px'),
actionButton("five", "5", style='padding-left:25px; padding-right:25px; font-size:500%; margin: 25px'),
actionButton("six", "6", style='padding-left:25px; padding-right:25px; font-size:500%; margin: 25px')
)
),
fluidRow(
column(12, align = "center",
actionButton("seven", "7", style='padding-left:25px; padding-right:25px; font-size:500%; margin: 25px'),
actionButton("eight", "8", style='padding-left:25px; padding-right:25px; font-size:500%; margin: 25px'),
actionButton("nine", "9", style='padding-left:25px; padding-right:25px; font-size:500%; margin: 25px')
)
),
fluidRow(
column(12, align = "center",
actionButton("restart", "", icon = icon("sync"), style='padding-left:25px; padding-right:25px; font-size:400%; margin: 25px'),
actionButton("zero", "0", style='padding-left:25px; padding-right:25px; font-size:500%; margin: 25px'),
actionButton("next_correct", "", icon = icon("arrow-right"), style='padding-left:25px; padding-right:25px; font-size:400%; margin: 25px')
)
)
)
#--------------------------- Digit Pad Disable
disable_DigitPad <- function() {
disable("one");disable("two");disable("three");disable("four");disable("five");disable("six");disable("seven");disable("eight");disable("nine");disable("zero");disable("backspace");disable("next_correct")
updateActionButton(inputId = "one", label = "?");updateActionButton(inputId = "two", label = "?");updateActionButton(inputId = "three", label = "?");
updateActionButton(inputId = "four", label = "?");updateActionButton(inputId = "five", label = "?");updateActionButton(inputId = "six", label = "?");
updateActionButton(inputId = "seven", label = "?");updateActionButton(inputId = "eight", label = "?");updateActionButton(inputId = "nine", label = "?");
updateActionButton(inputId = "zero", label = "?");updateActionButton(inputId = "restart", icon = icon("question"));updateActionButton(inputId = "next_correct", icon = icon("question"))
}
#--------------------------- Digit Pad Enable
enable_DigitPad <- function() {
enable("one");enable("two");enable("three");enable("four");enable("five");enable("six");enable("seven");enable("eight");enable("nine");enable("zero");enable("backspace");enable("next_correct")
updateActionButton(inputId = "one", label = "1");updateActionButton(inputId = "two", label = "2");updateActionButton(inputId = "three", label = "3");
updateActionButton(inputId = "four", label = "4");updateActionButton(inputId = "five", label = "5");updateActionButton(inputId = "six", label = "6");
updateActionButton(inputId = "seven", label = "7");updateActionButton(inputId = "eight", label = "8");updateActionButton(inputId = "nine", label = "9");
updateActionButton(inputId = "zero", label = "0");updateActionButton(inputId = "restart", label = "", icon = icon("sync"));updateActionButton(inputId = "next_correct", label = "", icon = icon("arrow-right"));
}
wrong_input <- function(id, retry = TRUE) {
# updateActionButton(inputId = id, label = "X")
updateActionButton(inputId = "restart", icon = icon("times"))
if (retry) {
updateActionButton(inputId = "next_correct", icon = icon("redo"))
} else {
updateActionButton(inputId = "next_correct", icon = icon("flag-checkered"))
}
}
all_correct <- function() {
# updateActionButton(inputId = id, label = "O")
updateActionButton(inputId = "next_correct", icon = icon("check"))
}
# ------------------------ Concepts and Background UI
# ------------------------- Description & Explanation of the test and theory UI
SensDescTabUI <- tabPanel(
"What is Sensory Memory?",
value = "SensDesc",
h1("What is Sensory Memory?", align = "center", style = "font-weight: bold"),
p(
"During every moment of an organism's life, sensory information is being taken in by sensory receptors and processed by the nervous system. Sensory information is stored in sensory memory just long enough to be transferred to short-term memory. Humans have five traditional senses: sight, hearing, taste, smell, touch. Sensory memory (SM) allows individuals to retain impressions of sensory information after the original stimulus has ceased. A common demonstration of SM is a child's ability to write letters and make circles by twirling a sparkler at night. When the sparkler is spun fast enough, it appears to leave a trail which forms a continuous image. This 'light trail' is the image that is represented in the visual sensory store known as iconic memory. The other two types of SM that have been most extensively studied are echoic memory, and haptic memory.",
style = "font-size: 150%"
),
p(
"It is the first stage of the Modal Model.The SM do not process the information carried by the stimulus, but rather detect and hold that information for use in STM. For this reason Atkinson and Shiffrin also called the registers 'buffers', as they prevent immense amounts of information from overwhelming higher-level cognitive processes. Information is only transferred to the STM when attention is given to it, otherwise it decays rapidly and is forgotten.",
style = "font-size: 150%"
),
br(),
h3("Iconic Memory", style = "font-weight: bold"),
p(
"Iconic memory, which is associated with the visual system, is perhaps the most researched of the sensory registers.Iconic memory is only limited to field of vision. That is, as long as a stimulus has entered the field of vision there is no limit to the amount of visual information iconic memory can hold at any one time. As noted above, sensory registers do not allow for further processing of information, and as such iconic memory only holds information for visual stimuli such as shape, size, color and location (but not semantic meaning). As the higher-level processes are limited in their capacities, not all information from sensory memory can be conveyed. It has been argued that the momentary mental freezing of visual input allows for the selection of specific aspects which should be passed on for further memory processing. The biggest limitation of iconic memory is the rapid decay of the information stored there; items in iconic memory decay after only 0.5â1.0 seconds.",
style = "font-size: 150%"
),
br(),
h3("Echoic Memory", style = "font-weight: bold"),
p(
"Echoic memory refers to information that is registered by the auditory system. As with iconic memory, echoic memory only holds superficial aspects of sound (e.g. pitch, tempo, or rhythm) and it has a nearly limitless capacity. Echoic memory is generally have a a duration of between 1.5 and 5 seconds depending on context but has been shown to last up to 20 seconds in the absence of competing information.",
style = "font-size: 150%"
),
img(src='Sensory-Memory.jpg', align = "center")
)
STMDescTabUI <- tabPanel(
"What is Short Term Memory?",
value = "STMDesc",
h1("What is Short Term Memory?", align = "center", style = "font-weight: bold"),
p(
"Short-Term Memory (STM) is the capacity for holding, but not manipulating, a small amount of information in mind in an active, readily available state for a short period of time. The purpose of the STM was to allow preliminary processing of information. Items held in the short-term memory decay rapidly over time; Atkinson and Shiffrin estimated that all trace of a word placed in STM will normally be lost within 30 seconds. For as long as an item resides in STM, however, there is a tendency to transfer it to the long-term memory(LTM); the longer an item is resident in STM, the greater the likelihood that a copy will be transferred to LTM. And once information is transferred to LTM, it is likely to be held there permanently.",
style = "font-size: 150%"
),
p(
"The STM was itself fed by a series of sensory registers from sensory memory. These registers acted as a system for selecting and collating sensory information ormation, which could be viewed as an essential component of perception. It reflect faculties of the human mind that can hold a limited amount of information in a very accessible state temporarily. One might relate short-term memory to a pattern of neural firing that represents a particular idea and one might consider the idea to be in short-term memory only when the firing pattern, or cell assembly, is active.",
style = "font-size: 150%"
),
br(),
h3("Duration", style = "font-weight: bold"),
p(
"As with sensory memory, the information that enters short-term memory decays and is lost, but the information in the short-term store has a longer duration, approximately 18â20 seconds when the information is not being actively rehearsed, though it is possible that this depends on modality and could be as long as 30 seconds. Fortunately, the information can be held in the short-term store for much longer through what Atkinson and Shiffrin called rehearsal. For auditory information rehearsal can be taken in a literal sense: continually repeating the items. However, the term can be applied for any information that is attended to, such as when a visual image is intentionally held in mind. Finally, information in the short-term store does not have to be of the same modality as its sensory input. For example, written text which enters visually can be held as auditory information, and likewise auditory input can be visualized. On this model, rehearsal of information allows for it to be stored more permanently in the long-term store. Atkinson and Shiffrin discussed this at length for auditory and visual information but did not give much attention to the rehearsal/storage of other modalities due to the experimental difficulties of studying those modalities.",
style = "font-size: 150%"
),
br(),
h3("Capacity", style = "font-weight: bold"),
p(
"There is a limit to the amount of information that can be held in the STM: 7 ± 2 chunks. These chunks, which were noted by Miller in his seminal paper The Magical Number Seven, Plus or Minus Two, are defined as independent items of information. It is important to note that some chunks are perceived as one unit though they could be broken down into multiple items, for example '1066' can be either the series of four digits '1, 0, 6, 6' or the semantically grouped item '1066' which is the year the Battle of Hastings was fought. Chunking allows for large amounts of information to be held in memory: 149283141066 is twelve individual items, well outside the limit of the STM, but it can be grouped semantically into the 3 chunks [1492][8314][1066]. Because short-term memory is limited in capacity, it severely limits the amount of information that can be attended to at any one time.",
style = "font-size: 150%"
)
)
LTMDescTabUI <- tabPanel(
"What is Long Term Memory?",
value = "LTMDesc",
h1("What is Long Term Memory?", align = "center", style = "font-weight: bold"),
p(
"Long-Term Memory(LTM) is is the stage of the AtkinsonâShiffrin memory model in which informative knowledge is held indefinitely. It is defined in contrast to short-term and working memory, which persist for only about 18 to 30 seconds. Long-term memory is commonly labelled as explicit memory (declarative), as well as episodic memory, semantic memory, autobiographical memory, and implicit memory.",
style = "font-size: 150%"
),
p(
"The LTM is concerned with storing information over extensive periods of time and fed by a STM that acted as a controller, feeding in new information and selecting particular processes for pulling information out of the LTM. It is a vast store of knowledge and a record of prior events, and it exists according to all theoretical views; it would be difficult to deny that each normal person has at his or her command a rich, although not flawless or complete, set of long-term memories.",
style = "font-size: 150%"
),
br(),
h3("Transfer from STM", style = "font-weight: bold"),
p(
"Information is postulated to enter the LTM store from the STM more or less automatically. As Atkinson and Shiffrin model it, transfer from the STM to the LTM is occurring for as long as the information is being attended to in the STM. In this way, varying amounts of attention result in varying amounts of time in STM. Ostensibly, the longer an item is held in STM, the stronger its memory trace will be in LTM. Repeated rote repetition enhances LTM. Forgetting increases for items which are studied fewer times. There are stronger encoding processes than simple rote rehearsal, namely relating the new information to information which has already made its way into the LTM.",
style = "font-size: 150%"
),
br(),
h3("Capacity and Duration", style = "font-weight: bold"),
p(
"In this model, as with most models of memory, LTM is assumed to be nearly limitless in its duration and capacity. It is most often the case that brain structures begin to deteriorate and fail before any limit of learning is reached. This is not to assume that any item which is stored in LTM is accessible at any point in the lifetime. Rather, it is noted that the connections, cues, or associations to the memory deteriorate; the memory remains intact but unreachable.",
style = "font-size: 150%"
)
)
AtkShifTabUI <- tabPanel(
"The Atkinson-Shiffrin Model",
value = "AtkShif",
h1("The Atkinson-Shiffrin Model", align = "center", style = "font-weight: bold"),
p(
"Two American Psychologists- Atkinson and Shiffrin suggested a three store structural model for memory. The first, called the sensory memory, where the inputs from the sensory organs is stored for a very small time in it's preliminary form before it is passed on to the next part, called short-term memory or STM. STM was assumed to be a temporary storage system that holds material just long enough for it to be processed; the capacity of this temporary store is very small. Once processing in this first store is completed, the coded material would be transferred to a more permanent store called long-term memory, or LTM. This model explained many of the memory related data so successfully that is soon became the modal model.",
style = "font-size: 150%"
),
img(src='Atkinson-and-Shiffrin-memory-model.png', align = "center")
)
DSTDescTabUI <- tabPanel(
"What is a Digit Span Test?",
value = "DSTDesc",
h1("What is a Digit Span Test?", align = "center", style = "font-weight: bold"),
p(
"A digit-span task is used to measure STM's number storage capacity. Participants see or hear a sequence of numerical digits and are tasked to recall the sequence correctly, with increasingly longer sequences being tested in each trial. The participant's span is the longest number of sequential digits that can accurately be remembered. Digit-span tasks can be given forwards or backwards, meaning that once the sequence is presented, the participant is asked to either recall the sequence in normal or reverse order. Digit-span tasks are the most commonly used test for memory span, partially because performance on a digit-span task cannot be affected by factors such as semantics, frequency of appearance in daily life, complexity, etc",
style = "font-size: 150%"
),
p(
"Verbal working memory is involved in many everyday tasks, such as remembering a friend's telephone number while entering it into a phone and understanding long and difficult sentences. Verbal working memory is also thought to be one of the elements underlying intelligence (often referred to as 'IQ,' meaning 'intelligence quotient'); thus, the digit span task is a common component of many IQ tests, including the widely used Wechsler Adult Intelligence Scale (WAIS). Performance on the digit span task is also closely linked to language learning abilities; improving verbal memory capacities may therefore aid mastery of a new language.",
style = "font-size: 150%"
),
p(
"One of the earliest measures of STM was digit span, the longest sequence of numbers that can be immediately repeated back in the correct order. People vary in their span, but it is usually around seven digits or five random letters.",
style = "font-size: 150%"
),
br(),
h3("Types of Digit Span Test", style = "font-weight: bold"),
p("- Forward Digit Span Test:", style = "font-size:150%; font-weight:bold"),
p("Here the subject is required to repeat the presented digit sequence in the given order", style = "font-size:150%"),
p("- Backward Digit Span Test:", style = "font-size:150%; font-weight:bold"),
p("It is an effective method in finding out the Short Term Memory capacity of subjects and the findings are reliable.", style = "font-size:150%")
)
DSTAdvTabUI <- tabPanel(
"Advantages of Digit Span Test",
value = "DSTAdv",
h1("Advantages of Digit Span Test", align = "center", style = "font-weight: bold"),
tags$div(tags$ul(
tags$li(p("It is very simple test and doesn't require any special setup apart from a silent environment and test subject.", style = "font-size:150%")),
tags$li(p("It serves as a part of assessing the IQ of the subjects. Higher values indicate higher remembering capacity.", style = "font-size:150%")),
tags$li(p("It is an effective method in finding out the Short Term Memory capacity of subjects and the findings are reliable.", style = "font-size:150%")),
tags$li(p("Computer and mobile versions of the test eliminate examiner differences and increase the inter-rater reliability.", style = "font-size:150%")),
tags$li(p("The digit sequence shows a superiority effect when compared to any non-digit span, and the Digit Span test is a preferred method to measure oneâs cognitive functioning.", style = "font-size:150%")),
)
)
)
DSTDisAdvTabUI <- tabPanel(
"Disadvantages of Digit Span Test",
value = "DSTDisAdv",
h1("Disadvantages of Digit Span Test", align = "center", style = "font-weight: bold"),
tags$div(tags$ul(
tags$li(p("It is criticised for being artificial in nature.", style = "font-size:150%")),
tags$li(p("This experiment is not the representative for the kinds of STM we do in everyday life.", style = "font-size:150%")),
tags$li(p("It is an effective method in finding out the Short Term Memory capacity of subjects and the findings are reliable.", style = "font-size:150%")),
tags$li(p("It lacks temporal validity i.e. findings may not generalize to modern times as it was devised almost a century ago.", style = "font-size:150%")),
)
)
)
DetailsNavListUI <- navlistPanel(
id = "details",
widths = c(2,10),
"Memory Model",
AtkShifTabUI,
SensDescTabUI,
STMDescTabUI,
LTMDescTabUI,
"Digit Span Test",
DSTDescTabUI,
DSTAdvTabUI,
DSTDisAdvTabUI
)
ConptBgUI <- tabPanelBody(
"theoryPanel",
fluidPage(
useShinydashboard(),
fluidRow(
column(
width = 1
),
column(
width = 11,
DetailsNavListUI
)
)
)
)
# ------------------------- Entire Test UI
EntireTestResultsUI <- tabPanelBody(
"entireTestPanel",
fluidPage(
#theme = bs_theme(bootswatch = "darkly"),
useShinydashboard(),
fluidRow(
column(
width = 1
),
column(
width = 11,
h1("Test Results", align = "center", style = "font-weight: bold"),
fluidRow(
infoBoxOutput("NumOfSubjects"),
infoBox("Number of Features Recorded", 16, icon = icon("list"), color = "blue", fill = TRUE),
downloadButton("download", "Download All Data", style = "width: 30%; font-size: 200%")
),
h2("Digit Span Score and Factoring Variables", align = "center", style = "font-weight: bold"),
fluidRow(
box(
title = "Digit Span Score Distribution", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPDist")
),
box(
title = "Digit Span Score vs Age", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsAge")
),
box(
title = "Digit Span Score vs Education Level", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsEducat")
),
box(
title = "Digit Span Score vs Gender", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsGender")
),
box(
title = "Digit Span Score vs Profession", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsJob")
),
box(
title = "Digit Span Score vs Academic Performance", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsAcad")
),
box(
title = "Digit Span Score vs Maths", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsMaths")
),
box(
title = "Digit Span Score vs Music", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsMusic")
),
box(
title = "Digit Span Score vs Environment", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsEnv")
),
box(
title = "Digit Span Score vs Mean Click Time", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsMeanTime")
)
),
h2("Mean Click Times and Factoring Variables", align = "center", style = "font-weight: bold"),
fluidRow(
box(
title = "Mean Click Time Difference vs Age", status = "success", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("MeanTimevsAge")
),
box(
title = "Mean Click Time Difference vs Education Level", status = "success", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("MeanTimevsEducat")
),
box(
title = "Mean Click Time Difference vs Gender", status = "success", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("MeanTimevsGender")
),
box(
title = "Mean Click Time Difference vs Profession", status = "success", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("MeanTimevsJob")
),
box(
title = "Mean Click Time Difference vs Academic Performance", status = "success", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("MeanTimevsAcad")
),
box(
title = "Mean Click Time Difference vs Maths", status = "success", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("MeanTimevsMaths")
),
box(
title = "Mean Click Time Difference vs Music", status = "success", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("MeanTimevsMusic")
),
box(
title = "Mean Click Time Difference vs Environment", status = "success", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("MeanTimevsEnv")
)
),
h2("Variation of Digit Span with Age and other Factoring Variables", align = "center", style = "font-weight: bold"),
fluidRow(
box(
title = "Digit Span Score vs Age vs Education Level", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsAgevsEducat")
),
box(
title = "Digit Span Score vs Age vs Gender", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsAgevsGender")
),
box(
title = "Digit Span Score vs Age vs Profession", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsAgevsJob")
),
box(
title = "Digit Span Score vs Age vs Academic Performance", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsAgevsAcad")
),
box(
title = "Digit Span Score vs Age vs Maths", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsAgevsMaths")
),
box(
title = "Digit Span Score vs Age vs Music", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsAgevsMusic")
),
box(
title = "Digit Span Score vs Age vs Environment", status = "primary", solidHeader = TRUE, width = 6, collapsible = TRUE, collapsed = TRUE,
plotOutput("DSPvsAgevsEnv")
)
),
h2("Interpretation", align = "center", style = "font-weight: bold"),
box(
title = "Interpretation", status = "success", solidHeader = TRUE, width = 12, collapsible = TRUE, collapsed = TRUE,
tags$div(tags$ul(
tags$li(p("It is observed that with increase in age digit span decreases.", style = "font-size:150%")),
tags$li(p("It is observed that with increase in education level digit span increases.", style = "font-size:150%")),
tags$li(p("It is observed that those who play musical instrument or constantly in touch with Maths have higher digit span.", style = "font-size:150%")),
tags$li(p("It is observed that those who attempted test in a silent environment have better digit span scores.", style = "font-size:150%")),
tags$li(p("From individual results(available if you attempt the test on your own), it is observed the time taken between clicks is far less than the time taken near the starting and end of the digit. It may be explained in two ways- one is the person starts guessing and eventually speed increases but that does not justify higher end time. So it may be because when a person remembers a digit clearly he is more relaxed to click the button for that digit but when he doesn't then he quickly presses the buttons to make sure he doesn't forget it. So, it is also justified by the primacy and recency effects of the Modal Model.", style = "font-size:150%")),
tags$li(p("Mean Click Time increases with age which can be interpreted as more time is required to retrieve the digits.", style = "font-size:150%")),
tags$li(p("Mean Click Time decreases with increase in education level.", style = "font-size:150%")),
tags$li(p("Mean Click Time is less for subjects who play musical instrument or are in constantly touch with Maths.", style = "font-size:150%")),
tags$li(p("From individual results(available if you attempt the test on your own), it is observed the time taken between clicks is more for later rounds which maybe because in general larger digit sequence takes more time to be retrieved from memory which also makes it prone to forget some of the digits.", style = "font-size:150%")),
tags$li(p("Higher Digit Span Subjects have slightly higher Mean Click Time i.e. on an average they can retrieve the digits even after more time has passed compared to the subjects with lower digit span.", style = "font-size:150%")))
)
)
)
)
)
)
modal_entiretest_tab <- modalDialog(
"No Pre-Collected Data Found",
title = "Error!",
footer = tagList(
actionButton("nopredata", "GO BACK TO HOME", class = "btn btn-danger")
)
)
# ------------------------- Intro UI
IntroUI <- tabPanelBody(
"introPanel",
h1("Digit Span Test", align = "center", style = "font-weight: bold"),
h2("Psychological Test for testing short term memory capacity", align = "center"),
h3(tags$a(href="https://github.com/RishiDarkDevil", "By Rishi Dey Chowdhury(RishiDarkDevil)", target = "_blank"), align = "center"),
fluidRow(
column(width = 1),
column(
width = 11,
fluidRow(
column(
width = 10,
h3("Rules(Read all or atleast the highlighted ones carefully):", style = "font-weight: bold")
),
column(
width = 2,
#actionButton("theory", "Concepts & Background")
)
),
tags$div(tags$ul(
tags$li(tags$span("Fill in the Details about 'YOUR INFO' on Left Side and Click 'Take Test' to begin.", style = "font-size:18px; font-weight: bold"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("Numbers will be displayed one at a time(at equal intervals of 1.5 sec).", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("The Digit Pad will be disabled when number display is in progress.", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("A thin progress bar showing how much number is displayed is visible on top of the screen throughout this process.", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("The random number sequence to be remembered will increase by 1 after each successful completion of round.", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("After all numbers are displayed 'GO' will be visible and Digit Pad is enabled. You can now start guessing the number in the correct order(Since, it is Forward Digit Span).", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("One Restart per round is available, which can be used only if no guess attempt(right or wrong) is made.", style = "font-size:18px; font-weight: bold"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("One chance for Mistake is available per round i.e. if you get a guess wrong then upon clicking the retry button another number sequence of same length will be displayed and you need to guess that.", style = "font-size:18px; font-weight: bold"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("Click on the Right Arrow Button after a successful guess to move to the next round. ", style = "font-size:18px; font-weight: bold"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("As you guess a progress bar will indicate how much you guessed correctly.", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("On successful guess restart button turns into a correct symbol and upon wrong guess turns into a cross symbol.", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("Continue till the maximum number of rounds you can go.", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("Even if you feel you have exhausted one mistake in the round and you don't remember the retry digit sequence properly, guess as much as you remember", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("Only after you reach the maximum round i.e. commit two mistakes in a round, you will be get access to 'Your Performance' assessment tab", style = "font-size:18px; font-weight: bold"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("'Your Performance' tab has comparison info with all the other test takers and visualizations regarding your performance", style = "font-size:18px"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("No Interface element except Digit Pad can be used once the test starts.", style = "font-size:18px; font-weight: bold"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("Ranking is decided first based on Digit Span Score(i.e. (max number of rounds)-1) then ties are broken based on the total time taken and average time difference between clicks", style = "font-size:18px; font-weight: bold"), style = "font-size: 36px; list-style-type: square;"),
tags$li(tags$span("First Round is Trial", style = "font-size:18px; font-weight: bold"), style = "font-size: 36px; list-style-type: square;")))
)
)
)
# ------------------- Detect Mobile
mobileDetect <- function(inputId, value = 0) {
tagList(
singleton(tags$head(tags$script(src = "js/mobile.js"))),
tags$input(id = inputId,
class = "mobile-element",
type = "hidden")
)
}
modal_mobile <- modalDialog(
"The webapp is not optimized for running on smaller screens. Please try using larger screen devices and Landscape Orientation.",
title = "You are on Mobile!",
footer = tagList(
actionButton("mobile", "Continue", class = "btn btn-warning")
)
)
# ------------------------- Test UI
TestUI <- tabPanelBody(
value = "testPanel",
fluidRow(
column(width = 1),
column(
width = 11,
fluidPage(
splitLayout(
cellWidths = c("50%", "50%"),
span(textOutput("display_digit"), style = "font-size:2000%; text-align: center; vertical-align: middle", align = "center"),
DigitPadUI
)
)
)
)
)
# ------------------------ Results UI
ResultUI <- tabPanelBody(
value = "perfPanel",
useShinydashboard(),
tags$head(tags$style(HTML('.info-box {min-height: 60px;} .info-box-icon {height: 60px; line-height: 60px;} .info-box-content {padding-top: 0px; padding-bottom: 0px;}'))),
fluidRow(
h1(textOutput("ResultHead"), align = "center", style = "font-weight: bold")
),
fluidRow(
column(width = 1),
column(
width = 11,
fluidRow(
valueBoxOutput("DSPScore", width = 3),
valueBoxOutput("TotalTime", width = 3),
# bsTooltip(""),
valueBoxOutput("TotalMistakes", width = 3),
valueBoxOutput("TotalRestarts", width = 3)
),
fluidRow(
column(
width = 6,
uiOutput("roundwisedata"),
box(
title = "Average Click Time in Each Round", status = "primary", solidHeader = TRUE, width = 12,
plotOutput("time_each_round")
)
),
column(
width = 6,
box(
title = "Click Times in Selected Round", status = "primary", solidHeader = TRUE, width = 12,
plotOutput("time_this_round")
),
box(
title = "Your Position Insight", status = "success", solidHeader = TRUE, collapsible = TRUE, width = 12,
infoBoxOutput("DSPRank", width = 6),
infoBoxOutput("NumCompetitors", width = 6),
infoBoxOutput("MeanTimeRankWithSameDSPRank", width = 6),
infoBoxOutput("TotTimeRankWithSameDSPRank", width = 6)
)
)
)
)
)
)
modal_performance_tab <- modalDialog(
"Your digit span data captured. Click below to view performance assessment",
title = "Test Complete",
footer = tagList(
actionButton("performance", "View Performance Assessment", class = "btn btn-success")
)
)
#-------------------------------------------------- Main UI
ui <- dashboardPage(
skin = "black",
dashboardHeader(
title = "DIGIT SPAN TEST", titleWidth = "15%",
tags$li(
class = "dropdown",
actionButton("theory", "Concepts & Background"),
bsTooltip("theory", "Gives Detailed information about the Digit Span Test and Memory Model."),
actionButton("entireTestRes", "Results and Findings"),
bsTooltip("entireTestRes", "Gives Visualization and Interpretation about already collected data."),
actionButton("home", "Home"),
bsTooltip("home", "Goes to Home Screen where all the rules are listed")
)
),
dashboardSidebar(
tags$style(HTML(".main-sidebar{width: 15%;}")),
UserDataUI
),
dashboardBody(
mobileDetect('isMobile'),
use_waiter(),
use_waitress(),
tabsetPanel(
id = "main",
type = "hidden",
selected = "introPanel",
#selected = "perfPanel",
ConptBgUI,
EntireTestResultsUI,
IntroUI,
TestUI,
ResultUI
)
)
)
#-------------------------------------------------- Main Server
server <- function(input, output, session) {
showNotification("Kindly keep an eye on notifications..", duration = NULL, type = "message")
# ------------ Deals with Mobile
observe({
if (input$isMobile) {
showModal(modal_mobile)
}
})
observeEvent(input$mobile, {
removeModal()
})
#------------- Deals with Theory
observeEvent(input$theory, {
if (input$main != "testPanel") {
updateTabsetPanel(inputId = "main", selected = "theoryPanel")
}
})
#------------- Deals with Test Home Screen
observeEvent(input$home, {
if (input$main != "testPanel") {
updateTabsetPanel(inputId = "main", selected = "introPanel")
}
})
#------------- Deals with Entire Test Results Screen
EntireTestResultsSetup <- function() {
user_data_temp <- read_sheet(user_data_id, sheet = "main")
user_dig_seq_temp <- read_sheet(user_dig_seq_id, sheet = "main")
user_restart_wrong_temp <- read_sheet(user_restart_wrong_id, sheet = "main")
user_digit_click_time_temp <- read_sheet(user_digit_click_time_id, sheet = "main")
sym_diff <- function(a,b) setdiff(union(a,b), intersect(a,b))
user_data_temp <- user_data_temp %>%
filter(!(ID %in% sym_diff(user_data_temp$ID, user_dig_seq_temp$ID)))
user_dig_seq_temp <- user_dig_seq_temp %>%
filter(!(ID %in% setdiff(user_data_temp$ID, user_dig_seq_temp$ID)))
user_restart_wrong_temp <- user_restart_wrong_temp %>%
filter(!(ID %in% sym_diff(user_data_temp$ID, user_restart_wrong_temp$ID)))
user_digit_click_time_temp <- user_digit_click_time_temp %>%
filter(!(ID %in% sym_diff(user_data_temp$ID, user_digit_click_time_temp$ID)))
output$NumOfSubjects <- renderInfoBox({
infoBox("Number of Subjects", nrow(user_data_temp), icon = icon("users"), fill = TRUE, color = "teal")
})
digit_span_per_ID <- user_dig_seq_temp %>%
group_by(ID) %>%
summarise(dig_span = max(parse_number(rounds))+1)
user_data_dig_span <- left_join(user_data_temp, digit_span_per_ID, by = "ID")
theme_include <- theme_bw() +
theme(
axis.title.x = element_text(size = 18),
axis.title.y = element_text(size = 18),
axis.text.x=element_text(size=15),
axis.text.y=element_text(size=15),
panel.border = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
strip.background = element_blank(),
legend.position = "none"
)
output$DSPDist <- renderPlot({
t1 <- digit_span_per_ID %>%
summarise('Mean' = mean(dig_span), 'Std' = sd(dig_span)) %>%
mutate(across(where(is.numeric), ~round(., digits = 2)))
digit_span_per_ID %>%
mutate(dig_span = as.factor(dig_span)) %>%
ggplot() +
geom_bar(aes(dig_span, fill = dig_span)) +
labs(
x = "Digit Span Score",
y = "Count"
) +
annotate("text", x = Inf, y = Inf, label = paste("mean=",round(t1$Mean, 2),",sd=",round(t1$Std, 2)), hjust = 1, vjust = 1) +
theme_include +
scale_fill_viridis(discrete = TRUE)
}, res = 96)
output$DSPvsAge <- renderPlot({
user_dig_span_age <- user_data_dig_span %>%
mutate(age = as.factor(ifelse(age < 10, 1, ifelse(age < 20, 2, ifelse(age < 30, 3, ifelse(age < 40, 4, ifelse(age < 50, 5, ifelse(age < 60, 6, ifelse(age < 70, 7, 8)))))))))
user_dig_span_age %>%
group_by(age) %>%
summarise(mean_dig_span = mean(dig_span), sd_dig_span = sd(dig_span)) %>%
ggplot() +
geom_bar(aes(age, mean_dig_span, fill = age), stat = "identity") +
labs(
x = "Age Groups",
y = "Average Digit Span Score"
) +
theme_include +
scale_x_discrete(labels = setNames(c("Below 10","10-19","20-29", "30-39", "40-49", "50-59", "60-69", "Above 70"), c(1, 2, 3, 4, 5, 6, 7, 8))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(age, mean_dig_span, label=paste("mean=",round(mean_dig_span, 2),",sd=",round(sd_dig_span, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$DSPvsEducat <- renderPlot({
user_data_dig_span %>%
mutate(educat = as.factor(ifelse(educat < 2, 1, ifelse(educat == 2, 2, 3)))) %>%
group_by(educat) %>%
summarise(mean_dig_span = mean(dig_span), sd_dig_span = sd(dig_span)) %>%
ggplot() +
geom_bar(aes(educat, mean_dig_span, fill = educat), stat = "identity") +
labs(
x = "Education Level",
y = "Average Digit Span Score"
) +
theme_include +
scale_x_discrete(labels = setNames(c("School-High School", "Undergraduate", "Graduate-Post Graduate"), c(1, 2, 3))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(educat, mean_dig_span, label=paste("mean=",round(mean_dig_span, 2),",sd=",round(sd_dig_span, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$DSPvsGender <- renderPlot({
user_data_dig_span %>%
mutate(sex = as.factor(sex)) %>%
group_by(sex) %>%
summarise(mean_dig_span = mean(dig_span), sd_dig_span = sd(dig_span)) %>%
ggplot() +
geom_bar(aes(sex, mean_dig_span, fill = sex), stat = "identity") +
labs(
x = "Gender",
y = "Average Digit Span Score"
) +
theme_include +
scale_x_discrete(labels = setNames(c("Male", "Female"), c(0, 1))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(sex, mean_dig_span, label=paste("mean=",round(mean_dig_span, 2),",sd=",round(sd_dig_span, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$DSPvsJob <- renderPlot({
user_data_dig_span %>%
mutate(job = as.factor(ifelse(job == 0, 1, 2))) %>%
group_by(job) %>%
summarise(mean_dig_span = mean(dig_span), sd_dig_span = sd(dig_span)) %>%
ggplot() +
geom_bar(aes(job, mean_dig_span, fill = job), stat = "identity") +
labs(
x = "Profession",
y = "Average Digit Span Score"
) +
theme_include +
scale_x_discrete(labels = setNames(c("Academia", "Industry, Bussiness or Other"), c(1, 2))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(job, mean_dig_span, label=paste("mean=",round(mean_dig_span, 2),",sd=",round(sd_dig_span, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$DSPvsAcad <- renderPlot({
user_data_dig_span %>%
mutate(academic = as.factor(ifelse(academic <= 2, 1, ifelse(academic >= 4, 3, 2)))) %>%
group_by(academic) %>%
summarise(mean_dig_span = mean(dig_span), sd_dig_span = sd(dig_span)) %>%
ggplot() +
geom_bar(aes(academic, mean_dig_span, fill = academic), stat = "identity") +
labs(
x = "Academic Performance",
y = "Average Digit Span Score"
) +
theme_include +
scale_x_discrete(labels = setNames(c("Below Average", "Average", "Above Average"), c(1, 2, 3))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(academic, mean_dig_span, label=paste("mean=",round(mean_dig_span, 2),",sd=",round(sd_dig_span, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$DSPvsMaths <- renderPlot({
user_data_dig_span %>%
mutate(maths = as.factor(maths)) %>%
group_by(maths) %>%
summarise(mean_dig_span = mean(dig_span), sd_dig_span = sd(dig_span)) %>%
ggplot() +
geom_bar(aes(maths, mean_dig_span, fill = maths), stat = "identity") +
labs(
x = "Have Maths?",
y = "Average Digit Span Score"
) +
theme_include +
scale_x_discrete(labels = setNames(c("Yes", "No"), c(1, 0))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(maths, mean_dig_span, label=paste("mean=",round(mean_dig_span, 2),",sd=",round(sd_dig_span, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$DSPvsMusic <- renderPlot({
user_data_dig_span %>%
mutate(music = as.factor(music)) %>%
group_by(music) %>%
summarise(mean_dig_span = mean(dig_span), sd_dig_span = sd(dig_span)) %>%
ggplot() +
geom_bar(aes(music, mean_dig_span, fill = music), stat = "identity") +
labs(
x = "Play Musical Instrument?",
y = "Average Digit Span Score"
) +
theme_include +
scale_x_discrete(labels = setNames(c("Yes", "No"), c(1, 0))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(music, mean_dig_span, label=paste("mean=",round(mean_dig_span, 2),",sd=",round(sd_dig_span, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$DSPvsEnv <- renderPlot({
user_data_dig_span %>%
mutate(env = as.factor(ifelse(env <= 1, 1, 2))) %>%
group_by(env) %>%
summarise(mean_dig_span = mean(dig_span), sd_dig_span = sd(dig_span)) %>%
ggplot() +
geom_bar(aes(env, mean_dig_span, fill = env), stat = "identity") +
labs(
x = "Environment",
y = "Average Digit Span Score"
) +
theme_include +
scale_x_discrete(labels = setNames(c("Silent or Normal", "Noisy or Very Noisy"), c(1, 2))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(env, mean_dig_span, label=paste("mean=",round(mean_dig_span, 2),",sd=",round(sd_dig_span, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$DSPvsMeanTime <- renderPlot({
user_data_dig_time <- full_join(user_digit_click_time_temp, user_data_dig_span)
user_data_dig_time <- user_data_dig_time %>%
mutate(dig_span = dig_span) %>%
group_by(dig_span) %>%
summarise(mean_time_diff = mean(time_diff))
user_data_dig_time
user_data_dig_time %>%
mutate(dig_span = as.factor(dig_span)) %>%
ggplot() +
geom_bar(aes(dig_span, mean_time_diff, fill = dig_span), stat = "identity") +
labs(
x = "Digit Span",
y = "Mean Click Time"
) +
theme_bw() +
theme_include +
scale_fill_viridis(discrete = TRUE)
}, res = 96)
output$MeanTimevsAge <- renderPlot({
user_data_dig_time <- full_join(user_digit_click_time_temp, user_data_dig_span)
user_data_dig_time <- user_data_dig_time %>%
mutate(age = as.factor(ifelse(age < 10, 1, ifelse(age < 20, 2, ifelse(age < 30, 3, ifelse(age < 40, 4, ifelse(age < 50, 5, ifelse(age < 60, 6, ifelse(age < 70, 7, 8))))))))) %>%
group_by(age) %>%
summarise(mean_time_diff = mean(time_diff), std_time_diff = sd(time_diff))
user_data_dig_time %>%
ggplot() +
geom_bar(aes(age, mean_time_diff, fill = age), stat = "identity") +
labs(
x = "Age",
y = "Mean Time Diff btw Clicks"
) +
theme_include +
scale_x_discrete(labels = setNames(c("Below 10","10-19","20-29", "30-39", "40-49", "50-59", "60-69", "Above 70"), c(1, 2, 3, 4, 5, 6, 7, 8))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(age, mean_time_diff, label=paste("mean=",round(mean_time_diff, 2),",sd=",round(std_time_diff, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$MeanTimevsEducat <- renderPlot({
user_data_dig_time <- full_join(user_digit_click_time_temp, user_data_dig_span)
user_data_dig_time <- user_data_dig_time %>%
mutate(educat = as.factor(ifelse(educat < 2, 1, ifelse(educat == 2, 2, 3)))) %>%
group_by(educat) %>%
summarise(mean_time_diff = mean(time_diff), std_time_diff = sd(time_diff))
user_data_dig_time %>%
ggplot() +
geom_bar(aes(educat, mean_time_diff, fill = educat), stat = "identity") +
labs(
x = "Education Level",
y = "Mean Time Diff btw Clicks"
) +
theme_include +
scale_x_discrete(labels = setNames(c("School-High School", "Undergraduate", "Graduate-Post Graduate"), c(1, 2, 3))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(educat, mean_time_diff, label=paste("mean=",round(mean_time_diff, 2),",sd=",round(std_time_diff, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$MeanTimevsGender<- renderPlot({
user_data_dig_time <- full_join(user_digit_click_time_temp, user_data_dig_span)
user_data_dig_time <- user_data_dig_time %>%
mutate(sex = as.factor(sex)) %>%
group_by(sex) %>%
summarise(mean_time_diff = mean(time_diff), std_time_diff = sd(time_diff))
user_data_dig_time %>%
ggplot() +
geom_bar(aes(sex, mean_time_diff, fill = sex), stat = "identity") +
labs(
x = "Gender",
y = "Mean Time Diff btw Clicks"
) +
theme_include +
scale_x_discrete(labels = setNames(c("Male", "Female"), c(0, 1))) +
scale_fill_viridis(discrete = TRUE) +
geom_text(aes(sex, mean_time_diff, label=paste("mean=",round(mean_time_diff, 2),",sd=",round(std_time_diff, 2))), position=position_dodge(width=0.9), vjust=-0.25)
}, res = 96)
output$MeanTimevsJob<- renderPlot({
user_data_dig_time <- full_join(user_digit_click_time_temp, user_data_dig_span)
user_data_dig_time <- user_data_dig_time %>%
mutate(job = as.factor(ifelse(job == 0, 1, 2))) %>%
group_by(job) %>%
summarise(mean_time_diff = mean(time_diff), std_time_diff = sd(time_diff))
user_data_dig_time %>%
ggplot() +
geom_bar(aes(job, mean_time_diff, fill = job), stat = "identity") +
labs(