mirror of https://git.sr.ht/~hrbrmstr/speedtest
boB Rudis
7 years ago
commit
8d3bf676b7
25 changed files with 445 additions and 0 deletions
@ -0,0 +1,10 @@ |
|||
^.*\.Rproj$ |
|||
^\.Rproj\.user$ |
|||
^\.travis\.yml$ |
|||
^README\.*Rmd$ |
|||
^README\.*html$ |
|||
^NOTES\.*Rmd$ |
|||
^NOTES\.*html$ |
|||
^\.codecov\.yml$ |
|||
^README_files$ |
|||
^doc$ |
@ -0,0 +1 @@ |
|||
comment: false |
@ -0,0 +1,8 @@ |
|||
.DS_Store |
|||
.Rproj.user |
|||
.Rhistory |
|||
.RData |
|||
.Rproj |
|||
src/*.o |
|||
src/*.so |
|||
src/*.dll |
@ -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 |
@ -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 |
@ -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) |
@ -0,0 +1,2 @@ |
|||
0.1.0 |
|||
* Initial release |
@ -0,0 +1,3 @@ |
|||
utils::globalVariables( |
|||
c("total", "latency_url", "test_result", "ping_time", "total_time", "retrieval_time", |
|||
"bw", "size", "secs")) |
@ -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) |
|||
|
|||
} |
|||
|
@ -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,] |
|||
|
|||
} |
|||
|
@ -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 |
|||
|
|||
} |
|||
|
@ -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)) |
|||
|
|||
} |
@ -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)) |
|||
|
|||
} |
@ -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 |
@ -0,0 +1 @@ |
|||
sGET <- purrr::safely(httr::GET) |
@ -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") |
|||
|
|||
``` |
|||
|
@ -0,0 +1,24 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/bestest.r |
|||
\name{spd_best_servers} |
|||
\alias{spd_best_servers} |
|||
\title{Find "best" servers (latency-wise) from master server list} |
|||
\usage{ |
|||
spd_best_servers(servers = NULL, config = NULL) |
|||
} |
|||
\arguments{ |
|||
\item{servers}{if not \code{NULL}, then the data frame from \code{\link[=spd_servers]{spd_servers()}}. If |
|||
\code{NULL}, then \code{\link[=spd_servers]{spd_servers()}} will be called to retrieve the server list.} |
|||
|
|||
\item{config}{client configuration retrieved via \code{\link[=spd_config]{spd_config()}}. If \code{NULL} it |
|||
will be retrieved} |
|||
} |
|||
\value{ |
|||
server list in order of latency closeness (retrieval speed column included) |
|||
} |
|||
\description{ |
|||
Find "best" servers (latency-wise) from master server list |
|||
} |
|||
\note{ |
|||
the list of target servers will be truncated to the first 10 |
|||
} |
@ -0,0 +1,21 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/closest.r |
|||
\name{spd_closest_servers} |
|||
\alias{spd_closest_servers} |
|||
\title{#' Find "closest" servers (geography-wise) from master server list} |
|||
\usage{ |
|||
spd_closest_servers(servers = NULL, config = NULL) |
|||
} |
|||
\arguments{ |
|||
\item{servers}{if not \code{NULL}, then the data frame from \code{\link[=spd_servers]{spd_servers()}}. If |
|||
\code{NULL}, then \code{\link[=spd_servers]{spd_servers()}} will be called to retrieve the server list.} |
|||
|
|||
\item{config}{client configuration retrieved via \code{\link[=spd_config]{spd_config()}}. If \code{NULL} it |
|||
will be retrieved} |
|||
} |
|||
\value{ |
|||
server list in order of geographic closeness |
|||
} |
|||
\description{ |
|||
Uses \href{https://ipinfo.io}{ipinfo.io} to geolocate your external IP address. |
|||
} |
@ -0,0 +1,11 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/config.r |
|||
\name{spd_config} |
|||
\alias{spd_config} |
|||
\title{Retrieve client configuration information for the speedtest} |
|||
\usage{ |
|||
spd_config() |
|||
} |
|||
\description{ |
|||
Retrieve client configuration information for the speedtest |
|||
} |
@ -0,0 +1,11 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/download.r |
|||
\name{spd_download_test} |
|||
\alias{spd_download_test} |
|||
\title{Download test} |
|||
\usage{ |
|||
spd_download_test(server, config = NULL) |
|||
} |
|||
\description{ |
|||
Download test |
|||
} |
@ -0,0 +1,18 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/servers.r |
|||
\name{spd_servers} |
|||
\alias{spd_servers} |
|||
\title{Retrieve a list of SpeedTest servers} |
|||
\usage{ |
|||
spd_servers(config = NULL) |
|||
} |
|||
\arguments{ |
|||
\item{config}{client configuration retrieved via [spd_config()]. If `NULL` it |
|||
will be retrieved} |
|||
} |
|||
\value{ |
|||
data frame |
|||
} |
|||
\description{ |
|||
Retrieve a list of SpeedTest servers |
|||
} |
@ -0,0 +1,13 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/speedtest-package.R |
|||
\docType{package} |
|||
\name{speedtest} |
|||
\alias{speedtest} |
|||
\alias{speedtest-package} |
|||
\title{...} |
|||
\description{ |
|||
... |
|||
} |
|||
\author{ |
|||
Bob Rudis (bob@rud.is) |
|||
} |
@ -0,0 +1,21 @@ |
|||
Version: 1.0 |
|||
|
|||
RestoreWorkspace: Default |
|||
SaveWorkspace: Default |
|||
AlwaysSaveHistory: Default |
|||
|
|||
EnableCodeIndexing: Yes |
|||
UseSpacesForTab: Yes |
|||
NumSpacesForTab: 2 |
|||
Encoding: UTF-8 |
|||
|
|||
RnwWeave: Sweave |
|||
LaTeX: pdfLaTeX |
|||
|
|||
StripTrailingWhitespace: Yes |
|||
|
|||
BuildType: Package |
|||
PackageUseDevtools: Yes |
|||
PackageInstallArgs: --no-multiarch --with-keep.source |
|||
PackageBuildArgs: --resave-data |
|||
PackageRoxygenize: rd,collate,namespace |
@ -0,0 +1,2 @@ |
|||
library(testthat) |
|||
test_check("speedtest") |
@ -0,0 +1,6 @@ |
|||
context("basic functionality") |
|||
test_that("we can do something", { |
|||
|
|||
#expect_that(some_function(), is_a("data.frame")) |
|||
|
|||
}) |
Loading…
Reference in new issue