Social play is ubiquitous in the development of many animal species and involves players adapting actions flexibly to their own previous actions and partner responses. Play differs from other behavioural contexts for which fine-scale analyses of action sequences are available, such as tool use and communication, in that its form is not defined by its functions, making it potentially more unpredictable. In humans, play is often organised in games, where players know context-appropriate actions but string them together unpredictably. Here, we use the sequential nature of play elements to explore whether play elements in chimpanzees are structured hierarchically and follow predictable game-like patterns. Based on 5711 play elements from 143 bouts, we extracted individual-level play sequences of 11 Western chimpanzees (Pan troglodytes verus) of different ages from the Bossou community. We detected transition probabilities between play elements that exceeded expected levels and show that play elements form hierarchically clustered and interchangeable groups, indicative of at least six ‘games’ that can be identified from transition networks, some with different roles for different players. We also show that increased information about preceding play elements improved predictability of subsequent elements, further indicating that play elements are not strung together randomly but that flexible action rules underlie their usage. Thus, chimpanzee play is hierarchically structured in short ‘games’ which limit acceptable play elements and allow players to predict and adapt to partners’ actions. This ‘grammar of action’ approach to social interactions can be valuable in understanding cognitive and communicative abilities within and across species.
Videos were coded in BORIS with the developed coding scheme - the manual is available on GitHub and in the Supplementary. The below R script extracts play elements from BORIS output and assigns them into bouts. Bouts are defined as all elements that happen between the start (first play element of either partner) and the end (neither individual shows play elements for more than 5 seconds).
The following script extracts basic descriptive information about all bouts, how many players exchanged how many elements for how long etc.
The play elements were defined in an additional file that can be found on GitHub. The file also contains conventions about lumping elements in case too few cases were observed. The lumping convention was determine a priori when developing the coding scheme based on similarity of movement between elements.
# get elements and their possible replacements from the .csv file in the repository
element_table <-
read_csv("~/GitHub/Mielke-Carvalho_Chimpanzee-Play/elements.csv", show_col_types = FALSE)
elements <- element_table$elements
Some bouts do not contain any usable play elements and should be removed (e.g., if they are only solitary play).
# remove bouts that do not contain any of the elements specified above
remove <- sapply(unique(video.data$bout.nr), function(x) {
nrow(filter(
video.data,
bout.nr == x,
!Behavior %in% c(
"Non-Play",
"Comment",
"Start",
"End",
"Players",
"Intervention"
)
)) == 0
})
remove <- unique(video.data$bout.nr)[remove]
if (length(remove) > 0) {
video.data <- filter(video.data, video.data$bout.nr != remove)
}
What we want to end up with is a list that contains all individuals’ sequences of elements within each bout. We want other lists that contain the respective information on the Time, the Individual, and which bout this was taken from, for later processing.
# go through each bout, remove useless information
bout.data <- lapply(unique(video.data$bout.nr), function(x) {
# select bout and sort by subject and time
set.data <-
filter(
video.data,
bout.nr == x,
!Behavior %in% c(
"Non-Play",
"Comment",
"Start",
"End",
"Players",
"Intervention"
)
) %>%
arrange(Subject, Time)
# vector with focals
focal <- set.data$Subject
# bout nr
bout.nr <- sub(".*/", "", unique(set.data$bout.nr))
# vector with time
Time <- set.data$Time
# put elements into list
bout.elements <- list()
for (i in 1:nrow(set.data)) {
yy <-
as.vector(unlist(strsplit(
unlist(set.data[i, ]),
split = ",", fixed = T
)))
yy <- intersect(yy, elements)
bout.elements[[i]] <- yy
}
# elements that co-occur in event are combined by % symbol
bout.elements <- sapply(bout.elements, paste, collapse = "%")
# empty cells (i.e. those not containing a recognised element) get NA
bout.elements[bout.elements == ""] <- NA
return(data.frame(focal, bout.nr, Time, bout.elements))
})
# combine all bouts into one frame
bout.data <- bind_rows(bout.data)
# create individual-level bout identifier
bout.data$bout.nr.focal <- bout.data %>%
unite(bout.nr, bout.nr, focal, sep = "_", remove = T) %>%
select(bout.nr)
bout.data$bout.nr.focal <-
as.vector(bout.data$bout.nr.focal$bout.nr)
# create list that has one vector of elements per individual-bout
elements.bout <-
lapply(unique(bout.data$bout.nr.focal), function(x) {
set.data <- filter(bout.data, bout.nr.focal == x)
return(set.data$bout.elements)
})
# create list that has one vector of times per individual-bout
elements.time <-
lapply(unique(bout.data$bout.nr.focal), function(x) {
set.data <- filter(bout.data, bout.nr.focal == x)
return(set.data$Time)
})
# create list of focal ID per individual-bout
bout.focal <- lapply(unique(bout.data$bout.nr.focal), function(x) {
set.data <- filter(bout.data, bout.nr.focal == x)
return(unique(set.data$focal))
})
# create list of bout ID per individual-bout
bout.id <- lapply(unique(bout.data$bout.nr.focal), function(x) {
set.data <- filter(bout.data, bout.nr.focal == x)
return(unique(set.data$bout.nr))
})
# name element-list and time-list using individual-bout id
names(elements.bout) <- unique(bout.data$bout.nr.focal)
names(elements.time) <- unique(bout.data$bout.nr.focal)
Now, we should be left with four objects:
- elements.bout, a list named with the individual-bout IDs, containing all the elements performed by the focal player in this bout, ordered in sequence.
- elements.time, another list, named with the individual-bout IDs, containing all corresponding time stamps
- bout.focal, another list, containing the corresponding focal IDs
- bout.id, another list, containing the corresponding bout IDs
Data are separated by bout and ID and analysed as sequence of all elements of an individual within that bout. This leads us currently to have 143 bouts across 35 videos in which play has been identified containing between 3 and 181 (mean = 30.3 ) elements per bout. As we split bouts by individual, we are working with 306 individual performances and 4970 events, giving a total of 7025 individual play elements (after accounting for co-occurrence). A total of 11 individuals were observed playing at least once.
The next steps will be to determine and replace rare elements, and to handle the continuous elements.
First we need to set a threshold for what determines a ‘rare’ element. Here, we will use elements that occur at least 20 times. All elements falling below this threshold will be changed to their potential replacement, as determined a priori.
The change_elements function allows for fast replacement of elements. The unlist_list and unlist_vector functions are designed to unlist element vectors and lists that contain co-occurring elements (i.e., those that happen at the same time). Those elements are marked by a percentage symbol (‘%’) between them.
We need to find out which elements occur fewer than the set number of times. There are a few elements that do not have a natural replacement and will be retained despite being rare.
# set threshould
threshold <- 20
# unlist elements
unlisted_elements_table <-
table(unlist_vector(elements.bout, method = "random"))
# detect elements below threshold
rare_elements <-
unlisted_elements_table[unlisted_elements_table <= threshold]
# show rare elements to replace
rare_elements_replace <- element_table %>%
filter(elements %in% names(rare_elements))
# go through rare elements and change them
for (i in seq_along(rare_elements_replace$elements)) {
# some elements do not have a natural replacement; instead, they had a '-' in the table
## ignore those
if (rare_elements_replace$potential_replacement[i] != "-") {
# use 'change_elements' function to change elements one by one
elements.bout <- change_elements(
elements.to.change = rare_elements_replace$elements[i],
new = rare_elements_replace$potential_replacement[i],
elem.bout = elements.bout
)
}
}
############ Repeat the same thing again in case some elements got missed
unlisted_elements_table <-
table(unlist_vector(elements.bout, method = "random"))
# detect elements below threshold
rare_elements <-
unlisted_elements_table[unlisted_elements_table <= threshold]
# show rare elements to replace
rare_elements_replace <- element_table %>%
filter(elements %in% names(rare_elements))
# go through rare elements and change them
for (i in seq_along(rare_elements_replace$elements)) {
if (rare_elements_replace$potential_replacement[i] != "-") {
elements.bout <- change_elements(
elements.to.change = rare_elements_replace$elements[i],
new = rare_elements_replace$potential_replacement[i],
elem.bout = elements.bout
)
}
}
After removing the rare elements, we have reduced the number of individual elements from 118 to 69 elements.
After we have removed elements at the low end of the scale, it is worth also checking why some elements occur at much higher frequency than others. The seven most common elements (Bipedal, Hold, Follow-Other, Approach, Retreat-backwards, Retreat, Flee) all share the fact that they are continuous and therefore are noted every time a change occurs while they are active. This is hard to explain from a language perspective, but easy if you imagine a musical piece on the piano: sometimes one note is held while others are played. In play, a chimpanzee can go bipedal, but then do all kinds of other actions while the Bipedal is marked at every change in event. This is not optimal. Ideally, we want a sequence that reflects when individuals made the choice to use a specific element - thus, they first go bipedal, then they do all the other things. What we do in this case is that we use a function that goes through each bout, finds cases where one of those seven elements occurs multiple times in a row, and only retains the first case in which they are observed (remove_serial). If they stop doing the continuous action (e.g., stop fleeing, then start again) the element is counted again. Here is an example of what such a sequence looks like, with Bipedal here occurring three times in a row.
## Warning in !is.null(rmarkdown::metadata$output) && rmarkdown::metadata$output
## %in% : 'length(x) = 4 > 1' in coercion to 'logical(1)'
| Bipedal | Hit%Bipedal | Bipedal%Arm-raise | Follow-Other | Charge | NA |
Here is a function that removes those serial occurrences of the same elements. As the time stamps would potentially be mixed if we would not account for them, they will be changed accordingly.
Now that we have this function, we want it to go over all the data for each of the continuous elements and adjust them.
for (i in names(sort(unlisted_elements_table, decreasing = T))[1:7]) {
serial.removed <-
remove_serial(
elem.bout = elements.bout,
elem.time = elements.time,
to.remove = as.character(i),
move.first = TRUE
)
elements.bout <- serial.removed$elements
elements.time <- serial.removed$times
}
If we look at the sequence from before, we can see that Bipedal now only occurs once - in the beginning of the sequence. Thus, instead of the player going bipedal, then being bipedal and hitting, then being bipedal and arm raising; they are now considered to go bipedal, then hit the partner, then raise their arm.
| Bipedal | Hit | Arm-raise | Follow-Other | Charge |
Creating a distribution plot (Figure 1), we can see that now, none of the elements has an excessive occurrence probability any more.
# How often does each element occur?
unlisted_elements_table <-
unlist_vector(elements.bout, method = "random") %>%
table()
# Data frame containing words and their frequency
word_count <- unlisted_elements_table %>%
data.frame(stringsAsFactors = FALSE) %>%
rename("element" = '.', "count" = Freq) %>%
arrange(desc(count)) %>%
mutate(element = as.character(element))
zipfs_plot <- zipf_plot(
element = word_count$element,
occurrance = word_count$count,
zipf = FALSE,
title = "Distribution of Element Frequencies"
)
zipfs_plot$zipf.plot
Distribution of Element Occurrences. This distribution controls for the over-exposure of some continuous elements.
All functions are available in the GitHub repository and can be loaded like a package. Most of them require data to be structured as a list, with each list element being a vector of elements order by their occurrence in the sequence. Co-occurring elements are marked by the % symbol, e.g., Hit%Hold indicates that the individual was simultaneously hitting and holding the partner.
###Transitions
Now that we have the dataset, we want to see which elements transition into each other in sequences. The transitions_frame function creates a basic summary of the bigram (antecedent and consequent) and their individual occurrence probabilities. The elem_info function allows users to get different output measures to quantify the transition - either their sum, joint probability, conditional probability, or pointwise mutual information. Here, we create the observed counts and conditional probabilities of A transitioning to B. The parameter it determines how many permutations of co-occurring elements should be produced, and ran.method determines that these co-occurring elements should be shuffled randomly but all used.
# create basic table of possible transitions
transitions <- transitions_frame(elem.bout = elements.bout,
all.possible = FALSE)
# how often does A lead to B
transitions$observed.sum <- elem_info(
antecedent = transitions$antecedent,
consequent = transitions$consequent,
elem.bout = elements.bout,
it = 1000,
measure = c("sum"),
ran.method = 'random'
)
# conditional probability of A leading to B
transitions$observed.probs <- round(
elem_info(
antecedent = transitions$antecedent,
consequent = transitions$consequent,
elem.bout = elements.bout,
it = 1000,
measure = c("prob"),
ran.method = 'random'
),
3
)
Users who would want to replicate the results using a different approach (bag-of-words or using one randomly selected co-occurring element rather than shuffling them and keeping all) can do so using the ran.method parameter (change to ‘sample’) or using the bag_of_words function. In most following function, adding a gap and elem.time parameter will automatically trigger the bag-of-words approach. The gap parameter specified below indicates that two elements should be counted as transitioning if they occur within 0 to 1 sec of each other.
# bigrams with observed probabilities of occurring within the same 'bag'
transitions_bow <-
bag_of_words(elem.bout = elements.bout,
elem.time = elements.time,
gap = c(0, 1))
We visualise the output of the transitions data frame by showing the head of the table and the overall distribution of observed conditional transition probabilities. There are overall 1622 transitions that were observed at least one time. The histogram shows that most elements are followed by a number of different consequents - only 4 transitions constituted more than 1/3 of all possible transitions of that antecedent. At the same time, each element was observed to be followed by between 7 and 53 elements. Thus, there is no tight coupling between any two elements. This might indicate random assignment - any elements could be followed by any other. However, it might also mean situation-specific responses that are tailored to the players’ own previous action and the partners’ reaction. To work this out, we will look at which elements follow each other more than expected under the assumption of randomness.
| antecedent | consequent | observed.sum | observed.probs |
|---|---|---|---|
| Approach | Approach | 1.000 | 0.004 |
| Approach | Armprotect | 2.000 | 0.008 |
| Approach | Armraise | 1.513 | 0.006 |
| Approach | Armswing | 10.297 | 0.039 |
| Approach | Armwave | 3.509 | 0.013 |
| Approach | Bendsapling | 3.000 | 0.011 |
| Approach | Bipedal | 30.000 | 0.113 |
| Approach | Bite | 1.488 | 0.006 |
| Approach | Bop | 2.026 | 0.008 |
| Approach | Bow | 3.590 | 0.013 |
ggplot(transitions, aes(x = observed.probs)) +
geom_histogram(fill = "grey", bins = 50, color = 'black') +
theme_classic() +
xlab("Conditional Transition Probabilities")
Distribution of Conditional Transition Probabilities
Before statistically testing which conditional probabilities are statistically meaningful, it makes sense to visualize how robust they are. We are working with very small samples - many transitions will be based on a small number of events. For example, if an element only occurs 10 times, even at random assignment, the transition probabilities to all consequents will be at least 0.1. However, each new or missing data point would dramatically change this pattern. This is not optimal. To check this, we bootstrap the transition probabilities using the boot_element function: by repeatedly taking random subsets of bouts (1000 iterations, random sampling with replacement), we can create an interval around the observed transition probabilities, and check how broad those intervals are. We plot the coefficient of variance for the 1000 bootstraps against the number of times the consequent was observed. What we see is that for some rare elements, the transition probabilities become volatile. Transition probabilities of rare elements will therefore be interpreted with caution, and elements will be filtered to exclude rare or highly volatile transitions.
# use 'boot_elements()' function
boot.probabilities <- boot_elements(
elem.bout = elements.bout,
antecedent = transitions$antecedent,
consequent = transitions$consequent,
measure = "prob",
trials = 1000,
it = 10,
cores = 16,
ci.range = c(0.025, 0.975),
output = "summary",
ran.method = 'random'
)
######### compare randomized and observed
transitions$lower.ci <- boot.probabilities$lower.ci
transitions$upper.ci <- boot.probabilities$upper.ci
transitions$range.ci <- boot.probabilities$range.ci
transitions$sd <- boot.probabilities$sd.ci
transitions$cv <- boot.probabilities$cv.ci
ggplot(data = transitions, aes(x = count.antecedent, y = range.ci)) +
geom_point(alpha = 0.5) +
theme_classic() +
ylab("Range Credible Interval") +
xlab("Count Element")
Range of conditional transition probabilities for bigrams, plotted against how often the antecedent occurred in the dataset.
To test which elements reliably follow which others, we have to create a null model of ‘expected’ transitions. To do this, we repeatedly randomize the order of elements across bouts: while the number of elements per bout and the position of breaks and NAs in bouts are kept the same, we randomly assign which element occurs where in which bout. Thus, two elements are considered to transition significantly if the combination is observed more often than would be expected if play elements were just strung together at random. We run 1,000 randomisations (each containing 10 random assignments of co-occurring elements for relevant events) to create the expected distribution for each transition and compare whether the observed transition probability falls within this distribution or not. To compare the observed and expected values, we provide a p-value (how many of the 10,000 randomisations show higher transition probabilities than observed), a z-value (how many standard deviations larger than the expected probabilities were observed values), and the ratio of observed and expected probabilities (e.g., a probability increase of 2 means that the observed probability was twice as large as the expected probability). To be conservative, and given the low robustness of the data, we set the significance level to 0.01 - thus, a transition probability is considered significant if it is larger than 990 out of 1000 random assignments. We also only consider transitions that are based on at least 5 observations of the transition itself. Because of the large number of randomisations, this function is parallelised. For the bag-of-words approach, a randomized_bag_of_words function exists.
Please remember that these analyses are based on resampling, so each user will have slightly different results.
randomizations <- randomized_elem_info(
elem.bout = elements.bout,
antecedent = transitions$antecedent,
consequent = transitions$consequent,
observed = transitions$observed.probs,
it = 10,
cores = 16,
trials = 1000,
type = "across",
output = "expected"
)
transitions$expected.sum <- randomizations$sum
transitions$expected.probs <- round(randomizations$prob, 3)
transitions$pvalue <- round(randomizations$pvalue, 3)
transitions$z <- round(randomizations$z, 3)
transitions$prob.increase <-
round(transitions$observed.probs / transitions$expected.probs, 3)
In total, 146 transitions were significant at 0.01 level and occurred at least 5 times (i.e., we can be very certain that the observed transition probability was outside the expected probability range). This constitutes 9% of all observed, and 5.41% of all possible transitions. Below is a table of all significant transitions, organised by their increase in probability compared to expected. As can be seen, many of those are repeated actions - if we see a chimpanzee player drum a tree, we can be fairly certain that the next move will also involve drumming a tree. Almost all possible elements (51 out of 68) showed at least one significant transition, ranging from 1 to 11. We will explore these connections further later-on when discussing network clusters of transitions - for now, this result confirms our first prediction: There are reliably predictable transition rules between play elements.
| Antecedent | Consequent | Conditional Probability | Expected Conditional Probability | p-value | Increase in Probability |
|---|---|---|---|---|---|
| Kickdirt | Kickdirt | 0.515 | 0.005 | 0.000 | 103.000 |
| Hitobject | Hitobject | 0.368 | 0.007 | 0.000 | 52.571 |
| Branchpull | Branchpull | 0.222 | 0.007 | 0.000 | 31.714 |
| Climb | Fall | 0.153 | 0.007 | 0.000 | 21.857 |
| Hitobject | Exploreobject | 0.147 | 0.008 | 0.000 | 18.375 |
| Slapground | Bow | 0.346 | 0.019 | 0.000 | 18.211 |
| Hideswing | Climb | 0.197 | 0.011 | 0.000 | 17.909 |
| Bow | Slapground | 0.226 | 0.014 | 0.000 | 16.143 |
| Jump | Bendsapling | 0.281 | 0.018 | 0.000 | 15.611 |
| Bendsapling | Jump | 0.093 | 0.006 | 0.000 | 15.500 |
| Embrace | Pressdown | 0.170 | 0.011 | 0.000 | 15.455 |
| Carryobject | Rollobject | 0.090 | 0.006 | 0.000 | 15.000 |
| Hang | Fall | 0.090 | 0.006 | 0.000 | 15.000 |
| Slapground | Slapground | 0.186 | 0.013 | 0.000 | 14.308 |
| DrumTree | DrumTree | 0.300 | 0.021 | 0.000 | 14.286 |
| Kick | Hang | 0.236 | 0.017 | 0.000 | 13.882 |
| Branchshake | Branchshake | 0.110 | 0.008 | 0.000 | 13.750 |
| Bendsapling | Branchpull | 0.095 | 0.007 | 0.000 | 13.571 |
| Mount | Bite | 0.148 | 0.011 | 0.000 | 13.455 |
| Bite | Mount | 0.119 | 0.009 | 0.000 | 13.222 |
| Liedown | GrabbleWrestle | 0.224 | 0.017 | 0.000 | 13.176 |
| Waveobject | Waveobject | 0.115 | 0.009 | 0.000 | 12.778 |
| Hold | Trip | 0.051 | 0.004 | 0.000 | 12.750 |
| Branchpull | Bendsapling | 0.224 | 0.018 | 0.000 | 12.444 |
| Bendsapling | Bendsapling | 0.215 | 0.018 | 0.000 | 11.944 |
| Bendsapling | Branchshake | 0.092 | 0.008 | 0.000 | 11.500 |
| Bite | Bite | 0.137 | 0.012 | 0.000 | 11.417 |
| Hang | Kick | 0.067 | 0.006 | 0.000 | 11.167 |
| Stomp | Stomp | 0.134 | 0.012 | 0.000 | 11.167 |
| Climb | Hang | 0.166 | 0.015 | 0.000 | 11.067 |
| Mount | Pressdown | 0.117 | 0.011 | 0.000 | 10.636 |
| Branchshake | Bendsapling | 0.186 | 0.018 | 0.000 | 10.333 |
| Flee | Armprotect | 0.082 | 0.008 | 0.000 | 10.250 |
| Touch | Touch | 0.109 | 0.011 | 0.000 | 9.909 |
| Shakeoff | Shakeoff | 0.136 | 0.014 | 0.000 | 9.714 |
| Flee | Hideswing | 0.134 | 0.014 | 0.000 | 9.571 |
| Swing | Swing | 0.143 | 0.015 | 0.000 | 9.533 |
| Climb | Swing | 0.132 | 0.014 | 0.000 | 9.429 |
| Hang | Hang | 0.134 | 0.015 | 0.000 | 8.933 |
| Circlepartner | Circlepartner | 0.086 | 0.010 | 0.000 | 8.600 |
| Circletree | Circletree | 0.162 | 0.019 | 0.000 | 8.526 |
| Swing | Hang | 0.135 | 0.016 | 0.000 | 8.438 |
| Branchshake | Swing | 0.114 | 0.014 | 0.000 | 8.143 |
| Hang | Swing | 0.111 | 0.014 | 0.000 | 7.929 |
| FollowOther | Chase | 0.071 | 0.009 | 0.000 | 7.889 |
| Hide | Feint | 0.199 | 0.027 | 0.000 | 7.370 |
| Circletree | Feint | 0.187 | 0.026 | 0.000 | 7.192 |
| Stomp | Bop | 0.086 | 0.012 | 0.000 | 7.167 |
| Mount | GrabbleWrestle | 0.119 | 0.017 | 0.000 | 7.000 |
| Bop | Stomp | 0.080 | 0.012 | 0.001 | 6.667 |
| Bow | Bop | 0.080 | 0.012 | 0.000 | 6.667 |
| Hang | Shakeoff | 0.093 | 0.015 | 0.000 | 6.200 |
| Shakeoff | Hang | 0.099 | 0.016 | 0.000 | 6.188 |
| Approach | Headshake | 0.030 | 0.005 | 0.000 | 6.000 |
| Armswing | Swagger | 0.036 | 0.006 | 0.000 | 6.000 |
| Bop | Bow | 0.114 | 0.019 | 0.000 | 6.000 |
| Carryobject | Carryobject | 0.089 | 0.015 | 0.000 | 5.933 |
| Bendsapling | Stomp | 0.071 | 0.012 | 0.000 | 5.917 |
| Retreatbackwards | Armprotect | 0.053 | 0.009 | 0.000 | 5.889 |
| Feint | Flee | 0.195 | 0.034 | 0.000 | 5.735 |
| Hold | Moveother | 0.017 | 0.003 | 0.000 | 5.667 |
| FollowOther | Circletree | 0.113 | 0.020 | 0.000 | 5.650 |
| Hitattempt | FollowOther | 0.263 | 0.047 | 0.001 | 5.596 |
| Hang | Bendsapling | 0.100 | 0.018 | 0.000 | 5.556 |
| Chase | FollowOther | 0.241 | 0.044 | 0.000 | 5.477 |
| Bite | GrabbleWrestle | 0.087 | 0.016 | 0.003 | 5.437 |
| Bendsapling | Hang | 0.085 | 0.016 | 0.000 | 5.312 |
| Pressdown | GrabbleWrestle | 0.088 | 0.017 | 0.000 | 5.176 |
| FollowOther | Reach | 0.062 | 0.012 | 0.000 | 5.167 |
| GrabbleWrestle | Crouch | 0.072 | 0.014 | 0.000 | 5.143 |
| Hold | Embrace | 0.040 | 0.008 | 0.000 | 5.000 |
| Circletree | Reach | 0.059 | 0.012 | 0.001 | 4.917 |
| Hold | Bite | 0.058 | 0.012 | 0.000 | 4.833 |
| Bite | Pull | 0.101 | 0.021 | 0.000 | 4.810 |
| Pull | Pull | 0.101 | 0.021 | 0.000 | 4.810 |
| Push | Hold | 0.269 | 0.056 | 0.000 | 4.804 |
| Approach | Hitattempt | 0.019 | 0.004 | 0.001 | 4.750 |
| Reach | Circletree | 0.090 | 0.019 | 0.000 | 4.737 |
| Hit | Hit | 0.127 | 0.027 | 0.000 | 4.704 |
| Flee | Climb | 0.051 | 0.011 | 0.000 | 4.636 |
| Stomp | Bendsapling | 0.085 | 0.019 | 0.000 | 4.474 |
| Swagger | Armswing | 0.152 | 0.034 | 0.000 | 4.471 |
| GrabbleWrestle | Shakeoff | 0.061 | 0.014 | 0.000 | 4.357 |
| Reach | Hold | 0.241 | 0.056 | 0.000 | 4.304 |
| Dropobject | Bipedal | 0.333 | 0.078 | 0.000 | 4.269 |
| GrabbleWrestle | Hold | 0.232 | 0.055 | 0.000 | 4.218 |
| Flee | Hide | 0.070 | 0.017 | 0.000 | 4.118 |
| Pirouette | Approach | 0.200 | 0.049 | 0.003 | 4.082 |
| Feint | Circletree | 0.077 | 0.019 | 0.000 | 4.053 |
| Approach | Swagger | 0.028 | 0.007 | 0.000 | 4.000 |
| Bipedal | Flail | 0.028 | 0.007 | 0.000 | 4.000 |
| Crouch | GrabbleWrestle | 0.068 | 0.017 | 0.002 | 4.000 |
| Approach | Carryobject | 0.059 | 0.015 | 0.000 | 3.933 |
| Bow | Stomp | 0.050 | 0.013 | 0.003 | 3.846 |
| Retreat | Carryobject | 0.057 | 0.015 | 0.000 | 3.800 |
| Approach | Grabobject | 0.034 | 0.009 | 0.000 | 3.778 |
| Pull | Hold | 0.211 | 0.056 | 0.000 | 3.768 |
| Bipedal | DrumTree | 0.073 | 0.020 | 0.000 | 3.650 |
| Hideswing | Feint | 0.094 | 0.026 | 0.001 | 3.615 |
| Bipedal | Waveobject | 0.032 | 0.009 | 0.000 | 3.556 |
| Hide | Hide | 0.060 | 0.017 | 0.003 | 3.529 |
| Hide | Flee | 0.123 | 0.035 | 0.000 | 3.514 |
| Fall | Retreat | 0.147 | 0.042 | 0.007 | 3.500 |
| Feint | Circlepartner | 0.035 | 0.010 | 0.006 | 3.500 |
| Feint | Hide | 0.059 | 0.017 | 0.000 | 3.471 |
| Hold | Pressdown | 0.038 | 0.011 | 0.000 | 3.455 |
| FollowOther | Pressground | 0.024 | 0.007 | 0.007 | 3.429 |
| Armswing | Bop | 0.040 | 0.012 | 0.001 | 3.333 |
| Retreat | Shakeoff | 0.050 | 0.015 | 0.000 | 3.333 |
| Bipedal | Armraise | 0.023 | 0.007 | 0.000 | 3.286 |
| Bipedal | Armwave | 0.013 | 0.004 | 0.008 | 3.250 |
| Hit | Pressdown | 0.039 | 0.012 | 0.006 | 3.250 |
| Pressdown | Hold | 0.174 | 0.054 | 0.000 | 3.222 |
| Hit | Hold | 0.177 | 0.056 | 0.000 | 3.161 |
| Hold | Headdown | 0.018 | 0.006 | 0.009 | 3.000 |
| Parry | Retreat | 0.126 | 0.042 | 0.000 | 3.000 |
| Feint | FollowOther | 0.137 | 0.046 | 0.000 | 2.978 |
| Bipedal | Armswing | 0.101 | 0.034 | 0.000 | 2.971 |
| Reach | FollowOther | 0.128 | 0.044 | 0.002 | 2.909 |
| Touch | Hold | 0.160 | 0.055 | 0.002 | 2.909 |
| Hide | Retreat | 0.122 | 0.042 | 0.000 | 2.905 |
| FollowOther | Feint | 0.078 | 0.027 | 0.000 | 2.889 |
| Parry | Hold | 0.164 | 0.057 | 0.000 | 2.877 |
| Approach | FollowOther | 0.132 | 0.046 | 0.000 | 2.870 |
| Bipedal | Hideswing | 0.040 | 0.014 | 0.000 | 2.857 |
| Feint | Retreat | 0.116 | 0.041 | 0.000 | 2.829 |
| Retreatbackwards | Parry | 0.053 | 0.019 | 0.000 | 2.789 |
| Retreatbackwards | Flee | 0.091 | 0.033 | 0.000 | 2.758 |
| Hold | Circlepartner | 0.030 | 0.011 | 0.003 | 2.727 |
| Charge | Bipedal | 0.215 | 0.081 | 0.007 | 2.654 |
| Hold | FollowOther | 0.122 | 0.046 | 0.000 | 2.652 |
| Hold | Mount | 0.021 | 0.008 | 0.010 | 2.625 |
| Hold | Pull | 0.053 | 0.021 | 0.000 | 2.524 |
| Bipedal | Hit | 0.068 | 0.028 | 0.000 | 2.429 |
| Retreatbackwards | Shakeoff | 0.036 | 0.015 | 0.008 | 2.400 |
| Retreat | Flee | 0.081 | 0.034 | 0.001 | 2.382 |
| Carryobject | Bipedal | 0.186 | 0.079 | 0.002 | 2.354 |
| Hold | Crouch | 0.031 | 0.014 | 0.010 | 2.214 |
| Shakeoff | Hold | 0.117 | 0.055 | 0.010 | 2.127 |
| Bipedal | Hold | 0.119 | 0.056 | 0.000 | 2.125 |
| Retreatbackwards | Armswing | 0.071 | 0.034 | 0.000 | 2.088 |
| Flee | Armswing | 0.070 | 0.034 | 0.009 | 2.059 |
| Retreatbackwards | Feint | 0.055 | 0.027 | 0.006 | 2.037 |
| Retreat | Bipedal | 0.158 | 0.078 | 0.000 | 2.026 |
| Bipedal | Retreatbackwards | 0.092 | 0.046 | 0.000 | 2.000 |
| Retreat | Approach | 0.081 | 0.048 | 0.010 | 1.688 |
ggplot(transitions, aes(x = prob.increase)) +
geom_histogram(fill = "grey", bins = 50, color = 'black') +
geom_vline(mapping = aes(xintercept = 1), linetype = 2) +
theme_classic() +
xlab("Ratio Observed/Expected Probabilities")
Distribution of Ratio of Observed and Expected Probabilities
In Table 2, we can see the 140 transitions that occurred at a higher-than-expected rate and occurred at least 5 times (0.0863132% of all transitions). There is a connection between sample size and effect size: very high probability increases are connected to very rare elements. They are also connected to loops: some of the most predictable transitions are between an element and itself (e.g., Kick-dirt), because individuals repeat the action multiple times.
One thing that would be important is whether this number of predictable transitions indicates that it is easy for individuals to predict which elements follows which, and how much flexibility there is in the system. We will test the amount of predictability by applying the transition probabilities directly: we go through the bouts of the dataset one by one, create the probabilities for all other bouts, and then predict the elements of the bout one by one (‘leave-one-out’). So, let’s say we know that the first element in a bout is Approach. We then use the transition probabilities to predict the second element and record whether this prediction was correct. We then take the actual next element to predict the third, and so on. We will test what the expected correct classification would be if the consequent element is only determine by the occurrence probability of each element, without taking transition information into account (null model). The difference between this value and the observed prediction accuracy of the models will tell us how much knowledge of the antecedent increases our predictions. Aside from using one element as antecedent (describing a Markov Process), we will repeat the procedure using two and three elements as antecedents. If the prediction accuracy under those conditions is higher than for one element, this indicates hierarchical processes - for example, if hit leads to hold in 10% of the time, but stare at plus hit leads to hold in 80% of the time, then the preceding element adds information. This hierarchical structure is an important component of human syntax and other action systems, but has not been shown for primate interactions.
loo4 = prediction_loo(
elem.bout = elements.bout,
it = 10,
trials = 100,
cores = 8,
lvl = 4,
out = 20,
prediction = 'product',
ran.method = 'random'
)
prediction.table <-
data.frame(level = seq_along(loo4)-1,
prediction_accuracy =
sapply(loo4, function(x){x$accuracy}),
prediction_accuracy_naive_bayes =
sapply(loo4, function(x){x$naivebayes.accuracy}),
prediction_accuracy_forest =
sapply(loo4, function(x){x$forest.accuracy})
)
kableExtra::kbl(prediction.table,
row.names = F,
caption = "Prediction accuracy of applied transition probabilities at different levels: level 0 is the prediction based on the simple occurrence probability of each element, level 1 has one antecedent element, level 2 has two antecedents, etc",
col.names = c('Level', 'Prediction Accuracy', 'Prediction Accuracy Naive Bayes', 'Prediction Accuracy Random Forest'),
digits = 3)
## Warning in !is.null(rmarkdown::metadata$output) && rmarkdown::metadata$output
## %in% : 'length(x) = 4 > 1' in coercion to 'logical(1)'
| Level | Prediction Accuracy | Prediction Accuracy Naive Bayes | Prediction Accuracy Random Forest |
|---|---|---|---|
| 0 | 0.031 | 0.067 | 0.067 |
| 1 | 0.055 | 0.128 | 0.051 |
| 2 | 0.090 | 0.155 | 0.035 |
| 3 | 0.079 | 0.144 | 0.038 |
| 4 | 0.080 | 0.136 | 0.046 |
We can analyse the usage statistics of each element in this light. We can do this for each element, by studying which elements are likely antecedents and consequents of that element (Fig.3 for feint, showing that it is connect bidirectionally with circle-tree, follow, hide, retreat, and precedes circle-partner and rarely press ground, and follows hide-swing). We can also analyse which elements are used in similar ways and whether we find clusters of similar elements. This is similar to the identification of synonyms in language: for example, the words jump and hop will usually occur in similar situations. We do this by taking the transition probabilities of all elements with all other elements and calculating the distance between elements (Fig. 4). Similarity can be established on the conditional transitions probabilities or mutual information, a measure of how much the presence of one element informs the presence of the other one. Clusters are detected using UMAP dimension reduction algorithm and K-means clustering.
element_plot(
element = "Feint",
antecedent = transitions$antecedent,
consequent = transitions$consequent,
count.antecedent = transitions$count.antecedent,
count.consequent = transitions$count.consequent,
observed.probs = transitions$observed.probs,
pvalue = transitions$pvalue,
cutoff = 5,
significance = 0.01
)$plot
Ego Network of Feint, with elements that are likely to precede and follow it
similar.cluster <- similiarity_clusters(
elem.bout = elements.bout,
measure = c("prob"),
k = NULL,
it = 1000,
facet = FALSE,
level = "bigram",
ran.method = 'random',
n_epochs = 8000,
trials = 1000
)
## Warning: `distinct_()` was deprecated in dplyr 0.7.0.
## Please use `distinct()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.
# similar.cluster$plot.solutions
# similar.cluster$silhouette.check
# similar.cluster$plot.similarity
similar.cluster$dendrogram.plot
Dendrogram of elements with similar usage statistics
What we observe is a relatively good cluster solution (0.8396785); any solution above 0.3 can be considered to show that there is more similarity within than between clusters. There are 12 clusters. These are usually composed of elements that involve similar actions. E.g, there is one containing all push, pull, wrestle, bite etc, so contact play. Another contains hanging and swinging of branches, pulling branches, climbing up etc - play in trees. One contains most of the object-related play, tug-of-war, wave_object etc. Elements in a cluster show similar usage patterns, so elements that fall into the same cluster can act as ‘synonyms’ - whether individuals press down the partner or hold them might not be important for the progression of play. This might also indicate that the coding scheme includes some distinctions that are less relevant for the chimpanzees - for example, rake ground and kick dirt differ in which limb is used, but might be used the same way (to get the partners attention).
Similar usage of some elements is part of the puzzle of how elements are connected, and whether there are ‘games’ in chimpanzee play. The other question is: if elements show similar usage, how are they connected? In Figure 5, we can see a network where the nodes represent the elements and edges represent significant connections. Links are weighted and directed (AB is different from BA), with arrows indicating directionality. To account for uncertainty, we only include significant transitions that occurred at least 5 times. Clusters are represented by different colours.
trans.net <- network_plot(
elem.bout = elements.bout,
edge.weight = "transition",
min.prob = 0,
min.count = 5,
significance = 0.01,
hide_unconnected = T,
link = "weighted",
clusters = T,
plot.bubbles = F,
title = "Transition Network Play Elements",
remove_loops = T,
cores = 16,
plot.layout = 'nicely',
it = 2000
)
trans.net$plot
Transition Network
We can see that, similar to the similarity plot, there are clusters of highly connected elements that transition into each other regularly. It becomes clear that there are some elements (hold,bipedal) that have high usage probability and are at the centre of clusters. In total, 24.6% of transitions occurred within clusters, while 40.1% would be expected - a 1.6 times increase.
Below is a table summarising the cluster assignment for each element for the similarity and transition networks. The interpretation can be found in the manuscript.
| element | k.means.cluster | community |
|---|---|---|
| Approach | 1 | 1 |
| Grabobject | 3 | 1 |
| Hitattempt | 4 | 1 |
| Chase | 8 | 1 |
| Circletree | 8 | 1 |
| FollowOther | 8 | 1 |
| Reach | 8 | 1 |
| Pirouette | 9 | 1 |
| Headshake | 12 | 1 |
| Pressground | 12 | 1 |
| Bipedal | 1 | 2 |
| Armswing | 1 | 2 |
| Armraise | 3 | 2 |
| Carryobject | 3 | 2 |
| DrumTree | 3 | 2 |
| Charge | 4 | 2 |
| Armwave | 4 | 2 |
| Swagger | 4 | 2 |
| Dropobject | 10 | 2 |
| Waveobject | 10 | 2 |
| Flail | 10 | 2 |
| Rollobject | 12 | 2 |
| Branchshake | 5 | 3 |
| Jump | 5 | 3 |
| Branchpull | 5 | 3 |
| Bendsapling | 5 | 3 |
| Embrace | 6 | 4 |
| Moveother | 6 | 4 |
| Bite | 6 | 4 |
| Trip | 6 | 4 |
| GrabbleWrestle | 6 | 4 |
| Pressdown | 6 | 4 |
| Headdown | 6 | 4 |
| Liedown | 6 | 4 |
| Mount | 6 | 4 |
| Crouch | 9 | 4 |
| Hit | 9 | 4 |
| Hold | 9 | 4 |
| Push | 9 | 4 |
| Touch | 9 | 4 |
| Pull | 9 | 4 |
| Slapground | 7 | 5 |
| Stomp | 7 | 5 |
| Bop | 7 | 5 |
| Bow | 7 | 5 |
| Hideswing | 2 | 6 |
| Climb | 5 | 6 |
| Fall | 5 | 6 |
| Swing | 5 | 6 |
| Shakeoff | 9 | 6 |
| Kick | 11 | 6 |
| Hang | 11 | 6 |
| Retreatbackwards | 1 | 7 |
| Retreat | 1 | 7 |
| Feint | 2 | 7 |
| Flee | 2 | 7 |
| Armprotect | 2 | 7 |
| Hide | 2 | 7 |
| Circlepartner | 9 | 7 |
| Parry | 9 | 7 |
| Hitobject | 10 | 7 |
| Exploreobject | 10 | 7 |
| Rock | 4 | NA |
| Stareat | 8 | NA |
| Lead | 8 | NA |
| Jumpon | 11 | NA |
| Kickdirt | 12 | NA |
| Presentbodypart | 12 | NA |