Kaynağa Gözat

arguments can be now passed to tweak plot details

pull/10/head
David 7 yıl önce
ebeveyn
işleme
a861a5aa67
14 değiştirilmiş dosya ile 143 ekleme ve 101 silme
  1. +9
    -9
      R/animate_helpers.R
  2. +10
    -1
      R/animate_joins.R
  3. +18
    -12
      R/animate_sets.R
  4. +9
    -27
      R/plot_helpers.R
  5. +21
    -9
      R/process_data_helpers.R
  6. +7
    -2
      man/add_color.Rd
  7. +10
    -1
      man/animate_join.Rd
  8. +1
    -1
      man/animate_join_function.Rd
  9. +18
    -12
      man/animate_set.Rd
  10. +1
    -1
      man/animate_set_function.Rd
  11. +0
    -24
      man/base_plot.Rd
  12. +3
    -1
      man/preprocess_data.Rd
  13. +3
    -1
      man/process_data.Rd
  14. +33
    -0
      man/static_plot.Rd

+ 9
- 9
R/animate_helpers.R Dosyayı Görüntüle

#' @param y right dataset #' @param y right dataset
#' @param type type of the set, i.e., intersect, setdiff, etc. #' @param type type of the set, i.e., intersect, setdiff, etc.
#' @param export if the function exports a gif, the first, or last picture #' @param export if the function exports a gif, the first, or last picture
#' @param ... further arguments passed to base_plot
#' @param ... further arguments passed to base_plot or to add_color
#' #'
#' #'
#' @name animate_set_function #' @name animate_set_function
} }


if (type == "union_all") { if (type == "union_all") {
ll <- preprocess_data(x, y, by = names(x), fill = FALSE)
ll <- preprocess_data(x, y, by = names(x), fill = FALSE, ...)
ll <- lapply(ll, function(a) ll <- lapply(ll, function(a)
a %>% mutate(.id_long = paste(.id_long, .side, sep = "-")) a %>% mutate(.id_long = paste(.id_long, .side, sep = "-"))
) )
} else { } else {
ll <- preprocess_data(x, y, by = names(x))
ll <- preprocess_data(x, y, by = names(x), ...)
} }


step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1) step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)
animate_plot(all, title, ...) %>% animate() animate_plot(all, title, ...) %>% animate()
} else if (export == "first") { } else if (export == "first") {
title <- "" title <- ""
base_plot(step0, title, ...)
static_plot(step0, title, ...)
} else if (export == "last") { } else if (export == "last") {
base_plot(step1, title, ...)
static_plot(step1, title, ...)
} }
} }


#' @param by by arguments for the join #' @param by by arguments for the join
#' @param type type of the join, i.e., left_join, right_join, etc. #' @param type type of the join, i.e., left_join, right_join, etc.
#' @param export if the function exports a gif, the first, or last picture #' @param export if the function exports a gif, the first, or last picture
#' @param ... further arguments passed to base_plot
#' @param ... further arguments passed to base_plot or to add_color
#' #'
#' @return either a gif or a ggplot #' @return either a gif or a ggplot
#' #'
y <- dplyr::distinct(y) y <- dplyr::distinct(y)
} }


ll <- preprocess_data(x, y, by)
ll <- preprocess_data(x, y, by, ...)


step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1) step0 <- bind_rows(ll$x, ll$y) %>% mutate(.frame = 0, .alpha = 1)


animate_plot(all, title, ...) %>% animate() animate_plot(all, title, ...) %>% animate()
} else if (export == "first") { } else if (export == "first") {
title <- "" title <- ""
base_plot(step0, title, ...)
static_plot(step0, title, ...)
} else if (export == "last") { } else if (export == "last") {
base_plot(step1, title, ...)
static_plot(step1, title, ...)
} }
} }



+ 10
- 1
R/animate_joins.R Dosyayı Görüntüle

#' animate_left_join(x, y, by = "id") #' animate_left_join(x, y, by = "id")
#' animate_right_join(x, y, by = "id") #' animate_right_join(x, y, by = "id")
#' animate_semi_join(x, y, by = "id") #' animate_semi_join(x, y, by = "id")
#' animate_anti_join(x, y, by = "id")#'
#' animate_anti_join(x, y, by = "id")
#'
#' # further arguments can be passed to all animate_* functions
#' animate_full_join(
#' x, y, by = "id", export = "last",
#' text_size = 5, title_size = 25,
#' color_header = "black",
#' color_other = "lightblue",
#' color_fun = viridis::viridis
#' )
#' } #' }
#' #'
#' # Save the results #' # Save the results

+ 18
- 12
R/animate_sets.R Dosyayı Görüntüle

#' @name animate_set #' @name animate_set
#' @examples #' @examples
#' x <- data_frame( #' x <- data_frame(
#' id = 1:3,
#' x = paste0("x", 1:3)
#' x = c(1, 1, 2),
#' y = c("a", "b", "a")
#' ) #' )
#' y <- data_frame( #' y <- data_frame(
#' id = (1:4)[-3],
#' y = paste0("y", (1:4)[-3])
#' x = c(1, 2),
#' y = c("a", "b")
#' ) #' )
#' #'
#' animate_union(x, y, by = "id", export = "first")
#' animate_union(x, y, by = "id", export = "last")
#'
#' # Animate the first or last state of the join
#' # Animate the first or last state of the set
#' animate_union(x, y, export = "first") #' animate_union(x, y, export = "first")
#' animate_union(x, y, export = "last") #' animate_union(x, y, export = "last")
#' #'
#' #'
#' # different options include #' # different options include
#' \donttest{ #' \donttest{
#' animate_union(x, y, by = "id")
#' animate_union_all(x, y, by = "id")
#' animate_intersect(x, y, by = "id")
#' animate_setdiff(x, y, by = "id")
#' animate_union(x, y)
#' animate_union_all(x, y)
#' animate_intersect(x, y)
#' animate_setdiff(x, y)
#'
#' # further arguments can be passed to all animate_* functions
#' animate_union(
#' x, y,
#' text_size = 5, title_size = 25,
#' color_header = "black",
#' color_other = "lightblue",
#' color_fun = viridis::viridis
#' )
#' } #' }
#' #'
#' # Save the results #' # Save the results

+ 9
- 27
R/plot_helpers.R Dosyayı Görüntüle

#' @examples #' @examples
#' NULL #' NULL
animate_plot <- function(d, title = "", ...) { animate_plot <- function(d, title = "", ...) {
base_plot(d, title, ...) +
static_plot(d, title, ...) +
transition_states(.frame, 2, 1) + transition_states(.frame, 2, 1) +
enter_fade() + enter_fade() +
exit_fade() + exit_fade() +
} }




#' Prints the tiles for a processed dataset
#' Prints the tiles for a processed dataset statically
#' #'
#' @param d a processed dataset #' @param d a processed dataset
#' @param title the title of the plot #' @param title the title of the plot
#' @param text_family the font for the text
#' @param title_family the font for the title
#' @param text_size the size of the text
#' @param title_size the size of the title
#' @param ... further arguments #' @param ... further arguments
#' #'
#' @return a ggplot #' @return a ggplot
#' #'
#' @examples #' @examples
#' NULL #' NULL
base_plot <- function(d, title = "", ...) {
dots <- list(...)

if ("text_family" %in% names(dots)) {
text_family <- dots$text_family
} else {
text_family <- "Fira Sans"
}

if ("title_family" %in% names(dots)) {
title_family <- dots$title_family
} else {
title_family <- "Fira Mono"
}

if ("title_size" %in% names(dots)) {
title_size <- dots$title_size
} else {
title_size <- 20
}
if ("text_size" %in% names(dots)) {
text_size <- dots$text_size
} else {
text_size <- 10
}
static_plot <- function(d, title = "",
text_family = "Fira Sans", title_family = "Fira Mono",
text_size = 7, title_size = 25, ...) {


if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1) if (!".alpha" %in% names(d)) d <- d %>% mutate(.alpha = 1)
d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-")) d <- d %>% mutate(.item_id = paste(.id_long, .col, sep = "-"))

+ 21
- 9
R/process_data_helpers.R Dosyayı Görüntüle

#' @param y a right dataset #' @param y a right dataset
#' @param by a by argument for joins / set operations #' @param by a by argument for joins / set operations
#' @param fill if missing ids should be filled #' @param fill if missing ids should be filled
#' @param ... further arguments passed to add_color
#' #'
#' @return a preprocessed dataset #' @return a preprocessed dataset
#' #'
#' @examples #' @examples
#' NULL #' NULL
preprocess_data <- function(x, y, by, fill = TRUE) {
preprocess_data <- function(x, y, by, fill = TRUE, ...) {


#' test for #' test for
#' a <- c("unique", "mult", "mult", "also unique") #' a <- c("unique", "mult", "mult", "also unique")
ids <- dplyr::union(x %>% dplyr::select(.id, .id_long), ids <- dplyr::union(x %>% dplyr::select(.id, .id_long),
y %>% dplyr::select(.id, .id_long)) y %>% dplyr::select(.id, .id_long))


x_ <- process_data(x, ids, by, fill = fill)
y_ <- process_data(y, ids, by, fill = fill) %>%
x_ <- process_data(x, ids, by, fill = fill, ...)
y_ <- process_data(y, ids, by, fill = fill, ...) %>%
mutate(.x = .x + ncol(x) - 1) mutate(.x = .x + ncol(x) - 1)


return(list(x = x_, y = y_)) return(list(x = x_, y = y_))
#' @param width the width of the tiles #' @param width the width of the tiles
#' @param side the side (x or y, lhs or rhs, etc) #' @param side the side (x or y, lhs or rhs, etc)
#' @param fill if missing ids should be filled #' @param fill if missing ids should be filled
#' @param ... further arguments passed to add_color
#' #'
#' @return a data_frame including all necessary information #' @return a data_frame including all necessary information
#' #'
#' @examples #' @examples
#' NULL #' NULL
process_data <- function(x, ids, by, width = 1, side = NA, fill = TRUE) {
process_data <- function(x, ids, by, width = 1, side = NA, fill = TRUE, ...) {
if (is.na(side)) side <- deparse(substitute(x)) if (is.na(side)) side <- deparse(substitute(x))


x_names <- names(x) %>% str_subset("^[^\\.]") x_names <- names(x) %>% str_subset("^[^\\.]")
} }
} }


res <- add_color(x, ids$.id, by)
res <- add_color(x, rev(ids$.id), by, ...)
return(res) return(res)
} }


#' @param color_header color for the header #' @param color_header color for the header
#' @param color_other color for "inactive" values #' @param color_other color for "inactive" values
#' @param color_missing color for missing values #' @param color_missing color for missing values
#' @param color_fun the function to generate the colors
#' @param ...
#' #'
#' @return the processed data_frame with a new column .color #' @return the processed data_frame with a new column .color
#' #'
#' @examples #' @examples
#' NULL #' NULL
add_color <- function(x, ids, by, color_header = "#bdbdbd", color_other = "#d0d0d0", color_missing = "#ffffff") {
colors <- c(color_header, scales::brewer_pal(type = "qual", "Set1")(length(ids)))
add_color <- function(x, ids, by,
color_header = "#737373", color_other = "#d0d0d0",
color_missing = "#ffffff",
color_fun = scales::brewer_pal(type = "qual", "Set1"), ...) {
colors <- c(color_header, color_fun(length(ids)))
names(colors) <- c(".header", ids) names(colors) <- c(".header", ids)


res <- x %>% res <- x %>%
mutate(.color = ifelse(is.na(.val), color_missing, colors[.id]),
.color = ifelse(.col %in% by, .color, color_other))
mutate(
.color = ifelse(is.na(.val),
color_missing,
ifelse(.col %in% by,
colors[.id],
color_other)),
.color = ifelse(.id == ".header", color_header, .color))
return(res) return(res)
} }

+ 7
- 2
man/add_color.Rd Dosyayı Görüntüle

\alias{add_color} \alias{add_color}
\title{Adds Color to a processed data_frame} \title{Adds Color to a processed data_frame}
\usage{ \usage{
add_color(x, ids, by, color_header = "#bdbdbd",
color_other = "#d0d0d0", color_missing = "#ffffff")
add_color(x, ids, by, color_header = "#737373",
color_other = "#d0d0d0", color_missing = "#ffffff",
color_fun = scales::brewer_pal(type = "qual", "Set1"), ...)
} }
\arguments{ \arguments{
\item{x}{a processed data_frame} \item{x}{a processed data_frame}
\item{color_other}{color for "inactive" values} \item{color_other}{color for "inactive" values}


\item{color_missing}{color for missing values} \item{color_missing}{color for missing values}

\item{color_fun}{the function to generate the colors}

\item{...}{}
} }
\value{ \value{
the processed data_frame with a new column .color the processed data_frame with a new column .color

+ 10
- 1
man/animate_join.Rd Dosyayı Görüntüle

animate_left_join(x, y, by = "id") animate_left_join(x, y, by = "id")
animate_right_join(x, y, by = "id") animate_right_join(x, y, by = "id")
animate_semi_join(x, y, by = "id") animate_semi_join(x, y, by = "id")
animate_anti_join(x, y, by = "id")#'
animate_anti_join(x, y, by = "id")

# further arguments can be passed to all animate_* functions
animate_full_join(
x, y, by = "id", export = "last",
text_size = 5, title_size = 25,
color_header = "black",
color_other = "lightblue",
color_fun = viridis::viridis
)
} }


# Save the results # Save the results

+ 1
- 1
man/animate_join_function.Rd Dosyayı Görüntüle



\item{export}{if the function exports a gif, the first, or last picture} \item{export}{if the function exports a gif, the first, or last picture}


\item{...}{further arguments passed to base_plot}
\item{...}{further arguments passed to base_plot or to add_color}
} }
\value{ \value{
either a gif or a ggplot either a gif or a ggplot

+ 18
- 12
man/animate_set.Rd Dosyayı Görüntüle

} }
\examples{ \examples{
x <- data_frame( x <- data_frame(
id = 1:3,
x = paste0("x", 1:3)
x = c(1, 1, 2),
y = c("a", "b", "a")
) )
y <- data_frame( y <- data_frame(
id = (1:4)[-3],
y = paste0("y", (1:4)[-3])
x = c(1, 2),
y = c("a", "b")
) )


animate_union(x, y, by = "id", export = "first")
animate_union(x, y, by = "id", export = "last")

# Animate the first or last state of the join
# Animate the first or last state of the set
animate_union(x, y, export = "first") animate_union(x, y, export = "first")
animate_union(x, y, export = "last") animate_union(x, y, export = "last")




# different options include # different options include
\donttest{ \donttest{
animate_union(x, y, by = "id")
animate_union_all(x, y, by = "id")
animate_intersect(x, y, by = "id")
animate_setdiff(x, y, by = "id")
animate_union(x, y)
animate_union_all(x, y)
animate_intersect(x, y)
animate_setdiff(x, y)

# further arguments can be passed to all animate_* functions
animate_union(
x, y,
text_size = 5, title_size = 25,
color_header = "black",
color_other = "lightblue",
color_fun = viridis::viridis
)
} }


# Save the results # Save the results

+ 1
- 1
man/animate_set_function.Rd Dosyayı Görüntüle



\item{export}{if the function exports a gif, the first, or last picture} \item{export}{if the function exports a gif, the first, or last picture}


\item{...}{further arguments passed to base_plot}
\item{...}{further arguments passed to base_plot or to add_color}
} }
\value{ \value{
either a gif or a ggplot either a gif or a ggplot

+ 0
- 24
man/base_plot.Rd Dosyayı Görüntüle

% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/plot_helpers.R
\name{base_plot}
\alias{base_plot}
\title{Prints the tiles for a processed dataset}
\usage{
base_plot(d, title = "", ...)
}
\arguments{
\item{d}{a processed dataset}

\item{title}{the title of the plot}

\item{...}{further arguments}
}
\value{
a ggplot
}
\description{
Prints the tiles for a processed dataset
}
\examples{
NULL
}

+ 3
- 1
man/preprocess_data.Rd Dosyayı Görüntüle

\alias{preprocess_data} \alias{preprocess_data}
\title{Preprocess data} \title{Preprocess data}
\usage{ \usage{
preprocess_data(x, y, by, fill = FALSE)
preprocess_data(x, y, by, fill = TRUE, ...)
} }
\arguments{ \arguments{
\item{x}{a left dataset} \item{x}{a left dataset}
\item{by}{a by argument for joins / set operations} \item{by}{a by argument for joins / set operations}


\item{fill}{if missing ids should be filled} \item{fill}{if missing ids should be filled}

\item{...}{further arguments passed to add_color}
} }
\value{ \value{
a preprocessed dataset a preprocessed dataset

+ 3
- 1
man/process_data.Rd Dosyayı Görüntüle

\alias{process_data} \alias{process_data}
\title{Processes the data} \title{Processes the data}
\usage{ \usage{
process_data(x, ids, by, width = 1, side = NA, fill = TRUE)
process_data(x, ids, by, width = 1, side = NA, fill = TRUE, ...)
} }
\arguments{ \arguments{
\item{x}{a preprocessed dataset} \item{x}{a preprocessed dataset}
\item{side}{the side (x or y, lhs or rhs, etc)} \item{side}{the side (x or y, lhs or rhs, etc)}


\item{fill}{if missing ids should be filled} \item{fill}{if missing ids should be filled}

\item{...}{further arguments passed to add_color}
} }
\value{ \value{
a data_frame including all necessary information a data_frame including all necessary information

+ 33
- 0
man/static_plot.Rd Dosyayı Görüntüle

% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/plot_helpers.R
\name{static_plot}
\alias{static_plot}
\title{Prints the tiles for a processed dataset statically}
\usage{
static_plot(d, title = "", text_family = "Fira Sans",
title_family = "Fira Mono", text_size = 7, title_size = 25, ...)
}
\arguments{
\item{d}{a processed dataset}

\item{title}{the title of the plot}

\item{text_family}{the font for the text}

\item{title_family}{the font for the title}

\item{text_size}{the size of the text}

\item{title_size}{the size of the title}

\item{...}{further arguments}
}
\value{
a ggplot
}
\description{
Prints the tiles for a processed dataset statically
}
\examples{
NULL
}

Yükleniyor…
İptal
Kaydet