File:Puyuk lake pollen 2.svg
Original file (SVG file, nominally 720 × 900 pixels, file size: 351 KB)
Captions
Captions
Summary[edit]
| Description |
English: Pollen diagram of Puyuk Lake, Alaska, Beringia |
| Date | |
| Source | Own work |
| Author | Merikanto |
This image is based on Neotoma pollen data.
Puyuk Lake
Site ID 1920
Longitude -162,2
Latitude 63,5
Description Maar crater on volcanic island. Physiography: subdued rounded hills and volcanic cones. Surrounding vegetation: mesic low-shrub tundra.
PIs: Ager, Thomas A.
Ager, T.A. 1980. A 16,000 year pollen record from St. Michael Island, Norton Sound, western Alaska. Page 3 in American Quaternary Association, Sixth Biennial Meeting, Abstracts and Program, 18-20 August 1980. Institute for Quaternary Studies, University of Maine, Orono, Maine, USA.
Ager, T.A. 1982. Vegetational history of western Alaska during the WIsconsin glacial interval and the Holocene. Pages 75-93 in D.M. Hopkins, J.V. Matthews, Jr., C.E. Schweger, and S.B. Young, editors. Paleoecology of Beringia. Academic Press, New York, New York, USA.
Ager, T.A., and J.P. Bradbury. 1982. Quaternary history of vegetation and climate of the Yukon Delta-Norton Sound Area. In W.L. Conrad, editor. The United States Geological Survey in Alaska: Accomplishments during 1981. U.S. Geological Survey Circular 868:103-105.
Ager, T.A., and L.B. Brubaker. 1985. Quaternary palynology and vegetational history of Alaska. Pages 353-384 in V.M. Bryant, Jr. and R.G. Holloway, editors. Pollen records of late Quaternary North American sediments. American Association of Stragigraphic Palynologists Foundation, Dallas, Texas, USA.
PIs: Ager, Thomas A.
Ager, T.A. 1980. A 16,000 year pollen record from St. Michael Island, Norton Sound, western Alaska. Page 3 in American Quaternary Association, Sixth Biennial Meeting, Abstracts and Program, 18-20 August 1980. Institute for Quaternary Studies, University of Maine, Orono, Maine, USA.
Ager, T.A. 1982. Vegetational history of western Alaska during the WIsconsin glacial interval and the Holocene. Pages 75-93 in D.M. Hopkins, J.V. Matthews, Jr., C.E. Schweger, and S.B. Young, editors. Paleoecology of Beringia. Academic Press, New York, New York, USA.
Ager, T.A., and J.P. Bradbury. 1982. Quaternary history of vegetation and climate of the Yukon Delta-Norton Sound Area. In W.L. Conrad, editor. The United States Geological Survey in Alaska: Accomplishments during 1981. U.S. Geological Survey Circular 868:103-105.
Ager, T.A., and L.B. Brubaker. 1985. Quaternary palynology and vegetational history of Alaska. Pages 353-384 in V.M. Bryant, Jr. and R.G. Holloway, editors. Pollen records of late Quaternary North American sediments. American Association of Stragigraphic Palynologists Foundation, Dallas, Texas, USA.
- Pollen diagram, arranged by pollen %
- "R" script, uses neotoma, ggplot2 ...
- 22.10.2021 0000.0000
- load packages
library("tidyverse")
library("neotoma")
library("rioja")
- devtools::install_github("richardjtelford/ggpalaeo") #NEW VERSION
library("ggpalaeo") #Need new version
- download data
get_dataset(1987)#check correct site
- A dataset_list containing 1 objects:
- Accessed from 2021-10-22 16:37h to 2021-10-22 16:37h.
- Datasets:
- dataset.id site.name long lat type
- 1987 Puyuk Lake -162.2 63.5 pollen
bambili_raw <- get_download(1987)
- API call was successful. Returned record for Bambili 1
eco_types <- get_table("EcolGroupTypes")
- extract components
cnts = counts(bambili_raw$`1987`) #table of counts
meta = bambili_raw$`1987`$sample.meta #sample depths/ages
taxa = bambili_raw$`1987`$taxon.list %>% #taxon info
mutate_all(as.character) #convert everything from a facto
bambili <- meta %>% select(age, depth) %>%
bind_cols(cnts) %>%
pivot_longer(cols = -c("age", "depth"), names_to = "species", values_to = "count") %>%
left_join(taxa, by = c("species" = "taxon.name"))
bambili %>% count(variable.element)
str(bambili)
- stop(-1)
eco_types %>%
semi_join(bambili, by = c("EcolGroupID" = "ecological.group")) %>%
select(EcolGroupID, EcolGroup)
bambili %>% filter(ecological.group == c("SEED"), count > 0) %>%
select(species, count) %>%
group_by(species) %>%
summarise(n = n(), max = max(count))
- remove unwanted variable.element/ecological.group
- bambili = bambili %>%
- filter(!ecological.group %in% c("AQVP","AQBR", "UNID", "SEED"))
- use `%in%` not `==`
- check count sums
bambili %>%
group_by(depth) %>%
summarise(s = sum(count)) %>%
arrange(s) %>%
slice(1:5)
- calculate percent
bambili = bambili %>%
group_by(depth) %>%
mutate(percent = count/sum(count) * 100)
- remove rare taxa
bambili1 = bambili %>%
group_by(species) %>%
filter(
sum(percent > 0) >= 3, #must be in at least three samples
max(percent) > 3) #must have a max percent > 3
bambili2 <- bambili1 %>%
select(age, depth, species, percent) %>%
pivot_wider(names_from = "species", values_from = "percent")
bambili_spp <- bambili2 %>% select(-age, -depth) %>%
as.data.frame()#needed as strat.plot does not li
- strat.plot
strat.plot(bambili_spp, yvar = bambili2$depth)
p.col <- c(rep("forestgreen", times=7), rep("gold2", times=20))
bambili2 <- bambili1 %>%
mutate(
- make ecological.group a factor with TRSH first
ecological.group = factor(ecological.group, levels = c("TRSH", "UPHE", "VACR", "AQBR", "AQVP", "TARD")),
- ecological.group = factor(ecological.group, levels = c("TRSH","UPHE","AQVP","VACR","AQBR","FUNGI","ALGA","FUNG","AMOE","TARD")),
mean_percent = mean(percent)) %>%
- arrange by ecological.group and mean_percent (largest first)
arrange(ecological.group, desc(mean_percent)) %>%
ungroup() %>%
- make species into a factor so we can perserve the order
mutate(species = factor(species, levels = unique(species)))
bambili2_spp <- bambili2 %>% select(-age, -depth) %>%
as.data.frame()#needed as strat.plot does not li
- reshape using tidyr::spread as pivot_wider (currently?) ignores factor order
bambili3 <- bambili2 %>%
select(age, depth, species, percent) %>%
spread(key = "species", value = "percent")
bambili_spp <- bambili3 %>%
select(-age, -depth) %>%
as.data.frame(bambili_spp)
- set up for ecological group colours
ecological_groups <- bambili2 %>%
distinct(species, ecological.group) %>%
pull(ecological.group)
ecological_colours <- c("green", "yellow", "orange","red")
- mgp <- c(2, 0.25, 0)
svg(filename="./puyuk_lake_pollen_2.svg", width=8, height=10, pointsize=16)
y.scale <- seq(0,18000,2000)
pol.plot <- strat.plot(bambili_spp, yvar=bambili3$age, y.tks=y.scale,
title="Puyuk Lake", ylabel="Age BP", xlabel="Pollen %",
y.rev=TRUE, plot.line=FALSE,
plot.poly=TRUE, plot.bar=TRUE, col.bar="black",
col.poly=ecological_colours[ecological_groups], col.poly.line="black",
xLeft = 0.2, xRight = 0.99, yBottom = 0.07, yTop = 0.7,
scale.percent=TRUE, xSpace=0.01, x.pc.lab=TRUE, x.pc.omit0=TRUE, las=2)
bambili_dist <- dist(sqrt(bambili_spp/100))#chord distance
clust <- chclust(bambili_dist, method = "coniss")
- bstick(clust)#five groups
dev.off()
print(".")
- plot ...
Licensing[edit]
- You are free:
- to share – to copy, distribute and transmit the work
- to remix – to adapt the work
- Under the following conditions:
- attribution – You must give appropriate credit, provide a link to the license, and indicate if changes were made. You may do so in any reasonable manner, but not in any way that suggests the licensor endorses you or your use.
- share alike – If you remix, transform, or build upon the material, you must distribute your contributions under the same or compatible license as the original.
File history
Click on a date/time to view the file as it appeared at that time.
| Date/Time | Thumbnail | Dimensions | User | Comment | |
|---|---|---|---|---|---|
| current | 14:36, 22 October 2021 | | 720 × 900 (351 KB) | Merikanto (talk | contribs) | Uploaded own work with UploadWizard |
You cannot overwrite this file.
File usage on Commons
There are no pages that use this file.
