initial commit - d/l kinda done

.Rbuildignore

@@ -0,0 +1,10 @@
+^.*\.Rproj$
+^\.Rproj\.user$
+^\.travis\.yml$
+^README\.*Rmd$
+^README\.*html$
+^NOTES\.*Rmd$
+^NOTES\.*html$
+^\.codecov\.yml$
+^README_files$
+^doc$

.codecov.yml

@@ -0,0 +1 @@
+comment: false

.gitignore

@@ -0,0 +1,8 @@
+.DS_Store
+.Rproj.user
+.Rhistory
+.RData
+.Rproj
+src/*.o
+src/*.so
+src/*.dll

.travis.yml

@@ -0,0 +1,31 @@
+language: r
+
+warnings_are_errors: true
+
+sudo: required
+
+cache: packages
+
+r:
+ - oldrel
+ - release
+ - devel
+
+apt_packages:
+  - libv8-dev
+  - xclip
+
+env:
+ global:
+   - CRAN: http://cran.rstudio.com
+
+after_success:
+  - Rscript -e 'covr::codecov()'
+
+notifications:
+  email:
+    - bob@rud.is
+  irc:
+    channels:
+      - "104.236.112.222#builds"
+    nick: travisci

DESCRIPTION

@@ -0,0 +1,30 @@
+Package: speedtest
+Type: Package
+Title: speedtest title goes here otherwise CRAN checks fail
+Version: 0.1.0
+Date: 2017-11-09
+Authors@R: c(
+    person("Bob", "Rudis", email = "bob@rud.is", role = c("aut", "cre"), 
+           comment = c(ORCID = "0000-0001-5670-2640"))
+  )
+Author: Bob Rudis (bob@rud.is)
+Maintainer: Bob Rudis <bob@rud.is>
+Description: A good description goes here otherwise CRAN checks fail.
+URL: https://github.com/hrbrmstr/speedtest
+BugReports: https://github.com/hrbrmstr/speedtest/issues
+License: AGPL
+Suggests:
+    testthat,
+    covr
+Depends:
+    R (>= 3.2.0)
+Imports:
+    curl,
+    purrr,
+    dplyr,
+    xml2,
+    utils,
+    pingr,
+    urltools,
+    jsonlite
+RoxygenNote: 6.0.1

NAMESPACE

@@ -0,0 +1,20 @@
+# Generated by roxygen2: do not edit by hand
+
+export(spd_best_servers)
+export(spd_closest_servers)
+export(spd_config)
+export(spd_download_test)
+export(spd_servers)
+import(httr)
+import(purrr)
+import(xml2)
+importFrom(curl,curl_fetch_multi)
+importFrom(curl,multi_run)
+importFrom(dplyr,arrange)
+importFrom(dplyr,data_frame)
+importFrom(dplyr,filter)
+importFrom(dplyr,left_join)
+importFrom(jsonlite,fromJSON)
+importFrom(pingr,ping)
+importFrom(urltools,domain)
+importFrom(utils,globalVariables)

NEWS.md

@@ -0,0 +1,2 @@
+0.1.0 
+* Initial release

R/aaa.r

@@ -0,0 +1,3 @@
+utils::globalVariables(
+  c("total", "latency_url", "test_result", "ping_time", "total_time", "retrieval_time",
+    "bw", "size", "secs"))

R/bestest.r

@@ -0,0 +1,52 @@
+#' Find "best" servers (latency-wise) from master server list
+#'
+#' @md
+#' @param servers if not `NULL`, then the data frame from [spd_servers()]. If
+#'        `NULL`, then [spd_servers()] will be called to retrieve the server list.
+#' @param config client configuration retrieved via [spd_config()]. If `NULL` it
+#'        will be retrieved
+#' @return server list in order of latency closeness (retrieval speed column included)
+#' @note the list of target servers will be truncated to the first 10
+#' @export
+spd_best_servers <- function(servers=NULL, config=NULL) {
+
+  if (is.null(config)) config <- spd_config()
+  if (is.null(servers)) servers <- spd_closest_servers(config=config)
+
+  targets <- servers
+
+  if (nrow(targets) > 10) targets <- servers[1:10,]
+
+  .lat_dat <- list()
+
+  .COK <- function(res) {
+    .lat_dat <<- c(.lat_dat, list(res))
+  }
+
+  .CERR <- function(res) { cat("X")}
+
+  targets$latency_url <- file.path(dirname(targets$url), "latency.txt")
+  purrr::walk(targets$latency_url, curl::curl_fetch_multi, .COK, .CERR)
+
+  curl::multi_run()
+
+  purrr::map_df(.lat_dat, ~{
+    data_frame(
+      latency_url = .x$url,
+      ping_time = mean(pingr::ping(urltools::domain(.x$url)), na.rm=TRUE)/1000,
+      total_time = .x$times["total"],
+      retrieval_time = .x$times[6] - .x$times[5],
+      test_result = rawToChar(.x$content)
+    )
+  }) %>%
+  dplyr::filter(!grepl("test=test", retrieval_time)) -> target_df
+
+  # order() is kinda not necessary since the first ones to finish are going to be
+  # in the list first, but it's best to be safe
+
+  dplyr::left_join(target_df, targets, "latency_url") %>%
+    dplyr::arrange(retrieval_time) %>%
+    dplyr::select(-latency_url, -test_result)
+
+}
+

R/closest.r

@@ -0,0 +1,25 @@
+#' #' Find "closest" servers (geography-wise) from master server list
+#'
+#' Uses [ipinfo.io](https://ipinfo.io) to geolocate your external IP address.
+#'
+#' @md
+#' @param servers if not `NULL`, then the data frame from [spd_servers()]. If
+#'        `NULL`, then [spd_servers()] will be called to retrieve the server list.
+#' @param config client configuration retrieved via [spd_config()]. If `NULL` it
+#'        will be retrieved
+#' @return server list in order of geographic closeness
+#' @export
+spd_closest_servers <- function(servers=NULL, config=NULL) {
+
+  if (is.null(config)) config <- spd_config()
+
+  if (is.null(servers)) servers <- spd_servers(config)
+
+  # we don't need great circle for this, just best effort
+  idx <- order(sqrt((servers$lat - as.numeric(config$client$lat))^2 +
+                      (servers$lng - as.numeric(config$client$lon))^2))
+
+  servers[idx,]
+
+}
+

R/config.r

@@ -0,0 +1,19 @@
+#' Retrieve client configuration information for the speedtest
+#'
+#' @export
+spd_config <- function() {
+
+  res <- httr::GET("http://www.speedtest.net/speedtest-config.php")
+
+  httr::stop_for_status(res)
+
+  config <- httr::content(res, as="text")
+  config <- xml2::read_xml(config)
+  config <- xml2::as_list(config)
+  config <- purrr::map(config, function(.x) { c(.x, attributes(.x)) })
+  config$`server-config`$ignoreids <- strsplit(config$`server-config`$ignoreids, ",")[[1]]
+
+  config
+
+}
+

R/download.r

@@ -0,0 +1,37 @@
+#' Download test
+#'
+#' @export
+spd_download_test <- function(server, config=NULL) {
+
+  if (nrow(server) > 1) server <- server[1,]
+
+  server <- unclass(server)
+
+  down_sizes <- c(350, 500, 750, 1000, 1500, 2000, 2500, 3000, 3500, 4000)
+
+  dl_urls <- sprintf("%s/random%sx%s.jpg", dirname(server$url), down_sizes, down_sizes)
+
+  pb <- dplyr::progress_estimated(length(dl_urls))
+  purrr::map(dl_urls, ~{
+    pb$tick()$print()
+    httr::GET(
+      url = .x,
+      httr::add_headers(
+        `Referer` = "http://c.speedtest.net/flash/speedtest.swf",
+        `Cache-Control` = "no-cache"
+      ),
+      httr::user_agent(
+        splashr::ua_macos_chrome
+      ),
+      query=list(ts=as.numeric(Sys.time()))
+    )
+  }) -> dl_resp
+
+  purrr::discard(dl_resp, ~.x$status_code != 200) %>%
+  purrr::map_df(~{
+    list(secs = .x$times[6] - .x$times[5], size = (length(.x$content) + length(.x$header)))
+  }) %>%
+  dplyr::mutate(bw = ((size/secs)*8) / 1024 / 1024) %>%
+  dplyr::summarise(min=min(bw), mean=mean(bw), median=median(bw), max=max(bw), sd=sd(bw), var=var(bw))
+
+}

R/servers.r

@@ -0,0 +1,34 @@
+#' Retrieve a list of SpeedTest servers
+#'
+#' @param config client configuration retrieved via [spd_config()]. If `NULL` it
+#'        will be retrieved
+#' @return data frame
+#' @export
+spd_servers <- function(config=NULL) {
+
+  res <- httr::GET("https://www.speedtest.net/speedtest-servers-static.php")
+
+  httr::stop_for_status(res)
+
+  if (is.null(config)) config <- spd_config()
+
+  httr::content(res, as="text") %>%
+    read_xml() %>%
+    xml2::xml_find_all(xpath="//settings/servers/server") %>%
+    purrr::map_df(~{
+      list(
+        url = xml2::xml_attr(.x, "url") %||% NA_character_,
+        lat = as.numeric(xml2::xml_attr(.x, "lat") %||% NA_real_),
+        lng = as.numeric(xml2::xml_attr(.x, "lon")) %||% NA_real_,
+        name = xml2::xml_attr(.x, "name") %||% NA_character_,
+        country = xml2::xml_attr(.x, "country") %||% NA_character_,
+        cc = xml2::xml_attr(.x, "cc") %||% NA_character_,
+        sponsor = xml2::xml_attr(.x, "sponsor") %||% NA_character_,
+        id = xml2::xml_attr(.x, "id") %||% NA_character_,
+        host = xml2::xml_attr(.x, "host") %||% NA_character_,
+        url2 = xml2::xml_attr(.x, "url2") %||% NA_character_
+      )
+    }) %>%
+    dplyr::filter(!(id %in% config$`server-config`$ignoreids))
+
+}

R/speedtest-package.R

@@ -0,0 +1,13 @@
+#' ...
+#'
+#' @name speedtest
+#' @docType package
+#' @author Bob Rudis (bob@@rud.is)
+#' @import purrr xml2 httr
+#' @importFrom utils globalVariables
+#' @importFrom dplyr left_join arrange filter data_frame
+#' @importFrom jsonlite fromJSON
+#' @importFrom curl curl_fetch_multi multi_run
+#' @importFrom pingr ping
+#' @importFrom urltools domain
+NULL

R/util.r

@@ -0,0 +1 @@
+sGET <- purrr::safely(httr::GET)

README.Rmd

@@ -0,0 +1,32 @@
+---
+output: rmarkdown::github_document
+---
+
+# speedtest
+
+## Description
+
+## What's Inside The Tin
+
+The following functions are implemented:
+
+## Installation
+
+```{r eval=FALSE}
+devtools::install_github("hrbrmstr/speedtest")
+```
+
+```{r message=FALSE, warning=FALSE, error=FALSE, include=FALSE}
+options(width=120)
+```
+
+## Usage
+
+```{r message=FALSE, warning=FALSE, error=FALSE}
+library(speedtest)
+
+# current verison
+packageVersion("speedtest")
+
+```
+