##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
Scrape Data from Assigned Biosample 28560002
# Define URL with Biosample ID added separately (syntax is helpful for later on in markdown file)
KMBpage <- paste0("https://www.ncbi.nlm.nih.gov/biosample/?term=",28560002)
# Store data from webpage
KMBpage2 <- read_html(KMBpage)
# Data from webpage is a table, so scrape using html_table()
KMBtable <- KMBpage2 %>%
html_node("table") %>%
html_table()
# Rename columns in data frame
names(KMBtable)<-c('Question','Response')
# Ensure that column names were changed
head(KMBtable)
## # A tibble: 6 × 2
## Question Response
## <chr> <chr>
## 1 dominant hand I am right handed
## 2 host height 152.4
## 3 life stage Adult
## 4 race Caucasian
## 5 sample name qiita_sid_10317:10317.000101300
## 6 sex female
Scrape Data from Biosamples 31280770-31280775
# Define URLs with specified range of Biosample IDs added separately
rangePage <- paste0("https://www.ncbi.nlm.nih.gov/biosample/?term=",31280770:31280775)
# See how multiple pages loaded into R
rangePage
## [1] "https://www.ncbi.nlm.nih.gov/biosample/?term=31280770"
## [2] "https://www.ncbi.nlm.nih.gov/biosample/?term=31280771"
## [3] "https://www.ncbi.nlm.nih.gov/biosample/?term=31280772"
## [4] "https://www.ncbi.nlm.nih.gov/biosample/?term=31280773"
## [5] "https://www.ncbi.nlm.nih.gov/biosample/?term=31280774"
## [6] "https://www.ncbi.nlm.nih.gov/biosample/?term=31280775"
# Read each URL and extract tables into a list using a loop function
rangePage2 <- map(rangePage, read_html)
# See if the loop was executed correctly and returns HTML structure
rangePage2
## [[1]]
## {html_document}
## <html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
## [1] <head xmlns:xi="http://www.w3.org/2001/XInclude">\n<meta http-equiv="Cont ...
## [2] <body>\n \t<div class="grid">\n\t\t\t<div class="col twelve_col nomarg ...
##
## [[2]]
## {html_document}
## <html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
## [1] <head xmlns:xi="http://www.w3.org/2001/XInclude">\n<meta http-equiv="Cont ...
## [2] <body>\n \t<div class="grid">\n\t\t\t<div class="col twelve_col nomarg ...
##
## [[3]]
## {html_document}
## <html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
## [1] <head xmlns:xi="http://www.w3.org/2001/XInclude">\n<meta http-equiv="Cont ...
## [2] <body>\n \t<div class="grid">\n\t\t\t<div class="col twelve_col nomarg ...
##
## [[4]]
## {html_document}
## <html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
## [1] <head xmlns:xi="http://www.w3.org/2001/XInclude">\n<meta http-equiv="Cont ...
## [2] <body>\n \t<div class="grid">\n\t\t\t<div class="col twelve_col nomarg ...
##
## [[5]]
## {html_document}
## <html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
## [1] <head xmlns:xi="http://www.w3.org/2001/XInclude">\n<meta http-equiv="Cont ...
## [2] <body>\n \t<div class="grid">\n\t\t\t<div class="col twelve_col nomarg ...
##
## [[6]]
## {html_document}
## <html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
## [1] <head xmlns:xi="http://www.w3.org/2001/XInclude">\n<meta http-equiv="Cont ...
## [2] <body>\n \t<div class="grid">\n\t\t\t<div class="col twelve_col nomarg ...
# Use another loop to retrieve table element (one per page) within the list
rangeTables <- map(rangePage2, \(page) {
page |>
html_element("table") |>
html_table()
})
# Rename the columns in each item in the list
renamedRT <- lapply(rangeTables, function(x) {
colnames(x) <- c("Question", "Response")
return(x)
})
# Ensure that column names were changed and overall structure of each item in list is intact
head(renamedRT)
## [[1]]
## # A tibble: 230 × 2
## Question Response
## <chr> <chr>
## 1 dominant hand I am right handed
## 2 environmental medium feces
## 3 environmental package human-gut
## 4 host body habitat UBERON:feces
## 5 host body mass index 21.0
## 6 host body product UBERON:feces
## 7 host tissue sampled UBERON:feces
## 8 host height 162.0
## 9 life stage Adult
## 10 race Hispanic
## # ℹ 220 more rows
##
## [[2]]
## # A tibble: 295 × 2
## Question Response
## <chr> <chr>
## 1 dominant hand I am right handed
## 2 environmental medium feces
## 3 environmental package human-gut
## 4 host body habitat UBERON:feces
## 5 host body mass index 26.0
## 6 host body product UBERON:feces
## 7 host tissue sampled UBERON:feces
## 8 host height 184.0
## 9 life stage Adult
## 10 race Hispanic
## # ℹ 285 more rows
##
## [[3]]
## # A tibble: 293 × 2
## Question Response
## <chr> <chr>
## 1 dominant hand I am left handed
## 2 environmental medium feces
## 3 environmental package human-gut
## 4 host body habitat UBERON:feces
## 5 host body mass index 25.7
## 6 host body product UBERON:feces
## 7 host tissue sampled UBERON:feces
## 8 host height 159.0
## 9 life stage Adult
## 10 race Hispanic
## # ℹ 283 more rows
##
## [[4]]
## # A tibble: 295 × 2
## Question Response
## <chr> <chr>
## 1 dominant hand I am left handed
## 2 environmental medium feces
## 3 environmental package human-gut
## 4 host body habitat UBERON:feces
## 5 host body mass index 25.4
## 6 host body product UBERON:feces
## 7 host tissue sampled UBERON:feces
## 8 host height 166.0
## 9 life stage Adult
## 10 race Hispanic
## # ℹ 285 more rows
##
## [[5]]
## # A tibble: 230 × 2
## Question Response
## <chr> <chr>
## 1 dominant hand I am right handed
## 2 environmental medium feces
## 3 environmental package human-gut
## 4 host body habitat UBERON:feces
## 5 host body mass index 20.4
## 6 host body product UBERON:feces
## 7 host tissue sampled UBERON:feces
## 8 host height 158.0
## 9 life stage Adult
## 10 race Hispanic
## # ℹ 220 more rows
##
## [[6]]
## # A tibble: 293 × 2
## Question Response
## <chr> <chr>
## 1 dominant hand I am right handed
## 2 environmental medium feces
## 3 environmental package human-gut
## 4 host body habitat UBERON:feces
## 5 host body mass index 33.3
## 6 host body product UBERON:feces
## 7 host tissue sampled UBERON:feces
## 8 host height 154.0
## 9 life stage Adult
## 10 race Hispanic
## # ℹ 283 more rows
# Added definitive titles for each item in list
names(renamedRT) <- c("31280770", "31280771", "31280772", "31280773", "31280774", "31280775")
Survey Pie Chart
# Make new data frame using tibble output for responses to "dominant hand" question
## Doing it this way because there are only six responses that need analyzed
RTdf <- data.frame(
Response = c("Right handed", "Left handed"),
Count = c(4, 2)
)
# Create a basic bar plot
pie = ggplot(RTdf, aes(x= "", y = Count, fill = Response)) + geom_bar(stat = "identity", width = 1)
# Convert to pie (polar coordinates) chart and add labels
pie = pie + coord_polar("y", start = 0) + geom_text(aes(label = paste0(round(Count / sum(Count) * 100), "%")), position = position_stack(vjust = 0.5))
# Add color scale
pie = pie + scale_fill_manual(values=c("#2df630", "#2d92f6"))
# Remove labels and only add title
pie = pie + labs(x = NULL, y = NULL, fill = NULL, title = "Dominant Hand")
# Tidy theme
pie = pie + theme_classic() + theme(axis.line = element_blank(),
axis.text = element_blank(),
axis.ticks = element_blank(),
plot.title = element_text(hjust = 0.5, color = "#666666"))
# Plot data
pie
