Preparing the Data: Cattell's 16 Factor Personality Measure

As I said in my previous post, I'm working on a 2-part series where I show how to conduct psychometric analysis on a personality measure. Those posts are coming very soon, but today, I wanted to start by demonstrating how I prepare the data for psychometric analysis.

So let's start working with the Cattell's 16 Factor Personality Measure, or more specifically, items from the International Personality Item Pool (IPIP) selected to reflect the 16 factors identified by Cattell. I happened upon this measure while exploring the Open-Source Psychometrics Project website, which not only allows you to take a wide variety of personality measures, it also makes the data collected through the website freely available. This would be a great source to use for a class project, someone learning psychometrics or working with larger datasets... or a blog post!

When you download the data, you'll also get the measure's codebook included in the zip file. However, the codebook is really a data dictionary of the items in the dataset (name, definition, and how it's coded), and doesn't tell you which items are reverse-scored. So I also recommended this page, which lists items of each measure in order, showing which are reverse-keyed, as well as the alpha for each scale from the initial research. You may also want to check out this page for additional details about the measure.

When conducting psychometric analysis, you may or may not need to do any data cleaning. It really depends on how the data were collected - was it in a controlled setting, like a testing center? Or less controlled like - in the case of this measure - an online survey? We likely have missing data, since none of the items were required. We could also have straight-line answering (where a person selects the same response for each item), or nonsensical answers to the open-response age question, such as one respondent who entered 2,147,483,647, which would put their birth right in the middle of the Paleoproterozoic era, when the only living beings on the planet were ones who didn't require oxygen.

So let's load our data and get started with cleaning.

library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.2.1     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ ggplot2   4.0.3     ✔ tibble    3.3.1
## ✔ lubridate 1.9.5     ✔ tidyr     1.3.2
## ✔ purrr     1.2.2     
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(ggthemes)

PF16 <- read_tsv("data.csv")

## Rows: 49159 Columns: 169
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: "\t"
## chr   (1): country
## dbl (168): A1, A2, A3, A4, A5, A6, A7, A8, A9, A10, B1, B2, B3, B4, B5, B6, ...
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

According to documentation from the website, they removed anyone under the age of 13 from the downloadable set, as well as anyone who didn't want their data included. But there are still children in the set (13 to 17), and also our immortal beings (i.e., 2 billion years old). We definitely want to remove those rows from data, since a random answer to the age question could also mean random answers on the rest of the measure. So let's get some descriptive data on our age measure, and make decisions about who to keep and who to filter out.

PF16 %>%
  filter(age > 99) %>%
  group_by(age) %>%
  summarise(count = n())

## # A tibble: 63 × 2
##      age count
##    <dbl> <int>
##  1   100     5
##  2   101     2
##  3   102     1
##  4   118     1
##  5   141     1
##  6   147     1
##  7   158     1
##  8   181     1
##  9   188     1
## 10   193     1
## # ℹ 53 more rows

I did some Googling, and the oldest person to ever live (recorded) was 122 years, and the oldest person still living is 117. I’m inclined to say anyone over 102 is not being truthful, so we’ll plan on filtering them out. Likely many people were not being truthful about age, but unless we have direct evidence they're lying, we'll have to leave them in. With the remaining respondents, we’ll classify their ages into groups: 13 to 17, 18 to 24, 25 to 34, 35 to 44, 45 to 64, 65+. I’m also going to add IDs to the file. Since each row is a person, I’ll just use row numbers.

PF16 <- PF16 %>%
  filter(age <= 102) %>%
  mutate(ID = row_number(),
         age_group = cut(age,
                         breaks = c(12, 17, 24, 34, 44, 64, Inf),
                         labels = c("13 to 17", "18 to 24", "25 to 34", "35 to 44", "45 to 64", "65+"),
                         right = TRUE))

To create the age grouping variable, I used the cut function, where I define my break points and use right = TRUE to say that the value provided is the end of each break. The first value in the "right = TRUE" notation should be the starting value minus 1.

Let's also replace missing values (currently coded with 0) with NA. Since all of our items are in a row, we can use mutate(across(firstvariable:lastvariable)) in the string we want to recode.

PF16 <- PF16 %>%
  mutate(across(A1:P10, ~na_if(., 0)))

Now we want to start identifying people with response patterns that won't provide meaningful information. This would include people who responded carelessly - like selecting the same option for each item or going between two options (like 4-5-4-5) - or with too much missing data. However, we want to be conservative in who we remove. Presumably, this was a volunteer survey that people did out of interest or curiosity. In those cases, some careless responding may mean the item was confusing, doesn't measure what it's supposed to, etc. But that doesn't mean there might not be some captive audience respondents - people who were required to complete the measure as part of coursework or a group activity - that just wanted to get it over with. Without being able to measure or control the context, we just don't know. This is why I'd like to be conservative in who I remove, because I'd rather retain people who were truly being careless than risk removing people whose "careless" responses are actually due to problematic items or scales.

There are a few ways we can measure careless responses. One is by looking at their longest string of identical responses. The other way is with intra-individual response variability, which is better at detecting people who stick to two consecutive options. The r package, careless, can do all of this for us. Reminder: if you don't have a particular package, you'll need to install it first with install.packages("packagename") before loading it. The longstring function will provide the count of the longest string of repeated answers; adding avg = TRUE will also give us the average length of strings across the entire row. irv computes intra-individual response variability, or the amount of variation in each row's responses. All of this will be easier if we have a dataset containing only item responses, and we generate a new dataset with the data from the careless functions; that way, we won't inadvertently use demographics, IDs, or results from a previous function. I'll also add to my flag dataset the number of missing responses and the longest string divided by total number of items, to measure the percentage of their responses included in that string.

library(careless)

Items <- PF16 %>%
  select(A1:P10)

longstrings <- longstring(Items, avg = TRUE)

Flags <- tibble(
  ID = PF16$ID,
  longstring = longstrings$longstr,
  avgstring = longstrings$avgstr,
  irv = irv(Items, na.rm = TRUE),
  na_count = rowSums(is.na(Items)),
  pct_long = longstring/163
)

Let's start with IRV, which should help us identify the worst offenders in terms of careless responding. Lower IRVs (say, less than 0.50) would identify people who gave the same answer or one of two answers to every item. Let's visualize our irv variable before we make any decisions on what to filter out.

library(ggthemes)

Flags %>% 
  ggplot(aes(irv)) + 
  geom_histogram() +
  theme_economist_white()

## `stat_bin()` using `bins = 30`. Pick better value `binwidth`.

## Warning: Removed 171 rows containing non-finite outside the scale range
## (`stat_bin()`).

We have a number of cases with an IRV of 0. Those are our true straight-liners. There are also cases with IRV of 0.50 or less. Those would be the people who bounce between two options. The overall counts are low, so we won't lose too many cases by filtering out any with an IRV of 0.50 or less.

Flags <- Flags %>%
  filter(irv > 0.50)

This dropped 381 cases. Now let's look at longstrings. Our IRV filter dropped people who showed careless response patterns across the whole measure, but we likely still have careless responders here. We just need to be judicious and data-driven in how we identify them.

range(Flags$pct_long)

## [1] 0.006134969 0.441717791

I also ran a basic histogram much like the one above for IRV (not pictured), and counts above 10% were so low, they weren't even visible. I reran the histogram, this time specifying bin width to figure out an exact cutoff, and limiting the scale to values between 0 and 50% (since we know our longest string is 44%).

Flags %>%
  ggplot(aes(pct_long)) +
  geom_histogram(binwidth = .01) +
  scale_x_continuous(limits = c(0, 0.50)) +
  theme_economist_white()
  

We have a large dropoff around the 9% string percentage. Let’s see how many cases we’d lose with that cutoff, as well as 10%.

Flags %>%
  filter(pct_long >= 0.09)

## # A tibble: 335 × 6
##       ID longstring avgstring   irv na_count pct_long
##    <int>      <dbl>     <dbl> <dbl>    <dbl>    <dbl>
##  1    42         15      1.90 0.553        0   0.0920
##  2    56         17      1.75 0.860        0   0.104 
##  3   176         15      1.96 0.769        1   0.0920
##  4   553         17      2.51 0.650        0   0.104 
##  5   617         17      2.51 0.737       11   0.104 
##  6  2038         17      3.40 0.688        0   0.104 
##  7  3418         18      2.09 1.31         0   0.110 
##  8  3995         15      1.47 1.30         1   0.0920
##  9  4035         15      2.86 0.985        0   0.0920
## 10  4385         16      2.12 0.849        0   0.0982
## # ℹ 325 more rows

Flags %>%
  filter(pct_long >= 0.10)

## # A tibble: 265 × 6
##       ID longstring avgstring   irv na_count pct_long
##    <int>      <dbl>     <dbl> <dbl>    <dbl>    <dbl>
##  1    56         17      1.75 0.860        0    0.104
##  2   553         17      2.51 0.650        0    0.104
##  3   617         17      2.51 0.737       11    0.104
##  4  2038         17      3.40 0.688        0    0.104
##  5  3418         18      2.09 1.31         0    0.110
##  6  6013         19      1.68 0.805        0    0.117
##  7  6909         21      1.92 1.51         1    0.129
##  8  7120         17      2.76 0.574        2    0.104
##  9  7158         18      1.99 0.718        6    0.110
## 10  7686         18      2.04 0.706        0    0.110
## # ℹ 255 more rows

A cutoff of 9% translate to a longest string of 15, and 10% translates to 17. Most of our scales contain 10 items, with the exception being scale B, intellect, at 13 items. Further, each scale contains 3-5 negatively worded items. If those items and scales are functioning as expected, the longest possible string would be 8. But what if those items and scales aren't functioning as expected? What if a negative item, that test developers thought represented the opposite of the trait being measured, is completely unrelated?

At the same time, these groups make up a small proportion of the overall sample. Using a cutoff of 10%, we would only lose about 0.5% of our overall total. So let's use 10%.

Flags <- Flags %>%
  filter(pct_long < 0.1)

NAs <- Flags %>% 
  group_by(na_count) %>% 
  summarise(count = n())

head(NAs)

## # A tibble: 6 × 2
##   na_count count
##      <dbl> <int>
## 1        0 35127
## 2        1  8705
## 3        2  2595
## 4        3   903
## 5        4   423
## 6        5   158

If we kept only complete cases, we’d still have over 35,000 cases to work with. But our psychometric approaches (CTT and Rasch) can handle some (but not a lot of) missing data. Using a cutoff of 2 missing or fewer would let us keep most of our sample, and shouldn't impact our ability to validate these scales.

Flags <- Flags %>%
  filter(na_count <= 2)

Now that we have our sample of people who appear to have put some effort into responding to the items, we can filter our PF16 dataset to just include those individuals.

PF16 <- PF16 %>%
  filter(ID %in% Flags$ID)

And to make it easier on myself, I'll save this dataset, so that I can start with it in my next post, where we'll work on CTT psychometric analysis!

write_csv(PF16, "Cleaned PF16 Data.csv")

See you in my next post!