1
1
library(shiny )
2
2
library(bslib )
3
3
library(tidyverse )
4
- library(future )
5
- library(promises )
6
4
7
- plan(multisession )
8
-
9
- survey <- arrow :: read_parquet(" data/survey.parquet" )
5
+ survey <- read.csv(" data/survey.csv" ) | >
6
+ slice_sample(n = 5000 , by = region )
10
7
11
8
ui <- page_sidebar(
12
9
@@ -23,77 +20,65 @@ ui <- page_sidebar(
23
20
max = 100 ,
24
21
value = 100 ,
25
22
step = 10
26
- ),
27
- input_task_button(
28
- id = " compute" ,
29
- label = " Calcular"
30
23
)
31
24
),
32
25
33
26
useBusyIndicators(),
34
27
35
28
card(
36
29
max_height = " 50%" ,
37
- DT :: DTOutput (" table" )
30
+ tableOutput (" table" )
38
31
),
39
32
40
33
layout_columns(
41
34
col_widths = c(4 , 4 , 4 ),
42
35
43
36
card(
44
- plotly :: plotlyOutput (" histogram" )
37
+ plotOutput (" histogram" )
45
38
),
46
39
card(
47
40
full_screen = TRUE ,
48
- plotly :: plotlyOutput (" by_transport" )
41
+ plotOutput (" by_transport" )
49
42
),
50
43
card(
51
44
full_screen = TRUE ,
52
- plotly :: plotlyOutput (" by_type" )
45
+ plotOutput (" by_type" )
53
46
)
54
47
55
48
)
56
49
57
50
)
58
51
59
52
server <- function (input , output , session ) {
60
- filter_task <- ExtendedTask $ new(function (p_survey , p_region , p_age ) {
61
- future_promise({
62
- p_survey | >
63
- dplyr :: filter(region == p_region ) | >
64
- dplyr :: filter(age < = p_age )
65
- })
66
- }) | >
67
- bind_task_button(" compute" )
68
-
69
- observe(filter_task $ invoke(survey , input $ region , input $ age )) | >
70
- bindEvent(input $ compute , ignoreNULL = FALSE )
71
-
72
- filtered <- reactive({
73
- filter_task $ result()
74
- })
75
-
76
- output $ table <- DT :: renderDT({
77
- filtered()
53
+ output $ table <- renderTable({
54
+ survey | >
55
+ filter(region == input $ region ) | >
56
+ filter(age < = input $ age )
78
57
})
79
58
80
- output $ histogram <- plotly :: renderPlotly({
81
- filtered() | >
59
+ output $ histogram <- renderPlot({
60
+ survey | >
61
+ filter(region == input $ region ) | >
62
+ filter(age < = input $ age ) | >
82
63
ggplot(aes(temps_trajet_en_heures )) +
83
64
geom_histogram(bins = 20 ) +
84
65
theme_light()
85
66
})
86
67
87
- output $ by_transport <- plotly :: renderPlotly({
88
- filtered() | >
68
+ output $ by_transport <- renderPlot({
69
+ survey | >
70
+ filter(region == input $ region ) | >
71
+ filter(age < = input $ age ) | >
89
72
ggplot(aes(temps_trajet_en_heures )) +
90
73
geom_histogram(bins = 20 ) +
91
74
facet_wrap(~ transport ) +
92
75
theme_light()
93
76
})
94
77
95
- output $ by_type <- plotly :: renderPlotly({
96
- filtered() | >
78
+ output $ by_type <- renderPlot({
79
+ survey | >
80
+ filter(region == input $ region ) | >
81
+ filter(age < = input $ age ) | >
97
82
ggplot(aes(temps_trajet_en_heures )) +
98
83
geom_histogram(bins = 20 ) +
99
84
facet_wrap(~ type ) +
0 commit comments