Personality Predictors of Attitudes Towards and Willingness to Engage in Consensual Non-Monogamy
Packages used:
library(haven) # for read_sav()
library(psych) # for alpha()
library(QuantPsyc) # for lm.beta()
library(car) # for vif()
library(rcompanion) # for nigelkerke()
library(corrplot)Importing data
setwd("C:/Users/fsanc/OneDrive - The Colorado College/Research/Open/Sharon/Attitudes")
# Dataset to be used in the analyses
attitudes0 <- read_sav("Personality and Relationships_June 8, 2020_22.11.sav")
# Dataset to be used for relationship type, race, and sexual orientation
attitudes0_csv <- read.csv("Personality and Relationships_June 8, 2020_18.05_2.csv", na.strings = "")The dataset has 2184 cases.
Variable descriptions
f <- function(var){attr(var, 'label')}
var.labels <- lapply(attitudes0,f)
df <- as.data.frame(var.labels)
df2 <- as.data.frame(t(df[1,]))
names(df2) <- "Description"
write.csv(df2, file = "var.labels.csv")
knitr::kable(df2)| Description | |
|---|---|
| StartDate | Start Date |
| EndDate | End Date |
| Status | Response Type |
| Progress | Progress |
| Duration_in_seconds | Duration (in seconds) |
| Finished | Finished |
| RecordedDate | Recorded Date |
| ResponseId | Response ID |
| DistributionChannel | Distribution Channel |
| UserLanguage | User Language |
| Q128 | Do you consent to participate in this research study? |
| Q2 | Age |
| Q3 | Gender - Selected Choice |
| Q3_4_TEXT | Gender - Something else - Text |
| Q4 | Do you identify as transgender? |
| Q5_1 | Which best represents your racial/ ethnic heritage? Choose all that apply. - Selected Choice Asian |
| Q5_2 | Which best represents your racial/ ethnic heritage? Choose all that apply. - Selected Choice African/Black |
| Q5_3 | Which best represents your racial/ ethnic heritage? Choose all that apply. - Selected Choice Caucasian/White |
| Q5_4 | Which best represents your racial/ ethnic heritage? Choose all that apply. - Selected Choice Hispanic/Latinx |
| Q5_5 | Which best represents your racial/ ethnic heritage? Choose all that apply. - Selected Choice Native American |
| Q5_6 | Which best represents your racial/ ethnic heritage? Choose all that apply. - Selected Choice Pacific Islander |
| Q5_7 | Which best represents your racial/ ethnic heritage? Choose all that apply. - Selected Choice Something else |
| Q5_8 | Which best represents your racial/ ethnic heritage? Choose all that apply. - Selected Choice Prefer not to answer |
| Q5_7_TEXT | Which best represents your racial/ ethnic heritage? Choose all that apply. - Something else - Text |
| Q6 | Which best describes your sexual orientation? - Selected Choice |
| Q6_7_TEXT | Which best describes your sexual orientation? - Something else - Text |
| Q7 | What is the highest degree of level of school you have completed? (If you are currently enrolled in school, please indicate the highest degree you have received.) |
| Q10 | Country of residence |
| Q8 | Are you currently in a relationship? |
| Q9_1 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Monogomous |
| Q9_2 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Consensual Non-monogamous |
| Q9_3 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Polyamorous |
| Q9_4 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Polyfidelity |
| Q9_5 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Open |
| Q9_6 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Swinging |
| Q9_7 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Relationship Anarchy |
| Q9_8 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Monogamish |
| Q9_9 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Having sex or a romantic relationship outside of a relationship but partner thinks we are monogamous |
| Q9_10 | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Selected Choice Self-description |
| Q9_10_TEXT | Which best describes your current relationship status (please endorse the best response. If more than one option applies equally well, feel free to endorse more than one. - Self-description - Text |
| Q13 | If my partner ignores me for awhile, I sometimes do stupid things to try to get his/her attention back. |
| Q14 | Our friendship merged gradually into love over time. |
| Q15 | I cannot be happy unless I place my partner’s happiness before my own. |
| Q16 | I would rather suffer myself than let my partner suffer. |
| Q17 | Our love is the best kind because it grew out of a long friendship. |
| Q18 | My partner would get upset if he/she knew of some of the things I’ve done with other people. |
| Q19 | I believe that what my partner doesn’t know about me won’t hurt him/her. |
| Q20 | My partner and I really understand each other. |
| Q21 | Our love relationship is the most satisfying because it developed from a good friendship. |
| Q22 | Since I’ve been in love with my partner I’ve had trouble concentrating on anything else. |
| Q23 | I cannot relax if I suspect that my partner is with someone else. |
| Q24 | My partner and I have the right physical ‘chemistry’ between us. |
| Q25 | An important factor in choosing my partner was whether or not he/she would be a good parent. |
| Q26 | I would endure all things for the sake of my partner. |
| Q27 | My partner fits my ideal standards of physical beauty/handsomeness. |
| Q28 | When my partner doesn’t pay attention to me, I feel sick all over. |
| Q29 | Our love is really a deep friendship, not a mysterious, mystical emotion. |
| Q30 | One consideration in choosing my partner was how he/she would reflect on my career. |
| Q31 | A main consideration in choosing my partner was how he/she would reflect on my family. |
| Q32 | I enjoy playing the ‘game of love’ with my partner and a number of other partners. |
| Q33 | I feel that my partner and I were meant for each other. |
| Q34 | Before getting very involved with my partner, I tried to figure out how compatible his/her hereditary background would be with mine in case we ever had children. |
| Q35 | I am usually willing to sacrifice my own wishes to let my partner achieve his/hers. |
| Q36 | I have sometimes had to keep my partner from finding out about other lovers. |
| Q115 | Most people are basically honest. |
| Q116 | Most people are trustworthy. |
| Q117 | Most people are basically good and kind. |
| Q118 | Most people are trustful of others. |
| Q119 | I am trustful. |
| Q120 | Most people will respond in kind when they are trusted by others. |
| Q62 | I tend to give up easily when I don’t clearly |
| understand a situation. | |
| Q63 | When I go shopping, I like to have a list exactly of what I need. |
| Q64 | I feel better about myself when I know that I have done |
| all I can to accurately plan my future. | |
| Q66 | Sudden changes make me feel upset. |
| Q67 | When making a decision, I am deterred by the fear of |
| making a mistake. | |
| Q68 | When uncertain, I act very cautiously until I have more information |
| about the situation. | |
| Q69 | I like to have things under control. |
| Q70 | When the future is uncertain, I generally expect the worst to happen. |
| Q71 | Facing uncertainty is a nerve-wracking experience. |
| Q72 | I get worried when a situation is uncertain. |
| Q73 | Thinking about uncertainty makes me feel depressed. |
| Q74 | I find the prospect of change exciting and stimulating. |
| Q75 | Uncertainty frightens me. |
| Q76 | There is something exciting about being kept in suspense. |
| Q77 | The idea of taking a trip to a new country fascinates |
| me. | |
| Q78 | I like going on holidays with nothing planned in advance. |
| Q79 | I think you have to be flexible to work effectively. |
| Q80 | Taking chances is part of life. |
| Q81 | When I feel uncertain about something, I try to |
| rationally weigh up all the information I have. | |
| Q82 | Before making any changes, I need to think things over thoroughly. |
| Q83 | I prefer to stick to tried and tested ways of doing things. |
| Q84 | I like to have my weekends planned in advance. |
| Q85 | I feel curious about new experiences. |
| Q86 | I like to think of a new experience in terms of a challenge. |
| Q87 | A new experience is an occasion to learn something new. |
| Q88 | When I feel a situation is unclear, I try to do my best to resolve it. |
| Q89 | I like to know exactly what I’m going to do next. |
| Q90 | When facing an uncertain situation, I tend to prepare as much as |
| possible, and then hope for the best. | |
| Q91 | I feel relieved when an ambiguous situation suddenly becomes clear. |
| Q92 | When I feel uncertain, I try to take decisive steps to clarify the |
| situation. | |
| Q93 | When I can’t clearly discern situations, I get apprehensive. |
| Q94 | I enjoy finding new ways of working out problems. |
| Q95 | When I’m not certain about someone’s intentions towards me, I often |
| become upset or angry. | |
| Q96 | New experiences can be useful. |
| Q97 | When uncertain about what to do next, I tend to feel lost. |
| Q98 | I feel anxious when things are changing. |
| Q99 | New experiences excite me. |
| Q100 | I think variety is the spice of life. |
| Q101 | I try to have my life and career clearly mapped out. |
| Q102 | I think a mid-life career change is an exciting idea. |
| Q103 | When a situation is unclear, it makes me feel angry. |
| Q104 | I enjoy unexpected events. |
| Q105 | I like things to be ordered and in place, both at work and at home. |
| Q106 | I really get anxious if I don’t know what someone thinks about me. |
| Q107 | I easily adapt to novelty. |
| Q108 | I am hesitant when it comes to making changes. |
| Q109 | I like to plan ahead in detail rather than leaving things to chance. |
| Q110 | Before I buy something, I have to view every sample I can find. |
| Q131 | I tend to begin a new job without much advance planning on how I will do it. |
| Q132 | I usually think about what I am going to do before doing it. |
| Q134 | I often do things on impulse. |
| Q135 | I very seldom spend much time on the details of planning ahead. |
| Q136 | I like to have new and exciting experiences and sensations even if they are a little frightening. |
| Q137 | Before I begin a complicated job, I make careful plans. |
| Q138 | I would like to take off on a trip with no preplanned or defining routes or timetable. |
| Q139 | I enjoy getting into new situations where you can’t predict how things will turn out. |
| Q140 | I like doing things just for the thrill of it. |
| Q141 | I tend to change interests frequently. |
| Q142 | I sometimes like to do things that are a little frightening. |
| Q143 | I’ll try anything once. |
| Q144 | I would like the kind of life where one is on the move and traveling a lot with lots of change and excitement. |
| Q145 | I sometimes do ‘crazy’ things just for fun. |
| Q146 | I like to explore a strange city or section of town by myself, even if it means getting lost. |
| Q147 | I prefer friends who are excitingly unpredictable. |
| Q148 | I often get so carried away by new and exciting things and ideas that I never think of possible complications. |
| Q149 | I am an impulsive person. |
| Q150 | I like ‘wild’ uninhibited parties. |
| Q151 | Q151 |
| Q152 | Q152 |
| Q153 | Q153 |
| Q154 | Q154 |
| Q155 | Q155 |
| Q156 | Q156 |
| Q157 | Q157 |
| Q158 | Q158 |
| Q159 | Q159 |
| Q160 | Q160 |
| Q161 | Q161 |
| Q162 | Q162 |
| Q163 | Q163 |
| Q164 | Q164 |
| Q165 | Q165 |
| Q166 | Q166 |
| Q167 | Q167 |
| Q45 | You and your partner may have sex with whomever they want, using condoms, no strings attached, no questions asked. |
| Q46 | You and your partner go together to swinger parties where partners are exchanged for the night. |
| Q47 | You and your partner may form outside romantic relationships, but they must always be less important. |
| Q48 | You and your partner may have sex with others, but never the same person more than once. |
| Q49 | You and your partner may have sex and romantic relationships with whomever they want, but there must be no secrets between you. |
| Q50 | You and your partner take on a third partner to join you in your relationship on equal terms. |
| Q182_1 | Please rate yourself from 0 - 6 on each of the following dimensions. - I can only see myself sexually involved with one person at a specific time in my life.:I can see myself sexually involved with multiple people at a specific time in my life. |
| Q182_2 | Please rate yourself from 0 - 6 on each of the following dimensions. - I can only see myself romantically involved with one person at a specific time in my life.:I can see myself romantically involved with multiple people at a specific time in my life. |
| Q182_3 | Please rate yourself from 0 - 6 on each of the following dimensions. - I don’t like the idea of my partner being sexually involved with another person.:I love the idea of my partner being sexually involved with other people. |
| Q182_4 | Please rate yourself from 0 - 6 on each of the following dimensions. - I don’t like the idea of my partner being romantically involved with another person.:I love the idea of my partner being romantically involved with other people. |
| Q38 | Polyamory is harmful to children. |
| Q39 | Polyamorous relationships can be successful in the long term. |
| Q40 | I think that committed relationships with more than two individuals should have the same legal rights as married couples. |
| Q41 | People use polyamorous relationships as a way to cheat on their partners without consequence. |
| Q42 | I would allow my children to spend time with a peer who had polyamorous parents. |
| Q43 | Polyamorous relationships spread STIs (sexually transmitted infections). |
| Q44 | Religious forms of polyamory (such as polygamy) are acceptable. |
| recruitment | recruitment |
| id | id |
| Q10___Parent_Topics | Q10 - Parent Topics |
| Q10___Topics | Q10 - Topics |
Were there any empty rows?
f <- function(x){sum(is.na(x)==F, na.rm=T)}
a <- apply(attitudes0, 1, f)
min.fill <- min(a)All rows had at least 20 non-empty entries.
Scales
Attitudes toward polyamory (ATP)
itemsATP <- cbind((8-attitudes0$Q38), attitudes0$Q39, attitudes0$Q40, (8-attitudes0$Q41), attitudes0$Q42, (8-attitudes0$Q43)) # excluded attitudes$Q44
attitudes0$ATP <- apply(itemsATP, 1, mean)Sexual and Romantic Exclusivity (SRE):
itemsSRE <- cbind((attitudes0$Q182_1 - 1), (attitudes0$Q182_2 - 1), (attitudes0$Q182_3 - 1), (attitudes0$Q182_4 - 1))
attitudes0$SRE <- apply(itemsSRE, 1, mean)
# Dichotomize SRE
attitudes0$SRE01 <- 1*(attitudes0$SRE > 0)Willingness to Engage in CNM (WECNM):
itemsWECNM <- cbind(attitudes0$Q45, attitudes0$Q46, attitudes0$Q47, attitudes0$Q48, attitudes0$Q49, attitudes0$Q50)
attitudes0$WECNM <- apply(itemsWECNM, 1, max)
# Dichotomize WECNM
attitudes0$WECNM01 <- 1*(attitudes0$WECNM > 1)Emotional Uncertainty (EU)
itemsEU <- 5-cbind(attitudes0$Q62, attitudes0$Q66, attitudes0$Q67, attitudes0$Q70, attitudes0$Q71, attitudes0$Q72, attitudes0$Q73, attitudes0$Q75, attitudes0$Q93, attitudes0$Q95, attitudes0$Q97, attitudes0$Q98, attitudes0$Q103, attitudes0$Q106, attitudes0$Q108)
attitudes0$EU <- apply(itemsEU, 1, mean)Desire for change (DFC)
itemsDFC <- 5-cbind(attitudes0$Q74, attitudes0$Q76, attitudes0$Q77, attitudes0$Q78, attitudes0$Q79, attitudes0$Q80, attitudes0$Q85, attitudes0$Q86, attitudes0$Q87, attitudes0$Q94, attitudes0$Q96, attitudes0$Q99, attitudes0$Q100, attitudes0$Q102, attitudes0$Q104, attitudes0$Q107)
attitudes0$DFC <- apply(itemsDFC, 1, mean)Cognitive Uncertainty (CU)
itemsCU <- 5-cbind(attitudes0$Q63,attitudes0$Q64, attitudes0$Q68, attitudes0$Q69, attitudes0$Q81, attitudes0$Q82, attitudes0$Q83, attitudes0$Q84, attitudes0$Q88, attitudes0$Q89, attitudes0$Q90, attitudes0$Q91, attitudes0$Q92, attitudes0$Q101, attitudes0$Q105, attitudes0$Q109, attitudes0$Q110)
attitudes0$CU <- apply(itemsCU, 1, mean)General Trust (GT)
# These items ranged from 8 to 12. To have values from 1 to 5, subtract 7.
itemsGT <- 6-cbind((attitudes0$Q115-7),(attitudes0$Q116-7), (attitudes0$Q117-7), (attitudes0$Q118-7), (attitudes0$Q119-7), (attitudes0$Q120-7))
attitudes0$GT <- apply(itemsGT, 1, mean)Sensation Seeking (SS)
itemsSS <- cbind(1*(attitudes0$Q136==23), 1*(attitudes0$Q138==10), 1*(attitudes0$Q140==5), 1*(attitudes0$Q141==4), 1*(attitudes0$Q142==4), 1*(attitudes0$Q143==4), 1*(attitudes0$Q144==4), 1*(attitudes0$Q145==4), 1*(attitudes0$Q146==4), 1*(attitudes0$Q147==4), 1*(attitudes0$Q150==4))
attitudes0$SS <- apply(itemsSS, 1, sum)Ludus love style
itemsLUDUS <- cbind(attitudes0$Q18, attitudes0$Q19, attitudes0$Q32, attitudes0$Q36)
attitudes0$LUDUS <- apply(itemsLUDUS, 1, mean)Pragma love style
itemsPRAGMA <- cbind(attitudes0$Q25, attitudes0$Q30, attitudes0$Q31, attitudes0$Q34)
attitudes0$PRAGMA <- apply(itemsPRAGMA, 1, mean)Mania love style
itemsMANIA <- cbind(attitudes0$Q13, attitudes0$Q22, attitudes0$Q23, attitudes0$Q28)
attitudes0$MANIA <- apply(itemsMANIA, 1, mean)Eros love style
itemsEROS <- cbind(attitudes0$Q20, attitudes0$Q24, attitudes0$Q27, attitudes0$Q33)
attitudes0$EROS <- apply(itemsEROS, 1, mean)Storge love style
itemsSTORGE <- cbind(attitudes0$Q14, attitudes0$Q17, attitudes0$Q21, attitudes0$Q29)
attitudes0$STORGE <- apply(itemsSTORGE, 1, mean)Agape love style
itemsAGAPE <- cbind(attitudes0$Q15, attitudes0$Q16, attitudes0$Q26, attitudes0$Q35)
attitudes0$AGAPE <- apply(itemsAGAPE, 1, mean)Demographics
Age
attitudes0$age <- factor(attitudes0$Q2)
a <- which(attitudes0$Q2 == "19 years old")
attitudes0$age[a] <- "19"
attitudes0$age <- as.numeric(as.character(attitudes0$age))
b <- which(attitudes0$age > 98 | attitudes0$age < 12)
attitudes0$age[b] <- NAGender
#attr(attitudes0$Q3, 'labels')
attitudes0$gender <- rep(NA,length(attitudes0$Q3))
attitudes0$gender[which(attitudes0$Q3==2)] <- "Woman"
attitudes0$gender[which(attitudes0$Q3==3)] <- "Man"
attitudes0$gender[which(attitudes0$Q3==1 | attitudes0$Q3==4)] <- "Other"
attitudes0$gender <- factor(attitudes0$gender,
levels = c("Woman", "Man", "Other"))Transgender status
#attr(attitudes$Q3, 'labels')
attitudes0$transgender <- rep(NA,length(attitudes0$Q4))
attitudes0$transgender[which(attitudes0$Q4==1)] <- "Yes"
attitudes0$transgender[which(attitudes0$Q4==2)] <- "No"
attitudes0$transgender <- factor(attitudes0$transgender,
levels = c("No", "Yes"))Sexual orientation
attitudes0$orientation <- rep(NA,length(attitudes0$Q6))
attitudes0$orientation[which(attitudes0$Q6==1 | attitudes0_csv$Q6 == "Asexual")] <- "Asexual"
attitudes0$orientation[which(attitudes0$Q6==2 | attitudes0_csv$Q6 == "Bisexual")] <- "Bisexual"
attitudes0$orientation[which(attitudes0$Q6==3 | attitudes0_csv$Q6 == "Gay/Lesbian")] <- "Gay/Lesbian"
attitudes0$orientation[which(attitudes0$Q6==4 | attitudes0_csv$Q6 == "Heterosexual")] <- "Heterosexual"
attitudes0$orientation[which(attitudes0$Q6==5 | attitudes0_csv$Q6 == "Pansexual")] <- "Pansexual"
attitudes0$orientation[which(attitudes0$Q6==6 | attitudes0_csv$Q6 == "Fluid")] <- "Fluid"
attitudes0$orientation[which(attitudes0_csv$Q6=="Something else" | attitudes0_csv$Q6=="Queer" | attitudes0_csv$Q6=="Heteroflexible" | attitudes0_csv$Q6=="Graysexual" | attitudes0_csv$Q6=="Gray-Asexual/Bisexual" | attitudes0_csv$Q6=="Demisexual" | attitudes0_csv$Q6=="Bi-curious")] <- "Other"
attitudes0$orientation <- factor(attitudes0$orientation, levels=c("Heterosexual", "Bisexual", "Asexual", "Gay/Lesbian", "Pansexual", "Fluid", "Other"))
# Dicotomize sexual orientation
attitudes0$orientation2 <- rep(NA,length(attitudes0$Q6))
attitudes0$orientation2[which(attitudes0$orientation=="Heterosexual")] <- "Heterosexual"
attitudes0$orientation2[which(attitudes0$orientation!="Heterosexual" & attitudes0$Q6!=8)] <- "LGBTQIA"
attitudes0$orientation2 <- factor(attitudes0$orientation2)Relationship Status
attitudes0$relationship <- rep(NA,length(attitudes0$Q8))
attitudes0$relationship[which(attitudes0$Q8==1)] <- "Yes"
attitudes0$relationship[which(attitudes0$Q8==2)] <- "No"
attitudes0$relationship <- factor(attitudes0$relationship, levels=c("Yes", "No"))Racial / ethnic heritage
attitudes0$race <- rep(NA,length(attitudes0$Q5_1))
attitudes0$race[which(attitudes0$Q5_3==1 | attitudes0_csv$Q5=="Caucasian/White")] <- "White"
attitudes0$race[which(attitudes0$Q5_1==1 | attitudes0_csv$Q5=="Asian")] <- "Asian"
attitudes0$race[which(attitudes0$Q5_2==1 | attitudes0_csv$Q5=="African/Black")] <- "Black"
attitudes0$race[which(attitudes0$Q5_4==1 | attitudes0_csv$Q5=="Hispanic/Latinx")] <- "Latinx"
attitudes0$race[which(attitudes0$Q5_5==1 | attitudes0_csv$Q5=="Native American")] <- "Native American"
attitudes0$race[which(attitudes0$Q5_6==1 | attitudes0_csv$Q5=="Pacific Islander")] <- "Pacific Islander"
attitudes0$race[which(attitudes0_csv$Q5=="Middle Eastern")] <- "Middle Eastern"
attitudes0$race[which(attitudes0_csv$Q5=="African/Black,Something else" | attitudes0_csv$Q5=="Asian,Middle Eastern" | attitudes0_csv$Q5=="Caucasian/White,African/Black,Asian" | attitudes0_csv$Q5=="Caucasian/White,Hispanic/Latinx" | attitudes0_csv$Q5=="Caucasian/White,Hispanic/Latinx,Native American" | attitudes0_csv$Q5=="Caucasian/White,Middle Eastern" | attitudes0_csv$Q5=="Caucasian/White,Pacific Islander,Something else" | attitudes0_csv$Q5=="Caucasian/White,Something else" | attitudes0_csv$Q5=="Hispanic/Latinx,Middle Eastern" | attitudes0_csv$Q5=="Hispanic/Latinx,Native American" | attitudes0_csv$Q5=="Mixed")] <- "Mixed"
attitudes0$race[which(attitudes0_csv$Q5=="Something else" | attitudes0$race == "Mixed")] <- "Mixed/Other"
attitudes0$race <- factor(attitudes0$race, levels=c("White", "Latinx", "Asian", "Black", "Pacific Islander", "Native American", "Mixed/Other"))
# Dicotomize race
attitudes0$race2 <- rep(NA,length(attitudes0$Q5_1))
attitudes0$race2[which(as.numeric(attitudes0$race)==1)] <- "White"
attitudes0$race2[which(as.numeric(attitudes0$race)>1)] <- "POC"
attitudes0$race2 <- factor(attitudes0$race2, levels = c("White", "POC"))Education level
attitudes0$education <- rep(NA,length(attitudes0$Q7))
attitudes0$education[which(attitudes0$Q7==1)] <- "Less than HS"
attitudes0$education[which(attitudes0$Q7==2)] <- "HS"
attitudes0$education[which(attitudes0$Q7==3)] <- "Some College"
attitudes0$education[which(attitudes0$Q7==4)] <- "Associates"
attitudes0$education[which(attitudes0$Q7==5)] <- "Bachelors"
attitudes0$education[which(attitudes0$Q7==6)] <- "Masters"
attitudes0$education[which(attitudes0$Q7==7)] <- "Professional"
attitudes0$education[which(attitudes0$Q7==8)] <- "Doctorate"
attitudes0$education <- factor(attitudes0$education, levels=c("Less than HS", "HS", "Some College", "Associates", "Bachelors", "Masters", "Professional", "Doctorate"))
# Dicotomize education
attitudes0$education2 <- rep(NA,length(attitudes0$Q7))
attitudes0$education2[which(attitudes0$Q7 <= 3)] <- "Some College or less"
attitudes0$education2[which(attitudes0$Q7 >= 4 & attitudes0$Q7 <= 8)] <- "Associates or more"
attitudes0$education2 <- factor(attitudes0$education2, levels = c("Some College or less", "Associates or more"))Sub-samples
Relationship types reported:
- Monogamous.
- CNM: Consensual Non-monogamous; Polyamorous; Polyfidelity; Open; Swinging; Relationship Anarchy; Monogamish.
- Non-CNM: Having sex or a romantic relationship outside of a relationship but partner thinks we are monogamous.
t <- summary(factor(attitudes0_csv$Q9))
nt <- names(t)
# 4 = Non-CNM
# 6 = Monogamous
# CNM subsample
wCNM <- which(attitudes0_csv$Q9 == nt[1] | attitudes0_csv$Q9 == nt[2] | attitudes0_csv$Q9 == nt[3] | attitudes0_csv$Q9 == nt[5] | attitudes0_csv$Q9 == nt[7] | attitudes0_csv$Q9 == nt[8] | attitudes0_csv$Q9 == nt[9] | attitudes0_csv$Q9 == nt[10] | attitudes0_csv$Q9 == nt[11] | attitudes0_csv$Q9 == nt[12] | attitudes0_csv$Q9 == nt[13])
attitudesCNM <- data.frame(attitudes0[wCNM,])
# Non-CNM subsample
wNCNM <- which(attitudes0_csv$Q9 == nt[4])
attitudesNCNM <- data.frame(attitudes0[wNCNM,])
# Monogamous sub-sample
wM <- which(attitudes0_csv$Q9 == nt[6])
attitudesM <- data.frame(attitudes0[wM,])There were 97 participants that were currently non-monogamous.
summary(attitudesCNM[,c("age", "gender", "transgender", "orientation", "orientation2", "relationship", "race", "race2", "education", "education2")])## age gender transgender orientation orientation2
## Min. :18.00 Woman:52 No :76 Heterosexual:45 Heterosexual:45
## 1st Qu.:19.00 Man :23 Yes : 3 Bisexual :13 LGBTQIA :31
## Median :21.00 Other: 5 NA's: 1 Asexual : 9 NA's : 4
## Mean :23.13 Gay/Lesbian : 5
## 3rd Qu.:24.00 Pansexual : 4
## Max. :48.00 (Other) : 0
## NA's :1 NA's : 4
## relationship race race2 education
## Yes:80 White :35 White:35 Some College:26
## No : 0 Latinx :11 POC :45 HS :25
## Asian :16 Bachelors :13
## Black :11 Associates : 8
## Pacific Islander: 4 Less than HS: 5
## Native American : 0 Masters : 2
## Mixed/Other : 3 (Other) : 1
## education2
## Some College or less:56
## Associates or more :24
##
##
##
##
## Sub-sample to be used in the bivariate and regression analyses. Exclude those who reported non-monogamous relationships.
attitudes <- data.frame(attitudes0[-c(wCNM,wNCNM),])Keep only those who completed at least one of the questionaires for the three outcome variables
a <- is.na(attitudes$ATP)==F | is.na(attitudes$SRE)==F | is.na(attitudes$WECNM)==F
sum(a)## [1] 1831attitudes <- attitudes[a,]Completed the questionnaire for ATP
sum(is.na(attitudes$ATP)==F)## [1] 1754Completed the questionnaire for SRE
sum(is.na(attitudes$SRE)==F)## [1] 1767Completed the questionnaire for WECNM
sum(is.na(attitudes$WECNM)==F)## [1] 1765Summaries of scale variables
ATP
# Histogram
hist(attitudes$ATP, main = NA,
xlab = "Attitudes toward polyamory (1-7)")
# missing values
sum(is.na(attitudes$ATP))/length(attitudes$ATP)## [1] 0.04205352# Skewness
skew(attitudes$ATP)## [1] 0.07301452# Alphas
alpha_ATP_CNM <- psych::alpha(itemsATP[wCNM,])
alpha_ATP_CNM$total[1]## raw_alpha
## 0.8745386alpha_ATP_M <- psych::alpha(itemsATP[wM,])
alpha_ATP_M$total[1]## raw_alpha
## 0.8572588SRE
# Barplot
barplot(table(attitudes$SRE),
xlab = "Sexual and Romantic Exclusivity (0-6)")
# Summary
table(attitudes$SRE)##
## 0 0.25 0.5 0.75 1 1.25 1.5 1.75 2 2.25 2.5 2.75 3 3.25 3.5 3.75
## 857 123 126 74 79 60 69 35 44 32 23 8 62 24 22 14
## 4 4.25 4.5 4.75 5 5.25 5.5 5.75 6
## 15 8 12 5 11 5 11 6 42table(attitudes$SRE01)##
## 0 1
## 857 910table(attitudes$SRE01)/sum(table(attitudes$SRE01))##
## 0 1
## 0.4850028 0.5149972# missing values
sum(is.na(attitudes$SRE01))/length(attitudes$SRE01)## [1] 0.03495358# Skewness
skew(attitudes$SRE)## [1] 1.832785# Alphas
alpha_SRE_CNM <- psych::alpha(itemsSRE[wCNM,])
alpha_SRE_CNM$total[1]## raw_alpha
## 0.899102alpha_SRE_M <- psych::alpha(itemsSRE[wM,])
alpha_SRE_M$total[1]## raw_alpha
## 0.8934466WECNM
# Barplot
barplot(table(attitudes$WECNM),
xlab = "Willingness to Engage in CNM (1-7)")
# Summary
table(attitudes$WECNM)##
## 1 2 3 4 5 6 7
## 970 202 137 126 160 96 74table(attitudes$WECNM01)##
## 0 1
## 970 795table(attitudes$WECNM01)/sum(table(attitudes$WECNM01))##
## 0 1
## 0.5495751 0.4504249# missing values
sum(is.na(attitudes$WECNM01))/length(attitudes$WECNM01)## [1] 0.03604588# Skewness
skew(attitudes$WECNM)## [1] 1.112422# Alphas
alpha_WECNM_CNM <- psych::alpha(itemsWECNM[wCNM,])
alpha_WECNM_CNM$total[1]## raw_alpha
## 0.8875191alpha_WECNM_M <- psych::alpha(itemsWECNM[wM,])
alpha_WECNM_M$total[1]## raw_alpha
## 0.9064678EU
# Histogram
hist(attitudes$EU, main = NA,
xlab = "Emotional Uncertainty (1-4)")
# missing values
sum(is.na(attitudes$EU))/length(attitudes$EU)## [1] 0.06553796# Skewness
skew(attitudes$EU)## [1] 0.2579102# Alphas
alpha_EU_CNM <- psych::alpha(itemsEU[wCNM,])
alpha_EU_CNM$total[1]## raw_alpha
## 0.9095295alpha_EU_M <- psych::alpha(itemsEU[wM,])
alpha_EU_M$total[1]## raw_alpha
## 0.9087364DFC
# Histogram
hist(attitudes$DFC, main = NA,
xlab = "Desire for Change (1-4)")
# missing values
sum(is.na(attitudes$DFC))/length(attitudes$DFC)## [1] 0.06553796# Skewness
skew(attitudes$DFC)## [1] -0.0427191# Alphas
alpha_DFC_CNM <- psych::alpha(itemsDFC[wCNM,])
alpha_DFC_CNM$total[1]## raw_alpha
## 0.8552393alpha_DFC_M <- psych::alpha(itemsDFC[wM,])
alpha_DFC_M$total[1]## raw_alpha
## 0.8759649CU
# Histogram
hist(attitudes$CU, main = NA,
xlab = "Cognitive Uncertainty (1-4)")
# missing values
sum(is.na(attitudes$CU))/length(attitudes$CU)## [1] 0.06553796# Skewness
skew(attitudes$CU)## [1] -0.02744117# Alphas
alpha_CU_CNM <- psych::alpha(itemsCU[wCNM,])
alpha_CU_CNM$total[1]## raw_alpha
## 0.8011954alpha_CU_M <- psych::alpha(itemsCU[wM,])
alpha_CU_M$total[1]## raw_alpha
## 0.8721939GT
# Histogram
hist(attitudes$GT, main = NA,
xlab = "General Trust (1-5)")
# missing values
sum(is.na(attitudes$GT))/length(attitudes$GT)## [1] 0.04205352# Skewness
skew(attitudes$GT)## [1] -0.2915849# Alphas
alpha_GT_CNM <- psych::alpha(itemsGT[wCNM,])
alpha_GT_CNM$total[1]## raw_alpha
## 0.720787alpha_GT_M <- psych::alpha(itemsGT[wM,])
alpha_GT_M$total[1]## raw_alpha
## 0.7353693SS
# Histogram
hist(attitudes$SS, main = NA,
xlab = "Sensation Seeking (0-11)")
# missing values
sum(is.na(attitudes$SS))/length(attitudes$SS)## [1] 0.05297652# Skewness
skew(attitudes$SS)## [1] -0.1768867# Alphas
alpha_SS_CNM <- psych::alpha(itemsSS[wCNM,])
alpha_SS_CNM$total[1]## raw_alpha
## 0.700814alpha_SS_M <- psych::alpha(itemsSS[wM,])
alpha_SS_M$total[1]## raw_alpha
## 0.7442691SCA
# Histogram
hist(attitudes$SCA, main = NA,
xlab = "Social Conformity (0-17)")
# missing values
sum(is.na(attitudes$SCA))/length(attitudes$SCA)## [1] 0.05297652# Skewness
skew(attitudes$SCA)## [1] 0.4045923# Alphas
alpha_SCA_CNM <- psych::alpha(itemsSCA[wCNM,])
alpha_SCA_CNM$total[1]## raw_alpha
## 0.6749895alpha_SCA_M <- psych::alpha(itemsSCA[wM,])
alpha_SCA_M$total[1]## raw_alpha
## 0.7614263LUDUS
# Histogram
hist(attitudes$LUDUS, main = NA,
xlab = "Ludus (1-5)")
# missing values
sum(is.na(attitudes$LUDUS))/length(attitudes$LUDUS)## [1] 0.05406881# Skewness
skew(attitudes$LUDUS)## [1] -0.62891# Alphas
alpha_LUDUS_CNM <- psych::alpha(itemsLUDUS[wCNM,])
alpha_LUDUS_CNM$total[1]## raw_alpha
## 0.562623alpha_LUDUS_M <- psych::alpha(itemsLUDUS[wM,])
alpha_LUDUS_M$total[1]## raw_alpha
## 0.6198689PRAGMA
# Histogram
hist(attitudes$PRAGMA, main = NA,
xlab = "Pragma (1-5)")
# missing values
sum(is.na(attitudes$PRAGMA))/length(attitudes$PRAGMA)## [1] 0.05406881# Skewness
skew(attitudes$PRAGMA)## [1] 0.1832647# Alphas
alpha_PRAGMA_CNM <- psych::alpha(itemsPRAGMA[wCNM,])
alpha_PRAGMA_CNM$total[1]## raw_alpha
## 0.7481848alpha_PRAGMA_M <- psych::alpha(itemsPRAGMA[wM,])
alpha_PRAGMA_M$total[1]## raw_alpha
## 0.7244247MANIA
#Histogram
hist(attitudes$MANIA, main = NA,
xlab = "Mania (1-5)")
# missing values
sum(is.na(attitudes$MANIA))/length(attitudes$MANIA)## [1] 0.05406881# Skewness
skew(attitudes$MANIA)## [1] 0.02716557# Alphas
alpha_MANIA_CNM <- psych::alpha(itemsMANIA[wCNM,])
alpha_MANIA_CNM$total[1]## raw_alpha
## 0.5779784alpha_MANIA_M <- psych::alpha(itemsMANIA[wM,])
alpha_MANIA_M$total[1]## raw_alpha
## 0.6105748EROS
# Histogram
hist(attitudes$EROS, main = NA,
xlab = "Eros (1-5)")
# missing values
sum(is.na(attitudes$EROS))/length(attitudes$EROS)## [1] 0.05406881# Skewness
skew(attitudes$EROS)## [1] 0.6542395# Alphas
alpha_EROS_CNM <- psych::alpha(itemsEROS[wCNM,])
alpha_EROS_CNM$total[1]## raw_alpha
## 0.8160158alpha_EROS_M <- psych::alpha(itemsEROS[wM,])
alpha_EROS_M$total[1]## raw_alpha
## 0.7330576STORGE
# Histogram
hist(attitudes$STORGE, main = NA,
xlab = "Storge (1-5)")
# missing values
sum(is.na(attitudes$STORGE))/length(attitudes$STORGE)## [1] 0.05406881# Skewness
skew(attitudes$STORGE)## [1] 0.4779848# Alphas
alpha_STORGE_CNM <- psych::alpha(itemsSTORGE[wCNM,])
alpha_STORGE_CNM$total[1]## raw_alpha
## 0.7694423alpha_STORGE_M <- psych::alpha(itemsSTORGE[wM,])
alpha_STORGE_M$total[1]## raw_alpha
## 0.7919189AGAPE
# Histogram
hist(attitudes$AGAPE, main = NA,
xlab = "Agape (1-5)")
# missing values
sum(is.na(attitudes$AGAPE))/length(attitudes$AGAPE)## [1] 0.05406881# Skewness
skew(attitudes$AGAPE)## [1] 0.2383842# Alphas
alpha_AGAPE_CNM <- psych::alpha(itemsAGAPE[wCNM,])
alpha_AGAPE_CNM$total[1]## raw_alpha
## 0.6492778alpha_AGAPE_M <- psych::alpha(itemsAGAPE[wM,])
alpha_AGAPE_M$total[1]## raw_alpha
## 0.7695012Bivariate relationships
Spearman correlations
cors21 <- cor.test(attitudes$SRE, attitudes$ATP, method = "spearman", exact = F)
cors31 <- cor.test(attitudes$WECNM, attitudes$ATP, method = "spearman", exact = F)
cors32 <- cor.test(attitudes$WECNM, attitudes$SRE, method = "spearman", exact = F)
c21 <- cors21$estimate; p21 <- cors21$p.value
c31 <- cors31$estimate; p31 <- cors31$p.value
c32 <- cors32$estimate; p32 <- cors32$p.value
ivs <- list(attitudes$EU, attitudes$DFC, attitudes$CU, attitudes$GT, attitudes$SS, attitudes$SCA, attitudes$LUDUS, attitudes$PRAGMA, attitudes$MANIA, attitudes$EROS, attitudes$STORGE, attitudes$AGAPE)
c1 <- numeric(); p1 <- numeric()
c2 <- numeric(); p2 <- numeric()
c3 <- numeric(); p3 <- numeric()
for(i in 1:length(ivs)){
aux <- cor.test(ivs[[i]], attitudes$ATP, method = "spearman", exact = F)
c1[i] <- aux$estimate; p1[i] <- aux$p.value
aux <- cor.test(ivs[[i]], attitudes$SRE, method = "spearman", exact = F)
c2[i] <- aux$estimate; p2[i] <- aux$p.value
aux <- cor.test(ivs[[i]], attitudes$WECNM, method = "spearman", exact = F)
c3[i] <- aux$estimate; p3[i] <- aux$p.value
}Save p-values for correlation tests (to be adjusted at the end)
p.cor <- c(p21,p31,p32,p1,p2,p3)See correlations and adjusted p-values at the end.
T-tests
meanSRE <- data.frame(zero = rep(NA,length(ivs)), nonzero = rep(NA,length(ivs)))
meanWECNM <- data.frame(zero = rep(NA,length(ivs)), nonzero = rep(NA,length(ivs)))
sdSRE <- data.frame(zero = rep(NA,length(ivs)), nonzero = rep(NA,length(ivs)))
sdWECNM <- data.frame(zero = rep(NA,length(ivs)), nonzero = rep(NA,length(ivs)))
pSRE <- numeric()
pWECNM <- numeric()
for(i in 1:length(ivs)){
meanSRE[i,] <- round(tapply(ivs[[i]], attitudes$SRE01, mean, na.rm = T),2)
sdSRE[i,] <- round(tapply(ivs[[i]], attitudes$SRE01, sd, na.rm = T),2)
meanWECNM[i,] <- round(tapply(ivs[[i]], attitudes$WECNM01, mean, na.rm = T),2)
sdWECNM[i,] <- round(tapply(ivs[[i]], attitudes$WECNM01, sd, na.rm = T),2)
aux <- t.test(ivs[[i]] ~ attitudes$SRE01)
pSRE[i] <- aux$p.value
aux <- t.test(ivs[[i]] ~ attitudes$WECNM01)
pWECNM[i] <- aux$p.value
}Means and standard deviations SRE
dfSRE <- cbind(meanSRE, sdSRE)
knitr::kable(dfSRE)| zero | nonzero | zero | nonzero |
|---|---|---|---|
| 2.48 | 2.46 | 0.56 | 0.57 |
| 2.72 | 2.79 | 0.47 | 0.47 |
| 2.96 | 2.85 | 0.45 | 0.45 |
| 3.39 | 3.33 | 0.58 | 0.61 |
| 5.16 | 6.16 | 2.84 | 2.80 |
| 5.91 | 5.28 | 3.31 | 3.31 |
| 4.02 | 3.60 | 0.76 | 0.85 |
| 2.87 | 3.11 | 0.97 | 1.03 |
| 3.10 | 3.08 | 0.88 | 0.87 |
| 1.87 | 2.24 | 0.70 | 0.78 |
| 2.28 | 2.55 | 0.91 | 0.93 |
| 2.54 | 2.78 | 0.87 | 0.88 |
Means and standard deviations WECNM
dfWECNM <- cbind(meanWECNM, sdWECNM)
knitr::kable(dfWECNM)| zero | nonzero | zero | nonzero |
|---|---|---|---|
| 2.47 | 2.48 | 0.57 | 0.57 |
| 2.73 | 2.79 | 0.47 | 0.47 |
| 2.96 | 2.84 | 0.45 | 0.46 |
| 3.36 | 3.36 | 0.59 | 0.60 |
| 5.30 | 6.12 | 2.86 | 2.79 |
| 6.02 | 5.07 | 3.38 | 3.21 |
| 3.97 | 3.61 | 0.78 | 0.86 |
| 2.87 | 3.15 | 0.98 | 1.03 |
| 3.09 | 3.07 | 0.88 | 0.87 |
| 1.88 | 2.27 | 0.72 | 0.77 |
| 2.33 | 2.52 | 0.93 | 0.92 |
| 2.59 | 2.74 | 0.87 | 0.89 |
Save p-values to adjust later
p.tt <- c(pSRE, pWECNM)Summaries of Demographics
p <- NA # Initialize vector of p-values to be adjustedAge
# Non-CNM subsample
mean(attitudes$age, na.rm = T)## [1] 22.39311sd(attitudes$age, na.rm = T)## [1] 6.420118# CNM subsample
mean(attitudes0$age[wCNM], na.rm = T)## [1] 23.12658sd(attitudes0$age[wCNM], na.rm = T)## [1] 6.633959Relationship between age and ATP
aux <- cor.test(attitudes$age, attitudes$ATP, method = "spearman", exact = F)
aux$estimate ## rho
## 0.1132168p <- c(p, aux$p.value)Relationship between age and SRE
aux <- cor.test(attitudes$age, attitudes$SRE, method = "spearman", exact = F)
aux$estimate ## rho
## 0.0760952p <- c(p, aux$p.value)Relationship between age and WECNM
aux <- cor.test(attitudes$age, attitudes$WECNM, method = "spearman", exact = F)
aux$estimate ## rho
## 0.08439916p <- c(p, aux$p.value)Gender
# Non-CNM subsample
table(attitudes$gender)##
## Woman Man Other
## 1355 428 40table(attitudes$gender)/sum(table(attitudes$gender))##
## Woman Man Other
## 0.74328031 0.23477784 0.02194185# CNM subsample
table(attitudes0$gender[wCNM])##
## Woman Man Other
## 52 23 5table(attitudes0$gender[wCNM])/sum(table(attitudes0$gender[wCNM]))##
## Woman Man Other
## 0.6500 0.2875 0.0625Relationship between gender and ATP
boxplot(ATP ~ gender, data=attitudes)
# Means
tapply(attitudes$ATP, attitudes$gender, mean, na.rm=T)## Woman Man Other
## 3.875064 3.904586 5.421053# SDs
tapply(attitudes$ATP, attitudes$gender, sd, na.rm=T)## Woman Man Other
## 1.383013 1.265777 1.094442# Pairwise t-tests
pairwise.t.test(attitudes$ATP, attitudes$gender, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$ATP and attitudes$gender
##
## Woman Man
## Man 0.7 -
## Other 1.5e-11 7.3e-11
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$ATP, attitudes$gender, p.adjust.method = "none")
p <- c(p, aux$p.value)Relationship between gender and SRE
boxplot(SRE ~ gender, data=attitudes)
# Means
tapply(attitudes$SRE, attitudes$gender, mean, na.rm=T)## Woman Man Other
## 0.8493516 1.1913203 2.2115385# SDs
tapply(attitudes$SRE, attitudes$gender, sd, na.rm=T)## Woman Man Other
## 1.434012 1.515315 1.860725# Pairwise t-tests
pairwise.t.test(attitudes$SRE, attitudes$gender, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$SRE and attitudes$gender
##
## Woman Man
## Man 3.9e-05 -
## Other 3.6e-08 3.9e-05
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$SRE, attitudes$gender, p.adjust.method = "none")
p <- c(p, aux$p.value)Relationship between gender and WECNM
boxplot(WECNM ~ gender, data=attitudes)
# Means
tapply(attitudes$WECNM, attitudes$gender, mean, na.rm=T)## Woman Man Other
## 2.129008 2.951100 4.282051# SDs
tapply(attitudes$WECNM, attitudes$gender, sd, na.rm=T)## Woman Man Other
## 1.738698 2.014057 2.327736# Pairwise t-tests
pairwise.t.test(attitudes$WECNM, attitudes$gender, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$WECNM and attitudes$gender
##
## Woman Man
## Man 8.4e-15 -
## Other 7.7e-13 1.4e-05
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$WECNM, attitudes$gender, p.adjust.method = "none")
p <- c(p, aux$p.value)Transgender status
Summaries for transgender status
#attr(attitudes$Q3, 'labels')
attitudes$transgender <- rep(NA,length(attitudes$Q4))
attitudes$transgender[which(attitudes$Q4==1)] <- "Yes"
attitudes$transgender[which(attitudes$Q4==2)] <- "No"
#attitudes$transgender[which(attitudes$Q4==3)] <- NA
attitudes$transgender <- factor(attitudes$transgender,
levels = c("No", "Yes"))
# Non-CNM subsample
table(attitudes$transgender)##
## No Yes
## 1779 36table(attitudes$transgender)/sum(table(attitudes$transgender))##
## No Yes
## 0.98016529 0.01983471sum(table(attitudes$transgender))## [1] 1815# CNM subsample
table(attitudes0$transgender[wCNM])##
## No Yes
## 76 3table(attitudes0$transgender[wCNM])/sum(table(attitudes0$transgender[wCNM]))##
## No Yes
## 0.96202532 0.03797468sum(table(attitudes0$transgender[wCNM]))## [1] 79Relationship between transgender status and ATP
boxplot(ATP ~ transgender, data=attitudes)
# Means
tapply(attitudes$ATP, attitudes$transgender, mean, na.rm=T)## No Yes
## 3.874976 5.514286# SDs
tapply(attitudes$ATP, attitudes$transgender, sd, na.rm=T)## No Yes
## 1.347378 1.257898# t-test
t.test(ATP ~ transgender, data=attitudes)##
## Welch Two Sample t-test
##
## data: ATP by transgender
## t = -7.6207, df = 35.62, p-value = 5.489e-09
## alternative hypothesis: true difference in means between group No and group Yes is not equal to 0
## 95 percent confidence interval:
## -2.075741 -1.202880
## sample estimates:
## mean in group No mean in group Yes
## 3.874976 5.514286aux <- pairwise.t.test(attitudes$ATP, attitudes$transgender, p.adjust.method = "none")
p <- c(p, aux$p.value)Relationship between transgender status and SRE
boxplot(SRE ~ transgender, data=attitudes)
# Means
tapply(attitudes$SRE, attitudes$transgender, mean, na.rm=T)## No Yes
## 0.9223485 2.2214286# SDs
tapply(attitudes$SRE, attitudes$transgender, sd, na.rm=T)## No Yes
## 1.451643 2.006214# t-test
t.test(SRE ~ transgender, data=attitudes)##
## Welch Two Sample t-test
##
## data: SRE by transgender
## t = -3.8105, df = 34.73, p-value = 0.0005426
## alternative hypothesis: true difference in means between group No and group Yes is not equal to 0
## 95 percent confidence interval:
## -1.9913726 -0.6067875
## sample estimates:
## mean in group No mean in group Yes
## 0.9223485 2.2214286aux <- pairwise.t.test(attitudes$SRE, attitudes$transgender, p.adjust.method = "none")
p <- c(p, aux$p.value)Relationship between transgender status and WECNM
boxplot(WECNM ~ transgender, data=attitudes)
# Means
tapply(attitudes$WECNM, attitudes$transgender, mean, na.rm=T)## No Yes
## 2.311370 4.416667# SDs
tapply(attitudes$WECNM, attitudes$transgender, sd, na.rm=T)## No Yes
## 1.826763 2.488545# t-test
t.test(WECNM ~ transgender, data=attitudes) ##
## Welch Two Sample t-test
##
## data: WECNM by transgender
## t = -5.0475, df = 35.796, p-value = 1.317e-05
## alternative hypothesis: true difference in means between group No and group Yes is not equal to 0
## 95 percent confidence interval:
## -2.951375 -1.259218
## sample estimates:
## mean in group No mean in group Yes
## 2.311370 4.416667aux <- pairwise.t.test(attitudes$WECNM, attitudes$transgender, p.adjust.method = "none")
p <- c(p, aux$p.value)Sexual orientation
Summaries of sexual orientation
attitudes$orientation <- rep(NA,length(attitudes$Q6))
attitudes$orientation[which(attitudes$Q6==1)] <- "Asexual"
attitudes$orientation[which(attitudes$Q6==2)] <- "Bisexual"
attitudes$orientation[which(attitudes$Q6==3)] <- "Gay/Lesbian"
attitudes$orientation[which(attitudes$Q6==4)] <- "Heterosexual"
attitudes$orientation[which(attitudes$Q6==5)] <- "Pansexual"
attitudes$orientation[which(attitudes$Q6==6)] <- "Fluid"
attitudes$orientation[which(attitudes$Q6==7)] <- "Other"
attitudes$orientation <- factor(attitudes$orientation, levels=c("Heterosexual", "Bisexual", "Asexual", "Gay/Lesbian", "Pansexual", "Fluid", "Other"))
attitudes$orientation2 <- rep(NA,length(attitudes$Q6))
attitudes$orientation2[which(attitudes$Q6==4)] <- "Heterosexual"
attitudes$orientation2[which(attitudes$Q6!=4 & attitudes$Q6!=8)] <- "LGBTQIA"
attitudes$orientation2 <- factor(attitudes$orientation2)
# Non-CNM subsample
table(attitudes$orientation)##
## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 1250 224 129 76 32 20
## Other
## 47table(attitudes$orientation)/sum(table(attitudes$orientation))##
## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 0.70303712 0.12598425 0.07255343 0.04274466 0.01799775 0.01124859
## Other
## 0.02643420table(attitudes$orientation2)##
## Heterosexual LGBTQIA
## 1250 528table(attitudes$orientation2)/sum(table(attitudes$orientation2))##
## Heterosexual LGBTQIA
## 0.7030371 0.2969629# CNM subsample
table(attitudes0$orientation[wCNM])##
## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 45 13 9 5 4 0
## Other
## 0table(attitudes0$orientation[wCNM])/sum(table(attitudes0$orientation[wCNM]))##
## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 0.59210526 0.17105263 0.11842105 0.06578947 0.05263158 0.00000000
## Other
## 0.00000000barplot(table(attitudes$orientation), las=2, cex.names=0.7)
Relationship between sexual orientation and ATP
All levels
boxplot(ATP ~ orientation, data=attitudes, las=2, xlab=NA, par(cex.axis=0.7))
# Means
tapply(attitudes$ATP, attitudes$orientation, mean, na.rm=T)## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 3.656067 4.943411 3.834688 4.444444 5.739583 4.283333
## Other
## 4.163043# SDs
tapply(attitudes$ATP, attitudes$orientation, sd, na.rm=T)## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 1.2518660 1.3107617 1.2616481 1.3842960 0.9818583 1.2797341
## Other
## 1.5680015# Pairwise t-tests
pairwise.t.test(attitudes$ATP, attitudes$orientation, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$ATP and attitudes$orientation
##
## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## Bisexual < 2e-16 - - - - -
## Asexual 0.16734 1.4e-13 - - - -
## Gay/Lesbian 1.3e-06 0.00699 0.00239 - - -
## Pansexual < 2e-16 0.00203 3.7e-13 5.3e-06 - -
## Fluid 0.04028 0.03971 0.16734 0.64696 0.00016 -
## Other 0.01296 0.00038 0.16734 0.26643 3.4e-07 0.72392
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$ATP, attitudes$orientation, p.adjust.method = "none")
p <- c(p, aux$p.value)2 levels (Heterosexual and LGBTQIA)
boxplot(ATP ~ orientation2, data=attitudes, las=1, xlab=NA)
# Means
tapply(attitudes$ATP, attitudes$orientation2, mean, na.rm=T)## Heterosexual LGBTQIA
## 3.656067 4.557743# SDs
tapply(attitudes$ATP, attitudes$orientation2, sd, na.rm=T)## Heterosexual LGBTQIA
## 1.251866 1.418488# t-test
t.test(ATP ~ orientation2, data=attitudes)##
## Welch Two Sample t-test
##
## data: ATP by orientation2
## t = -12.418, df = 858.36, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Heterosexual and group LGBTQIA is not equal to 0
## 95 percent confidence interval:
## -1.0441907 -0.7591609
## sample estimates:
## mean in group Heterosexual mean in group LGBTQIA
## 3.656067 4.557743Relationship between sexual orientation and SRE
All levels
boxplot(SRE ~ orientation, data=attitudes, las=2, xlab=NA)
#Means
tapply(attitudes$SRE, attitudes$orientation, mean, na.rm=T)## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 0.7716227 1.1619718 1.2943548 1.3659420 2.1406250 1.5500000
## Other
## 1.5388889# SDs
tapply(attitudes$SRE, attitudes$orientation, sd, na.rm=T)## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 1.364555 1.423211 1.628334 1.656970 1.745891 1.812965
## Other
## 1.740196# Pairwise t-tests
pairwise.t.test(attitudes$SRE, attitudes$orientation, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$SRE and attitudes$orientation
##
## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## Bisexual 0.0016 - - - - -
## Asexual 0.0011 0.5410 - - - -
## Gay/Lesbian 0.0028 0.4543 0.7757 - - -
## Pansexual 2.1e-06 0.0016 0.0086 0.0297 - -
## Fluid 0.0368 0.3969 0.5656 0.6765 0.2576 -
## Other 0.0017 0.2063 0.4558 0.6156 0.1444 0.9769
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$SRE, attitudes$orientation, p.adjust.method = "none")
p <- c(p, aux$p.value)2 levels (Heterosexual and LGBTQIA)
boxplot(SRE ~ orientation2, data=attitudes, las=1, xlab=NA)
#Means
tapply(attitudes$SRE, attitudes$orientation2, mean, na.rm=T)## Heterosexual LGBTQIA
## 0.7716227 1.3339960# SDs
tapply(attitudes$SRE, attitudes$orientation2, sd, na.rm=T)## Heterosexual LGBTQIA
## 1.364555 1.585943# t-test
t.test(SRE ~ orientation2, data=attitudes)##
## Welch Two Sample t-test
##
## data: SRE by orientation2
## t = -6.9571, df = 825.06, p-value = 7.076e-12
## alternative hypothesis: true difference in means between group Heterosexual and group LGBTQIA is not equal to 0
## 95 percent confidence interval:
## -0.7210387 -0.4037079
## sample estimates:
## mean in group Heterosexual mean in group LGBTQIA
## 0.7716227 1.3339960Relationship between sexual orientation and WECNM
All levels
boxplot(WECNM ~ orientation, data=attitudes, las=2, xlab=NA, par(cex.axis=0.7))
#Means
tapply(attitudes$WECNM, attitudes$orientation, mean, na.rm=T)## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 2.060331 3.183962 2.480000 3.219178 4.562500 3.750000
## Other
## 2.755556# SDs
tapply(attitudes$WECNM, attitudes$orientation, sd, na.rm=T)## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## 1.670697 2.161518 1.812145 2.174643 2.213412 1.681947
## Other
## 2.122986# Pairwise t-tests
pairwise.t.test(attitudes$WECNM, attitudes$orientation, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$WECNM and attitudes$orientation
##
## Heterosexual Bisexual Asexual Gay/Lesbian Pansexual Fluid
## Bisexual 1.9e-15 - - - - -
## Asexual 0.02090 0.00121 - - - -
## Gay/Lesbian 5.1e-07 0.88509 0.01002 - - -
## Pansexual 1.3e-13 0.00016 4.0e-08 0.00112 - -
## Fluid 0.00011 0.20755 0.00705 0.26701 0.15757 -
## Other 0.01897 0.19187 0.39631 0.20755 6.0e-05 0.05918
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$WECNM, attitudes$orientation, p.adjust.method = "none")
p <- c(p, aux$p.value)2 levels (Heterosexual and LGBTQIA)
boxplot(WECNM ~ orientation2, data=attitudes, las=1, xlab=NA)
#Means
tapply(attitudes$WECNM, attitudes$orientation2, mean, na.rm=T)## Heterosexual LGBTQIA
## 2.060331 3.086785# SDs
tapply(attitudes$WECNM, attitudes$orientation2, sd, na.rm=T)## Heterosexual LGBTQIA
## 1.670697 2.118142# t-test
t.test(WECNM ~ orientation2, data=attitudes)##
## Welch Two Sample t-test
##
## data: WECNM by orientation2
## t = -9.7182, df = 781.95, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group Heterosexual and group LGBTQIA is not equal to 0
## 95 percent confidence interval:
## -1.2337903 -0.8191186
## sample estimates:
## mean in group Heterosexual mean in group LGBTQIA
## 2.060331 3.086785Relationship Status
Summaries of relationship status
attitudes$relationship <- rep(NA,length(attitudes$Q8))
attitudes$relationship[which(attitudes$Q8==1)] <- "Yes"
attitudes$relationship[which(attitudes$Q8==2)] <- "No"
attitudes$relationship <- factor(attitudes$relationship, levels=c("Yes", "No"))
# Non-CNM subsample
table(attitudes$relationship)##
## Yes No
## 889 942table(attitudes$relationship)/sum(table(attitudes$relationship))##
## Yes No
## 0.485527 0.514473# CNM subsample
table(attitudes0$relationship[wCNM])##
## Yes No
## 80 0table(attitudes0$relationship[wCNM])/sum(table(attitudes0$relationship[wCNM]))##
## Yes No
## 1 0Relationship between relationship status and ATP
boxplot(ATP ~ relationship, data=attitudes, las=1, xlab=NA)
#Means
tapply(attitudes$ATP, attitudes$relationship, mean, na.rm=T)## Yes No
## 3.930653 3.899740# SDs
tapply(attitudes$ATP, attitudes$relationship, sd, na.rm=T)## Yes No
## 1.407050 1.327206# t-test
t.test(ATP ~ relationship, data=attitudes)##
## Welch Two Sample t-test
##
## data: ATP by relationship
## t = 0.47289, df = 1734.1, p-value = 0.6364
## alternative hypothesis: true difference in means between group Yes and group No is not equal to 0
## 95 percent confidence interval:
## -0.09730138 0.15912758
## sample estimates:
## mean in group Yes mean in group No
## 3.930653 3.899740aux <- pairwise.t.test(attitudes$ATP, attitudes$relationship, p.adjust.method = "none")
p <- c(p, aux$p.value)Relationship between relationship status and SRE
boxplot(SRE ~ relationship, data=attitudes, las=1, xlab=NA)
#Means
tapply(attitudes$SRE, attitudes$relationship, mean, na.rm=T)## Yes No
## 0.7936183 1.1207558# SDs
tapply(attitudes$SRE, attitudes$relationship, sd, na.rm=T)## Yes No
## 1.410920 1.535267# t-test
t.test(SRE ~ relationship, data=attitudes)##
## Welch Two Sample t-test
##
## data: SRE by relationship
## t = -4.6674, df = 1764.5, p-value = 3.281e-06
## alternative hypothesis: true difference in means between group Yes and group No is not equal to 0
## 95 percent confidence interval:
## -0.4646065 -0.1896684
## sample estimates:
## mean in group Yes mean in group No
## 0.7936183 1.1207558aux <- pairwise.t.test(attitudes$SRE, attitudes$relationship, p.adjust.method = "none")
p <- c(p, aux$p.value)Relationship between relationship status and WECNM
boxplot(WECNM ~ relationship, data=attitudes, las=1, xlab=NA)
#Means
tapply(attitudes$WECNM, attitudes$relationship, mean, na.rm=T)## Yes No
## 2.121387 2.608889# SDs
tapply(attitudes$WECNM, attitudes$relationship, sd, na.rm=T)## Yes No
## 1.795137 1.917755# t-test
t.test(WECNM ~ relationship, data=attitudes)##
## Welch Two Sample t-test
##
## data: WECNM by relationship
## t = -5.5157, df = 1761.8, p-value = 3.99e-08
## alternative hypothesis: true difference in means between group Yes and group No is not equal to 0
## 95 percent confidence interval:
## -0.6608518 -0.3141514
## sample estimates:
## mean in group Yes mean in group No
## 2.121387 2.608889aux <- pairwise.t.test(attitudes$WECNM, attitudes$relationship, p.adjust.method = "none")
p <- c(p, aux$p.value)Racial / ethnic heritage
Summaries for race/ethnicity
attitudes$race <- rep(NA,length(attitudes$Q5_1))
attitudes$race[which(attitudes$Q5_1==1)] <- "Asian"
attitudes$race[which(attitudes$Q5_2==1)] <- "Black"
attitudes$race[which(attitudes$Q5_3==1)] <- "White"
attitudes$race[which(attitudes$Q5_4==1)] <- "Latinx"
attitudes$race[which(attitudes$Q5_5==1)] <- "Native American"
attitudes$race[which(attitudes$Q5_6==1)] <- "Pacific Islander"
attitudes$race[which(attitudes$Q5_7==1)] <- "Other"
attitudes$race <- factor(attitudes$race, levels=c("White", "Latinx", "Asian", "Black", "Pacific Islander", "Native American", "Other"))
attitudes$race2 <- rep(NA,length(attitudes$Q5_1))
attitudes$race2[which(as.numeric(attitudes$race)==1)] <- "White"
attitudes$race2[which(as.numeric(attitudes$race)>1)] <- "POC"
attitudes$race2 <- factor(attitudes$race2, levels = c("White", "POC"))
# Non-CNM subsample
table(attitudes$race)##
## White Latinx Asian Black
## 825 430 290 128
## Pacific Islander Native American Other
## 46 24 68table(attitudes$race)/sum(table(attitudes$race))##
## White Latinx Asian Black
## 0.45554942 0.23743788 0.16013252 0.07067918
## Pacific Islander Native American Other
## 0.02540033 0.01325235 0.03754832table(attitudes$race2)##
## White POC
## 825 986table(attitudes$race2)/sum(table(attitudes$race2))##
## White POC
## 0.4555494 0.5444506# CNM subsample
table(attitudes0$race[wCNM])##
## White Latinx Asian Black
## 35 11 16 11
## Pacific Islander Native American Mixed/Other
## 4 0 3table(attitudes0$race[wCNM])/sum(table(attitudes0$race[wCNM]))##
## White Latinx Asian Black
## 0.4375 0.1375 0.2000 0.1375
## Pacific Islander Native American Mixed/Other
## 0.0500 0.0000 0.0375Relationship between race/ethnicity and ATP
All levels
boxplot(ATP ~ race, data=attitudes, las=2, xlab=NA, par(cex.axis=0.7))
# Means
tapply(attitudes$ATP, attitudes$race, mean, na.rm=T)## White Latinx Asian Black
## 4.197531 3.676935 3.721027 3.599727
## Pacific Islander Native American Other
## 3.666667 3.643939 3.930108# SDs
tapply(attitudes$ATP, attitudes$race, sd, na.rm=T)## White Latinx Asian Black
## 1.456021 1.262635 1.093789 1.490660
## Pacific Islander Native American Other
## 1.146115 1.129564 1.378520# Pairwise t-tests
pairwise.t.test(attitudes$ATP, attitudes$race, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$ATP and attitudes$race
##
## White Latinx Asian Black Pacific Islander Native American
## Latinx 4.1e-09 - - - - -
## Asian 4.4e-06 0.961 - - - -
## Black 3.8e-05 0.932 0.711 - - -
## Pacific Islander 0.049 0.961 0.961 0.961 - -
## Native American 0.240 0.961 0.961 0.961 0.961 -
## Other 0.397 0.438 0.627 0.397 0.661 0.711
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$ATP, attitudes$race, p.adjust.method = "none")
p <- c(p, aux$p.value)2 levels (White and BIPOC)
boxplot(ATP ~ race2, data=attitudes, las=1, xlab=NA)
# Means
tapply(attitudes$ATP, attitudes$race2, mean, na.rm=T)## White POC
## 4.197531 3.695173# SDs
tapply(attitudes$ATP, attitudes$race2, sd, na.rm=T)## White POC
## 1.456021 1.246600# t-test
t.test(ATP ~ race2, data = attitudes)##
## Welch Two Sample t-test
##
## data: ATP by race2
## t = 7.6271, df = 1546.7, p-value = 4.17e-14
## alternative hypothesis: true difference in means between group White and group POC is not equal to 0
## 95 percent confidence interval:
## 0.3731638 0.6315516
## sample estimates:
## mean in group White mean in group POC
## 4.197531 3.695173Relationship between race/ethnicity and SRE
All levels
boxplot(SRE ~ race, data=attitudes, las=2, xlab=NA, par(cex.axis=0.7))
# Means
tapply(attitudes$SRE, attitudes$race, mean, na.rm=T)## White Latinx Asian Black
## 0.8624524 0.8611765 1.1666667 1.3467742
## Pacific Islander Native American Other
## 0.6833333 0.8750000 1.1287879# SDs
tapply(attitudes$SRE, attitudes$race, sd, na.rm=T)## White Latinx Asian Black
## 1.332780 1.471874 1.672779 1.759905
## Pacific Islander Native American Other
## 1.149852 1.076674 1.690040# Pairwise t-tests
pairwise.t.test(attitudes$SRE, attitudes$race, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$SRE and attitudes$race
##
## White Latinx Asian Black Pacific Islander Native American
## Latinx 0.988 - - - - -
## Asian 0.020 0.035 - - - -
## Black 0.013 0.013 0.486 - - -
## Pacific Islander 0.615 0.615 0.141 0.040 - -
## Native American 0.988 0.988 0.596 0.353 0.760 -
## Other 0.353 0.353 0.988 0.576 0.349 0.633
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$SRE, attitudes$race, p.adjust.method = "none")
p <- c(p, aux$p.value)2 levels (White and BIPOC)
boxplot(SRE ~ race2, data=attitudes, las=1, xlab=NA)
# Means
tapply(attitudes$SRE, attitudes$race2, mean, na.rm=T)## White POC
## 0.8624524 1.0233402# SDs
tapply(attitudes$SRE, attitudes$race2, sd, na.rm=T)## White POC
## 1.332780 1.575497# t-test
t.test(SRE ~ race2, data = attitudes)##
## Welch Two Sample t-test
##
## data: SRE by race2
## t = -2.3145, df = 1746.8, p-value = 0.02075
## alternative hypothesis: true difference in means between group White and group POC is not equal to 0
## 95 percent confidence interval:
## -0.29722370 -0.02455209
## sample estimates:
## mean in group White mean in group POC
## 0.8624524 1.0233402Relationship between race/ethnicity and WECNM
All levels
boxplot(WECNM ~ race, data=attitudes, las=2, xlab=NA, par(cex.axis=0.7))
# Means
tapply(attitudes$WECNM, attitudes$race, mean, na.rm=T)## White Latinx Asian Black
## 2.489281 2.118203 2.505376 2.333333
## Pacific Islander Native American Other
## 1.804348 2.318182 2.375000# SDs
tapply(attitudes$WECNM, attitudes$race, sd, na.rm=T)## White Latinx Asian Black
## 1.941752 1.730744 1.850279 1.927653
## Pacific Islander Native American Other
## 1.543727 1.985336 1.939563# Pairwise t-tests
pairwise.t.test(attitudes$WECNM, attitudes$race, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$WECNM and attitudes$race
##
## White Latinx Asian Black Pacific Islander Native American
## Latinx 0.021 - - - - -
## Asian 0.947 0.076 - - - -
## Black 0.691 0.642 0.691 - - -
## Pacific Islander 0.097 0.642 0.097 0.400 - -
## Native American 0.830 0.830 0.830 0.972 0.642 -
## Other 0.830 0.642 0.830 0.947 0.400 0.947
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$WECNM, attitudes$race, p.adjust.method = "none")
p <- c(p, aux$p.value)2 levels (White and BIPOC)
boxplot(WECNM ~ race2, data=attitudes, las=1, xlab=NA)
# Means
tapply(attitudes$WECNM, attitudes$race2, mean, na.rm=T)## White POC
## 2.489281 2.265413# SDs
tapply(attitudes$WECNM, attitudes$race2, sd, na.rm=T)## White POC
## 1.941752 1.810183# t-test
t.test(WECNM ~ race2, data = attitudes)##
## Welch Two Sample t-test
##
## data: WECNM by race2
## t = 2.4754, df = 1639.2, p-value = 0.01341
## alternative hypothesis: true difference in means between group White and group POC is not equal to 0
## 95 percent confidence interval:
## 0.04648694 0.40124999
## sample estimates:
## mean in group White mean in group POC
## 2.489281 2.265413Education level
Summaries of education level
attitudes$education <- rep(NA,length(attitudes$Q7))
attitudes$education[which(attitudes$Q7==1)] <- "Less than HS"
attitudes$education[which(attitudes$Q7==2)] <- "HS"
attitudes$education[which(attitudes$Q7==3)] <- "Some College"
attitudes$education[which(attitudes$Q7==4)] <- "Associates"
attitudes$education[which(attitudes$Q7==5)] <- "Bachelors"
attitudes$education[which(attitudes$Q7==6)] <- "Masters"
attitudes$education[which(attitudes$Q7==7)] <- "Professional"
attitudes$education[which(attitudes$Q7==8)] <- "Doctorate"
attitudes$education <- factor(attitudes$education, levels=c("Less than HS", "HS", "Some College", "Associates", "Bachelors", "Masters", "Professional", "Doctorate"))
attitudes$education2 <- rep(NA,length(attitudes$Q7))
attitudes$education2[which(attitudes$Q7 <= 3)] <- "Some College or less"
attitudes$education2[which(attitudes$Q7 >= 4 & attitudes$Q7 <= 7)] <- "Associates or more"
attitudes$education2 <- factor(attitudes$education2, levels = c("Some College or less", "Associates or more"))
# Non-CNM subsample
table(attitudes$education)##
## Less than HS HS Some College Associates Bachelors Masters
## 40 571 635 296 170 78
## Professional Doctorate
## 11 11table(attitudes$education)/sum(table(attitudes$education))##
## Less than HS HS Some College Associates Bachelors Masters
## 0.02207506 0.31512141 0.35044150 0.16335541 0.09381898 0.04304636
## Professional Doctorate
## 0.00607064 0.00607064table(attitudes$education2)##
## Some College or less Associates or more
## 1246 555table(attitudes$education2)/sum(table(attitudes$education2))##
## Some College or less Associates or more
## 0.6918379 0.3081621# CNM subsample
table(attitudes0$education[wCNM])##
## Less than HS HS Some College Associates Bachelors Masters
## 5 25 26 8 13 2
## Professional Doctorate
## 0 1table(attitudes0$education[wCNM])/sum(table(attitudes0$education[wCNM]))##
## Less than HS HS Some College Associates Bachelors Masters
## 0.0625 0.3125 0.3250 0.1000 0.1625 0.0250
## Professional Doctorate
## 0.0000 0.0125Relationship between education level and ATP
All levels
boxplot(ATP ~ education, data=attitudes, las=2, xlab=NA, par(cex.axis=0.7))
#Means
tapply(attitudes$ATP, attitudes$education, mean, na.rm=T)## Less than HS HS Some College Associates Bachelors Masters
## 4.142157 3.674574 3.864499 4.139748 4.113636 4.559211
## Professional Doctorate
## 4.818182 3.983333# SDs
tapply(attitudes$ATP, attitudes$education, sd, na.rm=T)## Less than HS HS Some College Associates Bachelors Masters
## 1.2117080 1.2875039 1.3792563 1.3343175 1.5396838 1.3218124
## Professional Doctorate
## 1.5063837 0.9889825# Pairwise t-tests
pairwise.t.test(attitudes$ATP, attitudes$education, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$ATP and attitudes$education
##
## Less than HS HS Some College Associates Bachelors Masters
## HS 0.11796 - - - - -
## Some College 0.35950 0.05749 - - - -
## Associates 0.99216 3.2e-05 0.02393 - - -
## Bachelors 0.94513 0.00266 0.10443 0.91147 - -
## Masters 0.25222 2.9e-06 0.00023 0.05749 0.05749 -
## Professional 0.25992 0.02585 0.05749 0.20509 0.20502 0.73705
## Doctorate 0.87676 0.66407 0.87676 0.87676 0.87676 0.31990
## Professional
## HS -
## Some College -
## Associates -
## Bachelors -
## Masters -
## Professional -
## Doctorate 0.25992
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$ATP, attitudes$education, p.adjust.method = "none")
p <- c(p, aux$p.value)2 levels (Some College or less & Associates or more)
boxplot(ATP ~ education2, data=attitudes, las=1, xlab=NA)
#Means
tapply(attitudes$ATP, attitudes$education2, mean, na.rm=T)## Some College or less Associates or more
## 3.785436 4.206140# SDs
tapply(attitudes$ATP, attitudes$education2, sd, na.rm=T)## Some College or less Associates or more
## 1.337066 1.405497# t-test
t.test(ATP ~ education2, data=attitudes)##
## Welch Two Sample t-test
##
## data: ATP by education2
## t = -5.8304, df = 974.1, p-value = 7.517e-09
## alternative hypothesis: true difference in means between group Some College or less and group Associates or more is not equal to 0
## 95 percent confidence interval:
## -0.5623068 -0.2791023
## sample estimates:
## mean in group Some College or less mean in group Associates or more
## 3.785436 4.206140Relationship between education level and SRE
All levels
boxplot(SRE ~ education, data=attitudes, las=2, xlab=NA, par(cex.axis=0.7))
#Means
tapply(attitudes$SRE, attitudes$education, mean, na.rm=T)## Less than HS HS Some College Associates Bachelors Masters
## 2.0588235 0.7757685 0.9773829 0.8905172 1.1530303 1.2288732
## Professional Doctorate
## 1.3888889 1.3750000# SDs
tapply(attitudes$SRE, attitudes$education, sd, na.rm=T)## Less than HS HS Some College Associates Bachelors Masters
## 1.936549 1.330860 1.499357 1.425438 1.608284 1.734496
## Professional Doctorate
## 1.369940 1.318933# Pairwise t-tests
pairwise.t.test(attitudes$SRE, attitudes$education, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$SRE and attitudes$education
##
## Less than HS HS Some College Associates Bachelors Masters
## HS 2.2e-05 - - - - -
## Some College 0.00027 0.06589 - - - -
## Associates 0.00016 0.46168 0.51543 - - -
## Bachelors 0.00737 0.02102 0.38995 0.20653 - -
## Masters 0.03119 0.05713 0.38995 0.22790 0.79631 -
## Professional 0.38995 0.38995 0.51543 0.46445 0.74892 0.79631
## Doctorate 0.38995 0.38995 0.51543 0.46445 0.74892 0.79631
## Professional
## HS -
## Some College -
## Associates -
## Bachelors -
## Masters -
## Professional -
## Doctorate 0.98355
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$SRE, attitudes$education, p.adjust.method = "none")
p <- c(p, aux$p.value)2 levels (Some College or less & Associates or more)
boxplot(SRE ~ education2, data=attitudes, las=1, xlab=NA)
#Means
tapply(attitudes$SRE, attitudes$education2, mean, na.rm=T)## Some College or less Associates or more
## 0.9154229 1.0247664# SDs
tapply(attitudes$SRE, attitudes$education2, sd, na.rm=T)## Some College or less Associates or more
## 1.454246 1.529430# t-test
t.test(SRE ~ education2, data=attitudes)##
## Welch Two Sample t-test
##
## data: SRE by education2
## t = -1.397, df = 978.49, p-value = 0.1627
## alternative hypothesis: true difference in means between group Some College or less and group Associates or more is not equal to 0
## 95 percent confidence interval:
## -0.26293550 0.04424856
## sample estimates:
## mean in group Some College or less mean in group Associates or more
## 0.9154229 1.0247664Relationship between education level and WECNM
All levels
boxplot(WECNM ~ education, data=attitudes, las=2, xlab=NA, par(cex.axis=0.7))
#Means
tapply(attitudes$WECNM, attitudes$education, mean, na.rm=T)## Less than HS HS Some College Associates Bachelors Masters
## 2.857143 2.141049 2.370130 2.282313 2.825000 2.777778
## Professional Doctorate
## 3.888889 2.400000# SDs
tapply(attitudes$WECNM, attitudes$education, sd, na.rm=T)## Less than HS HS Some College Associates Bachelors Masters
## 2.060024 1.695582 1.879980 1.841471 2.114788 2.070737
## Professional Doctorate
## 2.088327 2.065591# Pairwise t-tests
pairwise.t.test(attitudes$WECNM, attitudes$education, p.adjust.method = "fdr")##
## Pairwise comparisons using t tests with pooled SD
##
## data: attitudes$WECNM and attitudes$education
##
## Less than HS HS Some College Associates Bachelors Masters
## HS 0.0940 - - - - -
## Some College 0.2253 0.1092 - - - -
## Associates 0.1758 0.4533 0.6723 - - -
## Bachelors 0.9597 0.0012 0.0347 0.0347 - -
## Masters 0.9236 0.0347 0.1758 0.1185 0.9236 -
## Professional 0.2253 0.0347 0.0593 0.0492 0.1758 0.1758
## Doctorate 0.6723 0.8056 0.9597 0.9236 0.6723 0.6951
## Professional
## HS -
## Some College -
## Associates -
## Bachelors -
## Masters -
## Professional -
## Doctorate 0.1758
##
## P value adjustment method: fdraux <- pairwise.t.test(attitudes$WECNM, attitudes$education, p.adjust.method = "none")
p <- c(p, aux$p.value)2 levels (Some College or less & Associates or more)
boxplot(WECNM ~ education2, data=attitudes, las=1, xlab=NA)
#Means
tapply(attitudes$WECNM, attitudes$education2, mean, na.rm=T)## Some College or less Associates or more
## 2.279070 2.538318# SDs
tapply(attitudes$WECNM, attitudes$education2, sd, na.rm=T)## Some College or less Associates or more
## 1.807952 1.981641# t-test
t.test(WECNM ~ education2, data=attitudes)##
## Welch Two Sample t-test
##
## data: WECNM by education2
## t = -2.5854, df = 944.71, p-value = 0.009875
## alternative hypothesis: true difference in means between group Some College or less and group Associates or more is not equal to 0
## 95 percent confidence interval:
## -0.45603336 -0.06246262
## sample estimates:
## mean in group Some College or less mean in group Associates or more
## 2.279070 2.538318Save p-values for demographics (to be adjusted at the end)
p.dem <- pCNM completed the questionnaire for personality scales
sum(is.na(attitudesCNM$EU)==F)## [1] 66sum(is.na(attitudesCNM$DFC)==F)## [1] 66sum(is.na(attitudesCNM$CU)==F)## [1] 66sum(is.na(attitudesCNM$GT)==F)## [1] 70sum(is.na(attitudesCNM$SS)==F)## [1] 69sum(is.na(attitudesCNM$SCA)==F)## [1] 73sum(is.na(attitudesCNM$LUDUS)==F)## [1] 70sum(is.na(attitudesCNM$PRAGMA)==F)## [1] 70sum(is.na(attitudesCNM$MANIA)==F)## [1] 70sum(is.na(attitudesCNM$EROS)==F)## [1] 70sum(is.na(attitudesCNM$STORGE)==F)## [1] 70sum(is.na(attitudesCNM$AGAPE)==F)## [1] 70Regressions
# To use in standardizing variables
attitudes$transgender01 <- 1*(attitudes$transgender=="Yes")
attitudes$orientation01 <- 1*(attitudes$orientation2=="LGBTQIA")
attitudes$race01 <- 1*(attitudes$race2=="POC")
attitudes$education01 <- 1*(attitudes$education2=="Associates or more")
attitudes$man01 <- 1*(attitudes$gender=="Man")
attitudes$other01 <- 1*(attitudes$gender=="Other")
attitudes$relationship01 <- 1*(attitudes$relationship == "Yes")Personality variables as predictors of ATP
Step 1: All predictors
pvals <- NA
data <- na.omit(attitudes[,c("ATP", "EU", "DFC", "CU", "GT", "SS", "SCA", "LUDUS", "PRAGMA", "MANIA", "EROS", "STORGE", "AGAPE")])
m1 <- lm(ATP ~ EU + DFC + CU + GT + SS + SCA + LUDUS + PRAGMA + MANIA + EROS + STORGE + AGAPE, data = data)
s <- summary(m1); s##
## Call:
## lm(formula = ATP ~ EU + DFC + CU + GT + SS + SCA + LUDUS + PRAGMA +
## MANIA + EROS + STORGE + AGAPE, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.9047 -0.7530 -0.0006 0.8484 3.5757
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.315e+00 4.414e-01 7.509 9.69e-14 ***
## EU 1.735e-01 6.260e-02 2.771 0.00565 **
## DFC -9.281e-02 7.936e-02 -1.170 0.24235
## CU -6.813e-02 7.480e-02 -0.911 0.36249
## GT 1.311e-01 4.919e-02 2.666 0.00776 **
## SS 1.637e-02 1.285e-02 1.273 0.20303
## SCA -1.758e-01 9.260e-03 -18.989 < 2e-16 ***
## LUDUS -6.232e-03 3.822e-02 -0.163 0.87049
## PRAGMA 2.558e-01 3.306e-02 7.737 1.76e-14 ***
## MANIA 8.059e-02 3.808e-02 2.116 0.03448 *
## EROS 1.071e-01 4.376e-02 2.447 0.01451 *
## STORGE -4.976e-05 3.403e-02 -0.001 0.99883
## AGAPE -5.226e-02 3.600e-02 -1.452 0.14675
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.154 on 1652 degrees of freedom
## Multiple R-squared: 0.2916, Adjusted R-squared: 0.2864
## F-statistic: 56.66 on 12 and 1652 DF, p-value: < 2.2e-16pvals <- c(pvals, s$coefficients[,4])
# standardized betas
lm.beta(m1)## EU DFC CU GT SS
## 7.218334e-02 -3.183495e-02 -2.265531e-02 5.701638e-02 3.426309e-02
## SCA LUDUS PRAGMA MANIA EROS
## -4.261834e-01 -3.792548e-03 1.887664e-01 5.168504e-02 5.990135e-02
## STORGE AGAPE
## -3.363274e-05 -3.390419e-02# VIF
vif(m1)## EU DFC CU GT SS SCA LUDUS PRAGMA
## 1.582267 1.727696 1.442500 1.066719 1.687982 1.174573 1.261335 1.387956
## MANIA EROS STORGE AGAPE
## 1.390954 1.397518 1.233824 1.271768# BIC
BIC(m1)## [1] 5293.169Step 1: Reduced model
nr <- nrow(data)
s <- step(m1, trace = F, k = log(nr)) # k=log(nr) gives BIC
s$call## lm(formula = ATP ~ SCA + PRAGMA, data = data)# Reduced model for step 1
m1.reduced.omit <- lm(ATP ~ SCA + PRAGMA, data = data)
m1.reduced <- lm(ATP ~ SCA + PRAGMA, data = attitudes)
s <- summary(m1.reduced); s##
## Call:
## lm(formula = ATP ~ SCA + PRAGMA, data = attitudes)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.6572 -0.7951 0.0289 0.8572 3.6652
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.07580 0.11804 34.530 <2e-16 ***
## SCA -0.17642 0.00900 -19.603 <2e-16 ***
## PRAGMA 0.27559 0.02956 9.324 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.162 on 1680 degrees of freedom
## (148 observations deleted due to missingness)
## Multiple R-squared: 0.2791, Adjusted R-squared: 0.2782
## F-statistic: 325.2 on 2 and 1680 DF, p-value: < 2.2e-16pvals <- c(pvals, s$coefficients[,4])
# Betas
lm.beta(m1.reduced)## SCA PRAGMA
## -0.4277673 0.2034689# VIF
vif(m1.reduced)## SCA PRAGMA
## 1.109656 1.109656# BIC
BIC(m1.reduced.omit)## [1] 5244.678Step 2: Adding sample characteristics to the reduced model from step 1
# Not including relationship status
data <- na.omit(attitudes[,c("ATP", "SCA", "PRAGMA", "age", "gender", "transgender", "orientation2", "race2", "education2")])
nr <- nrow(data)
full <- as.formula(ATP ~ SCA + PRAGMA + age + gender + transgender + orientation2 + race2 + education2)
m2 <- lm(full, data = data)
scope <- list(lower = as.formula(ATP ~ SCA + PRAGMA), upper = full)
s <- step(m2, trace = FALSE, k = log(nr), scope = scope)
s$call## lm(formula = ATP ~ SCA + PRAGMA + transgender + orientation2 +
## education2, data = data)# F-test for nested models
data <- na.omit(attitudes[,c("ATP", "PRAGMA", "SCA", "transgender", "orientation2", "education2")])
m1.reduced.omit <- lm(ATP ~ SCA + PRAGMA, data=data)
m2.omit <- lm(ATP ~ SCA + PRAGMA + transgender + orientation2 + education2, data=data)
a <- anova(m1.reduced.omit, m2.omit); a## Analysis of Variance Table
##
## Model 1: ATP ~ SCA + PRAGMA
## Model 2: ATP ~ SCA + PRAGMA + transgender + orientation2 + education2
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 1611 2176.6
## 2 1608 2026.4 3 150.23 39.736 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1pvals <- c(pvals, a$`Pr(>F)`[2])
# Model for step 2
m2 <- lm(ATP ~ SCA + PRAGMA + transgender01 + orientation01 + education01, data = attitudes)
s <- summary(m2); s##
## Call:
## lm(formula = ATP ~ SCA + PRAGMA + transgender01 + orientation01 +
## education01, data = attitudes)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7456 -0.7535 0.0354 0.7411 3.8126
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 3.879070 0.117930 32.893 < 2e-16 ***
## SCA -0.161743 0.009026 -17.920 < 2e-16 ***
## PRAGMA 0.227502 0.029613 7.683 2.69e-14 ***
## transgender01 0.771329 0.199457 3.867 0.000115 ***
## orientation01 0.557403 0.064185 8.684 < 2e-16 ***
## education01 0.245887 0.060799 4.044 5.50e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.123 on 1608 degrees of freedom
## (217 observations deleted due to missingness)
## Multiple R-squared: 0.3293, Adjusted R-squared: 0.3272
## F-statistic: 157.9 on 5 and 1608 DF, p-value: < 2.2e-16pvals <- c(pvals, s$coefficients[,4])
# Betas
lm.beta(m2)## SCA PRAGMA transgender01 orientation01 education01
## -0.38945327 0.16783222 0.08095915 0.18520870 0.08328563# VIF
vif(m2)## SCA PRAGMA transgender01 orientation01 education01
## 1.132299 1.144144 1.050722 1.090403 1.016733# BIC
BIC(m2)## [1] 4999.31Step 3: Checking for interactions
m1 <- lm(ATP ~ SCA + PRAGMA + transgender + orientation2 + education2, data = attitudes)
ivs <- c("PRAGMA", "SCA")
dem <- c("transgender", "orientation2", "education2")
for(j in ivs){
for(k in dem){
m2 <- lm(as.formula(paste("ATP ~ SCA + PRAGMA + transgender + orientation2 + education2 + ", j, ":", k)), data = attitudes)
a <- anova(m1, m2)
if(a$`Pr(>F)`[2] < 0.01){
print(c(j, k))
print(a$`Pr(>F)`[2])
}
}
}No interactions improve the model.
Personality variables as predictors of SRE
# function to standardize a variable
st <- function(x){x/sd(x, na.rm=T)}Step 1: All predictors
data <- na.omit(attitudes[,c("EU", "DFC", "CU", "GT", "SS", "SCA", "LUDUS", "PRAGMA", "MANIA", "EROS", "STORGE", "AGAPE", "SRE01")])
m1 <- glm(SRE01 ~ EU + DFC + CU + GT + SS + SCA + LUDUS + PRAGMA + MANIA + EROS + STORGE + AGAPE, family = "binomial", data = data)
s <- summary(m1); s##
## Call:
## glm(formula = SRE01 ~ EU + DFC + CU + GT + SS + SCA + LUDUS +
## PRAGMA + MANIA + EROS + STORGE + AGAPE, family = "binomial",
## data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3447 -1.0296 0.4589 1.0270 2.3381
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.11196 0.83959 -0.133 0.89392
## EU 0.08027 0.11843 0.678 0.49790
## DFC 0.08057 0.15032 0.536 0.59195
## CU -0.21076 0.14131 -1.492 0.13583
## GT -0.02318 0.09356 -0.248 0.80430
## SS 0.10670 0.02443 4.368 1.25e-05 ***
## SCA -0.05202 0.01775 -2.931 0.00337 **
## LUDUS -0.62244 0.07545 -8.250 < 2e-16 ***
## PRAGMA 0.29155 0.06294 4.632 3.62e-06 ***
## MANIA 0.02159 0.07272 0.297 0.76651
## EROS 0.40460 0.08429 4.800 1.58e-06 ***
## STORGE 0.10377 0.06433 1.613 0.10670
## AGAPE 0.17697 0.06856 2.581 0.00984 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2299.1 on 1658 degrees of freedom
## Residual deviance: 2030.0 on 1646 degrees of freedom
## AIC: 2056
##
## Number of Fisher Scoring iterations: 4pvals <- c(pvals, s$coefficients[,4])
# standardized betas
m1.st <- glm(SRE01 ~ st(EU) + st(DFC) + st(CU) + st(GT) + st(SS) + st(SCA) + st(LUDUS) + st(PRAGMA) + st(MANIA) + st(EROS) + st(STORGE) + st(AGAPE), family = "binomial", data = data)
m1.st$coefficients## (Intercept) st(EU) st(DFC) st(CU) st(GT) st(SS)
## -0.11196107 0.04545482 0.03770261 -0.09568925 -0.01376503 0.30471539
## st(SCA) st(LUDUS) st(PRAGMA) st(MANIA) st(EROS) st(STORGE)
## -0.17226905 -0.51501398 0.29340754 0.01891691 0.30953216 0.09561757
## st(AGAPE)
## 0.15655285# VIF
vif(m1)## EU DFC CU GT SS SCA LUDUS PRAGMA
## 1.569734 1.714957 1.410890 1.059675 1.646265 1.170467 1.263332 1.375485
## MANIA EROS STORGE AGAPE
## 1.413256 1.287174 1.182607 1.241011# Likelihood ratio test for m1 against the null
n <- nagelkerke(m1, restrictNobs = T)
n$Pseudo.R.squared.for.model.vs.null[2]## [1] 0.149755n$Likelihood.ratio.test## Df.diff LogLik.diff Chisq p.value
## -12 -134.57 269.14 1.3761e-50# BIC
BIC(m1)## [1] 2126.364Step 1: Reduced model
nr <- nrow(data)
s <- step(m1, trace = FALSE, k = log(nr))
s$formula## SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPEm1.reduced <- glm(SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPE, family = "binomial", data = attitudes)
# Likelihood ratio test for m1.reduced against the null
n <- nagelkerke(m1.reduced, restrictNobs = T)
n$Pseudo.R.squared.for.model.vs.null[2]## [1] 0.149346n$Likelihood.ratio.test## Df.diff LogLik.diff Chisq p.value
## -6 -135.71 271.42 1.0796e-55# reduced
s <- summary(m1.reduced); s##
## Call:
## glm(formula = SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPE,
## family = "binomial", data = attitudes)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.3502 -1.0347 0.4712 1.0300 2.4084
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.25288 0.43005 -0.588 0.55651
## SS 0.11626 0.01970 5.901 3.61e-09 ***
## SCA -0.05317 0.01735 -3.065 0.00217 **
## LUDUS -0.64345 0.07336 -8.772 < 2e-16 ***
## PRAGMA 0.32284 0.06005 5.376 7.60e-08 ***
## EROS 0.45133 0.07858 5.744 9.26e-09 ***
## AGAPE 0.18709 0.06434 2.908 0.00364 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2325.5 on 1677 degrees of freedom
## Residual deviance: 2054.1 on 1671 degrees of freedom
## (153 observations deleted due to missingness)
## AIC: 2068.1
##
## Number of Fisher Scoring iterations: 4pvals <- c(pvals, s$coefficients[,4])
# standardized betas
m1.reduced.st <- glm(SRE01 ~ st(SS) + st(SCA) + st(LUDUS) + st(PRAGMA) + st(EROS) + st(AGAPE), family = "binomial", data = attitudes)
m1.reduced.st$coefficients[-1]## st(SS) st(SCA) st(LUDUS) st(PRAGMA) st(EROS) st(AGAPE)
## 0.3322659 -0.1769603 -0.5364084 0.3257531 0.3451817 0.1658076# VIF
vif(m1.reduced)## SS SCA LUDUS PRAGMA EROS AGAPE
## 1.081286 1.138831 1.204578 1.274875 1.139922 1.105320# BIC
BIC(m1.reduced)## [1] 2106.074Step 2: Adding sample characteristics to the reduced model from step 1
data <- na.omit(attitudes[,c("SS", "SCA", "LUDUS", "PRAGMA", "EROS", "AGAPE", "age", "relationship", "gender", "transgender", "orientation2", "race2", "education2", "SRE01")])
nr <- nrow(data)
full <- as.formula(SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPE + age + relationship + gender + transgender + orientation2 + race2 + education2)
m2 <- glm(full, family = "binomial", data = data)
scope <- list(lower = as.formula(SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPE), upper = full)
s <- step(m2, trace = F, k = log(nr), scope = scope) # k=log(nr) gives BIC
s$formula## SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPE + age + orientation2# Likelihood ratio test for nested models
m2.reduced <- glm(SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPE + age + orientation2, family = "binomial", data = attitudes)
n <- nagelkerke(m2.reduced, null = m1.reduced, restrictNobs = T)
n$Likelihood.ratio.test## Df.diff LogLik.diff Chisq p.value
## -2 -22.305 44.609 2.0572e-10pvals <- c(pvals, n$Likelihood.ratio.test[4])
# Step 2: Reduced model
s <- summary(m2.reduced); s##
## Call:
## glm(formula = SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPE +
## age + orientation2, family = "binomial", data = attitudes)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.5166 -0.9849 0.3742 1.0116 2.3270
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.053991 0.481617 -2.188 0.028637 *
## SS 0.124386 0.020583 6.043 1.51e-09 ***
## SCA -0.039081 0.018017 -2.169 0.030076 *
## LUDUS -0.639440 0.075301 -8.492 < 2e-16 ***
## PRAGMA 0.242810 0.062803 3.866 0.000111 ***
## EROS 0.434361 0.081201 5.349 8.83e-08 ***
## AGAPE 0.207328 0.066418 3.122 0.001799 **
## age 0.029841 0.009143 3.264 0.001100 **
## orientation2LGBTQIA 0.742648 0.125006 5.941 2.83e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2260.7 on 1630 degrees of freedom
## Residual deviance: 1950.1 on 1622 degrees of freedom
## (200 observations deleted due to missingness)
## AIC: 1968.1
##
## Number of Fisher Scoring iterations: 3pvals <- c(pvals, s$coefficients[,4])
# standardized betas
m2.reduced.st <- glm(SRE01 ~ st(SS) + st(SCA) + st(LUDUS) + st(PRAGMA) + st(EROS) + st(AGAPE) + st(age) + st(orientation01), family = "binomial", data = attitudes)
m2.reduced.st$coefficients## (Intercept) st(SS) st(SCA) st(LUDUS)
## -1.0539915 0.3554864 -0.1300567 -0.5330633
## st(PRAGMA) st(EROS) st(AGAPE) st(age)
## 0.2449977 0.3322005 0.1837393 0.1915848
## st(orientation01)
## 0.3394262# VIF
vif(m2.reduced)## SS SCA LUDUS PRAGMA EROS AGAPE
## 1.112334 1.153697 1.191164 1.320077 1.132925 1.098713
## age orientation2
## 1.082627 1.060592# Likelihood ratio test for m2.reduced against the null
n <- nagelkerke(m2.reduced, restrictNobs = T)
n$Pseudo.R.squared.for.model.vs.null[2]## [1] 0.173394n$Likelihood.ratio.test## Df.diff LogLik.diff Chisq p.value
## -8 -155.29 310.59 2.2948e-62# BIC
BIC(m2.reduced)## [1] 2016.649Step 3: Checking for interactions
m1 <- glm(SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPE + age + orientation2, family = "binomial", data = attitudes)
ivs <- c("SS", "SCA", "LUDUS", "PRAGMA", "EROS", "AGAPE")
dem <- c("age", "orientation2")
for(j in ivs){
for(k in dem){
m2 <- glm(as.formula(paste("SRE01 ~ SS + SCA + LUDUS + PRAGMA + EROS + AGAPE + age + orientation2 + ", j, ":", k)), family = "binomial", data = attitudes)
df <- length(coef(m2)) - length(coef(m1)); df
teststat <- -2*(as.numeric(logLik(m1))-as.numeric(logLik(m2))); teststat
p <- pchisq(teststat, df=df, lower.tail=FALSE); p
if(p < 0.01){
print(c(j, k))
print(p)
}
}
}No interaction improves the model.
Personality variables as predictors of WECNM
Step 1: All predictors
data <- na.omit(attitudes[,c("EU", "DFC", "CU", "GT", "SS", "SCA", "LUDUS", "PRAGMA", "MANIA", "EROS", "STORGE", "AGAPE", "WECNM01")])
m1 <- glm(WECNM01 ~ EU + DFC + CU + GT + SS + SCA + LUDUS + PRAGMA + MANIA + EROS + STORGE + AGAPE, family = "binomial", data = data)
s <- summary(m1); s##
## Call:
## glm(formula = WECNM01 ~ EU + DFC + CU + GT + SS + SCA + LUDUS +
## PRAGMA + MANIA + EROS + STORGE + AGAPE, family = "binomial",
## data = data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.1717 -0.9952 -0.6000 1.0757 2.1642
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.809383 0.831051 -0.974 0.33009
## EU 0.250295 0.118191 2.118 0.03420 *
## DFC 0.165292 0.149119 1.108 0.26767
## CU -0.367240 0.141690 -2.592 0.00955 **
## GT 0.165583 0.093235 1.776 0.07574 .
## SS 0.076627 0.024233 3.162 0.00157 **
## SCA -0.081679 0.018012 -4.535 5.77e-06 ***
## LUDUS -0.554348 0.074056 -7.486 7.13e-14 ***
## PRAGMA 0.301312 0.062972 4.785 1.71e-06 ***
## MANIA 0.050694 0.072546 0.699 0.48468
## EROS 0.526574 0.083647 6.295 3.07e-10 ***
## STORGE 0.003851 0.064286 0.060 0.95224
## AGAPE -0.004828 0.068204 -0.071 0.94357
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2290.6 on 1664 degrees of freedom
## Residual deviance: 2036.2 on 1652 degrees of freedom
## AIC: 2062.2
##
## Number of Fisher Scoring iterations: 4pvals <- c(pvals, s$coefficients[,4])
# standardized betas
m1.st <- glm(WECNM01 ~ st(EU) + st(DFC) + st(CU) + st(GT) + st(SS) + st(SCA) + st(LUDUS) + st(PRAGMA) + st(MANIA) + st(EROS) + st(STORGE) + st(AGAPE), family = "binomial", data = attitudes)
m1.st$coefficients## (Intercept) st(EU) st(DFC) st(CU) st(GT) st(SS)
## -0.809382544 0.142191246 0.077938443 -0.167116958 0.098485718 0.218993096
## st(SCA) st(LUDUS) st(PRAGMA) st(MANIA) st(EROS) st(STORGE)
## -0.271818980 -0.462126805 0.304026799 0.044443760 0.402724707 0.003594899
## st(AGAPE)
## -0.004278597# VIF
vif(m1)## EU DFC CU GT SS SCA LUDUS PRAGMA
## 1.587398 1.700156 1.424740 1.069942 1.642371 1.171053 1.282902 1.380607
## MANIA EROS STORGE AGAPE
## 1.407209 1.320845 1.215186 1.266421# Likelihood ratio test for m1 against the null
n <- nagelkerke(m1, restrictNobs = T)
n$Pseudo.R.squared.for.model.vs.null[2]## [1] 0.141687n$Likelihood.ratio.test## Df.diff LogLik.diff Chisq p.value
## -12 -127.19 254.39 1.6614e-47# BIC
BIC(m1)## [1] 2132.626Step 1: Reduced model
nr <- nrow(data)
s <- step(m1, trace = F, k = log(nr))
s$formula## WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS# reduced
m1.reduced <- glm(WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS, family = "binomial", data = attitudes)
s <- summary(m1.reduced); s##
## Call:
## glm(formula = WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS, family = "binomial",
## data = attitudes)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.0891 -0.9910 -0.6112 1.1000 2.1495
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.15844 0.40998 -0.386 0.699
## SS 0.09234 0.01955 4.722 2.34e-06 ***
## SCA -0.08992 0.01758 -5.116 3.13e-07 ***
## LUDUS -0.56244 0.07176 -7.838 4.57e-15 ***
## PRAGMA 0.31708 0.05978 5.304 1.13e-07 ***
## EROS 0.53080 0.07438 7.136 9.59e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2316.5 on 1683 degrees of freedom
## Residual deviance: 2066.1 on 1678 degrees of freedom
## (147 observations deleted due to missingness)
## AIC: 2078.1
##
## Number of Fisher Scoring iterations: 4pvals <- c(pvals, s$coefficients[,4])
# Likelihood ratio test for m1.reduced against the null
n <- nagelkerke(m1.reduced, restrictNobs = T)
n$Pseudo.R.squared.for.model.vs.null[2]## [1] 0.138193n$Likelihood.ratio.test## Df.diff LogLik.diff Chisq p.value
## -5 -125.23 250.45 4.4006e-52# standardized betas
m1.reduced.st <- glm(WECNM01 ~ st(SS) + st(SCA) + st(LUDUS) + st(PRAGMA) + st(EROS), family = "binomial", data=attitudes)
m1.reduced.st$coefficients[-1]## st(SS) st(SCA) st(LUDUS) st(PRAGMA) st(EROS)
## 0.2638923 -0.2992418 -0.4688731 0.3199337 0.4059532# VIF
vif(m1.reduced)## SS SCA LUDUS PRAGMA EROS
## 1.083853 1.141114 1.225827 1.271232 1.060972# BIC
BIC(m1.reduced)## [1] 2110.632Step 2: Adding sample characteristics to the reduced model from step 1
data <- na.omit(attitudes[,c("WECNM01", "SS", "SCA", "LUDUS", "PRAGMA", "EROS", "age", "relationship", "gender", "transgender", "orientation2", "race2", "education2")])
nr <- nrow(data)
full <- as.formula(WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS + age + relationship + gender + transgender + orientation2 + race2 + education2)
scope <- list(lower = as.formula(WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS), upper = full)
m2 <- glm(full, family = "binomial", data = data)
s <- step(m2, trace = F, k = log(nr), scope = scope)
s$formula## WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS + gender + orientation2# Step 2: Reduced model
m2.reduced <- glm(WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS + man01 + other01 + orientation2, family="binomial", data = attitudes)
s <- summary(m2.reduced); s##
## Call:
## glm(formula = WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS + man01 +
## other01 + orientation2, family = "binomial", data = attitudes)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4187 -0.9476 -0.5752 1.0413 2.1164
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.35047 0.42458 -0.825 0.409112
## SS 0.07919 0.02023 3.914 9.06e-05 ***
## SCA -0.08373 0.01838 -4.556 5.21e-06 ***
## LUDUS -0.50655 0.07432 -6.816 9.36e-12 ***
## PRAGMA 0.23148 0.06211 3.727 0.000194 ***
## EROS 0.46802 0.07721 6.062 1.34e-09 ***
## man01 0.76486 0.13222 5.785 7.26e-09 ***
## other01 1.11377 0.44733 2.490 0.012780 *
## orientation2LGBTQIA 0.69307 0.12369 5.603 2.11e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2247.8 on 1634 degrees of freedom
## Residual deviance: 1938.7 on 1626 degrees of freedom
## (196 observations deleted due to missingness)
## AIC: 1956.7
##
## Number of Fisher Scoring iterations: 3pvals <- c(pvals, s$coefficients[,4])
# Likelihood ratio test for nested models
n <- nagelkerke(m2.reduced, null = m1.reduced)
n$Likelihood.ratio.test## Df.diff LogLik.diff Chisq p.value
## -3 -63.675 127.35 2.0143e-27pvals <- c(pvals, n$Likelihood.ratio.test[4])
# standardized coefficients
m2.reduced.st <- glm(WECNM01 ~ st(SS) + st(SCA) + st(LUDUS) + st(PRAGMA) + st(EROS) + st(man01) + st(other01) + st(orientation01), family="binomial", data = attitudes)
m2.reduced.st$coefficients## (Intercept) st(SS) st(SCA) st(LUDUS)
## -0.3504704 0.2263280 -0.2786497 -0.4222786
## st(PRAGMA) st(EROS) st(man01) st(other01)
## 0.2335621 0.3579436 0.3242818 0.1632054
## st(orientation01)
## 0.3167648# VIF
vif(m2.reduced)## SS SCA LUDUS PRAGMA EROS man01
## 1.083655 1.155726 1.223520 1.287380 1.071523 1.031285
## other01 orientation2
## 1.046416 1.069702# Likelihood ratio test for m2.reduced against the null
n <- nagelkerke(m2.reduced, restrictNobs = T)
n$Pseudo.R.squared.for.model.vs.null[2]## [1] 0.172264n$Likelihood.ratio.test## Df.diff LogLik.diff Chisq p.value
## -8 -154.56 309.12 4.7202e-62# BIC
BIC(m2.reduced)## [1] 2005.303Step 3: Checking for interactions
m1 <- glm(WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS + gender + orientation2, family = "binomial", data = attitudes)
ivs <- c("SS","SCA", "LUDUS", "PRAGMA", "EROS")
dem <- c("gender", "orientation2")
for(j in ivs){
for(k in dem){
m2 <- glm(as.formula(paste("WECNM01 ~ SS + SCA + LUDUS + PRAGMA + EROS + gender + orientation2 + ", j, ":", k)), family = "binomial", data = attitudes)
df <- length(coef(m2)) - length(coef(m1)); df
teststat <- -2*(as.numeric(logLik(m1))-as.numeric(logLik(m2))); teststat
p <- pchisq(teststat, df=df, lower.tail=FALSE); p
if(p < 0.01){
print(c(j, k))
print(p)
}
}
}No interactions improve the model.
Save p-values for regressions
p.reg <- pvals[-1]Matched pairs analysis
# Those who are currently in a monogamous relationship
attitudesMM <- subset(attitudesM, attitudesM$relationship == "Yes")
wna_all <- which(is.na(attitudesCNM$EU) &
is.na(attitudesCNM$DFC) &
is.na(attitudesCNM$CU) &
is.na(attitudesCNM$GT) &
is.na(attitudesCNM$SS) &
is.na(attitudesCNM$SCA) &
is.na(attitudesCNM$LUDUS) &
is.na(attitudesCNM$PRAGMA) &
is.na(attitudesCNM$MANIA) &
is.na(attitudesCNM$EROS) &
is.na(attitudesCNM$STORGE) &
is.na(attitudesCNM$AGAPE)
)
attitudesCNM <- attitudesCNM[-wna_all,]
last <- rep(NA, nrow(attitudesCNM))
w <- list(nrow(attitudesCNM))
wna <- which(is.na(attitudesCNM$orientation))
for (i in 1:nrow(attitudesCNM)){
or <- attitudesCNM$orientation[i]
or2 <- attitudesCNM$orientation2[i]
gender <- attitudesCNM$gender[i]
trans <- attitudesCNM$transgender[i]
age <- attitudesCNM$age[i]
race <- attitudesCNM$race[i]
race2 <- attitudesCNM$race2[i]
edu <- attitudesCNM$education[i]
edu2 <- attitudesCNM$education2[i]
w_or <- which(attitudesMM$orientation == or)
w_or2 <- which(attitudesMM$orientation2 == or2)
if(i %in% wna){w_or <- 1:nrow(attitudesCNM)}
w_gender <- which(attitudesMM$gender == gender)
w_trans <- which(attitudesMM$transgender == trans)
w_age <- which(attitudesMM$age == age)
w_age3 <- which((attitudesMM$age >= (age-5)) & (attitudesMM$age <= (age+5)))
if(i==53 | i==2 | i==9 | i==29 | i==32 | i==45 | i==56 | i==73 | i==74){w_age3 <- 1:nrow(attitudesCNM)}
w_race <- which(attitudesMM$race == race)
w_race2 <- which(attitudesMM$race2 == race2)
w_edu <- which(attitudesMM$education == edu)
w_edu2 <- which(attitudesMM$education2 == edu2)
w1 <- intersect(w_or, w_gender)
if(length(w1)==0){
last[i] <- "or"
w[[i]] <- w_or
} else {
w2 <- intersect(w1, w_trans)
if(length(w2)==0){
last[i] <- "gender"
w[[i]] <- w1
} else {
w3 <- intersect(w2, w_age3)
if(length(w3)==0){
last[i] <- "trans"
w[[i]] <- w2
} else {
w4 <- intersect(w3, w_race)
w42 <- intersect(w3, w_race2)
if(length(w4)==0 & length(w42)==0){
last[i] <- "age"
w[[i]] <- w3
} else {
r <- "race"
if(length(w4)==0){w4 <- w42; r <- "race2"}
w5 <- intersect(w4, w_edu)
w52 <- intersect(w4, w_edu2)
if(length(w5)==0 & length(w52)==0){
last[i] <- r
w[[i]] <- w4
} else {
ed <- "edu"
if(length(w5)==0){w5 <- w52; ed <- "edu2"}
last[i] <- ed
w[[i]] <- w5
}
}
}
}
}
}Possible matches for observations that could not be matched for all variables:
a <- which(last!="edu" & last !="edu2")
last[a]## [1] "trans" "gender" "gender" "race" "trans" "gender" "trans" "trans"
## [9] "race" "race"for(i in 1:length(a)){
print(w[[a[i]]])
}## [1] 538
## [1] 132 494 517 711 776
## [1] 538 560
## [1] 99 115 160 184 405 506 529 577 843
## [1] 471
## [1] 1 2 3 4 5 6 8 9 10 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 28
## [26] 29 30 31 32 33 34 35 36 37 39 40 41 42 43 44 45 46 49 50 51 52 53 54 56 57
## [51] 58 59 60 62 63 64 65 67 68 69 71 72 73
## [1] 125 177 233 465 594 665 679 717 767 846
## [1] 110 249 360 368 395 537 648 649 743 838
## [1] 27
## [1] 10 35 43 72Selecting matching subjects
The selection of matches was done manually by viewing the short list of possible matches.
#View(attitudesCNM[1,181:202])
#View(attitudesMM[w[[1]],181:202])m <- c(704, NA, 585, 469, 163, 747, 379, 217, NA, 320,
150, 589, 369, 732, 189, 560, 117, 584, 190, 217,
537, 186, 199, 99, 29, 802, 724, 238, NA, 62,
146, NA, 877, 35, 370, 447, 20, 648, 843, 62,
15, 28, 130, 484, NA, 575, 869, 287, 828, 537,
480, 818, 767, 365, 229, NA, 680, 467, 743, 572,
17, 573, 820, 378, 207, 356, 203, 410, 101, 356,
332, 27, NA, NA, 228)
matched <- attitudesMM[m,]Paired t-tests
vars <- c("EU", "DFC", "CU", "GT", "SS", "SCA", "LUDUS", "PRAGMA", "MANIA", "EROS", "STORGE", "AGAPE")
r <- rbind(attitudesCNM, attitudesMM)
r$rel_type <- factor(c(rep("CNM", nrow(attitudesCNM)), rep("M", nrow(attitudesMM))))
mean_CNM <- rep(NA, length(vars))
mean_M <- rep(NA, length(vars))
sd_CNM <- rep(NA, length(vars))
sd_M <- rep(NA, length(vars))
d <- rep(NA, length(vars))
p <- rep(NA, length(vars))
for(i in 1:length(vars)){
mean_CNM[i] <- mean(attitudesCNM[,vars[i]], na.rm = T)
sd_CNM[i] <- sd(attitudesCNM[,vars[i]], na.rm = T)
mean_M[i] <- mean(matched[,vars[i]], na.rm = T)
sd_M[i] <- sd(matched[,vars[i]], na.rm = T)
d[i] <- mean(attitudesCNM[,vars[i]]-matched[,vars[i]], na.rm = T)/sd(attitudesCNM[,vars[i]]-matched[,vars[i]], na.rm = T)
t <- t.test(attitudesCNM[,vars[i]], matched[,vars[i]], paired = T)
p[i] <- t$p.value
}
p.match <- pAlphas for paired monogamous subsample
w_yes <- which(attitudes0$relationship == "Yes")
wMM <- intersect(wM, w_yes)
itemsEU_M <- itemsEU[wMM,]
itemsDFC_M <- itemsDFC[wMM,]
itemsCU_M <- itemsCU[wMM,]
itemsGT_M <- itemsGT[wMM,]
itemsSS_M <- itemsSS[wMM,]
itemsSCA_M <- itemsSCA[wMM,]
itemsLUDUS_M <- itemsLUDUS[wMM,]
itemsPRAGMA_M <- itemsPRAGMA[wMM,]
itemsMANIA_M <- itemsMANIA[wMM,]
itemsEROS_M <- itemsEROS[wMM,]
itemsSTORGE_M <- itemsSTORGE[wMM,]
itemsAGAPE_M <- itemsAGAPE[wMM,]
a1 <- psych::alpha(itemsEU_M[m,])
a2 <- psych::alpha(itemsDFC_M[m,])
a3 <- psych::alpha(itemsCU_M[m,])
a4 <- psych::alpha(itemsGT_M[m,])
a5 <- psych::alpha(itemsSS_M[m,])
a6 <- psych::alpha(itemsSCA_M[m,])
a7 <- psych::alpha(itemsLUDUS_M[m,])
a8 <- psych::alpha(itemsPRAGMA_M[m,])
a9 <- psych::alpha(itemsMANIA_M[m,])
a10 <- psych::alpha(itemsEROS_M[m,])
a11 <- psych::alpha(itemsSTORGE_M[m,])
a12 <- psych::alpha(itemsAGAPE_M[m,])
c(a1$total[1], a2$total[1], a3$total[1], a4$total[1], a5$total[1], a6$total[1], a7$total[1], a8$total[1], a9$total[1], a10$total[1], a11$total[1], a12$total[1])## $raw_alpha
## [1] 0.9088015
##
## $raw_alpha
## [1] 0.885571
##
## $raw_alpha
## [1] 0.8346364
##
## $raw_alpha
## [1] 0.7464593
##
## $raw_alpha
## [1] 0.690724
##
## $raw_alpha
## [1] 0.7741645
##
## $raw_alpha
## [1] 0.6886198
##
## $raw_alpha
## [1] 0.6768929
##
## $raw_alpha
## [1] 0.5753628
##
## $raw_alpha
## [1] 0.7300958
##
## $raw_alpha
## [1] 0.7760366
##
## $raw_alpha
## [1] 0.8419176Adjusting p-values (for all tests performed):
pvals <- c(p.cor, p.tt, p.dem, p.reg, p.match)
padj <- p.adjust(pvals, method = "fdr")Correlations
cor.table <- data.frame(cors1 = c(NA,c21,c31,c1),
pvals1 = round(c(NA,p21,p31,p1),4),
padj1 = round(c(NA,padj[1],padj[2],padj[4:15]),4),
cors2 = round(c(NA,NA,c32,c2),4),
pvals2 = round(c(NA,NA,p32,p2),4),
padj2 = round(c(NA,NA,padj[3],padj[16:27]),4),
cors3 = round(c(NA,NA,NA,c3),4),
pvals3 = round(c(NA,NA,NA,p3),4),
padj3 = round(c(NA,NA,NA,padj[28:39]),4))
knitr::kable(cor.table)| cors1 | pvals1 | padj1 | cors2 | pvals2 | padj2 | cors3 | pvals3 | padj3 |
|---|---|---|---|---|---|---|---|---|
| NA | NA | NA | NA | NA | NA | NA | NA | NA |
| 0.2189474 | 0.0000 | 0.0000 | NA | NA | NA | NA | NA | NA |
| 0.3753155 | 0.0000 | 0.0000 | 0.5114 | 0.0000 | 0.0000 | NA | NA | NA |
| 0.0333590 | 0.1698 | 0.2615 | -0.0289 | 0.2352 | 0.3469 | 0.0118 | 0.6282 | 0.7488 |
| -0.0369392 | 0.1285 | 0.2150 | 0.0787 | 0.0012 | 0.0033 | 0.0787 | 0.0012 | 0.0033 |
| -0.0985141 | 0.0000 | 0.0002 | -0.1052 | 0.0000 | 0.0001 | -0.1168 | 0.0000 | 0.0000 |
| 0.0475183 | 0.0486 | 0.0899 | -0.0434 | 0.0717 | 0.1296 | -0.0003 | 0.9900 | 0.9947 |
| -0.0028442 | 0.9066 | 0.9561 | 0.1875 | 0.0000 | 0.0000 | 0.1577 | 0.0000 | 0.0000 |
| -0.4862102 | 0.0000 | 0.0000 | -0.0605 | 0.0121 | 0.0261 | -0.1530 | 0.0000 | 0.0000 |
| 0.1038573 | 0.0000 | 0.0001 | -0.2756 | 0.0000 | 0.0000 | -0.2355 | 0.0000 | 0.0000 |
| 0.3278501 | 0.0000 | 0.0000 | 0.0997 | 0.0000 | 0.0001 | 0.1499 | 0.0000 | 0.0000 |
| 0.1231081 | 0.0000 | 0.0000 | 0.0017 | 0.9451 | 0.9781 | 0.0017 | 0.9443 | 0.9781 |
| 0.1074706 | 0.0000 | 0.0000 | 0.2402 | 0.0000 | 0.0000 | 0.2528 | 0.0000 | 0.0000 |
| 0.0551979 | 0.0227 | 0.0450 | 0.1456 | 0.0000 | 0.0000 | 0.1191 | 0.0000 | 0.0000 |
| 0.0593433 | 0.0143 | 0.0301 | 0.1443 | 0.0000 | 0.0000 | 0.0740 | 0.0022 | 0.0057 |
Correlation plots
aux <- cor.table[-1,-c(2,3,5,6,8,9)]
cor.matrix <- as.matrix(aux)
aux <- cor.table[-1,-c(1,2,4,5,7,8)]
p.matrix <- as.matrix(aux)
rownames(cor.matrix) <- c("SRE", "WECNM", "Emotional uncertainty", "Desire for change", "Cognitive uncertainty", "General trust", "Sensation seeking", "Social conformity", "Ludus love style", "Pragma love style", "Mania love style", "Eros love style", "Storge love style", "Agape love style")
colnames(cor.matrix) <- c("ATP","SRE", "WECNM")
#cor.matrix
corrplot(cor.matrix, is.corr = F, order = "original", cl.pos = "r", cl.ratio = 1, cl.align.text = "l", na.label = "-", tl.col = "black", tl.cex = 0.8, p.mat = p.matrix, pch.col="dark grey", pch.cex = 0.8)
# Barplot for ATP
aux <- data.frame(cor = cor.table[-(1:3),1],
sig = 1*(cor.table[-(1:3),3]<0.05))
rownames(aux) <- c("Emotional uncertainty", "Desire for change", "Cognitive uncertainty", "General trust", "Sensation seeking", "Social conformity", "Ludus", "Pragma", "Mania", "Eros", "Storge", "Agape")
cor.ATP <- aux[order(aux$cor),]
f <- function(x){if(x==1) {"cadetblue"} else {"coral"}}
cor.ATP$col <- unlist(lapply(cor.ATP$sig, f))
par(mar=c(5,8.5,1,1)+.1) # c('bottom', 'left', 'top', 'right')
barplot(cor.ATP$cor, names.arg = rownames(cor.ATP), horiz = T, col = cor.ATP$col, xlab = "Spearman Correlation", cex.names = 0.75, las=2, xpd=T, xlim = c(-0.5, 0.4), main = "ATP")
grid(9, NA, col = "lightgray", lty = "dotted",
lwd = par("lwd"))
legend("bottomright", c("significant", "non-sig."), fill = c("cadetblue", "coral"), bty = "n", cex = 0.75)
# Barplot for SRE
aux <- data.frame(cor = cor.table[-(1:3),4],
sig = 1*(cor.table[-(1:3),6]<0.05))
rownames(aux) <- c("Emotional uncertainty", "Desire for change", "Cognitive uncertainty", "General trust", "Sensation seeking", "Social conformity", "Ludus", "Pragma", "Mania", "Eros", "Storge", "Agape")
cor.SRE <- aux[order(aux$cor),]
f <- function(x){if(x==1) {"cadetblue"} else {"coral"}}
cor.SRE$col <- unlist(lapply(cor.SRE$sig, f))
par(mar=c(5,8.5,1,1)+.1) # c('bottom', 'left', 'top', 'right')
barplot(cor.SRE$cor, names.arg = rownames(cor.SRE), horiz = T, col = cor.SRE$col, xlab = "Spearman Correlation", cex.names = 0.75, las=2, xpd=T, xlim = c(-0.5, 0.4), main = "SRE")
grid(9, NA, col = "lightgray", lty = "dotted",
lwd = par("lwd"))
legend("bottomright", c("significant", "non-sig."), fill = c("cadetblue", "coral"), bty = "n", cex = 0.75)
# Barplot for WECNM
aux <- data.frame(cor = cor.table[-(1:3),7],
sig = 1*(cor.table[-(1:3),9]<0.05))
rownames(aux) <- c("Emotional uncertainty", "Desire for change", "Cognitive uncertainty", "General trust", "Sensation seeking", "Social conformity", "Ludus", "Pragma", "Mania", "Eros", "Storge", "Agape")
cor.WECNM <- aux[order(aux$cor),]
f <- function(x){if(x==1) {"cadetblue"} else {"coral"}}
cor.WECNM$col <- unlist(lapply(cor.WECNM$sig, f))
par(mar=c(5,8.5,1,1)+.1) # c('bottom', 'left', 'top', 'right')
barplot(cor.WECNM$cor, names.arg = rownames(cor.WECNM), horiz = T, col = cor.WECNM$col, xlab = "Spearman Correlation", cex.names = 0.75, las=2, xpd=T, xlim = c(-0.5, 0.4), main = "WECNM")
grid(9, NA, col = "lightgray", lty = "dotted",
lwd = par("lwd"))
legend("bottomright", c("significant", "non-sig."), fill = c("cadetblue", "coral"), bty = "n", cex = 0.75)
T-tests for SRE01 and WECNM01
i <- length(p.cor)
data.frame(pvals.SRE = round(pvals[(i+1):(i+12)], 4),
padj.SRE = round(padj[(i+1):(i+12)], 4),
pvals.WECNM = round(pvals[(i+13):(i+24)], 4),
padj.WECNM = round(padj[(i+13):(i+24)], 4))## pvals.SRE padj.SRE pvals.WECNM padj.WECNM
## 1 0.4138 0.5364 0.5899 0.7188
## 2 0.0022 0.0058 0.0045 0.0110
## 3 0.0000 0.0000 0.0000 0.0000
## 4 0.0355 0.0674 0.8790 0.9453
## 5 0.0000 0.0000 0.0000 0.0000
## 6 0.0001 0.0003 0.0000 0.0000
## 7 0.0000 0.0000 0.0000 0.0000
## 8 0.0000 0.0000 0.0000 0.0000
## 9 0.6448 0.7568 0.5416 0.6705
## 10 0.0000 0.0000 0.0000 0.0000
## 11 0.0000 0.0000 0.0000 0.0001
## 12 0.0000 0.0000 0.0011 0.0030Tests for demographics
j <- length(p.cor) + length(p.tt)
data.frame(pvals = round(p.dem,4),
padj = round(padj[(j+1):(j+length(p.dem))],4))## pvals padj
## 1 NA NA
## 2 0.0000 0.0000
## 3 0.0014 0.0037
## 4 0.0004 0.0012
## 5 0.7004 0.8050
## 6 0.0000 0.0000
## 7 NA NA
## 8 0.0000 0.0000
## 9 0.0000 0.0001
## 10 0.0000 0.0000
## 11 NA NA
## 12 0.0000 0.0001
## 13 0.0000 0.0000
## 14 0.0000 0.0000
## 15 NA NA
## 16 0.0000 0.0001
## 17 0.0000 0.0000
## 18 0.0000 0.0000
## 19 0.0000 0.0000
## 20 0.0000 0.0000
## 21 0.1380 0.2242
## 22 0.0000 0.0000
## 23 0.0000 0.0000
## 24 0.0288 0.0559
## 25 0.0080 0.0181
## 26 NA NA
## 27 0.0000 0.0000
## 28 0.0040 0.0098
## 29 0.0010 0.0028
## 30 0.0265 0.0523
## 31 0.0002 0.0005
## 32 NA NA
## 33 NA NA
## 34 0.0013 0.0034
## 35 0.0000 0.0000
## 36 0.1434 0.2320
## 37 0.1352 0.2225
## 38 NA NA
## 39 NA NA
## 40 NA NA
## 41 0.0000 0.0000
## 42 0.6162 0.7390
## 43 0.2411 0.3534
## 44 NA NA
## 45 NA NA
## 46 NA NA
## 47 NA NA
## 48 0.0001 0.0002
## 49 0.0000 0.0000
## 50 NA NA
## 51 NA NA
## 52 NA NA
## 53 NA NA
## 54 NA NA
## 55 0.7239 0.8246
## 56 0.0002 0.0007
## 57 0.0001 0.0003
## 58 0.0008 0.0023
## 59 0.0000 0.0000
## 60 0.0158 0.0325
## 61 0.0004 0.0012
## 62 NA NA
## 63 0.4122 0.5361
## 64 0.3029 0.4240
## 65 0.0003 0.0010
## 66 0.2457 0.3556
## 67 0.1080 0.1849
## 68 NA NA
## 69 NA NA
## 70 0.7387 0.8390
## 71 0.0029 0.0073
## 72 0.4579 0.5876
## 73 0.3255 0.4476
## 74 NA NA
## 75 NA NA
## 76 NA NA
## 77 0.0113 0.0245
## 78 0.6120 0.7390
## 79 0.5277 0.6553
## 80 NA NA
## 81 NA NA
## 82 NA NA
## 83 NA NA
## 84 0.1472 0.2351
## 85 0.0687 0.1248
## 86 NA NA
## 87 NA NA
## 88 NA NA
## 89 NA NA
## 90 NA NA
## 91 0.9769 0.9898
## 92 0.0000 0.0000
## 93 0.0129 0.0275
## 94 0.0000 0.0000
## 95 0.0000 0.0000
## 96 0.0000 0.0001
## 97 0.0108 0.0236
## 98 NA NA
## 99 0.0005 0.0015
## 100 0.8851 0.9462
## 101 0.0001 0.0002
## 102 0.1779 0.2697
## 103 0.1462 0.2351
## 104 NA NA
## 105 NA NA
## 106 0.0052 0.0125
## 107 0.0000 0.0000
## 108 0.0034 0.0084
## 109 0.3774 0.5070
## 110 NA NA
## 111 NA NA
## 112 NA NA
## 113 0.0004 0.0013
## 114 0.2416 0.3534
## 115 0.1732 0.2636
## 116 NA NA
## 117 NA NA
## 118 NA NA
## 119 NA NA
## 120 0.1126 0.1917
## 121 0.0000 0.0001
## 122 NA NA
## 123 NA NA
## 124 NA NA
## 125 NA NA
## 126 NA NA
## 127 0.0395 0.0745
## 128 0.6359 0.7538
## 129 0.0000 0.0000
## 130 0.0000 0.0000
## 131 0.0000 0.0000
## 132 0.0000 0.0000
## 133 0.0000 0.0000
## 134 0.0094 0.0209
## 135 0.0573 0.1050
## 136 0.1323 0.2195
## 137 NA NA
## 138 0.6712 0.7767
## 139 0.5769 0.7051
## 140 0.9608 0.9838
## 141 0.9108 0.9561
## 142 0.1669 0.2590
## 143 NA NA
## 144 NA NA
## 145 0.4065 0.5323
## 146 0.7997 0.8822
## 147 0.7959 0.8806
## 148 0.2687 0.3832
## 149 NA NA
## 150 NA NA
## 151 NA NA
## 152 0.7738 0.8610
## 153 0.8872 0.9462
## 154 0.1157 0.1954
## 155 NA NA
## 156 NA NA
## 157 NA NA
## 158 NA NA
## 159 0.9481 0.9786
## 160 0.3147 0.4349
## 161 NA NA
## 162 NA NA
## 163 NA NA
## 164 NA NA
## 165 NA NA
## 166 0.3917 0.5218
## 167 0.9885 0.9947
## 168 0.0028 0.0073
## 169 0.0006 0.0019
## 170 0.4256 0.5499
## 171 0.9684 0.9864
## 172 0.1566 0.2481
## 173 NA NA
## 174 0.0067 0.0155
## 175 0.0012 0.0033
## 176 0.4393 0.5656
## 177 0.9656 0.9861
## 178 0.1680 0.2597
## 179 NA NA
## 180 NA NA
## 181 0.2545 0.3670
## 182 0.0402 0.0755
## 183 0.3690 0.4985
## 184 0.8502 0.9220
## 185 NA NA
## 186 NA NA
## 187 NA NA
## 188 0.0094 0.0209
## 189 0.1645 0.2564
## 190 0.3294 0.4507
## 191 NA NA
## 192 NA NA
## 193 NA NA
## 194 NA NA
## 195 0.6154 0.7390
## 196 0.1163 0.1955
## 197 NA NA
## 198 NA NA
## 199 NA NA
## 200 NA NA
## 201 NA NA
## 202 0.4821 0.6086
## 203 0.0010 0.0028
## 204 0.9015 0.9541
## 205 0.3891 0.5202
## 206 0.0157 0.0325
## 207 0.6718 0.7767
## 208 0.6379 0.7538
## 209 NA NA
## 210 0.0073 0.0166
## 211 0.2611 0.3751
## 212 0.2793 0.3968
## 213 0.6245 0.7467
## 214 0.3055 0.4247
## 215 NA NA
## 216 NA NA
## 217 0.3949 0.5225
## 218 0.0185 0.0374
## 219 0.6510 0.7618
## 220 0.6146 0.7390
## 221 NA NA
## 222 NA NA
## 223 NA NA
## 224 0.1015 0.1760
## 225 0.9721 0.9874
## 226 0.8849 0.9462
## 227 NA NA
## 228 NA NA
## 229 NA NA
## 230 NA NA
## 231 0.2888 0.4072
## 232 0.1142 0.1937
## 233 NA NA
## 234 NA NA
## 235 NA NA
## 236 NA NA
## 237 NA NA
## 238 0.9021 0.9541
## 239 0.0506 0.0931
## 240 0.2439 0.3544
## 241 0.9922 0.9947
## 242 0.9114 0.9561
## 243 0.1351 0.2225
## 244 0.1497 0.2381
## 245 0.7441 0.8426
## 246 NA NA
## 247 0.0169 0.0344
## 248 0.0000 0.0000
## 249 0.0004 0.0012
## 250 0.0000 0.0000
## 251 0.0055 0.0131
## 252 0.4743 0.6047
## 253 NA NA
## 254 NA NA
## 255 0.0043 0.0104
## 256 0.0410 0.0767
## 257 0.0000 0.0001
## 258 0.0205 0.0410
## 259 0.7828 0.8685
## 260 NA NA
## 261 NA NA
## 262 NA NA
## 263 0.8464 0.9205
## 264 0.0161 0.0330
## 265 0.1025 0.1770
## 266 0.7191 0.8216
## 267 NA NA
## 268 NA NA
## 269 NA NA
## 270 NA NA
## 271 0.0188 0.0378
## 272 0.0952 0.1658
## 273 0.7678 0.8569
## 274 NA NA
## 275 NA NA
## 276 NA NA
## 277 NA NA
## 278 NA NA
## 279 0.5528 0.6799
## 280 0.2057 0.3069
## 281 NA NA
## 282 NA NA
## 283 NA NA
## 284 NA NA
## 285 NA NA
## 286 NA NA
## 287 0.1578 0.2490
## 288 0.0000 0.0000
## 289 0.0000 0.0001
## 290 0.0000 0.0000
## 291 0.0011 0.0030
## 292 0.0067 0.0154
## 293 0.2228 0.3300
## 294 0.1948 0.2941
## 295 NA NA
## 296 0.0188 0.0378
## 297 0.2803 0.3968
## 298 0.0038 0.0093
## 299 0.0143 0.0301
## 300 0.2133 0.3171
## 301 0.2002 0.3011
## 302 NA NA
## 303 NA NA
## 304 0.4050 0.5321
## 305 0.1715 0.2620
## 306 0.1710 0.2620
## 307 0.4031 0.5315
## 308 0.3948 0.5225
## 309 NA NA
## 310 NA NA
## 311 NA NA
## 312 0.0664 0.1211
## 313 0.0814 0.1444
## 314 0.3152 0.4349
## 315 0.3042 0.4243
## 316 NA NA
## 317 NA NA
## 318 NA NA
## 319 NA NA
## 320 0.7154 0.8198
## 321 0.6383 0.7538
## 322 0.6419 0.7558
## 323 NA NA
## 324 NA NA
## 325 NA NA
## 326 NA NA
## 327 NA NA
## 328 0.7577 0.8529
## 329 0.7679 0.8569
## 330 NA NA
## 331 NA NA
## 332 NA NA
## 333 NA NA
## 334 NA NA
## 335 NA NA
## 336 0.9835 0.9939
## 337 0.0269 0.0528
## 338 0.1309 0.2181
## 339 0.0832 0.1469
## 340 0.9260 0.9662
## 341 0.8355 0.9138
## 342 0.1368 0.2231
## 343 0.4919 0.6168
## 344 NA NA
## 345 0.0351 0.0669
## 346 0.2914 0.4094
## 347 0.0000 0.0001
## 348 0.0062 0.0144
## 349 0.0051 0.0122
## 350 0.6617 0.7714
## 351 NA NA
## 352 NA NA
## 353 0.5042 0.6282
## 354 0.0058 0.0134
## 355 0.0777 0.1392
## 356 0.0148 0.0308
## 357 0.9597 0.9838
## 358 NA NA
## 359 NA NA
## 360 NA NA
## 361 0.0029 0.0074
## 362 0.0423 0.0787
## 363 0.0105 0.0231
## 364 0.8436 0.9200
## 365 NA NA
## 366 NA NA
## 367 NA NA
## 368 NA NA
## 369 0.8576 0.9275
## 370 0.0942 0.1648
## 371 0.4821 0.6086
## 372 NA NA
## 373 NA NA
## 374 NA NA
## 375 NA NA
## 376 NA NA
## 377 0.0903 0.1588
## 378 0.5462 0.6739
## 379 NA NA
## 380 NA NA
## 381 NA NA
## 382 NA NA
## 383 NA NA
## 384 NA NA
## 385 0.0807 0.1439Regressions for ATP
k <- length(p.cor) + length(p.tt) + length(p.dem)
nATP <- 23
data.frame(pvals = round(p.reg[1:nATP],4),
padj = round(padj[(k+1):(k+nATP)],4))## pvals padj
## 1 0.0000 0.0000
## 2 0.0056 0.0133
## 3 0.2423 0.3534
## 4 0.3625 0.4914
## 5 0.0078 0.0176
## 6 0.2030 0.3041
## 7 0.0000 0.0000
## 8 0.8705 0.9388
## 9 0.0000 0.0000
## 10 0.0345 0.0660
## 11 0.0145 0.0304
## 12 0.9988 0.9988
## 13 0.1468 0.2351
## 14 0.0000 0.0000
## 15 0.0000 0.0000
## 16 0.0000 0.0000
## 17 0.0000 0.0000
## 18 0.0000 0.0000
## 19 0.0000 0.0000
## 20 0.0000 0.0000
## 21 0.0001 0.0004
## 22 0.0000 0.0000
## 23 0.0001 0.0002Regressions for SRE
k <- length(p.cor) + length(p.tt) + length(p.dem) + nATP
nSRE <- 30
data.frame(pvals = round(p.reg[(nATP+1):(nATP+nSRE)],4),
padj = round(padj[(k+1):(k+nSRE)],4))## pvals padj
## 1 0.8939 0.9507
## 2 0.4979 0.6224
## 3 0.5920 0.7189
## 4 0.1358 0.2225
## 5 0.8043 0.8847
## 6 0.0000 0.0000
## 7 0.0034 0.0084
## 8 0.0000 0.0000
## 9 0.0000 0.0000
## 10 0.7665 0.8569
## 11 0.0000 0.0000
## 12 0.1067 0.1834
## 13 0.0098 0.0217
## 14 0.5565 0.6823
## 15 0.0000 0.0000
## 16 0.0022 0.0057
## 17 0.0000 0.0000
## 18 0.0000 0.0000
## 19 0.0000 0.0000
## 20 0.0036 0.0090
## 21 0.0000 0.0000
## 22 0.0286 0.0559
## 23 0.0000 0.0000
## 24 0.0301 0.0582
## 25 0.0000 0.0000
## 26 0.0001 0.0004
## 27 0.0000 0.0000
## 28 0.0018 0.0048
## 29 0.0011 0.0031
## 30 0.0000 0.0000Regressions for WECNM
k <- length(p.cor) + length(p.tt) + length(p.dem) + nATP + nSRE
nWECNM <- 29
data.frame(pvals = round(p.reg[(nATP + nSRE +1):(nATP + nSRE + nWECNM)],4),
padj = round(padj[(k+1):(k+nWECNM)],4))## pvals padj
## 1 0.3301 0.4507
## 2 0.0342 0.0658
## 3 0.2677 0.3831
## 4 0.0095 0.0211
## 5 0.0757 0.1363
## 6 0.0016 0.0042
## 7 0.0000 0.0000
## 8 0.0000 0.0000
## 9 0.0000 0.0000
## 10 0.4847 0.6098
## 11 0.0000 0.0000
## 12 0.9522 0.9802
## 13 0.9436 0.9781
## 14 0.6992 0.8050
## 15 0.0000 0.0000
## 16 0.0000 0.0000
## 17 0.0000 0.0000
## 18 0.0000 0.0000
## 19 0.0000 0.0000
## 20 0.4091 0.5339
## 21 0.0001 0.0003
## 22 0.0000 0.0000
## 23 0.0000 0.0000
## 24 0.0002 0.0006
## 25 0.0000 0.0000
## 26 0.0000 0.0000
## 27 0.0128 0.0273
## 28 0.0000 0.0000
## 29 0.0000 0.0000Matched-pairs t-test results
k <- length(p.cor) + length(p.tt) + length(p.dem) + nATP + nSRE + nWECNM
cbind(mean_CNM, sd_CNM, mean_M, sd_M, d, p, round(padj[(k+1):(k+12)],4))## mean_CNM sd_CNM mean_M sd_M d p
## 2.426263 0.5900461 2.461692 0.5780862 -0.02921575 0.823226616 0.9030
## 2.839962 0.4807757 2.875933 0.5026554 -0.04091267 0.754454086 0.8518
## 2.852050 0.4005908 3.028973 0.4139708 -0.42590106 0.001804545 0.0048
## 3.395238 0.5264130 3.405473 0.5627493 -0.09073699 0.474106826 0.6047
## 6.536232 2.6489716 6.000000 2.6076810 0.18388435 0.159609635 0.2508
## 5.972603 3.1621573 6.253731 3.6446028 -0.08776037 0.481795472 0.6086
## 3.400000 0.9221509 3.835821 0.9480365 -0.37003292 0.004645787 0.0112
## 2.910714 0.9909333 2.929104 1.0185830 0.01299636 0.918172577 0.9606
## 3.032143 0.7995939 3.298507 0.9151904 -0.17731309 0.164308818 0.2564
## 1.857143 0.7808526 1.720149 0.6433259 0.11824153 0.351622681 0.4784
## 2.396429 0.9455204 2.276119 1.0095513 0.11187814 0.377970051 0.5070
## 2.607143 0.7843250 2.500000 0.9914406 0.05512617 0.663232698 0.7714
Social Conformity-Autonomy (SCA)