1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
|
# bivariate scatterplot
bivariate_transform_x <-
eventReactive(input$bivariate_transform_go > 0, input$bivariate_transform_x)
bivariate_transform_y <-
eventReactive(input$bivariate_transform_go > 0, input$bivariate_transform_y)
bivariate_plot <- reactive({
validate(
need(input$param, message = FALSE),
need(input$bivariate_ellipse_lev, message = FALSE),
need(input$bivariate_param_y, message = FALSE)
)
if (!is.null(input$bivariate_ellipse_lev)) {
validate(
need(is.numeric(input$bivariate_pt_size), message = "Point size must be numeric"),
need(is.numeric(input$bivariate_pt_shape), message = "Point shape must be numeric")
)
if (input$bivariate_ellipse_lev != "None") {
validate(
need(
input$param != input$bivariate_param_y,
"For this option the x and y can't be the same parameter."
),
need(
is.numeric(input$bivariate_ellipse_lwd),
message = "Ellipse size must be numeric"
),
need(
is.numeric(input$bivariate_ellipse_lty),
message = "Ellipse shape must be numeric"
)
)
}
}
do.call(
".bivariate_plot",
args = list(
samps = SAMPS_post_warmup,
sp = if (!identical(SAMPLER_PARAMS_post_warmup, FALSE) && STAN_ALGORITHM == "NUTS")
SAMPLER_PARAMS_post_warmup else NULL,
max_td = if ("max_td" %in% names(MISC)) MISC$max_td else NULL,
param = input$param,
param2 = input$bivariate_param_y,
pt_alpha = input$bivariate_pt_alpha,
pt_size = input$bivariate_pt_size,
pt_shape = input$bivariate_pt_shape,
pt_color = input$bivariate_pt_color,
ellipse_lev = input$bivariate_ellipse_lev,
ellipse_color = input$bivariate_ellipse_color,
ellipse_lty = input$bivariate_ellipse_lty,
ellipse_lwd = input$bivariate_ellipse_lwd,
ellipse_alpha = input$bivariate_ellipse_alpha,
lines = input$bivariate_lines,
lines_color = input$bivariate_lines_color,
lines_alpha = input$bivariate_lines_alpha,
transform_x = bivariate_transform_x(),
transform_y = bivariate_transform_y()
)
)
})
output$bivariate_plot_out <- renderPlot({
x <- bivariate_plot()
suppressWarnings(print(x))
}, bg = "transparent")
# download
output$download_bivariate <- downloadHandler(
filename = 'shinystan-bivariate-gg.RData',
content = function(file) {
shinystan_bivariate_gg <- bivariate_plot()
save(shinystan_bivariate_gg, file = file)
}
)
output$save_pdf_bivariate = downloadHandler(
filename = "shinstan-bivariate.pdf",
content = function(file) {
ggsave(file, plot = bivariate_plot(), device = pdf)
}
)
|
