Skip to content

Commit

Permalink
Merge pull request #637 from hdrab127/master
Browse files Browse the repository at this point in the history 
Update deprecated dplyr functions
  • Loading branch information
@jbkunst
jbkunst authored Jul 5, 2020
2 parents 50f9835 + a964b19 commit e33985c
Show file tree
Hide file tree
Showing 19 changed files with 113 additions and 111 deletions.
4 changes: 2 additions & 2 deletions NAMESPACE
View file
Original file line number Diff line number Diff line change
Expand Up @@ -159,14 +159,13 @@ importFrom(dplyr,filter)
importFrom(dplyr,filter_)
importFrom(dplyr,glimpse)
importFrom(dplyr,group_by)
importFrom(dplyr,group_by_)
importFrom(dplyr,left_join)
importFrom(dplyr,mutate)
importFrom(dplyr,mutate_)
importFrom(dplyr,mutate_at)
importFrom(dplyr,mutate_if)
importFrom(dplyr,pull)
importFrom(dplyr,rename_)
importFrom(dplyr,rename)
importFrom(dplyr,select)
importFrom(dplyr,select_)
importFrom(dplyr,summarise)
Expand Down Expand Up @@ -204,6 +203,7 @@ importFrom(quantmod,is.OHLC)
importFrom(rlang,"!!!")
importFrom(rlang,"!!")
importFrom(rlang,":=")
importFrom(rlang,.data)
importFrom(rlang,enexprs)
importFrom(rlang,is_missing)
importFrom(rlang,parse_quo)
Expand Down
58 changes: 29 additions & 29 deletions R/hchart-shorcuts.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -32,9 +32,10 @@ hcspark <- function(x = NULL, type = NULL, ...) {
#' @param ... Additional arguments for the data series \url{http://api.highcharts.com/highcharts#series}.
#' @examples
#' hcboxplot(x = iris$Sepal.Length, var = iris$Species, color = "red")
#' @importFrom dplyr rename_
#' @importFrom dplyr rename
#' @importFrom tidyr unnest
#' @importFrom grDevices boxplot.stats
#' @importFrom rlang .data
#' @export
hcboxplot <- function(x = NULL, var = NULL, var2 = NULL, outliers = TRUE, ...) {
stopifnot(is.numeric(x))
Expand All @@ -60,28 +61,28 @@ hcboxplot <- function(x = NULL, var = NULL, var2 = NULL, outliers = TRUE, ...) {
}

series_box <- df %>%
group_by_("g1", "g2") %>%
group_by(.data$g1, .data$g2) %>%
do(data = get_box_values(.$x)) %>%
ungroup() %>%
unnest() %>%
group_by_("g2") %>%
do(data = list_parse(rename_(select_(., "-g2"), "name" = "g1"))) %>%
group_by(.data$g2) %>%
do(data = list_parse(rename(select(., -.data$g2), name = .data$g1))) %>%
mutate(type = "boxplot") %>%
mutate_("id" = "as.character(g2)")
mutate(id = as.character(.data$g2))

if (length(list(...)) > 0) {
series_box <- add_arg_to_df(series_box, ...)
}

series_out <- df %>%
group_by_("g1", "g2") %>%
group_by(.data$g1, .data$g2) %>%
do(data = get_outliers_values(.$x)) %>%
ungroup() %>%
filter(map_lgl(data, ~ length(.x) != 0)) %>%
group_by_("g2") %>%
do(data = list_parse(select_(., "name" = "g1", "y" = "data"))) %>%
group_by(.data$g2) %>%
do(data = list_parse(select(., name = .data$g1, y = .data$data))) %>%
mutate(type = "scatter") %>%
mutate_("linkedTo" = "as.character(g2)")
mutate(linkedTo = as.character(.data$g2))

if (length(list(...)) > 0) {
series_out <- add_arg_to_df(series_out, ...)
Expand All @@ -93,8 +94,8 @@ hcboxplot <- function(x = NULL, var = NULL, var2 = NULL, outliers = TRUE, ...) {
}

if (!has_name(list(...), "name")) {
series_box <- rename_(series_box, "name" = "g2")
series_out <- rename_(series_out, "name" = "g2")
series_box <- rename(series_box, name = .data$g2)
series_out <- rename(series_out, name = .data$g2)
}


Expand Down Expand Up @@ -144,7 +145,8 @@ hcboxplot <- function(x = NULL, var = NULL, var2 = NULL, outliers = TRUE, ...) {
#' hc_theme_null(chart = list(backgroundColor = "#34495e"))
#' )
#' )
#' @importFrom dplyr ungroup group_by_
#' @importFrom dplyr ungroup group_by
#' @importFrom rlang .data
#' @export
hciconarray <- function(labels, counts, rows = NULL, icons = NULL, size = 4,
...) {
Expand All @@ -161,26 +163,26 @@ hciconarray <- function(labels, counts, rows = NULL, icons = NULL, size = 4,

ds <- tibble(x = rep(1:w, h), y = rep(1:h, each = w)) %>%
head(sum(counts)) %>%
mutate_("y" = "-y") %>%
mutate(y = -.data$y) %>%
mutate(gr = rep(seq_along(labels), times = counts)) %>%
left_join(tibble(gr = seq_along(labels), name = as.character(labels)),
by = "gr"
) %>%
group_by_("name") %>%
group_by(.data$name) %>%
do(data = list_parse2(tibble(.$x, .$y))) %>%
ungroup() %>%
left_join(tibble(labels = as.character(labels), counts),
by = c("name" = "labels")
) %>%
arrange_("-counts") %>%
mutate_("percent" = "counts/sum(counts)*100")
mutate(percent = .data$counts / sum(.data$counts) * 100)

if (!is.null(icons)) {
assertthat::assert_that(length(icons) %in% c(1, length(labels)))

dsmrk <- ds %>%
mutate(iconm = icons) %>%
group_by_("name") %>%
group_by(.data$name) %>%
do(marker = list(symbol = fa_icon_mark(.$iconm)))

ds <- ds %>%
Expand Down Expand Up @@ -252,40 +254,38 @@ hciconarray <- function(labels, counts, rows = NULL, icons = NULL, size = 4,
#' GNI: {point.valuecolor:,.0f}")
#' }
#'
#' @importFrom dplyr filter_ mutate_ rename_ select_ tbl_df
#' @importFrom dplyr filter_ mutate_ rename select_ tbl_df
#' @importFrom purrr map map_df map_if
#'
#' @importFrom rlang .data
#' @export
hctreemap <- function(tm, ...) {
.Deprecated("hctreemap2")

assertthat::assert_that(is.list(tm))

df <- tm$tm %>%
tbl_df() %>%
select_("-x0", "-y0", "-w", "-h", "-stdErr", "-vColorValue") %>%
rename_("value" = "vSize", "valuecolor" = "vColor") %>%
tibble::as_tibble() %>%
select(-.data$x0, -.data$y0, -.data$w, -.data$h, -.data$stdErr, -.data$vColorValue) %>%
rename(value = .data$vSize, valuecolor = .data$vColor) %>%
purrr::map_if(is.factor, as.character) %>%
data.frame(stringsAsFactors = FALSE) %>%
tbl_df()
tibble::as_tibble()

ndepth <- which(names(df) == "value") - 1

ds <- map_df(seq(ndepth), function(lvl) {
df2 <- df %>%
filter_(sprintf("level == %s", lvl)) %>%
rename_("name" = names(df)[lvl]) %>%
mutate_("id" = "highcharter::str_to_id(name)")
rename(name = names(df)[lvl]) %>%
mutate(id = highcharter::str_to_id(.data$name))

if (lvl > 1) {
df2 <- df2 %>%
mutate_(
"parent" = names(df)[lvl - 1],
"parent" = "highcharter::str_to_id(parent)"
)
mutate(parent = names(df)[lvl - 1],
parent = highcharter::str_to_id(.data$parent))
} else {
df2 <- df2 %>%
mutate_("parent" = NA)
mutate(parent = NA)
}

df2
Expand Down
46 changes: 23 additions & 23 deletions R/hchart.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -322,7 +322,8 @@ hchart.ets <- function(object, ...) {
}

#' @importFrom tidyr gather
#' @importFrom dplyr count_ left_join select_
#' @importFrom dplyr count_ left_join select
#' @importFrom rlang .data
#' @export
hchart.matrix <- function(object, label = FALSE, showInLegend = FALSE, ...) {
if (getOption("highcharter.verbose")) {
Expand All @@ -345,22 +346,20 @@ hchart.matrix <- function(object, label = FALSE, showInLegend = FALSE, ...) {
yid <- seq(length(ynm)) - pos

ds <- as.data.frame(df) %>%
tbl_df() %>%
tibble::as_tibble() %>%
bind_cols(tibble(ynm), .) %>%
gather("key", "value", -ynm) %>%
rename_("xnm" = "key") %>%
mutate_(
"xnm" = "as.character(xnm)",
"ynm" = "as.character(ynm)"
)
rename(xnm = .data$key) %>%
mutate(xnm = as.character(.data$xnm),
ynm = as.character(.data$ynm))

ds$xnm <- if (is.null(colnames(object))) str_replace(ds$xnm, "V", "") else ds$xnm

ds <- ds %>%
left_join(tibble(xnm, xid), by = "xnm") %>%
left_join(tibble(ynm, yid), by = "ynm") %>%
mutate_("name" = "paste(xnm, ynm, sep = ' ~ ')") %>%
select_("x" = "xid", "y" = "yid", "value", "name")
mutate(name = paste(.data$xnm, .data$ynm, sep = ' ~ ')) %>%
select(x = .data$xid, y = .data$yid, .data$value, .data$name)

fntltp <- JS("function(){
return this.point.name + ': ' +
Expand Down Expand Up @@ -412,23 +411,24 @@ hchart.dist <- function(object, ...) {

#' @importFrom igraph vertex_attr edge_attr get.edgelist layout_nicely
#' @importFrom stats setNames
#' @importFrom rlang .data
#' @export
hchart.igraph <- function(object, ..., layout = layout_nicely, digits = 2) {

# data
dfv <- layout(object) %>%
round(digits) %>%
data.frame() %>%
tbl_df() %>%
tibble::as_tibble() %>%
setNames(c("x", "y"))

dfvex <- object %>%
vertex_attr() %>%
data.frame(stringsAsFactors = FALSE) %>%
tbl_df()
tibble::as_tibble()

if (nrow(dfvex) > 0) {
dfv <- tbl_df(cbind(dfv, dfvex))
dfv <- tibble::as_tibble(cbind(dfv, dfvex))
}

if (is.null(dfv[["name"]])) {
Expand All @@ -440,39 +440,39 @@ hchart.igraph <- function(object, ..., layout = layout_nicely, digits = 2) {
dfe <- object %>%
get.edgelist() %>%
data.frame(stringsAsFactors = FALSE) %>%
tbl_df() %>%
tibble::as_tibble() %>%
setNames(c("from", "to")) %>%
left_join(dfv %>%
select_(.dots = c("name", "x", "y")) %>%
select(.data$name, .data$x, .data$y) %>%
setNames(c("from", "xf", "yf")), by = "from") %>%
left_join(dfv %>%
select_(.dots = c("name", "x", "y")) %>%
select(.data$name, .data$x, .data$y) %>%
setNames(c("to", "xt", "yt")), by = "to") %>%
mutate(linkedTo = "e")

dfex <- object %>%
edge_attr() %>%
data.frame(stringsAsFactors = FALSE) %>%
tbl_df()
tibble::as_tibble()

if (nrow(dfex) > 0) {
dfe <- tbl_df(cbind(dfe, dfex))
dfe <- tibble::as_tibble(cbind(dfe, dfex))
}

# Checking opts
type <- "scatter"

if ("size" %in% names(dfv)) {
dfv <- dfv %>% rename_("z" = "size")
dfv <- dfv %>% rename(z = .data$size)
type <- "bubble"
}

if ("group" %in% names(dfv)) {
dfv <- dfv %>% rename_("groupvar" = "group")
dfv <- dfv %>% rename(groupvar = .data$group)
}

if ("width" %in% names(dfe)) {
dfe <- dfe %>% rename_("lineWidth" = "width")
dfe <- dfe %>% rename(lineWidth = .data$width)
}

if (!"color" %in% names(dfe)) {
Expand Down Expand Up @@ -525,7 +525,7 @@ hchart.igraph <- function(object, ..., layout = layout_nicely, digits = 2) {
if ("label" %in% names(dfv)) {
hc <- hc %>%
hc_add_series(
data = list_parse(dfv %>% select_(.dots = c("x", "y", "label"))),
data = list_parse(dfv %>% select(.data$x, .data$y, .data$label)),
type = "scatter", name = "labels", zIndex = 4,
marker = list(radius = 0), enableMouseTracking = FALSE,
dataLabels = list(enabled = TRUE, format = "{point.label}")
Expand Down Expand Up @@ -707,8 +707,8 @@ hchart.survfit <- function(object, ..., fun = NULL, markTimes = TRUE,
}

#' @importFrom tibble rownames_to_column
#' @importFrom rlang .data
#' @export

hchart.density <- function(object, type = "area", ...) {
hc_add_series(highchart(), data = object, type = type, ...)
}
Expand Down Expand Up @@ -746,7 +746,7 @@ hchart.pca <- function(sdev, n.obs, scores, loadings, ...,
setNames(c("x", "y")) %>%
rownames_to_column("name") %>%
as_tibble() %>%
group_by_("name") %>%
group_by(.data$name) %>%
do(data = list(c(0, 0), c(.$x, .$y))) %>%
list_parse()

Expand Down
18 changes: 9 additions & 9 deletions R/helpers.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -240,6 +240,7 @@ color_classes <- function(breaks = NULL,
#'
#' highcharter:::get_hc_series_from_df(iris, type = "point", x = Sepal.Width)
#' @importFrom tibble has_name
#' @importFrom rlang .data
get_hc_series_from_df <- function(data, type = NULL, ...) {
assertthat::assert_that(is.data.frame(data))
stopifnot(!is.null(type))
Expand Down Expand Up @@ -279,18 +280,17 @@ get_hc_series_from_df <- function(data, type = NULL, ...) {
# color
if (has_name(parsc, "color")) {
if (type == "treemap") {
data <- rename_(data, "colorValue" = "color")
data <- rename(data, colorValue = .data$color)
} else {
data <- mutate_(data,
"colorv" = "color",
"color" = "highcharter::colorize(color)"
)
data <- mutate(data,
colorv = .data$color,
color = highcharter::colorize(.data$color))
}
}

# size
if (has_name(parsc, "size") & type %in% c("bubble", "scatter")) {
data <- mutate_(data, "z" = "size")
data <- mutate(data, z = .data$size)
}

# group
Expand All @@ -301,10 +301,10 @@ get_hc_series_from_df <- function(data, type = NULL, ...) {
data[["charttpye"]] <- type

dfs <- data %>%
group_by_("group", "charttpye") %>%
do(data = list_parse(select_(., quote(-group), quote(-charttpye)))) %>%
group_by(.data$group, .data$charttpye) %>%
do(data = list_parse(select(., -.data$group, -.data$charttpye))) %>%
ungroup() %>%
rename_("name" = "group", "type" = "charttpye")
rename(name = .data$group, type = .data$charttpye)

if (!has_name(parsc, "group")) {
dfs[["name"]] <- NULL
Expand Down
Loading

0 comments on commit e33985c

Please sign in to comment.