Edward Sharpe & the Magnetic Zeros - Home

library(RISmed)
#get all the pubmed papers returned after searching for 'Magnetoreception' 
papers <- EUtilsSummary("Magnetoreception",
                     type="esearch", db="pubmed", datetype='pdat')
medline <- EUtilsGet(papers)

Looks good, these are all articles I’d expect to find on the subject.

Next let’s see what words are used in the abstract of these papers

library(wordcloud)
library(tm)
#get the abstracts
abstracts <- AbstractText(medline)
#clear out punctuation and common words etc.
wordCorpus <- Corpus(VectorSource(titles))
wordCorpus <- tm_map(wordCorpus, removePunctuation)
wordCorpus <- tm_map(wordCorpus, content_transformer(tolower))
wordCorpus <- tm_map(wordCorpus, removeWords, stopwords("english"))
wordCorpus <- tm_map(wordCorpus, stripWhitespace)
#set a palette
pal <- brewer.pal(9,"Reds")
pal <- pal[-(1:4)]
set.seed(999)
#make the wordcloud
wordcloud(words = wordCorpus, scale=c(5,0.3), max.words=500, random.order=FALSE, 
          rot.per=0.25, use.r.layout=FALSE, colors=pal)

library(ggplot2)
library(ggthemes)
library(dplyr)
#get the years
years <- data.frame(table(YearPubmed(medline)))
  colnames(years)[1] <- "year"
fullyears <- data.frame(year = c(1981:2016))
  fullyears <- merge(fullyears, years, by = "year", all = TRUE)
    fullyears$Freq[is.na(fullyears$Freq)] <- 0
    fullyears$sum <- cumsum(fullyears$Freq)
ggplot(fullyears, aes(x=year, y=sum)) + 
  geom_line(colour = "darkred", size = 2) +
  theme_fivethirtyeight() +
  xlab("Year") + ylab("Total Papers") +
  ggtitle("The Growth of Magnetoreception Research",
          subtitle = "total papers returned searching 'magnetoreception' on pubmed")

Showing a nice exponential growth. There are two main hypothesis of how magnetoreception might occur naturally. The “cryptochrome” hypothesis posits that the Earth’s magnetic field affects the coherence of radical pairs generated in photoreduction via cryptochrome. The “magnetite” hypothesis suggests a lump of the magnetic iron ore magnetite acts as some from of mechanical stress under a magnetic field.

We can grep these out and see the growth of the two fields.

library(data.table)
#get the publication dates as an object
dates <- YearPubmed(medline)
#find when papers mentioning a specific hypothesis in their abstract were published
cryp_dates <- data.frame(table(dates[grep("cryptochrome", abstracts)]))
  colnames(cryp_dates) <- c("year", "cryp_freq")
mag_dates <- data.frame(table(dates[grep("magnetite", abstracts)]))
  colnames(mag_dates) <- c("year", "mag_freq")
#merge this data into the master df
fullyears <- merge(fullyears, mag_dates, all = TRUE, by = "year")
  fullyears$mag_freq[is.na(fullyears$mag_freq)] <- 0
  fullyears$Magnetite <- cumsum(fullyears$mag_freq)
fullyears <- merge(fullyears, cryp_dates, all = TRUE, by = "year")
  fullyears$cryp_freq[is.na(fullyears$cryp_freq)] <- 0
  fullyears$Cryptochrome <- cumsum(fullyears$cryp_freq)
#take out only the sum columns for the hypotheses and melt
hypothesis_years <- fullyears[c(1,5,7)]
  hypothesis_years <- melt(hypothesis_years, id= "year")
#plot
ggplot(hypothesis_years) + 
  geom_line(aes(x = year, y = value, colour = variable), size = 2) +
  scale_colour_manual(values=c("darkgreen","darkblue")) +
  theme_fivethirtyeight() +
  xlab("Year") + ylab("Total Papers") +
  ggtitle("The Growth of Magnetoreception Research",
          subtitle = "total papers mentioning a specific hypothesis in their abstract")

Next I wanted to see how authors interact

LS0tCnRpdGxlOiAiTWFnbmV0b3JlY2VwdGlvbiBhbmQgUHViTWVkIERhdGEgTWFuaXB1bGF0aW9uIgpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sKLS0tCgpbRWR3YXJkIFNoYXJwZSAmIHRoZSBNYWduZXRpYyBaZXJvcyAtIEhvbWVdKGh0dHBzOi8vd3d3LnlvdXR1YmUuY29tL3dhdGNoP3Y9REhFT0ZfcmNORDgpCgpgYGB7cn0KbGlicmFyeShSSVNtZWQpCgojZ2V0IGFsbCB0aGUgcHVibWVkIHBhcGVycyByZXR1cm5lZCBhZnRlciBzZWFyY2hpbmcgZm9yICdNYWduZXRvcmVjZXB0aW9uJyAKcGFwZXJzIDwtIEVVdGlsc1N1bW1hcnkoIk1hZ25ldG9yZWNlcHRpb24iLAogICAgICAgICAgICAgICAgICAgICB0eXBlPSJlc2VhcmNoIiwgZGI9InB1Ym1lZCIsIGRhdGV0eXBlPSdwZGF0JykKCm1lZGxpbmUgPC0gRVV0aWxzR2V0KHBhcGVycykKCiNjaGVjayB3aGF0cyByZXR1cm5lZAp0aXRsZXMgPC0gQXJ0aWNsZVRpdGxlKG1lZGxpbmUpCmhlYWQodGl0bGVzKQpgYGAKCkxvb2tzIGdvb2QsIHRoZXNlIGFyZSBhbGwgYXJ0aWNsZXMgSSdkIGV4cGVjdCB0byBmaW5kIG9uIHRoZSBzdWJqZWN0LgoKTmV4dCBsZXQncyBzZWUgd2hhdCB3b3JkcyBhcmUgdXNlZCBpbiB0aGUgYWJzdHJhY3Qgb2YgdGhlc2UgcGFwZXJzCgpgYGB7ciwgd2FybmluZz1GQUxTRSwgbWVzc2FnZT1GQUxTRX0KbGlicmFyeSh3b3JkY2xvdWQpCmxpYnJhcnkodG0pCgojZ2V0IHRoZSBhYnN0cmFjdHMKYWJzdHJhY3RzIDwtIEFic3RyYWN0VGV4dChtZWRsaW5lKQoKI2NsZWFyIG91dCBwdW5jdHVhdGlvbiBhbmQgY29tbW9uIHdvcmRzIGV0Yy4Kd29yZENvcnB1cyA8LSBDb3JwdXMoVmVjdG9yU291cmNlKHRpdGxlcykpCndvcmRDb3JwdXMgPC0gdG1fbWFwKHdvcmRDb3JwdXMsIHJlbW92ZVB1bmN0dWF0aW9uKQp3b3JkQ29ycHVzIDwtIHRtX21hcCh3b3JkQ29ycHVzLCBjb250ZW50X3RyYW5zZm9ybWVyKHRvbG93ZXIpKQp3b3JkQ29ycHVzIDwtIHRtX21hcCh3b3JkQ29ycHVzLCByZW1vdmVXb3Jkcywgc3RvcHdvcmRzKCJlbmdsaXNoIikpCndvcmRDb3JwdXMgPC0gdG1fbWFwKHdvcmRDb3JwdXMsIHN0cmlwV2hpdGVzcGFjZSkKCiNzZXQgYSBwYWxldHRlCnBhbCA8LSBicmV3ZXIucGFsKDksIlJlZHMiKQpwYWwgPC0gcGFsWy0oMTo0KV0Kc2V0LnNlZWQoOTk5KQoKI21ha2UgdGhlIHdvcmRjbG91ZAp3b3JkY2xvdWQod29yZHMgPSB3b3JkQ29ycHVzLCBzY2FsZT1jKDUsMC4zKSwgbWF4LndvcmRzPTUwMCwgcmFuZG9tLm9yZGVyPUZBTFNFLCAKICAgICAgICAgIHJvdC5wZXI9MC4yNSwgdXNlLnIubGF5b3V0PUZBTFNFLCBjb2xvcnM9cGFsKQpgYGAKCmBgYHtyfQpsaWJyYXJ5KGdncGxvdDIpCmxpYnJhcnkoZ2d0aGVtZXMpCmxpYnJhcnkoZHBseXIpCgojZ2V0IHRoZSB5ZWFycwp5ZWFycyA8LSBkYXRhLmZyYW1lKHRhYmxlKFllYXJQdWJtZWQobWVkbGluZSkpKQogIGNvbG5hbWVzKHllYXJzKVsxXSA8LSAieWVhciIKZnVsbHllYXJzIDwtIGRhdGEuZnJhbWUoeWVhciA9IGMoMTk4MToyMDE2KSkKICBmdWxseWVhcnMgPC0gbWVyZ2UoZnVsbHllYXJzLCB5ZWFycywgYnkgPSAieWVhciIsIGFsbCA9IFRSVUUpCiAgICBmdWxseWVhcnMkRnJlcVtpcy5uYShmdWxseWVhcnMkRnJlcSldIDwtIDAKICAgIGZ1bGx5ZWFycyRzdW0gPC0gY3Vtc3VtKGZ1bGx5ZWFycyRGcmVxKQoKI3Bsb3QKZ2dwbG90KGZ1bGx5ZWFycywgYWVzKHg9eWVhciwgeT1zdW0pKSArIAogIGdlb21fbGluZShjb2xvdXIgPSAiZGFya3JlZCIsIHNpemUgPSAyKSArCiAgdGhlbWVfZml2ZXRoaXJ0eWVpZ2h0KCkgKwogIHhsYWIoIlllYXIiKSArIHlsYWIoIlRvdGFsIFBhcGVycyIpICsKICBnZ3RpdGxlKCJUaGUgR3Jvd3RoIG9mIE1hZ25ldG9yZWNlcHRpb24gUmVzZWFyY2giLAogICAgICAgICAgc3VidGl0bGUgPSAidG90YWwgcGFwZXJzIHJldHVybmVkIHNlYXJjaGluZyAnbWFnbmV0b3JlY2VwdGlvbicgb24gcHVibWVkIikKYGBgCgpTaG93aW5nIGEgbmljZSBleHBvbmVudGlhbCBncm93dGguIFRoZXJlIGFyZSB0d28gbWFpbiBoeXBvdGhlc2lzIG9mIGhvdyBtYWduZXRvcmVjZXB0aW9uIG1pZ2h0IG9jY3VyIG5hdHVyYWxseS4gVGhlICJjcnlwdG9jaHJvbWUiIGh5cG90aGVzaXMgcG9zaXRzIHRoYXQgdGhlIEVhcnRoJ3MgbWFnbmV0aWMgZmllbGQgYWZmZWN0cyB0aGUgY29oZXJlbmNlIG9mIHJhZGljYWwgcGFpcnMgZ2VuZXJhdGVkIGluIHBob3RvcmVkdWN0aW9uIHZpYSBjcnlwdG9jaHJvbWUuIFRoZSAibWFnbmV0aXRlIiBoeXBvdGhlc2lzIHN1Z2dlc3RzIGEgbHVtcCBvZiB0aGUgbWFnbmV0aWMgaXJvbiBvcmUgbWFnbmV0aXRlIGFjdHMgYXMgc29tZSBmcm9tIG9mIG1lY2hhbmljYWwgc3RyZXNzIHVuZGVyIGEgbWFnbmV0aWMgZmllbGQuCgpXZSBjYW4gZ3JlcCB0aGVzZSBvdXQgYW5kIHNlZSB0aGUgZ3Jvd3RoIG9mIHRoZSB0d28gZmllbGRzLgoKYGBge3IsIHdhcm5pbmc9RkFMU0UsIG1lc3NhZ2U9RkFMU0V9CmxpYnJhcnkoZGF0YS50YWJsZSkKCiNnZXQgdGhlIHB1YmxpY2F0aW9uIGRhdGVzIGFzIGFuIG9iamVjdApkYXRlcyA8LSBZZWFyUHVibWVkKG1lZGxpbmUpCgojZmluZCB3aGVuIHBhcGVycyBtZW50aW9uaW5nIGEgc3BlY2lmaWMgaHlwb3RoZXNpcyBpbiB0aGVpciBhYnN0cmFjdCB3ZXJlIHB1Ymxpc2hlZApjcnlwX2RhdGVzIDwtIGRhdGEuZnJhbWUodGFibGUoZGF0ZXNbZ3JlcCgiY3J5cHRvY2hyb21lIiwgYWJzdHJhY3RzKV0pKQogIGNvbG5hbWVzKGNyeXBfZGF0ZXMpIDwtIGMoInllYXIiLCAiY3J5cF9mcmVxIikKbWFnX2RhdGVzIDwtIGRhdGEuZnJhbWUodGFibGUoZGF0ZXNbZ3JlcCgibWFnbmV0aXRlIiwgYWJzdHJhY3RzKV0pKQogIGNvbG5hbWVzKG1hZ19kYXRlcykgPC0gYygieWVhciIsICJtYWdfZnJlcSIpCgojbWVyZ2UgdGhpcyBkYXRhIGludG8gdGhlIG1hc3RlciBkZgpmdWxseWVhcnMgPC0gbWVyZ2UoZnVsbHllYXJzLCBtYWdfZGF0ZXMsIGFsbCA9IFRSVUUsIGJ5ID0gInllYXIiKQogIGZ1bGx5ZWFycyRtYWdfZnJlcVtpcy5uYShmdWxseWVhcnMkbWFnX2ZyZXEpXSA8LSAwCiAgZnVsbHllYXJzJE1hZ25ldGl0ZSA8LSBjdW1zdW0oZnVsbHllYXJzJG1hZ19mcmVxKQoKZnVsbHllYXJzIDwtIG1lcmdlKGZ1bGx5ZWFycywgY3J5cF9kYXRlcywgYWxsID0gVFJVRSwgYnkgPSAieWVhciIpCiAgZnVsbHllYXJzJGNyeXBfZnJlcVtpcy5uYShmdWxseWVhcnMkY3J5cF9mcmVxKV0gPC0gMAogIGZ1bGx5ZWFycyRDcnlwdG9jaHJvbWUgPC0gY3Vtc3VtKGZ1bGx5ZWFycyRjcnlwX2ZyZXEpCgojdGFrZSBvdXQgb25seSB0aGUgc3VtIGNvbHVtbnMgZm9yIHRoZSBoeXBvdGhlc2VzIGFuZCBtZWx0Cmh5cG90aGVzaXNfeWVhcnMgPC0gZnVsbHllYXJzW2MoMSw1LDcpXQogIGh5cG90aGVzaXNfeWVhcnMgPC0gbWVsdChoeXBvdGhlc2lzX3llYXJzLCBpZD0gInllYXIiKQoKI3Bsb3QKZ2dwbG90KGh5cG90aGVzaXNfeWVhcnMpICsgCiAgZ2VvbV9saW5lKGFlcyh4ID0geWVhciwgeSA9IHZhbHVlLCBjb2xvdXIgPSB2YXJpYWJsZSksIHNpemUgPSAyKSArCiAgc2NhbGVfY29sb3VyX21hbnVhbCh2YWx1ZXM9YygiZGFya2dyZWVuIiwiZGFya2JsdWUiKSkgKwogIHRoZW1lX2ZpdmV0aGlydHllaWdodCgpICsKICB4bGFiKCJZZWFyIikgKyB5bGFiKCJUb3RhbCBQYXBlcnMiKSArCiAgZ2d0aXRsZSgiVGhlIEdyb3d0aCBvZiBNYWduZXRvcmVjZXB0aW9uIFJlc2VhcmNoIiwKICAgICAgICAgIHN1YnRpdGxlID0gInRvdGFsIHBhcGVycyBtZW50aW9uaW5nIGEgc3BlY2lmaWMgaHlwb3RoZXNpcyBpbiB0aGVpciBhYnN0cmFjdCIpCmBgYAoKTmV4dCBJIHdhbnRlZCB0byBzZWUgaG93IGF1dGhvcnMgaW50ZXJhY3Q=