-
Notifications
You must be signed in to change notification settings - Fork 0
/
presentation.Rmd
223 lines (151 loc) · 6.47 KB
/
presentation.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
---
title: "A Population Graph based Style Transmission model"
fontsize: 9pt
output:
beamer_presentation:
includes:
in_header: preamble.tex
keep_tex: true
fig_caption: yes
editor_options:
chunk_output_type: console
---
```{r, echo = FALSE}
# https://stackoverflow.com/questions/25646333/code-chunk-font-size-in-rmarkdown-with-knitr-and-latex
def.chunk.hook <- knitr::knit_hooks$get("chunk")
knitr::knit_hooks$set(chunk = function(x, options) {
x <- def.chunk.hook(x, options)
ifelse(options$size != "normalsize", paste0("\\", options$size,"\n\n", x, "\n\n \\normalsize"), x)
})
knitr::opts_chunk$set(echo = TRUE, cache = TRUE)
```
## Cultural Evolution -- Cultural Transmission -- Stylistic Variability
- **Cultural Evolution** theory applies terminology and methods from evolutionary biology to cultural anthropology
- **Cultural Transmission** investigates processes of idea transmission and diffusion of innovation
- Ideas spread in space and time. They exist in **social space** and their spread depends on **social relations**
- The spread of functional and stylistic traits is conceptually different. The fate of stylistic (**selectively neutral**) traits is determined by stochastic processes: **Stylistic Variability**
\usebeamertemplate*{title separator}
- There are many different ways to simulate the spread of **neutral traits**
# Yet another simulation approach: Population Graph based Style Transmission
## Simulation concept: Idea agents in a diachronic population network
**Idea agents**
- Ideas are the **agents**, not humans (*the meme's eye view*)
- Ideas have simple behaviour: **greedy expansion**
- Ideas life in a diachronic **population network**
\usebeamertemplate*{title separator}
**Network world**
- Each **node** represents a **social entity** (**humans**, households, ...)
- Each **edge** represents a **social relationship**
- Social entities **only** have relations to partners in **temporal vicinity**
- Social entities have **stronger** relations to partners in **social vicinity**
## Population generation
- **Populations** are divided into **units** (villages, clans, regions, ...)
- Each **unit** has a `name` and a `size development function` and is made up of **humans**
- Each human has a `year of birth` and a `year of death`
\usebeamertemplate*{title separator}
R package **popgenerator**: https://github.com/nevrome/popgenerator
```{r, eval=FALSE}
popgenerator::init_population_settings() %>%
popgenerator::generate_population()
```
## Population generation: Code sample I
```{r, eval=FALSE}
time <- 1:200
unit_names <- factor(c("group_1", "group_2", "group_3", "group_4"))
unit_size_functions <- list(
"group_1" = function(t) {20 + 0.4 * t},
"group_2" = function(t) {20 + (0.04 * t)^2},
"group_3" = function(t) {50},
"group_4" = function(t) {20 + 15 * log(t)}
)
popgenerator::init_population_settings(
time, unit_names, unit_size_functions,
age_distribution_function, age_range
) %>% popgenerator::generate_population() -> population
```
## Population generation: Result
![](figures/code_sample_I_population_generation.jpg)
## Relations generation
- Each **human** can have multiple **vertical** (Parent-Child) and **horizontal** (Friendship, Teacher-Student, ...) relations
- Relations have a **`weight`**, which will be relevant for the idea transmission
- The amount of **cross-unit relations** depends on a `unit interaction matrix` and `type based interaction probabilities`
\usebeamertemplate*{title separator}
R package **popgenerator**: https://github.com/nevrome/popgenerator
```{r, eval=FALSE}
popgenerator::init_relations_settings() %>%
popgenerator::generate_relations()
```
## Relations generation: Code sample II
```{r, eval=FALSE}
amount_friends <- 10
weight_child_of <- 50
weight_friend <- 10
distance_matrix_equal <- matrix(1, 4, 4) %>% `diag<-`(0)
cross_unit_proportion_child_of <- 0.002
cross_unit_proportion_friend <- 0.01
popgenerator::init_relations_settings(
population, amount_friends, distance_matrix_equal,
cross_unit_proportion_child_of, cross_unit_proportion_friend,
weight_child_of, weight_friend
) %>% popgenerator::generate_relations() -> relations
```
## Relations generation: Result
![](figures/code_sample_II_relations_generation.jpg)
## Idea expansion
- **Ideas** start at some nodes at `t = 0` and expand **greedily** in **cycles**
- Expansion can only happen **along edges**
- Success of conversion depends on **edge `weight`** and **chance**
- The simulation **ends**, when the ideas stop expanding
\usebeamertemplate*{title separator}
C++ CLI program **gluesless**: https://github.com/nevrome/gluesless
(missing: gluesless-R interface)
```{bash, eval=FALSE}
gluesless -pi network.paj -ii idea_config.txt -o output.txt
```
## Idea expansion: Code sample III
```{r, eval=FALSE}
system2(
"../gluesless/build/gluesless",
args = c(
"-pi", graph_file,
"-ii", ideas_file,
"-o", output_file, "-q"
)
)
result <- readLines("tmp_data/gluesless_result.txt")
idea_development <- population %>%
dplyr::mutate(
idea = ifelse(id %in% result_idea_1, "idea_1", "idea_2"),
from = birth_time - abs(birth_time - death_time)/2,
to = death_time
) %>%
aoristAAR::aorist(
split_vars = c("unit", "idea")
)
```
## Idea expansion: Result
![](figures/code_sample_III_idea_generation.jpg)
# What YOU could do now
## Comparing real world time series with simulation results
- Identify processes of fashion change and idea transmission and try to describe them with quantitative (!) **time series**
- Compare these time series and calculate measures of **cultural distance**
- Compare multiple measures of cultural and **spatial distance** to identify **correlation**
\usebeamertemplate*{title separator}
- Explore **models of idea transmission** to understand the **relation of trait distribution and the structure and behaviour of populations**
## Processes of Cultural Transmission: Bronze Age burial rites
\begin{columns}
\begin{column}{0.40\textwidth}
\begin{figure}
\includegraphics{figures/cultrans_bronzeageburials_map_graves.jpeg}
\end{figure}
\vspace{0.5cm}
\footnotesize{Schmid, Evaluating Cultural Transmission in Bronze Age burial rites of Central, Northern and North-western Europe using radiocarbon data, Adaptive Behavior, \textit{forthcoming}}
\end{column}
\begin{column}{0.26\textwidth}
\begin{figure}
\includegraphics{figures/cultrans_bronzeageburials_development_burial_type.jpeg}
\end{figure}
\end{column}
\end{columns}
##
\titlepage