#########################################################################
#
# This is the script for mds analysis
# of data from the discrimination session
# for the manuscript: Immediate and Sustained Effects
# of Verbal Labels for Newly-learned Categories, Fotiadis & Protopapas
# This analysis was done post-hoc. Also, our counterbalancing scheme
# forces us to conduct each analysis for two different sub-groups of participants
# based on counterbalancing sub-conditions
# For the aforementioned reasons, we have reservations as to the validity of these analyses
# (although the results seem to be supportive of our hypotheses)
# and we present them in Supplementary Materials.
#
#########################################################################
rm(list=ls())
# All trials in data, apart from practice trials
# Load Data Files
# Category Learning
data1<-read.table("TrialRep_StimPresentationA2_CAT.txt", header=T)
# Paired-Associate Learning
data2<-read.table("TrialRep_StimPresentationA2_PA.txt", header=T)
# Combine data files
data<-rbind(data1, data2)
# Convert all chr columns to factor:
library(dplyr)
data <- mutate_if(data, is.character, as.factor)
# Rename Group levels
levels(data$Group)<-c("CAT", "PA")
# In Experiment Builder, no response is denoted by a negative RT. Make necessary conversions
data$RT<-ifelse(data$RT>0, data$RT, NA)
# Adjust 'Response' Column
data$Response<-as.factor(ifelse(is.na(data$RT),NA,data$Response))
levels(data$Response)<-c('Correct', 'Wrong')
# Create 'acc' Variable, rename Variables
data$acc<-ifelse(is.na(data$Response), NA, ifelse(data$Response=='Correct', 1,0))
colnames(data)[1] <- "sbj"
colnames(data)[6] <- "cnd"
data$trial<-data$Trial_Number-24
data<-data[order(data$Group, data$sbj, data$trial),]
####################################################################
# Get information about specific stimuli through Fixation reports.
####################################################################
#load data from category training group
d1<-read.table("FixRep_StimPresentationB_CAT.txt", header=T)
colnames(d1)[2]<-"group"
#load data from paired-associate training group
d2<-read.table("FixRep_StimPresentationB_PA.txt", header=T)
colnames(d2)[2]<-"group"
d<-rbind(d1,d2)
d_dw<-aggregate(CURRENT_FIX_DURATION ~ sbj+trial+group+cnd+same_diff+shape_left+shape_right+Response,d,sum,na.rm=T)
d_dw<-d_dw[order(d_dw$group, d_dw$sbj, d_dw$trial),]
data$shape_left<-d_dw$shape_left
data$shape_right<-d_dw$shape_right
data <- mutate_if(data, is.character, as.factor)
############################
# Accuracy
############################
temp<-aggregate(acc~ sbj + Group, data=data, mean, na.rm=T)
# different trial only
temp2<-aggregate(acc~ sbj + Group, data=data[data$same_diff=="diff",], mean)
range(temp2$acc)
## [1] 0.8958333 1.0000000
temp2$Sbj<-temp2$sbj
levels(temp2$Sbj)<-paste("sbj", 1:48, sep="_")
plot(acc~Sbj, data=temp2, las=2)
#### Accuracy is too high to allow for an mds analysis based on errors.
#### We therefore run mds analysis based on RTs of the discrimination task
################################
# RTs
################################
#################################
# keep correct responses only #
#################################
data_cr<-droplevels(subset(data, Response == 'Correct'))
##################################
# Our counterbalancing scheme (see Readme.docx at Materials folder)
# makes it necessary to analyze data according to counterbalancing subcondition
# Seperate data according to subcondition
# s1-s4: stim1, stim2: ideo & stim3, stim4: label
# s5-s8: stim1, stim2: label & stim3, stim4: ideo
data_cr14<-droplevels(data_cr[data_cr$subcondition=="s1" | data_cr$subcondition=="s2" | data_cr$subcondition=="s3" | data_cr$subcondition=="s4",])
data_cr58<-droplevels(data_cr[data_cr$subcondition=="s5" | data_cr$subcondition=="s6" | data_cr$subcondition=="s7" | data_cr$subcondition=="s8",])
##################
##################
#s1s4
##################
##################
##################
#CAT Group
##################
# Aggregate data for distance matrix
# two label shapes and two ideo
catli<-droplevels(data_cr14[data_cr14$Group=="CAT" & data_cr14$same_diff=="diff"& data_cr14$cnd !="mixed", ])
cat_li<-aggregate(RT ~ sbj+cnd+ shape_left+shape_right, data=catli, mean)
#stim3 & stim4
stim3stim4<-aggregate(RT~cnd, data=cat_li, mean)[2,2]
#stim1 & stim2
stim1stim2<-aggregate(RT~cnd, data=cat_li, mean)[1,2]
# one label and one ideo shape
catm<-droplevels(data_cr[data_cr$Group=="CAT" & data_cr$same_diff=="diff"& data_cr$cnd=="mixed", ])
#stim1 & stim3
catm1<-aggregate(RT ~ sbj+cnd, data=catm[(catm$shape_left=="stim1.bmp" & catm$shape_right=="stim3.bmp" )| (catm$shape_left=="stim3.bmp" & catm$shape_right=="stim1.bmp"), ],mean)
stim1stim3<-aggregate (RT~cnd, data=catm1, mean)[1,2]
#stim1 & stim4
catm2<-aggregate(RT ~ sbj+cnd, data=catm[(catm$shape_left=="stim1.bmp" & catm$shape_right=="stim4.bmp" )| (catm$shape_left=="stim4.bmp" & catm$shape_right=="stim1.bmp"), ],mean)
stim1stim4<-aggregate (RT~cnd, data=catm2, mean)[1,2]
#stim2 & stim3
catm3<-aggregate(RT ~ sbj+cnd, data=catm[(catm$shape_left=="stim2.bmp" & catm$shape_right=="stim3.bmp" )| (catm$shape_left=="stim3.bmp" & catm$shape_right=="stim2.bmp"), ],mean)
stim2stim3<-aggregate (RT~cnd, data=catm3, mean)[1,2]
#stim2 & stim4
catm4<-aggregate(RT ~ sbj+cnd, data=catm[(catm$shape_left=="stim2.bmp" & catm$shape_right=="stim4.bmp" )| (catm$shape_left=="stim4.bmp" & catm$shape_right=="stim2.bmp"), ],mean)
stim2stim4<-aggregate (RT~cnd, data=catm4, mean)[1,2]
Dcat_rt14 = matrix(
c(0, stim1stim2, stim1stim3,stim1stim4,
stim1stim2,0,stim2stim3,stim2stim4,
stim1stim3,stim2stim3,0,stim3stim4,
stim1stim4,stim2stim4,stim3stim4,0),
nrow = 4, ncol = 4, byrow = TRUE)
dist.matrixcat14<-Dcat_rt14
##################
#PA Group
##################
# Aggregate data for distance matrix
# two label shapes and two ideo
pali<-droplevels(data_cr14[data_cr14$Group=="PA" & data_cr14$same_diff=="diff"& data_cr14$cnd !="mixed", ])
pa_li<-aggregate(RT ~ sbj+cnd+ shape_left+shape_right, data=pali, mean)
#stim3 & stim4
stim3stim4<-aggregate(RT~cnd, data=pa_li, mean)[2,2]
#stim1 & stim2
stim1stim2<-aggregate(RT~cnd, data=pa_li, mean)[1,2]
# one label and one ideo shape
pam<-droplevels(data_cr[data_cr$Group=="PA" & data_cr$same_diff=="diff"& data_cr$cnd=="mixed", ])
#stim1 & stim3
pam1<-aggregate(RT ~ sbj+cnd, data=pam[(pam$shape_left=="stim1.bmp" & pam$shape_right=="stim3.bmp" )| (pam$shape_left=="stim3.bmp" & pam$shape_right=="stim1.bmp"), ],mean)
stim1stim3<-aggregate (RT~cnd, data=pam1, mean)[1,2]
#stim1 & stim4
pam2<-aggregate(RT ~ sbj+cnd, data=pam[(pam$shape_left=="stim1.bmp" & pam$shape_right=="stim4.bmp" )| (pam$shape_left=="stim4.bmp" & pam$shape_right=="stim1.bmp"), ],mean)
stim1stim4<-aggregate (RT~cnd, data=pam2, mean)[1,2]
#stim2 & stim3
pam3<-aggregate(RT ~ sbj+cnd, data=pam[(pam$shape_left=="stim2.bmp" & pam$shape_right=="stim3.bmp" )| (pam$shape_left=="stim3.bmp" & pam$shape_right=="stim2.bmp"), ],mean)
stim2stim3<-aggregate (RT~cnd, data=pam3, mean)[1,2]
#stim2 & stim4
pam4<-aggregate(RT ~ sbj+cnd, data=pam[(pam$shape_left=="stim2.bmp" & pam$shape_right=="stim4.bmp" )| (pam$shape_left=="stim4.bmp" & pam$shape_right=="stim2.bmp"), ],mean)
stim2stim4<-aggregate (RT~cnd, data=pam4, mean)[1,2]
Dpa_rt14 = matrix(
c(0, stim1stim2, stim1stim3,stim1stim4,
stim1stim2,0,stim2stim3,stim2stim4,
stim1stim3,stim2stim3,0,stim3stim4,
stim1stim4,stim2stim4,stim3stim4,0),
nrow = 4, ncol = 4, byrow = TRUE)
dist.matrixpa14<-Dpa_rt14
##################
##################
#s5s8
##################
##################
##################
#CAT Group
##################
# Aggregate data for distance matrix
# two label shapes and two ideo
catli<-droplevels(data_cr58[data_cr58$Group=="CAT" & data_cr58$same_diff=="diff"& data_cr58$cnd !="mixed", ])
cat_li<-aggregate(RT ~ sbj+cnd+ shape_left+shape_right, data=catli, mean)
#stim3 & stim4
stim3stim4<-aggregate(RT~cnd, data=cat_li, mean)[2,2]
#stim1 & stim2
stim1stim2<-aggregate(RT~cnd, data=cat_li, mean)[1,2]
# one label and one ideo shape
catm<-droplevels(data_cr[data_cr$Group=="CAT" & data_cr$same_diff=="diff"& data_cr$cnd=="mixed", ])
#stim1 & stim3
catm1<-aggregate(RT ~ sbj+cnd, data=catm[(catm$shape_left=="stim1.bmp" & catm$shape_right=="stim3.bmp" )| (catm$shape_left=="stim3.bmp" & catm$shape_right=="stim1.bmp"), ],mean)
stim1stim3<-aggregate (RT~cnd, data=catm1, mean)[1,2]
#stim1 & stim4
catm2<-aggregate(RT ~ sbj+cnd, data=catm[(catm$shape_left=="stim1.bmp" & catm$shape_right=="stim4.bmp" )| (catm$shape_left=="stim4.bmp" & catm$shape_right=="stim1.bmp"), ],mean)
stim1stim4<-aggregate (RT~cnd, data=catm2, mean)[1,2]
#stim2 & stim3
catm3<-aggregate(RT ~ sbj+cnd, data=catm[(catm$shape_left=="stim2.bmp" & catm$shape_right=="stim3.bmp" )| (catm$shape_left=="stim3.bmp" & catm$shape_right=="stim2.bmp"), ],mean)
stim2stim3<-aggregate (RT~cnd, data=catm3, mean)[1,2]
#stim2 & stim4
catm4<-aggregate(RT ~ sbj+cnd, data=catm[(catm$shape_left=="stim2.bmp" & catm$shape_right=="stim4.bmp" )| (catm$shape_left=="stim4.bmp" & catm$shape_right=="stim2.bmp"), ],mean)
stim2stim4<-aggregate (RT~cnd, data=catm4, mean)[1,2]
Dcat_rt58 = matrix(
c(0, stim1stim2, stim1stim3,stim1stim4,
stim1stim2,0,stim2stim3,stim2stim4,
stim1stim3,stim2stim3,0,stim3stim4,
stim1stim4,stim2stim4,stim3stim4,0),
nrow = 4, ncol = 4, byrow = TRUE)
dist.matrixcat58<-Dcat_rt58
##################
#PA Group
##################
# Aggregate data for distance matrix
# two label shapes and two ideo
pali<-droplevels(data_cr58[data_cr58$Group=="PA" & data_cr58$same_diff=="diff"& data_cr58$cnd !="mixed", ])
pa_li<-aggregate(RT ~ sbj+cnd+ shape_left+shape_right, data=pali, mean)
#stim3 & stim4
stim3stim4<-aggregate(RT~cnd, data=pa_li, mean)[2,2]
#stim1 & stim2
stim1stim2<-aggregate(RT~cnd, data=pa_li, mean)[1,2]
# one label and one ideo shape
pam<-droplevels(data_cr[data_cr$Group=="PA" & data_cr$same_diff=="diff"& data_cr$cnd=="mixed", ])
#stim1 & stim3
pam1<-aggregate(RT ~ sbj+cnd, data=pam[(pam$shape_left=="stim1.bmp" & pam$shape_right=="stim3.bmp" )| (pam$shape_left=="stim3.bmp" & pam$shape_right=="stim1.bmp"), ],mean)
stim1stim3<-aggregate (RT~cnd, data=pam1, mean)[1,2]
#stim1 & stim4
pam2<-aggregate(RT ~ sbj+cnd, data=pam[(pam$shape_left=="stim1.bmp" & pam$shape_right=="stim4.bmp" )| (pam$shape_left=="stim4.bmp" & pam$shape_right=="stim1.bmp"), ],mean)
stim1stim4<-aggregate (RT~cnd, data=pam2, mean)[1,2]
#stim2 & stim3
pam3<-aggregate(RT ~ sbj+cnd, data=pam[(pam$shape_left=="stim2.bmp" & pam$shape_right=="stim3.bmp" )| (pam$shape_left=="stim3.bmp" & pam$shape_right=="stim2.bmp"), ],mean)
stim2stim3<-aggregate (RT~cnd, data=pam3, mean)[1,2]
#stim2 & stim4
pam4<-aggregate(RT ~ sbj+cnd, data=pam[(pam$shape_left=="stim2.bmp" & pam$shape_right=="stim4.bmp" )| (pam$shape_left=="stim4.bmp" & pam$shape_right=="stim2.bmp"), ],mean)
stim2stim4<-aggregate (RT~cnd, data=pam4, mean)[1,2]
Dpa_rt58 = matrix(
c(0, stim1stim2, stim1stim3,stim1stim4,
stim1stim2,0,stim2stim3,stim2stim4,
stim1stim3,stim2stim3,0,stim3stim4,
stim1stim4,stim2stim4,stim3stim4,0),
nrow = 4, ncol = 4, byrow = TRUE )
dist.matrixpa58 <-Dpa_rt58
########
# Based on the fact that stimuli only differed in shape, we choose an one-dimension mds solution
########
# Following precedence (Podgorny & Garner, 1979, Perception & Psychophysics)
# we use euclidean distance and non-metric (ordinal) mds
p=2 # eucliden distance
library(MASS)
########s1s4
mdscat14<-isoMDS(dist.matrixcat14, k=1, p=p)
## initial value 26.087898
## final value 26.085633
## converged
mdspa14<-isoMDS(dist.matrixpa14, k=1, p=p)
## initial value 21.926556
## final value 21.925877
## converged
#plot mds solution
y1<-rep(0,4)
x1<-as.vector(mdscat14$points)
col=c("blue", "blue", "red", "red")
pch=c(16,16,15,15)
plot(x1,y1, bty="n", ylim=c(-1, 2),yaxt="n", xaxt="n" , xlab="MDS Solution", ylab="", col=col,pch=pch, main="S1 to S4 participants", xlim=c(-750, 750))
axis(side = 1, at = x1, labels =c("stim1", "stim2", "stim3", "stim4"), cex.axis = 1.0, outer=FALSE)
axis(side = 1, at = c(-700,0,700), labels =c("-700","0", "700"), padj = 1)
abline(h=0, lty=1)
x11<-trunc(x1*10^2)/10^2
text(x=x1, y=y1+0.1, labels=x11)
text(-400, y=0-0.2, labels="Category Learning", face=2)
## Warning in text.default(-400, y = 0 - 0.2, labels = "Category Learning", :
## "face" is not a graphical parameter
#legend("")
y2<-rep(1, 4)
x2<-as.vector(mdspa14$points)
points(x2,y2, pch=pch, col=col)
abline(h=1, lty=2)
x22<-trunc(x2*10^2)/10^2
text(x=x2, y=y2+0.1, labels=x22)
text(-400, y=1-0.2, labels="Paired-Associate Learning", face=2)
## Warning in text.default(-400, y = 1 - 0.2, labels = "Paired-Associate
## Learning", : "face" is not a graphical parameter
legend(x=200, y=1.9, legend=c("Label Shapes", "Ideogram Shapes"), bty="n", pch=c(15,16), col=c("red", "blue"))
########s5s8
mdscat58<-isoMDS(dist.matrixcat58, k=1, p=p)
## initial value 22.652363
## final value 22.651443
## converged
mdspa58<-isoMDS(dist.matrixpa58, k=1, p=p)
## initial value 27.056104
## final value 27.054734
## converged
#plot mds solution
y1<-rep(0,4)
x1<-as.vector(mdscat58$points)
col=c("red", "red", "blue", "blue")
pch=c(15,15,16,16)
plot(x1,y1, bty="n", ylim=c(-1, 2),yaxt="n", xaxt="n" , xlab="MDS Solution", ylab="", col=col,pch=pch, main="S5 to S8 participants", xlim=c(-750, 750))
axis(side = 1, at = x1, labels =c("stim1", "stim2", "stim3", "stim4"), cex.axis = 1.0)
axis(side = 1, at = c(-700,0,700), labels =c("-700","0", "700"), padj = 1)
abline(h=0, lty=1)
x11<-trunc(x1*10^2)/10^2
text(x=x1, y=y1+0.1, labels=x11)
text(-400, y=0-0.2, labels="Category Learning", face=2)
## Warning in text.default(-400, y = 0 - 0.2, labels = "Category Learning", :
## "face" is not a graphical parameter
#legend("")
y2<-rep(1, 4)
x2<-as.vector(mdspa58$points)
points(x2,y2, pch=pch, col=col)
abline(h=1, lty=2)
x22<-trunc(x2*10^2)/10^2
text(x=x2, y=y2+0.1, labels=x22)
text(-400, y=1-0.2, labels="Paired-Associate Learning", face=2)
## Warning in text.default(-400, y = 1 - 0.2, labels = "Paired-Associate
## Learning", : "face" is not a graphical parameter
legend(x=200, y=1.9, legend=c("Label Shapes", "Ideogram Shapes"), bty="n", pch=c(15,16), col=c("red", "blue"))
# to facilitate comparison with s1s4 participants, we inverse (reflect) the axis.
x1<- -x1
x2<- -x2
plot(x1,y1, bty="n", ylim=c(-1, 2),yaxt="n", xaxt="n" , xlab="MDS Solution", ylab="", col=col,pch=pch, main="S5 to S8 participants", xlim=c(-750, 750))
axis(side = 1, at = x1, labels =c("stim1", "stim2", "stim3", "stim4"), cex.axis = 1.0)
axis(side = 1, at = c(-700,0,700), labels =c("-700","0", "700"), padj = 1)
abline(h=0, lty=1)
x11<-trunc(x1*10^2)/10^2
text(x=x1, y=y1+0.1, labels=x11)
text(-400, y=0-0.2, labels="Category Learning", face=2)
## Warning in text.default(-400, y = 0 - 0.2, labels = "Category Learning", :
## "face" is not a graphical parameter
points(x2,y2, pch=pch, col=col)
abline(h=1, lty=2)
x22<-trunc(x2*10^2)/10^2
text(x=x2, y=y2+0.1, labels=x22)
text(-400, y=1-0.2, labels="Paired-Associate Learning", face=2)
## Warning in text.default(-400, y = 1 - 0.2, labels = "Paired-Associate
## Learning", : "face" is not a graphical parameter
legend(x=200, y=1.9, legend=c("Label Shapes", "Ideogram Shapes"), bty="n", pch=c(15,16), col=c("red", "blue"))
# Present in one graph, along with shapes
One-Dimensional MDS Solution.
#####
# From the results of these analyses, we might deduce
# that stimuli are placed in the psychological dimension of shape
# depending on their learned pairing with labels or ideograms.
# For both s1s4 and s5s8 sub-groups, label shapes for the category learning group are further apart (less similar)
# compared to label shapes for the paired-associate group.
# For both s1s4 and s5s8 sub-groups, ideogram shapes for the category learning group are closer (more similar)
# compared to ideogram shapes for the paired-associate group.
# If we consider data from the PA group to be the reference,
# by assuming that there was no dimensional stretching in this group of participants,
# then the results might be interpreted as follows:
# According to the label-feedback hypothesis, labels are hypothesized to locally stretch the dimension of shape.
# Ideograms are also hypothesized to locally stretch the dimension of shape, but to a lesser extent compared to label shapes.
#
# Taking into account the position of ideogram shapes on the axes, and the fact that there are
# two unequal counter-forces acting on the region of ideogram shapes,
# the expansion of the region around the label shapes
# and the compression of the region around the ideogram shapes is to be expected,
# We therefore consider the results of the mds analysis to be supportive
# of the assumption of sensitization of the perceptual space depending on the nameability of category labels
# following learning to categorize, in comparison to learning to associate.
# In these analyses, we allow data to reveal the dimensionality.
# To foreshadow, an assumption of two-dimensional space is more plausible for our data (see scree plots)
# From our experience with these shapes, we might deduce that the two dimensions
# might be the features of an "edgy point" (that seems salient for stim1 and stim2)
# and the features of a "base", i.e., a "flat line" (that seems salient for stim3 and stim4).
# In what follows, we rotate and inverse axis where necessary, to allow for a direct comparison
# between sub-groups s1s4 and s5s8, and we present only those final graphs of the mds solution.
# The interested reader might run the code prefixed with #, so that all steps are visible.
# Again, following precedence (Podgorny & Garner, 1979, Perception & Psychophysics),
# we conduct non-metric (ordinal) mds, and we assume distances to be euclidean (p=2).
##################
##################
#s5s8
##################
##################
##################
#CAT Group
##################
#p=2 (Eyclidean distance)
p=2
k<-3
stress<-rep(0,k)
for (i in 1:k){
stress[i]<-isoMDS(dist.matrixcat14, k=i, p=p)$stress
}
## initial value 26.087898
## final value 26.085633
## converged
## initial value 0.000000
## final value 0.000000
## converged
## initial value 0.000000
## final value 0.000000
## converged
#stress
#Scree Plot
plot(1:k, stress/100, pch=15, cex=1.3, bty="n",main="S1 to S4, CAT, Scree Plot\nOrdinal MDS, Euclidean Distance", ylab="Stress",xlab="Number of Dimensions", las=2, xaxt="n", ylim=c(0,0.4))
lines(1:k, stress/100,lty=4)
axis(side=1, at=1:k)
#it seems that there are two dimension, k=2
mdscat14<-isoMDS(dist.matrixcat14, k=2, p=p)
## initial value 0.000000
## final value 0.000000
## converged
##################
#PA Group
##################
k<-3
stress<-rep(0,k)
for (i in 1:k){
stress[i]<-isoMDS(dist.matrixpa14, k=i, p=p)$stress
}
## initial value 21.926556
## final value 21.925877
## converged
## initial value 0.354952
## iter 5 value 0.336491
## iter 10 value 0.313414
## iter 15 value 0.290337
## iter 20 value 0.267260
## iter 25 value 0.244183
## iter 30 value 0.221106
## iter 35 value 0.198028
## iter 40 value 0.174951
## iter 45 value 0.151874
## iter 50 value 0.128796
## final value 0.128796
## stopped after 50 iterations
## initial value 0.000000
## final value 0.000000
## converged
#stress
#Scree Plot
plot(1:k, stress/100, pch=15, cex=1.3, bty="n",main="S1 to S4, PA, Scree Plot\nOrdinal MDS, Euclidean Distance", ylab="Stress",xlab="Number of Dimensions", las=2, xaxt="n", ylim=c(0,0.4))
lines(1:k, stress/100,lty=4)
axis(side=1, at=1:k)
#it seems that there are two dimensions, k=2
mdspa14<-isoMDS(dist.matrixpa14, k=2, p=p)
## initial value 0.354952
## iter 5 value 0.336491
## iter 10 value 0.313414
## iter 15 value 0.290337
## iter 20 value 0.267260
## iter 25 value 0.244183
## iter 30 value 0.221106
## iter 35 value 0.198028
## iter 40 value 0.174951
## iter 45 value 0.151874
## iter 50 value 0.128796
## final value 0.128796
## stopped after 50 iterations
#####
# plot solutions for CAT and PA
####
#plot(mdscat14$points[,1], mdscat14$points[,2], pch=c(16,16,15,15),col= c("blue", "blue", "red","red") , ylim=c(-700, 700), xlim=c(-700, 700), main="S1 to S4 Participants", bty="n", asp=1, xlab="", ylab="")
#text(mdscat14$points[,1], mdscat14$points[,2]+50, labels=c("stim1-CAT", "stim2-CAT", "stim3-CAT", "stim4-CAT"), col= c("blue", "blue", "red","red"))
#points(mdspa14$points[,1], mdspa14$points[,2], pch=c(13,13,7,7),col= c("blue", "blue", "red","red") )
#text(mdspa14$points[,1], mdspa14$points[,2]+50, labels=c("stim1-PA", "stim2-PA", "stim3-PA", "stim4-PA"), col= c("blue", "blue", "red","red"))
#abline(h=0, lty=2)
#abline(v=0, lty=2)
#legend(x=200, y=600, legend=c("CAT-Label Shapes", "CAT-Ideogram Shapes", "PA-Label Shapes", "PA-Ideogram Shapes"), bty="n", pch=c(15,16, 7, 13), col=c("red", "blue", "red", "blue"))
#rotate mdscat14 solution in relation to stim4.
theta=atan(mdscat14$points[4,2]/mdscat14$points[4,1])
rot_cat14<-matrix(c(cos(theta),sin(theta),-sin(theta),cos(theta)), nrow=2,ncol=2)
new_points_cat14<-mdscat14$points[,1:2]%*%rot_cat14
#rotate mdspa14 solution in relation to stim4
theta=atan(mdspa14$points[4,2]/mdspa14$points[4,1])
rot_pa14<-matrix(c(cos(theta),sin(theta),-sin(theta),cos(theta)), nrow=2,ncol=2)
new_points_pa14<-mdspa14$points[,1:2]%*%rot_pa14
###########
# two plots rotated
###########
plot(new_points_cat14[,1], new_points_cat14[,2], pch=c(16,16,15,15),col= c("blue", "blue", "red","red") , ylim=c(-700, 700), xlim=c(-700, 700), main="S1 to S4 Participants", bty="n", asp=1, xlab="", ylab="", xaxt="n")
text(new_points_cat14[,1], new_points_cat14[,2]+60, labels=c("stim1-CAT", "stim2-CAT", "stim3-CAT", "stim4-CAT"), col= c("blue", "blue", "red","red"))
points(new_points_pa14[,1], new_points_pa14[,2], pch=c(13,13,7,7),col= c("blue", "blue", "red","red") )
text(new_points_pa14[,1], new_points_pa14[,2]+30, labels=c("stim1-PA", "stim2-PA", "stim3-PA", "stim4-PA"), col= c("blue", "blue", "red","red"))
axis(side=1, at=c(-600, -400, -200, 0, 200, 400, 600))
abline(h=0, lty=2)
abline(v=0, lty=2)
legend(x=200, y=600, legend=c("CAT-Label Shapes", "CAT-Ideogram Shapes", "PA-Label Shapes", "PA-Ideogram Shapes"), bty="n", pch=c(15,16, 7, 13), col=c("red", "blue", "red", "blue"))
##################
##################
#s5s8
##################
##################
##################
#CAT Group
##################
k<-3
stress<-rep(0,k)
for (i in 1:k){
stress[i]<-isoMDS(dist.matrixcat58, k=i, p=p)$stress
}
## initial value 22.652363
## final value 22.651443
## converged
## initial value 0.000000
## final value 0.000000
## converged
## initial value 0.000000
## final value 0.000000
## converged
#stress
#Scree Plot
plot(1:k, stress/100, pch=15, cex=1.3, bty="n",main="S5 to S8, CAT, Scree Plot\nOrdinal MDS, Euclidean Distance", ylab="Stress",xlab="Number of Dimensions", las=2, xaxt="n", ylim=c(0,0.4))
lines(1:k, stress/100,lty=4)
axis(side=1, at=1:k)
#two dimensions
mdscat58<-isoMDS(dist.matrixcat58, k=2, p=p)
## initial value 0.000000
## final value 0.000000
## converged
##################
#PA Group
##################
k<-3
stress<-rep(0,k)
for (i in 1:k){
stress[i]<-isoMDS(dist.matrixpa58, k=i, p=p)$stress
}
## initial value 27.056104
## final value 27.054734
## converged
## initial value 0.260473
## iter 5 value 0.241222
## iter 10 value 0.217158
## iter 15 value 0.193095
## iter 20 value 0.169031
## iter 25 value 0.144967
## iter 30 value 0.120903
## iter 35 value 0.096839
## iter 40 value 0.072775
## iter 45 value 0.048711
## iter 50 value 0.024647
## final value 0.024647
## stopped after 50 iterations
## initial value 0.000000
## final value 0.000000
## converged
stress
## [1] 2.705473e+01 2.464717e-02 1.079508e-14
#Scree Plot
plot(1:k, stress/100, pch=15, cex=1.3, bty="n",main="S5 to S8, PA, Scree Plot\nOrdinal MDS, Euclidean Distance", ylab="Stress",xlab="Number of Dimensions", las=2, xaxt="n", ylim=c(0,0.4))
lines(1:k, stress/100,lty=4)
axis(side=1, at=1:k)
#it seems that there are two dimensions, k=2
mdspa58<-isoMDS(dist.matrixpa58, k=2, p=p)
## initial value 0.260473
## iter 5 value 0.241222
## iter 10 value 0.217158
## iter 15 value 0.193095
## iter 20 value 0.169031
## iter 25 value 0.144967
## iter 30 value 0.120903
## iter 35 value 0.096839
## iter 40 value 0.072775
## iter 45 value 0.048711
## iter 50 value 0.024647
## final value 0.024647
## stopped after 50 iterations
###########
# two plots
###########
# stim1 stim 2 are now label, therefore color= red red blue blue
#plot(mdscat58$points[,1], mdscat58$points[,2], pch=c(15,15,16,16),col= c("red", "red", "blue","blue") , ylim=c(-700, 700), xlim=c(-700, 700), main="S5 to S8 Participants", bty="n", asp=1, xlab="", ylab="")
#text(mdscat58$points[,1], mdscat58$points[,2]+50, labels=c("stim1-CAT", "stim2-CAT", "stim3-CAT", "stim4-CAT"), col= c("red", "red", "blue","blue"))
#points(mdspa58$points[,1], mdspa58$points[,2], pch=c(7,7,13,13),col= c("red", "red", "blue","blue") )
#text(mdspa58$points[,1], mdspa58$points[,2]+50, labels=c("stim1-PA", "stim2-PA", "stim3-PA", "stim4-PA"), col= c("red", "red", "blue","blue"))
#abline(h=0, lty=2)
#abline(v=0, lty=2)
# rotate cat in relation to stim4
theta=atan(mdscat58$points[4,2]/mdscat58$points[4,1])
rot_cat58<-matrix(c(cos(theta),sin(theta),-sin(theta),cos(theta)), nrow=2,ncol=2)
new_points_cat58<-mdscat58$points[,1:2]%*%rot_cat58
# rotate pa data in relation to stim4
theta=atan(mdspa58$points[4,2]/mdspa58$points[4,1])
rot_pa58<-matrix(c(cos(theta),sin(theta),-sin(theta),cos(theta)), nrow=2,ncol=2)
new_points_pa58<-mdspa58$points[,1:2]%*%rot_pa58
###########
# two plots rotated
###########
#plot(new_points_cat58[,1], new_points_cat58[,2], pch=c(15,15,16,16),col= c("red", "red", "blue","blue") , ylim=c(-700, 700), xlim=c(-700, 700), main="S5 to S8 Participants", bty="n", xlab="", ylab="", asp=1)
#text(new_points_cat58[,1], new_points_cat58[,2]+50, labels=c("stim1-CAT", "stim2-CAT", "stim3-CAT", "stim4-CAT"), col= c("red", "red", "blue","blue"))
#points(new_points_pa58[,1], new_points_pa58[,2], pch=c(7,7,13,13),col= c("red", "red", "blue","blue") )
#text(new_points_pa58[,1], new_points_pa58[,2]-50, labels=c("stim1-PA", "stim2-PA", "stim3-PA", "stim4-PA"), col=c("red", "red", "blue","blue"))
#abline(h=0, lty=2)
#abline(v=0, lty=2)
#legend(x=200, y=600, legend=c("CAT-Label Shapes", "CAT-Ideogram Shapes", "PA-Label Shapes", "PA-Ideogram Shapes"), bty="n", pch=c(15,16, 7, 13), col=c("red", "blue", "red", "blue"))
#####
# we need to inverse the x axis for both conditions, for comparison to the s1s4 sub-group
####
new_points_cat58[,1]<--1*new_points_cat58[,1]
new_points_pa58[,1]<--1*new_points_pa58[,1]
###########
# two plots inversed
###########
plot(new_points_cat58[,1], new_points_cat58[,2], pch=c(15,15,16,16),col= c("red", "red", "blue","blue") , ylim=c(-700, 700), xlim=c(-700, 700), main="S5 to S8 Participants", bty="n", asp=1, xlab="", ylab="", xaxt="n")
axis(side=1, at=c(-600, -400, -200, 0, 200, 400, 600))
text(new_points_cat58[,1], new_points_cat58[,2]+50, labels=c("stim1-CAT", "stim2-CAT", "stim3-CAT", "stim4-CAT"), col= c("red", "red", "blue","blue"))
points(new_points_pa58[,1], new_points_pa58[,2], pch=c(7,7,13,13),col= c("red", "red", "blue","blue") )
text(new_points_pa58[,1], new_points_pa58[,2]-50, labels=c("stim1-PA", "stim2-PA", "stim3-PA", "stim4-PA"), col=c("red", "red", "blue","blue"))
abline(h=0, lty=2)
abline(v=0, lty=2)
legend(x=300, y=600, legend=c("CAT-Label Shapes", "CAT-Ideogram Shapes", "PA-Label Shapes", "PA-Ideogram Shapes"), bty="n", pch=c(15,16, 7, 13), col=c("red", "blue", "red", "blue"))
# Present in one graph, along with shapes
Two-Dimensional MDS Solution.
#################################################################
# Quantification of expansion, based on distances between stimuli
#################################################################
# function to calculate the euclidean distance between two points
distance <- function(vect1, vect2) sqrt(sum((vect1 - vect2)^2))
#s1s4 sub-group
#ideogram shapes expansion
distance(new_points_cat14[1,], new_points_cat14[2,])-distance(new_points_pa14[1,], new_points_pa14[2,])
## [1] 223.4022
#label shapes expansion
distance(new_points_cat14[3,], new_points_cat14[4,])-distance(new_points_pa14[3,], new_points_pa14[4,])
## [1] 239.7065
#Difference in expansion between label and ideogram
(distance(new_points_cat14[3,], new_points_cat14[4,])-distance(new_points_pa14[3,], new_points_pa14[4,]))-(distance(new_points_cat14[1,], new_points_cat14[2,])-distance(new_points_pa14[1,], new_points_pa14[2,]))
## [1] 16.30438
#some indication that labels sensitized space to a greater extent compared to ideograms.
#s5s8 sub-group
#label shapes expansion
distance(new_points_cat58[1,], new_points_cat58[2,])-distance(new_points_pa58[1,], new_points_pa58[2,])
## [1] 60.80239
#ideogram shapes expansion
distance(new_points_cat58[3,], new_points_cat58[4,])-distance(new_points_pa58[3,], new_points_pa58[4,])
## [1] 48.35276
#Difference in expansion between label and ideogram
(distance(new_points_cat58[1,], new_points_cat58[2,])-distance(new_points_pa58[1,], new_points_pa58[2,]))-(distance(new_points_cat58[3,], new_points_cat58[4,])-distance(new_points_pa58[3,], new_points_pa58[4,]))
## [1] 12.44963
#some indication that labels sensitized space to a greater extend compared to ideograms.
#####
# From the results of these analyses, it seems that our stimuli, following both
# category and paired-associate learning, are placed on perpendicular axes.
# This makes it more easy (compared to one-dimensional mds solutions)
# to disentangle and visually inspect the effects of labels and ideograms on perceptual dimensions.
# The label-feedback hypothesis suggests that words might stretch perceptual space to a greater extent
# compared to ideograms, following learning to categorize.
# We take the mds solution of the paired-associate group to be reference data, under the assumption that
# no sensitization took place in this group.
# For both sub-groups of participants (s1s4 & s5s8),
# expansion on the dimension of the label shapes was
# greater compared to the expansion on the dimension of the ideogram shapes.
# We therefore consider the results of the mds analysis to be supportive
# of the assumption of sensitization of the perceptual space depending on the nameability of category labels
# following learning to categorize, in comparison to learning to associate.