Chapter_6.Rmd

@@ -9,15 +9,37 @@ 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(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),
+  "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) <- 
- c( "Zuni",
+rev( c( "Zuni",
 "Towway",
 "Kolliwa",
 "Shunnte",
@@ -33,46 +55,60 @@ rownames(dt) <-
 "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)
+series_max <- apply(dt, 2, max)
+ship_gap <- max(dt) * 0.08
+series_left <- c(0, cumsum(series_max[-series_col] + ship_gap))
+series_center <- series_left + series_max / 2
+plot_right <- series_left[series_col] + series_max[series_col]
 
-for (s in seq_len(series_col)) {
+par(las = 1, bty = "n", mar = c(1, 7, 3, 1), xpd = NA)
 plot(
   NA,
-    xlim = c(-(max(dt_pct[,s]/2)),max(dt_pct[,s]/2)),
-    ylim = c(0.5, n_phase + 0.5),
+  xlim = c(0, plot_right),
+  ylim = c(0.5, n_phase + 1.5),
   axes = FALSE,
-    xlab = "Width = relative frequency (%)",
-    ylab = "",
-    main = colnames(dt)[s]
+  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 <- dt_pct[r, s]
+    chip_width <- dt[r, s]
 
     rect(
-      -chip_width / 2,
+      series_center[s] - chip_width / 2,
       chip_bottom,
-      chip_width / 2,
+      series_center[s] + 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)
 }
+
+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 
@@ -81,5 +117,4 @@ A more common wa to represent tht would be to plot the freuecny through time, us
   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.
-
+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.

_output.yml

@@ -1,5 +1,6 @@
 bookdown::gitbook:
   css: book.css
+  code_folding: hide
   split_by: section
   config:
     toc:
@@ -23,4 +24,3 @@ bookdown::gitbook:
       facebook: false
       twitter: false
       all: false
-

book.css

@@ -180,6 +180,43 @@ body,
   box-shadow: 0 1rem 2.5rem rgba(32, 44, 42, 0.12);
 }
 
+.pottery-gallery {
+  display: grid;
+  grid-template-columns: repeat(3, minmax(0, 1fr));
+  gap: 1rem;
+  align-items: end;
+  margin: 2rem 0 0.75rem;
+}
+
+.pottery-gallery figure {
+  margin: 0;
+  text-align: center;
+}
+
+.pottery-gallery img {
+  width: 100%;
+  height: 180px;
+  object-fit: contain;
+  background: transparent;
+  box-shadow: none !important;
+}
+
+.pottery-gallery figcaption {
+  margin-top: 0.65rem;
+  color: var(--teal-dark);
+  font-family: "Fraunces", serif;
+  font-size: 1.1rem;
+  font-weight: 700;
+}
+
+.pottery-credit {
+  margin: 0 0 2rem;
+  color: var(--muted);
+  font-size: 0.72rem;
+  line-height: 1.5;
+  text-align: center;
+}
+
 .book .book-header.fixed {
   background: rgba(247, 241, 229, 0.92);
   border-bottom: 1px solid rgba(216, 203, 184, 0.7);
@@ -194,5 +231,16 @@ body,
   .book .book-body .page-wrapper .page-inner section.normal h1 {
     font-size: 2.6rem;
   }
+
+  .pottery-gallery {
+    gap: 0.4rem;
   }
 
+  .pottery-gallery img {
+    height: 105px;
+  }
+
+  .pottery-gallery figcaption {
+    font-size: 0.82rem;
+  }
+}