.Rhistory

new_mapping <- ggplot2::aes()
new_mapping
bool_errorbar <- FALSE
upper_var <-
upper_quo %>%
rlang::quo_get_expr() %>%
as.character()
upper_var
names(data)
lower_var <-
lower_quo %>%
rlang::quo_get_expr() %>%
as.character()
lower_var
new_mapping <-
fxGeom_assoc_vars[c("upper", "lower")] %>%
magrittr::set_names(c("ymax", "ymin"))
new_mapping
bool_errorbar <- TRUE
bool_errorbar
if(bool_errorbar) {
ci_nom <-
list(
nomination(
ggplot2::geom_line(),
ggplot2::geom_ribbon(new_mapping, alpha = 0.1)
)
)
}
ci_nom
if(bool_errorbar & n_row < fxGeom_errorbar.threshold) {
errorbar_nom <-
list(
nomination(
ggplot2::geom_point(),
ggplot2::geom_linerange(mapping = new_mapping)
)
)
}
errorbar_nom
nxt <- fxe_layer_complete_nominate(fxGeom("Continuous"), AesName("y"))
nxt <- fxe_layer_complete_nominate(fxGeom("Continuous"), AesName("y"), df)
nxt
c(ci_nom, errorbar_nom, nxt)
c(ci_nom, errorbar_nom, nxt) -> new_nominations
c(ci_nom, errorbar_nom, nxt) -> nominations
# Remove layers without the required aesthetics - not possible for now.
# Removing duplicates does not make sense because every layer is a reference
# class and therefore unique.
# Veto the inapplicable nominees and give the other nominees the corresponding
# votes.
chosen_nomination <- fxi_layer_complete_vote(nominations, mf, data) %>%
unlist(recursive = FALSE)
# Remove layers without the required aesthetics - not possible for now.
# Removing duplicates does not make sense because every layer is a reference
# class and therefore unique.
# Veto the inapplicable nominees and give the other nominees the corresponding
# votes.
chosen_nomination <- tectr:::fxi_layer_complete_vote(nominations, mf, data) %>%
unlist(recursive = FALSE)
chosen_nomination
mf
ggplot(df, mapping) + chosen_nomination
lst_fxGeom <- purrr::map(mf[["fxGeom_class"]], fxGeom)
lst_aesName <- purrr::map(mf[["aes"]], AesName)
lst_fxGeom
lst_aesName
for(i in seq_len(nrow(mf))) {
# Prepare any other arguments for splicing
mf_args <- dplyr::select(mf[i, ], -aes) %>% lst_mf_args()
# Let each aesthetic nominate its potential candidates
new_nominations <- do.call("fxe_layer_complete_nominate",
rlang::list2(fx_geom = lst_fxGeom[[i]],
aes_name = lst_aesName[[i]],
data = data,
!!!mf_args))
purrr::walk(new_nominations, ~ assertthat::assert_that(is_nomination(.)))
nominations <- c(nominations, new_nominations)
}
nominations <- list()
for(i in seq_len(nrow(mf))) {
# Prepare any other arguments for splicing
mf_args <- dplyr::select(mf[i, ], -aes) %>% tectr:::lst_mf_args()
# Let each aesthetic nominate its potential candidates
new_nominations <- do.call("fxe_layer_complete_nominate",
rlang::list2(fx_geom = lst_fxGeom[[i]],
aes_name = lst_aesName[[i]],
data = data,
!!!mf_args))
purrr::walk(new_nominations, ~ assertthat::assert_that(is_nomination(.)))
nominations <- c(nominations, new_nominations)
}
nominations
# Prepare any other arguments for splicing
mf_args <- dplyr::select(mf[i, ], -aes) %>% lst_mf_args()
# Prepare any other arguments for splicing
mf_args <- dplyr::select(mf[i, ], -aes) %>% tectr:::lst_mf_args()
i <- 1
# Prepare any other arguments for splicing
mf_args <- dplyr::select(mf[i, ], -aes) %>% tectr:::lst_mf_args()
mf_args
fxe_layer_complete_nominate(fx_geom = lst_fxGeom[[i]], aes_name = lst_aesName[[i]], data = data, fxGeom_assoc_vars = mf_args$fxGeom_assoc_vars, name = mf_args$name)
methods::getMethod("fxe_layer_complete_nominate", signature = c(fx_geom = "fxGeomContinuousCI", aes_name = "yAesName"))
.local <- function (fx_geom, aes_name, data, ..., name, fxGeom_nominations = NULL,
fxGeom_assoc_vars = NULL, fxGeom_errorbar.threshold = NULL)
{
nxt <- callNextMethod()
if (is.null(fxGeom_errorbar.threshold))
fxGeom_errorbar.threshold <- 200
n_row <- nrow(data)
upper_quo <- fxGeom_assoc_vars[["upper"]]
lower_quo <- fxGeom_assoc_vars[["lower"]]
new_mapping <- ggplot2::aes()
bool_errorbar <- FALSE
if (!is.null(upper_quo)) {
upper_var <- upper_quo %>% rlang::quo_get_expr() %>%
as.character()
if (upper_var %in% names(data)) {
if (!is.null(lower_quo)) {
lower_var <- lower_quo %>% rlang::quo_get_expr() %>%
as.character()
if (lower_var %in% names(data)) {
new_mapping <- fxGeom_assoc_vars[c("upper",
"lower")] %>% magrittr::set_names(c("ymax",
"ymin"))
bool_errorbar <- TRUE
}
}
}
}
if (bool_errorbar) {
ci_nom <- list(nomination(ggplot2::geom_line(), ggplot2::geom_ribbon(new_mapping,
alpha = 0.1)))
}
else ci_nom <- NULL
if (bool_errorbar & n_row < fxGeom_errorbar.threshold) {
errorbar_nom <- list(nomination(ggplot2::geom_point(),
ggplot2::geom_linerange(mapping = new_mapping)))
}
else errorbar_nom <- NULL
c(ci_nom, errorbar_nom, nxt)
}
.local(fxGeom("ContinuousCI"), AesName("y"), df, name = "var", fxGeom_assoc_vars = aes(upper = high, lower = low))
?callNextMethod
nxt <- fxe_layer_complete_nominate(
fxGeom("Continuous"),
AesName("y"),
data, ...)
library(tectr)
fxe_layer_complete_nominate(fx_geom = lst_fxGeom[[i]], aes_name = lst_aesName[[i]], data = data, fxGeom_assoc_vars = mf_args$fxGeom_assoc_vars, name = mf_args$name)
library(tectr)
fxe_layer_complete_nominate(fx_geom = lst_fxGeom[[i]], aes_name = lst_aesName[[i]], data = data, fxGeom_assoc_vars = mf_args$fxGeom_assoc_vars, name = mf_args$name)
.local
ls()
View(dat)
fxe_layer_complete_nominate(fx_geom = lst_fxGeom[[i]], aes_name = lst_aesName[[i]], data = data, fxGeom_assoc_vars = mf_args$fxGeom_assoc_vars, name = mf_args$name)
fxe_layer_complete_nominate(fx_geom = lst_fxGeom[[i]], aes_name = lst_aesName[[i]], data = data, fxGeom_assoc_vars = mf_args$fxGeom_assoc_vars, name = mf_args$name) -> tst
tst
lst_fxGeom[[i]]
lst_aesName[[i]]
i <- 2
lst_fxGeom[[i]]
lst_aesName[[i]]
fxe_layer_complete_nominate(fx_geom = lst_fxGeom[[i]], aes_name = lst_aesName[[i]], data = data, fxGeom_assoc_vars = mf_args$fxGeom_assoc_vars, name = mf_args$name) -> tst
tst
fx_ggplot(df, aes(x = var, y = var))
fx_ggplot(df, aes(x = time, y = var))
library(tectr)
fx_ggplot(df, aes(x = time, y = var))
fx_ggplot(df, aes(x = var, y = var))
library(tectr)
fx_ggplot(df, aes(x = var, y = var))
library(tectr)
fx_ggplot(df, aes(x = var, y = var))
fx_ggplot(df, aes(x = var, y = year))
fx_ggplot(df, aes(x = var, y = time))
library(tectr)
fx_ggplot(df, aes(x = var, y = var))
covr::report()
library(tectr)
fxe_layer_complete_vote(nomination(geom_point()), fxGeom("Continuous"), AesName("y"))
fxe_layer_complete_vote(nomination(geom_point()), fxGeom("Continuous"), AesName("y"), df)
?fxe_layer_complete_vote
get_alpha(1000, 3000, 0.05, 10)
tectr:::get_alpha(1000, 3000, 0.05, 10)
geom_point() -> tst
tst$aes_params
fxe_layer_complete_vote(nomination(geom_boxplot()), fxGeom("Continuous"), AesName("y"), df)
geom_point(alpha = .5) -> tst
tst$aes_params
tst$aes_params$alpha
geom_point() -> tst
tst$aes_params$alpha
library(tectr)
fx_ggplot(df, aes(x = time, y = var))
fx_ggplot(df, aes(x = var, y = var))
?fxe_layer_complete_vote
AesName()
AesName("")
devtools::install_local("C:\Users\samue\Documents\Studium\Statistik\tectr_0.0.0.999.tar.gz")
devtools::install_local("C://Users//samue//Documents//Studium//Statistik//tectr_0.0.0.999.tar.gz")
?install_local
?install
devtools::install()
?fxe_layer_complete_vote
?fxe_layer_complete_vote
library(tectr)
library(tectr)
library(tectr)
?fxe_layer_complete_nominate
library(tectr)
install.packages(c("digest", "later", "magic", "reprex", "spData", "tinytex", "xtable"))
devtools::install()
devtools::check()
devtools::install_github("r-lib/devtools")
devtools::install()
devtools::check()
warnings()
install.packages("devtools")
install.packages("devtools")
devtools::check()
?check
library(tectr)
devtools::check()
?loadNamespace
loadNamespace("devtools")
loadNamespace('devtools')
library(tectr)
.libPaths()
devtools::check()
library(tectr)
devtools::check()
devtools::check()
library(tectr)
library(tectr)
devtools::check()
?install
devtools::install()
library(tectr)
devtools::install_local("tectr_0.0.0.999.zip")
fx_ggplot_columns
devtools::install_github("sflippl/tectr")
?check
tst <- devtools::check()
tst
tst$errors
tst <- devtools::check_cran()
?check_cran
devtools::check_failures('C:/Users/samue/AppData/Local/Temp/RtmpkHmt0j/tectr.Rcheck/00install.out')
tst <- devtools::check_cran()
tst <- devtools::check()
library(tectr)
devtools::check()
library(tectr)
library(tectr)
library(tectr)
devtools::check()
devtools::check()
devtools::check()
devtools::check() -> tst
install.packages("curl")
devtools::check() -> tst
tst$errors
devtools::check() -> tst
devtools::check() -> tst
devtools::check() -> tst
devtools::check() -> tst
devtools::check() -> tst
devtools::check() -> tst
library(tectr)
devtools::check() -> tst
library(tectr)
devtools::check()
library(tectr)
?fxe_layer_single
?fxe_layer_single
library(tectr)
devtools::check() -> tst
tst$errors
package?tectr
?tectr
df <- data.frame(x = 1:10)
fx_ggplot(df, aes(x = x))
library(ggplot2)
fx_ggplot(df, aes(x = x))
df %>% fx_default() %>% mutate_mf(fxGeom_vote = list(function(x) nom_layers(x) %>% map_lgl(~ inherits(.$geom, "GeomPoint"))))
library(tidyverse)
df %>% fx_default() %>% mutate_mf(fxGeom_vote = list(function(x) nom_layers(x) %>% map_lgl(~ inherits(.$geom, "GeomPoint"))))
df %>% fx_default() %>% mutate_mf(fxGeom_vote = list(function(x) nom_layers(x) %>% map_lgl(~ inherits(.$geom, "GeomPoint")))) -> tst
fx_ggplot(tst, aes(x = x))
df %>% fx_default() %>% mutate_mf(fxGeom_vote = list(function(x) nom_layers(x, ...) %>% map_lgl(~ inherits(.$geom, "GeomPoint")))) -> tst
fx_ggplot(tst, aes(x = x))
df %>% fx_default() %>% mutate_mf(fxGeom_vote = list(function(x,...) nom_layers(x) %>% map_lgl(~ inherits(.$geom, "GeomPoint")))) -> tst
fx_ggplot(tst, aes(x = x))
library(tectr)
?geom_blank
library(tectr)
library(tectr)
geom_blank(mapping = aes(group = country_name))
geom_blank(mapping = aes())
aes(x =x) %>% c(aes(y=y))
aes(x =x) %>% c(aes(y=y)) %>% c(aes(x = NULL))
fxe_layer_complete_nominate(
fxGeom("ContinuousCI"),
AesName("y"),
data.frame(upper = 1:10, lower = 1:10),
fxGeom_assoc_vars = ggplot2::aes(upper = upper, lower = lower)) -> tst
aes(x = x) %>% c(aes(y = y))
aes(x = x) %>% c(aes(y = y)) %>% class()
aes(x = x) %>% class()
aes(x = x) %>% c(aes(y = y)) -> tst
tst
class(tst) <- "uneval"
tst
library(tectr)
library(tectr)
covr::report()
library(tectr)
df2 <- data.frame(x = rep(LETTERS[1:5], 2), y = 1:10)
df2
df2 <- df2 %>% mutate_mf(fxGeom_class = c("Discrete", "Time"))
fx_ggplot(df2, aes(x = y, y = x))
veto_lines <- function(nomination, aes_name, ...) {
has_lines <-
nomination %>%
nom_layers() %>%
map_lgl( ~ inherits(.$geom, "GeomPath")) %>%
any()
print(has_lines)
if(aes_name %in% c("x", "y")) return(has_lines)
FALSE
}
df2 <- df2 %>% mutate_mf(fxGeom_class = c("Discrete", "Time"), fxGeom_veto = list(veto_lines, NULL))
fx_ggplot(df2, aes(y = x, x = y))
data <- df2
mapping <- aes(x = y, y = x)
dat <-
data %>%
fx_default(columns = fx_ggplot_columns, ...)
dat <-
data %>%
fx_default(columns = fx_ggplot_columns)
dar
dat
layers <- c(
# At first, we add the geometric information along one dimension
purrr::map(names(mapping), ~ fxi_layer_single(dat, mapping, .)) %>%
unlist(recursive = FALSE),
# Then, we add the geometric information that is dependent on all dimensions
fxi_layer_complete(dat, mapping),
if(length(facet_vars) != 0)
facet_wrap(facet_vars, labeller = fxi_labeller(dat, facet_vars))
else NULL
)
tectr:::fxi_layer_complete(dat, mapping)
data <- dat
mf <- metaframe(data) %>%
dplyr::mutate(name = as.character(name)) %>%
dplyr::inner_join(
dplyr::tibble(aes = names(mapping), name = get_inds(mapping)),
by = "name")
mf <- metaframe(data) %>%
dplyr::mutate(name = as.character(name)) %>%
dplyr::inner_join(
dplyr::tibble(aes = names(mapping), name = tectr:::get_inds(mapping)),
by = "name")
nf
nf
mf
nominations <- fxi_layer_complete_nominate(data, mf)
nominations <- tectr:::fxi_layer_complete_nominate(data, mf)
nominations
chosen_nomination <- tectr:::fxi_layer_complete_vote(nominations, mf, data) %>%
unlist(recursive = FALSE)
chosen_nomination
lst_fxGeom <- purrr::map(mf[["fxGeom_class"]], fxGeom)
lst_aesName <- purrr::map(mf[["aes"]], AesName)
assertthat::assert_that(length(nominations) != 0,
msg = "No nominations have been provided.")
lgl_veto <- FALSE
for(i in seq_len(nrow(mf))) {
mf_args <- dplyr::select(mf[i, ], -aes) %>%
rlang::as_list(.) %>%
purrr::map(1)
lgl_veto <- lgl_veto |
purrr::map_lgl(
nominations,
~ do.call("fxe_layer_complete_veto",
rlang::list2(nomination = ., fx_geom = lst_fxGeom[[i]],
aes_name = lst_aesName[[i]], data = data,
!!!mf_args))
)
}
lgl_veto
fxe_layer_complete_veto(nominations[[2]], lst_fxGeom[[2]], lst_aesName[[2]], data = data, fxGeom_veto = mf$fxGeom_veto)
mf$fxGeom_veto
fxe_layer_complete_veto(nominations[[2]], lst_fxGeom[[1]], lst_aesName[[1]], data = data, fxGeom_veto = mf$fxGeom_veto[[1]])
fxe_layer_complete_veto(nominations[[2]], lst_fxGeom[[1]], lst_aesName[[1]], data = data, fxGeom_veto = mf$fxGeom_veto[[1]]) -> tst
tst
lst_aesName
lst_aesName´[[1]] == y
lst_aesName[[1]] == y
lst_aesName[[1]] == "y"
nomination <- nominations[[2]]
fx_geom <- lst_fxGeom[[1]]
aes_name <- lst_aesName[[1]]
fxGeom_veto <- mf$fxGeom_veto[[1]]
if(is.null(fxGeom_veto)) return(FALSE)
assertthat::assert_that(is.function(fxGeom_veto))
fxGeom_veto(nomination = nomination, aes_name = aes_name,
...)
fxGeom_veto(nomination = nomination, aes_name = aes_name,
)
lst_fxGeom
nxt <- fxe_layer_complete_veto(
nomination, fxGeom("Discrete"), AesName(""), data, fxGeom_veto = mf$fxGeom_veto[[1]]
)
nxt
veto_lines
AesName("")
library(tectr)
library(tectr)
library(tectr)
library(tectr)
fxe_layer_complete_nominate(
fxGeom("OrdinalCI"),
AesName("y"),
data.frame(upper = LETTERS[1:10], lower = LETTERS[1:10]),
fxGeom_assoc_vars = ggplot2::aes(upper = upper, lower = lower)) %>%
length()
)
fxe_layer_complete_nominate(
fxGeom("OrdinalCI"),
AesName("y"),
data.frame(upper = LETTERS[1:10], lower = LETTERS[1:10]),
fxGeom_assoc_vars = ggplot2::aes(upper = upper, lower = lower)) %>%
length()
fxe_layer_complete_nominate(
fxGeom("OrdinalCI"),
AesName("y"),
data.frame(upper = LETTERS[1:10], lower = LETTERS[1:10]),
fxGeom_assoc_vars = ggplot2::aes(upper = upper, lower = lower))
library(tectr)
library(tectr)
fxe_layer_complete_nominate(
fxGeom("OrdinalCI"),
AesName("y"),
data.frame(upper = LETTERS[1:10], lower = LETTERS[1:10]),
fxGeom_assoc_vars = ggplot2::aes(upper = upper, lower = lower))
fxe_layer_complete_veto(nominations[[2]], lst_fxGeom[[1]], lst_aesName[[1]], data = data, fxGeom_veto = mf$fxGeom_veto[[1]]) -> tst
tst
fx_ggplot(data, mapping)
df
metaframe(df)
df <- data.frame(x = 1:10, y = 1:10)
df <- df %>% mutate_mf(fxGeom_class = c("Time", "Continuous"))
df
fx_ggplot(df, aes(x = x, y = y))
df <- df %>% mutate_mf(fxGeom_vote = vote_lines)
df <- df %>% mutate_mf(fxGeom_vote = vote_step)
vote_step <- function(nomination, aes_name, ...) {
if(aes_name != "y") return(0)
has_path <-
nomination %>%
nom_layers() %>%
map_lgl( ~ inherits(.$geom, "GeomStep")) %>%
any()
print(has_path)
4 * has_path
}
df <- df %>% mutate_mf(fxGeom_vote = list(vote_step, NULL))
fx_ggplot(df, aes(x = x, y = y))
vote_step <- function(nomination, aes_name, ...) {
if(aes_name != "y") return(0)
has_path <-
nomination %>%
nom_layers() %>%
map_lgl( ~ inherits(.$geom, "GeomStep")) %>%
any()
print(has_path)
4 * has_path
}
vote_step <- function(nomination, aes_name, ...) {
print(aes_name); if(aes_name != "y") return(0)
has_path <-
nomination %>%
nom_layers() %>%
map_lgl( ~ inherits(.$geom, "GeomStep")) %>%
any()
print(has_path)
4 * has_path
}
fx_ggplot(df, aes(x = x, y = y))
df <- df %>% mutate_mf(fxGeom_vote = list(NULL, vote_step))
fx_ggplot(df, aes(x = x, y = y))
library(tectr)
library(tectr)
library(tectr)
fx_ggplot(df, aes(x = x, y = y))
tectr:::get_alpha
library(tectr)
library(tectr)
library(tectr)
covr::report()
library(tectr)
covr::report()
devtools::check()
library(tectr)
library(tectr)
library(tectr)
library(tectr)
covr::report()