renderHighchart output not displaying in Shiny App - r

I have some data which looks like:
# A tibble: 100 × 4
price habs mts2 type
<dbl> <dbl> <dbl> <chr>
1 338000 3 92 comprar
2 288000 4 79 comprar
3 3000 2 55 alquiler
4 775 1 10 alquiler
5 288000 4 76 comprar
In R I can plot the data using the following:
library(highcharter)
library(tidyverse)
library(broom)
highcharterPlotterFunction = function(TYPE){
filteredDF = df %>%
filter(type == TYPE)
# formula = as.formula(y ~ x + I(x^2))
lm.model <- augment(lm(price ~ mts2, data = filteredDF)) %>%
mutate(
.fitted = round(.fitted, 0)
)
highchart() %>%
hc_add_series(data = lm.model,
type = "scatter",
hcaes(x = price, y = mts2, color = mts2),
showInLegend = FALSE,
dataLabels = list(enabled = TRUE, format='{point.games}')
) %>%
hc_add_series(data = lm.model,
type = "line",
hcaes(x = .fitted, y = mts2),
color = "#0099F9",
showInLegend = FALSE,
dataLabels = list(enabled = TRUE, format='{point.games}')
) %>%
hc_title(text = str_to_title(TYPE))
}
c("comprar", "alquiler") %>%
map(., ~highcharterPlotterFunction(.x)) %>%
hw_grid(rowheight = 300, ncol = 1) %>%
htmltools::browsable()
Which plots two highercharter graphics on top of each other. However, when I try to put it into a shiny App I do not get any output:
Shiny App:
library(shiny)
ui <- fluidPage(
fluidRow(
p("plot goes below here"),
highchartOutput('regressionPlots')
)
)
server <- function(input, output) {
highcharterPlotterFunction = function(TYPE){
filteredDF = reactive_regression_data() %>%
filter(type == TYPE)
# formula = as.formula(y ~ x + I(x^2))
lm.model <- augment(lm(price ~ mts2, data = filteredDF)) %>%
mutate(
.fitted = round(.fitted, 0)
)
highchart() %>%
hc_add_series(data = lm.model,
type = "scatter",
hcaes(x = price, y = mts2, color = mts2),
showInLegend = FALSE
) %>%
hc_add_series(data = lm.model,
type = "line",
hcaes(x = .fitted, y = mts2),
color = "#0099F9",
showInLegend = FALSE
) %>%
hc_title(text = str_to_title(TYPE))
}
reactive_regression_data = reactive(
df %>%
# filter(provincia == input$provinceSelect) %>%
# filter(municipio == input$municipioSelect) %>%
# filter(distrito == input$distritoSelect) %>%
filter(price <= 1000000) %>%
filter(mts2 <= 200)
)
output$regressionPlots <- renderHighchart({
c("comprar", "alquiler") %>%
map(., ~highcharterPlotterFunction(.x)) %>%
hw_grid(rowheight = 300, ncol = 1) %>%
htmltools::browsable()
})
}
shinyApp(ui = ui, server = server)
Data:
df <- structure(list(price = c(338000, 288000, 3000, 775, 288000, 230000,
218000, 2900, 845000, 1250, 288000, 299000, 356000, 1500, 300000,
1300, 1500, 288000, 405000, 715000, 225000, 294000, 790, 329000,
320000, 1200, 1150, 715000, 415000, 715000, 295000, 1500, 348000,
1100, 3000, 249000, 379000, 761000, 320000, 1995, 715000, 715000,
229000, 1600, 389000, 330000, 212000, 415000, 288000, 950, 1850,
365000, 1050, 1650, 1750, 350000, 288000, 715000, 1200, 990,
260000, 234500, 1400, 288000, 1100, 1650, 348000, 332000, 288000,
350000, 1350, 360000, 2800, 379000, 799000, 288000, 685000, 1700,
890, 294000, 338000, 590000, 294000, 1050, 320000, 1990, 350000,
1100, 365000, 365000, 294000, 299000, 288000, 490000, 229000,
2095, 560000, 288000, 715000, 360000), habs = c(3, 4, 2, 1, 4,
3, 2, 4, 3, 2, 4, 2, 2, 4, 2, 4, 2, 4, 3, 3, 1, 2, 1, 4, 3, 3,
NA, NA, 3, NA, 3, 2, 4, 2, 4, 2, 3, 3, 2, 2, 3, 3, 3, 1, 4, 4,
2, 4, 4, 1, 4, 3, 1, 2, 2, 4, 4, 3, 3, 2, NA, 3, 4, 4, 3, 1,
4, 4, 4, 4, 3, 4, 2, 3, 4, 4, 4, 4, 2, 2, 3, 4, 2, 1, 3, 1, 4,
3, 3, 3, 2, 2, 4, 4, 3, 3, 4, 4, 3, 2), mts2 = c(92, 79, 55,
10, 76, 65, 57, 95, 121, 57, 76, 90, 70, 102, 74, 83, 88, 79,
83, 109, 60, 75, 47, 75, 68, 70, 30, 109, 80, 109, 100, 75, 80,
70, 135, 65, 95, 121, 68, 110, 109, 109, 63, 70, 100, 85, 54,
100, 76, 45, 100, 94, 46, 71, 92, 87, 76, 109, 88, 68, 58, 65,
104, 75, 75, 40, 80, 80, 76, 87, 75, 112, 95, 111, 135, 79, 88,
115, 43, 75, 92, 145, 75, 46, 92, 47, 87, 75, 90, 63, 70, 85,
76, 111, 60, 132, 140, 79, 109, 70), type = c("comprar", "comprar",
"alquiler", "alquiler", "comprar", "comprar", "comprar", "alquiler",
"comprar", "alquiler", "comprar", "comprar", "comprar", "alquiler",
"comprar", "alquiler", "alquiler", "comprar", "comprar", "comprar",
"comprar", "comprar", "alquiler", "comprar", "comprar", "alquiler",
"alquiler", "comprar", "comprar", "comprar", "comprar", "alquiler",
"comprar", "alquiler", "alquiler", "comprar", "comprar", "comprar",
"comprar", "alquiler", "comprar", "comprar", "comprar", "alquiler",
"comprar", "comprar", "comprar", "comprar", "comprar", "alquiler",
"alquiler", "comprar", "alquiler", "alquiler", "alquiler", "comprar",
"comprar", "comprar", "alquiler", "alquiler", "comprar", "comprar",
"alquiler", "comprar", "alquiler", "alquiler", "comprar", "comprar",
"comprar", "comprar", "alquiler", "comprar", "alquiler", "comprar",
"comprar", "comprar", "comprar", "alquiler", "alquiler", "comprar",
"comprar", "comprar", "comprar", "alquiler", "comprar", "alquiler",
"comprar", "alquiler", "comprar", "comprar", "comprar", "comprar",
"comprar", "comprar", "comprar", "alquiler", "comprar", "comprar",
"comprar", "comprar")), row.names = c(NA, -100L), class = c("tbl_df",
"tbl", "data.frame"))

You when you use renderHighchart(), the expression in the curly braces expects a return value of class highchart. However, when you combine multiple charts using hw_grid(), the return value is of class shiny.tag. Therefore, the output binding is not able to render the output and (silently) fails.
The simplest fix for this is to replace renderHighchart() with renderUI() and highchartOutput() with uiOutput().
shiny::shinyApp(
shiny::fluidPage(
shiny::uiOutput("chart")
),
function(input, output, session) {
output$chart <- shiny::renderUI({
highcharter::hw_grid(
highcharter::highcharts_demo(),
highcharter::highcharts_demo()
)
})
}
)
Annother approach would be to use two separate calls to renderHighchart()/highchartOutput() and combine the charts inside the UI. However, with this approach you won't be able to use hw_grid()
A third way, which is probably the most challenging yet the most flexible is to use the highcharts.js API to generate multiple axes as in the examples here. This way, the dual-axis chart will be represented as a single highcharter object which means that it can be passed to renderHighchart().

Related

dygraphs/highcharter highlighting on both plots - interactivity

I am trying to replicate the following plot in dyGraph or highcharter.
df %>%
ggplot(aes(x = mts2, y = price)) +
geom_point() +
geom_jitter() +
facet_wrap(~ type, scales = "free_y", ncol = 1) +
stat_smooth(method = "lm", formula = y ~ x + I(x^2), size = 1, color = "red")
However, I would like it interactive so when the user hovers over one of the points a line is drawn to connect the rental and the purchases. So when I hover over the regression line it will highlight the regression in the other plot.
I am trying to recreate the same plot but in dygraphs or highcharter where I can highlight the same points in both regressions. (i.e. when we hoverover 80 mts2 and the points around 400,000 price it should highlight the points in the top graph around 1,500
Code:
library(dygraphs)
df %>%
filter(type == "comprar") %>%
select(-c(type, habs)) %>%
dygraph(main = "myTitle") %>%
dyOptions(drawPoints = TRUE) %>%
dySeries(drawPoints = TRUE, color = "#0099F9")
library(highcharter)
df %>%
highchart() %>%
hc_title(text = "Scatter chart with size and color") %>%
hc_add_series(df, "scatter", hcaes(x = price, y = mts2, size = mts2, color = mts2))
Data:
df = structure(list(price = c(1600, 1200, 249000, 288000, 775000,
350000, 715000, 330000, 375000, 925, 1250, 300000, 425000, 489000,
1200, 550000, 1895, 310000, 289000, 450000, 1250, 288000, 1000,
600, 1100, 350000, 1200, 339000, 405000, 427000, 299000, 218000,
159900, 360000, 365000, 725, 405000, 300000, 715000, 1300, 1400,
1500, 415000, 1500, 663, 350000, 365000, 230000, 515000, 259000,
310000, 405000, 288000, 350000, 288000, 1300, 350000, 1350, 715000,
350000, 715000, 185000, 2200, 288000, 353800, 290000, 229000,
365000, 1900, 1300, 590000, 180000, 1050, 1900, 1100, 1950, 288000,
1995, 112000, 369000, 593000, 550000, 365000, 715000, 1800, 713000,
1100, 260000, 375000, 715000, 338000, 288000, 1900, 288000, 2800,
2450, 1990, 260000, 415000, 745000), habs = c(1, 1, 1, 4, 3,
4, NA, 4, 2, 2, 2, 2, 4, 3, 3, 4, 2, 2, 3, 4, 1, 4, 1, 1, 2,
5, 3, 4, 3, 4, 2, 2, NA, 4, 3, 1, 3, 3, 3, 3, 3, 2, 4, 2, 1,
3, 3, 3, 2, 1, 2, 3, 4, 4, 4, 3, 4, 3, NA, 3, 3, 1, 3, 4, 1,
4, 3, 3, 1, 2, 3, 2, 1, 1, 2, 2, 4, 2, 1, 3, 2, 4, 3, 3, 2, 3,
3, NA, 2, 3, 3, 4, 1, 4, 4, 4, 1, NA, 4, 3), mts2 = c(70, 65,
55, 76, 121, 87, 109, 85, 81, 46, 65, 55, 100, 102, 65, 122,
66, 51, 85, 99, 50, 75, 55, 10, 75, 87, 71, 75, 83, 118, 85,
57, 45, 112, 63, 40, 83, 75, 109, 91, 74, 58, 100, 75, 42, 82,
90, 65, 104, 52, 55, 83, 79, 87, 76, 77, 87, 88, 109, 83, 109,
46, 145, 76, 40, 66, 63, 90, 45, 65, 115, 44, 46, 45, 73, 90,
79, 110, 42, 81, 73, 115, 94, 109, 70, 104, 75, 58, 80, 109,
92, 79, 45, 76, 122, 160, 47, 58, 100, 104), type = c("alquiler",
"alquiler", "comprar", "comprar", "comprar", "comprar", "comprar",
"comprar", "comprar", "alquiler", "alquiler", "comprar", "comprar",
"comprar", "alquiler", "comprar", "alquiler", "comprar", "comprar",
"comprar", "alquiler", "comprar", "alquiler", "alquiler", "alquiler",
"comprar", "alquiler", "comprar", "comprar", "comprar", "comprar",
"comprar", "comprar", "comprar", "comprar", "alquiler", "comprar",
"comprar", "comprar", "alquiler", "alquiler", "alquiler", "comprar",
"alquiler", "alquiler", "comprar", "comprar", "comprar", "comprar",
"comprar", "comprar", "comprar", "comprar", "comprar", "comprar",
"alquiler", "comprar", "alquiler", "comprar", "comprar", "comprar",
"comprar", "alquiler", "comprar", "comprar", "comprar", "comprar",
"comprar", "alquiler", "alquiler", "comprar", "comprar", "alquiler",
"alquiler", "alquiler", "alquiler", "comprar", "alquiler", "comprar",
"comprar", "comprar", "comprar", "comprar", "comprar", "alquiler",
"comprar", "alquiler", "comprar", "comprar", "comprar", "comprar",
"comprar", "alquiler", "comprar", "alquiler", "alquiler", "alquiler",
"comprar", "comprar", "comprar")), row.names = c(NA, -100L), class = c("tbl_df",
"tbl", "data.frame"))

From Boxplot to Barplot in ggplot possible?

I have to do a ggplot barplot with errorbars, Tukey sig. letters for plants grown with different fertilizer concentraitions.
The data should be grouped after the dif. concentrations and the sig. letters should be added automaticaly.
I have already a code for the same problem but for Boxplot - which is working nicely. I tried several tutorials with barplots but I always get the problem; stat_count() can only have an x or y aesthetic.
So I thought, is it possible to get my boxplot code to a barplot code? I tried but I couldnt do it :) And if not - how do I automatically add tukeyHSD Test result sig. letters to a ggplot barplot?
This is my Code for the boxplot with the tukey letters:
    value_max = Dünger, group_by(Duenger.g), summarize(max_value = max(Höhe.cm))
hsd=HSD.test(aov(Höhe.cm~Duenger.g, data=Dünger),
trt = "Duenger.g", group = T) sig.letters <- hsd$groups[order(row.names(hsd$groups)), ]
J <- ggplot(Dünger, aes(x = Duenger.g, y = Höhe.cm))+ geom_boxplot(aes(fill= Duenger.g))+ scale_fill_discrete(labels=c("0.5g", '1g', "2g", "3g", "4g"))+ geom_text(data = value_max, aes(x=Duenger.g, y = 0.1 + max_value, label = sig.letters$groups), vjust=0)+ stat_boxplot(geom = 'errorbar', width = 0.1)+ ggtitle("Auswirkung von Dünger auf die Höhe von Pflanzen") + xlab("Dünger in g") + ylab("Höhe in cm"); J
This is how it looks:
boxplot with tukey
Data from dput:
structure(list(Duenger.g = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5, 0.5,
0.5, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2,
2, 2, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4,
4, 4), plant = c(1, 2, 3, 4, 5, 7, 10, 11, 12, 13, 14, 18, 19,
21, 23, 24, 25, 26, 27, 29, 30, 31, 33, 34, 35, 37, 38, 39, 40,
41, 42, 43, 44, 48, 49, 50, 53, 54, 55, 56, 57, 58, 61, 62, 64,
65, 66, 67, 68, 69, 70, 71, 72, 73, 75, 79, 80, 81, 83, 85, 86,
88, 89, 91, 93, 99, 100, 102, 103, 104, 105, 106, 107, 108, 110,
111, 112, 113, 114, 115, 116, 117, 118, 120, 122, 123, 125, 126,
127, 128, 130, 131, 132, 134, 136, 138, 139, 140, 141, 143, 144,
145, 146, 147, 149), height.cm = c(5.7, 2.8, 5.5, 8, 3.5, 2.5,
4, 6, 10, 4.5, 7, 8.3, 11, 7, 8, 2.5, 7.4, 3, 14.5, 7, 12, 7.5,
30.5, 27, 6.5, 19, 10.4, 12.7, 27.3, 11, 11, 10.5, 10.5, 13,
53, 12.5, 12, 6, 12, 35, 8, 16, 56, 63, 69, 62, 98, 65, 77, 32,
85, 75, 33.7, 75, 55, 38.8, 39, 46, 35, 59, 44, 31.5, 49, 34,
52, 37, 43, 38, 28, 14, 28, 19, 20, 23, 17.5, 32, 16, 17, 24.7,
34, 50, 12, 14, 21, 33, 39.3, 41, 29, 35, 48, 40, 65, 35, 10,
26, 34, 41, 32, 38, 23.5, 22.2, 20.5, 29, 34, 45)), class = c("tbl_df",
"tbl", "data.frame"), row.names = c(NA, -105L))
Thank you
mirai
A bar chart and a boxplot are two different things. By default geom_boxplot computes the boxplot stats by default (stat="boxplot"). In contrast when you use geom_bar it will by default count the number of observations (stat="count") which are then mapped on y. That's the reason why you get an error. Hence, simply replacing geom_boxplot by geom_bar will not give your your desired result. Instead you could use e.g. stat_summary to create your bar chart with errorbars. Additionally I created a summary dataset to add the labels on the top of the error bars.
library(ggplot2)
library(dplyr)
library(agricolae)
Dünger <- Dünger |>
rename("Höhe.cm" = height.cm) |>
mutate(Duenger.g = factor(Duenger.g))
hsd <- HSD.test(aov(Höhe.cm ~ Duenger.g, data = Dünger), trt = "Duenger.g", group = T)
sig.letters <- hsd$groups %>% mutate(Duenger.g = row.names(.))
duenger_sum <- Dünger |>
group_by(Duenger.g) |>
summarize(mean_se(Höhe.cm)) |>
left_join(sig.letters, by = "Duenger.g")
ggplot(Dünger, aes(x = Duenger.g, y = Höhe.cm, fill = Duenger.g)) +
stat_summary(geom = "bar", fun = "mean") +
stat_summary(geom = "errorbar", width = .1) +
scale_fill_discrete(labels = c("0.5g", "1g", "2g", "3g", "4g")) +
geom_text(data = duenger_sum, aes(y = ymax, label = groups), vjust = 0, nudge_y = 1) +
labs(
title = "Auswirkung von Dünger auf die Höhe von Pflanzen",
x = "Dünger in g", y = "Höhe in cm"
)
#> No summary function supplied, defaulting to `mean_se()`
But as the summary dataset now already contains the mean and the values for the error bars a second option would be to do:
ggplot(duenger_sum, aes(x = Duenger.g, y = y, fill = Duenger.g)) +
geom_col() +
geom_errorbar(aes(ymin = ymin, ymax = ymax), width = .1) +
scale_fill_discrete(labels = c("0.5g", "1g", "2g", "3g", "4g")) +
geom_text(aes(y = ymax, label = groups), vjust = 0, nudge_y = 1) +
labs(
title = "Auswirkung von Dünger auf die Höhe von Pflanzen",
x = "Dünger in g", y = "Höhe in cm"
)

Surface in plotly does not cover all data, leaving a gap between surface and highlight

I am using a plotly surface plot with data that has some missing values.
As you can see in the example below, I am using highlight lines to show the surface does not reach the highlight, leaving a weird empty gap. It is not a matter of perspective, as the gap also shows in a cenital plane.
To be more specific, below I am hovering on row 12, column 2006, and although the missing data starts in row 13, in the plot the missing data seems to start before row 12 ("row 11.9"). My expectation would be that the purple surface would reach all the way to the bright blue highlight in row 12.
Is this a bug, or there is a parameter to make sure this does not happen?
Thanks!
library(dplyr)
library(plotly)
DF_RAW = structure(c(181, 163, 60, 124, 76, 62, 73, 59, 17, 21, 26, 7, NA, NA, NA,
188, 145, 61, 130, 61, 59, 62, 57, 20, 22, 22, 6, NA, NA, NA,
137, 154, 54, 191, 75, 56, 65, 56, 22, 27, 33, 14, NA, NA, NA,
126, 185, 65, 109, 51, 71, 57, 38, 25, 23, 21, 10, NA, NA, NA,
150, 144, 44, 123, 58, 24, 48, 41, 19, 26, 21, 5, NA, NA, NA,
138, 137, 61, 130, 67, 34, 60, 44, 19, 21, 16, 4, NA, NA, NA,
121, 146, 101, 92, 70, 74, 88, 33, 18, 39, 24, 12, NA, NA, NA,
NA, 160, 129, 117, 70, 61, 42, 35, 22, 25, 21, 7, 10, 23, 8,
NA, 129, 130, 107, 64, 61, 44, 25, 23, 30, 18, 11, 20, 58, 40,
NA, 136, 131, 96, 53, 31, 51, 37, 43, 31, 19, 2, 22, 40, 41,
NA, 124, 154, 74, 62, 44, 34, 15, 26, 23, 20, 6, 23, 10, 19,
NA, 126, 251, 76, 73, 84, 47, 40, 32, 25, 32, 6, 13, 10, 13,
NA, 129, 194, 91, 53, 99, 46, 34, 60, 21, 17, 6, 14, 14, 26,
NA, 115, 119, 88, 64, 108, 37, 24, 49, 26, 17, 6, 15, 15, 47),
.Dim = 15:14,
.Dimnames = list(c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15"),
c("2006", "2007", "2008", "2009", "2010", "2011", "2012", "2013", "2014", "2015", "2016", "2017", "2018", "2019")))
DF = DF_RAW
plot1 = plotly::plot_ly(x = ~ colnames(DF),
y = ~ rownames(DF),
z = ~ DF) %>%
plotly::add_surface(name = "3D mesh",
connectgaps = TRUE, hidesurface = TRUE,
contours = list(
x = list(show = TRUE, width = 1, highlightwidth = 2, highlightcolor = "#41a7b3", highlight = TRUE),
y = list(show = TRUE, width = 1, highlightwidth = 2, highlightcolor = "#41a7b3", highlight = TRUE),
z = list(show = FALSE, width = 1, highlightwidth = 2, highlightcolor = "#41a7b3", highlight = FALSE)
)) %>%
plotly::add_surface(name = "surface",
connectgaps = FALSE,
contours = list(
x = list(show = F, width = 1, highlightwidth = 2, highlightcolor = "#41a7b3", highlight = TRUE),
y = list(show = F, width = 1, highlightwidth = 2, highlightcolor = "#41a7b3", highlight = TRUE),
z = list(show = FALSE, width = 1, highlightwidth = 2, highlightcolor = "#41a7b3", highlight = FALSE)
)
)
plot1
EDIT:To emphasize that this is not a matter of perspective, here a cenital view of the plot. The gap is still visible.
plot1 %>%
plotly::layout(
scene = list(
camera = list(
eye = list(x = 0, y = 0, z = 2),
center = list(x = 0, y = 0, z = 0),
up = list(x = 0, y = 0, z = 1)
)
)
)
And if we get rid of the 3d mesh and show only the surface with the highlight, see how in row 11 (right) is very clear we have all the data (blue highlight goes all the way from top to bottom) but in row 12 it seems we only have data up to 2013 (blue line stops there).
plotly::plot_ly(x = ~ colnames(DF),
y = ~ rownames(DF),
z = ~ DF, showscale = FALSE) %>%
plotly::add_surface(name = "surface",
connectgaps = FALSE,
contours = list(
x = list(show = F, width = 1, highlightwidth = 2, highlightcolor = "#41a7b3", highlight = TRUE),
y = list(show = F, width = 1, highlightwidth = 2, highlightcolor = "#41a7b3", highlight = TRUE),
z = list(show = FALSE, width = 1, highlightwidth = 2, highlightcolor = "#41a7b3", highlight = FALSE)
)
) %>%
plotly::layout(
scene = list(
xaxis = list(showspikes = FALSE),
yaxis = list(showspikes = FALSE),
zaxis = list(showspikes = FALSE),
camera = list(
eye = list(x = 0, y = 0, z = 2),
center = list(x = 0, y = 0, z = 0),
up = list(x = 0, y = 0, z = 1)
)
)
)

Tidyverse change values based on name

I have a dataframe as follows
library(tidyverse)
library(tidymodels)
#df <- read_csv("C:\\Users\\omarl\\OneDrive\\Escritorio\\games.csv")
df <- structure(list(gameId = 3326086514, creationTime = 1504279457970,
gameDuration = 1949, seasonId = 9, winner = 1, firstBlood = 2,
firstTower = 1, firstInhibitor = 1, firstBaron = 1, firstDragon = 1,
firstRiftHerald = 2, t1_champ1id = 8, t1_champ1_sum1 = 12,
t1_champ1_sum2 = 4, t1_champ2id = 432, t1_champ2_sum1 = 3,
t1_champ2_sum2 = 4, t1_champ3id = 96, t1_champ3_sum1 = 4,
t1_champ3_sum2 = 7, t1_champ4id = 11, t1_champ4_sum1 = 11,
t1_champ4_sum2 = 6, t1_champ5id = 112, t1_champ5_sum1 = 4,
t1_champ5_sum2 = 14, t1_towerKills = 11, t1_inhibitorKills = 1,
t1_baronKills = 2, t1_dragonKills = 3, t1_riftHeraldKills = 0,
t1_ban1 = 92, t1_ban2 = 40, t1_ban3 = 69, t1_ban4 = 119,
t1_ban5 = 141, t2_champ1id = 104, t2_champ1_sum1 = 11, t2_champ1_sum2 = 4,
t2_champ2id = 498, t2_champ2_sum1 = 4, t2_champ2_sum2 = 7,
t2_champ3id = 122, t2_champ3_sum1 = 6, t2_champ3_sum2 = 4,
t2_champ4id = 238, t2_champ4_sum1 = 14, t2_champ4_sum2 = 4,
t2_champ5id = 412, t2_champ5_sum1 = 4, t2_champ5_sum2 = 3,
t2_towerKills = 5, t2_inhibitorKills = 0, t2_baronKills = 0,
t2_dragonKills = 1, t2_riftHeraldKills = 1, t2_ban1 = 114,
t2_ban2 = 67, t2_ban3 = 43, t2_ban4 = 16, t2_ban5 = 51), row.names = c(NA,
-1L), class = c("tbl_df", "tbl", "data.frame"))
df <- df %>%
mutate(winner = ifelse(winner == 1, "team1", "team2")) %>%
mutate(firstBlood = ifelse(firstBlood == 1, "team1", "team2")) %>%
mutate(firstTower = ifelse(firstTower == 1, "team1", "team2")) %>%
mutate(firstInhibitor = ifelse(firstInhibitor == 1, "team1", "team2")) %>%
mutate(firstBaron = ifelse(firstBaron == 1, "team1", "team2")) %>%
mutate(firstDragon = ifelse(firstDragon == 1, "team1", "team2")) %>%
mutate(firstRiftHerald = ifelse(firstRiftHerald == 1, "team1", "team2")) %>%
select(-gameId, -creationTime) %>%
filter(seasonId == 9) %>%
select(gameDuration, winner, firstBlood, firstTower, firstInhibitor, firstBaron, firstDragon,
firstRiftHerald)
As you can see, mutate is really redundant here, because I'm copying the code for every variable. Is there any way to apply the ifelse to columns that start with first, t1, etc. programatically?
You may try
library(dplyr)
df %>%
mutate(across(starts_with("t1")|starts_with("first"), ~ifelse(.x == 1, "team1", "team2")))
Park gave a best (one liner) solution. But if you want to look at some other options, here is how we can do it via using some other functions in dplyr:
df %>%
gather(key, value, firstBlood:t1_ban5) %>%
mutate(value = ifelse(value == 1, "team1", "team2")) %>%
spread(key, value) %>%
select(-gameId, -creationTime) %>%
filter(seasonId == 9) %>%
select(gameDuration, winner, firstBlood, firstTower, firstInhibitor, firstBaron, firstDragon,
firstRiftHerald)

Plotly: How to set manual zoom for camera view in a 3D plot?

I use the data below to create a 3D plot but I cannot get the full axis to show. Can I set the original zoom so that it shows the entire plot?
> dput(analysis[,c(1:3)])
structure(list(L = c(60, 70, 80, 90, 100, 110, 120, 130, 140,
60, 70, 80, 90, 100, 110, 120, 130, 140, 60, 70, 80, 90, 100,
110, 120, 130, 140, 60, 70, 80, 90, 100, 110, 120, 130, 140),
S = c(6, 6, 6, 6, 6, 6, 6, 6, 6, 7.5, 7.5, 7.5, 7.5, 7.5,
7.5, 7.5, 7.5, 7.5, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10.5, 10.5,
10.5, 10.5, 10.5, 10.5, 10.5, 10.5, 10.5), theta = c(0.387648377238727,
0.365065109815399, 0.361945691353903, 0.308994736435413,
0.31312106684787, 0.347902392899031, 0.322177548286843, 0.313365432864246,
0.318566760330453, 0.329343960085812, 0.4305266050694, 0.412161930763136,
0.405615100181224, 0.342671510183088, 0.379821799998522,
0.351607159033827, 0.338622255013142, 0.330437773555393,
0.359828622589832, 0.43564477128519, 0.446968516154636, 0.364471191945187,
0.311372659889749, 0.343410820556976, 0.319743944825857,
0.367342095248675, 0.303374120182854, 0.402025212310935,
0.486427167733943, 0.402463557214462, 0.380560495098558,
0.32606222794188, 0.383477501221339, 0.315207079133179, 0.359243336292084,
0.338734658604223)), class = "data.frame", row.names = c(NA, -36L))
fig <- plot_ly(analysis, x = ~L, y = ~S, z = ~theta) %>%
add_markers(opacity = 0.6) %>%
layout(scene = list(xaxis = list(title = 'Span Length (ft)'),
yaxis = list(title = 'Girder Spacing (ft)'),
zaxis = list(title = 'End Rotation (deg)')),
margin = list(b=130), annotations =
list(x = 0.9, y = -0.2, text = "<i>Figure 4. Relationship between the input variables used in the parametric study.</i>",
showarrow = F, xref='paper', yref='paper',
xanchor='right', yanchor='auto', xshift=0, yshift=0,
font=list(size=15)))
Below is a screenshot of the HTML output:
You'll have to find a combination of x, y, and z in scene = list(camera = list(eye = list(x=1.5, y=3, z = 0.1))) that suits your needs.
Your code snippet is not reproducible, but we can recreate the problem using:
fig <- plot_ly(z = ~volcano)
fig <- fig %>% add_surface()
fig
Now, just include:
scene = list(camera = list(eye = list(x=1.5, y=3, z = 0.1)))
fig <- fig %>% layout(title = "changed zoom", scene = scene)
And you'll get:

Resources