Klaudia Lenart
library(ggplot2)Warning: pakiet 'ggplot2' został zbudowany w wersji R 4.2.3library(dplyr)
Dołączanie pakietu: 'dplyr'Następujące obiekty zostały zakryte z 'package:stats':
filter, lagNastępujące obiekty zostały zakryte z 'package:base':
intersect, setdiff, setequal, unionlibrary(tidyr)
library(shiny)Warning: pakiet 'shiny' został zbudowany w wersji R 4.2.3library(shinythemes)Warning: pakiet 'shinythemes' został zbudowany w wersji R 4.2.3library(gapminder)Warning: pakiet 'gapminder' został zbudowany w wersji R 4.2.3head(gapminder)# A tibble: 6 × 6
country continent year lifeExp pop gdpPercap
<fct> <fct> <int> <dbl> <int> <dbl>
1 Afghanistan Asia 1952 28.8 8425333 779.
2 Afghanistan Asia 1957 30.3 9240934 821.
3 Afghanistan Asia 1962 32.0 10267083 853.
4 Afghanistan Asia 1967 34.0 11537966 836.
5 Afghanistan Asia 1972 36.1 13079460 740.
6 Afghanistan Asia 1977 38.4 14880372 786.By możliwy był wybór przez użytkownika, która zmienna ma zostać przedstawiona na wykresie słupkowym dane należy przekształcić funkcja pivot_longer przeniesie wszystkie wartości trzech zmiennych do jednej kolumny a ich nazwy do drugiej. Liczba wierszy zwiększy się trzykrotnie. Niektóre kolumny zostaną przekształcone na factor ze względów estetycznych.
dane <- gapminder%>% pivot_longer(cols = c('lifeExp','pop','gdpPercap'),
names_to = "zmienna",
values_to = "wartość") %>%
mutate(zmienna=factor(zmienna,levels=c("lifeExp","pop","gdpPercap"),
labels = c("średnia długość życia","populacja","PKB per capita")))Wartości kilku kolorów które zostaną użyte w wykresach
k<- "#2b3e4f"
k2<-"#ededef"
k3<- "#df6916"
k4<-"#9d9da1"Pakiet shiny pozwala na tworzenie internatywnych aplikacji.
Składają się one z dwóch głownych elementów - interfejsu użytkownika i serwera.
Aplikację taką można uruchomić za pomocą Rstudio lub opublikować jako stronę internetową.
W ramach elementu ui zdefiniowany zostanie interfejs użytkownika.
Ta część aplikacji definiuje jakie elementy wyśwpietlane są po uruchomieniu alplikacji oraz ich układ i wygląd.
ui <- fluidPage(
#wybór motywu
theme = shinytheme("superhero"),
#tytuł dashboardu
titlePanel("Interaktywny dashboard z pakietem shiny"),
#wewnątrz funkcji tabsetPanel zagnieżdżone są definiujące poszczególne karty funkcje tabPanel()
tabsetPanel(
##pierwsza karta
tabPanel("Gapminder - ogólne statystyki",
###panel boczny
sidebarLayout(
sidebarPanel(
####wybór daty - suwak
####pierwszy argument to nazwa elementu input
####można się do nich odnosić skryptach wykonywanych przez serwer
####tutaj na przykład użytkownik wybiera dla jakiego roku sporządzony będzie wykres
sliderInput("data_slupkowy",
#opis elemetu widoczny dla użytkownika
"Wybierz datę:",
#wartości minimalne i maksymalne suwaka
min = 1952,
max = 2007,
#wartość domyślna
value=2007,
#co ile można się przesunąć suwakiem
#zbiór gapminder zawiera obserwacje co pięć lat dlatego step=5
#należy unikać możliwości wybrania suwakiem wartości niewystępujących w danych
#jeżeli wartość ta ma być użyta do filtorwania
step=5,
sep=""),
####wybór zmiennej - lista rozwijana
selectInput("zmienna_slupkowy",
"Wybierz zmienną:",
#możliwe do wybrania wartości
choices = c("średnia długość życia","populacja","PKB per capita"))),
###wyświetlany wykres słupkowy
###sam wykres zostanie zdefiniowany w ramach elementu serwer
mainPanel(
plotOutput("wykres_slupkowy")
)
)),
##druga karta
tabPanel("Gapminder - wykres bąbelkowy",
###panel boczny
sidebarLayout(
sidebarPanel(
####wybór daty - suwak
sliderInput("data_babelkowy",
"Wybierz datę:",
min = 1952,
max = 2007,
value=2007,
step=5,
sep="",
#animacja - klatka po klatce zobaczyć będzie można poszczególne lata
animate = TRUE),
####wybór kontynentów - lista z checkboxami
####w przeciwieństwie do rozwijanej pozwala na wybór wielu elementów jednocześnie
checkboxGroupInput("kontynenty_babelkowy",
"Wybierz wyświetlane kontynenty:",
#możliwe do wybrania wartości
choices = c("Azja","Europa","Afryka","Ameryki","Oceania"),
#wartości domyślnie wybrane
selected = c("Azja","Europa","Afryka","Ameryki","Oceania"))),
###wyświetlany wykres bąbelkowy
mainPanel(
plotOutput("wykres_babelkowy")
)
)),
#trzecia karta
tabPanel("Rozwój krajów Europy",
###w ramach tej karty zaprezentowany zostanie sposób na umieszczenie
###kilku wykresów jednocześnie w jednej karcie
sidebarLayout(
sidebarPanel(
####wybór zmiennej - lista rozwijana
selectInput("kraj_liniowy",
"Wybierz kraj:",
#zamiast wypisywać możliwe wartości kod odwołuje się bezpośrednio do danych
choices = unique(gapminder%>%filter(continent=="Europe")%>%select(country)))),
###wyświetlane wykresy liniowe
mainPanel(
####wszystkie wykresy umieszczone są w funkcji fluidRow
####każdy umieszczony jest w osobnej funkcji column
####pierwszy argument funkcji kolumn decyduje o szerokości argumentu z 12 jako maksimum
####w celu umieszczenia dwóch wykresów obok siebie zamiast pod sobą 12 należałoby zamienić na 4
####(tak by suma szerokości 3 wykresów była równa 12)
fluidRow(
column(12,plotOutput("wykres_liniowy1")),
column(12,plotOutput("wykres_liniowy2")),
column(12,plotOutput("wykres_liniowy3"))
)
)
))
)
)W ramach serwera zostanie zapisany kod R, który wykonywany będzie przez dashboard.
W tym przypadku będą to głównie wykresy jednak można tu umieścić obliczenia, przekształcenia danych itp.
server <- function(input, output) {
#wykres słupkowy
##wykres zostaje zapisany jako część elementu output
##do tych nazw odwoływać się można w ramach ui by wykres był widoczny w dashboardzie
##kod tworzący wykres obudowany jest funkcją renderPlot
output$wykres_slupkowy <- renderPlot({
###dane są filtorwane tak by ograniczyć je do zmiennej i roku
###wybranych przez użytkownika
###przywołane zostają input$zmienna_slupkowy i input$data_slupkowy,
###których nazwy zostały zdefiniowane w funkcjach tworzących
###suwak i listę rozwijaną pierwszej karty
dane%>%filter(zmienna==input$zmienna_slupkowy,
year==input$data_slupkowy)%>%
###dane zostają ograniczone do 20 obserwacji o najwyższych wartościach
###wybranej zmiennej w wybranym roku
slice_max(order_by = wartość,n=20)%>%
###tworzenie wykresu ggpolt
ggplot(aes(y=reorder(country, wartość),x=wartość))+
geom_bar(stat='identity',fill=k3)+
geom_text(aes(label=wartość),color=k2,fontface='bold')+
theme(
panel.background = element_rect(fill = k, colour = k4,
size = 0.5, linetype = "solid"),
panel.grid.major = element_line(size = 0.1, linetype = 'solid',
colour = k4),
panel.grid.minor = element_line(size = 0.1, linetype = 'solid',
colour = k4),
plot.background = element_rect(fill = k),
axis.title= element_text(colour =k2,size=10,face='bold'),
axis.text= element_text(colour =k2,size=10,face='bold'))+
###do zdefiniowanego przez użytkownika inputu można odwoływać się
###nie tylko w celu filtrowania danych
### na przykład niżej opis osi bedzie zmieniał się w zależności od wybranej zmiennej
labs(x=input$zmienna_slupkowy,y="")
})
#wykres bąbelkowy
##po raz kolejny wykres zapisany jest jako część outputu, sam kod generujący wykres umieszczony jest w funkcji renderPlot
##tym razem odtworzony zostanie znany sposób prezentacji danych gapminder - wykres bąbelkowy
output$wykres_babelkowy <- renderPlot({gapminder%>%
###zmienna continent przeształcona jest na factor tak by możliwe było użycie
###w elementach interfejsu polskich nazw kontynentów
mutate(continent=factor(continent,
levels = c("Asia","Europe","Africa","Americas","Oceania"),
labels = c("Azja","Europa","Afryka","Ameryki","Oceania")))%>%
###dane ograniczone zostają do wybranego za pomocą suwaka roku
###należy pamiętać że w tym przypadku suwak umożliwia animację wykresu
###tzn. dane będą filtrowane wielokrotnie,
###w tym wypadku również wykres będzie wielokrotnie tworzony
filter(year==input$data_babelkowy,
###użytkownik ma mozliwość wyboru wielu kontynentów na raz
###więc w filtrze wykorzystano operator %in%
continent %in% input$kontynenty_babelkowy)%>%
###tworzenie wykresu ggpolt
ggplot(aes(y=lifeExp,x=gdpPercap,color=continent,size=pop))+
geom_point()+
theme(
panel.background = element_rect(fill = k, colour = k4,
size = 0.5, linetype = "solid"),
panel.grid.major = element_line(size = 0.1, linetype = 'solid',
colour = k4),
panel.grid.minor = element_line(size = 0.1, linetype = 'solid',
colour = k4),
plot.background = element_rect(fill = k),
legend.background = element_rect(fill = k),
axis.title= element_text(colour =k2,size=10,face='bold'),
legend.title= element_text(colour =k2,size=10,face='bold'),
axis.text= element_text(colour =k2,size=10,face='bold'),
legend.text= element_text(colour =k2,size=10,face='bold'))+
labs(x="PKB per capita",y="średnia długość życia")+
###stałe zakresy wartości dla osi oraz rozmiaru punktów wprowadzono
###by legenda i osie nie zmieniały się podczas animacji
###w przeciwnym wypadku każdy wykres miałby trochę inną skalę na osiach
###oraz w legendzie dopasowaną do danych dla danego roku
xlim(0,60000)+
ylim(0,84)+
scale_size(limits = c(60000,1319000000))+
labs(size="Populacja", color="Kontynent")
})
#wykresy liniowe
##dla karty trzeciej przygotowane zostaną trzy osobne wykresy
output$wykres_liniowy1 <- renderPlot({
gapminder_unfiltered%>%filter(country==input$kraj_liniowy)%>%
ggplot(aes(y=lifeExp,x=year))+
geom_line(color=k3,size=2)+
theme(
panel.background = element_rect(fill = k, colour = k4,
size = 0.5, linetype = "solid"),
panel.grid.major = element_line(size = 0.1, linetype = 'solid',
colour = k4),
panel.grid.minor = element_line(size = 0.1, linetype = 'solid',
colour = k4),
plot.background = element_rect(fill = k),
axis.title= element_text(colour =k2,size=10,face='bold'),
axis.text= element_text(colour =k2,size=10,face='bold'))+
labs(x="",y="średnia długość życia")
})
output$wykres_liniowy2 <- renderPlot({
gapminder_unfiltered%>%filter(country==input$kraj_liniowy)%>%
ggplot(aes(y=pop,x=year))+
geom_line(color=k3,size=2)+
theme(
panel.background = element_rect(fill = k, colour = k4,
size = 0.5, linetype = "solid"),
panel.grid.major = element_line(size = 0.1, linetype = 'solid',
colour = k4),
panel.grid.minor = element_line(size = 0.1, linetype = 'solid',
colour = k4),
plot.background = element_rect(fill = k),
axis.title= element_text(colour =k2,size=10,face='bold'),
axis.text= element_text(colour =k2,size=10,face='bold'))+
labs(x="",y="populacja")
})
output$wykres_liniowy3 <- renderPlot({
gapminder_unfiltered%>%filter(country==input$kraj_liniowy)%>%
ggplot(aes(y=gdpPercap,x=year))+
geom_line(color=k3,size=2)+
theme(
panel.background = element_rect(fill = k, colour = k4,
size = 0.5, linetype = "solid"),
panel.grid.major = element_line(size = 0.1, linetype = 'solid',
colour = k4),
panel.grid.minor = element_line(size = 0.1, linetype = 'solid',
colour = k4),
plot.background = element_rect(fill = k),
axis.title= element_text(colour =k2,size=10,face='bold'),
axis.text= element_text(colour =k2,size=10,face='bold'))+
labs(x="",y="PKB per capita")
})
}Po przygotowaniu serwera i ui w taki sposób możliwe jest wywołanie samego dashboardu za pomocą funkcji shinyApp.
shinyApp(ui = ui, server = server)PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.