Show average value in table R by categories - r

I want to clean up my data but I'm quite new to R.
my code:
#library
library(dplyr)
library(shiny)
library(shinythemes)
library(ggplot2)
#Source
dataset <- read.csv("Wagegap.csv")
SFWage <- dataset %>% select(gender,JobTitle,BasePay,Year,)
clean <- na.omit(SFWage)
#UI
ui <- fluidPage(
theme = shinytheme("united"),
navbarPage("San Fransisco Wages",
tabPanel("Barplot",
mainPanel(
plotOutput("barplot")
)) ,
tabPanel("Table",
mainPanel(
dataTableOutput("table")
))
)
)
#server
server <- function(input, output){
output$barplot <- renderPlot({
ggplot(clean, aes(x = JobTitle, y = BasePay ))+
geom_bar(stat="Identity", width = 0.3, fill="orange")+
labs(x= "Jobs", y = "Wage", title = "Wage per job")
})
output$table <- renderDataTable({
clean
})
}
shinyApp(ui = ui, server = server)
I get this output for the table:
Table Output
What I would like is the Jobtitle to be bundled and only seperated by the gender, and showing the average of the BasePay.
M - account clerk - averageBasePay - Year
F - account clerk - averageBasePay - Year
and so on for every job.
This data will be used to compare the wagegap between genders for every job given in the dataset.
P.S.
If someone also could tell me why the na.omit didnt work to clean up the empty genders, that would be amazing :)

You could use group_by() and summarise()
SFWage <- dataset %>%
group_by(gender,JobTitle, Year) %>%
summarise(averageBasePay = mean(BasePay, na.rm=TRUE) %>%
select(gender, JobTitle, averageBasePay, Year)

Related

Shiny app plot related question -reactive

I am having two columns in my data frame, one is "all_pass" which contains numeric values and other is "st_name" which contains string values name of states
The requirement of the plot is , when user give input of the state it will show the plot of that particular state which contains all_pass numbers
Following is the code in which I am trying to plot, where the user will input the name of the state and as per the input of the state name, the graph will plot as per the all_pass as per the related pass scores to that particular state. Kindly help in the following code, will be of great help.
Code is as mentioned below :
library(ggplot2)
library(plotly)
library(dplyr)
library(shiny)
ui <- basicPage(
h1("Total bills passed by state delegation , 110th Congress"),
selectizeInput(inputId = "bins",label = "Choose State",
choices = list("AK","AL","AR","AS","AZ","CA","CO","CT","DC","DE","FL","GA","GU","HI","IA","ID","IL","IN","KS","KY","LA","MA","MD","ME","MI","MN","MO","MS","MT","NC","NE","ND","NH","NJ","NM","NV","NY","OH","OK","OR","PA","PR","RI","SC","SD","TN","TX","UT","VA") ,multiple = TRUE ,plotOutput("plot"))
)
server <- function(input, output) {
data <- reactive({
require(input$bins)
df <- df7 %>% filter(st_name %in% input$bins)
})
output$plot <- renderPlot({
ggplot(df(), aes(y= all_pass,x=st_name ))+geom_bar(stat = "sum")
})
}
shinyApp(ui = ui, server = server)
in the UI definition you have plotOutput("plot") as an argument to selectizeInput() instead of basicPage(). Reformatting your code (Ctrl+Shift+A) would have made that more visible.
You can simplify the server code, as the renderPlot() already creates a reactive dependence on input$bins.
You can use the object datasets::state.abb to get a vector of US state abbreviations. This is loaded automatically in every R session.
Please see some working code below. I am using some mock data for df as you did not provide any data in your question.
library(ggplot2)
library(plotly)
library(dplyr)
library(shiny)
ui <- basicPage(
h1("Total bills passed by state delegation, 110th Congress"),
selectizeInput(inputId = "bins",
label = "Choose State",
choices = state.abb,
multiple = TRUE),
plotOutput("plot")
)
server <- function(input, output) {
df <-
tibble(all_pass = sample(1:500, 350),
st_name = rep(state.abb, 7))
output$plot <- renderPlot({
req(input$bins)
df |>
filter(st_name %in% input$bins) |>
ggplot(aes(y = all_pass,x=st_name )) +
geom_bar(stat = "sum")
})
}
shinyApp(ui = ui, server = server)

Bar Plot does not Display in Shiny App, I have developed a code

I am new to the shiny app and trying to write simple code.
I changed the codes so many times but my bar chart doesn't work.
I have this problem in my other trying. That the UI works and also the codes in the server work part by part in R but not in the shiny app. I know some part of my server is not what I want, I just want to know what should I do to run the code which works in R but not in Shiny
#Graph 2
server<-#Graph 2
library("tidyverse")
library("leaflet")
library("leaflet.extras")
library("rnaturalearthdata")
library("sf")
library("DT")
library("ggplot2")
N <- read.csv("https://data.ontario.ca/dataset/f4112442-bdc8-45d2-be3c-12efae72fb27/resource/455fd63b-603d-4608-8216-7d8647f43350/download/conposcovidloc.csv")
function(input, output, session){
if(input$data.Gender){
City ="Ottawa"
N %>% subset(Reporting_PHU_City == City) %>%
select(Case_Reported_Date, Age_Group, Client_Gender, Outcome1)%>%
rename(Date = Case_Reported_Date)%>%
arrange(Age_Group, Client_Gender, Outcome1)
Data.N <- as.data.frame(N)
Data.N %>%
group_by(Age_Group) %>%
summarise(Age = n_distinct(Age_Group)) %>%
arrange(desc(Age))
w = table(N$Age_Group)
t = as.data.frame(w)
}
output$Plot <- renderPlot({
ggplot() +
geom_bar(stat = "identity",data = t,mapping = aes(x = N$Client_Gender , y =Freq))
})
}
Sorry, the site didn't let me share the UI too. This is Ui
UI<- #Graph 2
library("leaflet")
library("DT")
fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons("data.Gender", "",
c("Data female" = "Gender.Female",
"Data male" = "Gender.Male"))
),
enter code here
mainPanel(
plotOutput("Plot")
)
))
Perhaps you should group by Client_Gender. Your present group by of Age_Group will give 1 as the value for all groups.
Try this
server <- function(input, output, session){
t <- reactive({
input$data.Gender
City ="Toronto"
aa <- N %>% subset(Reporting_PHU_City == City) %>%
select(Case_Reported_Date, Age_Group, Client_Gender, Outcome1)%>%
rename(Date = Case_Reported_Date)%>%
arrange(Age_Group, Client_Gender, Outcome1)
bb <- aa %>%
group_by(Client_Gender) %>%
summarise(Age = n_distinct(Age_Group)) %>%
arrange(desc(Age))
bb
})
output$Plot <- renderPlot({
ggplot(data=t()) +
geom_bar(stat = "identity",mapping = aes(x = Client_Gender , y = Age))
})
}

Slider with years for barplot

I am trying to get a slider within my barplot page to make the data interactive per year.
#library
library(dplyr)
library(shiny)
library(shinythemes)
library(ggplot2)
#Source
dataset <- read.csv("Wagegap.csv")
SFWage <- dataset %>%
group_by(gender,JobTitle, Year) %>%
summarise(averageBasePay = mean(BasePay, na.rm=TRUE)) %>%
select(gender, JobTitle, averageBasePay, Year)
clean <- SFWage %>% filter(gender != "")
#UI
ui <- fluidPage(
theme = shinytheme("united"),
navbarPage("San Fransisco Wages",
tabPanel("Barplot",
mainPanel(
plotOutput("barplot")
)) ,
tabPanel("Table",
mainPanel(
dataTableOutput("table")
))
)
)
#server
server <- function(input, output){
output$barplot <- renderPlot({
ggplot(clean, aes(x = JobTitle, y = averageBasePay ))+
geom_bar(stat="Identity", width = 0.3, fill="orange")+
labs(x= "Jobs", y = "Wage", title = "Wage per job")
})
output$table <- renderDataTable({
clean
})
}
#Run App
shinyApp(ui = ui, server = server)
I don't fully understand it yet how to put this input in.
I have tried sliding it into the navbarpage but I can't figure out how it works.
I also tried making year reactive but with no success.
It's not the year that has to be reactive; it's the whole data frame. Therefore, in your ui, you can do:
[...]
tabPanel("Barplot",
mainPanel(
sliderInput("year", label = "Which year should be displayed?", min = 1900, max = 2020, step = 5, value = 2000) # new
plotOutput("barplot")
)) ,
[...]
I put it there for convenience; the layout is yours. I tried do change as little as possible.
The server would then have:
server <- function(input, output){
# NEW ########################################
clean <- reactive({
SFWage <- dataset %>%
group_by(gender,JobTitle, Year) %>%
summarise(averageBasePay = mean(as.numeric(BasePay), na.rm=TRUE)) %>% # Notice the as.numeric()
select(gender, JobTitle, averageBasePay, Year)
SFWage %>% filter(gender != "" & Year == input$year)
})
# OLD ########################################
output$barplot <- renderPlot({
ggplot(clean(), aes(x = JobTitle, y = averageBasePay ))+ # Parenthesis
geom_bar(stat="Identity", width = 0.3, fill="orange")+
labs(x= "Jobs", y = "Wage", title = "Wage per job")
})
output$table <- renderDataTable({
clean() # Parenthesis
})
}
Don't forget to add the parenthesis, as I did here.
This should work, but I might have mistyped something or got it completely wrong. Since I don't have your data, I can't test it.
EDIT: Due to your comment, I added the as.numeric() term, as you can see above. However, if your data is not only not numeric but also with ,, you can do:
[...]
summarise(averageBasePay = mean(as.numeric(gsub(",", ".", BasePay)), na.rm=TRUE)) %>% # Notice the as.numeric() and the gsub()
[...]

Select specific data from R DataTable in Shiny with checkboxes and create histogram

I have created a data table with DT in Shiny that looks like this:
I would like to select data with checkboxes on a side panel that satisfies certain attributes (e.g. Mfr=Mitsubish, Joint=1, etc.) and then updates a histogram of deg/s in real time to view.
I've read through the material I could find on the web, but I can't figure out how to do this. Does anyone have any hints?
#guero64 Here is an example I had that I believe has examples of what you're looking for. I hope this is helpful. It is based on the diamonds dataset and has a couple of checkbox filters you can apply to the data.
library(shiny)
library(DT)
library(tidyverse)
ui <- shinyUI(pageWithSidebar(
headerPanel("Example"),
sidebarPanel(
checkboxInput("cb_cut", "Cut (Ideal)", FALSE),
checkboxInput("cb_color", "Color (I)", FALSE)
),
mainPanel(
DT::dataTableOutput("data_table"),
plotOutput("data_plot")
)
))
server <- shinyServer(function(input, output) {
filtered_data <- reactive({
dat <- diamonds
if (input$cb_cut) { dat <- dat %>% filter(dat$cut %in% "Ideal") }
if (input$cb_color) { dat <- dat %>% filter(dat$color %in% "I") }
dat
})
output$data_table <- DT::renderDataTable({
filtered_data()
})
output$data_plot <- renderPlot({
hist(filtered_data()$price, main = "Distribution of Price", ylab = "Price")
})
})
shinyApp(ui = ui, server = server)

How to get the rows corresponding to a plot selection in shiny

I have a bar graph which is part of a shiny app. I have created it with plotly. I would like the user to be able to select a part of the graph (click) and on clicking a datatable would show all rows corresponding to the values given in the hover text from that part of the chart.
So far I am able to show the output from event.data which isnt very interesting. How can I show the relevant rows from the original table?
library(plotly)
library(shiny)
ui <- fluidPage(
uiOutput("ChooserDropdown"),
plotlyOutput("plot2"),
DT::dataTableOutput("tblpolypDetail2")
)
server <- function(input, output, session) {
output$plot2 <- renderPlotly({
# use the key aesthetic/argument to help uniquely identify selected observations
#key <- row.names(mtcars)
browser()
p <- ggplot(iris,aes_string(iris$Species,input$Chooser)) + geom_col()
ggplotly(p,source = "subset") %>% layout(dragmode = "select")
})
output$tblpolypDetail2 <- renderDataTable({
event.data <- event_data("plotly_click", source = "subset")
print(event.data)
})
output$ChooserDropdown<-renderUI({
selectInput("Chooser", label = h4("Choose the endoscopic documentation column"),
choices = colnames(iris) ,selected = 1
)
})
}
shinyApp(ui, server)
I created a small demo where you can highlight rows in datatable by clicking the plotly graph.
You need to do it in two steps:
Map pointNumber of a click to rows in datatable(), you can create an external table for it.
You need to create a dataTableProxy where you can update a datatable
library(plotly)
library(DT)
library(shiny)
library(dplyr)
data <- as_tibble(iris) %>%
group_by(Species) %>%
summarise(avg = mean(Sepal.Width)) %>%
mutate(Species = as.character(Species))
species_mapping <- data.frame(
Species = data$Species,
row_id = 1:length(data$Species),
stringsAsFactors = FALSE
)
ui <- fluidPage(
DT::dataTableOutput("table"),
plotlyOutput("plot")
)
server <- function(input, output, session) {
output$plot <- renderPlotly({
p <- data %>%
ggplot() +
geom_col(aes(x = Species, y = avg))
# register this plotly object
plotly_object <- ggplotly(p,source = "source1")
event_register(plotly_object,event = "plotly_click")
plotly_object
})
output$table <- DT::renderDataTable(data)
# create a proxy where we can update datatable
proxy <- DT::dataTableProxy("table")
observe({
s <- event_data("plotly_click",source = "source1")
req(!is.null(s))
# map point number to Species
row_clicked <- species_mapping[s$pointNumber + 1,"row_id"]
proxy %>%
selectRows(NULL) %>%
selectRows(row_clicked)
})
}
shinyApp(ui, server)

Resources