Reactive Graph Demo with Shiny

app.R

library(tidyverse)

data_path <- "speed_dating_data.csv"
spd_dat <- read.csv(data_path)

spddat_plot2 <- subset(spd_dat, select=c(goal, match, gender, 
                                         like, expnum, income, like_o))

spddat_plot2$income <- gsub(",", "", spddat_plot2$income)
spddat_plot2$income <- as.numeric(spddat_plot2$income)
spddat_plot2$goal <- as.character(spddat_plot2$goal)
spddat_plot2$match <- as.character(spddat_plot2$match)
spddat_plot2$gender <- as.character(spddat_plot2$gender)

spddat_plot2 <- na.omit(spddat_plot2)

# Define UI for app that draws a histogram ----
ui <- fluidPage(
  
  # App title ----
  titlePanel("Demo of Shiny with Prelim Plots"),
  
  # Sidebar layout with input and output definitions ----
  sidebarLayout(
    
    # Sidebar panel for inputs ----
    sidebarPanel(
      
      selectInput("select_yvar", h3("Y Variable"),
                  choices=colnames(spddat_plot2))
      
    ),
    
    # Main panel for displaying outputs ----
    mainPanel(
      plotOutput("plot2")
    )
  )
)

# Define server logic required to draw a histogram ----
server <- function(input, output) {
  
  output$plot2 <- renderPlot({
    ggplot(spddat_plot2,
           aes_string(y=input$select_yvar, 
                      x="goal", 
                      group=paste0("interaction(", paste0(c("match", "gender"), 
                                                          collapse =  ", "), ")"),
                      color="match")) +
      geom_smooth(aes(linetype=as.character(gender))) +
      geom_point(position = "jitter", alpha=0.2) +
      scale_colour_discrete(labels=c("No Match", "Match"), type=c("#7b3494", "#008837")) +
      scale_linetype(labels=c("Female", "Male")) +
      labs(title = "How does goal effect user-chosen variables?",
           colour = "Match",
           linetype = "Gender") +
      xlab("Goal of Speed Dating") +
      #ylab(input$select_yvar) +
      theme_light() +
      theme(text = element_text(family="Avenir"))
  })
  
}

shinyApp(ui = ui, server = server)