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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
|
library(shiny)
library(bslib)
library(plotly)
library(leaflet)
library(gt)
plot_hist <- function(var) {
config(
plot_ly(y = diamonds[[var]], type = "histogram"),
displayModeBar = FALSE
)
}
lorem_ipsum_dolor_sit_amet <- "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Id nibh tortor id aliquet lectus proin nibh nisl. Adipiscing at in tellus integer feugiat. Arcu bibendum at varius vel pharetra vel turpis nunc eget. Cursus sit amet dictum sit amet justo. Sit amet consectetur adipiscing elit. Vestibulum mattis ullamcorper velit sed ullamcorper. Enim facilisis gravida neque convallis a. Elit duis tristique sollicitudin nibh sit amet. Magna eget est lorem ipsum. Gravida dictum fusce ut placerat orci nulla pellentesque dignissim. Mauris in aliquam sem fringilla ut morbi. Id semper risus in hendrerit gravida rutrum quisque non tellus. At erat pellentesque adipiscing commodo elit at imperdiet dui. Fames ac turpis egestas maecenas pharetra convallis posuere morbi. Duis convallis convallis tellus id interdum velit laoreet id. Aliquet lectus proin nibh nisl. Nunc vel risus commodo viverra maecenas accumsan lacus vel facilisis. Bibendum enim facilisis gravida neque convallis a."
main_grid <- layout_column_wrap(
width = 1/3, heights_equal = "row",
card(
full_screen = TRUE,
card_header("DT::dataTableOutput()"),
card_body_fill(DT::dataTableOutput("DT"))
),
navs_pill_card(
title = "Shiny outputs",
full_screen = TRUE,
wrapper = card_body_fill,
nav(
"plotOutput",
plotOutput("plot"),
card_body(
height = "100px",
lorem_ipsum_dolor_sit_amet
)
),
nav("imageOutput", plotOutput("image"))
),
card(
full_screen = TRUE,
card_header("leaflet (via uiOutput())"),
card_body_fill(uiOutput("leaflet", fill = TRUE))
),
card(
full_screen = TRUE,
card_header("plotly::plotlyOutput()"),
layout_column_wrap(
width = 1/2,
plotlyOutput("cut"),
plotlyOutput("clarity")
),
card_body_fill(plotlyOutput("price"))
),
card(
full_screen = TRUE,
card_header("Static plotly"),
card_body_fill(plot_hist("price")),
layout_column_wrap(
width = 1/2,
plot_hist("cut"),
plot_hist("clarity")
)
),
layout_column_wrap(
width = 1,
card(
full_screen = TRUE,
card_header("card_image()"),
card_image(
file = "www/shiny-hex.svg",
height = 200,
href = "https://github.com/rstudio/shiny"
)
),
card(
full_screen = TRUE,
card_header("Scrollable gt()"),
card_body_fill(
max_height = "400px",
max_height_full_screen = "100%",
gt::gt(mtcars)
)
)
)
)
grid_height <- "calc(100vh - 5px)"
ui <- page_fluid(
theme = bs_theme(
"card-cap-bg" = "#212529",
"card-cap-color" = "white"
),
layout_column_wrap(
width = NULL, heights_equal = "row",
height = grid_height,
style = css(grid_template_columns = "200px 1fr"),
id = "grid_page",
card(
card_header("Input controls", class = "bg-primary"),
checkboxInput(
"fixed_height",
"Fix height to viewport (this only applies to wide screens)",
value = TRUE
)
),
main_grid
)
)
server <- function(input, output, session) {
theme_set(theme_minimal(base_size = 16))
observeEvent(input$fixed_height, ignoreInit = TRUE, {
css <- sprintf(
"#grid_page { height: %s !important; }",
if (input$fixed_height) grid_height else "auto"
)
insertUI(selector = "head", ui = tags$style(HTML(css)))
})
output$DT <- DT::renderDataTable({
DT::datatable(mtcars, fillContainer = TRUE)
})
output$plot <- renderPlot({
ggplot(mtcars) + geom_point(aes(wt, mpg))
})
output$image <- renderImage({
list(src = "www/shiny-hex.svg", width = "100%", height = "100%")
}, deleteFile = FALSE)
output$cut <- renderPlotly(plot_hist("cut"))
output$clarity <- renderPlotly(plot_hist("clarity"))
output$price <- renderPlotly(plot_hist("price"))
output$leaflet <- renderUI({
addTiles(leaflet())
})
output$gt <- render_gt(gt(mtcars[1:5, ]))
}
shinyApp(ui, server)
|
