artemklevtsov

library(httr)

endpoint <- oauth_endpoints("google")
app <- oauth_app(appname = "my_app",
                 key = "my_key",
                 secret = "my_secret")
scope <- "https://www.googleapis.com/auth/analytics.readonly"
redirect_uri <- "http://shinyapps.io/my_nickname/my_qpp"

authorize_url <- modify_url(endpoint$authorize, query = list(

artemklevtsov

## Load pakcages
library(RGA)
library(stringi)
library(ggplot2)

## Authorisation
authorize()

## Get Profile ID
# Profiles (profiles) list

artemklevtsov

proftable <- function(filename = "Rprof.out", return.calls = FALSE) {
    prof.data <- scan(filename, what = "character", quote = "\"", sep = "\n",
                      strip.white = TRUE, multi.line = FALSE, quiet = TRUE)
    interval <- as.numeric(strsplit(prof.data[1L], split = "=", fixed = TRUE)[[1L]][2L]) / 1e+06
    prof.data <- prof.data[-1L]
    filelines <- grep("^#File", prof.data)
    if (length(filelines)) {
        files <- prof.data[filelines]
        filenames <- gsub("^#File ", "", files)
        prof.data <- prof.data[-filelines]

artemklevtsov

#' @title
#' Evaluate R code and mask the output by a prefix
#' @description
#' Render reproducible example code to Markdown suitable for use in
#' code-oriented websites, such as StackOverflow or GitHub
#' @param expr Any R expression.
#' @param file A connection, or a character string naming the file to write to.
#' If "", print to the standard output connection. If it is "|cmd", the output
#' is piped to the command given by ‘cmd’.
#' @param prefix The prefix to be put before source code output.

artemklevtsov

desc_stats_by <- function(x, ...) {
    UseMethod("desc_stats_by")
}

desc_stats_by.data.frame <- function(x, by, ...) {
    by <- substitute(by)
    if (!is.numeric(by))
        by <- which(names(x) == as.character(by))
    g <- x[, by]
    x <- x[, -by]

artemklevtsov

timer <- R6::R6Class(
    classname = "timer",
    public = list(
        initialize = function(started.at = Sys.time()) {
            private$started.at <- started.at
        },
        elapsed = function() {
            if (!private$suspended)
                secs <- as.double(difftime(Sys.time(), private$started.at, units = "secs"))
            else

artemklevtsov

# Box-Cox transformation
box_cox <- function(x, lambda = 0) {
    stopifnot(is.numeric(x))
    stopifnot(is.numeric(lambda))
    if (lambda == 0)
        x <- log(x)
    else
        x <- (x^lambda - 1L) / lambda
    return(x)
}

artemklevtsov

format_pval <- function(x, cut = 0.05) {
    x <- round(x, 3)
    x[x == 0] <- paste("<span style='color:red;'>&lt;", 0.001, "</span>")
    x[x < cut] <- paste0("<span style='color:red;'>", x[x < cut], "</span>")
    return(x)
}

artemklevtsov

as.data.frame.htest <- function(x) {
    res <- list()
    if (grepl("correlation", x$method) && !is.null(x$estimate))
        res[names(x$estimate)] <- x$estimate
    else if (!is.null(x$statistic))
        res[names(x$statistic)] <- x$statistic
    if (!is.null(x$parameter))
        res[names(x$parameter)] = x$parameter
    if (!is.null(x$p.value)) {
        res$p.value <- x$p.value

artemklevtsov

# Convert camelCase character vector to separated
to_separated <- function(x, sep = ".") {
    x <- gsub("(.)([[:upper:]][[:lower:]]+)", paste0("\\1", sep, "\\2"), x)
    x <- gsub("([[:lower:][:digit:]])([[:upper:]])", paste0("\\1", sep, "\\2"), x)
    x <- gsub(paste0("\\", sep, "+"), sep, x)
    tolower(x)
}

# Convert separated character vector to camelCase
to_camel <- function(x) {