Creating negative stacking bar chart with Highcharter(Likert chart) - r

The dream is that Jkunst responds, but I am trying to create a negative stacking bar chart with highcharter like the highcharts demo here -http://jsfiddle.net/KV5KV/
I've tried swapping all of the options and what not, but I can't seem to get it to show more than one series at a time, if anybody can help it would be wonderful. Here is what I am trying to run in R.
highchart() %>%
hc_chart(type = "bar") %>%
hc_title(text = "stuff") %>%
hc_yAxis(title = list(text = ""),
labels = list(format = "{value}"), min=0) %>%
hc_plotOptions(column = list(
series=list(stacking='normal'),
dataLabels = list(enabled = FALSE),
enableMouseTracking = TRUE)) %>%
hc_legend(enabled = FALSE) %>%
hc_xAxis(reversed=FALSE,opposite=TRUE,reversed=FALSE, linkedTo=0) %>%
hc_series(list(name="Value",color=c("#766A62"),data=list(-10, -5, -6))) %>%
hc_add_series(list(name="Value",color=c("#766A62"),data=list(-2, -5, -3))) %>%
hc_add_series(list(name="neutral",id='neutral',color=c("#766A62"),data=list(-2, -5, -3))) %>%
hc_add_series(list(name="Value",color=c("#766A62"),data=list(5, 1,6))) %>%
hc_add_series(list(name="Value",color=c("#766A62"),data=list(2, 5, 3))) %>%
hc_add_series(list(linkedTo='neutral',name="neutral",color=c("#766A62"),data=list(6, 8, 2)))

I HAVE DONE IT.
highchart() %>%
hc_chart(type = "bar") %>%
hc_title(text = "Experimental Survey Questions breakdown") %>%
hc_yAxis(title = list(text = ""),
labels = list(format = "{value}")) %>%
hc_plotOptions(series=list(stacking='normal'),column = list(
dataLabels = list(enabled = FALSE),
enableMouseTracking = TRUE)) %>%
hc_legend(enabled = FALSE) %>%
hc_xAxis(reversed=FALSE,opposite=TRUE,reversed=FALSE) %>%
hc_add_series(name="Value",color=c("rgb(205,35,35)"),data=list(-10, -5, -6)) %>%
hc_add_series(name="Values",color=c("rgb(165,85,85)"),data=list(-2, -5, -3)) %>%
hc_add_series(name="neutral",id='neutral',color=c("#766A62"),data=list(-2, -5, -3)) %>%
hc_add_series(name="Valuess",color=c("rgb(35,35,205)"),data=list(5, 1,6)) %>%
hc_add_series(name="Valuesss",color=c("rgb(85,85,165)"),data=list(2, 5, 3)) %>%
hc_add_series(name="Neutral",linkedTo='neutral',color=c("#766A62"),data=list(6, 8, 2))
^Cut and dry for those looking for answer, Special thanks to good ol jbkunst, he made this amazing library and has completely changed the way I present my research( you dah best they evah wuz ;)
I still have the question of how to get the actual values to link together(neutral has a line through it, which is lame.)

I'm still fiddling with it but this seems to be closer. I got rid of the colors for now. I was hoping to get the mirrored x-axis but I'll edit that in if I can figure it out. It does show all 3 series though
highchart() %>%
hc_chart(type = "bar") %>%
hc_title(text = "stuff") %>%
hc_yAxis(title = list(text = ""),
labels = list(format = "{value}"), min=0) %>%
hc_plotOptions(
series=list(stacking='normal'),
dataLabels = list(enabled = TRUE),
enableMouseTracking = TRUE) %>%
hc_legend(enabled = TRUE) %>%
hc_xAxis(reversed=FALSE,opposite=TRUE,reversed=FALSE, linkedTo=0) %>%
hc_add_series(name="Value", data=list(-10, -5, -6)) %>%
hc_add_series(name="foo",data=list(-2, -15, -3)) %>%
hc_add_series(name="neutral",id='neutral',data=list(-2, -5, -4)) %>%
hc_add_series(name="Value",data=list(5, 1, 7)) %>%
hc_add_series(name="Value", linkedTo = "neutral", data=list(2, 5, 3))

Related

Plotly subplots with shared legend in R

I have made twoplots using plotly, which are working fine individually, but when combined using subplot I can't seem to figure out how to combine the legends. I have tried to use showlegend = F in plot_ly in one of the plots, but this just removes it completely - what I want is to control both subplots with the same legend.
My code is as follows:
coronavirus_not_china <- coronavirus %>%
filter(!(country == "China"))
cases_not_china_plot <- coronavirus_not_china %>%
group_by(type, date) %>%
summarise(total_cases = sum(cases)) %>%
pivot_wider(names_from = type, values_from = total_cases) %>%
arrange(date) %>%
mutate(active = confirmed - death - recovered) %>%
mutate(active_total = cumsum(active),
recovered_total = cumsum(recovered),
death_total = cumsum(death)) %>%
plot_ly(x = ~ date,
y = ~ active_total,
name = 'Active',
fillcolor = '#1f77b4',
type = 'scatter',
mode = 'none',
stackgroup = 'one',
showlegend = F) %>%
add_trace(y = ~ death_total,
name = "Death",
fillcolor = '#E41317') %>%
add_trace(y = ~recovered_total,
name = 'Recovered',
fillcolor = 'forestgreen') %>%
layout(title = "Distribution of Covid19 Cases outside China",
legend = list(x = 0.1, y = 0.9),
yaxis = list(title = "Number of Cases", showgrid = T))
coronavirus_china <- coronavirus %>%
filter((country == "China"))
cases_china_plot <- coronavirus_china %>%
group_by(type, date) %>%
summarise(total_cases = sum(cases)) %>%
pivot_wider(names_from = type, values_from = total_cases) %>%
arrange(date) %>%
mutate(active = confirmed - death - recovered) %>%
mutate(active_total = cumsum(active),
recovered_total = cumsum(recovered),
death_total = cumsum(death)) %>%
plot_ly(x = ~ date,
y = ~ active_total,
name = 'Active',
fillcolor = '#1f77b4',
type = 'scatter',
mode = 'none',
stackgroup = 'one',
showlegend = T) %>%
add_trace(y = ~ death_total,
name = "Death",
fillcolor = '#E41317') %>%
add_trace(y = ~recovered_total,
name = 'Recovered',
fillcolor = 'forestgreen') %>%
layout(title = "Distribution of Covid19 Cases inside China",
legend = list(x = 0.1, y = 0.9),
yaxis = list(title = "Number of Cases", showgrid = F))
And I create the subplots as:
subplot(cases_not_china_plot, cases_china_plot, nrows = 2, margin = 0.05, shareX = T) %>%
layout(title="Coronavirus cases outside China and in China", ylab("Number of cases"))
I am quite new to R, so if there is a smarter way to do what I desire, please let me know.
With the above code, my output is:

Bar with negative stack and positive labels

I'm trying to make in R (Shiny) a reversed stacked bar highchart. I already found how to make the graph, but I can't find out how to make the labels on the x-axis positive, like here: https://www.highcharts.com/demo/bar-negative-stack
I've tried to apply the abs() function, but it didn't work so far. Does anyone have a solution?
highchart() %>%
hc_chart(type = "bar") %>%
hc_title(text = "Example") %>%
hc_yAxis(title = list(text = ""), labels = list(format = "{value}")) %>%
hc_plotOptions(series=list(stacking='normal'),
column = list( dataLabels = list(enabled = FALSE),
enableMouseTracking = TRUE)) %>%
hc_legend(enabled = FALSE) %>%
hc_xAxis(reversed=FALSE, opposite=TRUE, reversed=FALSE) %>%
hc_add_series(name="neutral", id='neutral', color=c("#766A62"), data=list(2, 8)) %>%
hc_add_series(name="Neutral",linkedTo='neutral',color=c("#ffeeff"),data=list(-5, -3))
I want the values of the bars and the labels on the x-axis all to be positive. Any ideas welcome.
Using your code:
highchart() %>%
hc_chart(type = "bar") %>%
hc_title(text = "Example") %>%
hc_yAxis(title = list(text = ""),labels = list(format = "{value}")) %>%
hc_plotOptions(series=list(stacking='normal'),column = list( dataLabels = list(enabled = FALSE),
enableMouseTracking = TRUE)) %>%
hc_legend(enabled = FALSE) %>%
hc_xAxis(list(categories = c("0-4", "5-9"),
reversed=FALSE ),
list(reversed=FALSE,opposite=TRUE,
reversed=FALSE,
categories =c("0-4", "5-9"),
linkedTo = 0)) %>%
hc_yAxis(
labels = list(
formatter = JS("function(){ return Math.abs(this.value) + '%'; }"))) %>%
hc_add_series(name="neutral",id='neutral',color=c("#766A62"),data=list(2, 8)) %>%
hc_add_series(name="Neutral",linkedTo='neutral',color=c("#ffeeff"),data=list(-5, -3))
Following lines are modified:
hc_xAxis(list(categories = c("0-4", "5-9"),
reversed=FALSE ),
list(reversed=FALSE,opposite=TRUE,
reversed=FALSE,
categories =c("0-4", "5-9"),
linkedTo = 0)) %>%
hc_yAxis(
labels = list(
formatter = JS("function(){ return Math.abs(this.value) + '%'; }")))
Result:

The type 'variwide' in highcharter does not work

I would like to create a variwide chart in Highcharter to use in R,but the result is empty。
library(data.table)
library(highcharter)
labor_cost <- data.table(country =c('挪威','丹麦','比利时','瑞典','法国','荷兰','芬兰','德国','奥地利','爱尔兰','意大利','英国','西班牙','希腊','葡萄牙','捷克共和国','波兰','罗马尼亚'),cost=c(50.2,42,39.2,38,35.6,34.3,33.2,33,32.7,30.4,27.8,26.7,21.3,14.2,13.7,10.2,8.6,5.5),gdp=c(335504,277339,421611,462057,2228857,702641,215615,3144050,349344,275567,1672438,2366911,1113851,175887,184933,176564,424269,169578))
highchart() %>%
hc_title(text = "欧洲各国人工成本", align="center")%>%
hc_xAxis(type = "category",title = list(text = "* 柱子宽度与 GDP 成正比")) %>%
hc_legend(enabled = FALSE) %>%
hc_add_series(data = labor_cost,type = "variwide",hcaes(x = country,width= gdp),dataLabels = list(enabled = TRUE,format="€{point.y:.0f}"),colorByPoint = TRUE)
The code executes normally,no errors appear.

Add reference line for each bar in bar chart using highcharter

I want to put a specific line for each bar likes the following:
But, I can't. To do this, I have tried the following code to put a particular text at least, but it does not work anymore:
mydata <- data.frame(A=runif(1:10),
B=runif(1:10),
C=runif(1:10))
highchart() %>%
hc_chart(type = "column", inverted = TRUE) %>%
hc_title(text = "MyGraph") %>%
hc_yAxis(title = list(text = "Weights")) %>%
hc_plotOptions(column = list(
dataLabels = list(enabled = FALSE),
stacking = "normal",
enableMouseTracking = FALSE)
) %>%
hc_legend(layout="vertical") %>%
hc_tooltip(formatter = function(){ return("<b> test</b><br/>")},
useHtml = TRUE) %>%
hc_series(list(name="A",data=mydata$A),
list(name="B",data=mydata$B),
list(name="C",data=mydata$C))
My question is how can I add red lines into the bar chart for each bar line?
Here is a possible solution:
set.seed(1)
mydata <- data.frame(A=runif(1:10), B=runif(1:10), C=runif(1:10))
library(highcharter)
hc <- highchart() %>%
hc_chart(type = "column", inverted = TRUE) %>%
hc_title(text = "MyGraph") %>%
hc_yAxis(title = list(text = "Weights")) %>%
hc_plotOptions(column = list(
dataLabels = list(enabled = FALSE),
stacking = "normal", groupPadding=0,
enableMouseTracking = FALSE)
) %>%
hc_legend(layout="vertical") %>%
hc_tooltip(formatter = function(){ return("<b> test</b><br/>")},
useHtml = TRUE) %>%
hc_series(list(name="A",data=mydata$A),
list(name="B",data=mydata$B),
list(name="C",data=mydata$C))
# x position of red lines
linepos <- c(1.3, 0.7, 1.8, 1.2, 1.0, 1.6, 0.7, 1.7, 0.8, 1.1)
# height of red lines
lw <- 0.35
for (k in 1:length(linepos)) {
df <- data.frame(x=c(k-1-lw,k-1+lw),y=rep(linepos[k],2))
hc <- hc %>%
hc_add_series(data = df, type = 'line', marker=list(enabled=FALSE),
x = ~x, y= ~y, color='red', lineWidth=5, showInLegend=FALSE,
enableMouseTracking = FALSE)
}
hc

tidytext -- how to do commonality and comparsion word clouds

Let me start with the following and fully working code from Introduction to tidytext # CRAN
library(janeaustenr)
library(dplyr)
library(stringr)
original_books <- austen_books() %>%
group_by(book) %>%
mutate(linenumber = row_number(),
chapter = cumsum(str_detect(text, regex("^chapter [\\divxlc]",
ignore_case = TRUE)))) %>%
ungroup()
original_books
library(tidytext)
tidy_books <- original_books %>%
unnest_tokens(word, text)
tidy_books
data("stop_words")
cleaned_books <- tidy_books %>%
anti_join(stop_words)
All good so far. I have a tibble with six Jane Austen novels, with the standard junk words removed.
unique(cleaned_books$book)
Which gets me: Sense & Sensibility, Pride & Prejudice, Mansfield Park, Emma, Northanger Abbey, Persuasion.
So if I want to do a standard TF word cloud of all six, no problem. Just like this (color added):
library(wordcloud)
library(RColorBrewer)
dark2 <- brewer.pal(8, "Dark2")
cleaned_books %>%
count(word) %>%
with(wordcloud(word, n, color = dark2, max.words = 100))
Works beautifully. But how do I then do a commonality.cloud() with all six novels, and a comparison.cloud() with the same?
All the data I need is in cleaned_books -- but I can't figure out how to reshape it. Your help appreciated!
Got it. Thanks.
Will leave up in case anyone else has a similar issue.
The above code &
set1 <- brewer.pal(8, "Set1") ## a second color just for other cloud type
library(reshape2)
# title size and scale optional, obviously
cleaned_books %>%
group_by(book) %>%
count(word) %>%
acast(word ~ book, value.var = "n", fill = 0) %>%
comparison.cloud(color = dark2, title.size = 1, scale = c(3, 0.3), random.order = FALSE, max.words = 100)
cleaned_books %>%
group_by(book) %>%
count(word) %>%
acast(word ~ book, value.var = "n", fill = 0) %>%
commonality.cloud(color = set1, title.size = 1, scale = c(3, 0.3), random.order = FALSE, max.words = 100)
That worked out nicely.
Got it. Thanks. Run the above code. Then
set1 <- brewer.pal(8, "Set1") ## a second color just for other cloud type
library(reshape2)
Color is optional. reshape2 essential. Then just group by book, and go.
cleaned_books %>%
group_by(book) %>%
count(word) %>%
acast(word ~ book, value.var = "n", fill = 0) %>%
comparison.cloud(color = dark2, title.size = 1, scale = c(3, 0.3), random.order = FALSE, max.words = 100)
cleaned_books %>%
group_by(book) %>%
count(word) %>%
acast(word ~ book, value.var = "n", fill = 0) %>%
commonality.cloud(color = set1, title.size = 1, scale = c(3, 0.3), random.order = FALSE, max.words = 100)
All good!

Resources