suppressPackageStartupMessages(library(tidyverse))

Case study: how do features of nesting female horseshoe crabs influence the number of males found nearby? Today, we’ll check understanding of local regression concepts.

Load the data. Here are the top six rows of 173 rows:

crab <- read_table("https://newonlinecourses.science.psu.edu/stat504/sites/onlinecourses.science.psu.edu.stat504/files/lesson07/crab/index.txt", col_names = FALSE) %>% 
  select(-1) %>% 
  setNames(c("colour","spine","width","weight","n_male")) %>% 
  mutate(colour = factor(colour),
         spine  = factor(spine))
Parsed with column specification:
cols(
  X1 = col_integer(),
  X2 = col_integer(),
  X3 = col_integer(),
  X4 = col_double(),
  X5 = col_double(),
  X6 = col_integer()
)
knitr::kable(head(crab))
colour spine width weight n_male
2 3 28.3 3.05 8
3 3 26.0 2.60 4
3 3 25.6 2.15 0
4 2 21.0 1.85 0
2 3 29.0 3.00 1
1 2 25.0 2.30 3

Predictors: Colour; spine condition; carapace width; weight.

First, let’s see how carapace width influences the mean number of males nearby.

p <- ggplot(crab, aes(width, n_male)) + 
  geom_point(alpha=0.25) +
  labs(x = "Carapace Width", 
       y = "No. males\nnearby") +
  theme_bw() +
  theme(axis.title.y = element_text(angle=0, vjust=0.5))
plotly::ggplotly(p)

Data source: H. Jane Brockmann’s 1996 paper; found online here; another regression demo with this data is found here.

Local Regression Questions

These questions are meant to check your understanding of local regression.

What is the estimated mean number of nearby males for nesting females having a carapace width of 32.5? Use the following methods, by hand.

1. kNN with \(k=3\).

2. Using a moving window with a radius of 2.4.

3. Using a kernel smoother with Gaussian kernel with variance 1.

4. Using local polynomials with a radius of 2.4 and a flat kernel, first with degree 1, then with degree 2.

LS0tCnRpdGxlOiAiSG9yZXNob2UgY3JhYiBjYXNlIHN0dWR5OiBsb2NhbCByZWdyZXNzaW9uIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKZWRpdG9yX29wdGlvbnM6IAogIGNodW5rX291dHB1dF90eXBlOiBpbmxpbmUKLS0tCgpgYGB7cn0Kc3VwcHJlc3NQYWNrYWdlU3RhcnR1cE1lc3NhZ2VzKGxpYnJhcnkodGlkeXZlcnNlKSkKYGBgCgpDYXNlIHN0dWR5OiBob3cgZG8gZmVhdHVyZXMgb2YgbmVzdGluZyBmZW1hbGUgaG9yc2VzaG9lIGNyYWJzIGluZmx1ZW5jZSB0aGUgbnVtYmVyIG9mIG1hbGVzIGZvdW5kIG5lYXJieT8gVG9kYXksIHdlJ2xsIGNoZWNrIHVuZGVyc3RhbmRpbmcgb2YgbG9jYWwgcmVncmVzc2lvbiBjb25jZXB0cy4KCkxvYWQgdGhlIGRhdGEuIEhlcmUgYXJlIHRoZSB0b3Agc2l4IHJvd3Mgb2YgMTczIHJvd3M6CgpgYGB7cn0KY3JhYiA8LSByZWFkX3RhYmxlKCJodHRwczovL25ld29ubGluZWNvdXJzZXMuc2NpZW5jZS5wc3UuZWR1L3N0YXQ1MDQvc2l0ZXMvb25saW5lY291cnNlcy5zY2llbmNlLnBzdS5lZHUuc3RhdDUwNC9maWxlcy9sZXNzb24wNy9jcmFiL2luZGV4LnR4dCIsIGNvbF9uYW1lcyA9IEZBTFNFKSAlPiUgCiAgc2VsZWN0KC0xKSAlPiUgCiAgc2V0TmFtZXMoYygiY29sb3VyIiwic3BpbmUiLCJ3aWR0aCIsIndlaWdodCIsIm5fbWFsZSIpKSAlPiUgCiAgbXV0YXRlKGNvbG91ciA9IGZhY3Rvcihjb2xvdXIpLAogICAgICAgICBzcGluZSAgPSBmYWN0b3Ioc3BpbmUpKQprbml0cjo6a2FibGUoaGVhZChjcmFiKSkKYGBgCgpQcmVkaWN0b3JzOiBDb2xvdXI7IHNwaW5lIGNvbmRpdGlvbjsgY2FyYXBhY2Ugd2lkdGg7IHdlaWdodC4gCgpGaXJzdCwgbGV0J3Mgc2VlIGhvdyBjYXJhcGFjZSB3aWR0aCBpbmZsdWVuY2VzIHRoZSBtZWFuIG51bWJlciBvZiBtYWxlcyBuZWFyYnkuCgpgYGB7ciwgZmlnLndpZHRoPTYsIGZpZy5oZWlnaHQ9M30KcCA8LSBnZ3Bsb3QoY3JhYiwgYWVzKHdpZHRoLCBuX21hbGUpKSArIAogIGdlb21fcG9pbnQoYWxwaGE9MC4yNSkgKwogIGxhYnMoeCA9ICJDYXJhcGFjZSBXaWR0aCIsIAogICAgICAgeSA9ICJOby4gbWFsZXNcbm5lYXJieSIpICsKICB0aGVtZV9idygpICsKICB0aGVtZShheGlzLnRpdGxlLnkgPSBlbGVtZW50X3RleHQoYW5nbGU9MCwgdmp1c3Q9MC41KSkKcGxvdGx5OjpnZ3Bsb3RseShwKQpgYGAKCkRhdGEgc291cmNlOiBbSC4gSmFuZSBCcm9ja21hbm4ncyAxOTk2IHBhcGVyXShodHRwczovL29ubGluZWxpYnJhcnkud2lsZXkuY29tL2RvaS9hYnMvMTAuMTExMS9qLjE0MzktMDMxMC4xOTk2LnRiMDEwOTkueCk7IGZvdW5kIG9ubGluZSBbaGVyZV0oaHR0cHM6Ly9uZXdvbmxpbmVjb3Vyc2VzLnNjaWVuY2UucHN1LmVkdS9zdGF0NTA0L3NpdGVzL29ubGluZWNvdXJzZXMuc2NpZW5jZS5wc3UuZWR1LnN0YXQ1MDQvZmlsZXMvbGVzc29uMDcvY3JhYi9pbmRleC50eHQpOyBhbm90aGVyIHJlZ3Jlc3Npb24gZGVtbyB3aXRoIHRoaXMgZGF0YSBpcyBmb3VuZCBbaGVyZV0oaHR0cHM6Ly9uZXdvbmxpbmVjb3Vyc2VzLnNjaWVuY2UucHN1LmVkdS9zdGF0NTA0L25vZGUvMTY5LykuCgoKIyMgTG9jYWwgUmVncmVzc2lvbiBRdWVzdGlvbnMKClRoZXNlIHF1ZXN0aW9ucyBhcmUgbWVhbnQgdG8gY2hlY2sgeW91ciB1bmRlcnN0YW5kaW5nIG9mIGxvY2FsIHJlZ3Jlc3Npb24uCgpXaGF0IGlzIHRoZSBlc3RpbWF0ZWQgbWVhbiBudW1iZXIgb2YgbmVhcmJ5IG1hbGVzIGZvciBuZXN0aW5nIGZlbWFsZXMgaGF2aW5nIGEgY2FyYXBhY2Ugd2lkdGggb2YgMzIuNT8gVXNlIHRoZSBmb2xsb3dpbmcgbWV0aG9kcywgYnkgaGFuZC4KCjFcLiBrTk4gd2l0aCAkaz0zJC4KCmBgYHtyfQoKYGBgCgoyXC4gVXNpbmcgYSBtb3Zpbmcgd2luZG93IHdpdGggYSByYWRpdXMgb2YgMi40LgoKYGBge3J9CgpgYGAKCjNcLiBVc2luZyBhIGtlcm5lbCBzbW9vdGhlciB3aXRoIEdhdXNzaWFuIGtlcm5lbCB3aXRoIHZhcmlhbmNlIDEuCgpgYGB7cn0KCmBgYAoKNFwuIFVzaW5nIGxvY2FsIHBvbHlub21pYWxzIHdpdGggYSByYWRpdXMgb2YgMi40IGFuZCBhIGZsYXQga2VybmVsLCBmaXJzdCB3aXRoIGRlZ3JlZSAxLCB0aGVuIHdpdGggZGVncmVlIDIuCgpgYGB7cn0KCmBgYAoK