When I run this
library(tidyverse)
df = data.frame(
stringsAsFactors = FALSE,
Type = c("a", "b", "c", "d"),
A = c(51, 5, 10, 155.5),
P1 = c(40.1, 50.5, 127.8, 216),
C = c(40, 45, 50, 255)
)
library(huxtable)
ht = as_hux(df)
ht %>% map_text_color( row = 2:nrow(df), col = 2:3,
by_cases(. < 50 ~ "red")) %>%
set_all_borders()
ht
I get table:
table
The problem is that 127.8 is bigger than 50 so it shouldn't be red. How to make it to be as I want?
The underlying issue is that adding cases has turned your numbers to character(). A workaround is to use by_cases(as.numeric(.) < 50 ~ "red"). Alternatively, write:
ht = as_hux(df, add_colnames = FALSE)
ht %>% map_text_color(col = 2:3,
by_cases(. < 50 ~ "red")) %>%
add_colnames() %>%
set_all_borders() %>%
which keeps the data as numeric until after you've done the colour mapping.
Related
Can I present the result of TukeyHSD as a heatmap? And how would the code look like concerning the example below?
#Daten erstellen
set.seed (0)
data <- data.frame(group = rep(c("A", "B", "C"), each = 30),
values = c(runif(30, 0, 3),
runif(30, 0, 5),
runif(30, 1, 7)))
#Die ersten sechs Zeilen anzeigen
head(data)
#einfaktorielles ANOVA-Modell anpassen
model <- aov(values~group, data=data)
#Sehen Sie sich die Modellausgabe an
summary(model)
#Tukey Test durchführen
TukeyHSD(model, conf.level=.95)
#Konfidenzintervalle plotten
plot(TukeyHSD(model, conf.level=.95), las = 2)
Thank you so much!!
I actually get the right results, but can't display them as a heatmap.
Here a way to do it with a tidyverse approach
library(dplyr)
library(lubridate)
library(tidyr)
data <- data.frame(group = rep(c("A", "B", "C"), each = 30),
values = c(runif(30, 0, 3),
runif(30, 0, 5),
runif(30, 1, 7)))
#einfaktorielles ANOVA-Modell anpassen
model <- aov(values~group, data=data)
#Tukey Test durchführen
test_list <- TukeyHSD(model, conf.level=.95)
test_data <- test_list$group
test_data %>%
as_tibble() %>%
bind_cols(data.frame(rw = rownames(test_data))) %>%
separate(rw,into = c("var1","var2")) %>%
ggplot(aes(x = var1,y = var2, fill = `p adj`))+
geom_tile()+
geom_text(aes(label = p.adjust(`p adj`)), color = "white")
I have a stacked bar chart and I want to add a value label above each stacked bar. I don't want values for each section of the stack.
This yields a value for each section of the stack:
library(echarts4r)
set.seed(1)
d <- data.frame(
xaxis = c(rep("a", 2), rep("b", 2)),
groups = c("c", "d", "c", "d"),
value = rnorm(4, mean = 50)
)
d |>
group_by(groups) |>
e_chart(xaxis) |>
e_bar(value, stack = "grp1") |>
e_labels()
I just want one number above each bar, equal to the sum of each section.
You can precalculate the labels of your groups and then bind them to e_bar :
library(echarts4r)
set.seed(1)
d <- data.frame(
xaxis = c(rep("a", 2), rep("b", 2)),
groups = c("c", "d", "c", "d"),
value = rnorm(4, mean = 50)
) |>
group_by(xaxis) |>
dplyr::mutate(Label = ifelse(groups == "c","",as.character(sum(value))))
d |>
group_by(groups) |>
e_chart(xaxis) |>
e_bar(value, stack = "groups",
bind = Label,
label = list(
show = TRUE,
formatter = "{b}",
position = "outside"
)
)
I think I'm basically looking for an R plotly equivalent to this python plotly post:
I have a XY data.frame that I'd like to plot using R's plotly, where each point belongs to either one of two types ("a"/"b"), and nested within each type is a group, and the group assignment is redundant.
My purpose is to color code the points according to the group frequency, where each type uses a different color scale.
Here's the data.frame:
library(dplyr)
set.seed(1)
df <- rbind(data.frame(type = "a", group = paste0("a", sample(1000, 500, replace = T))) %>%
cbind(as.data.frame(MASS::mvrnorm(n = 1000,mu = c(-5,-5),Sigma = matrix(c(5, 3, 4, 4), ncol=2)))),
data.frame(type = "b", group = paste0("b", sample(500, 50, replace = T))) %>%
cbind(as.data.frame(MASS::mvrnorm(n = 500,mu = c(5,5),Sigma = matrix(c(5, 3, 4, 4), ncol=2))))) %>%
dplyr::rename(x = V1, y = V2)
Here I compute the frequency of each group, for each type, and then add two artificial points per each type, with the global minimum and maximum frequency (f), so that the color scales use a comment numeric scale:
freq.df <- rbind(dplyr::group_by(dplyr::filter(df, type == "a"), type, group) %>%
dplyr::tally() %>%
dplyr::mutate(f = 100*n/sum(n)) %>%
dplyr::select(-n),
dplyr::group_by(dplyr::filter(df, type == "b"), type, group) %>%
dplyr::tally() %>%
dplyr::mutate(f = 100*n/sum(n)) %>%
dplyr::select(-n)) %>%
dplyr::ungroup() %>%
rbind(data.frame(type = c(rep("a", 2), rep("b", 2)), group = c(rep("a", 2), rep("b", 2)), f = rep(c(min(.$f), max(.$f)), 2), stringsAsFactors = F))
And now joining freq.df to df:
df <- df %>% dplyr::left_join(freq.df)
Here's how I'm trying to plot it:
plotly::plot_ly(marker = list(size = 3), type = 'scatter', mode = "markers", color = dplyr::filter(df, type == "a")$f, colors = viridis::viridis_pal(option = "D")(3), x = dplyr::filter(df, type == "a")$x, y = dplyr::filter(df, type == "a")$y) %>%
plotly::add_trace(marker = list(size = 3),type = 'scatter', mode = "markers",color = dplyr::filter(df, type == "b")$f,colors = viridis::viridis_pal(option = "A")(3), x = dplyr::filter(df, type == "b")$x,y=dplyr::filter(df,type == "b")$y) %>%
plotly::layout(xaxis = list(zeroline = F, showticklabels = F, showgrid = F),yaxis = list(zeroline = F,showticklabels = F, showgrid = F))
Which only gives me the colorbar of first color scale (viridis's cividis):
Any idea how to get both colorbars (viridis's cividis and viridis's magma) appear side by side?
DF <- data.frame(Height = rnorm(100, 170, 5),
Weight = rnorm(100, 55, 5))
BMI = function(height,weight){(weight/(height)^2*10000)}
DF$bmi = BMI(DF$Height,DF$Weight)
DF$weight_group <-
cut(
x = DF$Weight,
breaks = c(0,60,70,Inf),
include.lowest = TRUE,
labels = c("0-60", "61-70", "71+")
)
DF$BMI_group <-
cut(
x = DF$bmi,
breaks = c(0, 19.75582, Inf),
include.lowest = TRUE,
labels = c("Below Average", "Above Average")
)
This is my code. I cannot figure out how to just calculate the average of the last half of the data frame. I didn't know how to add in gender, to make 50 males and 50 females, so this is my work around.
Are you looking for such a solution?
DF <- data.frame(Height = rnorm(100, 170, 5),
Weight = rnorm(100, 55, 5),
Gender = c(rep("male", 50), rep("female", 50)))
BMI <- function(height,weight){(weight/(height)^2*10000)}
library(dplyr)
DF %>%
group_by(Gender) %>%
mutate(bmi = BMI(Height, Weight)) %>%
summarise(mean_bmi = mean(bmi))
# A tibble: 2 x 2
Gender mean_bmi
* <chr> <dbl>
1 female 19.4
2 male 19.6
We may use sample to create the column, subset the 'Gender' for 'F', and apply the BMI
DF$Gender <- sample(c("F", "M"), nrow(DF), replace = TRUE, prob = c(0.5, 0.5))
with(subset(DF, Gender == "F"), mean(BMI(Height, Weight)))
If we want to get the mean of 'BMI' by 'BMI_group'
subdf <- subset(DF, Gender == "F")
with(subdf, tapply(BMI(Height, Weight), BMI_group, FUN = mean))
Below Average Above Average
17.57841 21.43003
I'm trying to do a semi circle donut with highcharter library but I only know how to do a pie chart. I know that with JS you can do it by adding "startAngle" and "endAngle" but I want to know how to do it with R:
A <- c("a", "b", "c", "d")
B <- c(4, 6, 9, 2)
C <- c(23, 26, 13, 15)
df <- data.frame(A, B, C)
highchart() %>%
hc_chart(type = "pie") %>%
hc_add_series_labels_values(labels = df$A, values = df$B)%>%
hc_tooltip(crosshairs = TRUE, borderWidth = 5, sort = TRUE, shared = TRUE, table = TRUE,
pointFormat = paste('<b>{point.percentage:.1f}%</b>')
) %>%
hc_title(text = "ABC",
margin = 20,
style = list(color = "#144746", useHTML = TRUE))
Thank you!
You can do something like this though not using Highcharts library.
library(tidyverse)
library(ggforce)
library(scales)
library(ggplot2)
# -------------------------------------------------------------------------
A <- c("a", "b", "c", "d")
B <- c(4, 6, 9, 2)
C <- c(23, 26, 13, 15)
df <- data.frame(A, B, C)
# Ensure A is a factor (we'll be using it to fill the pie)
df$A <- factor(df$A)
# compute the individual proportion in this case using var C
df$prop <- df$C/sum(df$C)
# compute the cumulative proportion and use that to plot ymax
df$p_end <- cumsum(df$prop)
# generate a y-min between 0 and 1 less value than p_end (using p_end)
df$p_start <- c(0, head(df$p_end ,-1))
# -------------------------------------------------------------------------
# plot
df %>%
mutate_at(c("p_start", "p_end"), rescale, to=pi*c(-.5,.5), from=0:1) %>%
ggplot +
geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = .5, r = 1, start = p_start, end = p_end, fill=A)) +
coord_fixed() +xlab("X_label") + ylab("Y_lablel") + guides(fill=guide_legend(title="Legend Title"))
Output
Hope that helps.
Try adding startAngle = -90, endAngle = 90 inside hc_add_series_labels_values.
Note as per the warning hc_add_series_labels_values is deprecated so suggest using hc_add_series.
highchart() %>%
hc_add_series(type = "pie", data = df, hcaes(x = A, y = B), startAngle = -90, endAngle = 90) %>%
hc_tooltip(pointFormat = '<b>{point.percentage:.1f}%</b>') %>%
hc_title(text = "ABC",
margin = 20,
style = list(color = "#144746", useHTML = TRUE))