Skip to content

Commit c7ff838

Browse files
a-arnesona-arneson
committed
Adding time-dependent regression materials
Also reproducible report activity!
1 parent f444677 commit c7ff838

10 files changed

Lines changed: 950 additions & 0 deletions

‎VecDyn_Dataset_Access.R‎

Lines changed: 315 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,315 @@
1+
# VecDyn Dataset Access Script
2+
# Usage Instructions at: https://docs.google.com/document/d/1e0WLCyGJZfdzbLneyqfm4yKiTBzBugCvoA4Lu5MnIec/preview
3+
4+
5+
# Settings:
6+
lowercaseVars <<- TRUE
7+
useQA <<- FALSE
8+
9+
10+
getWebData <- function(dataURL) {
11+
if (!"httr" %in% installed.packages()) {
12+
cat("Installing necessary httr library...\n")
13+
install.packages("httr")
14+
}
15+
if (!"jsonlite" %in% installed.packages()) {
16+
cat("Installing necessary jsonlite library...\n")
17+
install.packages("jsonlite")
18+
}
19+
if (!exists("webDataLibrariesOpen")) {
20+
library(httr)
21+
library(jsonlite)
22+
webDataLibrariesOpen <<- TRUE
23+
}
24+
webData <- GET(url = dataURL)
25+
if (status_code(webData) >= 300 || status_code(webData) < 200) {
26+
returnValue <- data.frame(
27+
message = "Data fetch failed.",
28+
HTTPcode = status_code(webData)
29+
)
30+
return(returnValue)
31+
}
32+
returnValue <- fromJSON(
33+
content(webData, "text", encoding = "UTF-8"),
34+
flatten = TRUE
35+
)
36+
return(returnValue)
37+
}
38+
39+
40+
addLeadingZeros <- function(num, digits = 2) {
41+
if (nchar(as.character(num)) >= digits) {
42+
return(as.character(num))
43+
} else {
44+
return(paste(c(rep("0",digits-nchar(as.character(num))),as.character(num)),collapse=""))
45+
}
46+
}
47+
48+
49+
getDataset <- function(ID = -1, safety = TRUE) {
50+
if (safety) {
51+
availableIDs <<- as.integer(getWebData(paste(c(
52+
"https://vectorbyte",
53+
c("-qa","")[as.integer(useQA)],
54+
".crc.nd.edu/portal/api/vecdynbyprovider/?format=json"
55+
), collapse = ""))$ids)
56+
datasetMax <<- max(availableIDs)
57+
datasetMin <<- min(availableIDs)
58+
if (as.integer(ID) %in% availableIDs) {
59+
datasetID <- ID
60+
} else {
61+
while (TRUE) {
62+
Sys.sleep(0.2)
63+
datasetID <- readline(prompt = "Enter a dataset ID: ")
64+
if (as.integer(datasetID) %in% availableIDs) {
65+
break
66+
} else if (as.integer(datasetID) <= datasetMax && as.integer(datasetID) >= datasetMin) {
67+
cat(paste("No dataset was found with ID", datasetID, "\b.\nPlease try again.\n"))
68+
} else {
69+
cat(paste("The dataset ID", datasetID, "is invalid or is out of range.\n"))
70+
cat(paste("Please choose a number between", datasetMin, "and", datasetMax, "\b.\n"))
71+
}
72+
}
73+
}
74+
} else {
75+
datasetID <- ID
76+
}
77+
tryCatch({
78+
dataset <<- read.csv(
79+
paste(
80+
c(
81+
"https://vectorbyte",
82+
c("-qa","")[as.integer(useQA)],
83+
".crc.nd.edu/portal/api/vecdyncsv/?piids=",
84+
datasetID,
85+
"&return_as=csv"
86+
),
87+
collapse = ""
88+
)
89+
)
90+
if (lowercaseVars) {
91+
colnames(dataset) <<- tolower(colnames(dataset))
92+
}
93+
}, warning = function(e) {
94+
cat("Uh Oh!\nAn HTTP error occured and dataset", datasetID, "could not be retrieved.\n")
95+
dataset <<- NA
96+
}, error = function(e) {
97+
cat("Uh Oh!\nAn HTTP error occured and dataset", datasetID, "could not be retrieved.\n")
98+
dataset <<- NA
99+
}, silent = TRUE)
100+
return(dataset)
101+
}
102+
103+
104+
getDatasets <- function(IDS, safety = TRUE, l = 25L) {
105+
Sys.sleep(0.2)
106+
IDs <- IDS
107+
if (length(IDs) > l) {
108+
cat("You may not retrieve more than", l, "datasets at a time.\n")
109+
cat("Would you like to retrieve only the first", l, "datasets?\n")
110+
answer <- tolower(readline())
111+
if (grepl("y", answer) && !grepl("n", answer)) {
112+
IDs <- IDs[1:l]
113+
} else {
114+
return()
115+
}
116+
}
117+
if (safety && length(IDs) > 50) {
118+
cat("Are you sure you want to retrieve all", length(IDs), "datasets?\n")
119+
answer <- tolower(readline())
120+
} else {
121+
answer <- "y"
122+
}
123+
if (grepl("y", answer) && !grepl("n", answer)) {
124+
total <- length(IDs)
125+
setNumber <- 0
126+
datasets <- list()
127+
cat("Retrieving datasets....\n> 00%")
128+
for (datasetID in IDs) {
129+
setNumber <- setNumber + 1
130+
flush.console()
131+
datasets[[setNumber]] <- getDataset(datasetID, FALSE)
132+
# Extend loading bar:
133+
cat("\b\b\b\b\b=")
134+
datasets[[setNumber]] <- datasets[[setNumber]]
135+
if (lowercaseVars) {
136+
colnames(datasets[[setNumber]]) <- tolower(colnames(datasets[[setNumber]]))
137+
}
138+
cat("> ")
139+
flush.console()
140+
# Display new percentage:
141+
cat(addLeadingZeros(floor(100 * setNumber / total)), "\b%")
142+
}
143+
cat("\b\b\b\b\b\b 100% \nData retrieval complete!\n")
144+
return(datasets)
145+
}
146+
}
147+
148+
149+
searchDatasets <- function(KEYWORD = "", safety = TRUE) {
150+
keyword <- KEYWORD
151+
while (nchar(keyword) < 3) {
152+
Sys.sleep(0.2)
153+
keyword <- readline(prompt = "Enter a keyword to search for in all datasets: ")
154+
if (nchar(keyword) < 3) {
155+
cat("Please enter a more descriptive keyword.\n")
156+
}
157+
}
158+
cat("Searching Datasets....\n")
159+
flush.console()
160+
setSearch <- getWebData(
161+
paste(
162+
c(
163+
"https://vectorbyte",
164+
c("-qa","")[as.integer(useQA)],
165+
".crc.nd.edu/portal/api/vecdynbyprovider/?format=json&keywords=",
166+
gsub(" ", "%20", keyword)
167+
),
168+
collapse = ""
169+
)
170+
)
171+
if (as.character(setSearch)[1] == "Data fetch failed.") {
172+
cat("Uh Oh!\nAn HTTP error has occurred:", setSearch$HTTPcode, "\n")
173+
cat("This could be because the search term you entered was too general (too many results).\n")
174+
cat("Please try again:\n")
175+
searchDatasets()
176+
} else {
177+
cat(length(setSearch$ids), "relevant datasets found.\n")
178+
if (length(setSearch$ids) > 0) {
179+
return(getDatasets(setSearch$ids, safety))
180+
} else {
181+
return(list())
182+
}
183+
}
184+
}
185+
186+
187+
searchDatasetsMulti <- function(KEYWORDS = c(), safety = TRUE) {
188+
if (length(KEYWORDS) == 0) {
189+
Sys.sleep(0.2)
190+
cat("Please enter a list of keywords to search for in the datasets:\n")
191+
keywords <- c()
192+
while (length(keywords) == 0) {
193+
keywords <- scan(what = "")
194+
}
195+
} else {
196+
keywords <- KEYWORDS
197+
}
198+
cat("Searching Datasets....\n")
199+
flush.console()
200+
setSearch <- getWebData(
201+
paste(
202+
c(
203+
"https://vectorbyte",
204+
c("-qa","")[as.integer(useQA)],
205+
".crc.nd.edu/portal/api/vecdynbyprovider/?format=json&keywords=",
206+
gsub(" ", "%20", paste(keywords, collapse = "%20"))
207+
),
208+
collapse = ""
209+
)
210+
)
211+
if (as.character(setSearch)[1] == "Data fetch failed.") {
212+
cat("Uh Oh!\nAn HTTP error has occurred:", setSearch$HTTPcode, "\n")
213+
cat("This could be because the search term you entered had too many results or no results.\n")
214+
cat("Please try again:\n")
215+
searchDatasetsMulti()
216+
} else {
217+
cat(length(setSearch$ids), "relevant datasets found.\n")
218+
if (length(setSearch$ids) > 0) {
219+
return(getDatasets(setSearch$ids, safety))
220+
} else {
221+
return(list())
222+
}
223+
}
224+
}
225+
226+
227+
smartSearch <- function(VARIABLE_NAME, VARIABLE_VALUE, OPERATOR = "eq", safety = TRUE) {
228+
operator <- tolower(OPERATOR)
229+
if (operator != "contains") {
230+
if (operator == "contain" || operator == "has") { operator <- "contains" }
231+
if (operator == "!contain" || operator == "!contains" || operator == "!has" || operator == "!have" || operator == "does not contain") { operator <- "ncontains" }
232+
if (operator == "=" || operator == "==" || operator == "equal" || operator == "equals") { operator <- "eq" }
233+
if (operator == "!=" || operator == "not" || operator == "!equal" || operator == "!equals") { operator <- "neq" }
234+
if (operator == "starts with" || operator == "start with" || operator == "starts" || operator == "start") { operator <- "sw" }
235+
if (operator == "not start with" || operator == "!start" || operator == "!starts") { operator <- "nsw" }
236+
}
237+
variable_name <- tolower(VARIABLE_NAME)
238+
if (tolower(variable_name) == "species") { variable_name <- "SpeciesName" }
239+
if (tolower(variable_name) == "submittedby") { variable_name <- "provider" }
240+
if (tolower(variable_name) == "who") { variable_name <- "provider" }
241+
cat("Searching Datasets....\n")
242+
flush.console()
243+
setSearch <- getWebData(
244+
paste(
245+
c(
246+
"https://vectorbyte",
247+
c("-qa","")[as.integer(useQA)],
248+
".crc.nd.edu/portal/api/vecdynbyprovider/?format=json&field=",
249+
gsub(" ", "%20", variable_name),
250+
"&operator=",
251+
operator,
252+
"&term=",
253+
gsub(" ", "%20", VARIABLE_VALUE)
254+
),
255+
collapse = ""
256+
)
257+
)
258+
if (as.character(setSearch)[1] == "Data fetch failed.") {
259+
if (setSearch$HTTPcode == 400) {
260+
cat("Uh Oh!\nThe server does not wish to fulfill your request.\n")
261+
cat("This could be because you included unsupported/reserved URL characters, such as:\n")
262+
cat(", ! @ # $ % ^ & : ; \\ \" ' ? / < > emojis etc.\n")
263+
cat("This could also be because too many results matched your search.\n")
264+
if (OPERATOR != "contains") {
265+
cat("This could also very likely be because the operator you entered is not supported.\n")
266+
cat("The following operators are supported by the server:\n")
267+
cat("contains, ncontains (doesn't contain), eq (equal to), neq (not equal to), sw (starts with),\nnsw (doesn't start with), in, nin (not in)\n")
268+
}
269+
} else {
270+
cat("Uh Oh!\nAn HTTP error has occurred:", setSearch$HTTPcode, "\n")
271+
if (setSearch$HTTPcode == 404) {
272+
cat("The most likely reason for this is that no results matched your search.")
273+
}
274+
}
275+
} else {
276+
cat(length(setSearch$ids), "relevant datasets found.\n")
277+
if (length(setSearch$ids) > 0) {
278+
return(getDatasets(setSearch$ids, safety))
279+
} else {
280+
return(list())
281+
}
282+
}
283+
}
284+
285+
286+
pick <- function(SELECTION = 0) {
287+
if (SELECTION == 0) {
288+
cat("MENU:\n [1] Retrieve dataset by ID\n [2] Retrieve datasets by IDs\n [3] Search for datasets by keyword\n [4] Search for datasets by list of keywords\n [5] Search for datasets by variable and value\n")
289+
Sys.sleep(0.25)
290+
answer <- as.integer(readline(prompt = "Enter a number from the menu above to select it. "))
291+
} else {
292+
answer <- SELECTION
293+
}
294+
Sys.sleep(0.25)
295+
if (answer == 1) {
296+
return(getDataset())
297+
}
298+
if (answer == 2) {
299+
cat("Enter a list of dataset IDs below.\n")
300+
datasetIDs <- scan(what = integer())
301+
return(getDatasets(datasetIDs))
302+
}
303+
if (answer == 3) {
304+
return(searchDatasets())
305+
}
306+
if (answer == 4) {
307+
return(searchDatasetsMulti())
308+
}
309+
if (answer == 5) {
310+
vname <- readline(prompt = "Variable Name: ")
311+
Sys.sleep(0.2)
312+
vval <- readline(prompt = "Variable Value: ")
313+
return(smartSearch(vname, vval))
314+
}
315+
}

‎graphics/clipboard-2136995412.png‎

24.8 KB
Loading

‎graphics/clipboard-2237205476.png‎

64.1 KB
Loading

‎graphics/clipboard-2418282490.png‎

36.2 KB
Loading

‎graphics/clipboard-2514654178.png‎

49.7 KB
Loading

‎graphics/clipboard-3536036317.png‎

69.9 KB
Loading

‎graphics/clipboard-659488832.png‎

15.8 KB
Loading

‎graphics/stlPlot.png‎

9.36 KB
Loading

0 commit comments

Comments
 (0)