I'm pretty new to r and shiny and I am currently working on my first personal project. My project is about Pokemon and I am currently having trouble creating an interactive radar chart. I have tried looking at other questions about on this website about r and radar charts but couldn't really find the right answer since the dataset was usually in a different format, and the answers didn't provide a way to do it interactively.
What I'm trying to achieve: Create an interactive radar chart where the user can select a Pokemon and the radar chart will display that Pokemon's base stats (hp, attack, defense, etc.)
dataset:
name hp defense attack sp_attack sp_defense speed
1 Bulbasaur 45 49 49 65 65 45
2 Ivysaur 60 63 62 80 80 60
3 Venusaur 80 123 100 122 120 80
4 Charmander 39 43 52 60 50 65
5 Charmeleon 58 58 64 80 65 80
6 Charizard 78 78 104 159 115 100
...
ui.R:
library(shiny)
library(plotly)
ui <- navbarPage(title = "Pokemon Research",
tabPanel(title = "Types and Stats",
sidebarPanel(
selectInput(inputId = "diff_stat",
label = "Different Types and their Base Statistics",
choices = c("hp", "attack", "defense", "special_attack",
"special_defense", "speed", "total"))
),
mainPanel(plotlyOutput("type"))),
tabPanel(title = "Pokemon Statistics",
sidebarPanel(
selectInput(inputId = "indv",
label = "Pokemon",
choices = data$name
),
#IDK WHAT TO PUT HERE FOR THE MAINPANEL
)))
server.R:
library("shiny")
library("ggplot2")
data <- read.csv("../data/pokemon.csv", stringsAsFactors = FALSE)
type_data <- data %>%
select(name, type1, hp, defense, attack, sp_attack, sp_defense, speed) %>%
group_by(type1) %>%
summarise(hp = mean(hp),
attack = mean(attack),
defense = mean(defense),
special_attack = mean(sp_attack),
special_defense = mean(sp_defense),
speed = mean(speed),
total = mean(attack + defense + hp + sp_attack + sp_defense + speed))
indv_data <- data %>%
select(name, hp, defense, attack, sp_attack, sp_defense, speed)
server <- function(input, output) {
output$type <- renderPlotly({
ggplot(data = type_data, mapping = aes_string(x = "type1", y = input$diff_stat)) +
geom_line(group = 1) +
geom_point() +
labs(x = "Types",
y = "Base Stat (avg)")
})
output$radar <- renderPlot({
#WHAT DO I PUT HERE TO MAKE THE RADAR CHART
})
}
Any help is greatly appreciated!
This can help. I only included the code for the radar chart.
library(tidyverse)
library(shiny)
library(plotly)
pokemons <-
read_table('
name hp defense attack sp_attack sp_defense speed
Bulbasaur 45 49 49 65 65 45
Ivysaur 60 63 62 80 80 60
Venusaur 80 123 100 122 120 80
Charmander 39 43 52 60 50 65
Charmeleon 58 58 64 80 65 80
Charizard 78 78 104 159 115 100')
ui <- navbarPage(title = "Pokemon Research",
tabPanel(title = "Pokemon Statistics",
sidebarPanel(
selectInput(inputId = "indv",
label = "Pokemon",
choices = pokemons$name,
selected = 'Bulbasaur')
),
mainPanel(
plotlyOutput('radar') #the radar plot
)
))
server <- function(input, output, session) {
output$radar <- renderPlotly({
pkmn <- filter(pokemons, name == input$indv)
r <- map_dbl(pkmn[, 2:6], ~.x)
nms <- names(r)
#code to plot the radar
fig <- plot_ly(
type = 'scatterpolar',
r = r,
theta = nms,
fill = 'toself',
mode = 'markers'
)
fig <- fig %>%
layout(
polar = list(
radialaxis = list(
visible = T,
range = c(0,max(r))
)
),
showlegend = F
)
})
}
shinyApp(ui, server)
Related
I'm seeking assistance with my shiny dashboard issue.
Essentially, I have a single selectInput menu, however want to be able to select multiple variables and have them all plotted on the same graph.
At the moment I can get it to plot a single selected variable on the plot.ly graph, however even when I select multiple variables, it will still only plot the first variable selected:
current single variable output
Additionally, when the app is first run, I get this error until I manually select a variable:
error received when first displayed
This is a simplified version of the code I'm working with so far:
global_indices <- read_excel("Market_Data.xlsx",
sheet = 4,
col_names = FALSE,
skip = 5)
global_indices_clean <- global_indicies[,c(1,3,7,9,13,21,23)]
colnames(global_indices_clean) <- c("Date", "Australia", "US", "UK", "Germany", "Japan", "Hong_Kong")
global_indices_2y2 <- global_indices_clean %>% filter(between(Date, now() - years(2), now()))
header <- dashboardHeader(
title = "Dashboard"
)
sidebar <- dashboardSidebar(
sidebarMenu(
menuItem("Global Indices",
tabName = "global_indices")
)
)
body <- dashboardBody(
tabItems(
tabItem(tabName = "global_indices",
fluidRow(
box(plotlyOutput("plot_3"), title = "Developed indices", status = "primary", width = 4, ""),
box(plotlyOutput(""), title = "", status = "primary", width = 4, ""),
box(plotlyOutput(""), title = "", status = "primary", width = 4, "")
),
fluidRow(
box(selectInput("global_indices_input", "Indices",
choices =
list("Australia" = "Australia",
"US" = "US",
"UK" = "UK",
"Germany" = "Germany",
"Japan" = "Japan",
"Hong Kong" = "Hong_Kong"),
multiple = TRUE),
width = 4)
)
)
)
)
ui <- dashboardPage(
header,
sidebar,
body
)
server <- function(input, output) {
output$plot_3 <- renderPlotly({
plot_3 <- plot_ly(
global_indices_2y2, x = global_indices_2y2$Date, y = ~get(input$global_indices_input), type="scatter", mode="lines"
)
})
}
shinyApp(ui, server)
I can't provide the dataset itself, however below is a small section of it:
> str(global_indices_2y2)
'data.frame': 478 obs. of 7 variables:
$ Date : POSIXct, format: "2018-01-29" "2018-01-30" "2018-01-31" "2018-02-01" ...
$ Australia: num 107 106 106 107 108 ...
$ US : num 113 112 112 112 110 ...
$ UK : num 104 103 102 102 101 ...
$ Germany : num 103.9 102.9 102.8 101.4 99.7 ...
$ Japan : num 116 114 113 115 114 ...
$ Hong_Kong: num 120 118 119 118 118 ...
I've read through dozens of threads on here over the last few days, however they all seem to focus on issues around multiple selectInput parameters, instead of a single selectInput requiring the ability to select and display multiple outputs.
Any help that you are able to provide would be greatly appreciated!
One approach would be to create a separate reactive to filter your data, and use the filtered data in your plot. First, I would consider converting your data to long format (e.g., using tidyverse pivot_longer). For example:
global_indices_2y2 <- data.frame(
Date = as.POSIXct(c("2018-01-29", "2018-01-30", "2018-01-31", "2018-02-01")),
Australia = c(107, 106, 106, 107),
US = c(113,112,112,112),
UK = c(104,103,102,102)
) %>%
pivot_longer(cols = -Date, names_to = "country", values_to = "index")
Then add reactive to filter based on multiple selections in your server:
mydata <- reactive({
global_indices_2y2 %>%
filter(country %in% input$global_indices_input)
})
Then plot filtered data:
output$plot_3 <- renderPlotly({
plot_3 <- plot_ly(
mydata(),
x = ~Date,
y = ~index,
name = ~country,
type="scatter",
mode="lines"
)
})
I have a simple shiny application and I don't know why the values on the chart change when I choose multiple items from a list. Below my example and images with bad charts.
ui
library(shiny)
library(plotly)
shinyUI(fluidPage(
titlePanel("App test"),
sidebarPanel(
h3(" "),
selectizeInput("name",
label = "Code",
choices = unique(data$Product),
multiple = T,
options = list(maxItems = 5, placeholder = 'Select a code'),
selected = "46")
),
mainPanel(
plotOutput("trendPlot")
)
)
)
server
shinyServer(function(input, output, session) {
output$trendPlot <- renderPlot({
df_trend <- data[data$Product == input$name, ]
ggplot(df_trend) +
geom_line(aes(x = Month, y = Value, group = Product, colour = Product)) +
theme(legend.position = "bottom")
})
})
Head my data:
> head(data)
# A tibble: 6 x 3
Product Month Value
<chr> <chr> <dbl>
1 46 Jan 188
2 46 Feb 277
3 46 Mar 317
4 46 Apr 367
5 46 May 329
6 46 Jun 318
The data set above only includes '46' for Product so cannot reproduce. However, I suspect the problem is how you are filtering data, allowing for multiple inputs with selectizeInput.
Right now you filter data:
df_trend <- data[data$Product == input$name, ]
Which is fine if input$name is a single value. However, with multiple inputs (e.g., 46 and 92), then input$name contains those two values, and you need a different kind of comparison.
To subset your data based on multi-value matching (like matching a vector), try instead:
df_trend <- data[data$Product %in% input$name, ]
I have a dataset with categorical and numeric variables.
My data looks like this
Region Country Project.ID Client PG Percent.of.CoE Status
1 Africa Sudan 1001 Vodafone PG 1 50 Signed
2 Europe Russia 1002 Vodafone Russia PG 2 50 Low
3 Europe United Kingdom 1003 Orange PG 3 50 Signed
4 Latin America Peru 1004 Co-operative Bank PG 3 50 Signed
5 Asia Malaysia 1005 AB Malaysia PG 2 14 Signed
6 Europe France 1006 Orange PG 4 50 High
7 Africa South Africa 1007 Coris Bank PG 1 40 Signed
8 Asia China 1008 Gulf Bank PG 2 50 Low
9 North America United States 1009 ABI PG 1 50 Signed
10 Europe Germany 1010 O2 PG 2 50 Medium
11 Latin America Argentina 1011 ACEP PG 3 40 Low
12 North America Canada 1012 BCN United States PG 1 100 Signed
The sample data is stored here
What am I trying to do with this data?
I want to create a simple app, which with filter categorical and numeric variables.
My current UI looks like this and this is my desired UI.
The first filter works perfectly. The second does not due to data structure.
Trying to resolve it, I changed tha data format, using gather, see the code below. As a result my data looks like this.
Percent.of.CoE variable value
1 50 Region Africa
2 50 Region Europe
23 40 Country Argentina
24 100 Country Canada
25 50 Client Vodafone
26 50 Client Vodafone Russia
47 40 PG PG 3
48 100 PG PG 1
49 50 Status Signed
50 50 Status Low
I am not sure that it is correct format for this. But any solution will work.
My code
library(shiny)
library(shinythemes)
library(tidyverse)
# Global code
# Read file on a local machine
data_pg <- read.csv("pg1.csv", header = TRUE, stringsAsFactors = FALSE)
# Transform into tidy data, removing long/lat variables.
data_pg_df3 <- data_pg %>% select(Region, Country, Client, PG, Status,
Percent.of.CoE) %>% gather(key = "variable", value = "value", -
c("Percent.of.CoE"))
# UI code
ui <- fluidPage(theme = shinytheme("united"),
titlePanel(h1("Test", align = "center")),
sidebarLayout(
sidebarPanel(
selectInput("dataInput", "Choose to filter by:",
choices = c("Region",
"Country",
"Client",
"PG",
"Status"),
selected = "Choose to display by"),
sliderInput("percentInput1", "Percent of CoE", min = 0,
max = 100, value = c(0, 0))
),
mainPanel(
# Output
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot", height = 850)))
)
)
)
# Server code
server <- function(input, output) {
# 1. Select among columns
selectedData <- reactive({
filter(data_pg_df3, variable == input$dataInput)
})
output$plot <- renderPlot({
ggplot(selectedData(), aes(x = value, fill = value)) + geom_bar(stat = "count") + theme(axis.title = element_blank())
})
HOW TO WRITE THE SECOND FILTER? I did. But wrong and might be wrong filtering too. But I think my dataframe is not good for this.
# # 2. Select among percents
# selectedPercent <- reactive({
# filter(data_pg_df3, Percent.of.CoE >= input$percentInput1[1] &
Percent.of.CoE <= input$percentInput1[2])
# })
#
# output$plot <- renderPlot({
# ggplot(selectedPercent(), aes(x = value, fill = value)) + geom_bar(stat = "count") + theme(axis.title = element_blank())
# })
}
shinyApp(ui = ui, server = server)
I want to filter by variable and then to filter by percent, leaving only projects withing selected range.
I don't think this has anything to do with your data structure. Try something like the following:
server <- function(input, output) {
# 1. Select among columns
filtered_data_1 <- reactive({
filter(data_pg_df3, variable == input$dataInput)
})
filtered_data_2 <- reactive({
filter(filtered_data_1(), Percent.of.CoE == input$percentInput1)
})
output$plot <- renderPlot({
ggplot(filtered_data_2(), aes(x = value, fill = value)) + geom_bar(stat = "count") + theme(axis.title = element_blank())
})
The key thing is to pass one reactive to another. Alternatively you could apply both filters within the same reactive:
server <- function(input, output) {
# 1. Select among columns
filtered_data <- reactive({
data_pg_df3 %>%
filter(variable == input$dataInput)
filter(Percent.of.CoE == input$percentInput1)
})
output$plot <- renderPlot({
ggplot(filtered_data(), aes(x = value, fill = value)) + geom_bar(stat = "count") + theme(axis.title = element_blank())
})
This can be done using your original data structure in a variety of ways. For example, you could just filter on Percent.of.CoE and then pass the column given by input$dataInput to your ggplot aesthetic.
I resolved also.
My server looks like this. In general, I was right and the answer above is correct too.
# Server
server <- function(input, output) {
# 1. Select among columns
selectedData <- reactive({
filter(data_pg_df3, variable == input$dataInput) %>%
filter(Percent.of.CoE >= input$percentInput1[1] & Percent.of.CoE <= input$percentInput1[2])
})
output$plot <- renderPlot({
ggplot(selectedData(), aes(x = value, fill = value)) + geom_bar(stat = "count") + theme(axis.title = element_blank())
})
}
The tricky part for me was with UI.
Instead of
sliderInput("percentInput1", "Percent of CoE", min = 0,
max = 100, value = c(0, 0))
I put
sliderInput("percentInput1", "Percent of CoE", min = 0,
max = 100, value = c(1, 99))
This resolved my problem. Works perfectly now.
And as I mentioned before, I use sliderInput with values, because I needed to select a range of data.
I've a plotly bar chart with a hover event which plots another plot alongside the first one
Is there a way to have the second plot show up inside of the hoverinfo box ?
The code I used is as under:
UI
library(shiny)
library(plotly)
library(shinythemes)
library(dplyr)
library(png)
ui <- fluidPage(
theme = shinytheme("spacelab"),
h2("Coupled hover-events in plotly charts using Shiny"),
tags$hr(),
fluidRow(
column(6, plotlyOutput(outputId = "ageplot", height = "600px")),
column(6, plotlyOutput(outputId = "raceplot", height = "600px"))),
tags$hr(),
tags$blockquote("Hover over age plot for race and gender information")
)
SERVER:
server <- function(input, output){
patdata <- read.csv("Sal.csv")
boston_race<-read.csv("bostonrace.csv")
patdata$Race<-ifelse(patdata$Race=="RACE_UNKNOWN", "Unknown",ifelse(patdata$Race=="BLACK_AFRICAN_AMERICAN", "African American",ifelse(patdata$Race=="RACE_LATINO_HISPANIC", "Latino Hispanic",
ifelse(patdata$Race=="WHITE", "White",ifelse(patdata$Race=="ASIAN", "Asian",
ifelse(patdata$Race=="RACE_OTHER", "Other","Unknown"))))))
patdata$Date<-as.Date(patdata$CreateDate, format = "%m/%d/%Y")
patdata$agegroup<- ifelse(patdata$Age>=0 &patdata$Age<=19,"<20",
ifelse(patdata$Age>=20 &patdata$Age<=29,"20-29",
ifelse(patdata$Age>=30 &patdata$Age<=39,"30-39",
ifelse(patdata$Age>=40 &patdata$Age<=49,"40-49",
ifelse(patdata$Age>=50,"50+","Invalid Age")))))
patdata$dp<- ifelse(patdata$Age>=0 &patdata$Age<=19,0,
ifelse(patdata$Age>=20 &patdata$Age<=29,1,
ifelse(patdata$Age>=30 &patdata$Age<=39,2,
ifelse(patdata$Age>=40 &patdata$Age<=49,3,
ifelse(patdata$Age>=50,4,NA)))))
patdata$dp<-as.numeric(patdata$dp)
patdata_age<- subset(patdata, select="agegroup")
patdata_age<-as.data.frame(table(patdata_age))
selection<-patdata_age
output$ageplot <- renderPlotly({
colnames(selection)<-c("agegroup","Freq")
selection$y<-round((patdata_age$Freq*100/sum(patdata_age$Freq)))
plot_ly(source = "source",selection, x = ~agegroup, y = selection$y, type = 'bar',
marker = list(color = 'rgb(255,140,0)',
# marker = list(color,alpha = d),
line = list(color = 'rgb(8,48,107)', width = 1.5))) %>%
layout(title = paste0("Age-group distribution of patients "),xaxis = list(title = 'age group'),
yaxis = list(title = paste0('Percentage of Patients')),titlefont=list(size=13),
annotations = list(x = ~agegroup, y = selection$y, text = paste0(selection$y, "%"),
xanchor = 'center', yanchor = 'bottom',
showarrow = FALSE))
})
output$raceplot <- renderPlotly({
eventdata <- event_data("plotly_hover", source = "source")
validate(need(!is.null(eventdata), "Hover over the age plot to populate this race plot"))
datapoint <- as.numeric(eventdata$pointNumber)[1]
sel<-patdata %>% filter(dp %in% datapoint)
raceselection<-subset(sel,select="Race")
raceselection<-as.data.frame(table(raceselection))
colnames(raceselection)<-c("Race","Freq")
raceselection$y<-round((raceselection$Freq*100/sum(raceselection$Freq)))
raceall<-merge(raceselection,boston_race)
raceall$Race<- as.character(raceall$Race)
raceall$Percent<-round(raceall$Percent,0)
plot_ly(raceall, x = ~Race, y = ~Percent, type = 'bar', name = 'Total Population',marker = list(color = 'rgb(255,140,0)',
line = list(color = 'rgb(8,48,107)', width = 1))
) %>%
add_trace(y = ~y, name = 'Patient Population',marker = list(color = 'rgb(49,130,189)',
line = list(color = 'rgb(8,48,107)', width = 1))) %>%
layout(yaxis = list(title = 'Population Percent'), barmode = 'group',
title = paste0("Patient Race comparison"))
})
}
boston_race dataset:
Race Percent
White 47
Unknown 0
Other 1.8
Latino Hispanic 17.5
Asian 8.9
African American 22.4
Sal data snippet:
CreateDate Age Race
1/6/1901 20 RACE_LATINO_HISPANIC
1/21/1901 37 BLACK_AFRICAN_AMERICAN
1/21/1901 51 WHITE
1/31/1901 58 WHITE
2/2/1901 24 ASIAN
2/4/1901 31 WHITE
2/7/1901 29 WHITE
2/7/1901 19 WHITE
2/11/1901 7 BLACK_AFRICAN_AMERICAN
2/12/1901 41 ASIAN
2/13/1901 22 WHITE
2/19/1901 3 RACE_LATINO_HISPANIC
2/24/1901 19 WHITE
3/7/1901 26 WHITE
3/12/1901 21 RACE_UNKNOWN
3/17/1901 39 RACE_LATINO_HISPANIC
3/18/1901 71 WHITE
3/20/1901 65 WHITE
4/10/1901 19 WHITE
4/18/1901 31 WHITE
4/23/1901 63 WHITE
4/24/1901 20 WHITE
4/29/1901 19 WHITE
4/30/1901 27 WHITE
5/2/1901 23 WHITE
5/12/1901 21 WHITE
5/16/1901 26 RACE_LATINO_HISPANIC
5/20/1901 54 BLACK_AFRICAN_AMERICAN
5/20/1901 2 WHITE
5/20/1901 9 RACE_LATINO_HISPANIC
5/21/1901 28 WHITE
5/29/1901 2 BLACK_AFRICAN_AMERICAN
5/30/1901 0 WHITE
6/3/1901 21 WHITE
6/9/1901 10 ASIAN
6/9/1901 37 WHITE
The current output:
I want the second plot to appear in a small hoverinfo box
I'm having trouble with plotly in R and 'parcoords'. I'm trying to plot using colorscale defined by Persona. Persona has values of 1 through 4 and I expect each number to have it's own color. The plot scales fine but there are no lines representing the values for each variable.
Here is the code
options(viewer=NULL)
p <- df %>%
plot_ly(type = 'parcoords',
line = list(color = ~Persona,
colorscale = list(c(0,'red'),c(0.5,'green'),c(1,'blue'),c(1.5,'yellow'))) ,
dimensions = list(
list(range = c(15,55),
label = 'Rescuer Count', values = ~RescuerCount),
list(range = c(15,50),
label = 'Rescuer Share', values = ~RescuerShare),
list(range = c(5,95),
label = 'Avg Serviced Zip Codes', values = ~AvgServZips),
list(range = c(10,925),
label = 'Avg Number of Rescues', values = ~ AAvgNumofRescues),
list(range = c(310,16000),
label = 'Avg Rescuer Earnings', values = ~ AAEarnings),
list(range = c(1,55),
label = 'Persona Share of Earnings', values = ~ EarnShare),
list(range = c(30,95),
label = ' Login Percentage', values = ~ LoginPrct),
list(range = c(7,95),
label = 'Prct of Login Days W/Offer', values = ~ PrctLoginDaysWO),
list(range = c(1,5),
label = 'Avg Acceptance Rate', values = ~ AvgAcceptRate),
list(range = c(150,1975),
label = 'Annualized Number of Offers', values = ~ ANumofOffers)
)
)
print(p)
Data Table is here
Persona RescuerCount RescuerShare AvgServZips AAvgNumofRescues AAEarnings EarnShare LoginPrct PrctLoginDaysWO AvgAcceptRate ANumofOffers
1 16 15 45 389 6706 27 71 91 30 1314
2 13 15 90 915 15805 51 91 94 47 1954
3 30 27 28 147 2429 18 55 86 22 679
4 51 46 6 20 319 4 34 75 13 152
resulting plot
Please Help