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

# Chapter 6

CV transmission etc..

Figure 6.4
kroeber seriation:

```{r battleship-seriation, fig.width=7.2, fig.height=4.8, fig.cap=""}
dt <- data.frame(
  "Black-on-Red" = c(1,2, 2, 2, 3, 4, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0),
  "Three-Color" = c(0,0, 0, 0, 0, 0, 1, 1, 3, 4, 3, 2, 0, 0, 0, 0),
  "Corrugated" = c(1,1, 0, 1, 2, 3, 2, 7, 4, 7, 9, 10, 11, 10, 15, 20),
  check.names = FALSE
)
rownames(dt) <- 
 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)

dt_pct <- sweep(as.matrix(dt), 2, colSums(as.matrix(dt)), "/") * 100

par(mfrow = c(1, 3), las = 1, bty = "n", mar = c(0,0, 3,0), oma = c(0, 6, 0, 0),xpd=NA)
phase_axis <- seq_len(n_phase)
phase_labels <- rownames(dt)

for (s in seq_len(series_col)) {
  plot(
    NA,
    xlim = c(-(max(dt_pct[,s]/2)),max(dt_pct[,s]/2)),
    ylim = c(0.5, n_phase + 0.5),
    axes = FALSE,
    xlab = "Width = relative frequency (%)",
    ylab = "",
    main = colnames(dt)[s]
  )

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

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

  if(s==1) 
      text(-(max(dt_pct[,s]/2)),seq((0.55+1.45)/2, (0.55+1.45)/2*n_phase ,length.out=n_phase),phase_labels,pos=2,font=2,cex=1.2)
}
```

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 describption of the data to test hypothese about the cultural transmission process.