Initial version

Author: coatless

NAMESPACE

@@ -0,0 +1,8 @@
+# Generated by roxygen2: do not edit by hand
+
+export(fetch_all_courses)
+export(fetch_department_courses)
+export(fetch_departments)
+export(parse_courses)
+export(read_cache)
+export(write_cache)

R/cache.R

@@ -0,0 +1,34 @@
+#' Write course data to cache
+#'
+#' @param data Course data frame
+#' @param cache_dir Directory to cache results
+#' @param dept Department code
+#' @export
+write_cache <- function(data, cache_dir, dept) {
+  fs::dir_create(cache_dir)
+  jsonlite::write_json(
+    data,
+    fs::path(cache_dir, paste0(dept, ".json")),
+    pretty = TRUE
+  )
+}
+
+#' Read course data from cache
+#'
+#' @param cache_dir Directory containing cached files
+#' @param dept Department code (optional)
+#' @return Data frame of course data
+#' @export
+read_cache <- function(cache_dir, dept = NULL) {
+  if (is.null(dept)) {
+    files <- fs::dir_ls(cache_dir, glob = "*.json")
+    purrr::map_dfr(files, jsonlite::read_json, simplifyVector = TRUE)
+  } else {
+    file <- fs::path(cache_dir, paste0(dept, ".json"))
+    if (fs::file_exists(file)) {
+      jsonlite::read_json(file, simplifyVector = TRUE)
+    } else {
+      stop("Cache file not found for department: ", dept)
+    }
+  }
+}

R/constants.R

@@ -0,0 +1,7 @@
+ENDPOINT <- "https://explorecourses.stanford.edu/"
+DEPARTMENTS_ENDPOINT <- paste0(ENDPOINT, "?view=xml-20140630")
+COURSE_ENDPOINT <- paste0(
+  ENDPOINT,
+  "search?view=xml-20140630&academicYear=&q={name}&",
+  "filter-departmentcode-{name}=on&filter-coursestatus-Active=on"
+)

R/explorecourses-package.R

@@ -0,0 +1,11 @@
+#' Stanford
+#'
+#' This package contains R code specific to the Stanford University
+#' web applications.
+#'
+#' @keywords internal
+"_PACKAGE"
+
+## usethis namespace: start
+## usethis namespace: end
+NULL

R/fetch.R

@@ -0,0 +1,159 @@
+#' Fetch department list from Stanford ExploreCourses
+#'
+#' @param cache_dir Directory to cache results
+#' @return A data frame containing department information
+#' @export
+#' @include constants.R
+fetch_departments <- function(cache_dir = NULL) {
+  req <- httr2::request(DEPARTMENTS_ENDPOINT) |>
+    httr2::req_perform()
+
+  xml_data <- req |>
+    httr2::resp_body_string() |>
+    xml2::read_xml()
+
+  schools <- xml2::xml_find_all(xml_data, "//school")
+
+  departments <- purrr::map_dfr(schools, function(school) {
+    school_name <- xml2::xml_attr(school, "name")
+    deps <- xml2::xml_find_all(school, ".//department")
+
+    purrr::map_dfr(deps, function(dep) {
+      tibble::tibble(
+        name = xml2::xml_attr(dep, "name"),
+        longname = xml2::xml_attr(dep, "longname"),
+        school = school_name
+      )
+    })
+  })
+
+  if (!is.null(cache_dir)) {
+    fs::dir_create(cache_dir)
+    jsonlite::write_json(
+      departments,
+      fs::path(cache_dir, "departments.json"),
+      pretty = TRUE
+    )
+  }
+
+  departments
+}
+
+#' Fetch courses for a specific department
+#'
+#' @param name Department code
+#' @param cache_dir Directory to cache results
+#' @return XML content of courses
+#' @export
+fetch_department_courses <- function(name, cache_dir = NULL) {
+  url <- glue::glue(COURSE_ENDPOINT, name = name)
+
+  req <- httr2::request(url) |>
+    httr2::req_perform()
+
+  content <- httr2::resp_body_string(req)
+
+  if (!is.null(cache_dir)) {
+    fs::dir_create(cache_dir)
+
+    xml_path <- fs::path(cache_dir, paste0(name, ".xml"))
+    readr::write_file(content, xml_path)
+  }
+
+  content
+}
+
+#' Parse course XML into a data frame
+#'
+#' @param xml_content XML content from fetch_department_courses
+#' @return A list of data frames containing course information
+#' @export
+parse_courses <- function(xml_content) {
+  xml_data <- xml2::read_xml(xml_content)
+  courses <- xml2::xml_find_all(xml_data, "//course")
+
+  course_data <- purrr::map_dfr(courses, function(course) {
+    # Basic course info
+    basic_info <- tibble::tibble(
+      objectID = xml2::xml_text(xml2::xml_find_first(course, ".//courseId")),
+      year = xml2::xml_text(xml2::xml_find_first(course, ".//year")),
+      subject = xml2::xml_text(xml2::xml_find_first(course, ".//subject")),
+      code = xml2::xml_text(xml2::xml_find_first(course, ".//code")),
+      title = xml2::xml_text(xml2::xml_find_first(course, ".//title")),
+      description = xml2::xml_text(xml2::xml_find_first(course, ".//description")),
+      units_min = as.numeric(xml2::xml_text(xml2::xml_find_first(course, ".//unitsMin"))),
+      units_max = as.numeric(xml2::xml_text(xml2::xml_find_first(course, ".//unitsMax")))
+    )
+
+    # Get sections
+    sections <- xml2::xml_find_all(course, ".//section")
+    section_data <- purrr::map_dfr(sections, function(section) {
+      section_info <- tibble::tibble(
+        objectID = basic_info$objectID,
+        term = xml2::xml_text(xml2::xml_find_first(section, ".//term")),
+        term_id = xml2::xml_text(xml2::xml_find_first(section, ".//termId")),
+        section_number = xml2::xml_text(xml2::xml_find_first(section, ".//sectionNumber")),
+        component = xml2::xml_text(xml2::xml_find_first(section, ".//component")),
+        class_id = xml2::xml_text(xml2::xml_find_first(section, ".//classId")),
+        current_size = as.numeric(xml2::xml_text(xml2::xml_find_first(section, ".//currentClassSize"))),
+        max_size = as.numeric(xml2::xml_text(xml2::xml_find_first(section, ".//maxClassSize")))
+      )
+
+      # Get schedules
+      schedules <- xml2::xml_find_all(section, ".//schedule")
+      schedule_data <- purrr::map_dfr(schedules, function(schedule) {
+        tibble::tibble(
+          section_id = section_info$class_id,
+          days = xml2::xml_text(xml2::xml_find_first(schedule, ".//days")),
+          start_time = xml2::xml_text(xml2::xml_find_first(schedule, ".//startTime")),
+          end_time = xml2::xml_text(xml2::xml_find_first(schedule, ".//endTime")),
+          location = xml2::xml_text(xml2::xml_find_first(schedule, ".//location"))
+        )
+      })
+
+      # Join schedules to section
+      if (nrow(schedule_data) > 0) {
+        section_info <- dplyr::left_join(
+          section_info,
+          schedule_data,
+          by = c("class_id" = "section_id")
+        )
+      }
+
+      section_info
+    })
+
+    # Join sections to basic info
+    if (nrow(section_data) > 0) {
+      basic_info <- dplyr::left_join(
+        basic_info,
+        section_data,
+        by = "objectID"
+      )
+    }
+
+    basic_info
+  })
+
+  course_data
+}
+
+#' Fetch and process courses for multiple departments
+#'
+#' @param departments Character vector of department codes
+#' @param cache_dir Directory to cache results
+#' @return A list of data frames containing course information
+#' @export
+fetch_all_courses <- function(departments = NULL, cache_dir = NULL) {
+  if (is.null(departments)) {
+    departments <- fetch_departments(cache_dir)$name
+  }
+
+  purrr::map_dfr(departments, function(dept) {
+    message("Fetching department: ", dept)
+    xml_content <- fetch_department_courses(dept, cache_dir)
+    courses <- parse_courses(xml_content)
+    courses$department <- dept
+    courses
+  })
+}