Nothing
#####---------------------------------------------------------------------------
## check for byte-order-bark
remove_bom <- function(x, encoding=c("UTF-8", "UTF-16LE", "UTF-16BE")) {
encoding <- match.arg(encoding)
line1 <- strsplit(x, "")[[1]]
if(encoding == "UTF-8") {
bom <- rawToChar(as.raw(strtoi(c("EF", "BB", "BF"), base=16L)))
if(grepl(bom, paste0(line1[1:3], collapse=""))) {
line1[1:3] <- ""
x <- paste0(line1, collapse="")
}
} else if(encoding == "UTF-16LE") {
bom <- rawToChar(as.raw(strtoi(c("FF", "FE"), base=16L)))
if(grepl(bom, paste0(line1[1:2], collapse=""))) {
line1[1:2] <- ""
x <- paste0(line1, collapse="")
}
} else if(encoding == "UTF-16BE") {
bom <- rawToChar(as.raw(strtoi(c("FE", "FF"), base=16L)))
if(grepl(bom, paste0(line1[1:2], collapse=""))) {
line1[1:2] <- ""
x <- paste0(line1, collapse="")
}
}
x
}
## parse character vector from ShotMarker CSV file
parse_ShotMarkerCSV <- function(x) {
## remove byte-order-mark from first line if present
x[1] <- remove_bom(x[1])
## session defined by newline + line with non-empty first cell
## in newer versions, lines with only commas have replaced empty lines
idx_empty1 <- !nzchar(x)
idx_empty2 <- vapply(strsplit(x, ","), function(y) { all(!nzchar(y)) }, logical(1))
idx_empty <- idx_empty1 | idx_empty2
idx_have_first <- nzchar(x) & (substr(x, 1, 1) != ",")
sStart <- which(idx_empty)[(which(idx_empty) + 1) %in% which(idx_have_first)] + 1
sLen <- diff(c(sStart, length(x)+1)) # length of sections
if((length(sLen) < 1L) || all(sLen < 1L)) {
stop("No structures found")
}
sessionL <- Map(function(start, len) x[start:(start+len-1)], sStart, sLen)
## extract file header and header info
header <- x[seq_len(sStart[1]-1)] # header
## extract session data
get_coords <- function(session, group) {
# browser()
## extract session info
session_info <- read.csv(text=session[1], header=FALSE,
stringsAsFactors=FALSE)
session_date <- as.Date(strptime(session_info[["V1"]], format="%b %d %Y"))
session_name <- session_info[["V2"]]
dist_start <- regexpr("[[:digit:]]+(mm|m|y|yd|f|ft)", session[1])
dist_len <- attr(dist_start, "match.length")
dist_end <- dist_start + dist_len - 1
session_dist_str <- substring(session[1],
first=dist_start,
last=dist_end)
distnum_start <- regexpr("[[:digit:]]+", session_dist_str)
distnum_len <- attr(distnum_start, "match.length")
distnum_end <- distnum_start + distnum_len - 1
session_dist <- as.numeric(substring(session_dist_str,
first=distnum_start,
last=distnum_end))
distunit_start <- regexpr("(mm|m|y|yd|ft)", session_dist_str)
distunit_len <- attr(distunit_start, "match.length")
distunit_end <- distunit_start + distunit_len - 1
dunits <- c(m="m", mm="mm", y="yd", yd="yd", f="ft", ft="ft")
session_dist_unit <- unname(dunits[substring(session_dist_str,
first=distunit_start,
last=distunit_end)])
## extract individual coordinates / velocity
## do we have avg/sd lines?
have_avg_sd <- any(grepl("avg:,", session)) &&
any(grepl("SD:,", session))
offset_top <- 3 ## session header, newline, coord data
offset_bot <- if(have_avg_sd) { 4 } else { 2 }
coord_txt0 <- session[offset_top:(length(session) - offset_bot)]
## remove initial ,
coord_txt1 <- substring(coord_txt0, 2)
coord_txt2 <- coord_txt1
## all rows except header have trailing ','
coord_txt2[-1] <- substr(coord_txt2[-1], start=1,
stop=nchar(coord_txt2[-1])-1)
shots <- read.csv(text=coord_txt2,
header=TRUE,
stringsAsFactors=FALSE)
if(nrow(shots) < 1L) {
NULL
} else {
shots_date_time <- paste0(session_date, " ", shots[["time"]])
data.frame(group=session_name,
date=session_date,
date.time=as.POSIXct(strptime(shots_date_time,
format="%Y-%m-%d %I:%M:%S %p")),
distance=session_dist,
distance.unit=session_dist_unit,
aim.x=0,
aim.y=0,
point.x=shots[["x..inch."]],
point.y=shots[["y..inch."]],
point.unit="in",
score=shots[["score"]],
velocity=shots[["v..fps."]],
velocity.unit="ft",
stringsAsFactors=FALSE)
}
}
coordL <- Map(get_coords, sessionL, seq_along(sessionL))
coordL <- Filter(Negate(is.null), coordL)
coords <- do.call("rbind", coordL)
return(coords)
}
#####---------------------------------------------------------------------------
## read in ShotMarker backup file
parse_string <- function(s, n) {
dunits <- c(m="m", mm="mm", y="yd", yd="yd", f="ft", ft="ft")
dshots <- as.data.frame(s[["shots"]])
if(nrow(dshots) < 1L) {
NULL
} else {
d <- data.frame(group=s[["name"]],
caliber=s[["bullet"]],
shot=as.character(dshots[["display_text"]]),
date=as.Date(as.POSIXct(dshots[["ts"]] / 1000, origin="1970-01-01")),
date.time= as.POSIXct(dshots[["ts"]] / 1000, origin="1970-01-01"),
distance=s[["dist"]],
distance.unit=unname(dunits[s[["dist_unit"]]]),
aim.x=0,
aim.y=0,
point.x=dshots[["x"]] + s[["cal_x"]],
point.y=dshots[["y"]] + s[["cal_y"]],
point.unit="mm",
velocity=dshots[["v"]],
target=paste0("x_", s[["face_id"]]),
stringsAsFactors=FALSE)
d[["score"]] <- if(hasName(dshots, "score")) {
dshots[["score"]]
} else { NA_integer_ }
## some shots are invalid -> attribute hide = TRUE, otherwise NA
dsub <- if(hasName(dshots, "hide")) {
d[is.na(dshots[["hide"]]) | !dshots[["hide"]], , drop=FALSE]
} else {
d
}
dsub
}
}
parse_ShotMarkerBackup <- function(f) {
## untar backup file into random temp directory
tmpf <- paste0("sm_", gsub("^[^0-9](.+)$", "\\1", tempfile(pattern="", tmpdir="")))
tmpd <- normalizePath(file.path(tempdir(), tmpf), mustWork=FALSE)
untar(f, exdir=tmpd)
Sys.chmod(tmpd, mode="0755")
## read data and archive json structures
## data not always included
## jdata <- jsonlite::read_json(file.path(tmpd, "data.txt"))
jarchive <- jsonlite::read_json(file.path(tmpd, "archive.txt"))
strings <- names(jarchive)
## assume millisecond timestamp
string_dates <- unlist(lapply(strings, function(s) {
as.Date(jarchive[[s]][["ts"]] / (1000*60*60*24) , origin="1970-01-01")
}))
string_times <- unlist(lapply(strings, function(s) {
jarchive[[s]][["time"]]
}))
## zlib files with coordinate data from 1 string/session each
jstringL <- lapply(strings, function(s) {
fzlib <- paste0(tmpd, "/string-", s, ".z")
charstream <- try(readZlib(fzlib))
if(inherits(charstream, "try-error")) {
return(NULL)
} else {
return(jsonlite::fromJSON(charstream))
}
})
DFL <- Map(parse_string, jstringL, seq_along(jstringL))
DFL <- Filter(Negate(is.null), DFL)
DF <- do.call("rbind", DFL)
vunits <- c('fps'="ft", 'ft/s'="ft", 'mps'="m", 'm/s'="m")
## velocity unit -> implied: per second
## even though jdata::velocity_unit is "fps", it's really m/s
DF$velocity.unit <- "m" # unname(vunits[jdata$velocity_unit])
DF
}
## read raw zlib byte stream, decompress and convert to character
readZlib <- function(f) {
con <- file(f, "rb")
on.exit(close(con))
fsize <- file.info(f)$size
frawz <- readBin(con, what="raw", n=fsize)
fraw <- memDecompress(frawz, type="gzip")
rawToChar(fraw)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.