AI Art Study 4 Analysis
This script processes and analyzes data from the AI Art Study 2, examining perceptions of transformativeness, essence change, and creativity across different modification conditions, effort levels, and creator types
Setup
Library Loading
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorsDATA_PATH <- "/Users/dgkamper/Library/CloudStorage/GoogleDrive-dgkamper@gmail.com/My Drive/DGK Lab/Reasoning Lab/DGK Lab - Copyrightability and AI Art/Analysis/AI Visual Art/Study2_ForAnalysis.csv"Define Constants and Mapping Dictionaries
# Response mappings
response_mappings <- list(
transformative = c(
"Not at all transformative" = 1,
"Slightly transformative" = 2,
"Moderately transformative" = 3,
"Very transformative" = 4,
"Highly transformative" = 5
),
essence = c(
"No change in essence" = 1,
"Very little change in essence" = 2,
"Moderate change in essence" = 3,
"Significant change in essence" = 4,
"Complete change in essence" = 5
),
creativity = c(
"No creativity involved" = 1,
"Minimal creativity involved" = 2,
"Moderate creativity involved" = 3,
"Significant creativity involved" = 4,
"A great deal of creativity involved" = 5
)
)
# Define ordered factor levels
modification_levels <- c("No Modification", "Slight Modification", "Dramatic Modification")
effort_levels <- c("less than 1 hour", "10 hours", "100 hours")
question_types <- c(
"Transformative Perception",
"Essence Change",
"Perceived Creativity",
"Reasoning Explanation (Transformative)",
"Reasoning Explanation (Essence)",
"Reasoning Explanation (Creativity)"
)Initial Data Loading and Preparation
# Read the data from specified path
data <- read_csv(DATA_PATH)## Rows: 117 Columns: 212
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (203): ConsentForm, DateofConsent, Type, AttentionCheck, 1FigureNoneTran...
## dbl (8): Progress, Duration (in seconds), id, AttentionCheck2, Age, hour1_...
## lgl (1): Finished
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Convert all columns to character type for consistent handling
data <- data %>%
mutate(across(everything(), as.character))
# Verify data structure
glimpse(data)## Rows: 117
## Columns: 212
## $ Progress <chr> "100", "100", "100", "100", "100", "100", "100…
## $ `Duration (in seconds)` <chr> "1708", "1402", "3428", "1695", "1701", "3750"…
## $ Finished <chr> "TRUE", "TRUE", "TRUE", "TRUE", "TRUE", "TRUE"…
## $ id <chr> "69675", "67641", "69515", "69873", "62784", "…
## $ ConsentForm <chr> "I consent to this study.", "I consent to this…
## $ DateofConsent <chr> "1/27/25", "1/27/25", "1/27/25", "1/27/25", "1…
## $ Type <chr> "Human", "Human", "Human", "AI", "Human", "AI"…
## $ AttentionCheck <chr> "Viewing images for a set amount of time and a…
## $ `1FigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `1FigureNoneEss` <chr> "No change in essence", "No change in essence"…
## $ `1FigureNoneCreat` <chr> "No creativity involved", "No creativity invol…
## $ `1FigureNoneTransR` <chr> "I see no change in the pictures.", "They look…
## $ `1FigureNoneEssR` <chr> "I see no change in the pictures.", "They look…
## $ `1FigureNoneCreatR` <chr> "I see no change.", "They look the exact same …
## $ `1FigureMinTrans` <chr> "Moderately transformative", "Slightly transfo…
## $ `1FigureMinEss` <chr> "Moderate change in essence", "Very little cha…
## $ `1FigureMinCreat` <chr> "Minimal creativity involved", "No creativity …
## $ `1FigureMinTransR` <chr> "I think this magnifies what is going on insid…
## $ `1FigureMinEssR` <chr> "The essence is now sad and looks to me like l…
## $ `1FigureMinCreatR` <chr> "There is some creativity in changing the whol…
## $ `1FigureMaxTrans` <chr> "Very transformative", "Very transformative", …
## $ `1FigureMaxEss` <chr> "Moderate change in essence", "Moderate change…
## $ `1FigureMaxCreat` <chr> "Significant creativity involved", "Moderate c…
## $ `1FigureMaxTransR` <chr> "This transformed the photo to older years, an…
## $ `1FigureMaxEssR` <chr> "The mood of this now is sad, less electric.",…
## $ `1FigureMaxCreatR` <chr> "Creativity is huge in this, as the whole pict…
## $ `2FigureNoneTrans` <chr> NA, NA, "Not at all transformative", "Not at a…
## $ `2FigureNoneEss` <chr> NA, NA, "No change in essence", "No change in …
## $ `2FigureNoneCreat` <chr> NA, NA, "No creativity involved", "No creativi…
## $ `2FigureNoneTransR` <chr> NA, NA, "The images are so similar that there …
## $ `2FigureNoneEssR` <chr> NA, NA, "The essence remained the same because…
## $ `2FigureNoneCreatR` <chr> NA, NA, "The was no creativity because they lo…
## $ `2FigureMinTrans` <chr> NA, NA, "Moderately transformative", "Slightly…
## $ `2FigureMinEss` <chr> NA, NA, "Moderate change in essence", "Very li…
## $ `2FigureMinCreat` <chr> NA, NA, "No creativity involved", "Minimal cre…
## $ `2FigureMinTransR` <chr> NA, NA, "There is a different meaning in the s…
## $ `2FigureMinEssR` <chr> NA, NA, "Because it is darker, the feeling of …
## $ `2FigureMinCreatR` <chr> NA, NA, "The images do not differ very much.",…
## $ `2FigureMaxTrans` <chr> NA, NA, "Slightly transformative", "Moderately…
## $ `2FigureMaxEss` <chr> NA, NA, "Moderate change in essence", "Moderat…
## $ `2FigureMaxCreat` <chr> NA, NA, "Significant creativity involved", "Mo…
## $ `2FigureMaxTransR` <chr> NA, NA, "There was a change in style but there…
## $ `2FigureMaxEssR` <chr> NA, NA, "I feel like there is a slightly diffe…
## $ `2FigureMaxCreatR` <chr> NA, NA, "I felt like this was very creative. I…
## $ `3FigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `3FigureNoneEss` <chr> "No change in No change in essence", "No chang…
## $ `3FigureNoneCreat` <chr> "No creativity involved", "No creativity invol…
## $ `3FigureNoneTransR` <chr> "I see no change in the pictures.", "They look…
## $ `3FigureNoneEssR` <chr> "I see no change.", "They look the same", NA, …
## $ `3FigureNoneCreatR` <chr> "I see no change.", "they look the same.", NA,…
## $ `3FigureMinTrans` <chr> "Slightly transformative", "Not at all transfo…
## $ `3FigureMinEss` <chr> "Very little change in essence", "Very little …
## $ `3FigureMinCreat` <chr> "No creativity involved", "No creativity invol…
## $ `3FigureMinTransR` <chr> "The fire looks as though it burns stronger an…
## $ `3FigureMinEssR` <chr> "With the increased fire color intensity, it m…
## $ `3FigureMinCreatR` <chr> "No change in creativity as the picture didnt …
## $ `3FigureMaxTrans` <chr> "Very transformative", "Moderately transformat…
## $ `3FigureMaxEss` <chr> "Significant change in essence", "Moderate cha…
## $ `3FigureMaxCreat` <chr> "Significant creativity involved", "Minimal cr…
## $ `3FigureMaxTransR` <chr> "The photo is transformed into electronic and …
## $ `3FigureMaxEssR` <chr> "The vide of the photo is now more friendly an…
## $ `3FigureMaxCreatR` <chr> "There is now more creativity, as a background…
## $ `4FigureNoneTrans` <chr> NA, NA, "Not at all transformative", NA, NA, "…
## $ `4FigureNoneEss` <chr> NA, NA, "No change in essence", NA, NA, "No ch…
## $ `4FigureNoneCreat` <chr> NA, NA, "No creativity involved", NA, NA, "Sig…
## $ `4FigureNoneTransR` <chr> NA, NA, "The images are so similar that it doe…
## $ `4FigureNoneEssR` <chr> NA, NA, "There is no difference in feeling bet…
## $ `4FigureNoneCreatR` <chr> NA, NA, "The images are so similar, so there i…
## $ `4FigureMinTrans` <chr> NA, NA, "Very transformative", NA, NA, "Slight…
## $ `4FigureMinEss` <chr> NA, NA, "Moderate change in essence", NA, NA, …
## $ `4FigureMinCreat` <chr> NA, NA, "Minimal creativity involved", NA, NA,…
## $ `4FigureMinTransR` <chr> NA, NA, "It feels like there is a fair amount …
## $ `4FigureMinEssR` <chr> NA, NA, "The feeling in the image changed a fa…
## $ `4FigureMinCreatR` <chr> NA, NA, "The images are so similar that there …
## $ `4FigureMaxTrans` <chr> NA, NA, "Very transformative", NA, NA, "Modera…
## $ `4FigureMaxEss` <chr> NA, NA, "Significant change in essence", NA, N…
## $ `4FigureMaxCreat` <chr> NA, NA, "Moderate creativity involved", NA, NA…
## $ `4FigureMaxTransR` <chr> NA, NA, "Due to the style change there is a co…
## $ `4FigureMaxEssR` <chr> NA, NA, "The feeling of the image totally chan…
## $ `4FigureMaxCreatR` <chr> NA, NA, "I feel like the second one is fairly …
## $ `5FigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `5FigureNoneEss` <chr> "No change in essence", "No change in essence"…
## $ `5FigureNoneCreat` <chr> "No creativity involved", "No creativity invol…
## $ `5FigureNoneTransR` <chr> "No change.", "I can't tell the difference bet…
## $ `5FigureNoneEssR` <chr> "No change.", "I can't tell the difference bet…
## $ `5FigureNoneCreatR` <chr> "No change.", "I can't tell the difference bet…
## $ `5FigureMinTrans` <chr> "Slightly transformative", "Moderately transfo…
## $ `5FigureMinEss` <chr> "Very little change in essence", "Very little …
## $ `5FigureMinCreat` <chr> "No creativity involved", "No creativity invol…
## $ `5FigureMinTransR` <chr> "The change in filter transforms the picture t…
## $ `5FigureMinEssR` <chr> "The change in skin tone and the darkness look…
## $ `5FigureMinCreatR` <chr> "The picture didnt change just the filter.", "…
## $ `5FigureMaxTrans` <chr> "Very transformative", "Very transformative", …
## $ `5FigureMaxEss` <chr> "Complete change in essence", "Moderate change…
## $ `5FigureMaxCreat` <chr> "Significant creativity involved", "Significan…
## $ `5FigureMaxTransR` <chr> "It transforms into a different story and shap…
## $ `5FigureMaxEssR` <chr> "The mood immediately lightens and looks less …
## $ `5FigureMaxCreatR` <chr> "So much changes in the design and creativity …
## $ `1NonFigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `1NonFigureNoneEss` <chr> "No change in essence", "No change in essence"…
## $ `1NonFigureNoneCreat` <chr> "No creativity involved", "No creativity invol…
## $ `1NonFigureNoneTransR` <chr> "I see no change in the 2 pictures.", "They lo…
## $ `1NonFigureNoneEssR` <chr> "I see no change in the 2 pictures.", "They lo…
## $ `1NonFigureNoneCreatR` <chr> "I see no change in the 2 pictures.", "They lo…
## $ `1NonFigureMinTrans` <chr> "Slightly transformative", "Very transformativ…
## $ `1NonFigureMinEss` <chr> "Moderate change in essence", "Significant cha…
## $ `1NonFigureMinCreat` <chr> "No creativity involved", "Significant creativ…
## $ `1NonFigureMinTransR` <chr> "The second picture has a darker orange tone o…
## $ `1NonFigureMinEssR` <chr> "The essence is a little creepier in the secon…
## $ `1NonFigureMinCreatR` <chr> "No creativity, just a different filter over t…
## $ `1NonFigureMaxTrans` <chr> "Slightly transformative", "Moderately transfo…
## $ `1NonFigureMaxEss` <chr> "Moderate change in essence", "Moderate change…
## $ `1NonFigureMaxCreat` <chr> "Minimal creativity involved", "Minimal creati…
## $ `1NonFigureMaxTransR` <chr> "The second picture was made into clipart whic…
## $ `1NonFigureMaxEssR` <chr> "It gives a more kid sense and less realistic,…
## $ `1NonFigureMaxCreatR` <chr> "The first one seems more creative to me.", "I…
## $ `2NonFigureNoneTrans` <chr> "Not at all transformative", NA, "Not at all t…
## $ `2NonFigureNoneEss` <chr> "No change in essence", NA, "No change in esse…
## $ `2NonFigureNoneCreat` <chr> "No creativity involved", NA, "No creativity i…
## $ `2NonFigureNoneTransR` <chr> "I see no change in the pictures.", NA, "There…
## $ `2NonFigureNoneEssR` <chr> "I see no change in the pictures.", NA, "Becau…
## $ `2NonFigureNoneCreatR` <chr> "I see no change in the pictures.", NA, "The t…
## $ `2NonFigureMinTrans` <chr> "Not at all transformative", NA, "Slightly tra…
## $ `2NonFigureMinEss` <chr> "Very little change in essence", NA, "Moderate…
## $ `2NonFigureMinCreat` <chr> "No creativity involved", NA, "Minimal creativ…
## $ `2NonFigureMinTransR` <chr> "I don't think the slight change makes a diffe…
## $ `2NonFigureMinEssR` <chr> "The faded look makes it look a little less ap…
## $ `2NonFigureMinCreatR` <chr> "No creativity just a more faded filter.", NA,…
## $ `2NonFigureMaxTrans` <chr> "Very transformative", NA, "Highly transformat…
## $ `2NonFigureMaxEss` <chr> "Significant change in essence", NA, "Complete…
## $ `2NonFigureMaxCreat` <chr> "Significant creativity involved", NA, "A grea…
## $ `2NonFigureMaxTransR` <chr> "This one is almost completely different. It …
## $ `2NonFigureMaxEssR` <chr> "The essence of the second is completely diffe…
## $ `2NonFigureMaxCreatR` <chr> "This one involves creativity with the new col…
## $ `3NonFigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `3NonFigureNoneEss` <chr> "No change in essence", "No change in essence"…
## $ `3NonFigureNoneCreat` <chr> "No creativity involved", "Minimal creativity …
## $ `3NonFigureNoneTransR` <chr> "The second one didn't change from the first."…
## $ `3NonFigureNoneEssR` <chr> "The second one didn't change from the first."…
## $ `3NonFigureNoneCreatR` <chr> "The second one didn't change from the first."…
## $ `3NonFigureMinTrans` <chr> "Slightly transformative", "Moderately transfo…
## $ `3NonFigureMinEss` <chr> "Moderate change in essence", "No change in es…
## $ `3NonFigureMinCreat` <chr> "No creativity involved", "Minimal creativity …
## $ `3NonFigureMinTransR` <chr> "The second one was darkened. It transforms t…
## $ `3NonFigureMinEssR` <chr> "It looks darker and gives a more scary and la…
## $ `3NonFigureMinCreatR` <chr> "The creativity did not chang, as it was just …
## $ `3NonFigureMaxTrans` <chr> "Slightly transformative", "Highly transformat…
## $ `3NonFigureMaxEss` <chr> "Significant change in essence", "Significant …
## $ `3NonFigureMaxCreat` <chr> "Minimal creativity involved", "Moderate creat…
## $ `3NonFigureMaxTransR` <chr> "I feel like the second one is more simple and…
## $ `3NonFigureMaxEssR` <chr> "The second one does give me more emotions and…
## $ `3NonFigureMaxCreatR` <chr> "I feel like the second one is more boring and…
## $ `4NonFigureNoneTrans` <chr> NA, "Not at all transformative", NA, "Not at a…
## $ `4NonFigureNoneEss` <chr> NA, "No change in essence", NA, "No change in …
## $ `4NonFigureNoneCreat` <chr> NA, "No creativity involved", NA, "No creativi…
## $ `4NonFigureNoneTransR` <chr> NA, "They look like the same exact image to me…
## $ `4NonFigureNoneEssR` <chr> NA, "They look like the same exact image to me…
## $ `4NonFigureNoneCreatR` <chr> NA, "They look like the same exact image to me…
## $ `4NonFigureMinTrans` <chr> NA, "Not at all transformative", NA, "Not at a…
## $ `4NonFigureMinEss` <chr> NA, "No change in essence", NA, "No change in …
## $ `4NonFigureMinCreat` <chr> NA, "No creativity involved", NA, "No creativi…
## $ `4NonFigureMinTransR` <chr> NA, "The only difference I noticed was the sky…
## $ `4NonFigureMinEssR` <chr> NA, "Again, the sky changing didn't change my …
## $ `4NonFigureMinCreatR` <chr> NA, "Changing sky colors doesn't take much eff…
## $ `4NonFigureMaxTrans` <chr> NA, "Highly transformative", NA, "Moderately t…
## $ `4NonFigureMaxEss` <chr> NA, "Complete change in essence", NA, "Moderat…
## $ `4NonFigureMaxCreat` <chr> NA, "A great deal of creativity involved", NA,…
## $ `4NonFigureMaxTransR` <chr> NA, "They changed everything besides the scene…
## $ `4NonFigureMaxEssR` <chr> NA, "The different art style gives a completel…
## $ `4NonFigureMaxCreatR` <chr> NA, "They changed the whole style of the art a…
## $ `5NonFigureNoneTrans` <chr> NA, NA, "Not at all transformative", NA, NA, "…
## $ `5NonFigureNoneEss` <chr> NA, NA, "No change in essence", NA, NA, "No ch…
## $ `5NonFigureNoneCreat` <chr> NA, NA, "No creativity involved", NA, NA, "Sig…
## $ `5NonFigureNoneTransR` <chr> NA, NA, "They look exactly the same.", NA, NA,…
## $ `5NonFigureNoneEssR` <chr> NA, NA, "Because the images look identical the…
## $ `5NonFigureNoneCreatR` <chr> NA, NA, "It seems like there is no creativity …
## $ `5NonFigureMinTrans` <chr> NA, NA, "Slightly transformative", NA, NA, "Ve…
## $ `5NonFigureMinEss` <chr> NA, NA, "Very little change in essence", NA, N…
## $ `5NonFigureMinCreat` <chr> NA, NA, "Minimal creativity involved", NA, NA,…
## $ `5NonFigureMinTransR` <chr> NA, NA, "The meaning slightly changed with the…
## $ `5NonFigureMinEssR` <chr> NA, NA, "The second image felt like it had a d…
## $ `5NonFigureMinCreatR` <chr> NA, NA, "The colors were more vibrant and seem…
## $ `5NonFigureMaxTrans` <chr> NA, NA, "Highly transformative", NA, NA, "Very…
## $ `5NonFigureMaxEss` <chr> NA, NA, "Complete change in essence", NA, NA, …
## $ `5NonFigureMaxCreat` <chr> NA, NA, "Moderate creativity involved", NA, NA…
## $ `5NonFigureMaxTransR` <chr> NA, NA, "The meaning is totally different in t…
## $ `5NonFigureMaxEssR` <chr> NA, NA, "The feeling in the second one totally…
## $ `5NonFigureMaxCreatR` <chr> NA, NA, "There was creativity, but there was l…
## $ AttentionCheck2 <chr> "15", "15", "15", "15", "15", "15", "15", "15"…
## $ Seriousness <chr> "Yes, I did", "Yes, I did", "Yes, I did", "Yes…
## $ CommentFeedback <chr> NA, NA, NA, NA, NA, "N/A", NA, NA, NA, "One of…
## $ Race <chr> "White or Caucasian", "White or Caucasian,Asia…
## $ Gender <chr> "Female", "Female", "Male", "Female", "Male", …
## $ Age <chr> "18", "19", "24", "21", "21", "20", "22", "21"…
## $ Language <chr> "English", "English", "English", "English", "E…
## $ Experience <chr> "Moderate formal training or experience", "No …
## $ Additional <chr> NA, NA, NA, "I would like to change my answer …
## $ hour1_count <chr> "2", "2", "2", "2", "2", "2", "2", "2", "2", "…
## $ hour10_count <chr> "2", "2", "2", "2", "2", "2", "2", "2", "2", "…
## $ hour100_count <chr> "2", "2", "2", "2", "2", "2", "2", "2", "2", "…
## $ Image1_Time <chr> "10 hours", "100 hours", "10 hours", "10 hours…
## $ Image2_Time <chr> "less than 1 hour", "less than 1 hour", "10 ho…
## $ Image3_Time <chr> "10 hours", "100 hours", "10 hours", "less tha…
## $ Image4_Time <chr> "100 hours", "10 hours", "less than 1 hour", "…
## $ Image5_Time <chr> "less than 1 hour", "10 hours", "100 hours", "…
## $ Image6_Time <chr> "100 hours", "less than 1 hour", "less than 1 …
## $ Image1 <chr> "Image3_Nonfigure", "Image3_Nonfigure", "Image…
## $ Image2 <chr> "Image1_Nonfigure", "Image1_Nonfigure", "Image…
## $ Image3 <chr> "Image2_Nonfigure", "Image4_Nonfigure", "Image…
## $ Image4 <chr> "Image1_Figure", "Image5_Figure", "Image5_Nonf…
## $ Image5 <chr> "Image3_Figure", "Image1_Figure", "Image4_Figu…
## $ Image6 <chr> "Image5_Figure", "Image3_Figure", "Image2_Figu…# See data headings
colnames(data)## [1] "Progress" "Duration (in seconds)" "Finished"
## [4] "id" "ConsentForm" "DateofConsent"
## [7] "Type" "AttentionCheck" "1FigureNoneTrans"
## [10] "1FigureNoneEss" "1FigureNoneCreat" "1FigureNoneTransR"
## [13] "1FigureNoneEssR" "1FigureNoneCreatR" "1FigureMinTrans"
## [16] "1FigureMinEss" "1FigureMinCreat" "1FigureMinTransR"
## [19] "1FigureMinEssR" "1FigureMinCreatR" "1FigureMaxTrans"
## [22] "1FigureMaxEss" "1FigureMaxCreat" "1FigureMaxTransR"
## [25] "1FigureMaxEssR" "1FigureMaxCreatR" "2FigureNoneTrans"
## [28] "2FigureNoneEss" "2FigureNoneCreat" "2FigureNoneTransR"
## [31] "2FigureNoneEssR" "2FigureNoneCreatR" "2FigureMinTrans"
## [34] "2FigureMinEss" "2FigureMinCreat" "2FigureMinTransR"
## [37] "2FigureMinEssR" "2FigureMinCreatR" "2FigureMaxTrans"
## [40] "2FigureMaxEss" "2FigureMaxCreat" "2FigureMaxTransR"
## [43] "2FigureMaxEssR" "2FigureMaxCreatR" "3FigureNoneTrans"
## [46] "3FigureNoneEss" "3FigureNoneCreat" "3FigureNoneTransR"
## [49] "3FigureNoneEssR" "3FigureNoneCreatR" "3FigureMinTrans"
## [52] "3FigureMinEss" "3FigureMinCreat" "3FigureMinTransR"
## [55] "3FigureMinEssR" "3FigureMinCreatR" "3FigureMaxTrans"
## [58] "3FigureMaxEss" "3FigureMaxCreat" "3FigureMaxTransR"
## [61] "3FigureMaxEssR" "3FigureMaxCreatR" "4FigureNoneTrans"
## [64] "4FigureNoneEss" "4FigureNoneCreat" "4FigureNoneTransR"
## [67] "4FigureNoneEssR" "4FigureNoneCreatR" "4FigureMinTrans"
## [70] "4FigureMinEss" "4FigureMinCreat" "4FigureMinTransR"
## [73] "4FigureMinEssR" "4FigureMinCreatR" "4FigureMaxTrans"
## [76] "4FigureMaxEss" "4FigureMaxCreat" "4FigureMaxTransR"
## [79] "4FigureMaxEssR" "4FigureMaxCreatR" "5FigureNoneTrans"
## [82] "5FigureNoneEss" "5FigureNoneCreat" "5FigureNoneTransR"
## [85] "5FigureNoneEssR" "5FigureNoneCreatR" "5FigureMinTrans"
## [88] "5FigureMinEss" "5FigureMinCreat" "5FigureMinTransR"
## [91] "5FigureMinEssR" "5FigureMinCreatR" "5FigureMaxTrans"
## [94] "5FigureMaxEss" "5FigureMaxCreat" "5FigureMaxTransR"
## [97] "5FigureMaxEssR" "5FigureMaxCreatR" "1NonFigureNoneTrans"
## [100] "1NonFigureNoneEss" "1NonFigureNoneCreat" "1NonFigureNoneTransR"
## [103] "1NonFigureNoneEssR" "1NonFigureNoneCreatR" "1NonFigureMinTrans"
## [106] "1NonFigureMinEss" "1NonFigureMinCreat" "1NonFigureMinTransR"
## [109] "1NonFigureMinEssR" "1NonFigureMinCreatR" "1NonFigureMaxTrans"
## [112] "1NonFigureMaxEss" "1NonFigureMaxCreat" "1NonFigureMaxTransR"
## [115] "1NonFigureMaxEssR" "1NonFigureMaxCreatR" "2NonFigureNoneTrans"
## [118] "2NonFigureNoneEss" "2NonFigureNoneCreat" "2NonFigureNoneTransR"
## [121] "2NonFigureNoneEssR" "2NonFigureNoneCreatR" "2NonFigureMinTrans"
## [124] "2NonFigureMinEss" "2NonFigureMinCreat" "2NonFigureMinTransR"
## [127] "2NonFigureMinEssR" "2NonFigureMinCreatR" "2NonFigureMaxTrans"
## [130] "2NonFigureMaxEss" "2NonFigureMaxCreat" "2NonFigureMaxTransR"
## [133] "2NonFigureMaxEssR" "2NonFigureMaxCreatR" "3NonFigureNoneTrans"
## [136] "3NonFigureNoneEss" "3NonFigureNoneCreat" "3NonFigureNoneTransR"
## [139] "3NonFigureNoneEssR" "3NonFigureNoneCreatR" "3NonFigureMinTrans"
## [142] "3NonFigureMinEss" "3NonFigureMinCreat" "3NonFigureMinTransR"
## [145] "3NonFigureMinEssR" "3NonFigureMinCreatR" "3NonFigureMaxTrans"
## [148] "3NonFigureMaxEss" "3NonFigureMaxCreat" "3NonFigureMaxTransR"
## [151] "3NonFigureMaxEssR" "3NonFigureMaxCreatR" "4NonFigureNoneTrans"
## [154] "4NonFigureNoneEss" "4NonFigureNoneCreat" "4NonFigureNoneTransR"
## [157] "4NonFigureNoneEssR" "4NonFigureNoneCreatR" "4NonFigureMinTrans"
## [160] "4NonFigureMinEss" "4NonFigureMinCreat" "4NonFigureMinTransR"
## [163] "4NonFigureMinEssR" "4NonFigureMinCreatR" "4NonFigureMaxTrans"
## [166] "4NonFigureMaxEss" "4NonFigureMaxCreat" "4NonFigureMaxTransR"
## [169] "4NonFigureMaxEssR" "4NonFigureMaxCreatR" "5NonFigureNoneTrans"
## [172] "5NonFigureNoneEss" "5NonFigureNoneCreat" "5NonFigureNoneTransR"
## [175] "5NonFigureNoneEssR" "5NonFigureNoneCreatR" "5NonFigureMinTrans"
## [178] "5NonFigureMinEss" "5NonFigureMinCreat" "5NonFigureMinTransR"
## [181] "5NonFigureMinEssR" "5NonFigureMinCreatR" "5NonFigureMaxTrans"
## [184] "5NonFigureMaxEss" "5NonFigureMaxCreat" "5NonFigureMaxTransR"
## [187] "5NonFigureMaxEssR" "5NonFigureMaxCreatR" "AttentionCheck2"
## [190] "Seriousness" "CommentFeedback" "Race"
## [193] "Gender" "Age" "Language"
## [196] "Experience" "Additional" "hour1_count"
## [199] "hour10_count" "hour100_count" "Image1_Time"
## [202] "Image2_Time" "Image3_Time" "Image4_Time"
## [205] "Image5_Time" "Image6_Time" "Image1"
## [208] "Image2" "Image3" "Image4"
## [211] "Image5" "Image6"Initial Data Loading and Preparation
# Read the data from specified path
data <- read_csv(DATA_PATH)## Rows: 117 Columns: 212
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (203): ConsentForm, DateofConsent, Type, AttentionCheck, 1FigureNoneTran...
## dbl (8): Progress, Duration (in seconds), id, AttentionCheck2, Age, hour1_...
## lgl (1): Finished
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Convert all columns to character type for consistent handling
data <- data %>%
mutate(across(everything(), as.character))
# Verify data structure
glimpse(data)## Rows: 117
## Columns: 212
## $ Progress <chr> "100", "100", "100", "100", "100", "100", "100…
## $ `Duration (in seconds)` <chr> "1708", "1402", "3428", "1695", "1701", "3750"…
## $ Finished <chr> "TRUE", "TRUE", "TRUE", "TRUE", "TRUE", "TRUE"…
## $ id <chr> "69675", "67641", "69515", "69873", "62784", "…
## $ ConsentForm <chr> "I consent to this study.", "I consent to this…
## $ DateofConsent <chr> "1/27/25", "1/27/25", "1/27/25", "1/27/25", "1…
## $ Type <chr> "Human", "Human", "Human", "AI", "Human", "AI"…
## $ AttentionCheck <chr> "Viewing images for a set amount of time and a…
## $ `1FigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `1FigureNoneEss` <chr> "No change in essence", "No change in essence"…
## $ `1FigureNoneCreat` <chr> "No creativity involved", "No creativity invol…
## $ `1FigureNoneTransR` <chr> "I see no change in the pictures.", "They look…
## $ `1FigureNoneEssR` <chr> "I see no change in the pictures.", "They look…
## $ `1FigureNoneCreatR` <chr> "I see no change.", "They look the exact same …
## $ `1FigureMinTrans` <chr> "Moderately transformative", "Slightly transfo…
## $ `1FigureMinEss` <chr> "Moderate change in essence", "Very little cha…
## $ `1FigureMinCreat` <chr> "Minimal creativity involved", "No creativity …
## $ `1FigureMinTransR` <chr> "I think this magnifies what is going on insid…
## $ `1FigureMinEssR` <chr> "The essence is now sad and looks to me like l…
## $ `1FigureMinCreatR` <chr> "There is some creativity in changing the whol…
## $ `1FigureMaxTrans` <chr> "Very transformative", "Very transformative", …
## $ `1FigureMaxEss` <chr> "Moderate change in essence", "Moderate change…
## $ `1FigureMaxCreat` <chr> "Significant creativity involved", "Moderate c…
## $ `1FigureMaxTransR` <chr> "This transformed the photo to older years, an…
## $ `1FigureMaxEssR` <chr> "The mood of this now is sad, less electric.",…
## $ `1FigureMaxCreatR` <chr> "Creativity is huge in this, as the whole pict…
## $ `2FigureNoneTrans` <chr> NA, NA, "Not at all transformative", "Not at a…
## $ `2FigureNoneEss` <chr> NA, NA, "No change in essence", "No change in …
## $ `2FigureNoneCreat` <chr> NA, NA, "No creativity involved", "No creativi…
## $ `2FigureNoneTransR` <chr> NA, NA, "The images are so similar that there …
## $ `2FigureNoneEssR` <chr> NA, NA, "The essence remained the same because…
## $ `2FigureNoneCreatR` <chr> NA, NA, "The was no creativity because they lo…
## $ `2FigureMinTrans` <chr> NA, NA, "Moderately transformative", "Slightly…
## $ `2FigureMinEss` <chr> NA, NA, "Moderate change in essence", "Very li…
## $ `2FigureMinCreat` <chr> NA, NA, "No creativity involved", "Minimal cre…
## $ `2FigureMinTransR` <chr> NA, NA, "There is a different meaning in the s…
## $ `2FigureMinEssR` <chr> NA, NA, "Because it is darker, the feeling of …
## $ `2FigureMinCreatR` <chr> NA, NA, "The images do not differ very much.",…
## $ `2FigureMaxTrans` <chr> NA, NA, "Slightly transformative", "Moderately…
## $ `2FigureMaxEss` <chr> NA, NA, "Moderate change in essence", "Moderat…
## $ `2FigureMaxCreat` <chr> NA, NA, "Significant creativity involved", "Mo…
## $ `2FigureMaxTransR` <chr> NA, NA, "There was a change in style but there…
## $ `2FigureMaxEssR` <chr> NA, NA, "I feel like there is a slightly diffe…
## $ `2FigureMaxCreatR` <chr> NA, NA, "I felt like this was very creative. I…
## $ `3FigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `3FigureNoneEss` <chr> "No change in No change in essence", "No chang…
## $ `3FigureNoneCreat` <chr> "No creativity involved", "No creativity invol…
## $ `3FigureNoneTransR` <chr> "I see no change in the pictures.", "They look…
## $ `3FigureNoneEssR` <chr> "I see no change.", "They look the same", NA, …
## $ `3FigureNoneCreatR` <chr> "I see no change.", "they look the same.", NA,…
## $ `3FigureMinTrans` <chr> "Slightly transformative", "Not at all transfo…
## $ `3FigureMinEss` <chr> "Very little change in essence", "Very little …
## $ `3FigureMinCreat` <chr> "No creativity involved", "No creativity invol…
## $ `3FigureMinTransR` <chr> "The fire looks as though it burns stronger an…
## $ `3FigureMinEssR` <chr> "With the increased fire color intensity, it m…
## $ `3FigureMinCreatR` <chr> "No change in creativity as the picture didnt …
## $ `3FigureMaxTrans` <chr> "Very transformative", "Moderately transformat…
## $ `3FigureMaxEss` <chr> "Significant change in essence", "Moderate cha…
## $ `3FigureMaxCreat` <chr> "Significant creativity involved", "Minimal cr…
## $ `3FigureMaxTransR` <chr> "The photo is transformed into electronic and …
## $ `3FigureMaxEssR` <chr> "The vide of the photo is now more friendly an…
## $ `3FigureMaxCreatR` <chr> "There is now more creativity, as a background…
## $ `4FigureNoneTrans` <chr> NA, NA, "Not at all transformative", NA, NA, "…
## $ `4FigureNoneEss` <chr> NA, NA, "No change in essence", NA, NA, "No ch…
## $ `4FigureNoneCreat` <chr> NA, NA, "No creativity involved", NA, NA, "Sig…
## $ `4FigureNoneTransR` <chr> NA, NA, "The images are so similar that it doe…
## $ `4FigureNoneEssR` <chr> NA, NA, "There is no difference in feeling bet…
## $ `4FigureNoneCreatR` <chr> NA, NA, "The images are so similar, so there i…
## $ `4FigureMinTrans` <chr> NA, NA, "Very transformative", NA, NA, "Slight…
## $ `4FigureMinEss` <chr> NA, NA, "Moderate change in essence", NA, NA, …
## $ `4FigureMinCreat` <chr> NA, NA, "Minimal creativity involved", NA, NA,…
## $ `4FigureMinTransR` <chr> NA, NA, "It feels like there is a fair amount …
## $ `4FigureMinEssR` <chr> NA, NA, "The feeling in the image changed a fa…
## $ `4FigureMinCreatR` <chr> NA, NA, "The images are so similar that there …
## $ `4FigureMaxTrans` <chr> NA, NA, "Very transformative", NA, NA, "Modera…
## $ `4FigureMaxEss` <chr> NA, NA, "Significant change in essence", NA, N…
## $ `4FigureMaxCreat` <chr> NA, NA, "Moderate creativity involved", NA, NA…
## $ `4FigureMaxTransR` <chr> NA, NA, "Due to the style change there is a co…
## $ `4FigureMaxEssR` <chr> NA, NA, "The feeling of the image totally chan…
## $ `4FigureMaxCreatR` <chr> NA, NA, "I feel like the second one is fairly …
## $ `5FigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `5FigureNoneEss` <chr> "No change in essence", "No change in essence"…
## $ `5FigureNoneCreat` <chr> "No creativity involved", "No creativity invol…
## $ `5FigureNoneTransR` <chr> "No change.", "I can't tell the difference bet…
## $ `5FigureNoneEssR` <chr> "No change.", "I can't tell the difference bet…
## $ `5FigureNoneCreatR` <chr> "No change.", "I can't tell the difference bet…
## $ `5FigureMinTrans` <chr> "Slightly transformative", "Moderately transfo…
## $ `5FigureMinEss` <chr> "Very little change in essence", "Very little …
## $ `5FigureMinCreat` <chr> "No creativity involved", "No creativity invol…
## $ `5FigureMinTransR` <chr> "The change in filter transforms the picture t…
## $ `5FigureMinEssR` <chr> "The change in skin tone and the darkness look…
## $ `5FigureMinCreatR` <chr> "The picture didnt change just the filter.", "…
## $ `5FigureMaxTrans` <chr> "Very transformative", "Very transformative", …
## $ `5FigureMaxEss` <chr> "Complete change in essence", "Moderate change…
## $ `5FigureMaxCreat` <chr> "Significant creativity involved", "Significan…
## $ `5FigureMaxTransR` <chr> "It transforms into a different story and shap…
## $ `5FigureMaxEssR` <chr> "The mood immediately lightens and looks less …
## $ `5FigureMaxCreatR` <chr> "So much changes in the design and creativity …
## $ `1NonFigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `1NonFigureNoneEss` <chr> "No change in essence", "No change in essence"…
## $ `1NonFigureNoneCreat` <chr> "No creativity involved", "No creativity invol…
## $ `1NonFigureNoneTransR` <chr> "I see no change in the 2 pictures.", "They lo…
## $ `1NonFigureNoneEssR` <chr> "I see no change in the 2 pictures.", "They lo…
## $ `1NonFigureNoneCreatR` <chr> "I see no change in the 2 pictures.", "They lo…
## $ `1NonFigureMinTrans` <chr> "Slightly transformative", "Very transformativ…
## $ `1NonFigureMinEss` <chr> "Moderate change in essence", "Significant cha…
## $ `1NonFigureMinCreat` <chr> "No creativity involved", "Significant creativ…
## $ `1NonFigureMinTransR` <chr> "The second picture has a darker orange tone o…
## $ `1NonFigureMinEssR` <chr> "The essence is a little creepier in the secon…
## $ `1NonFigureMinCreatR` <chr> "No creativity, just a different filter over t…
## $ `1NonFigureMaxTrans` <chr> "Slightly transformative", "Moderately transfo…
## $ `1NonFigureMaxEss` <chr> "Moderate change in essence", "Moderate change…
## $ `1NonFigureMaxCreat` <chr> "Minimal creativity involved", "Minimal creati…
## $ `1NonFigureMaxTransR` <chr> "The second picture was made into clipart whic…
## $ `1NonFigureMaxEssR` <chr> "It gives a more kid sense and less realistic,…
## $ `1NonFigureMaxCreatR` <chr> "The first one seems more creative to me.", "I…
## $ `2NonFigureNoneTrans` <chr> "Not at all transformative", NA, "Not at all t…
## $ `2NonFigureNoneEss` <chr> "No change in essence", NA, "No change in esse…
## $ `2NonFigureNoneCreat` <chr> "No creativity involved", NA, "No creativity i…
## $ `2NonFigureNoneTransR` <chr> "I see no change in the pictures.", NA, "There…
## $ `2NonFigureNoneEssR` <chr> "I see no change in the pictures.", NA, "Becau…
## $ `2NonFigureNoneCreatR` <chr> "I see no change in the pictures.", NA, "The t…
## $ `2NonFigureMinTrans` <chr> "Not at all transformative", NA, "Slightly tra…
## $ `2NonFigureMinEss` <chr> "Very little change in essence", NA, "Moderate…
## $ `2NonFigureMinCreat` <chr> "No creativity involved", NA, "Minimal creativ…
## $ `2NonFigureMinTransR` <chr> "I don't think the slight change makes a diffe…
## $ `2NonFigureMinEssR` <chr> "The faded look makes it look a little less ap…
## $ `2NonFigureMinCreatR` <chr> "No creativity just a more faded filter.", NA,…
## $ `2NonFigureMaxTrans` <chr> "Very transformative", NA, "Highly transformat…
## $ `2NonFigureMaxEss` <chr> "Significant change in essence", NA, "Complete…
## $ `2NonFigureMaxCreat` <chr> "Significant creativity involved", NA, "A grea…
## $ `2NonFigureMaxTransR` <chr> "This one is almost completely different. It …
## $ `2NonFigureMaxEssR` <chr> "The essence of the second is completely diffe…
## $ `2NonFigureMaxCreatR` <chr> "This one involves creativity with the new col…
## $ `3NonFigureNoneTrans` <chr> "Not at all transformative", "Not at all trans…
## $ `3NonFigureNoneEss` <chr> "No change in essence", "No change in essence"…
## $ `3NonFigureNoneCreat` <chr> "No creativity involved", "Minimal creativity …
## $ `3NonFigureNoneTransR` <chr> "The second one didn't change from the first."…
## $ `3NonFigureNoneEssR` <chr> "The second one didn't change from the first."…
## $ `3NonFigureNoneCreatR` <chr> "The second one didn't change from the first."…
## $ `3NonFigureMinTrans` <chr> "Slightly transformative", "Moderately transfo…
## $ `3NonFigureMinEss` <chr> "Moderate change in essence", "No change in es…
## $ `3NonFigureMinCreat` <chr> "No creativity involved", "Minimal creativity …
## $ `3NonFigureMinTransR` <chr> "The second one was darkened. It transforms t…
## $ `3NonFigureMinEssR` <chr> "It looks darker and gives a more scary and la…
## $ `3NonFigureMinCreatR` <chr> "The creativity did not chang, as it was just …
## $ `3NonFigureMaxTrans` <chr> "Slightly transformative", "Highly transformat…
## $ `3NonFigureMaxEss` <chr> "Significant change in essence", "Significant …
## $ `3NonFigureMaxCreat` <chr> "Minimal creativity involved", "Moderate creat…
## $ `3NonFigureMaxTransR` <chr> "I feel like the second one is more simple and…
## $ `3NonFigureMaxEssR` <chr> "The second one does give me more emotions and…
## $ `3NonFigureMaxCreatR` <chr> "I feel like the second one is more boring and…
## $ `4NonFigureNoneTrans` <chr> NA, "Not at all transformative", NA, "Not at a…
## $ `4NonFigureNoneEss` <chr> NA, "No change in essence", NA, "No change in …
## $ `4NonFigureNoneCreat` <chr> NA, "No creativity involved", NA, "No creativi…
## $ `4NonFigureNoneTransR` <chr> NA, "They look like the same exact image to me…
## $ `4NonFigureNoneEssR` <chr> NA, "They look like the same exact image to me…
## $ `4NonFigureNoneCreatR` <chr> NA, "They look like the same exact image to me…
## $ `4NonFigureMinTrans` <chr> NA, "Not at all transformative", NA, "Not at a…
## $ `4NonFigureMinEss` <chr> NA, "No change in essence", NA, "No change in …
## $ `4NonFigureMinCreat` <chr> NA, "No creativity involved", NA, "No creativi…
## $ `4NonFigureMinTransR` <chr> NA, "The only difference I noticed was the sky…
## $ `4NonFigureMinEssR` <chr> NA, "Again, the sky changing didn't change my …
## $ `4NonFigureMinCreatR` <chr> NA, "Changing sky colors doesn't take much eff…
## $ `4NonFigureMaxTrans` <chr> NA, "Highly transformative", NA, "Moderately t…
## $ `4NonFigureMaxEss` <chr> NA, "Complete change in essence", NA, "Moderat…
## $ `4NonFigureMaxCreat` <chr> NA, "A great deal of creativity involved", NA,…
## $ `4NonFigureMaxTransR` <chr> NA, "They changed everything besides the scene…
## $ `4NonFigureMaxEssR` <chr> NA, "The different art style gives a completel…
## $ `4NonFigureMaxCreatR` <chr> NA, "They changed the whole style of the art a…
## $ `5NonFigureNoneTrans` <chr> NA, NA, "Not at all transformative", NA, NA, "…
## $ `5NonFigureNoneEss` <chr> NA, NA, "No change in essence", NA, NA, "No ch…
## $ `5NonFigureNoneCreat` <chr> NA, NA, "No creativity involved", NA, NA, "Sig…
## $ `5NonFigureNoneTransR` <chr> NA, NA, "They look exactly the same.", NA, NA,…
## $ `5NonFigureNoneEssR` <chr> NA, NA, "Because the images look identical the…
## $ `5NonFigureNoneCreatR` <chr> NA, NA, "It seems like there is no creativity …
## $ `5NonFigureMinTrans` <chr> NA, NA, "Slightly transformative", NA, NA, "Ve…
## $ `5NonFigureMinEss` <chr> NA, NA, "Very little change in essence", NA, N…
## $ `5NonFigureMinCreat` <chr> NA, NA, "Minimal creativity involved", NA, NA,…
## $ `5NonFigureMinTransR` <chr> NA, NA, "The meaning slightly changed with the…
## $ `5NonFigureMinEssR` <chr> NA, NA, "The second image felt like it had a d…
## $ `5NonFigureMinCreatR` <chr> NA, NA, "The colors were more vibrant and seem…
## $ `5NonFigureMaxTrans` <chr> NA, NA, "Highly transformative", NA, NA, "Very…
## $ `5NonFigureMaxEss` <chr> NA, NA, "Complete change in essence", NA, NA, …
## $ `5NonFigureMaxCreat` <chr> NA, NA, "Moderate creativity involved", NA, NA…
## $ `5NonFigureMaxTransR` <chr> NA, NA, "The meaning is totally different in t…
## $ `5NonFigureMaxEssR` <chr> NA, NA, "The feeling in the second one totally…
## $ `5NonFigureMaxCreatR` <chr> NA, NA, "There was creativity, but there was l…
## $ AttentionCheck2 <chr> "15", "15", "15", "15", "15", "15", "15", "15"…
## $ Seriousness <chr> "Yes, I did", "Yes, I did", "Yes, I did", "Yes…
## $ CommentFeedback <chr> NA, NA, NA, NA, NA, "N/A", NA, NA, NA, "One of…
## $ Race <chr> "White or Caucasian", "White or Caucasian,Asia…
## $ Gender <chr> "Female", "Female", "Male", "Female", "Male", …
## $ Age <chr> "18", "19", "24", "21", "21", "20", "22", "21"…
## $ Language <chr> "English", "English", "English", "English", "E…
## $ Experience <chr> "Moderate formal training or experience", "No …
## $ Additional <chr> NA, NA, NA, "I would like to change my answer …
## $ hour1_count <chr> "2", "2", "2", "2", "2", "2", "2", "2", "2", "…
## $ hour10_count <chr> "2", "2", "2", "2", "2", "2", "2", "2", "2", "…
## $ hour100_count <chr> "2", "2", "2", "2", "2", "2", "2", "2", "2", "…
## $ Image1_Time <chr> "10 hours", "100 hours", "10 hours", "10 hours…
## $ Image2_Time <chr> "less than 1 hour", "less than 1 hour", "10 ho…
## $ Image3_Time <chr> "10 hours", "100 hours", "10 hours", "less tha…
## $ Image4_Time <chr> "100 hours", "10 hours", "less than 1 hour", "…
## $ Image5_Time <chr> "less than 1 hour", "10 hours", "100 hours", "…
## $ Image6_Time <chr> "100 hours", "less than 1 hour", "less than 1 …
## $ Image1 <chr> "Image3_Nonfigure", "Image3_Nonfigure", "Image…
## $ Image2 <chr> "Image1_Nonfigure", "Image1_Nonfigure", "Image…
## $ Image3 <chr> "Image2_Nonfigure", "Image4_Nonfigure", "Image…
## $ Image4 <chr> "Image1_Figure", "Image5_Figure", "Image5_Nonf…
## $ Image5 <chr> "Image3_Figure", "Image1_Figure", "Image4_Figu…
## $ Image6 <chr> "Image5_Figure", "Image3_Figure", "Image2_Figu…# See data headings
colnames(data)## [1] "Progress" "Duration (in seconds)" "Finished"
## [4] "id" "ConsentForm" "DateofConsent"
## [7] "Type" "AttentionCheck" "1FigureNoneTrans"
## [10] "1FigureNoneEss" "1FigureNoneCreat" "1FigureNoneTransR"
## [13] "1FigureNoneEssR" "1FigureNoneCreatR" "1FigureMinTrans"
## [16] "1FigureMinEss" "1FigureMinCreat" "1FigureMinTransR"
## [19] "1FigureMinEssR" "1FigureMinCreatR" "1FigureMaxTrans"
## [22] "1FigureMaxEss" "1FigureMaxCreat" "1FigureMaxTransR"
## [25] "1FigureMaxEssR" "1FigureMaxCreatR" "2FigureNoneTrans"
## [28] "2FigureNoneEss" "2FigureNoneCreat" "2FigureNoneTransR"
## [31] "2FigureNoneEssR" "2FigureNoneCreatR" "2FigureMinTrans"
## [34] "2FigureMinEss" "2FigureMinCreat" "2FigureMinTransR"
## [37] "2FigureMinEssR" "2FigureMinCreatR" "2FigureMaxTrans"
## [40] "2FigureMaxEss" "2FigureMaxCreat" "2FigureMaxTransR"
## [43] "2FigureMaxEssR" "2FigureMaxCreatR" "3FigureNoneTrans"
## [46] "3FigureNoneEss" "3FigureNoneCreat" "3FigureNoneTransR"
## [49] "3FigureNoneEssR" "3FigureNoneCreatR" "3FigureMinTrans"
## [52] "3FigureMinEss" "3FigureMinCreat" "3FigureMinTransR"
## [55] "3FigureMinEssR" "3FigureMinCreatR" "3FigureMaxTrans"
## [58] "3FigureMaxEss" "3FigureMaxCreat" "3FigureMaxTransR"
## [61] "3FigureMaxEssR" "3FigureMaxCreatR" "4FigureNoneTrans"
## [64] "4FigureNoneEss" "4FigureNoneCreat" "4FigureNoneTransR"
## [67] "4FigureNoneEssR" "4FigureNoneCreatR" "4FigureMinTrans"
## [70] "4FigureMinEss" "4FigureMinCreat" "4FigureMinTransR"
## [73] "4FigureMinEssR" "4FigureMinCreatR" "4FigureMaxTrans"
## [76] "4FigureMaxEss" "4FigureMaxCreat" "4FigureMaxTransR"
## [79] "4FigureMaxEssR" "4FigureMaxCreatR" "5FigureNoneTrans"
## [82] "5FigureNoneEss" "5FigureNoneCreat" "5FigureNoneTransR"
## [85] "5FigureNoneEssR" "5FigureNoneCreatR" "5FigureMinTrans"
## [88] "5FigureMinEss" "5FigureMinCreat" "5FigureMinTransR"
## [91] "5FigureMinEssR" "5FigureMinCreatR" "5FigureMaxTrans"
## [94] "5FigureMaxEss" "5FigureMaxCreat" "5FigureMaxTransR"
## [97] "5FigureMaxEssR" "5FigureMaxCreatR" "1NonFigureNoneTrans"
## [100] "1NonFigureNoneEss" "1NonFigureNoneCreat" "1NonFigureNoneTransR"
## [103] "1NonFigureNoneEssR" "1NonFigureNoneCreatR" "1NonFigureMinTrans"
## [106] "1NonFigureMinEss" "1NonFigureMinCreat" "1NonFigureMinTransR"
## [109] "1NonFigureMinEssR" "1NonFigureMinCreatR" "1NonFigureMaxTrans"
## [112] "1NonFigureMaxEss" "1NonFigureMaxCreat" "1NonFigureMaxTransR"
## [115] "1NonFigureMaxEssR" "1NonFigureMaxCreatR" "2NonFigureNoneTrans"
## [118] "2NonFigureNoneEss" "2NonFigureNoneCreat" "2NonFigureNoneTransR"
## [121] "2NonFigureNoneEssR" "2NonFigureNoneCreatR" "2NonFigureMinTrans"
## [124] "2NonFigureMinEss" "2NonFigureMinCreat" "2NonFigureMinTransR"
## [127] "2NonFigureMinEssR" "2NonFigureMinCreatR" "2NonFigureMaxTrans"
## [130] "2NonFigureMaxEss" "2NonFigureMaxCreat" "2NonFigureMaxTransR"
## [133] "2NonFigureMaxEssR" "2NonFigureMaxCreatR" "3NonFigureNoneTrans"
## [136] "3NonFigureNoneEss" "3NonFigureNoneCreat" "3NonFigureNoneTransR"
## [139] "3NonFigureNoneEssR" "3NonFigureNoneCreatR" "3NonFigureMinTrans"
## [142] "3NonFigureMinEss" "3NonFigureMinCreat" "3NonFigureMinTransR"
## [145] "3NonFigureMinEssR" "3NonFigureMinCreatR" "3NonFigureMaxTrans"
## [148] "3NonFigureMaxEss" "3NonFigureMaxCreat" "3NonFigureMaxTransR"
## [151] "3NonFigureMaxEssR" "3NonFigureMaxCreatR" "4NonFigureNoneTrans"
## [154] "4NonFigureNoneEss" "4NonFigureNoneCreat" "4NonFigureNoneTransR"
## [157] "4NonFigureNoneEssR" "4NonFigureNoneCreatR" "4NonFigureMinTrans"
## [160] "4NonFigureMinEss" "4NonFigureMinCreat" "4NonFigureMinTransR"
## [163] "4NonFigureMinEssR" "4NonFigureMinCreatR" "4NonFigureMaxTrans"
## [166] "4NonFigureMaxEss" "4NonFigureMaxCreat" "4NonFigureMaxTransR"
## [169] "4NonFigureMaxEssR" "4NonFigureMaxCreatR" "5NonFigureNoneTrans"
## [172] "5NonFigureNoneEss" "5NonFigureNoneCreat" "5NonFigureNoneTransR"
## [175] "5NonFigureNoneEssR" "5NonFigureNoneCreatR" "5NonFigureMinTrans"
## [178] "5NonFigureMinEss" "5NonFigureMinCreat" "5NonFigureMinTransR"
## [181] "5NonFigureMinEssR" "5NonFigureMinCreatR" "5NonFigureMaxTrans"
## [184] "5NonFigureMaxEss" "5NonFigureMaxCreat" "5NonFigureMaxTransR"
## [187] "5NonFigureMaxEssR" "5NonFigureMaxCreatR" "AttentionCheck2"
## [190] "Seriousness" "CommentFeedback" "Race"
## [193] "Gender" "Age" "Language"
## [196] "Experience" "Additional" "hour1_count"
## [199] "hour10_count" "hour100_count" "Image1_Time"
## [202] "Image2_Time" "Image3_Time" "Image4_Time"
## [205] "Image5_Time" "Image6_Time" "Image1"
## [208] "Image2" "Image3" "Image4"
## [211] "Image5" "Image6"Data Restructuring to Long Format
# Step 1: Create a helper function to extract image information
extract_image_info <- function(image_value) {
# Example input: "Image3_Figure" or "Image1_Nonfigure"
# Split the string and extract components
parts <- str_match(image_value, "Image(\\d+)_(\\w+)")
list(
image_number = parts[2],
image_type = ifelse(parts[3] == "Nonfigure", "NonFigure", "Figure")
)
}# Step 2: Create a mapping dataframe for each participant's image viewing
create_image_mapping <- function(data) {
data %>%
select(id, Type, starts_with("Image")) %>%
pivot_longer(
cols = c(starts_with("Image"), -ends_with("Time")),
names_to = "image_slot",
values_to = "image_seen"
) %>%
# Add time information
mutate(
slot_number = str_extract(image_slot, "\\d"),
time_col = paste0("Image", slot_number, "_Time")
) %>%
# Join with time information
rowwise() %>%
mutate(
effort_level = data[[time_col]][1],
# Extract image information
info = list(extract_image_info(image_seen)),
image_number = info$image_number,
image_type = info$image_type
) %>%
select(-info, -time_col)
}# Step 3: Create functions to extract response data
get_response_columns <- function(image_number, image_type) {
# Base patterns for different modification levels
patterns <- c(
"None" = paste0(image_number, image_type, "None"),
"Min" = paste0(image_number, image_type, "Min"),
"Max" = paste0(image_number, image_type, "Max")
)
# Create patterns for all response types
response_cols <- lapply(patterns, function(p) {
c(
trans = paste0(p, "Trans"),
ess = paste0(p, "Ess"),
creat = paste0(p, "Creat"),
trans_resp = paste0(p, "TransR"),
ess_resp = paste0(p, "EssR"),
creat_resp = paste0(p, "CreatR")
)
})
unlist(response_cols)
}# Step 4: Transform data to long format
transform_to_long <- function(data) {
# Keep existing image mapping
image_mapping <- create_image_mapping(data)
results <- list()
for(participant_id in unique(data$id)) {
participant_data <- data %>% filter(id == participant_id)
participant_mapping <- image_mapping %>% filter(id == participant_id)
for(i in 1:nrow(participant_mapping)) {
mapping_row <- participant_mapping[i,]
response_cols <- get_response_columns(
mapping_row$image_number,
mapping_row$image_type
)
# Modified response extraction with more explicit pattern matching
responses <- participant_data %>%
select(all_of(response_cols)) %>%
pivot_longer(
cols = everything(),
names_to = "temp_name",
values_to = "response"
) %>%
mutate(
# Extract modification pattern
modification = case_when(
str_detect(temp_name, "None") ~ "No Modification",
str_detect(temp_name, "Min") ~ "Slight Modification",
str_detect(temp_name, "Max") ~ "Dramatic Modification"
),
# Revised measure extraction
measure = case_when(
# For rating responses
str_detect(temp_name, "Trans$") ~ "Transformative Perception",
str_detect(temp_name, "Ess$") ~ "Essence Change",
str_detect(temp_name, "Creat$") ~ "Perceived Creativity",
# For reasoning responses
str_detect(temp_name, "TransR$") ~ "Reasoning Explanation (Transformative)",
str_detect(temp_name, "EssR$") ~ "Reasoning Explanation (Essence)",
str_detect(temp_name, "CreatR$") ~ "Reasoning Explanation (Creativity)"
),
# Simplified response type detection
response_type = if_else(str_detect(temp_name, "R$"), "Reasoning", "Rating")
) %>%
select(-temp_name) %>%
mutate(
id = participant_id,
Type = participant_data$Type,
effort_level = mapping_row$effort_level,
image_number = mapping_row$image_number,
image_type = mapping_row$image_type,
image_slot = mapping_row$image_slot
)
results[[length(results) + 1]] <- responses
}
}
# Combine and convert to factors with explicit checks
combined_data <- bind_rows(results) %>%
mutate(
modification = factor(modification, levels = modification_levels),
measure = factor(measure, levels = question_types),
effort_level = factor(effort_level, levels = effort_levels),
response_type = factor(response_type)
)
# Add verification step to check measure assignments
print("Checking measure assignments before saving:")
print(table(combined_data$measure, useNA = "always"))
return(combined_data)
}# Step 5: Execute the transformation
long_data <- transform_to_long(data)## [1] "Checking measure assignments before saving:"
##
## Transformative Perception Essence Change
## 0 0
## Perceived Creativity Reasoning Explanation (Transformative)
## 0 0
## Reasoning Explanation (Essence) Reasoning Explanation (Creativity)
## 0 0
## <NA>
## 12636# Add verification steps
print("Checking factor levels:")## [1] "Checking factor levels:"str(long_data)## tibble [12,636 × 10] (S3: tbl_df/tbl/data.frame)
## $ response : chr [1:12636] "Not at all transformative" "No change in essence" "No creativity involved" "The second one didn't change from the first." ...
## $ modification : Factor w/ 3 levels "No Modification",..: 1 1 1 1 1 1 2 2 2 2 ...
## $ measure : Factor w/ 6 levels "Transformative Perception",..: NA NA NA NA NA NA NA NA NA NA ...
## $ response_type: Factor w/ 1 level "Rating": 1 1 1 1 1 1 1 1 1 1 ...
## $ id : chr [1:12636] "69675" "69675" "69675" "69675" ...
## $ Type : chr [1:12636] "Human" "Human" "Human" "Human" ...
## $ effort_level : Factor w/ 3 levels "less than 1 hour",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ image_number : chr [1:12636] "3" "3" "3" "3" ...
## $ image_type : chr [1:12636] "NonFigure" "NonFigure" "NonFigure" "NonFigure" ...
## $ image_slot : chr [1:12636] "Image1" "Image1" "Image1" "Image1" ...print("\nModification level counts:")## [1] "\nModification level counts:"table(long_data$modification)##
## No Modification Slight Modification Dramatic Modification
## 4212 4212 4212print("\nMeasure type counts:")## [1] "\nMeasure type counts:"table(long_data$measure)##
## Transformative Perception Essence Change
## 0 0
## Perceived Creativity Reasoning Explanation (Transformative)
## 0 0
## Reasoning Explanation (Essence) Reasoning Explanation (Creativity)
## 0 0print("\nResponse type counts:")## [1] "\nResponse type counts:"table(long_data$response_type)##
## Rating
## 12636# Save the transformed data
write_csv(long_data, "long_data_notbyhand.csv")# Step 6: Input Hand Edited Data (measures not able to work)
long_data_handedit_path <- "/Users/dgkamper/Library/CloudStorage/GoogleDrive-dgkamper@gmail.com/My Drive/DGK Lab/Reasoning Lab/DGK Lab - Copyrightability and AI Art/Analysis/AI Visual Art/long_data_study2.csv"
# Read the data from specified path
long_data <- read_csv(long_data_handedit_path)## Rows: 12636 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): response, modification, measure, response_type, Type, effort_level,...
## dbl (2): id, image_number
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Step 7: Split into separate dataframes by measure type
# Process the transformed data into specific measure datasets
# Transformativeness dataset
transformativeness <- long_data %>%
filter(
measure == "Transformative Perception", # Only get rating responses for transformativeness
response_type == "Rating" # Exclude reasoning responses
) %>%
mutate(Response = case_when( # Convert text responses to numeric values
response == "Not at all transformative" ~ 1,
response == "Slightly transformative" ~ 2,
response == "Moderately transformative" ~ 3,
response == "Very transformative" ~ 4,
response == "Highly transformative" ~ 5,
TRUE ~ NA_real_ # Handle any unexpected values
))
# Essence change dataset
essence_change <- long_data %>%
filter(
measure == "Essence Change",
response_type == "Rating"
) %>%
mutate(Response = case_when(
response == "No change in essence" ~ 1,
response == "Very little change in essence" ~ 2,
response == "Moderate change in essence" ~ 3,
response == "Significant change in essence" ~ 4,
response == "Complete change in essence" ~ 5,
TRUE ~ NA_real_
))
# Creativity dataset
creativity <- long_data %>%
filter(
measure == "Creativity", # Note: This matches our question_types vector
response_type == "Rating"
) %>%
mutate(Response = case_when(
response == "No creativity involved" ~ 1,
response == "Minimal creativity involved" ~ 2,
response == "Moderate creativity involved" ~ 3,
response == "Significant creativity involved" ~ 4,
response == "A great deal of creativity involved" ~ 5,
TRUE ~ NA_real_
))
# Add verification steps to check our conversions worked correctly
print("Checking transformed datasets:")## [1] "Checking transformed datasets:"print("\nTransformativeness response distribution:")## [1] "\nTransformativeness response distribution:"table(transformativeness$Response, useNA = "always")##
## 1 2 3 4 5 <NA>
## 917 461 303 294 127 4print("\nEssence change response distribution:")## [1] "\nEssence change response distribution:"table(essence_change$Response, useNA = "always")##
## 1 2 3 4 5 <NA>
## 823 376 365 309 144 89print("\nCreativity response distribution:")## [1] "\nCreativity response distribution:"table(creativity$Response, useNA = "always")##
## 1 2 3 4 5 <NA>
## 870 498 378 245 115 0# Save the processed datasets
write_csv(transformativeness, "Transformativeness_Longform.csv")
write_csv(essence_change, "EssenceChange_Longform.csv")
write_csv(creativity, "Creativity_Longform.csv")# Double Check Distributions
# First, let's examine the original long data
original_data <- read_csv("long_data_study2.csv")## Rows: 12636 Columns: 10
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): response, modification, measure, response_type, Type, effort_level,...
## dbl (2): id, image_number
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Then examine the transformativeness data
trans_data <- read_csv("Transformativeness_Longform.csv")## Rows: 2106 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): response, modification, measure, response_type, Type, effort_level,...
## dbl (3): id, image_number, Response
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Let's check what happens to a single participant's data
sample_participant <- trans_data %>%
filter(id == first(id)) %>%
arrange(image_slot, modification) %>%
select(id, image_number, image_type, effort_level, modification, Response)
print("Sample participant data structure:")## [1] "Sample participant data structure:"print(sample_participant)## # A tibble: 18 × 6
## id image_number image_type effort_level modification Response
## <dbl> <dbl> <chr> <chr> <chr> <dbl>
## 1 69675 3 NonFigure 10 hours Dramatic Modification 2
## 2 69675 3 NonFigure 10 hours No Modification 1
## 3 69675 3 NonFigure 10 hours Slight Modification 2
## 4 69675 1 NonFigure less than 1 hour Dramatic Modification 2
## 5 69675 1 NonFigure less than 1 hour No Modification 1
## 6 69675 1 NonFigure less than 1 hour Slight Modification 2
## 7 69675 2 NonFigure 10 hours Dramatic Modification 4
## 8 69675 2 NonFigure 10 hours No Modification 1
## 9 69675 2 NonFigure 10 hours Slight Modification 1
## 10 69675 1 Figure 100 hours Dramatic Modification 4
## 11 69675 1 Figure 100 hours No Modification 1
## 12 69675 1 Figure 100 hours Slight Modification 3
## 13 69675 3 Figure less than 1 hour Dramatic Modification 4
## 14 69675 3 Figure less than 1 hour No Modification 1
## 15 69675 3 Figure less than 1 hour Slight Modification 2
## 16 69675 5 Figure 100 hours Dramatic Modification 4
## 17 69675 5 Figure 100 hours No Modification 1
## 18 69675 5 Figure 100 hours Slight Modification 2# Let's check the distribution of images per participant in the original data
original_distribution <- original_data %>%
group_by(id) %>%
summarize(
unique_images = n_distinct(paste(image_number, image_type)),
total_responses = n()
)
print("\nOriginal data image distribution:")## [1] "\nOriginal data image distribution:"print(summary(original_distribution))## id unique_images total_responses
## Min. :58091 Min. :6 Min. :108
## 1st Qu.:65878 1st Qu.:6 1st Qu.:108
## Median :69285 Median :6 Median :108
## Mean :67559 Mean :6 Mean :108
## 3rd Qu.:69513 3rd Qu.:6 3rd Qu.:108
## Max. :69876 Max. :6 Max. :108# Compare with transformativeness data
trans_distribution <- trans_data %>%
group_by(id) %>%
summarize(
unique_images = n_distinct(paste(image_number, image_type)),
total_responses = n()
)
print("\nTransformativeness data image distribution:")## [1] "\nTransformativeness data image distribution:"print(summary(trans_distribution))## id unique_images total_responses
## Min. :58091 Min. :6 Min. :18
## 1st Qu.:65878 1st Qu.:6 1st Qu.:18
## Median :69285 Median :6 Median :18
## Mean :67559 Mean :6 Mean :18
## 3rd Qu.:69513 3rd Qu.:6 3rd Qu.:18
## Max. :69876 Max. :6 Max. :18Descriptive Statistics
Advanced Descriptive Analysis
# First, create a function to calculate core descriptive statistics
# This function will generate means, standard deviations, and confidence intervals
calculate_descriptives <- function(data, dv_name) {
data %>%
group_by(Type, effort_level, modification) %>%
summarise(
n = n(),
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd / sqrt(n),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
) %>%
mutate(Measure = dv_name)
}
# Calculate descriptive statistics for each dependent variable
trans_desc <- calculate_descriptives(transformativeness, "Transformativeness")
essence_desc <- calculate_descriptives(essence_change, "Essence")
creative_desc <- calculate_descriptives(creativity, "Creativity")
# Combine all descriptive statistics into a single dataframe
all_descriptives <- bind_rows(trans_desc, essence_desc, creative_desc)
# Create a more readable format of the descriptive statistics
formatted_stats <- all_descriptives %>%
arrange(Measure, Type, effort_level, modification) %>%
mutate(
# Round numeric columns for cleaner display
across(c(mean, sd, se, ci_lower, ci_upper), ~round(., 3))
) %>%
# Create a formatted output with mean and CI
mutate(
formatted_result = sprintf("%.2f [%.2f, %.2f]", mean, ci_lower, ci_upper)
)
# Print formatted statistics by measure and effort level
for(measure in unique(formatted_stats$Measure)) {
for(effort in unique(formatted_stats$effort_level)) {
cat("\n\n", measure, "- Effort Level:", effort, "\n")
print(
formatted_stats %>%
filter(Measure == measure, effort_level == effort) %>%
select(Type, modification, formatted_result) %>%
pivot_wider(names_from = modification, values_from = formatted_result)
)
}
}##
##
## Creativity - Effort Level: 10 hours
## # A tibble: 2 × 4
## Type `Dramatic Modification` `No Modification` `Slight Modification`
## <chr> <chr> <chr> <chr>
## 1 AI 3.37 [3.19, 3.55] 1.38 [1.23, 1.53] 1.98 [1.83, 2.14]
## 2 Human 3.33 [3.14, 3.52] 1.21 [1.10, 1.33] 1.96 [1.81, 2.10]
##
##
## Creativity - Effort Level: 100 hours
## # A tibble: 2 × 4
## Type `Dramatic Modification` `No Modification` `Slight Modification`
## <chr> <chr> <chr> <chr>
## 1 AI 3.32 [3.13, 3.51] 1.21 [1.10, 1.31] 1.81 [1.66, 1.96]
## 2 Human 3.26 [3.05, 3.47] 1.11 [1.02, 1.20] 1.87 [1.71, 2.03]
##
##
## Creativity - Effort Level: less than 1 hour
## # A tibble: 2 × 4
## Type `Dramatic Modification` `No Modification` `Slight Modification`
## <chr> <chr> <chr> <chr>
## 1 AI 3.57 [3.40, 3.73] 1.29 [1.15, 1.42] 2.00 [1.84, 2.16]
## 2 Human 3.18 [2.98, 3.38] 1.14 [1.03, 1.25] 1.92 [1.76, 2.08]
##
##
## Essence - Effort Level: 10 hours
## # A tibble: 2 × 4
## Type `Dramatic Modification` `No Modification` `Slight Modification`
## <chr> <chr> <chr> <chr>
## 1 AI 3.58 [3.40, 3.77] 1.12 [1.05, 1.19] 1.96 [1.81, 2.11]
## 2 Human 3.74 [3.56, 3.92] 1.05 [1.00, 1.10] 2.16 [1.99, 2.33]
##
##
## Essence - Effort Level: 100 hours
## # A tibble: 2 × 4
## Type `Dramatic Modification` `No Modification` `Slight Modification`
## <chr> <chr> <chr> <chr>
## 1 AI 3.60 [3.41, 3.79] 1.04 [0.99, 1.09] 1.94 [1.77, 2.11]
## 2 Human 3.45 [3.26, 3.64] 1.06 [1.00, 1.12] 2.17 [2.00, 2.34]
##
##
## Essence - Effort Level: less than 1 hour
## # A tibble: 2 × 4
## Type `Dramatic Modification` `No Modification` `Slight Modification`
## <chr> <chr> <chr> <chr>
## 1 AI 3.80 [3.63, 3.97] 1.12 [1.04, 1.20] 2.02 [1.86, 2.18]
## 2 Human 3.55 [3.38, 3.72] 1.03 [1.00, 1.06] 2.20 [2.02, 2.38]
##
##
## Transformativeness - Effort Level: 10 hours
## # A tibble: 2 × 4
## Type `Dramatic Modification` `No Modification` `Slight Modification`
## <chr> <chr> <chr> <chr>
## 1 AI 3.37 [3.17, 3.57] 1.07 [1.02, 1.13] 1.93 [1.77, 2.08]
## 2 Human 3.49 [3.29, 3.69] 1.10 [0.99, 1.20] 2.14 [1.97, 2.32]
##
##
## Transformativeness - Effort Level: 100 hours
## # A tibble: 2 × 4
## Type `Dramatic Modification` `No Modification` `Slight Modification`
## <chr> <chr> <chr> <chr>
## 1 AI 3.47 [3.25, 3.68] 1.01 [0.99, 1.02] 1.89 [1.75, 2.04]
## 2 Human 3.36 [3.16, 3.56] 1.04 [1.00, 1.09] 2.04 [1.89, 2.20]
##
##
## Transformativeness - Effort Level: less than 1 hour
## # A tibble: 2 × 4
## Type `Dramatic Modification` `No Modification` `Slight Modification`
## <chr> <chr> <chr> <chr>
## 1 AI 3.59 [3.39, 3.79] 1.07 [1.02, 1.13] 1.89 [1.75, 2.04]
## 2 Human 3.40 [3.21, 3.59] 1.03 [1.00, 1.06] 2.15 [1.97, 2.34]# Save the results for future reference
write_csv(all_descriptives, "descriptive_statistics_study2.csv")Descriptive Plots
library(tidyverse)
library(ggplot2)
library(gridExtra)##
## Attaching package: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combine# Create plotting function for effort levels
create_effort_plot <- function(data, effort_level) {
# Filter and prepare data for the specific effort level
filtered_data <- data %>%
filter(effort_level == !!effort_level) %>%
# Ensure all factors are properly ordered
mutate(
# Order measures consistently
Measure = factor(Measure,
levels = c("Transformativeness", "Essence", "Creativity")),
# Simplify modification labels for cleaner display
modification = factor(
case_when(
modification == "No Modification" ~ "None",
modification == "Slight Modification" ~ "Slight",
modification == "Dramatic Modification" ~ "Dramatic"
),
levels = c("None", "Slight", "Dramatic")
)
)
# Verify data availability
if(nrow(filtered_data) == 0) {
stop(paste("No data found for effort level:", effort_level))
}
# Create the plot with faceting by measure
ggplot(filtered_data,
aes(x = modification, y = mean, fill = Type)) +
# Create grouped bar plot
geom_bar(stat = "identity",
position = position_dodge(width = 0.9),
width = 0.8) +
# Add error bars showing confidence intervals
geom_errorbar(aes(ymin = ci_lower, ymax = ci_upper),
position = position_dodge(width = 0.9),
width = 0.25,
size = 0.6) +
# Set consistent y-axis scale
scale_y_continuous(limits = c(0, 5), breaks = seq(0, 5, 1)) +
# Use grayscale color scheme
scale_fill_manual(values = c("AI" = "#595959", "Human" = "#A1a1a1")) +
# Create vertical facets for each measure
facet_wrap(~Measure, ncol = 1) +
# Use classic theme as base
theme_classic() +
# Customize theme elements
theme(
text = element_text(family = "Times New Roman"),
axis.title = element_text(size = 12),
axis.text = element_text(size = 10),
strip.text = element_text(size = 12),
strip.background = element_blank(),
axis.title.x = element_text(margin = margin(t = 10)),
axis.title.y = element_text(size = 12),
legend.position = "bottom",
legend.title = element_blank(),
panel.spacing = unit(1, "lines"),
plot.title = element_text(
hjust = 0.5,
face = "bold",
size = 14
)
) +
# Add labels
labs(x = "Modification Level",
y = "Mean Rating",
title = paste("Effort Level:", effort_level))
}
# Create individual plots for each effort level
less_than_1_plot <- try(create_effort_plot(all_descriptives, "less than 1 hour"))## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.ten_hours_plot <- try(create_effort_plot(all_descriptives, "10 hours"))
hundred_hours_plot <- try(create_effort_plot(all_descriptives, "100 hours"))
# Save individual plots with error handling
if(!inherits(less_than_1_plot, "try-error")) {
print(less_than_1_plot)
ggsave("less_than_1_plot.png", less_than_1_plot,
width = 6, height = 8, dpi = 300)
}
if(!inherits(ten_hours_plot, "try-error")) {
print(ten_hours_plot)
ggsave("ten_hours_plot.png", ten_hours_plot,
width = 6, height = 8, dpi = 300)
}
if(!inherits(hundred_hours_plot, "try-error")) {
print(hundred_hours_plot)
ggsave("hundred_hours_plot.png", hundred_hours_plot,
width = 6, height = 8, dpi = 300)
}
# Create and save combined plot if all individual plots exist
if(!any(c(inherits(less_than_1_plot, "try-error"),
inherits(ten_hours_plot, "try-error"),
inherits(hundred_hours_plot, "try-error")))) {
combined_plots <- grid.arrange(less_than_1_plot,
ten_hours_plot,
hundred_hours_plot,
ncol = 3)
ggsave("all_effort_levels.png", combined_plots,
width = 18, height = 8, dpi = 300)
}
Inferential Statistics
Mixed ANOVA
Transformativeness
PART 1: INITIAL DATA PREPARATION AND SPHERICITY TESTING
# Load required libraries
library(tidyverse) # For data manipulation
library(rstatix) # For statistical tests##
## Attaching package: 'rstatix'## The following object is masked from 'package:stats':
##
## filterlibrary(effectsize) # For effect sizes##
## Attaching package: 'effectsize'## The following objects are masked from 'package:rstatix':
##
## cohens_d, eta_squaredlibrary(car) # For Levene's test and Type III SS## Loading required package: carData##
## Attaching package: 'car'## The following object is masked from 'package:dplyr':
##
## recode## The following object is masked from 'package:purrr':
##
## somelibrary(ggpubr) # For visualization
library(emmeans) # For post-hoc comparisons## Welcome to emmeans.
## Caution: You lose important information if you filter this package's results.
## See '? untidy'library(ez) # For mixed ANOVA
# Read the transformativeness data
data_transformative <- read_csv("Transformativeness_Longform.csv")## Rows: 2106 Columns: 11## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): response, modification, measure, response_type, Type, effort_level,...
## dbl (3): id, image_number, Response
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Create wide format dataset for sphericity testing
# Note: We now need to account for both Modification and Effort Level
wide_data_transformative <- data_transformative %>%
filter(!is.na(Response)) %>%
group_by(id, Type, modification, effort_level) %>%
summarise(
mean_response = mean(Response),
.groups = "drop"
) %>%
pivot_wider(
id_cols = c(id, Type),
names_from = c(modification, effort_level),
values_from = mean_response
)
# Test sphericity for Modification
mod_matrix <- wide_data_transformative %>%
select(contains("less than 1 hour")) %>%
as.matrix()
sphericity_mod <- mauchly.test(lm(mod_matrix ~ 1))
# Test sphericity for Effort Level
effort_matrix <- wide_data_transformative %>%
select(contains("No Modification")) %>%
as.matrix()
sphericity_effort <- mauchly.test(lm(effort_matrix ~ 1))
# Print sphericity results with clear formatting
cat("=== Sphericity Tests for Transformativeness Ratings ===\n\n")## === Sphericity Tests for Transformativeness Ratings ===cat("Modification Effect:\n")## Modification Effect:print(sphericity_mod)##
## Mauchly's test of sphericity
##
## data: SSD matrix from lm(formula = mod_matrix ~ 1)
## W = 0.21916, p-value < 2.2e-16cat("\nEffort Level Effect:\n")##
## Effort Level Effect:print(sphericity_effort)##
## Mauchly's test of sphericity
##
## data: SSD matrix from lm(formula = effort_matrix ~ 1)
## W = 0.38398, p-value < 2.2e-16PART 2: ASSUMPTION TESTING
# Create averaged dataset for assumption tests
averaged_data_transformative <- data_transformative %>%
filter(!is.na(Response)) %>%
group_by(id, Type, modification, effort_level) %>%
summarise(
mean_response = mean(Response),
.groups = "drop"
)
# Test normality for each combination of conditions
normality_tests_transformative <- averaged_data_transformative %>%
group_by(Type, modification, effort_level) %>%
shapiro_test(mean_response)
# Create Q-Q plots for visual inspection
# We'll create separate plots for each effort level to stay within the 2-facet limit
less_than_1_qq <- ggqqplot(
averaged_data_transformative %>% filter(effort_level == "less than 1 hour"),
"mean_response",
facet.by = c("Type", "modification")) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Q-Q Plots: Less than 1 hour effort",
x = "Theoretical Quantiles",
y = "Sample Quantiles")
ten_hours_qq <- ggqqplot(
averaged_data_transformative %>% filter(effort_level == "10 hours"),
"mean_response",
facet.by = c("Type", "modification")) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Q-Q Plots: 10 hours effort",
x = "Theoretical Quantiles",
y = "Sample Quantiles")
hundred_hours_qq <- ggqqplot(
averaged_data_transformative %>% filter(effort_level == "100 hours"),
"mean_response",
facet.by = c("Type", "modification")) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Q-Q Plots: 100 hours effort",
x = "Theoretical Quantiles",
y = "Sample Quantiles")
# Arrange all plots in a grid
qq_combined <- gridExtra::grid.arrange(
less_than_1_qq, ten_hours_qq, hundred_hours_qq,
ncol = 1
)
# Test homogeneity of variance
# We need to test this for each combination of modification and effort level
levene_tests_transformative <- averaged_data_transformative %>%
group_by(modification, effort_level) %>%
levene_test(mean_response ~ Type)## Warning: There were 9 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `data = map(.data$data, .f, ...)`.
## Caused by warning in `leveneTest.default()`:
## ! group coerced to factor.
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 8 remaining warnings.# Print results in an organized format
cat("\nNormality Tests (Shapiro-Wilk):\n")##
## Normality Tests (Shapiro-Wilk):print(normality_tests_transformative)## # A tibble: 18 × 6
## Type modification effort_level variable statistic p
## <chr> <chr> <chr> <chr> <dbl> <dbl>
## 1 AI Dramatic Modification 10 hours mean_response 0.953 2.09e- 2
## 2 AI Dramatic Modification 100 hours mean_response 0.923 9.53e- 4
## 3 AI Dramatic Modification less than 1 hour mean_response 0.956 2.84e- 2
## 4 AI No Modification 10 hours mean_response 0.344 5.00e-15
## 5 AI No Modification 100 hours mean_response 0.109 2.21e-17
## 6 AI No Modification less than 1 hour mean_response 0.278 9.51e-16
## 7 AI Slight Modification 10 hours mean_response 0.912 3.19e- 4
## 8 AI Slight Modification 100 hours mean_response 0.913 3.70e- 4
## 9 AI Slight Modification less than 1 hour mean_response 0.915 4.29e- 4
## 10 Human Dramatic Modification 10 hours mean_response 0.947 1.49e- 2
## 11 Human Dramatic Modification 100 hours mean_response 0.942 9.11e- 3
## 12 Human Dramatic Modification less than 1 hour mean_response 0.948 1.77e- 2
## 13 Human No Modification 10 hours mean_response 0.264 3.08e-15
## 14 Human No Modification 100 hours mean_response 0.234 1.55e-15
## 15 Human No Modification less than 1 hour mean_response 0.180 4.68e-16
## 16 Human Slight Modification 10 hours mean_response 0.917 9.52e- 4
## 17 Human Slight Modification 100 hours mean_response 0.900 2.22e- 4
## 18 Human Slight Modification less than 1 hour mean_response 0.927 2.20e- 3cat("\nHomogeneity of Variance (Levene's Test):\n")##
## Homogeneity of Variance (Levene's Test):print(levene_tests_transformative)## # A tibble: 9 × 6
## modification effort_level df1 df2 statistic p
## <chr> <chr> <int> <int> <dbl> <dbl>
## 1 Dramatic Modification 10 hours 1 115 0.378 0.540
## 2 Dramatic Modification 100 hours 1 115 2.46 0.119
## 3 Dramatic Modification less than 1 hour 1 115 0.00987 0.921
## 4 No Modification 10 hours 1 115 0.165 0.685
## 5 No Modification 100 hours 1 115 1.87 0.174
## 6 No Modification less than 1 hour 1 115 1.21 0.274
## 7 Slight Modification 10 hours 1 115 0.000277 0.987
## 8 Slight Modification 100 hours 1 115 1.40 0.238
## 9 Slight Modification less than 1 hour 1 115 1.38 0.242# Save the combined plot
ggsave("transformative_normality_qq_plots_study2.png",
qq_combined,
width = 12,
height = 15) # Taller to accommodate three plots verticallyPART 3: MIXED ANOVA
# Prepare data for ANOVA by ensuring all variables are properly factored
averaged_data_transformative <- averaged_data_transformative %>%
mutate(
id = factor(id),
Type = factor(Type),
# Ensure correct ordering of modification levels
modification = factor(modification,
levels = c("No Modification",
"Slight Modification",
"Dramatic Modification")),
# Ensure correct ordering of effort levels
effort_level = factor(effort_level,
levels = c("less than 1 hour",
"10 hours",
"100 hours"))
)
# Run mixed ANOVA using ezANOVA
# Note: We now specify both modification and effort_level as within-subjects factors
anova_result_transformative <- ezANOVA(
data = averaged_data_transformative,
dv = mean_response,
wid = id, # Subject identifier
within = c(modification, # Both within-subjects factors
effort_level),
between = Type, # Between-subjects factor
detailed = TRUE,
type = 3,
return_aov = TRUE
)## Warning: Data is unbalanced (unequal N per group). Make sure you specified a
## well-considered value for the type argument to ezANOVA().# Print results with clear formatting
cat("\nMixed ANOVA Results:\n")##
## Mixed ANOVA Results:print(anova_result_transformative$ANOVA)## Effect DFn DFd SSn SSd F
## 1 (Intercept) 1 115 4954.6878440 149.67968 3806.7232119
## 2 Type 1 115 0.7809115 149.67968 0.5999800
## 3 modification 2 230 1015.2699067 145.08764 804.7276582
## 5 effort_level 2 230 0.6735840 66.36345 1.1672413
## 4 Type:modification 2 230 3.6725658 145.08764 2.9109651
## 6 Type:effort_level 2 230 0.5862146 66.36345 1.0158404
## 7 modification:effort_level 4 460 0.3333550 113.20368 0.3386447
## 8 Type:modification:effort_level 4 460 1.3181603 113.20368 1.3390769
## p p<.05 ges
## 1 5.523313e-90 * 0.9126298568
## 2 4.401753e-01 0.0016436249
## 3 1.443571e-104 * 0.6815701756
## 5 3.130610e-01 0.0014180476
## 4 5.643120e-02 0.0076830792
## 6 3.637167e-01 0.0012343421
## 7 8.518870e-01 0.0007022912
## 8 2.544409e-01 0.0027712669cat("\nSphericity Tests:\n")##
## Sphericity Tests:print(anova_result_transformative$Sphericity)## Effect GGe p[GG] p[GG]<.05 HFe
## 3 modification 0.8987648 2.781151e-94 * 0.9121419
## 4 Type:modification 0.8987648 6.232112e-02 0.9121419
## 5 effort_level 0.9544508 3.115787e-01 0.9701585
## 6 Type:effort_level 0.9544508 3.608961e-01 0.9701585
## 7 modification:effort_level 0.7604082 8.001369e-01 0.7833926
## 8 Type:modification:effort_level 0.7604082 2.612465e-01 0.7833926
## p[HF] p[HF]<.05
## 3 1.216478e-95 *
## 4 6.151073e-02
## 5 3.121078e-01
## 6 3.618906e-01
## 7 8.060074e-01
## 8 2.606954e-01PART 4: POST-HOC ANALYSES
# 1. Pairwise comparisons for the significant modification effect
posthoc_transformative <- averaged_data_transformative %>%
group_by(id) %>%
summarise(
no_mod = mean(mean_response[modification == "No Modification"]),
slight_mod = mean(mean_response[modification == "Slight Modification"]),
dramatic_mod = mean(mean_response[modification == "Dramatic Modification"])
) %>%
gather(modification, rating, -id) %>%
pairwise_t_test(
formula = rating ~ modification,
paired = TRUE,
p.adjust.method = "bonferroni"
)
# Helper function for calculating Cohen's d for paired comparisons
paired_cohens_d <- function(data, var1, var2) {
diff <- data[[var1]] - data[[var2]]
d <- mean(diff, na.rm = TRUE) / sd(diff, na.rm = TRUE)
return(d)
}
# 2. Calculate effect sizes for modification comparisons
effect_sizes_transformative <- averaged_data_transformative %>%
group_by(id) %>%
summarise(
no_mod = mean(mean_response[modification == "No Modification"]),
slight_mod = mean(mean_response[modification == "Slight Modification"]),
dramatic_mod = mean(mean_response[modification == "Dramatic Modification"])
) %>%
summarise(
d_no_vs_slight = paired_cohens_d(., "slight_mod", "no_mod"),
d_slight_vs_dramatic = paired_cohens_d(., "dramatic_mod", "slight_mod"),
d_no_vs_dramatic = paired_cohens_d(., "dramatic_mod", "no_mod")
)
# 3. Calculate descriptive statistics across all conditions
descriptives_transformative <- averaged_data_transformative %>%
group_by(modification) %>%
summarise(
mean = mean(mean_response),
sd = sd(mean_response),
se = sd / sqrt(n()),
n = n()
)
# 4. Examine patterns across effort levels and creator types
descriptives_by_condition <- averaged_data_transformative %>%
group_by(Type, modification, effort_level) %>%
summarise(
mean = mean(mean_response),
sd = sd(mean_response),
se = sd / sqrt(n()),
n = n(),
.groups = 'drop'
)
# 5. Compare creator types within each modification and effort level
type_comparisons <- averaged_data_transformative %>%
group_by(modification, effort_level) %>%
t_test(mean_response ~ Type, paired = FALSE) %>%
adjust_pvalue(method = "bonferroni")
# Print results
cat("\nPost-hoc Analysis:\n")##
## Post-hoc Analysis:cat("\nDescriptive Statistics by Modification Level:\n")##
## Descriptive Statistics by Modification Level:print(descriptives_transformative)## # A tibble: 3 × 5
## modification mean sd se n
## <fct> <dbl> <dbl> <dbl> <int>
## 1 No Modification 1.05 0.245 0.0131 351
## 2 Slight Modification 2.01 0.702 0.0375 351
## 3 Dramatic Modification 3.45 0.908 0.0484 351cat("\nDescriptive Statistics by Condition:\n")##
## Descriptive Statistics by Condition:print(descriptives_by_condition)## # A tibble: 18 × 7
## Type modification effort_level mean sd se n
## <fct> <fct> <fct> <dbl> <dbl> <dbl> <int>
## 1 AI No Modification less than 1 hour 1.07 0.286 0.0367 61
## 2 AI No Modification 10 hours 1.07 0.239 0.0306 61
## 3 AI No Modification 100 hours 1.01 0.0640 0.00820 61
## 4 AI Slight Modification less than 1 hour 1.89 0.653 0.0836 61
## 5 AI Slight Modification 10 hours 1.93 0.682 0.0873 61
## 6 AI Slight Modification 100 hours 1.89 0.665 0.0852 61
## 7 AI Dramatic Modification less than 1 hour 3.59 0.864 0.111 61
## 8 AI Dramatic Modification 10 hours 3.37 0.970 0.124 61
## 9 AI Dramatic Modification 100 hours 3.47 1.00 0.128 61
## 10 Human No Modification less than 1 hour 1.03 0.148 0.0198 56
## 11 Human No Modification 10 hours 1.10 0.398 0.0532 56
## 12 Human No Modification 100 hours 1.04 0.197 0.0263 56
## 13 Human Slight Modification less than 1 hour 2.18 0.839 0.112 56
## 14 Human Slight Modification 10 hours 2.14 0.712 0.0951 56
## 15 Human Slight Modification 100 hours 2.04 0.620 0.0828 56
## 16 Human Dramatic Modification less than 1 hour 3.40 0.844 0.113 56
## 17 Human Dramatic Modification 10 hours 3.49 0.897 0.120 56
## 18 Human Dramatic Modification 100 hours 3.36 0.862 0.115 56cat("\nCreator Type Comparisons:\n")##
## Creator Type Comparisons:print(type_comparisons)## # A tibble: 9 × 11
## modification effort_level .y. group1 group2 n1 n2 statistic df
## <fct> <fct> <chr> <chr> <chr> <int> <int> <dbl> <dbl>
## 1 No Modification less than 1… mean… AI Human 61 56 1.13 91.7
## 2 No Modification 10 hours mean… AI Human 61 56 -0.399 88.5
## 3 No Modification 100 hours mean… AI Human 61 56 -1.32 65.6
## 4 Slight Modificat… less than 1… mean… AI Human 61 56 -2.04 104.
## 5 Slight Modificat… 10 hours mean… AI Human 61 56 -1.68 113.
## 6 Slight Modificat… 100 hours mean… AI Human 61 56 -1.27 115.
## 7 Dramatic Modific… less than 1… mean… AI Human 61 56 1.19 115.
## 8 Dramatic Modific… 10 hours mean… AI Human 61 56 -0.708 115.
## 9 Dramatic Modific… 100 hours mean… AI Human 61 56 0.638 115.
## # ℹ 2 more variables: p <dbl>, p.adj <dbl>cat("\nPairwise Comparisons of Modification Levels (Bonferroni-corrected):\n")##
## Pairwise Comparisons of Modification Levels (Bonferroni-corrected):print(posthoc_transformative)## # A tibble: 3 × 10
## .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 rati… drama… no_mod 117 117 36.0 116 9 e-65 2.70e-64 ****
## 2 rati… drama… sligh… 117 117 22.7 116 2.02e-44 6.06e-44 ****
## 3 rati… no_mod sligh… 117 117 -19.1 116 1.56e-37 4.68e-37 ****cat("\nEffect Sizes (Cohen's d) for Modification Level Comparisons:\n")##
## Effect Sizes (Cohen's d) for Modification Level Comparisons:print(effect_sizes_transformative)## # A tibble: 1 × 3
## d_no_vs_slight d_slight_vs_dramatic d_no_vs_dramatic
## <dbl> <dbl> <dbl>
## 1 1.76 2.10 3.33Essence
PART 1: INITIAL DATA PREPARATION AND SPHERICITY TESTING
# Load required libraries for statistical analysis
library(tidyverse) # For data manipulation
library(rstatix) # For statistical tests
library(effectsize) # For effect sizes
library(car) # For Levene's test and Type III SS
library(ggpubr) # For visualization
library(emmeans) # For post-hoc comparisons
library(ez) # For mixed ANOVA
# Read the essence data from our longform CSV
data_essence <- read_csv("EssenceChange_Longform.csv")## Rows: 2106 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): response, modification, measure, response_type, Type, effort_level,...
## dbl (3): id, image_number, Response
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Create wide format dataset for sphericity testing
# We need to account for both modification and effort_level as within-subjects factors
wide_data_essence <- data_essence %>%
filter(!is.na(Response)) %>%
group_by(id, Type, modification, effort_level) %>%
summarise(
mean_response = mean(Response),
.groups = "drop"
) %>%
pivot_wider(
id_cols = c(id, Type),
names_from = c(modification, effort_level),
values_from = mean_response
)
# Test sphericity for modification effect
# We use the "less than 1 hour" condition to test modification
mod_matrix <- wide_data_essence %>%
select(contains("less than 1 hour")) %>%
as.matrix()
sphericity_mod <- mauchly.test(lm(mod_matrix ~ 1))
# Test sphericity for effort level effect
# We use the "No Modification" condition to test effort level
effort_matrix <- wide_data_essence %>%
select(contains("No Modification")) %>%
as.matrix()
sphericity_effort <- mauchly.test(lm(effort_matrix ~ 1))
# Print sphericity results with clear formatting
cat("=== Sphericity Tests for Essence Change Ratings ===\n\n")## === Sphericity Tests for Essence Change Ratings ===cat("Modification Effect:\n")## Modification Effect:print(sphericity_mod)##
## Mauchly's test of sphericity
##
## data: SSD matrix from lm(formula = mod_matrix ~ 1)
## W = 0.36871, p-value < 2.2e-16cat("\nEffort Level Effect:\n")##
## Effort Level Effect:print(sphericity_effort)##
## Mauchly's test of sphericity
##
## data: SSD matrix from lm(formula = effort_matrix ~ 1)
## W = 0.28346, p-value < 2.2e-16PART 2: ASSUMPTION TESTING
# Create averaged dataset for assumption tests
averaged_data_essence <- data_essence %>%
filter(!is.na(Response)) %>%
group_by(id, Type, modification, effort_level) %>%
summarise(
mean_response = mean(Response),
.groups = "drop"
)
# Test normality for each condition combination
normality_tests_essence <- averaged_data_essence %>%
group_by(Type, modification, effort_level) %>%
shapiro_test(mean_response)
# Create Q-Q plots for visual inspection
# We'll create separate plots for each effort level to stay within ggpubr's 2-facet limit
less_than_1_qq <- ggqqplot(
averaged_data_essence %>% filter(effort_level == "less than 1 hour"),
"mean_response",
facet.by = c("Type", "modification")) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Q-Q Plots: Less than 1 hour effort",
x = "Theoretical Quantiles",
y = "Sample Quantiles")
ten_hours_qq <- ggqqplot(
averaged_data_essence %>% filter(effort_level == "10 hours"),
"mean_response",
facet.by = c("Type", "modification")) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Q-Q Plots: 10 hours effort",
x = "Theoretical Quantiles",
y = "Sample Quantiles")
hundred_hours_qq <- ggqqplot(
averaged_data_essence %>% filter(effort_level == "100 hours"),
"mean_response",
facet.by = c("Type", "modification")) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Q-Q Plots: 100 hours effort",
x = "Theoretical Quantiles",
y = "Sample Quantiles")
# Combine all Q-Q plots into a single figure
qq_combined <- gridExtra::grid.arrange(
less_than_1_qq, ten_hours_qq, hundred_hours_qq,
ncol = 1
)
# Test homogeneity of variance for each combination
levene_tests_essence <- averaged_data_essence %>%
group_by(modification, effort_level) %>%
levene_test(mean_response ~ Type)## Warning: There were 9 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `data = map(.data$data, .f, ...)`.
## Caused by warning in `leveneTest.default()`:
## ! group coerced to factor.
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 8 remaining warnings.# Print results in organized format
cat("\nNormality Tests (Shapiro-Wilk):\n")##
## Normality Tests (Shapiro-Wilk):print(normality_tests_essence)## # A tibble: 18 × 6
## Type modification effort_level variable statistic p
## <chr> <chr> <chr> <chr> <dbl> <dbl>
## 1 AI Dramatic Modification 10 hours mean_response 0.945 8.42e- 3
## 2 AI Dramatic Modification 100 hours mean_response 0.934 2.74e- 3
## 3 AI Dramatic Modification less than 1 hour mean_response 0.943 6.82e- 3
## 4 AI No Modification 10 hours mean_response 0.429 5.08e-14
## 5 AI No Modification 100 hours mean_response 0.147 4.90e-17
## 6 AI No Modification less than 1 hour mean_response 0.303 1.78e-15
## 7 AI Slight Modification 10 hours mean_response 0.891 5.29e- 5
## 8 AI Slight Modification 100 hours mean_response 0.880 2.38e- 5
## 9 AI Slight Modification less than 1 hour mean_response 0.920 6.75e- 4
## 10 Human Dramatic Modification 10 hours mean_response 0.933 3.98e- 3
## 11 Human Dramatic Modification 100 hours mean_response 0.956 4.07e- 2
## 12 Human Dramatic Modification less than 1 hour mean_response 0.950 2.22e- 2
## 13 Human No Modification 10 hours mean_response 0.234 1.55e-15
## 14 Human No Modification 100 hours mean_response 0.237 1.65e-15
## 15 Human No Modification less than 1 hour mean_response 0.180 4.68e-16
## 16 Human Slight Modification 10 hours mean_response 0.939 7.36e- 3
## 17 Human Slight Modification 100 hours mean_response 0.921 1.35e- 3
## 18 Human Slight Modification less than 1 hour mean_response 0.922 1.49e- 3cat("\nHomogeneity of Variance (Levene's Test):\n")##
## Homogeneity of Variance (Levene's Test):print(levene_tests_essence)## # A tibble: 9 × 6
## modification effort_level df1 df2 statistic p
## <chr> <chr> <int> <int> <dbl> <dbl>
## 1 Dramatic Modification 10 hours 1 115 0.0178 0.894
## 2 Dramatic Modification 100 hours 1 115 0.241 0.625
## 3 Dramatic Modification less than 1 hour 1 115 0.158 0.691
## 4 No Modification 10 hours 1 115 2.25 0.136
## 5 No Modification 100 hours 1 115 0.0761 0.783
## 6 No Modification less than 1 hour 1 115 2.08 0.152
## 7 Slight Modification 10 hours 1 115 0.794 0.375
## 8 Slight Modification 100 hours 1 115 0.305 0.582
## 9 Slight Modification less than 1 hour 1 115 1.51 0.222# Save the combined Q-Q plots
ggsave("essence_normality_qq_plots_study2.png",
qq_combined,
width = 12,
height = 15) # Taller to accommodate three plots verticallyPART 3: MIXED ANOVA
# First, prepare our data by ensuring all variables are properly factored
# This is crucial for the ANOVA to correctly handle our categorical variables
averaged_data_essence <- averaged_data_essence %>%
mutate(
# Convert id to a factor since it represents individual subjects
id = factor(id),
# Convert Type to a factor for our between-subjects variable
Type = factor(Type),
# Create ordered factor for modification with explicit level ordering
# This ensures our levels are in the correct logical sequence
modification = factor(modification,
levels = c("No Modification",
"Slight Modification",
"Dramatic Modification")),
# Create ordered factor for effort_level with explicit level ordering
# This ensures our effort levels are in ascending order
effort_level = factor(effort_level,
levels = c("less than 1 hour",
"10 hours",
"100 hours"))
)
# Run the mixed ANOVA using ezANOVA
# This will give us all main effects and interactions
anova_result_essence <- ezANOVA(
data = averaged_data_essence,
dv = mean_response, # Our dependent variable
wid = id, # Subject identifier
within = c(modification, # Both within-subjects factors
effort_level),
between = Type, # Between-subjects factor
detailed = TRUE, # Get detailed output
type = 3, # Type III sums of squares
return_aov = TRUE # Return the full ANOVA object
)## Warning: Data is unbalanced (unequal N per group). Make sure you specified a
## well-considered value for the type argument to ezANOVA().# Print results with clear formatting and headers
cat("\nMixed ANOVA Results for Essence Change:\n")##
## Mixed ANOVA Results for Essence Change:print(anova_result_essence$ANOVA)## Effect DFn DFd SSn SSd F
## 1 (Intercept) 1 115 5314.0792252 148.00387 4129.0751932
## 2 Type 1 115 0.2482661 148.00387 0.1929044
## 3 modification 2 230 1161.8170126 140.14548 953.3590430
## 5 effort_level 2 230 1.1008516 53.79326 2.3534162
## 4 Type:modification 2 230 4.5596527 140.14548 3.7415411
## 6 Type:effort_level 2 230 0.8121526 53.79326 1.7362315
## 7 modification:effort_level 4 460 0.7650305 109.79100 0.8013272
## 8 Type:modification:effort_level 4 460 1.7659802 109.79100 1.8497666
## p p<.05 ges
## 1 5.876357e-92 * 0.9216530922
## 2 6.613344e-01 0.0005492833
## 3 4.761789e-112 * 0.7200375364
## 5 9.732892e-02 0.0024310243
## 4 2.517348e-02 * 0.0099928118
## 6 1.784842e-01 0.0017946310
## 7 5.247492e-01 0.0016906803
## 8 1.182243e-01 0.0038941164cat("\nSphericity Tests for Essence Change:\n")##
## Sphericity Tests for Essence Change:print(anova_result_essence$Sphericity)## Effect GGe p[GG] p[GG]<.05 HFe
## 3 modification 0.9703209 8.214443e-109 * 0.9867138
## 4 Type:modification 0.9703209 2.639487e-02 * 0.9867138
## 5 effort_level 0.9902270 9.789701e-02 1.0074924
## 6 Type:effort_level 0.9902270 1.788404e-01 1.0074924
## 7 modification:effort_level 0.7968568 5.003126e-01 0.8222277
## 8 Type:modification:effort_level 0.7968568 1.339696e-01 0.8222277
## p[HF] p[HF]<.05
## 3 1.338908e-110 *
## 4 2.571304e-02 *
## 5 9.732892e-02
## 6 1.784842e-01
## 7 5.036806e-01
## 8 1.319027e-01PART 4: POST-HOC ANALYSES
# 1. Pairwise comparisons for the significant modification effect
posthoc_essence <- averaged_data_essence %>%
group_by(id) %>%
summarise(
no_mod = mean(mean_response[modification == "No Modification"]),
slight_mod = mean(mean_response[modification == "Slight Modification"]),
dramatic_mod = mean(mean_response[modification == "Dramatic Modification"])
) %>%
gather(modification, rating, -id) %>%
pairwise_t_test(
formula = rating ~ modification,
paired = TRUE,
p.adjust.method = "bonferroni"
)
# 2. Calculate effect sizes for modification comparisons
effect_sizes_essence <- averaged_data_essence %>%
group_by(id) %>%
summarise(
no_mod = mean(mean_response[modification == "No Modification"]),
slight_mod = mean(mean_response[modification == "Slight Modification"]),
dramatic_mod = mean(mean_response[modification == "Dramatic Modification"])
) %>%
summarise(
d_no_vs_slight = paired_cohens_d(., "slight_mod", "no_mod"),
d_slight_vs_dramatic = paired_cohens_d(., "dramatic_mod", "slight_mod"),
d_no_vs_dramatic = paired_cohens_d(., "dramatic_mod", "no_mod")
)
# 3. Calculate overall descriptive statistics
descriptives_essence <- averaged_data_essence %>%
group_by(modification) %>%
summarise(
mean = mean(mean_response),
sd = sd(mean_response),
se = sd / sqrt(n()),
n = n()
)
# 4. Examine the significant Type × modification interaction
# Compare creator types within each modification level
type_comparisons <- averaged_data_essence %>%
group_by(modification) %>%
t_test(mean_response ~ Type, paired = FALSE) %>%
adjust_pvalue(method = "bonferroni")
# 5. Calculate descriptive statistics by creator type and modification
# This helps us understand the interaction
descriptives_by_type <- averaged_data_essence %>%
group_by(Type, modification) %>%
summarise(
mean = mean(mean_response),
sd = sd(mean_response),
se = sd / sqrt(n()),
n = n(),
.groups = 'drop'
)
# Print all results in a clear, organized format
cat("\nPost-hoc Analysis:\n")##
## Post-hoc Analysis:cat("\nDescriptive Statistics by Modification Level:\n")##
## Descriptive Statistics by Modification Level:print(descriptives_essence)## # A tibble: 3 × 5
## modification mean sd se n
## <fct> <dbl> <dbl> <dbl> <int>
## 1 No Modification 1.07 0.267 0.0143 351
## 2 Slight Modification 2.06 0.753 0.0402 351
## 3 Dramatic Modification 3.62 0.824 0.0440 351cat("\nDescriptive Statistics by Creator Type and Modification:\n")##
## Descriptive Statistics by Creator Type and Modification:print(descriptives_by_type)## # A tibble: 6 × 6
## Type modification mean sd se n
## <fct> <fct> <dbl> <dbl> <dbl> <int>
## 1 AI No Modification 1.09 0.320 0.0236 183
## 2 AI Slight Modification 1.95 0.728 0.0538 183
## 3 AI Dramatic Modification 3.66 0.812 0.0600 183
## 4 Human No Modification 1.04 0.193 0.0149 168
## 5 Human Slight Modification 2.17 0.766 0.0591 168
## 6 Human Dramatic Modification 3.58 0.838 0.0646 168cat("\nCreator Type Comparisons by Modification Level:\n")##
## Creator Type Comparisons by Modification Level:print(type_comparisons)## # A tibble: 3 × 10
## modification .y. group1 group2 n1 n2 statistic df p p.adj
## <fct> <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl>
## 1 No Modification mean… AI Human 183 168 1.64 303. 0.102 0.306
## 2 Slight Modific… mean… AI Human 183 168 -2.70 343. 0.00718 0.0215
## 3 Dramatic Modif… mean… AI Human 183 168 0.886 344. 0.376 1cat("\nPairwise Comparisons of Modification Levels (Bonferroni-corrected):\n")##
## Pairwise Comparisons of Modification Levels (Bonferroni-corrected):print(posthoc_essence)## # A tibble: 3 × 10
## .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 rati… drama… no_mod 117 117 40.5 116 3.10e-70 9.30e-70 ****
## 2 rati… drama… sligh… 117 117 26.2 116 1.73e-50 5.19e-50 ****
## 3 rati… no_mod sligh… 117 117 -17.8 116 5.50e-35 1.65e-34 ****cat("\nEffect Sizes (Cohen's d) for Modification Level Comparisons:\n")##
## Effect Sizes (Cohen's d) for Modification Level Comparisons:print(effect_sizes_essence)## # A tibble: 1 × 3
## d_no_vs_slight d_slight_vs_dramatic d_no_vs_dramatic
## <dbl> <dbl> <dbl>
## 1 1.65 2.42 3.74Creativity
PART 1: INITIAL DATA PREPARATION AND SPHERICITY TESTING
# Load required libraries for statistical analysis
library(tidyverse) # For data manipulation
library(rstatix) # For statistical tests
library(effectsize) # For effect sizes
library(car) # For Levene's test and Type III SS
library(ggpubr) # For visualization
library(emmeans) # For post-hoc comparisons
library(ez) # For mixed ANOVA
# Read the creativity data from our longform CSV
data_creativity <- read_csv("Creativity_Longform.csv")## Rows: 2106 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): response, modification, measure, response_type, Type, effort_level,...
## dbl (3): id, image_number, Response
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.# Create wide format dataset for sphericity testing
# Account for both modification and effort_level as within-subjects factors
wide_data_creativity <- data_creativity %>%
filter(!is.na(Response)) %>%
group_by(id, Type, modification, effort_level) %>%
summarise(
mean_response = mean(Response),
.groups = "drop"
) %>%
pivot_wider(
id_cols = c(id, Type),
names_from = c(modification, effort_level),
values_from = mean_response
)
# Test sphericity for modification effect
# Use the "less than 1 hour" condition to test modification
mod_matrix <- wide_data_creativity %>%
select(contains("less than 1 hour")) %>%
as.matrix()
sphericity_mod <- mauchly.test(lm(mod_matrix ~ 1))
# Test sphericity for effort level effect
# Use the "No Modification" condition to test effort level
effort_matrix <- wide_data_creativity %>%
select(contains("No Modification")) %>%
as.matrix()
sphericity_effort <- mauchly.test(lm(effort_matrix ~ 1))
# Print sphericity results with clear formatting
cat("=== Sphericity Tests for Creativity Ratings ===\n\n")## === Sphericity Tests for Creativity Ratings ===cat("Modification Effect:\n")## Modification Effect:print(sphericity_mod)##
## Mauchly's test of sphericity
##
## data: SSD matrix from lm(formula = mod_matrix ~ 1)
## W = 0.56514, p-value = 8.995e-13cat("\nEffort Level Effect:\n")##
## Effort Level Effect:print(sphericity_effort)##
## Mauchly's test of sphericity
##
## data: SSD matrix from lm(formula = effort_matrix ~ 1)
## W = 0.085342, p-value < 2.2e-16PART 2: ASSUMPTION TESTING
# Create averaged dataset for assumption tests
# This step combines multiple responses from the same condition to get more stable measures
averaged_data_creativity <- data_creativity %>%
filter(!is.na(Response)) %>%
group_by(id, Type, modification, effort_level) %>%
summarise(
mean_response = mean(Response),
.groups = "drop"
)
# Test normality for each condition combination
# Shapiro-Wilk test examines if our data is normally distributed
normality_tests_creativity <- averaged_data_creativity %>%
group_by(Type, modification, effort_level) %>%
shapiro_test(mean_response)
# Create Q-Q plots for visual inspection
# We create separate plots for each effort level due to ggpubr's 2-facet limit
# First plot: Less than 1 hour effort
less_than_1_qq <- ggqqplot(
averaged_data_creativity %>% filter(effort_level == "less than 1 hour"),
"mean_response",
facet.by = c("Type", "modification")) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Q-Q Plots: Less than 1 hour effort",
x = "Theoretical Quantiles",
y = "Sample Quantiles")
# Second plot: 10 hours effort
ten_hours_qq <- ggqqplot(
averaged_data_creativity %>% filter(effort_level == "10 hours"),
"mean_response",
facet.by = c("Type", "modification")) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Q-Q Plots: 10 hours effort",
x = "Theoretical Quantiles",
y = "Sample Quantiles")
# Third plot: 100 hours effort
hundred_hours_qq <- ggqqplot(
averaged_data_creativity %>% filter(effort_level == "100 hours"),
"mean_response",
facet.by = c("Type", "modification")) +
theme_bw() +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(title = "Q-Q Plots: 100 hours effort",
x = "Theoretical Quantiles",
y = "Sample Quantiles")
# Combine all Q-Q plots into a single figure for easier viewing
qq_combined <- gridExtra::grid.arrange(
less_than_1_qq, ten_hours_qq, hundred_hours_qq,
ncol = 1
)
# Test homogeneity of variance for each combination
# Levene's test checks if variance is similar across groups
levene_tests_creativity <- averaged_data_creativity %>%
group_by(modification, effort_level) %>%
levene_test(mean_response ~ Type)## Warning: There were 9 warnings in `mutate()`.
## The first warning was:
## ℹ In argument: `data = map(.data$data, .f, ...)`.
## Caused by warning in `leveneTest.default()`:
## ! group coerced to factor.
## ℹ Run `dplyr::last_dplyr_warnings()` to see the 8 remaining warnings.# Print results in organized format
cat("\nNormality Tests (Shapiro-Wilk):\n")##
## Normality Tests (Shapiro-Wilk):print(normality_tests_creativity)## # A tibble: 18 × 6
## Type modification effort_level variable statistic p
## <chr> <chr> <chr> <chr> <dbl> <dbl>
## 1 AI Dramatic Modification 10 hours mean_response 0.942 6.39e- 3
## 2 AI Dramatic Modification 100 hours mean_response 0.955 2.41e- 2
## 3 AI Dramatic Modification less than 1 hour mean_response 0.931 2.07e- 3
## 4 AI No Modification 10 hours mean_response 0.586 7.65e-12
## 5 AI No Modification 100 hours mean_response 0.399 2.15e-14
## 6 AI No Modification less than 1 hour mean_response 0.471 1.70e-13
## 7 AI Slight Modification 10 hours mean_response 0.906 2.02e- 4
## 8 AI Slight Modification 100 hours mean_response 0.857 4.30e- 6
## 9 AI Slight Modification less than 1 hour mean_response 0.902 1.39e- 4
## 10 Human Dramatic Modification 10 hours mean_response 0.960 5.91e- 2
## 11 Human Dramatic Modification 100 hours mean_response 0.965 1.02e- 1
## 12 Human Dramatic Modification less than 1 hour mean_response 0.962 7.52e- 2
## 13 Human No Modification 10 hours mean_response 0.564 1.24e-11
## 14 Human No Modification 100 hours mean_response 0.346 2.21e-14
## 15 Human No Modification less than 1 hour mean_response 0.263 3.01e-15
## 16 Human Slight Modification 10 hours mean_response 0.920 1.17e- 3
## 17 Human Slight Modification 100 hours mean_response 0.839 2.82e- 6
## 18 Human Slight Modification less than 1 hour mean_response 0.898 1.91e- 4cat("\nHomogeneity of Variance (Levene's Test):\n")##
## Homogeneity of Variance (Levene's Test):print(levene_tests_creativity)## # A tibble: 9 × 6
## modification effort_level df1 df2 statistic p
## <chr> <chr> <int> <int> <dbl> <dbl>
## 1 Dramatic Modification 10 hours 1 115 0.0103 0.919
## 2 Dramatic Modification 100 hours 1 115 0.0314 0.860
## 3 Dramatic Modification less than 1 hour 1 115 0.198 0.657
## 4 No Modification 10 hours 1 115 2.06 0.154
## 5 No Modification 100 hours 1 115 1.14 0.287
## 6 No Modification less than 1 hour 1 115 1.39 0.241
## 7 Slight Modification 10 hours 1 115 4.12 0.0448
## 8 Slight Modification 100 hours 1 115 0.810 0.370
## 9 Slight Modification less than 1 hour 1 115 0.00465 0.946# Save the combined Q-Q plots
ggsave("creativity_normality_qq_plots_study2.png",
qq_combined,
width = 12,
height = 15) # Taller to accommodate three plots verticallyPART 3: MIXED ANOVA
# First, we need to prepare our data by ensuring all variables are properly factored.
# This is essential for the ANOVA to correctly handle our categorical variables and
# maintain the proper order of levels within each factor.
averaged_data_creativity <- averaged_data_creativity %>%
mutate(
# Convert id to a factor since it represents individual subjects
id = factor(id),
# Convert Type to a factor for our between-subjects variable
Type = factor(Type),
# Create ordered factor for modification with explicit level ordering
# The order is important: we want to see how ratings change from no modification
# to dramatic modification
modification = factor(modification,
levels = c("No Modification",
"Slight Modification",
"Dramatic Modification")),
# Create ordered factor for effort_level with explicit level ordering
# This orders our effort levels from lowest to highest
effort_level = factor(effort_level,
levels = c("less than 1 hour",
"10 hours",
"100 hours"))
)
# Now we run the mixed ANOVA using ezANOVA
# This will give us a comprehensive analysis of all main effects and interactions
anova_result_creativity <- ezANOVA(
data = averaged_data_creativity,
dv = mean_response, # Our creativity ratings
wid = id, # Subject identifier
within = c(modification, # Both within-subjects factors
effort_level),
between = Type, # Between-subjects factor
detailed = TRUE, # Get detailed output
type = 3, # Type III sums of squares for unbalanced designs
return_aov = TRUE # Return the full ANOVA object
)## Warning: Data is unbalanced (unequal N per group). Make sure you specified a
## well-considered value for the type argument to ezANOVA().# Print results with clear formatting and headers
cat("\nMixed ANOVA Results for Creativity Ratings:\n")##
## Mixed ANOVA Results for Creativity Ratings:print(anova_result_creativity$ANOVA)## Effect DFn DFd SSn SSd F
## 1 (Intercept) 1 115 4906.7420719 253.03333 2230.0435064
## 2 Type 1 115 2.8959181 253.03333 1.3161530
## 3 modification 2 230 813.2229505 165.25236 565.9262012
## 5 effort_level 2 230 2.3739109 57.39912 4.7561663
## 4 Type:modification 2 230 1.0263693 165.25236 0.7142559
## 6 Type:effort_level 2 230 1.3596659 57.39912 2.7241111
## 7 modification:effort_level 4 460 0.4411095 84.09498 0.6032178
## 8 Type:modification:effort_level 4 460 1.1989442 84.09498 1.6395579
## p p<.05 ges
## 1 3.871002e-77 * 0.8975985461
## 2 2.536648e-01 0.0051466911
## 3 1.491923e-89 * 0.5922952145
## 5 9.462260e-03 * 0.0042228859
## 4 4.906389e-01 0.0018301676
## 6 6.772178e-02 0.0024230446
## 7 6.604979e-01 0.0007873849
## 8 1.631567e-01 0.0021372365cat("\nSphericity Tests for Creativity Ratings:\n")##
## Sphericity Tests for Creativity Ratings:print(anova_result_creativity$Sphericity)## Effect GGe p[GG] p[GG]<.05 HFe
## 3 modification 0.7797241 1.787442e-70 * 0.7885011
## 4 Type:modification 0.7797241 4.580518e-01 0.7885011
## 5 effort_level 0.9474930 1.072466e-02 * 0.9629033
## 6 Type:effort_level 0.9474930 7.080906e-02 0.9629033
## 7 modification:effort_level 0.8486300 6.334869e-01 0.8775651
## 8 Type:modification:effort_level 0.8486300 1.732323e-01 0.8775651
## p[HF] p[HF]<.05
## 3 3.103555e-71 *
## 4 4.595177e-01
## 5 1.033742e-02 *
## 6 6.988974e-02
## 7 6.389875e-01
## 8 1.712774e-01PART 4: POST-HOC ANALYSES
# 1. Pairwise comparisons for the significant modification effect
posthoc_creativity <- averaged_data_creativity %>%
group_by(id) %>%
summarise(
no_mod = mean(mean_response[modification == "No Modification"]),
slight_mod = mean(mean_response[modification == "Slight Modification"]),
dramatic_mod = mean(mean_response[modification == "Dramatic Modification"])
) %>%
gather(modification, rating, -id) %>%
pairwise_t_test(
formula = rating ~ modification,
paired = TRUE,
p.adjust.method = "bonferroni"
)
# 2. Calculate effect sizes for modification comparisons
effect_sizes_creativity <- averaged_data_creativity %>%
group_by(id) %>%
summarise(
no_mod = mean(mean_response[modification == "No Modification"]),
slight_mod = mean(mean_response[modification == "Slight Modification"]),
dramatic_mod = mean(mean_response[modification == "Dramatic Modification"])
) %>%
summarise(
d_no_vs_slight = paired_cohens_d(., "slight_mod", "no_mod"),
d_slight_vs_dramatic = paired_cohens_d(., "dramatic_mod", "slight_mod"),
d_no_vs_dramatic = paired_cohens_d(., "dramatic_mod", "no_mod")
)
# 3. Calculate descriptive statistics by modification level
descriptives_creativity <- averaged_data_creativity %>%
group_by(modification) %>%
summarise(
mean = mean(mean_response),
sd = sd(mean_response),
se = sd / sqrt(n()),
n = n()
)
# 4. Examine effort level differences through pairwise comparisons
effort_comparisons <- averaged_data_creativity %>%
group_by(id) %>%
summarise(
less_than_1 = mean(mean_response[effort_level == "less than 1 hour"]),
ten_hours = mean(mean_response[effort_level == "10 hours"]),
hundred_hours = mean(mean_response[effort_level == "100 hours"])
) %>%
gather(effort_level, rating, -id) %>%
pairwise_t_test(
formula = rating ~ effort_level,
paired = TRUE,
p.adjust.method = "bonferroni"
)
# 5. Calculate descriptive statistics by effort level
descriptives_by_effort <- averaged_data_creativity %>%
group_by(effort_level) %>%
summarise(
mean = mean(mean_response),
sd = sd(mean_response),
se = sd / sqrt(n()),
n = n(),
.groups = 'drop'
)
# Calculate descriptive statistics by creator type
descriptives_by_type <- averaged_data_creativity %>%
group_by(Type) %>%
summarise(
mean = mean(mean_response),
sd = sd(mean_response),
se = sd / sqrt(n()),
n = n(),
.groups = 'drop'
)
# Print results
cat("\nPost-hoc Analysis:\n")##
## Post-hoc Analysis:cat("\nDescriptive Statistics by Modification Level:\n")##
## Descriptive Statistics by Modification Level:print(descriptives_creativity)## # A tibble: 3 × 5
## modification mean sd se n
## <fct> <dbl> <dbl> <dbl> <int>
## 1 No Modification 1.23 0.596 0.0318 351
## 2 Slight Modification 1.92 0.739 0.0394 351
## 3 Dramatic Modification 3.34 0.852 0.0455 351cat("\nDescriptive Statistics by Effort Level:\n")##
## Descriptive Statistics by Effort Level:print(descriptives_by_effort)## # A tibble: 3 × 5
## effort_level mean sd se n
## <fct> <dbl> <dbl> <dbl> <int>
## 1 less than 1 hour 2.19 1.18 0.0630 351
## 2 10 hours 2.21 1.10 0.0587 351
## 3 100 hours 2.10 1.16 0.0620 351cat("\nPairwise Comparisons of Modification Levels (Bonferroni-corrected):\n")##
## Pairwise Comparisons of Modification Levels (Bonferroni-corrected):print(posthoc_creativity)## # A tibble: 3 × 10
## .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 rati… drama… no_mod 117 117 27.3 116 2.48e-52 7.44e-52 ****
## 2 rati… drama… sligh… 117 117 22.6 116 3 e-44 9 e-44 ****
## 3 rati… no_mod sligh… 117 117 -14.5 116 6.65e-28 1.99e-27 ****cat("\nEffect Sizes (Cohen's d) for Modification Level Comparisons:\n")##
## Effect Sizes (Cohen's d) for Modification Level Comparisons:print(effect_sizes_creativity)## # A tibble: 1 × 3
## d_no_vs_slight d_slight_vs_dramatic d_no_vs_dramatic
## <dbl> <dbl> <dbl>
## 1 1.34 2.09 2.52cat("\nPairwise Comparisons of Effort Levels (Bonferroni-corrected):\n")##
## Pairwise Comparisons of Effort Levels (Bonferroni-corrected):print(effort_comparisons)## # A tibble: 3 × 10
## .y. group1 group2 n1 n2 statistic df p p.adj p.adj.signif
## * <chr> <chr> <chr> <int> <int> <dbl> <dbl> <dbl> <dbl> <chr>
## 1 rating hundred_ho… less_… 117 117 -2.70 116 0.008 0.024 *
## 2 rating hundred_ho… ten_h… 117 117 -2.76 116 0.007 0.02 *
## 3 rating less_than_1 ten_h… 117 117 -0.505 116 0.615 1 nscat("\nDescriptive Statistics by Creator Type:\n")##
## Descriptive Statistics by Creator Type:print(descriptives_by_type)## # A tibble: 2 × 5
## Type mean sd se n
## <fct> <dbl> <dbl> <dbl> <int>
## 1 AI 2.21 1.18 0.0503 549
## 2 Human 2.11 1.11 0.0495 504Linear-Mixed Model Method
Transformativeness
PART 1: SETUP AND DATA PREPARATION
### Load Required Libraries
library(tidyverse) # For data manipulation and visualization
library(lme4) # For mixed effects modeling## Loading required package: Matrix##
## Attaching package: 'Matrix'## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpacklibrary(lmerTest) # For significance tests in mixed models##
## Attaching package: 'lmerTest'## The following object is masked from 'package:lme4':
##
## lmer## The following object is masked from 'package:stats':
##
## steplibrary(emmeans) # For post-hoc comparisons
library(effectsize) # For effect size calculations
library(moments) # For additional normality assessments
### Read and Prepare Data
data_transformative <- read_csv("Transformativeness_Longform.csv")## Rows: 2106 Columns: 11## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): response, modification, measure, response_type, Type, effort_level,...
## dbl (3): id, image_number, Response
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.PART 2: DATA STRUCTURE VERIFICATION
##### PART 2: DATA STRUCTURE VERIFICATION
# This verification ensures our data matches the study design where:
# - Each participant sees 6 unique artworks (combinations of image number and type)
# - Each artwork is rated under all 3 modification levels
# - Each participant experiences all 3 effort levels
# - There should be a balance of Figure and NonFigure images
# First, let's check the basic structure for each participant
structure_check <- data_transformative %>%
group_by(id) %>%
summarise(
# Count unique artworks by combining image number and type
n_artworks = n_distinct(paste(image_number, image_type)),
# Check modification levels per participant
n_modifications = n_distinct(modification),
# Check effort levels per participant
n_effort_levels = n_distinct(effort_level),
# Count total ratings (should be 18: 6 artworks × 3 modifications)
total_ratings = n(),
# Count Figure vs NonFigure balance
n_figure = n_distinct(paste(image_number, image_type)[image_type == "Figure"]),
n_nonfigure = n_distinct(paste(image_number, image_type)[image_type == "NonFigure"]),
.groups = "drop"
)
# Now verify modification balance within each unique artwork
mod_balance <- data_transformative %>%
group_by(id, image_number, image_type, effort_level) %>%
summarise(
n_modifications = n_distinct(modification),
modifications = list(sort(unique(as.character(modification)))),
.groups = "drop"
)
# Check effort level distribution for each participant
effort_balance <- data_transformative %>%
group_by(id, effort_level) %>%
summarise(
n_artworks = n_distinct(paste(image_number, image_type)),
.groups = "drop"
) %>%
pivot_wider(
names_from = effort_level,
values_from = n_artworks,
names_prefix = "effort_"
)
# Print comprehensive verification results
cat("\nData Structure Verification for Transformativeness:\n")##
## Data Structure Verification for Transformativeness:cat("\n1. Basic Structure Summary:\n")##
## 1. Basic Structure Summary:print(summary(structure_check))## id n_artworks n_modifications n_effort_levels total_ratings
## Min. :58091 Min. :6 Min. :3 Min. :3 Min. :18
## 1st Qu.:65878 1st Qu.:6 1st Qu.:3 1st Qu.:3 1st Qu.:18
## Median :69285 Median :6 Median :3 Median :3 Median :18
## Mean :67559 Mean :6 Mean :3 Mean :3 Mean :18
## 3rd Qu.:69513 3rd Qu.:6 3rd Qu.:3 3rd Qu.:3 3rd Qu.:18
## Max. :69876 Max. :6 Max. :3 Max. :3 Max. :18
## n_figure n_nonfigure
## Min. :3 Min. :3
## 1st Qu.:3 1st Qu.:3
## Median :3 Median :3
## Mean :3 Mean :3
## 3rd Qu.:3 3rd Qu.:3
## Max. :3 Max. :3cat("\n2. Detailed Participant-Level Checks:\n")##
## 2. Detailed Participant-Level Checks:cat("Number of unique artworks per participant (should be 6):\n")## Number of unique artworks per participant (should be 6):print(table(structure_check$n_artworks))##
## 6
## 117cat("\nModification levels per participant (should be 3):\n")##
## Modification levels per participant (should be 3):print(table(structure_check$n_modifications))##
## 3
## 117cat("\nEffort levels per participant (should be 3):\n")##
## Effort levels per participant (should be 3):print(table(structure_check$n_effort_levels))##
## 3
## 117cat("\n3. Figure/NonFigure Balance:\n")##
## 3. Figure/NonFigure Balance:cat("Distribution of Figure images per participant:\n")## Distribution of Figure images per participant:print(table(structure_check$n_figure))##
## 3
## 117cat("\nDistribution of NonFigure images per participant:\n")##
## Distribution of NonFigure images per participant:print(table(structure_check$n_nonfigure))##
## 3
## 117cat("\n4. Modification Balance Check:\n")##
## 4. Modification Balance Check:cat("Number of modifications per artwork (should all be 3):\n")## Number of modifications per artwork (should all be 3):print(table(mod_balance$n_modifications))##
## 3
## 702cat("\n5. Effort Level Distribution:\n")##
## 5. Effort Level Distribution:summary_effort <- effort_balance %>%
summarise(
across(starts_with("effort_"),
list(
mean = ~mean(., na.rm = TRUE),
sd = ~sd(., na.rm = TRUE)
))
)
print(summary_effort)## # A tibble: 1 × 6
## `effort_10 hours_mean` `effort_10 hours_sd` `effort_100 hours_mean`
## <dbl> <dbl> <dbl>
## 1 2 0 2
## # ℹ 3 more variables: `effort_100 hours_sd` <dbl>,
## # `effort_less than 1 hour_mean` <dbl>, `effort_less than 1 hour_sd` <dbl># Identify participants with fewer than 6 artworks
participants_with_fewer_artworks <- structure_check %>%
filter(n_artworks < 6) %>%
pull(id)
# Examine their complete data
detailed_inspection <- data_transformative %>%
filter(id %in% participants_with_fewer_artworks) %>%
arrange(id, image_number, image_type, modification) %>%
select(id, image_number, image_type, effort_level, modification, Response)
# Show the unique combinations of images they saw
image_combinations <- data_transformative %>%
filter(id %in% participants_with_fewer_artworks) %>%
group_by(id) %>%
summarize(
image_combinations = list(unique(paste(image_number, image_type))),
effort_levels = list(unique(effort_level))
)
print("Participants with fewer than 6 artworks:")## [1] "Participants with fewer than 6 artworks:"print(participants_with_fewer_artworks)## numeric(0)print("\nDetailed data for these participants:")## [1] "\nDetailed data for these participants:"print(detailed_inspection)## # A tibble: 0 × 6
## # ℹ 6 variables: id <dbl>, image_number <dbl>, image_type <chr>,
## # effort_level <chr>, modification <chr>, Response <dbl>print("\nUnique image combinations:")## [1] "\nUnique image combinations:"print(image_combinations)## # A tibble: 0 × 3
## # ℹ 3 variables: id <dbl>, image_combinations <list>, effort_levels <list># Add a final verification message
cat("\nVerification Summary:\n")##
## Verification Summary:all_correct <- all(
all(structure_check$n_artworks == 6),
all(structure_check$n_modifications == 3),
all(structure_check$n_effort_levels == 3),
all(structure_check$total_ratings == 18)
)
if(all_correct) {
cat("✓ Data structure matches study design specifications\n")
} else {
cat("! Some aspects of the data structure require attention\n")
}## ✓ Data structure matches study design specificationsPART 3: FIT MIXED EFFECT MODEL AND TESTS OF NORMALITY
# Define enhanced normality assessment function
assess_normality <- function(residuals, measure_name) {
# Visual checks
par(mfrow = c(2,2))
# Histogram with density curve
hist(residuals, freq = FALSE,
main = paste("Residual Distribution -", measure_name),
xlab = "Residuals", col = "lightgray")
curve(dnorm(x, mean = mean(residuals), sd = sd(residuals)),
add = TRUE, col = "#E69F00", lwd = 2)
# Q-Q plot with reference line
qqnorm(residuals, main = paste("Q-Q Plot -", measure_name),
pch = 1, col = "#56B4E9")
qqline(residuals, col = "#E69F00", lwd = 2)
# Density plot comparison
plot(density(residuals),
main = paste("Density Plot -", measure_name),
col = "#56B4E9", lwd = 2)
curve(dnorm(x, mean = mean(residuals), sd = sd(residuals)),
add = TRUE, col = "#E69F00", lwd = 2, lty = 2)
# Boxplot of residuals
boxplot(residuals,
main = paste("Residual Spread -", measure_name),
ylab = "Residuals", col = "#56B4E9")
par(mfrow = c(1,1))
# Statistical tests
ks_test <- ks.test(scale(residuals), "pnorm")
skew <- moments::skewness(residuals)
kurt <- moments::kurtosis(residuals)
# Print formal test results
cat("\n=== Normality Assessment for", measure_name, "===\n")
cat("Kolmogorov-Smirnov Test:\n")
cat("D =", round(ks_test$statistic, 3),
"p-value =", format.pval(ks_test$p.value, digits = 3), "\n\n")
cat("Distribution Shape:\n")
cat("Skewness =", round(skew, 3),
"(SE =", round(sd(residuals)/sqrt(length(residuals)), 3), ")\n")
cat("Kurtosis =", round(kurt, 3),
"(SE =", round(sd(residuals)/sqrt(length(residuals)), 3), ")\n")
invisible(list(
ks_test = ks_test,
skewness = skew,
kurtosis = kurt
))
}
# First, let's create a unique identifier for each artwork
data_transformative <- data_transformative %>%
mutate(
# Combine image_number and image_type to create a unique artwork identifier
artwork_id = paste(image_number, image_type)
)
# Fit initial mixed effects model with convergence control
initial_model_transform <- lmer(
Response ~ Type * modification * effort_level + # Note lowercase 'modification'
(1 + modification | id) + # Random slopes for modifications
(1 | artwork_id), # Random intercept for unique artworks
data = data_transformative,
control = lmerControl(optimizer = "bobyqa",
optCtrl = list(maxfun = 2e5))
)## boundary (singular) fit: see help('isSingular')### Comprehensive Model Diagnostics
# Extract model components
model_residuals_transform <- residuals(initial_model_transform)
model_fitted_transform <- fitted(initial_model_transform)
# Conduct formal normality assessment
normality_report_transform <- assess_normality(model_residuals_transform, "Transformativeness")
##
## === Normality Assessment for Transformativeness ===
## Kolmogorov-Smirnov Test:
## D = 0.118 p-value = <2e-16
##
## Distribution Shape:
## Skewness = 0.284 (SE = 0.014 )
## Kurtosis = 5.961 (SE = 0.014 )# Enhanced Residual vs. Fitted plot
ggplot(mapping = aes(x = model_fitted_transform, y = model_residuals_transform)) +
geom_point(alpha = 0.5, color = "#0072B2") +
geom_hline(yintercept = 0, color = "#D55E00", size = 1) +
geom_smooth(color = "#009E73", se = FALSE) +
labs(title = "Residuals vs. Fitted Values (Transformativeness)",
x = "Fitted Values", y = "Residuals") +
theme_minimal()## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
# Enhanced Scale-Location plot
ggplot(mapping = aes(x = model_fitted_transform, y = sqrt(abs(model_residuals_transform)))) +
geom_point(alpha = 0.5, color = "#0072B2") +
geom_smooth(color = "#009E73", se = FALSE) +
labs(title = "Scale-Location Plot (Transformativeness)",
x = "Fitted Values", y = "√|Standardized Residuals|") +
theme_minimal()## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
# Residual distribution plots
used_rows_transform <- attr(initial_model_transform@frame, "row.names")
transform_resid_data <- data_transformative %>%
mutate(row_num = 1:n()) %>%
filter(row_num %in% as.numeric(used_rows_transform)) %>%
mutate(residuals = model_residuals_transform)
# Plot for modification levels
p1 <- ggplot(transform_resid_data,
aes(x = modification, y = residuals, fill = Type)) + # lowercase 'modification'
geom_boxplot(alpha = 0.8, outlier.shape = NA) +
geom_jitter(width = 0.2, alpha = 0.3, color = "#999999") +
scale_fill_manual(values = c("#595959", "#A1a1a1")) +
labs(title = "Residuals by Modification Level",
x = "Modification Level", y = "Residuals") +
theme_bw() +
theme(legend.position = "bottom",
panel.grid.major.x = element_blank())
# Additional plot for effort levels
p2 <- ggplot(transform_resid_data,
aes(x = effort_level, y = residuals, fill = Type)) +
geom_boxplot(alpha = 0.8, outlier.shape = NA) +
geom_jitter(width = 0.2, alpha = 0.3, color = "#999999") +
scale_fill_manual(values = c("#595959", "#A1a1a1")) +
labs(title = "Residuals by Effort Level",
x = "Effort Level", y = "Residuals") +
theme_bw() +
theme(legend.position = "bottom",
panel.grid.major.x = element_blank())
# Arrange both plots side by side
grid.arrange(p1, p2, ncol = 2)
# Interaction visualization
interaction_plot <- ggplot(data_transformative,
aes(x = modification, y = Response, color = Type)) +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm") +
facet_wrap(~effort_level) +
theme_bw() +
labs(title = "Response Patterns Across Conditions")
print(interaction_plot)## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 4 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_point()`).
PART 4: MAIN ANALYSIS
# Fit final model
model_transformative <- lmer(
Response ~ Type * modification * effort_level +
(1 + modification | id) +
(1 | artwork_id),
data = data_transformative,
REML = TRUE
)## boundary (singular) fit: see help('isSingular')# Obtain Type III ANOVA results for fixed effects
anova_results <- anova(model_transformative, type = 3)
# Print comprehensive results
print("\nType III ANOVA Results:")## [1] "\nType III ANOVA Results:"print(anova_results)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Type 0.23 0.234 1 115.70 0.5239 0.47062
## modification 530.67 265.335 2 123.73 593.2073 < 2e-16
## effort_level 1.19 0.596 2 1850.88 1.3331 0.26392
## Type:modification 2.96 1.479 2 123.73 3.3057 0.03994
## Type:effort_level 0.91 0.453 2 1850.23 1.0133 0.36320
## modification:effort_level 0.67 0.167 4 1844.78 0.3731 0.82797
## Type:modification:effort_level 2.53 0.632 4 1844.77 1.4121 0.22745
##
## Type
## modification ***
## effort_level
## Type:modification *
## Type:effort_level
## modification:effort_level
## Type:modification:effort_level
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Get model summary for parameter estimates
model_summary <- summary(model_transformative)
print("\nModel Summary (Parameter Estimates):")## [1] "\nModel Summary (Parameter Estimates):"print(model_summary)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Response ~ Type * modification * effort_level + (1 + modification |
## id) + (1 | artwork_id)
## Data: data_transformative
##
## REML criterion at convergence: 4703.2
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -4.0924 -0.4065 -0.0407 0.3449 5.8725
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## id (Intercept) 0.4342 0.6589
## modificationNo Modification 0.4141 0.6435 -1.00
## modificationSlight Modification 0.3067 0.5538 -0.68 0.74
## artwork_id (Intercept) 0.0171 0.1308
## Residual 0.4473 0.6688
## Number of obs: 2102, groups: id, 117; artwork_id, 10
##
## Fixed effects:
## Estimate
## (Intercept) 3.37582
## TypeHuman 0.11172
## modificationNo Modification -2.29508
## modificationSlight Modification -1.44262
## effort_level100 hours 0.09453
## effort_levelless than 1 hour 0.20344
## TypeHuman:modificationNo Modification -0.09778
## TypeHuman:modificationSlight Modification 0.09441
## TypeHuman:effort_level100 hours -0.22898
## TypeHuman:effort_levelless than 1 hour -0.28672
## modificationNo Modification:effort_level100 hours -0.16393
## modificationSlight Modification:effort_level100 hours -0.12964
## modificationNo Modification:effort_levelless than 1 hour -0.22131
## modificationSlight Modification:effort_levelless than 1 hour -0.25523
## TypeHuman:modificationNo Modification:effort_level100 hours 0.24429
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.16535
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 0.23917
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 0.37026
## Std. Error
## (Intercept) 0.11181
## TypeHuman 0.15013
## modificationNo Modification 0.11883
## modificationSlight Modification 0.11118
## effort_level100 hours 0.08575
## effort_levelless than 1 hour 0.08585
## TypeHuman:modificationNo Modification 0.17176
## TypeHuman:modificationSlight Modification 0.16070
## TypeHuman:effort_level100 hours 0.12381
## TypeHuman:effort_levelless than 1 hour 0.12413
## modificationNo Modification:effort_level100 hours 0.12110
## modificationSlight Modification:effort_level100 hours 0.12124
## modificationNo Modification:effort_levelless than 1 hour 0.12110
## modificationSlight Modification:effort_levelless than 1 hour 0.12124
## TypeHuman:modificationNo Modification:effort_level100 hours 0.17504
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.17514
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 0.17504
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 0.17537
## df
## (Intercept) 152.24740
## TypeHuman 191.31008
## modificationNo Modification 272.22403
## modificationSlight Modification 306.33180
## effort_level100 hours 1845.71693
## effort_levelless than 1 hour 1846.90261
## TypeHuman:modificationNo Modification 272.22404
## TypeHuman:modificationSlight Modification 306.33181
## TypeHuman:effort_level100 hours 1844.66705
## TypeHuman:effort_levelless than 1 hour 1847.17179
## modificationNo Modification:effort_level100 hours 1844.33229
## modificationSlight Modification:effort_level100 hours 1844.80615
## modificationNo Modification:effort_levelless than 1 hour 1844.33229
## modificationSlight Modification:effort_levelless than 1 hour 1844.80601
## TypeHuman:modificationNo Modification:effort_level100 hours 1844.33228
## TypeHuman:modificationSlight Modification:effort_level100 hours 1844.55947
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 1844.33228
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 1845.08629
## t value
## (Intercept) 30.192
## TypeHuman 0.744
## modificationNo Modification -19.314
## modificationSlight Modification -12.976
## effort_level100 hours 1.102
## effort_levelless than 1 hour 2.370
## TypeHuman:modificationNo Modification -0.569
## TypeHuman:modificationSlight Modification 0.587
## TypeHuman:effort_level100 hours -1.849
## TypeHuman:effort_levelless than 1 hour -2.310
## modificationNo Modification:effort_level100 hours -1.354
## modificationSlight Modification:effort_level100 hours -1.069
## modificationNo Modification:effort_levelless than 1 hour -1.828
## modificationSlight Modification:effort_levelless than 1 hour -2.105
## TypeHuman:modificationNo Modification:effort_level100 hours 1.396
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.944
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 1.366
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 2.111
## Pr(>|t|)
## (Intercept) <2e-16
## TypeHuman 0.4577
## modificationNo Modification <2e-16
## modificationSlight Modification <2e-16
## effort_level100 hours 0.2704
## effort_levelless than 1 hour 0.0179
## TypeHuman:modificationNo Modification 0.5697
## TypeHuman:modificationSlight Modification 0.5573
## TypeHuman:effort_level100 hours 0.0646
## TypeHuman:effort_levelless than 1 hour 0.0210
## modificationNo Modification:effort_level100 hours 0.1760
## modificationSlight Modification:effort_level100 hours 0.2851
## modificationNo Modification:effort_levelless than 1 hour 0.0678
## modificationSlight Modification:effort_levelless than 1 hour 0.0354
## TypeHuman:modificationNo Modification:effort_level100 hours 0.1630
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.3452
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 0.1720
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 0.0349
##
## (Intercept) ***
## TypeHuman
## modificationNo Modification ***
## modificationSlight Modification ***
## effort_level100 hours
## effort_levelless than 1 hour *
## TypeHuman:modificationNo Modification
## TypeHuman:modificationSlight Modification
## TypeHuman:effort_level100 hours .
## TypeHuman:effort_levelless than 1 hour *
## modificationNo Modification:effort_level100 hours
## modificationSlight Modification:effort_level100 hours
## modificationNo Modification:effort_levelless than 1 hour .
## modificationSlight Modification:effort_levelless than 1 hour *
## TypeHuman:modificationNo Modification:effort_level100 hours
## TypeHuman:modificationSlight Modification:effort_level100 hours
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##
## Correlation matrix not shown by default, as p = 18 > 12.
## Use print(model_summary, correlation=TRUE) or
## vcov(model_summary) if you need it## optimizer (nloptwrap) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')PART 5: POST-HOC ANALYSES
# Calculate estimated marginal means for main effects and interactions
emm_results <- emmeans(model_transformative, specs = c("Type", "modification", "effort_level"))
# Examine the modification main effect
pairs_modification <- pairs(emmeans(model_transformative, "modification"),
adjust = "bonferroni")## NOTE: Results may be misleading due to involvement in interactions# Examine the Type × modification interaction
pairs_type_by_mod <- pairs(emmeans(model_transformative,
specs = c("Type", "modification")),
by = "Type",
adjust = "bonferroni")## NOTE: Results may be misleading due to involvement in interactions# Calculate effect sizes for modification levels
mod_contrasts <- emmeans(model_transformative, "modification")## NOTE: Results may be misleading due to involvement in interactionsmod_effects <- eff_size(pairs(mod_contrasts),
sigma = sigma(model_transformative),
edf = df.residual(model_transformative))
# Examine simple effects of Type within modification levels
simple_effects_type <- emmeans(model_transformative,
specs = "Type",
by = "modification") %>%
pairs()## NOTE: Results may be misleading due to involvement in interactions# Examine modification effects within each effort level
mod_by_effort <- emmeans(model_transformative,
specs = c("modification"),
by = "effort_level") %>%
pairs(adjust = "bonferroni")## NOTE: Results may be misleading due to involvement in interactions# Examine Type effects within each effort level
type_by_effort <- emmeans(model_transformative,
specs = c("Type"),
by = "effort_level") %>%
pairs()## NOTE: Results may be misleading due to involvement in interactions# Examine three-way interaction patterns
three_way_patterns <- emmeans(model_transformative,
specs = c("Type", "modification", "effort_level")) %>%
pairs(by = c("effort_level", "Type"))
# Calculate effect sizes for effort level comparisons
effort_contrasts <- emmeans(model_transformative, "effort_level")## NOTE: Results may be misleading due to involvement in interactionseffort_effects <- eff_size(pairs(effort_contrasts),
sigma = sigma(model_transformative),
edf = df.residual(model_transformative))
# Print all results in a clear, organized format
cat("\nPairwise Comparisons for Modification Levels:\n")##
## Pairwise Comparisons for Modification Levels:print(pairs_modification)## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.392 0.0694 115 34.444
## Dramatic Modification - Slight Modification 1.434 0.0625 115 22.949
## No Modification - Slight Modification -0.957 0.0539 115 -17.750
## p.value
## <.0001
## <.0001
## <.0001
##
## Results are averaged over the levels of: Type, effort_level
## Degrees-of-freedom method: kenward-roger
## P value adjustment: bonferroni method for 3 testscat("\nEffect Sizes for Modification Comparisons:\n")##
## Effect Sizes for Modification Comparisons:print(mod_effects)## contrast
## (Dramatic Modification - No Modification) - (Dramatic Modification - Slight Modification)
## (Dramatic Modification - No Modification) - (No Modification - Slight Modification)
## (Dramatic Modification - Slight Modification) - (No Modification - Slight Modification)
## effect.size SE df lower.CL upper.CL
## 1.43 0.0836 115 1.27 1.60
## 5.01 0.1640 115 4.68 5.33
## 3.58 0.1040 115 3.37 3.78
##
## Results are averaged over the levels of: Type, effort_level
## sigma used for effect sizes: 0.6688
## Degrees-of-freedom method: inherited from kenward-roger when re-gridding
## Confidence level used: 0.95cat("\nSimple Effects of Type within each Modification Level:\n")##
## Simple Effects of Type within each Modification Level:print(simple_effects_type)## modification = Dramatic Modification:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.06019 0.1320 115 0.456 0.6493
##
## modification = No Modification:
## contrast estimate SE df t.ratio p.value
## AI - Human -0.00319 0.0517 115 -0.062 0.9509
##
## modification = Slight Modification:
## contrast estimate SE df t.ratio p.value
## AI - Human -0.21276 0.1040 115 -2.042 0.0434
##
## Results are averaged over the levels of: effort_level
## Degrees-of-freedom method: kenward-rogercat("\nPairwise Comparisons by Creator Type:\n")##
## Pairwise Comparisons by Creator Type:print(pairs_type_by_mod)## Type = AI:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.423 0.0961 115 25.223
## Dramatic Modification - Slight Modification 1.571 0.0865 115 18.165
## No Modification - Slight Modification -0.853 0.0746 115 -11.425
## p.value
## <.0001
## <.0001
## <.0001
##
## Type = Human:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.360 0.1000 115 23.535
## Dramatic Modification - Slight Modification 1.298 0.0903 115 14.379
## No Modification - Slight Modification -1.062 0.0779 115 -13.637
## p.value
## <.0001
## <.0001
## <.0001
##
## Results are averaged over the levels of: effort_level
## Degrees-of-freedom method: kenward-roger
## P value adjustment: bonferroni method for 3 testscat("\nModification Effects within Each Effort Level:\n")##
## Modification Effects within Each Effort Level:print(mod_by_effort)## effort_level = 10 hours:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.344 0.0859 264 27.294
## Dramatic Modification - Slight Modification 1.395 0.0803 305 17.367
## No Modification - Slight Modification -0.949 0.0739 385 -12.839
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = 100 hours:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.386 0.0859 264 27.780
## Dramatic Modification - Slight Modification 1.442 0.0804 306 17.940
## No Modification - Slight Modification -0.943 0.0739 386 -12.759
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = less than 1 hour:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.446 0.0859 264 28.478
## Dramatic Modification - Slight Modification 1.466 0.0805 308 18.198
## No Modification - Slight Modification -0.980 0.0741 389 -13.232
## p.value
## <.0001
## <.0001
## <.0001
##
## Results are averaged over the levels of: Type
## Degrees-of-freedom method: kenward-roger
## P value adjustment: bonferroni method for 3 testscat("\nType Effects within Each Effort Level:\n")##
## Type Effects within Each Effort Level:print(type_by_effort)## effort_level = 10 hours:
## contrast estimate SE df t.ratio p.value
## AI - Human -0.1106 0.0828 202 -1.336 0.1831
##
## effort_level = 100 hours:
## contrast estimate SE df t.ratio p.value
## AI - Human -0.0182 0.0828 203 -0.219 0.8267
##
## effort_level = less than 1 hour:
## contrast estimate SE df t.ratio p.value
## AI - Human -0.0270 0.0831 205 -0.325 0.7456
##
## Results are averaged over the levels of: modification
## Degrees-of-freedom method: kenward-rogercat("\nEffect Sizes for Effort Level Comparisons:\n")##
## Effect Sizes for Effort Level Comparisons:print(effort_effects)## contrast effect.size
## (10 hours - 100 hours) - (10 hours - less than 1 hour) 0.0783
## (10 hours - 100 hours) - (100 hours - less than 1 hour) 0.1523
## (10 hours - less than 1 hour) - (100 hours - less than 1 hour) 0.0741
## SE df lower.CL upper.CL
## 0.0539 1736 -0.0274 0.184
## 0.0935 1736 -0.0310 0.336
## 0.0540 1736 -0.0318 0.180
##
## Results are averaged over the levels of: Type, modification
## sigma used for effect sizes: 0.6688
## Degrees-of-freedom method: inherited from kenward-roger when re-gridding
## Confidence level used: 0.95cat("\nThree-way Interaction Patterns:\n")##
## Three-way Interaction Patterns:print(three_way_patterns)## effort_level = 10 hours, Type = AI:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.295 0.119 264 19.314 <.0001
## Dramatic Modification - Slight Modification 1.443 0.111 305 12.976 <.0001
## No Modification - Slight Modification -0.852 0.102 385 -8.339 <.0001
##
## effort_level = 100 hours, Type = AI:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.459 0.119 264 20.694 <.0001
## Dramatic Modification - Slight Modification 1.572 0.111 307 14.122 <.0001
## No Modification - Slight Modification -0.887 0.102 387 -8.660 <.0001
##
## effort_level = less than 1 hour, Type = AI:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.516 0.119 264 21.177 <.0001
## Dramatic Modification - Slight Modification 1.698 0.111 307 15.251 <.0001
## No Modification - Slight Modification -0.819 0.102 387 -7.994 <.0001
##
## effort_level = 10 hours, Type = Human:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.393 0.124 264 19.294 <.0001
## Dramatic Modification - Slight Modification 1.348 0.116 305 11.619 <.0001
## No Modification - Slight Modification -1.045 0.107 385 -9.791 <.0001
##
## effort_level = 100 hours, Type = Human:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.312 0.124 264 18.646 <.0001
## Dramatic Modification - Slight Modification 1.312 0.116 305 11.312 <.0001
## No Modification - Slight Modification -1.000 0.107 385 -9.373 <.0001
##
## effort_level = less than 1 hour, Type = Human:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.375 0.124 264 19.150 <.0001
## Dramatic Modification - Slight Modification 1.233 0.116 309 10.595 <.0001
## No Modification - Slight Modification -1.142 0.107 390 -10.664 <.0001
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 3 estimatesPART 6: DESCRIPTIVE STATISTICS FOR CONFIRMATION
descriptives <- data_transformative %>%
group_by(Type, modification, effort_level) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# Create several focused summaries for different aspects of our design
# 1. Overall modification effects by Type
mod_by_type_summary <- data_transformative %>%
group_by(Type, modification) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# 2. Effort level effects by Type
effort_by_type_summary <- data_transformative %>%
group_by(Type, effort_level) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# 3. Three-way interaction summary
three_way_summary <- data_transformative %>%
group_by(Type, modification, effort_level) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# Print results in a clear, organized format
cat("\nOverall Descriptive Statistics:\n")##
## Overall Descriptive Statistics:print(descriptives)## # A tibble: 18 × 9
## Type modification effort_level mean sd se n ci_lower ci_upper
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Dramatic Mod… 10 hours 3.37 1.13 0.102 122 3.17 3.57
## 2 AI Dramatic Mod… 100 hours 3.47 1.19 0.107 122 3.25 3.68
## 3 AI Dramatic Mod… less than 1… 3.59 1.10 0.100 122 3.39 3.79
## 4 AI No Modificat… 10 hours 1.07 0.292 0.0265 122 1.02 1.13
## 5 AI No Modificat… 100 hours 1.01 0.0905 0.00820 122 0.992 1.02
## 6 AI No Modificat… less than 1… 1.07 0.319 0.0289 122 1.02 1.13
## 7 AI Slight Modif… 10 hours 1.93 0.874 0.0791 122 1.77 2.08
## 8 AI Slight Modif… 100 hours 1.89 0.794 0.0719 122 1.75 2.03
## 9 AI Slight Modif… less than 1… 1.89 0.804 0.0728 122 1.75 2.04
## 10 Human Dramatic Mod… 10 hours 3.49 1.05 0.0991 112 3.29 3.69
## 11 Human Dramatic Mod… 100 hours 3.36 1.06 0.101 112 3.16 3.56
## 12 Human Dramatic Mod… less than 1… 3.40 1.02 0.0961 112 3.21 3.59
## 13 Human No Modificat… 10 hours 1.10 0.553 0.0522 112 0.995 1.20
## 14 Human No Modificat… 100 hours 1.04 0.247 0.0233 112 0.998 1.09
## 15 Human No Modificat… less than 1… 1.03 0.162 0.0153 112 0.996 1.06
## 16 Human Slight Modif… 10 hours 2.14 0.938 0.0887 112 1.97 2.32
## 17 Human Slight Modif… 100 hours 2.04 0.842 0.0796 112 1.89 2.20
## 18 Human Slight Modif… less than 1… 2.15 0.969 0.0916 112 1.97 2.34cat("\nModification Effects by Creator Type:\n")##
## Modification Effects by Creator Type:print(mod_by_type_summary)## # A tibble: 6 × 8
## Type modification mean sd se n ci_lower ci_upper
## <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Dramatic Modification 3.48 1.14 0.0596 366 3.36 3.59
## 2 AI No Modification 1.05 0.256 0.0134 366 1.03 1.08
## 3 AI Slight Modification 1.90 0.823 0.0430 366 1.82 1.99
## 4 Human Dramatic Modification 3.42 1.04 0.0568 336 3.30 3.53
## 5 Human No Modification 1.06 0.362 0.0198 336 1.02 1.10
## 6 Human Slight Modification 2.11 0.916 0.0500 336 2.02 2.21cat("\nEffort Level Effects by Creator Type:\n")##
## Effort Level Effects by Creator Type:print(effort_by_type_summary)## # A tibble: 6 × 8
## Type effort_level mean sd se n ci_lower ci_upper
## <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI 10 hours 2.12 1.27 0.0662 366 1.99 2.25
## 2 AI 100 hours 2.12 1.31 0.0685 366 1.99 2.26
## 3 AI less than 1 hour 2.19 1.33 0.0693 366 2.05 2.32
## 4 Human 10 hours 2.24 1.31 0.0715 336 2.10 2.38
## 5 Human 100 hours 2.15 1.24 0.0675 336 2.02 2.28
## 6 Human less than 1 hour 2.19 1.27 0.0692 336 2.06 2.33cat("\nComplete Three-Way Interaction Summary:\n")##
## Complete Three-Way Interaction Summary:print(three_way_summary)## # A tibble: 18 × 9
## Type modification effort_level mean sd se n ci_lower ci_upper
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Dramatic Mod… 10 hours 3.37 1.13 0.102 122 3.17 3.57
## 2 AI Dramatic Mod… 100 hours 3.47 1.19 0.107 122 3.25 3.68
## 3 AI Dramatic Mod… less than 1… 3.59 1.10 0.100 122 3.39 3.79
## 4 AI No Modificat… 10 hours 1.07 0.292 0.0265 122 1.02 1.13
## 5 AI No Modificat… 100 hours 1.01 0.0905 0.00820 122 0.992 1.02
## 6 AI No Modificat… less than 1… 1.07 0.319 0.0289 122 1.02 1.13
## 7 AI Slight Modif… 10 hours 1.93 0.874 0.0791 122 1.77 2.08
## 8 AI Slight Modif… 100 hours 1.89 0.794 0.0719 122 1.75 2.03
## 9 AI Slight Modif… less than 1… 1.89 0.804 0.0728 122 1.75 2.04
## 10 Human Dramatic Mod… 10 hours 3.49 1.05 0.0991 112 3.29 3.69
## 11 Human Dramatic Mod… 100 hours 3.36 1.06 0.101 112 3.16 3.56
## 12 Human Dramatic Mod… less than 1… 3.40 1.02 0.0961 112 3.21 3.59
## 13 Human No Modificat… 10 hours 1.10 0.553 0.0522 112 0.995 1.20
## 14 Human No Modificat… 100 hours 1.04 0.247 0.0233 112 0.998 1.09
## 15 Human No Modificat… less than 1… 1.03 0.162 0.0153 112 0.996 1.06
## 16 Human Slight Modif… 10 hours 2.14 0.938 0.0887 112 1.97 2.32
## 17 Human Slight Modif… 100 hours 2.04 0.842 0.0796 112 1.89 2.20
## 18 Human Slight Modif… less than 1… 2.15 0.969 0.0916 112 1.97 2.34# Create confirmation summaries for our significant effects
# For example, if we found a significant Type × modification interaction:
cat("\nMean Differences Between Types at Each Modification Level:\n")##
## Mean Differences Between Types at Each Modification Level:type_differences <- mod_by_type_summary %>%
group_by(modification) %>%
summarise(
type_difference = diff(mean),
pooled_se = sqrt(sum(se^2)),
t_value = type_difference/pooled_se,
df = n[1] + n[2] - 2,
p_value = 2 * pt(-abs(t_value), df),
.groups = 'drop'
)
print(type_differences)## # A tibble: 3 × 6
## modification type_difference pooled_se t_value df p_value
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Dramatic Modification -0.0587 0.0824 -0.713 700 0.476
## 2 No Modification 0.00464 0.0239 0.194 700 0.846
## 3 Slight Modification 0.210 0.0659 3.18 700 0.00152Essence
PART 1: SETUP AND DATA PREPARATION
### Load Required Libraries
library(tidyverse) # For data manipulation and visualization
library(lme4) # For mixed effects modeling
library(lmerTest) # For significance tests in mixed models
library(emmeans) # For post-hoc comparisons
library(effectsize) # For effect size calculations
library(moments) # For additional normality assessments
### Read and Prepare Data
data_essence <- read_csv("EssenceChange_Longform.csv")## Rows: 2106 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): response, modification, measure, response_type, Type, effort_level,...
## dbl (3): id, image_number, Response
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.PART 2: DATA STRUCTURE VERIFICATION
##### PART 2: DATA STRUCTURE VERIFICATION
# This verification ensures our data matches the study design where:
# - Each participant sees 6 unique artworks (combinations of image number and type)
# - Each artwork is rated under all 3 modification levels
# - Each participant experiences all 3 effort levels
# - There should be a balance of Figure and NonFigure images
# First, let's check the basic structure for each participant
structure_check <- data_essence %>%
group_by(id) %>%
summarise(
# Count unique artworks by combining image number and type
n_artworks = n_distinct(paste(image_number, image_type)),
# Check modification levels per participant
n_modifications = n_distinct(modification),
# Check effort levels per participant
n_effort_levels = n_distinct(effort_level),
# Count total ratings (should be 18: 6 artworks × 3 modifications)
total_ratings = n(),
# Count Figure vs NonFigure balance
n_figure = n_distinct(paste(image_number, image_type)[image_type == "Figure"]),
n_nonfigure = n_distinct(paste(image_number, image_type)[image_type == "NonFigure"]),
.groups = "drop"
)
# Now verify modification balance within each unique artwork
mod_balance <- data_essence %>%
group_by(id, image_number, image_type, effort_level) %>%
summarise(
n_modifications = n_distinct(modification),
modifications = list(sort(unique(as.character(modification)))),
.groups = "drop"
)
# Check effort level distribution for each participant
effort_balance <- data_essence %>%
group_by(id, effort_level) %>%
summarise(
n_artworks = n_distinct(paste(image_number, image_type)),
.groups = "drop"
) %>%
pivot_wider(
names_from = effort_level,
values_from = n_artworks,
names_prefix = "effort_"
)
# Print comprehensive verification results
cat("\nData Structure Verification for Transformativeness:\n")##
## Data Structure Verification for Transformativeness:cat("\n1. Basic Structure Summary:\n")##
## 1. Basic Structure Summary:print(summary(structure_check))## id n_artworks n_modifications n_effort_levels total_ratings
## Min. :58091 Min. :6 Min. :3 Min. :3 Min. :18
## 1st Qu.:65878 1st Qu.:6 1st Qu.:3 1st Qu.:3 1st Qu.:18
## Median :69285 Median :6 Median :3 Median :3 Median :18
## Mean :67559 Mean :6 Mean :3 Mean :3 Mean :18
## 3rd Qu.:69513 3rd Qu.:6 3rd Qu.:3 3rd Qu.:3 3rd Qu.:18
## Max. :69876 Max. :6 Max. :3 Max. :3 Max. :18
## n_figure n_nonfigure
## Min. :3 Min. :3
## 1st Qu.:3 1st Qu.:3
## Median :3 Median :3
## Mean :3 Mean :3
## 3rd Qu.:3 3rd Qu.:3
## Max. :3 Max. :3cat("\n2. Detailed Participant-Level Checks:\n")##
## 2. Detailed Participant-Level Checks:cat("Number of unique artworks per participant (should be 6):\n")## Number of unique artworks per participant (should be 6):print(table(structure_check$n_artworks))##
## 6
## 117cat("\nModification levels per participant (should be 3):\n")##
## Modification levels per participant (should be 3):print(table(structure_check$n_modifications))##
## 3
## 117cat("\nEffort levels per participant (should be 3):\n")##
## Effort levels per participant (should be 3):print(table(structure_check$n_effort_levels))##
## 3
## 117cat("\n3. Figure/NonFigure Balance:\n")##
## 3. Figure/NonFigure Balance:cat("Distribution of Figure images per participant:\n")## Distribution of Figure images per participant:print(table(structure_check$n_figure))##
## 3
## 117cat("\nDistribution of NonFigure images per participant:\n")##
## Distribution of NonFigure images per participant:print(table(structure_check$n_nonfigure))##
## 3
## 117cat("\n4. Modification Balance Check:\n")##
## 4. Modification Balance Check:cat("Number of modifications per artwork (should all be 3):\n")## Number of modifications per artwork (should all be 3):print(table(mod_balance$n_modifications))##
## 3
## 702cat("\n5. Effort Level Distribution:\n")##
## 5. Effort Level Distribution:summary_effort <- effort_balance %>%
summarise(
across(starts_with("effort_"),
list(
mean = ~mean(., na.rm = TRUE),
sd = ~sd(., na.rm = TRUE)
))
)
print(summary_effort)## # A tibble: 1 × 6
## `effort_10 hours_mean` `effort_10 hours_sd` `effort_100 hours_mean`
## <dbl> <dbl> <dbl>
## 1 2 0 2
## # ℹ 3 more variables: `effort_100 hours_sd` <dbl>,
## # `effort_less than 1 hour_mean` <dbl>, `effort_less than 1 hour_sd` <dbl># Identify participants with fewer than 6 artworks
participants_with_fewer_artworks <- structure_check %>%
filter(n_artworks < 6) %>%
pull(id)
# Examine their complete data
detailed_inspection <- data_essence %>%
filter(id %in% participants_with_fewer_artworks) %>%
arrange(id, image_number, image_type, modification) %>%
select(id, image_number, image_type, effort_level, modification, Response)
# Show the unique combinations of images they saw
image_combinations <- data_essence %>%
filter(id %in% participants_with_fewer_artworks) %>%
group_by(id) %>%
summarize(
image_combinations = list(unique(paste(image_number, image_type))),
effort_levels = list(unique(effort_level))
)
print("Participants with fewer than 6 artworks:")## [1] "Participants with fewer than 6 artworks:"print(participants_with_fewer_artworks)## numeric(0)print("\nDetailed data for these participants:")## [1] "\nDetailed data for these participants:"print(detailed_inspection)## # A tibble: 0 × 6
## # ℹ 6 variables: id <dbl>, image_number <dbl>, image_type <chr>,
## # effort_level <chr>, modification <chr>, Response <dbl>print("\nUnique image combinations:")## [1] "\nUnique image combinations:"print(image_combinations)## # A tibble: 0 × 3
## # ℹ 3 variables: id <dbl>, image_combinations <list>, effort_levels <list># Add a final verification message
cat("\nVerification Summary:\n")##
## Verification Summary:all_correct <- all(
all(structure_check$n_artworks == 6),
all(structure_check$n_modifications == 3),
all(structure_check$n_effort_levels == 3),
all(structure_check$total_ratings == 18)
)
if(all_correct) {
cat("✓ Data structure matches study design specifications\n")
} else {
cat("! Some aspects of the data structure require attention\n")
}## ✓ Data structure matches study design specificationsPART 3: FIT MIXED EFFECT MODEL AND TESTS OF NORMALITY
# Define enhanced normality assessment function
assess_normality <- function(residuals, measure_name) {
# Visual checks
par(mfrow = c(2,2))
# Histogram with density curve
hist(residuals, freq = FALSE,
main = paste("Residual Distribution -", measure_name),
xlab = "Residuals", col = "lightgray")
curve(dnorm(x, mean = mean(residuals), sd = sd(residuals)),
add = TRUE, col = "#E69F00", lwd = 2)
# Q-Q plot with reference line
qqnorm(residuals, main = paste("Q-Q Plot -", measure_name),
pch = 1, col = "#56B4E9")
qqline(residuals, col = "#E69F00", lwd = 2)
# Density plot comparison
plot(density(residuals),
main = paste("Density Plot -", measure_name),
col = "#56B4E9", lwd = 2)
curve(dnorm(x, mean = mean(residuals), sd = sd(residuals)),
add = TRUE, col = "#E69F00", lwd = 2, lty = 2)
# Boxplot of residuals
boxplot(residuals,
main = paste("Residual Spread -", measure_name),
ylab = "Residuals", col = "#56B4E9")
par(mfrow = c(1,1))
# Statistical tests
ks_test <- ks.test(scale(residuals), "pnorm")
skew <- moments::skewness(residuals)
kurt <- moments::kurtosis(residuals)
# Print formal test results
cat("\n=== Normality Assessment for", measure_name, "===\n")
cat("Kolmogorov-Smirnov Test:\n")
cat("D =", round(ks_test$statistic, 3),
"p-value =", format.pval(ks_test$p.value, digits = 3), "\n\n")
cat("Distribution Shape:\n")
cat("Skewness =", round(skew, 3),
"(SE =", round(sd(residuals)/sqrt(length(residuals)), 3), ")\n")
cat("Kurtosis =", round(kurt, 3),
"(SE =", round(sd(residuals)/sqrt(length(residuals)), 3), ")\n")
invisible(list(
ks_test = ks_test,
skewness = skew,
kurtosis = kurt
))
}
# First, create unique identifier for each artwork
data_essence <- data_essence %>%
mutate(
artwork_id = paste(image_number, image_type)
)
# Fit initial mixed effects model with convergence control
initial_model_essence <- lmer(
Response ~ Type * modification * effort_level +
(1 + modification | id) +
(1 | artwork_id),
data = data_essence,
control = lmerControl(optimizer = "bobyqa",
optCtrl = list(maxfun = 2e5))
)## boundary (singular) fit: see help('isSingular')### Comprehensive Model Diagnostics
model_residuals_essence <- residuals(initial_model_essence)
model_fitted_essence <- fitted(initial_model_essence)
# Conduct formal normality assessment
normality_report_essence <- assess_normality(model_residuals_essence, "Essence Change")
## Warning in ks.test.default(scale(residuals), "pnorm"): ties should not be
## present for the one-sample Kolmogorov-Smirnov test##
## === Normality Assessment for Essence Change ===
## Kolmogorov-Smirnov Test:
## D = 0.101 p-value = <2e-16
##
## Distribution Shape:
## Skewness = 0.042 (SE = 0.014 )
## Kurtosis = 4.608 (SE = 0.014 )# Diagnostic plots
ggplot(mapping = aes(x = model_fitted_essence, y = model_residuals_essence)) +
geom_point(alpha = 0.5, color = "#0072B2") +
geom_hline(yintercept = 0, color = "#D55E00", size = 1) +
geom_smooth(color = "#009E73", se = FALSE) +
labs(title = "Residuals vs. Fitted Values (Essence Change)",
x = "Fitted Values", y = "Residuals") +
theme_minimal()## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
# Scale-Location plot
ggplot(mapping = aes(x = model_fitted_essence, y = sqrt(abs(model_residuals_essence)))) +
geom_point(alpha = 0.5, color = "#0072B2") +
geom_smooth(color = "#009E73", se = FALSE) +
labs(title = "Scale-Location Plot (Essence Change)",
x = "Fitted Values", y = "√|Standardized Residuals|") +
theme_minimal()## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
# Residual distribution plots
used_rows_essence <- attr(initial_model_essence@frame, "row.names")
essence_resid_data <- data_essence %>%
mutate(row_num = 1:n()) %>%
filter(row_num %in% as.numeric(used_rows_essence)) %>%
mutate(residuals = model_residuals_essence)
# Modification levels plot
p1 <- ggplot(essence_resid_data,
aes(x = modification, y = residuals, fill = Type)) +
geom_boxplot(alpha = 0.8, outlier.shape = NA) +
geom_jitter(width = 0.2, alpha = 0.3, color = "#999999") +
scale_fill_manual(values = c("#595959", "#A1a1a1")) +
labs(title = "Residuals by Modification Level",
x = "Modification Level", y = "Residuals") +
theme_bw() +
theme(legend.position = "bottom",
panel.grid.major.x = element_blank())
# Effort levels plot
p2 <- ggplot(essence_resid_data,
aes(x = effort_level, y = residuals, fill = Type)) +
geom_boxplot(alpha = 0.8, outlier.shape = NA) +
geom_jitter(width = 0.2, alpha = 0.3, color = "#999999") +
scale_fill_manual(values = c("#595959", "#A1a1a1")) +
labs(title = "Residuals by Effort Level",
x = "Effort Level", y = "Residuals") +
theme_bw() +
theme(legend.position = "bottom",
panel.grid.major.x = element_blank())
grid.arrange(p1, p2, ncol = 2)
# Interaction visualization
interaction_plot <- ggplot(data_essence,
aes(x = modification, y = Response, color = Type)) +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm") +
facet_wrap(~effort_level) +
theme_bw() +
labs(title = "Response Patterns Across Conditions")
print(interaction_plot)## `geom_smooth()` using formula = 'y ~ x'## Warning: Removed 89 rows containing non-finite outside the scale range
## (`stat_smooth()`).## Warning: Removed 89 rows containing missing values or values outside the scale range
## (`geom_point()`).
PART 4: MAIN ANALYSIS
# Fit final model
model_essence <- lmer(
Response ~ Type * modification * effort_level +
(1 + modification | id) +
(1 | artwork_id),
data = data_essence,
REML = TRUE
)## boundary (singular) fit: see help('isSingular')# Obtain Type III ANOVA results
anova_results <- anova(model_essence, type = 3)
# Print comprehensive results
print("\nType III ANOVA Results:")## [1] "\nType III ANOVA Results:"print(anova_results)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Type 0.06 0.06 1 115.41 0.1331 0.71593
## modification 638.48 319.24 2 121.56 762.0209 < 2e-16
## effort_level 1.96 0.98 2 1767.01 2.3382 0.09680
## Type:modification 3.32 1.66 2 120.54 3.9657 0.02148
## Type:effort_level 1.21 0.61 2 1766.30 1.4490 0.23509
## modification:effort_level 1.49 0.37 4 1761.73 0.8895 0.46937
## Type:modification:effort_level 3.43 0.86 4 1761.77 2.0449 0.08571
##
## Type
## modification ***
## effort_level .
## Type:modification *
## Type:effort_level
## modification:effort_level
## Type:modification:effort_level .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Get model summary for parameter estimates
model_summary <- summary(model_essence)
print("\nModel Summary (Parameter Estimates):")## [1] "\nModel Summary (Parameter Estimates):"print(model_summary)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Response ~ Type * modification * effort_level + (1 + modification |
## id) + (1 | artwork_id)
## Data: data_essence
##
## REML criterion at convergence: 4403.1
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.8799 -0.4393 -0.0301 0.3775 3.5531
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## id (Intercept) 0.34586 0.5881
## modificationNo Modification 0.34653 0.5887 -0.99
## modificationSlight Modification 0.25673 0.5067 -0.52 0.63
## artwork_id (Intercept) 0.02512 0.1585
## Residual 0.41894 0.6473
## Number of obs: 2017, groups: id, 117; artwork_id, 10
##
## Fixed effects:
## Estimate
## (Intercept) 3.59430
## TypeHuman 0.14601
## modificationNo Modification -2.44591
## modificationSlight Modification -1.63155
## effort_level100 hours 0.01071
## effort_levelless than 1 hour 0.17857
## TypeHuman:modificationNo Modification -0.22169
## TypeHuman:modificationSlight Modification 0.05298
## TypeHuman:effort_level100 hours -0.31100
## TypeHuman:effort_levelless than 1 hour -0.36399
## modificationNo Modification:effort_level100 hours -0.09045
## modificationSlight Modification:effort_level100 hours -0.03319
## modificationNo Modification:effort_levelless than 1 hour -0.19981
## modificationSlight Modification:effort_levelless than 1 hour -0.14985
## TypeHuman:modificationNo Modification:effort_level100 hours 0.39743
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.32176
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 0.35987
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 0.36985
## Std. Error
## (Intercept) 0.10812
## TypeHuman 0.13819
## modificationNo Modification 0.11413
## modificationSlight Modification 0.10604
## effort_level100 hours 0.08337
## effort_levelless than 1 hour 0.08371
## TypeHuman:modificationNo Modification 0.16452
## TypeHuman:modificationSlight Modification 0.15279
## TypeHuman:effort_level100 hours 0.12028
## TypeHuman:effort_levelless than 1 hour 0.12059
## modificationNo Modification:effort_level100 hours 0.12036
## modificationSlight Modification:effort_level100 hours 0.11832
## modificationNo Modification:effort_levelless than 1 hour 0.12108
## modificationSlight Modification:effort_levelless than 1 hour 0.11860
## TypeHuman:modificationNo Modification:effort_level100 hours 0.17421
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.17101
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 0.17425
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 0.17060
## df
## (Intercept) 109.12155
## TypeHuman 204.01476
## modificationNo Modification 295.97250
## modificationSlight Modification 329.68303
## effort_level100 hours 1761.97558
## effort_levelless than 1 hour 1763.90702
## TypeHuman:modificationNo Modification 293.14608
## TypeHuman:modificationSlight Modification 326.14657
## TypeHuman:effort_level100 hours 1761.27801
## TypeHuman:effort_levelless than 1 hour 1763.02085
## modificationNo Modification:effort_level100 hours 1760.83364
## modificationSlight Modification:effort_level100 hours 1762.97132
## modificationNo Modification:effort_levelless than 1 hour 1761.40633
## modificationSlight Modification:effort_levelless than 1 hour 1764.01530
## TypeHuman:modificationNo Modification:effort_level100 hours 1760.74622
## TypeHuman:modificationSlight Modification:effort_level100 hours 1762.97429
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 1760.84000
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 1762.32281
## t value
## (Intercept) 33.243
## TypeHuman 1.057
## modificationNo Modification -21.431
## modificationSlight Modification -15.387
## effort_level100 hours 0.128
## effort_levelless than 1 hour 2.133
## TypeHuman:modificationNo Modification -1.347
## TypeHuman:modificationSlight Modification 0.347
## TypeHuman:effort_level100 hours -2.586
## TypeHuman:effort_levelless than 1 hour -3.018
## modificationNo Modification:effort_level100 hours -0.751
## modificationSlight Modification:effort_level100 hours -0.280
## modificationNo Modification:effort_levelless than 1 hour -1.650
## modificationSlight Modification:effort_levelless than 1 hour -1.264
## TypeHuman:modificationNo Modification:effort_level100 hours 2.281
## TypeHuman:modificationSlight Modification:effort_level100 hours 1.882
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 2.065
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 2.168
## Pr(>|t|)
## (Intercept) < 2e-16
## TypeHuman 0.29194
## modificationNo Modification < 2e-16
## modificationSlight Modification < 2e-16
## effort_level100 hours 0.89777
## effort_levelless than 1 hour 0.03305
## TypeHuman:modificationNo Modification 0.17887
## TypeHuman:modificationSlight Modification 0.72901
## TypeHuman:effort_level100 hours 0.00980
## TypeHuman:effort_levelless than 1 hour 0.00258
## modificationNo Modification:effort_level100 hours 0.45246
## modificationSlight Modification:effort_level100 hours 0.77913
## modificationNo Modification:effort_levelless than 1 hour 0.09906
## modificationSlight Modification:effort_levelless than 1 hour 0.20657
## TypeHuman:modificationNo Modification:effort_level100 hours 0.02265
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.06006
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 0.03904
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 0.03030
##
## (Intercept) ***
## TypeHuman
## modificationNo Modification ***
## modificationSlight Modification ***
## effort_level100 hours
## effort_levelless than 1 hour *
## TypeHuman:modificationNo Modification
## TypeHuman:modificationSlight Modification
## TypeHuman:effort_level100 hours **
## TypeHuman:effort_levelless than 1 hour **
## modificationNo Modification:effort_level100 hours
## modificationSlight Modification:effort_level100 hours
## modificationNo Modification:effort_levelless than 1 hour .
## modificationSlight Modification:effort_levelless than 1 hour
## TypeHuman:modificationNo Modification:effort_level100 hours *
## TypeHuman:modificationSlight Modification:effort_level100 hours .
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour *
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##
## Correlation matrix not shown by default, as p = 18 > 12.
## Use print(model_summary, correlation=TRUE) or
## vcov(model_summary) if you need it## optimizer (nloptwrap) convergence code: 0 (OK)
## boundary (singular) fit: see help('isSingular')PART 5: POST-HOC ANALYSES
# Calculate estimated marginal means for main effects and interactions
emm_results <- emmeans(model_essence, specs = c("Type", "modification", "effort_level"))
# Examine the modification main effect
pairs_modification <- pairs(emmeans(model_essence, "modification"),
adjust = "bonferroni")## NOTE: Results may be misleading due to involvement in interactions# Examine the Type × modification interaction
pairs_type_by_mod <- pairs(emmeans(model_essence,
specs = c("Type", "modification")),
by = "Type",
adjust = "bonferroni")## NOTE: Results may be misleading due to involvement in interactions# Calculate effect sizes for modification levels
mod_contrasts <- emmeans(model_essence, "modification")## NOTE: Results may be misleading due to involvement in interactionsmod_effects <- eff_size(pairs(mod_contrasts),
sigma = sigma(model_essence),
edf = df.residual(model_essence))
# Examine simple effects of Type within modification levels
simple_effects_type <- emmeans(model_essence,
specs = "Type",
by = "modification") %>%
pairs()## NOTE: Results may be misleading due to involvement in interactions# Examine modification effects within each effort level
mod_by_effort <- emmeans(model_essence,
specs = c("modification"),
by = "effort_level") %>%
pairs(adjust = "bonferroni")## NOTE: Results may be misleading due to involvement in interactions# Examine Type effects within each effort level
type_by_effort <- emmeans(model_essence,
specs = c("Type"),
by = "effort_level") %>%
pairs()## NOTE: Results may be misleading due to involvement in interactions# Examine three-way interaction patterns
three_way_patterns <- emmeans(model_essence,
specs = c("Type", "modification", "effort_level")) %>%
pairs(by = c("effort_level", "Type"))
# Calculate effect sizes for effort level comparisons
effort_contrasts <- emmeans(model_essence, "effort_level")## NOTE: Results may be misleading due to involvement in interactionseffort_effects <- eff_size(pairs(effort_contrasts),
sigma = sigma(model_essence),
edf = df.residual(model_essence))
# Print all results in a clear, organized format
cat("\nPairwise Comparisons for Modification Levels:\n")##
## Pairwise Comparisons for Modification Levels:print(pairs_modification)## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.527 0.0653 117 38.695
## Dramatic Modification - Slight Modification 1.551 0.0585 115 26.531
## No Modification - Slight Modification -0.976 0.0572 116 -17.080
## p.value
## <.0001
## <.0001
## <.0001
##
## Results are averaged over the levels of: Type, effort_level
## Degrees-of-freedom method: kenward-roger
## P value adjustment: bonferroni method for 3 testscat("\nEffect Sizes for Modification Comparisons:\n")##
## Effect Sizes for Modification Comparisons:print(mod_effects)## contrast
## (Dramatic Modification - No Modification) - (Dramatic Modification - Slight Modification)
## (Dramatic Modification - No Modification) - (No Modification - Slight Modification)
## (Dramatic Modification - Slight Modification) - (No Modification - Slight Modification)
## effect.size SE df lower.CL upper.CL
## 1.51 0.0915 115 1.33 1.69
## 5.41 0.1710 116 5.07 5.75
## 3.90 0.1020 115 3.70 4.11
##
## Results are averaged over the levels of: Type, effort_level
## sigma used for effect sizes: 0.6473
## Degrees-of-freedom method: inherited from kenward-roger when re-gridding
## Confidence level used: 0.95cat("\nSimple Effects of Type within each Modification Level:\n")##
## Simple Effects of Type within each Modification Level:print(simple_effects_type)## modification = Dramatic Modification:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.0790 0.1190 115 0.662 0.5096
##
## modification = No Modification:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.0482 0.0532 114 0.906 0.3667
##
## modification = Slight Modification:
## contrast estimate SE df t.ratio p.value
## AI - Human -0.2045 0.1110 115 -1.836 0.0689
##
## Results are averaged over the levels of: effort_level
## Degrees-of-freedom method: kenward-rogercat("\nPairwise Comparisons by Creator Type:\n")##
## Pairwise Comparisons by Creator Type:print(pairs_type_by_mod)## Type = AI:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.54 0.0902 116 28.177
## Dramatic Modification - Slight Modification 1.69 0.0809 115 20.917
## No Modification - Slight Modification -0.85 0.0790 116 -10.757
## p.value
## <.0001
## <.0001
## <.0001
##
## Type = Human:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.51 0.0941 116 26.699
## Dramatic Modification - Slight Modification 1.41 0.0843 115 16.705
## No Modification - Slight Modification -1.10 0.0824 115 -13.384
## p.value
## <.0001
## <.0001
## <.0001
##
## Results are averaged over the levels of: effort_level
## Degrees-of-freedom method: kenward-roger
## P value adjustment: bonferroni method for 3 testscat("\nModification Effects within Each Effort Level:\n")##
## Modification Effects within Each Effort Level:print(mod_by_effort)## effort_level = 10 hours:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.557 0.0825 289 30.993
## Dramatic Modification - Slight Modification 1.605 0.0764 324 21.008
## No Modification - Slight Modification -0.952 0.0763 351 -12.479
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = 100 hours:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.448 0.0824 288 29.718
## Dramatic Modification - Slight Modification 1.477 0.0766 328 19.276
## No Modification - Slight Modification -0.971 0.0764 353 -12.711
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = less than 1 hour:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.577 0.0824 288 31.260
## Dramatic Modification - Slight Modification 1.570 0.0764 324 20.548
## No Modification - Slight Modification -1.007 0.0763 351 -13.197
## p.value
## <.0001
## <.0001
## <.0001
##
## Results are averaged over the levels of: Type
## Degrees-of-freedom method: kenward-roger
## P value adjustment: bonferroni method for 3 testscat("\nType Effects within Each Effort Level:\n")##
## Type Effects within Each Effort Level:print(type_by_effort)## effort_level = 10 hours:
## contrast estimate SE df t.ratio p.value
## AI - Human -0.0898 0.0816 203 -1.100 0.2728
##
## effort_level = 100 hours:
## contrast estimate SE df t.ratio p.value
## AI - Human -0.0185 0.0817 204 -0.226 0.8211
##
## effort_level = less than 1 hour:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.0310 0.0819 206 0.378 0.7057
##
## Results are averaged over the levels of: modification
## Degrees-of-freedom method: kenward-rogercat("\nEffect Sizes for Effort Level Comparisons:\n")##
## Effect Sizes for Effort Level Comparisons:print(effort_effects)## contrast effect.size
## (10 hours - 100 hours) - (10 hours - less than 1 hour) 0.105
## (10 hours - 100 hours) - (100 hours - less than 1 hour) 0.207
## (10 hours - less than 1 hour) - (100 hours - less than 1 hour) 0.102
## SE df lower.CL upper.CL
## 0.0552 1675 -0.00347 0.213
## 0.0958 1675 0.01906 0.395
## 0.0554 1675 -0.00639 0.211
##
## Results are averaged over the levels of: Type, modification
## sigma used for effect sizes: 0.6473
## Degrees-of-freedom method: inherited from kenward-roger when re-gridding
## Confidence level used: 0.95cat("\nThree-way Interaction Patterns:\n")##
## Three-way Interaction Patterns:print(three_way_patterns)## effort_level = 10 hours, Type = AI:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.446 0.114 289 21.426 <.0001
## Dramatic Modification - Slight Modification 1.632 0.106 328 15.386 <.0001
## No Modification - Slight Modification -0.814 0.106 351 -7.716 <.0001
##
## effort_level = 100 hours, Type = AI:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.536 0.114 283 22.345 <.0001
## Dramatic Modification - Slight Modification 1.665 0.106 324 15.746 <.0001
## No Modification - Slight Modification -0.872 0.105 347 -8.287 <.0001
##
## effort_level = less than 1 hour, Type = AI:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.646 0.114 291 23.130 <.0001
## Dramatic Modification - Slight Modification 1.781 0.106 328 16.799 <.0001
## No Modification - Slight Modification -0.864 0.106 357 -8.149 <.0001
##
## effort_level = 10 hours, Type = Human:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.668 0.119 286 22.451 <.0001
## Dramatic Modification - Slight Modification 1.579 0.110 321 14.348 <.0001
## No Modification - Slight Modification -1.089 0.110 348 -9.911 <.0001
##
## effort_level = 100 hours, Type = Human:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.361 0.119 289 19.807 <.0001
## Dramatic Modification - Slight Modification 1.290 0.111 331 11.627 <.0001
## No Modification - Slight Modification -1.071 0.111 357 -9.670 <.0001
##
## effort_level = less than 1 hour, Type = Human:
## contrast estimate SE df t.ratio p.value
## Dramatic Modification - No Modification 2.508 0.118 283 21.174 <.0001
## Dramatic Modification - Slight Modification 1.359 0.110 321 12.348 <.0001
## No Modification - Slight Modification -1.149 0.109 344 -10.496 <.0001
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 3 estimatesPART 6: DESCRIPTIVE STATISTICS FOR CONFIRMATION
# Calculate overall descriptive statistics combining all factors
descriptives <- data_essence %>%
group_by(Type, modification, effort_level) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# Create focused summaries examining specific aspects of the design
# 1. Examine how modification levels affect essence change ratings for each creator type
mod_by_type_summary <- data_essence %>%
group_by(Type, modification) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# 2. Analyze how effort levels influence essence change ratings for each creator type
effort_by_type_summary <- data_essence %>%
group_by(Type, effort_level) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# 3. Examine the complete interaction between all factors
three_way_summary <- data_essence %>%
group_by(Type, modification, effort_level) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# Present results in an organized format
cat("\nOverall Descriptive Statistics for Essence Change:\n")##
## Overall Descriptive Statistics for Essence Change:print(descriptives)## # A tibble: 18 × 9
## Type modification effort_level mean sd se n ci_lower ci_upper
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Dramatic Modif… 10 hours 3.58 1.02 0.0921 122 3.40 3.77
## 2 AI Dramatic Modif… 100 hours 3.60 1.06 0.0957 122 3.41 3.79
## 3 AI Dramatic Modif… less than 1… 3.80 0.963 0.0872 122 3.63 3.97
## 4 AI No Modification 10 hours 1.12 0.400 0.0362 122 1.05 1.19
## 5 AI No Modification 100 hours 1.04 0.281 0.0255 122 0.994 1.10
## 6 AI No Modification less than 1… 1.12 0.448 0.0405 122 1.04 1.20
## 7 AI Slight Modific… 10 hours 1.96 0.838 0.0758 122 1.81 2.11
## 8 AI Slight Modific… 100 hours 1.94 0.959 0.0869 122 1.77 2.11
## 9 AI Slight Modific… less than 1… 2.02 0.896 0.0811 122 1.86 2.18
## 10 Human Dramatic Modif… 10 hours 3.74 0.966 0.0912 112 3.56 3.92
## 11 Human Dramatic Modif… 100 hours 3.45 1.03 0.0976 112 3.26 3.64
## 12 Human Dramatic Modif… less than 1… 3.55 0.909 0.0859 112 3.38 3.72
## 13 Human No Modification 10 hours 1.05 0.260 0.0246 112 1.00 1.10
## 14 Human No Modification 100 hours 1.06 0.312 0.0295 112 1.00 1.12
## 15 Human No Modification less than 1… 1.03 0.169 0.0160 112 0.997 1.06
## 16 Human Slight Modific… 10 hours 2.16 0.910 0.0860 112 1.99 2.33
## 17 Human Slight Modific… 100 hours 2.17 0.906 0.0856 112 2.00 2.34
## 18 Human Slight Modific… less than 1… 2.20 0.952 0.0899 112 2.02 2.38cat("\nEssence Change by Modification Level and Creator Type:\n")##
## Essence Change by Modification Level and Creator Type:print(mod_by_type_summary)## # A tibble: 6 × 8
## Type modification mean sd se n ci_lower ci_upper
## <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Dramatic Modification 3.66 1.02 0.0531 366 3.56 3.77
## 2 AI No Modification 1.09 0.382 0.0200 366 1.05 1.13
## 3 AI Slight Modification 1.97 0.897 0.0469 366 1.88 2.06
## 4 Human Dramatic Modification 3.58 0.975 0.0532 336 3.48 3.69
## 5 Human No Modification 1.05 0.253 0.0138 336 1.02 1.07
## 6 Human Slight Modification 2.18 0.920 0.0502 336 2.08 2.28cat("\nEssence Change by Effort Level and Creator Type:\n")##
## Essence Change by Effort Level and Creator Type:print(effort_by_type_summary)## # A tibble: 6 × 8
## Type effort_level mean sd se n ci_lower ci_upper
## <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI 10 hours 2.25 1.30 0.0679 366 2.12 2.39
## 2 AI 100 hours 2.23 1.36 0.0709 366 2.09 2.37
## 3 AI less than 1 hour 2.36 1.38 0.0721 366 2.22 2.50
## 4 Human 10 hours 2.36 1.35 0.0739 336 2.22 2.51
## 5 Human 100 hours 2.27 1.28 0.0696 336 2.13 2.40
## 6 Human less than 1 hour 2.29 1.29 0.0702 336 2.16 2.43cat("\nComplete Three-Way Interaction for Essence Change:\n")##
## Complete Three-Way Interaction for Essence Change:print(three_way_summary)## # A tibble: 18 × 9
## Type modification effort_level mean sd se n ci_lower ci_upper
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Dramatic Modif… 10 hours 3.58 1.02 0.0921 122 3.40 3.77
## 2 AI Dramatic Modif… 100 hours 3.60 1.06 0.0957 122 3.41 3.79
## 3 AI Dramatic Modif… less than 1… 3.80 0.963 0.0872 122 3.63 3.97
## 4 AI No Modification 10 hours 1.12 0.400 0.0362 122 1.05 1.19
## 5 AI No Modification 100 hours 1.04 0.281 0.0255 122 0.994 1.10
## 6 AI No Modification less than 1… 1.12 0.448 0.0405 122 1.04 1.20
## 7 AI Slight Modific… 10 hours 1.96 0.838 0.0758 122 1.81 2.11
## 8 AI Slight Modific… 100 hours 1.94 0.959 0.0869 122 1.77 2.11
## 9 AI Slight Modific… less than 1… 2.02 0.896 0.0811 122 1.86 2.18
## 10 Human Dramatic Modif… 10 hours 3.74 0.966 0.0912 112 3.56 3.92
## 11 Human Dramatic Modif… 100 hours 3.45 1.03 0.0976 112 3.26 3.64
## 12 Human Dramatic Modif… less than 1… 3.55 0.909 0.0859 112 3.38 3.72
## 13 Human No Modification 10 hours 1.05 0.260 0.0246 112 1.00 1.10
## 14 Human No Modification 100 hours 1.06 0.312 0.0295 112 1.00 1.12
## 15 Human No Modification less than 1… 1.03 0.169 0.0160 112 0.997 1.06
## 16 Human Slight Modific… 10 hours 2.16 0.910 0.0860 112 1.99 2.33
## 17 Human Slight Modific… 100 hours 2.17 0.906 0.0856 112 2.00 2.34
## 18 Human Slight Modific… less than 1… 2.20 0.952 0.0899 112 2.02 2.38# Calculate type differences at each modification level
cat("\nMean Differences in Essence Change Between Types at Each Modification Level:\n")##
## Mean Differences in Essence Change Between Types at Each Modification Level:type_differences <- mod_by_type_summary %>%
group_by(modification) %>%
summarise(
type_difference = diff(mean),
pooled_se = sqrt(sum(se^2)),
t_value = type_difference/pooled_se,
df = n[1] + n[2] - 2,
p_value = 2 * pt(-abs(t_value), df),
.groups = 'drop'
)
print(type_differences)## # A tibble: 3 × 6
## modification type_difference pooled_se t_value df p_value
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Dramatic Modification -0.0791 0.0751 -1.05 700 0.293
## 2 No Modification -0.0479 0.0243 -1.97 700 0.0490
## 3 Slight Modification 0.204 0.0687 2.98 700 0.00303Creativity
PART 1: SETUP AND DATA PREPARATION
### Load Required Libraries
library(tidyverse) # For data manipulation and visualization
library(lme4) # For mixed effects modeling
library(lmerTest) # For significance tests in mixed models
library(emmeans) # For post-hoc comparisons
library(effectsize) # For effect size calculations
library(moments) # For additional normality assessments
### Read and Prepare Data
data_creativity <- read_csv("Creativity_Longform.csv")## Rows: 2106 Columns: 11
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (8): response, modification, measure, response_type, Type, effort_level,...
## dbl (3): id, image_number, Response
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.PART 2: DATA STRUCTURE VERIFICATION
##### PART 2: DATA STRUCTURE VERIFICATION
# This verification ensures our data matches the study design where:
# - Each participant sees 6 unique artworks (combinations of image number and type)
# - Each artwork is rated under all 3 modification levels
# - Each participant experiences all 3 effort levels
# - There should be a balance of Figure and NonFigure images
# First, let's check the basic structure for each participant
structure_check <- data_creativity %>%
group_by(id) %>%
summarise(
# Count unique artworks by combining image number and type
n_artworks = n_distinct(paste(image_number, image_type)),
# Check modification levels per participant
n_modifications = n_distinct(modification),
# Check effort levels per participant
n_effort_levels = n_distinct(effort_level),
# Count total ratings (should be 18: 6 artworks × 3 modifications)
total_ratings = n(),
# Count Figure vs NonFigure balance
n_figure = n_distinct(paste(image_number, image_type)[image_type == "Figure"]),
n_nonfigure = n_distinct(paste(image_number, image_type)[image_type == "NonFigure"]),
.groups = "drop"
)
# Now verify modification balance within each unique artwork
mod_balance <- data_creativity %>%
group_by(id, image_number, image_type, effort_level) %>%
summarise(
n_modifications = n_distinct(modification),
modifications = list(sort(unique(as.character(modification)))),
.groups = "drop"
)
# Check effort level distribution for each participant
effort_balance <- data_creativity %>%
group_by(id, effort_level) %>%
summarise(
n_artworks = n_distinct(paste(image_number, image_type)),
.groups = "drop"
) %>%
pivot_wider(
names_from = effort_level,
values_from = n_artworks,
names_prefix = "effort_"
)
# Print comprehensive verification results
cat("\nData Structure Verification for Transformativeness:\n")##
## Data Structure Verification for Transformativeness:cat("\n1. Basic Structure Summary:\n")##
## 1. Basic Structure Summary:print(summary(structure_check))## id n_artworks n_modifications n_effort_levels total_ratings
## Min. :58091 Min. :6 Min. :3 Min. :3 Min. :18
## 1st Qu.:65878 1st Qu.:6 1st Qu.:3 1st Qu.:3 1st Qu.:18
## Median :69285 Median :6 Median :3 Median :3 Median :18
## Mean :67559 Mean :6 Mean :3 Mean :3 Mean :18
## 3rd Qu.:69513 3rd Qu.:6 3rd Qu.:3 3rd Qu.:3 3rd Qu.:18
## Max. :69876 Max. :6 Max. :3 Max. :3 Max. :18
## n_figure n_nonfigure
## Min. :3 Min. :3
## 1st Qu.:3 1st Qu.:3
## Median :3 Median :3
## Mean :3 Mean :3
## 3rd Qu.:3 3rd Qu.:3
## Max. :3 Max. :3cat("\n2. Detailed Participant-Level Checks:\n")##
## 2. Detailed Participant-Level Checks:cat("Number of unique artworks per participant (should be 6):\n")## Number of unique artworks per participant (should be 6):print(table(structure_check$n_artworks))##
## 6
## 117cat("\nModification levels per participant (should be 3):\n")##
## Modification levels per participant (should be 3):print(table(structure_check$n_modifications))##
## 3
## 117cat("\nEffort levels per participant (should be 3):\n")##
## Effort levels per participant (should be 3):print(table(structure_check$n_effort_levels))##
## 3
## 117cat("\n3. Figure/NonFigure Balance:\n")##
## 3. Figure/NonFigure Balance:cat("Distribution of Figure images per participant:\n")## Distribution of Figure images per participant:print(table(structure_check$n_figure))##
## 3
## 117cat("\nDistribution of NonFigure images per participant:\n")##
## Distribution of NonFigure images per participant:print(table(structure_check$n_nonfigure))##
## 3
## 117cat("\n4. Modification Balance Check:\n")##
## 4. Modification Balance Check:cat("Number of modifications per artwork (should all be 3):\n")## Number of modifications per artwork (should all be 3):print(table(mod_balance$n_modifications))##
## 3
## 702cat("\n5. Effort Level Distribution:\n")##
## 5. Effort Level Distribution:summary_effort <- effort_balance %>%
summarise(
across(starts_with("effort_"),
list(
mean = ~mean(., na.rm = TRUE),
sd = ~sd(., na.rm = TRUE)
))
)
print(summary_effort)## # A tibble: 1 × 6
## `effort_10 hours_mean` `effort_10 hours_sd` `effort_100 hours_mean`
## <dbl> <dbl> <dbl>
## 1 2 0 2
## # ℹ 3 more variables: `effort_100 hours_sd` <dbl>,
## # `effort_less than 1 hour_mean` <dbl>, `effort_less than 1 hour_sd` <dbl># Identify participants with fewer than 6 artworks
participants_with_fewer_artworks <- structure_check %>%
filter(n_artworks < 6) %>%
pull(id)
# Examine their complete data
detailed_inspection <- data_creativity %>%
filter(id %in% participants_with_fewer_artworks) %>%
arrange(id, image_number, image_type, modification) %>%
select(id, image_number, image_type, effort_level, modification, Response)
# Show the unique combinations of images they saw
image_combinations <- data_creativity %>%
filter(id %in% participants_with_fewer_artworks) %>%
group_by(id) %>%
summarize(
image_combinations = list(unique(paste(image_number, image_type))),
effort_levels = list(unique(effort_level))
)
print("Participants with fewer than 6 artworks:")## [1] "Participants with fewer than 6 artworks:"print(participants_with_fewer_artworks)## numeric(0)print("\nDetailed data for these participants:")## [1] "\nDetailed data for these participants:"print(detailed_inspection)## # A tibble: 0 × 6
## # ℹ 6 variables: id <dbl>, image_number <dbl>, image_type <chr>,
## # effort_level <chr>, modification <chr>, Response <dbl>print("\nUnique image combinations:")## [1] "\nUnique image combinations:"print(image_combinations)## # A tibble: 0 × 3
## # ℹ 3 variables: id <dbl>, image_combinations <list>, effort_levels <list># Add a final verification message
cat("\nVerification Summary:\n")##
## Verification Summary:all_correct <- all(
all(structure_check$n_artworks == 6),
all(structure_check$n_modifications == 3),
all(structure_check$n_effort_levels == 3),
all(structure_check$total_ratings == 18)
)
if(all_correct) {
cat("✓ Data structure matches study design specifications\n")
} else {
cat("! Some aspects of the data structure require attention\n")
}## ✓ Data structure matches study design specificationsPART 3: FIT MIXED EFFECT MODEL AND TESTS OF NORMALITY
# Define enhanced normality assessment function
assess_normality <- function(residuals, measure_name) {
# Visual checks
par(mfrow = c(2,2))
# Histogram with density curve
hist(residuals, freq = FALSE,
main = paste("Residual Distribution -", measure_name),
xlab = "Residuals", col = "lightgray")
curve(dnorm(x, mean = mean(residuals), sd = sd(residuals)),
add = TRUE, col = "#E69F00", lwd = 2)
# Q-Q plot with reference line
qqnorm(residuals, main = paste("Q-Q Plot -", measure_name),
pch = 1, col = "#56B4E9")
qqline(residuals, col = "#E69F00", lwd = 2)
# Density plot comparison
plot(density(residuals),
main = paste("Density Plot -", measure_name),
col = "#56B4E9", lwd = 2)
curve(dnorm(x, mean = mean(residuals), sd = sd(residuals)),
add = TRUE, col = "#E69F00", lwd = 2, lty = 2)
# Boxplot of residuals
boxplot(residuals,
main = paste("Residual Spread -", measure_name),
ylab = "Residuals", col = "#56B4E9")
par(mfrow = c(1,1))
# Statistical tests
ks_test <- ks.test(scale(residuals), "pnorm")
skew <- moments::skewness(residuals)
kurt <- moments::kurtosis(residuals)
# Print formal test results
cat("\n=== Normality Assessment for", measure_name, "===\n")
cat("Kolmogorov-Smirnov Test:\n")
cat("D =", round(ks_test$statistic, 3),
"p-value =", format.pval(ks_test$p.value, digits = 3), "\n\n")
cat("Distribution Shape:\n")
cat("Skewness =", round(skew, 3),
"(SE =", round(sd(residuals)/sqrt(length(residuals)), 3), ")\n")
cat("Kurtosis =", round(kurt, 3),
"(SE =", round(sd(residuals)/sqrt(length(residuals)), 3), ")\n")
invisible(list(
ks_test = ks_test,
skewness = skew,
kurtosis = kurt
))
}
# First, create unique identifier for each artwork
data_creativity <- data_creativity %>%
mutate(
artwork_id = paste(image_number, image_type)
)
# Fit initial mixed effects model with convergence control
initial_model_creativity <- lmer(
Response ~ Type * modification * effort_level +
(1 + modification | id) +
(1 | artwork_id),
data = data_creativity,
control = lmerControl(optimizer = "bobyqa",
optCtrl = list(maxfun = 2e5))
)
### Comprehensive Model Diagnostics
model_residuals_creativity <- residuals(initial_model_creativity)
model_fitted_creativity <- fitted(initial_model_creativity)
# Conduct formal normality assessment for creativity ratings
normality_report_creativity <- assess_normality(model_residuals_creativity, "Creativity")
##
## === Normality Assessment for Creativity ===
## Kolmogorov-Smirnov Test:
## D = 0.09 p-value = 4.36e-15
##
## Distribution Shape:
## Skewness = 0.336 (SE = 0.013 )
## Kurtosis = 5.239 (SE = 0.013 )# Create diagnostic plots to examine model assumptions
# Residuals vs. Fitted plot helps assess linearity and homoscedasticity
ggplot(mapping = aes(x = model_fitted_creativity, y = model_residuals_creativity)) +
geom_point(alpha = 0.5, color = "#0072B2") +
geom_hline(yintercept = 0, color = "#D55E00", size = 1) +
geom_smooth(color = "#009E73", se = FALSE) +
labs(title = "Residuals vs. Fitted Values (Creativity)",
x = "Fitted Values", y = "Residuals") +
theme_minimal()## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
# Scale-Location plot helps assess homoscedasticity
ggplot(mapping = aes(x = model_fitted_creativity, y = sqrt(abs(model_residuals_creativity)))) +
geom_point(alpha = 0.5, color = "#0072B2") +
geom_smooth(color = "#009E73", se = FALSE) +
labs(title = "Scale-Location Plot (Creativity)",
x = "Fitted Values", y = "√|Standardized Residuals|") +
theme_minimal()## `geom_smooth()` using method = 'gam' and formula = 'y ~ s(x, bs = "cs")'
# Prepare data for residual distribution plots
used_rows_creativity <- attr(initial_model_creativity@frame, "row.names")
creativity_resid_data <- data_creativity %>%
mutate(row_num = 1:n()) %>%
filter(row_num %in% as.numeric(used_rows_creativity)) %>%
mutate(residuals = model_residuals_creativity)
# Create boxplot for modification levels to examine residual patterns
p1 <- ggplot(creativity_resid_data,
aes(x = modification, y = residuals, fill = Type)) +
geom_boxplot(alpha = 0.8, outlier.shape = NA) +
geom_jitter(width = 0.2, alpha = 0.3, color = "#999999") +
scale_fill_manual(values = c("#595959", "#A1a1a1")) +
labs(title = "Residuals by Modification Level",
x = "Modification Level", y = "Residuals") +
theme_bw() +
theme(legend.position = "bottom",
panel.grid.major.x = element_blank())
# Create boxplot for effort levels to examine residual patterns
p2 <- ggplot(creativity_resid_data,
aes(x = effort_level, y = residuals, fill = Type)) +
geom_boxplot(alpha = 0.8, outlier.shape = NA) +
geom_jitter(width = 0.2, alpha = 0.3, color = "#999999") +
scale_fill_manual(values = c("#595959", "#A1a1a1")) +
labs(title = "Residuals by Effort Level",
x = "Effort Level", y = "Residuals") +
theme_bw() +
theme(legend.position = "bottom",
panel.grid.major.x = element_blank())
# Arrange residual plots side by side
grid.arrange(p1, p2, ncol = 2)
# Visualize interaction patterns in creativity ratings
interaction_plot <- ggplot(data_creativity,
aes(x = modification, y = Response, color = Type)) +
geom_point(alpha = 0.3) +
geom_smooth(method = "lm") +
facet_wrap(~effort_level) +
theme_bw() +
labs(title = "Creativity Rating Patterns Across Conditions")
print(interaction_plot)## `geom_smooth()` using formula = 'y ~ x'
PART 4: MAIN ANALYSIS
# Fit final model
model_creativity <- lmer(
Response ~ Type * modification * effort_level +
(1 + modification | id) + # Random slopes for participant sensitivity to modifications
(1 | artwork_id), # Random intercepts for artwork differences
data = data_creativity,
REML = TRUE
)
# Obtain Type III ANOVA results to examine fixed effects on creativity ratings
anova_results <- anova(model_creativity, type = 3)
# Print comprehensive ANOVA results with clear labels
print("\nType III ANOVA Results for Creativity Ratings:")## [1] "\nType III ANOVA Results for Creativity Ratings:"print(anova_results)## Type III Analysis of Variance Table with Satterthwaite's method
## Sum Sq Mean Sq NumDF DenDF F value Pr(>F)
## Type 0.538 0.538 1 114.82 1.3404 0.24937
## modification 297.129 148.565 2 115.00 370.4090 < 2e-16
## effort_level 4.999 2.500 2 1740.30 6.2320 0.00201
## Type:modification 1.092 0.546 2 115.00 1.3612 0.26045
## Type:effort_level 2.646 1.323 2 1739.23 3.2989 0.03715
## modification:effort_level 0.882 0.221 4 1732.58 0.5499 0.69913
## Type:modification:effort_level 2.398 0.599 4 1732.58 1.4946 0.20127
##
## Type
## modification ***
## effort_level **
## Type:modification
## Type:effort_level *
## modification:effort_level
## Type:modification:effort_level
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# Get detailed model summary including parameter estimates
model_summary <- summary(model_creativity)
print("\nModel Summary for Creativity Analysis (Parameter Estimates):")## [1] "\nModel Summary for Creativity Analysis (Parameter Estimates):"print(model_summary)## Linear mixed model fit by REML. t-tests use Satterthwaite's method [
## lmerModLmerTest]
## Formula: Response ~ Type * modification * effort_level + (1 + modification |
## id) + (1 | artwork_id)
## Data: data_creativity
##
## REML criterion at convergence: 4632.7
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -3.5264 -0.4720 -0.0422 0.3946 4.9889
##
## Random effects:
## Groups Name Variance Std.Dev. Corr
## id (Intercept) 0.43300 0.6580
## modificationNo Modification 0.57455 0.7580 -0.77
## modificationSlight Modification 0.32656 0.5715 -0.53 0.88
## artwork_id (Intercept) 0.01141 0.1068
## Residual 0.40108 0.6333
## Number of obs: 2106, groups: id, 117; artwork_id, 10
##
## Fixed effects:
## Estimate
## (Intercept) 3.37125
## TypeHuman -0.04269
## modificationNo Modification -1.99180
## modificationSlight Modification -1.38525
## effort_level100 hours -0.05480
## effort_levelless than 1 hour 0.19464
## TypeHuman:modificationNo Modification -0.12427
## TypeHuman:modificationSlight Modification 0.01025
## TypeHuman:effort_level100 hours -0.01871
## TypeHuman:effort_levelless than 1 hour -0.34569
## modificationNo Modification:effort_level100 hours -0.12295
## modificationSlight Modification:effort_level100 hours -0.12295
## modificationNo Modification:effort_levelless than 1 hour -0.28689
## modificationSlight Modification:effort_levelless than 1 hour -0.18033
## TypeHuman:modificationNo Modification:effort_level100 hours 0.08724
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.10509
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 0.36724
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 0.29640
## Std. Error
## (Intercept) 0.10740
## TypeHuman 0.14733
## modificationNo Modification 0.12647
## modificationSlight Modification 0.10922
## effort_level100 hours 0.08120
## effort_levelless than 1 hour 0.08129
## TypeHuman:modificationNo Modification 0.18280
## TypeHuman:modificationSlight Modification 0.15787
## TypeHuman:effort_level100 hours 0.11724
## TypeHuman:effort_levelless than 1 hour 0.11754
## modificationNo Modification:effort_level100 hours 0.11467
## modificationSlight Modification:effort_level100 hours 0.11467
## modificationNo Modification:effort_levelless than 1 hour 0.11467
## modificationSlight Modification:effort_levelless than 1 hour 0.11467
## TypeHuman:modificationNo Modification:effort_level100 hours 0.16575
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.16575
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 0.16575
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 0.16575
## df
## (Intercept) 167.80740
## TypeHuman 183.92200
## modificationNo Modification 216.18140
## modificationSlight Modification 281.13300
## effort_level100 hours 1734.35761
## effort_levelless than 1 hour 1735.87054
## TypeHuman:modificationNo Modification 216.18140
## TypeHuman:modificationSlight Modification 281.13300
## TypeHuman:effort_level100 hours 1733.01224
## TypeHuman:effort_levelless than 1 hour 1736.18937
## modificationNo Modification:effort_level100 hours 1732.57972
## modificationSlight Modification:effort_level100 hours 1732.57972
## modificationNo Modification:effort_levelless than 1 hour 1732.57972
## modificationSlight Modification:effort_levelless than 1 hour 1732.57972
## TypeHuman:modificationNo Modification:effort_level100 hours 1732.57972
## TypeHuman:modificationSlight Modification:effort_level100 hours 1732.57973
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 1732.57972
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 1732.57973
## t value
## (Intercept) 31.391
## TypeHuman -0.290
## modificationNo Modification -15.750
## modificationSlight Modification -12.683
## effort_level100 hours -0.675
## effort_levelless than 1 hour 2.394
## TypeHuman:modificationNo Modification -0.680
## TypeHuman:modificationSlight Modification 0.065
## TypeHuman:effort_level100 hours -0.160
## TypeHuman:effort_levelless than 1 hour -2.941
## modificationNo Modification:effort_level100 hours -1.072
## modificationSlight Modification:effort_level100 hours -1.072
## modificationNo Modification:effort_levelless than 1 hour -2.502
## modificationSlight Modification:effort_levelless than 1 hour -1.573
## TypeHuman:modificationNo Modification:effort_level100 hours 0.526
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.634
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 2.216
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 1.788
## Pr(>|t|)
## (Intercept) < 2e-16
## TypeHuman 0.77235
## modificationNo Modification < 2e-16
## modificationSlight Modification < 2e-16
## effort_level100 hours 0.49979
## effort_levelless than 1 hour 0.01676
## TypeHuman:modificationNo Modification 0.49736
## TypeHuman:modificationSlight Modification 0.94830
## TypeHuman:effort_level100 hours 0.87326
## TypeHuman:effort_levelless than 1 hour 0.00331
## modificationNo Modification:effort_level100 hours 0.28379
## modificationSlight Modification:effort_level100 hours 0.28379
## modificationNo Modification:effort_levelless than 1 hour 0.01245
## modificationSlight Modification:effort_levelless than 1 hour 0.11601
## TypeHuman:modificationNo Modification:effort_level100 hours 0.59875
## TypeHuman:modificationSlight Modification:effort_level100 hours 0.52614
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour 0.02685
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour 0.07392
##
## (Intercept) ***
## TypeHuman
## modificationNo Modification ***
## modificationSlight Modification ***
## effort_level100 hours
## effort_levelless than 1 hour *
## TypeHuman:modificationNo Modification
## TypeHuman:modificationSlight Modification
## TypeHuman:effort_level100 hours
## TypeHuman:effort_levelless than 1 hour **
## modificationNo Modification:effort_level100 hours
## modificationSlight Modification:effort_level100 hours
## modificationNo Modification:effort_levelless than 1 hour *
## modificationSlight Modification:effort_levelless than 1 hour
## TypeHuman:modificationNo Modification:effort_level100 hours
## TypeHuman:modificationSlight Modification:effort_level100 hours
## TypeHuman:modificationNo Modification:effort_levelless than 1 hour *
## TypeHuman:modificationSlight Modification:effort_levelless than 1 hour .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##
## Correlation matrix not shown by default, as p = 18 > 12.
## Use print(model_summary, correlation=TRUE) or
## vcov(model_summary) if you need itPART 5: POST-HOC ANALYSES
# Calculate estimated marginal means to examine creativity ratings across conditions
emm_results <- emmeans(model_creativity, specs = c("Type", "modification", "effort_level"))
# Examine how different modification levels affect creativity ratings
pairs_modification <- pairs(emmeans(model_creativity, "modification"),
adjust = "bonferroni")## NOTE: Results may be misleading due to involvement in interactions# Analyze how modification effects on creativity differ between AI and human creators
pairs_type_by_mod <- pairs(emmeans(model_creativity,
specs = c("Type", "modification")),
by = "Type",
adjust = "bonferroni")## NOTE: Results may be misleading due to involvement in interactions# Calculate standardized effect sizes for modification differences in creativity
mod_contrasts <- emmeans(model_creativity, "modification")## NOTE: Results may be misleading due to involvement in interactionsmod_effects <- eff_size(pairs(mod_contrasts),
sigma = sigma(model_creativity),
edf = df.residual(model_creativity))
# Examine how creator type affects creativity ratings within each modification level
simple_effects_type <- emmeans(model_creativity,
specs = "Type",
by = "modification") %>%
pairs()## NOTE: Results may be misleading due to involvement in interactions# Analyze how modifications influence creativity ratings within each effort level
mod_by_effort <- emmeans(model_creativity,
specs = c("modification"),
by = "effort_level") %>%
pairs(adjust = "bonferroni")## NOTE: Results may be misleading due to involvement in interactions# Examine how creator type affects creativity ratings within each effort level
type_by_effort <- emmeans(model_creativity,
specs = c("Type"),
by = "effort_level") %>%
pairs()## NOTE: Results may be misleading due to involvement in interactions# Analyze complex patterns in how modifications, creator type, and effort interact
three_way_patterns <- emmeans(model_creativity,
specs = c("Type", "modification", "effort_level")) %>%
pairs(by = c("effort_level", "Type"))
# Calculate effect sizes for how effort levels influence creativity ratings
effort_contrasts <- emmeans(model_creativity, "effort_level")## NOTE: Results may be misleading due to involvement in interactionseffort_effects <- eff_size(pairs(effort_contrasts),
sigma = sigma(model_creativity),
edf = df.residual(model_creativity))
# Print results in a clear, organized format that shows how creativity is affected by our manipulations
cat("\nPairwise Comparisons for How Modifications Affect Creativity:\n")##
## Pairwise Comparisons for How Modifications Affect Creativity:print(pairs_modification)## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.115 0.0779 115 27.157
## Dramatic Modification - Slight Modification 1.414 0.0628 115 22.529
## No Modification - Slight Modification -0.701 0.0479 115 -14.610
## p.value
## <.0001
## <.0001
## <.0001
##
## Results are averaged over the levels of: Type, effort_level
## Degrees-of-freedom method: kenward-roger
## P value adjustment: bonferroni method for 3 testscat("\nEffect Sizes for Modification Impacts on Creativity:\n")##
## Effect Sizes for Modification Impacts on Creativity:print(mod_effects)## contrast
## (Dramatic Modification - No Modification) - (Dramatic Modification - Slight Modification)
## (Dramatic Modification - No Modification) - (No Modification - Slight Modification)
## (Dramatic Modification - Slight Modification) - (No Modification - Slight Modification)
## effect.size SE df lower.CL upper.CL
## 1.11 0.0776 115 0.952 1.26
## 4.45 0.1820 115 4.085 4.81
## 3.34 0.1240 115 3.093 3.59
##
## Results are averaged over the levels of: Type, effort_level
## sigma used for effect sizes: 0.6333
## Degrees-of-freedom method: inherited from kenward-roger when re-gridding
## Confidence level used: 0.95cat("\nHow Creator Type Influences Creativity at Each Modification Level:\n")##
## How Creator Type Influences Creativity at Each Modification Level:print(simple_effects_type)## modification = Dramatic Modification:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.1642 0.131 115 1.255 0.2122
##
## modification = No Modification:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.1369 0.102 115 1.345 0.1812
##
## modification = Slight Modification:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.0201 0.121 115 0.166 0.8682
##
## Results are averaged over the levels of: effort_level
## Degrees-of-freedom method: kenward-rogercat("\nDetailed Comparison of Modification Effects by Creator Type:\n")##
## Detailed Comparison of Modification Effects by Creator Type:print(pairs_type_by_mod)## Type = AI:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.128 0.1080 115 19.753
## Dramatic Modification - Slight Modification 1.486 0.0869 115 17.111
## No Modification - Slight Modification -0.642 0.0663 115 -9.678
## p.value
## <.0001
## <.0001
## <.0001
##
## Type = Human:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.101 0.1120 115 18.684
## Dramatic Modification - Slight Modification 1.342 0.0907 115 14.806
## No Modification - Slight Modification -0.759 0.0692 115 -10.961
## p.value
## <.0001
## <.0001
## <.0001
##
## Results are averaged over the levels of: effort_level
## Degrees-of-freedom method: kenward-roger
## P value adjustment: bonferroni method for 3 testscat("\nHow Modifications Affect Creativity Within Each Effort Level:\n")##
## How Modifications Affect Creativity Within Each Effort Level:print(mod_by_effort)## effort_level = 10 hours:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.054 0.0914 216 22.472
## Dramatic Modification - Slight Modification 1.380 0.0789 281 17.485
## No Modification - Slight Modification -0.674 0.0677 430 -9.947
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = 100 hours:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.133 0.0914 216 23.340
## Dramatic Modification - Slight Modification 1.451 0.0789 281 18.376
## No Modification - Slight Modification -0.683 0.0677 430 -10.079
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = less than 1 hour:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.157 0.0914 216 23.602
## Dramatic Modification - Slight Modification 1.412 0.0789 281 17.892
## No Modification - Slight Modification -0.745 0.0677 430 -10.997
## p.value
## <.0001
## <.0001
## <.0001
##
## Results are averaged over the levels of: Type
## Degrees-of-freedom method: kenward-roger
## P value adjustment: bonferroni method for 3 testscat("\nCreator Type Effects Within Each Effort Level:\n")##
## Creator Type Effects Within Each Effort Level:print(type_by_effort)## effort_level = 10 hours:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.0807 0.100 159 0.804 0.4228
##
## effort_level = 100 hours:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.0353 0.100 160 0.351 0.7258
##
## effort_level = less than 1 hour:
## contrast estimate SE df t.ratio p.value
## AI - Human 0.2052 0.101 161 2.039 0.0431
##
## Results are averaged over the levels of: modification
## Degrees-of-freedom method: kenward-rogercat("\nEffect Sizes for How Effort Levels Impact Creativity:\n")##
## Effect Sizes for How Effort Levels Impact Creativity:print(effort_effects)## contrast effect.size
## (10 hours - 100 hours) - (10 hours - less than 1 hour) 0.143
## (10 hours - 100 hours) - (100 hours - less than 1 hour) 0.323
## (10 hours - less than 1 hour) - (100 hours - less than 1 hour) 0.180
## SE df lower.CL upper.CL
## 0.0538 1741 0.0377 0.249
## 0.0934 1740 0.1402 0.507
## 0.0540 1740 0.0742 0.286
##
## Results are averaged over the levels of: Type, modification
## sigma used for effect sizes: 0.6333
## Degrees-of-freedom method: inherited from kenward-roger when re-gridding
## Confidence level used: 0.95cat("\nComplex Interaction Patterns in Creativity Ratings:\n")##
## Complex Interaction Patterns in Creativity Ratings:print(three_way_patterns)## effort_level = 10 hours, Type = AI:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 1.992 0.1260 216 15.750
## Dramatic Modification - Slight Modification 1.385 0.1090 281 12.683
## No Modification - Slight Modification -0.607 0.0937 430 -6.471
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = 100 hours, Type = AI:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.115 0.1260 216 16.722
## Dramatic Modification - Slight Modification 1.508 0.1090 281 13.809
## No Modification - Slight Modification -0.607 0.0937 430 -6.471
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = less than 1 hour, Type = AI:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.279 0.1260 216 18.018
## Dramatic Modification - Slight Modification 1.566 0.1090 281 14.334
## No Modification - Slight Modification -0.713 0.0937 430 -7.608
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = 10 hours, Type = Human:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.116 0.1320 216 16.032
## Dramatic Modification - Slight Modification 1.375 0.1140 281 12.062
## No Modification - Slight Modification -0.741 0.0978 430 -7.576
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = 100 hours, Type = Human:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.152 0.1320 216 16.302
## Dramatic Modification - Slight Modification 1.393 0.1140 281 12.219
## No Modification - Slight Modification -0.759 0.0978 430 -7.758
## p.value
## <.0001
## <.0001
## <.0001
##
## effort_level = less than 1 hour, Type = Human:
## contrast estimate SE df t.ratio
## Dramatic Modification - No Modification 2.036 0.1320 216 15.423
## Dramatic Modification - Slight Modification 1.259 0.1140 281 11.044
## No Modification - Slight Modification -0.777 0.0978 430 -7.941
## p.value
## <.0001
## <.0001
## <.0001
##
## Degrees-of-freedom method: kenward-roger
## P value adjustment: tukey method for comparing a family of 3 estimatesPART 6: DESCRIPTIVE STATISTICS FOR CONFIRMATION
# Calculate comprehensive descriptive statistics examining creativity ratings across all experimental conditions
descriptives <- data_creativity %>%
group_by(Type, modification, effort_level) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# Create focused summaries to understand specific aspects of creativity judgments
# 1. Examine how different levels of modification influence creativity ratings for AI vs human creators
mod_by_type_summary <- data_creativity %>%
group_by(Type, modification) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# 2. Analyze how different effort levels affect perceived creativity for each creator type
effort_by_type_summary <- data_creativity %>%
group_by(Type, effort_level) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# 3. Examine the complete interaction pattern between modifications, effort, and creator type
three_way_summary <- data_creativity %>%
group_by(Type, modification, effort_level) %>%
summarise(
mean = mean(Response, na.rm = TRUE),
sd = sd(Response, na.rm = TRUE),
se = sd/sqrt(n()),
n = n(),
ci_lower = mean - qt(0.975, n-1) * se,
ci_upper = mean + qt(0.975, n-1) * se,
.groups = 'drop'
)
# Present results in a clear, organized format that helps us understand creativity patterns
cat("\nOverall Descriptive Statistics for Creativity Ratings:\n")##
## Overall Descriptive Statistics for Creativity Ratings:print(descriptives)## # A tibble: 18 × 9
## Type modification effort_level mean sd se n ci_lower ci_upper
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Dramatic Modif… 10 hours 3.37 1.01 0.0911 122 3.19 3.55
## 2 AI Dramatic Modif… 100 hours 3.32 1.06 0.0962 122 3.13 3.51
## 3 AI Dramatic Modif… less than 1… 3.57 0.945 0.0855 122 3.40 3.73
## 4 AI No Modification 10 hours 1.38 0.846 0.0766 122 1.23 1.53
## 5 AI No Modification 100 hours 1.20 0.602 0.0545 122 1.10 1.31
## 6 AI No Modification less than 1… 1.29 0.755 0.0683 122 1.15 1.42
## 7 AI Slight Modific… 10 hours 1.98 0.881 0.0798 122 1.83 2.14
## 8 AI Slight Modific… 100 hours 1.81 0.836 0.0757 122 1.66 1.96
## 9 AI Slight Modific… less than 1… 2 0.900 0.0815 122 1.84 2.16
## 10 Human Dramatic Modif… 10 hours 3.33 1.01 0.0952 112 3.14 3.52
## 11 Human Dramatic Modif… 100 hours 3.26 1.13 0.107 112 3.05 3.47
## 12 Human Dramatic Modif… less than 1… 3.18 1.05 0.0992 112 2.98 3.38
## 13 Human No Modification 10 hours 1.21 0.621 0.0587 112 1.10 1.33
## 14 Human No Modification 100 hours 1.11 0.472 0.0446 112 1.02 1.20
## 15 Human No Modification less than 1… 1.14 0.598 0.0565 112 1.03 1.25
## 16 Human Slight Modific… 10 hours 1.96 0.764 0.0722 112 1.81 2.10
## 17 Human Slight Modific… 100 hours 1.87 0.854 0.0807 112 1.71 2.03
## 18 Human Slight Modific… less than 1… 1.92 0.871 0.0823 112 1.76 2.08cat("\nCreativity Ratings by Modification Level and Creator Type:\n")##
## Creativity Ratings by Modification Level and Creator Type:print(mod_by_type_summary)## # A tibble: 6 × 8
## Type modification mean sd se n ci_lower ci_upper
## <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Dramatic Modification 3.42 1.01 0.0527 366 3.31 3.52
## 2 AI No Modification 1.29 0.743 0.0388 366 1.21 1.37
## 3 AI Slight Modification 1.93 0.875 0.0457 366 1.84 2.02
## 4 Human Dramatic Modification 3.26 1.06 0.0579 336 3.14 3.37
## 5 Human No Modification 1.15 0.568 0.0310 336 1.09 1.22
## 6 Human Slight Modification 1.91 0.829 0.0453 336 1.82 2.00cat("\nCreativity Ratings by Effort Level and Creator Type:\n")##
## Creativity Ratings by Effort Level and Creator Type:print(effort_by_type_summary)## # A tibble: 6 × 8
## Type effort_level mean sd se n ci_lower ci_upper
## <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI 10 hours 2.24 1.24 0.0646 366 2.12 2.37
## 2 AI 100 hours 2.11 1.23 0.0644 366 1.99 2.24
## 3 AI less than 1 hour 2.28 1.29 0.0674 366 2.15 2.42
## 4 Human 10 hours 2.17 1.20 0.0652 336 2.04 2.29
## 5 Human 100 hours 2.08 1.24 0.0676 336 1.94 2.21
## 6 Human less than 1 hour 2.08 1.20 0.0655 336 1.95 2.21cat("\nComplete Three-Way Interaction for Creativity Ratings:\n")##
## Complete Three-Way Interaction for Creativity Ratings:print(three_way_summary)## # A tibble: 18 × 9
## Type modification effort_level mean sd se n ci_lower ci_upper
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <int> <dbl> <dbl>
## 1 AI Dramatic Modif… 10 hours 3.37 1.01 0.0911 122 3.19 3.55
## 2 AI Dramatic Modif… 100 hours 3.32 1.06 0.0962 122 3.13 3.51
## 3 AI Dramatic Modif… less than 1… 3.57 0.945 0.0855 122 3.40 3.73
## 4 AI No Modification 10 hours 1.38 0.846 0.0766 122 1.23 1.53
## 5 AI No Modification 100 hours 1.20 0.602 0.0545 122 1.10 1.31
## 6 AI No Modification less than 1… 1.29 0.755 0.0683 122 1.15 1.42
## 7 AI Slight Modific… 10 hours 1.98 0.881 0.0798 122 1.83 2.14
## 8 AI Slight Modific… 100 hours 1.81 0.836 0.0757 122 1.66 1.96
## 9 AI Slight Modific… less than 1… 2 0.900 0.0815 122 1.84 2.16
## 10 Human Dramatic Modif… 10 hours 3.33 1.01 0.0952 112 3.14 3.52
## 11 Human Dramatic Modif… 100 hours 3.26 1.13 0.107 112 3.05 3.47
## 12 Human Dramatic Modif… less than 1… 3.18 1.05 0.0992 112 2.98 3.38
## 13 Human No Modification 10 hours 1.21 0.621 0.0587 112 1.10 1.33
## 14 Human No Modification 100 hours 1.11 0.472 0.0446 112 1.02 1.20
## 15 Human No Modification less than 1… 1.14 0.598 0.0565 112 1.03 1.25
## 16 Human Slight Modific… 10 hours 1.96 0.764 0.0722 112 1.81 2.10
## 17 Human Slight Modific… 100 hours 1.87 0.854 0.0807 112 1.71 2.03
## 18 Human Slight Modific… less than 1… 1.92 0.871 0.0823 112 1.76 2.08# Calculate and examine differences in creativity ratings between AI and human creators
cat("\nMean Differences in Creativity Ratings Between Types at Each Modification Level:\n")##
## Mean Differences in Creativity Ratings Between Types at Each Modification Level:type_differences <- mod_by_type_summary %>%
group_by(modification) %>%
summarise(
type_difference = diff(mean),
pooled_se = sqrt(sum(se^2)),
t_value = type_difference/pooled_se,
df = n[1] + n[2] - 2,
p_value = 2 * pt(-abs(t_value), df),
.groups = 'drop'
)
print(type_differences)## # A tibble: 3 × 6
## modification type_difference pooled_se t_value df p_value
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Dramatic Modification -0.162 0.0783 -2.07 700 0.0389
## 2 No Modification -0.135 0.0497 -2.72 700 0.00678
## 3 Slight Modification -0.0180 0.0643 -0.280 700 0.780