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
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
pp_hists_test_statistics_mean <- reactive({
pp_tests()
y <- get_y()
yrep <- get_yrep()
mean_y <- mean(y)
mean_yrep <- apply(yrep, 1, mean)
do.call(".pp_hists_test_statistics", args = list(
stat_y = mean_y,
stat_yrep = mean_yrep,
which = "mean",
geom = input$pp_hists_test_statistics_type
))
})
pp_hists_test_statistics_sd <- reactive({
pp_tests()
y <- get_y()
yrep <- get_yrep()
sd_y <- sd(y)
sd_yrep <- apply(yrep, 1, sd)
do.call(".pp_hists_test_statistics", args = list(
stat_y = sd_y,
stat_yrep = sd_yrep,
which = "sd",
geom = input$pp_hists_test_statistics_type
))
})
pp_hists_test_statistics_min <- reactive({
pp_tests()
y <- get_y()
yrep <- get_yrep()
min_y <- min(y)
min_yrep <- apply(yrep, 1, min)
do.call(".pp_hists_test_statistics", args = list(
stat_y = min_y,
stat_yrep = min_yrep,
which = "min",
geom = input$pp_hists_test_statistics_type
))
})
pp_hists_test_statistics_max <- reactive({
pp_tests()
y <- get_y()
yrep <- get_yrep()
max_y <- max(y)
max_yrep <- apply(yrep, 1, max)
do.call(".pp_hists_test_statistics", args = list(
stat_y = max_y,
stat_yrep = max_yrep,
which = "max",
geom = input$pp_hists_test_statistics_type
))
})
pp_test_stats <- c("mean", "sd", "min", "max")
for (i in seq_along(pp_test_stats)) {
local({
fn <- paste0("pp_hists_test_statistics_", pp_test_stats[i])
output[[paste0(fn,"_out")]] <- renderPlot({
x <- suppressMessages(do.call(fn, list()))
suppress_and_print(x)
}, bg = "transparent")
})
}
# pp_hists_test_statistics_custom1 <- reactive({
# tests()
# validate(need(input$pp_test_statistics_fun1, message = ""))
# y <- get_y()
# yrep <- get_yrep()
#
# fun <- input$pp_test_statistics_fun1
# if (grepl("function", fun)) {
# f <- eval(parse(text = fun))
# stat_y <- f(y)
# stat_yrep <- apply(yrep, 1, FUN = f)
# } else {
# stat_y <- do.call(fun, args = list(y))
# stat_yrep <- apply(yrep, 1, paste(fun))
# }
#
# do.call(".pp_hists_test_statistics", args = list(
# stat_y = stat_y,
# stat_yrep = stat_yrep,
# which = "f",
# geom = input$pp_hists_test_statistics_type
# ))
# })
# pp_hists_test_statistics_custom2 <- reactive({
# tests()
# if (is.null(input$pp_test_statistics_fun2) | is.na(input$pp_test_statistics_fun2)) {
# return(last_plot())
# }
# y <- get_y()
# yrep <- get_yrep()
# stat_y <- do.call(input$pp_test_statistics_fun2, args = list(y))
# stat_yrep <- apply(yrep, 1, paste(input$pp_test_statistics_fun2))
#
# do.call(".pp_hists_test_statistics", args = list(
# stat_y = stat_y,
# stat_yrep = stat_yrep,
# which = paste(input$pp_test_statistics_fun2),
# geom = input$pp_hists_test_statistics_type
# ))
# })
|
