---
title: "Chapter 6"
---

# Chapter 6

CV transmission etc..

Figure 6.4
kroeber seriation:

<div class="pottery-gallery" aria-label="Examples of the three pottery types">
  <figure>
    <img src="images/chapter-6/black-on-red.jpg" alt="Tusayan Black-on-Red bowl viewed from above">
    <figcaption>Black-on-Red</figcaption>
  </figure>
  <figure>
    <img src="images/chapter-6/three-color.jpg" alt="Fourmile Polychrome bowl">
    <figcaption>Three-Color</figcaption>
  </figure>
  <figure>
    <img src="images/chapter-6/corrugated.jpg" alt="Corrugated pottery jar from New Mexico">
    <figcaption>Corrugated</figcaption>
  </figure>
</div>

<p class="pottery-credit">
Images from Wikimedia Commons:
<a href="https://commons.wikimedia.org/wiki/File:Grand_Canyon_Tusayan_Black_on_Red_bowl.jpg">Tusayan Black-on-Red bowl</a>, Grand Canyon National Park, CC BY 2.0;
<a href="https://commons.wikimedia.org/wiki/File:Fourmile_Polychrome_Bowl,_Anasazi_(Native_American),_1350-1400_C.E.,_02.257.2562.jpg">Fourmile Polychrome bowl</a>, Riggs Pueblo Pottery Fund, no known restrictions;
<a href="https://commons.wikimedia.org/wiki/File:Corrugated_Jar,_950%E2%80%931200_AD,_New_Mexico.jpg">Corrugated jar</a>, Netherzone, CC BY-SA 4.0.
</p>

```{r battleship-seriation, fig.width=7.2, fig.height=4.8, fig.cap=""}
dt <- data.frame(
  "Black-on-Red" = c(2, 4, 3, 3, 2, 4, 3, 9, 2, 6, 5, 3, 7, 0, 0, 0),
  "Three-Color" = c(14, 10, 9, 9, 5, 5, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0),
  "Corrugated" = c(0, 1, 0, 2, 2, 3, 4, 9, 22, 24, 11, 36, 44, 59, 63, 64),
  check.names = FALSE
) #these data are not he original but estimated from the image in Lyman and Harpole 2002
rownames(dt) <- 
rev( c( "Zuni",
"Towway",
"Kolliwa",
"Shunnte",
"Wimmay",
"Mattsak",
"Kyakki",
"Pinnawa",
"Site W",
"Hattsina",
"Kyakki W",
"Shoptlu",
"Hawwik B",
"Te\'alla",
"Site X",
"Tetlnat"
))
ship_cols <- c("#8c6bb1", "#1f77b4", "#ff7f0e")
series_col <- ncol(dt)
n_phase <- nrow(dt)
phase_axis <- seq_len(n_phase)
phase_labels <- rownames(dt)
series_center <- seq_len(series_col)
max_ship_width <- 3.5
ship_widths <- as.matrix(dt) / max(dt[, "Corrugated"]) * max_ship_width
plot_left <- series_center[3] - max_ship_width / 2
plot_right <- series_center[3] + max_ship_width / 2

par(las = 1, bty = "n", mar = c(1, 7, 3, 1), xpd = NA)
plot(
  NA,
  xlim = c(0, plot_right),
  ylim = c(0.5, n_phase + 1.5),
  axes = FALSE,
  xlab = "",
  ylab = ""
)

for (s in seq_len(series_col)) {
  for (r in phase_axis) {
    chip_bottom <- (n_phase - r) + 0.55
    chip_top <- (n_phase - r) + 1.45
    chip_width <- ship_widths[r, s]

    rect(
      series_center[s] - chip_width / 2,
      chip_bottom,
      series_center[s] + chip_width / 2,
      chip_top,
      col = ship_cols[s],
      border = "white"
    )
  }
}

text(
  series_center,
  n_phase + 1.1,
  labels = colnames(dt),
  font = 2,
  cex = 0.9
)
text(
  0,
  n_phase - phase_axis + 1,
  labels = phase_labels,
  pos = 2,
  font = 2,
  cex = 0.9
)
```

A more common wa to represent tht would be to plot the freuecny through time, using 

```{r}
matplot(cbind(1:nrow(dt) ,1:nrow(dt) ,1:nrow(dt)) ,dt,type="l",lwd=3,col=ship_cols,lty=1,ylab="frequency",xlab="time")
```

This should remind you of the plot about changes in allele frequency seen in Chapter 3, we will see later how we can use these description of the data to test hypotheses about the cultural transmission process.