Final Project - New Tab Not Responsive

[pharri14]

I am creating a new tab, but only the portion of the dashboard that I copied over is working (which are Gender and Transportation). I can not quite figure out if I need to change something with the code chunk that I copied over.

The goal is to get be able to input Direction, Gender, Transportation, and Time of Day into the graph as well as have the row above the graph display data about Number of Crashes, Total Injuries, Total Fatalities, and Rate of Harm

Traffic Accidents By Traveling Direction {data-orientation=rows}

Sidebar {.sidebar}

Driver Characteristics

selectInput(inputId = "driver.1.direction", 
            label = h4("Driver Direction:"), 
            choices = c("North", "South", "East", "West"),
            selected = "North")

selectInput(inputId = "driver.1.gender", 
            label = h4("Driver Gender"), 
            choices = c("Male","Female", "Unknown"), 
            selected = c("Female"))

radioButtons(inputId = "driver.1.pedcy", 
             label = h4("Driver Transportation"),
             choices = c("Driver", "Pedalcyclist", "Pedestrian"), 
             selected = c("Driver"))

sliderInput(inputId = "hour", 
            label = h4("Time of Day"), 
            min = 0, 
            max = 23, 
            value = c(6, 12))

Row

Number of Crashes

renderValueBox({
  d2 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy,
            hour >= input$hour[1] & hour <= input$hour[2] )

  crashes <- count( d2 )
  valueBox(crashes, 
           icon = "fa-pencil",
           color = ifelse( crashes > 50, 
                           "danger", 
                           "primary") )
})

Total Injuries

renderValueBox({
  d2 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy, 
            hour >= input$hour[1] & hour <= input$hour[2] )

  total.injuries <- sum( d2$Totalinjuries )
  valueBox(total.injuries, 
           icon = "fa-angry",
           color = ifelse( total.injuries > 30, 
                           "danger", 
                           "primary" ))
})

Total Fatalities

renderValueBox({
  d2 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy, 
            hour >= input$hour[1] & hour <= input$hour[2] )

  total.fatalities <- sum( d2$Totalfatalities )
  valueBox( total.fatalities, 
            icon = "fa-briefcase-medical",
            color = ifelse(total.fatalities > 10, 
                           "danger", 
                           "primary"))
})

Rate of Harm

renderValueBox({
  d2 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy, 
            hour >= input$hour[1] & hour <= input$hour[2] )

  rate.of.harm <- round(length(which(d2$harm == "Harm"))/count(d2), 3)
  valueBox(rate.of.harm, 
           icon = "fa-pencil",
           color = ifelse(rate.of.harm > 0.5, 
                          "danger", 
                          "primary"))
})

Outputs

Traffic Accidents By Driver 1 Traveling Direction

renderLeaflet({

  # days.of.week <- input$days    # vector will all checked values
  # start.time <- input$hour[1]   # sliderInput lower value
  # end.time  <-  input$hour[2] 

  driver.dir <- input$direction  # Vector of checked direction
  start.time <- input$hour[1]    # Slider input of lower time range
  end.time  <-  input$hour[2]    # Slider input of upper time range

  d12 <-
    dat %>%
    filter( Traveldirection_One == driver.dir,
            hour >= start.time & hour <= end.time, 
            Gender_Drv1 %in% input$driver.1.gender,
            Unittype_One %in% input$driver.1.pedcy )

  d12$col.vec <- ifelse( d12$nohurt, 
                         "gray20", 
                         ifelse(d12$inj, 
                                "steelblue", 
                                "darkorange") )              

  point.size <- d12$Totalinjuries + d12$Totalfatalities

  crash.details <- paste0( "Time: ", d12$DateTime, "<br>",
                           "Total Fatalities: ", d12$Totalfatalities, "<br>",
                           "Total Injuries: ", d12$Totalinjuries, "<br>",
                           "Collision type: ", d12$Collisionmanner)

  tempe <- leaflet( ) %>% 
              addProviderTiles( "CartoDB.Positron" )  %>%
              setView( lng=-111.9278, 
                       lat=33.39951, 
                       zoom=13 )

  addCircles( tempe, 
              lng=d12$Longitude, 
              lat=d12$Latitude,
              fillColor=d12$col.vec, 
              fillOpacity=0.5, 
              stroke=F, 
              radius=50*(1+0.33*point.size),
              popup=crash.details )

})

[jamisoncrawford]

Hi Peyton, a good start, I think, is that your inputId = values in your control widgets (e.g. ) selectInput()) do not match the input$[id] in your render*() output.

For example, you're first inputId = is "driver.1.direction", but in the output functions you are using input$direction (when it should be input$driver.1.direction. All of these should match because they are your unique IDs that connect user inputs and graphical output functions.

[pharri14]

@jamisoncrawford I made those changes to make sure that the inputId matched the input throughout the code. I also changed the time from a slider to a radio button. However, now, none of the inputs from the sidebar affect the map (and no points show up on the map). It may be easier for me to send you my .rmd file, but here are the code chunks:

Traffic Accidents By Traveling Direction {data-orientation=rows}

Sidebar {.sidebar}

Driver Characteristics

selectInput(inputId = "direction", 
            label = h4("Driver Direction:"), 
            choices = c("North", "South", "East", "West"),
            selected = "North")

selectInput(inputId = "d1gender", 
            label = h4("Driver Gender"), 
            choices = c("Male","Female", "Unknown"), 
            selected = c("Female"))

radioButtons(inputId = "d1pedcy", 
             label = h4("Driver Transportation"),
             choices = c("Driver", "Pedalcyclist", "Pedestrian"), 
             selected = c("Driver"))

radioButtons(inputId = "time.of.day", 
             label = h4("Time of Day"),
             choices = c("Morning Commute", 
                         "Evening Commute", 
                         "School Pickup", 
                         "Work", 
                         "Night", 
                         "Midnight to Dawn"),
             selected = c("Morning Commute") )

Row

Number of Crashes

renderValueBox({
  d2 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy,
            hour %in% input$time.of.day )

  crashes <- count( d2 )
  valueBox(crashes, 
           icon = "fa-pencil",
           color = ifelse( crashes > 50, 
                           "danger", 
                           "primary") )
})

Total Injuries

renderValueBox({
  d2 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy, 
            hour %in% input$time.of.day )

  total.injuries <- sum( d2$Totalinjuries )
  valueBox(total.injuries, 
           icon = "fa-angry",
           color = ifelse( total.injuries > 30, 
                           "danger", 
                           "primary" ))
})

Total Fatalities

renderValueBox({
  d2 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy, 
            hour %in% input$time.of.day )

  total.fatalities <- sum( d2$Totalfatalities )
  valueBox( total.fatalities, 
            icon = "fa-briefcase-medical",
            color = ifelse(total.fatalities > 10, 
                           "danger", 
                           "primary"))
})

Rate of Harm

renderValueBox({
  d2 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy, 
            hour %in% input$time.of.day )

  rate.of.harm <- round(length(which(d2$harm == "Harm"))/count(d2), 3)
  valueBox(rate.of.harm, 
           icon = "fa-pencil",
           color = ifelse(rate.of.harm > 0.5, 
                          "danger", 
                          "primary"))
})

Outputs

Traffic Accidents By Driver 1 Traveling Direction

renderLeaflet({

  # days.of.week <- input$days    # vector will all checked values
  # start.time <- input$hour[1]   # sliderInput lower value
  # end.time  <-  input$hour[2] 

  d12 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy,
            hour %in% input$time.of.day )

  d12$col.vec <- ifelse( d12$nohurt, 
                         "gray20", 
                         ifelse(d12$inj, 
                                "steelblue", 
                                "darkorange") )              

  point.size <- d12$Totalinjuries + d12$Totalfatalities

  crash.details <- paste0( "Time: ", d12$DateTime, "<br>",
                           "Total Fatalities: ", d12$Totalfatalities, "<br>",
                           "Total Injuries: ", d12$Totalinjuries, "<br>",
                           "Collision type: ", d12$Collisionmanner)

  tempe <- leaflet( ) %>% 
              addProviderTiles( "CartoDB.Positron" )  %>%
              setView( lng=-111.9278, 
                       lat=33.39951, 
                       zoom=13 )

  addCircles( tempe, 
              lng=d12$Longitude, 
              lat=d12$Latitude,
              fillColor=d12$col.vec, 
              fillOpacity=0.5, 
              stroke=F, 
              radius=50*(1+0.33*point.size),
              popup=crash.details )

})

[jamisoncrawford]

Sounds good @pharri14, just email it to me and I'll take a look!

[jamisoncrawford]

Hi @pharri14,

I think I got it - take a look at your calls to filter():

  d12 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy,
            hour %in% input$time.of.day )

Then, check out your input for time.of.day:

radioButtons(inputId = "time.of.day", 
             label = h4("Time of Day"),
             choices = c("Morning Commute", 
                         "Evening Commute", 
                         "School Pickup", 
                         "Work", 
                         "Night", 
                         "Midnight to Dawn"),
             selected = c("Morning Commute") )

Now check out what variable hour looks like:

> unique(dat$hour)
 [1]  9 17 19 14 13  7 15 20  4 22  8 18 16 12 21  2 10 11  6  0 23  5  3  1

What is R expecting and what does it encounter, instead?

[pharri14]

@jamisoncrawford I see what you are saying and changed it from hour %in% input$time.of.day to time.of.day %in% input$time.of.day throughout the code. That worked and allowed the map to finally populate. That being said, the only piece that is not working is the input for the direction that the driver is traveling.

I currently have the code similar to what you had in your example as follows:

  d2 <-
    dat %>%
    filter( Traveldirection_One == input$direction,
            Gender_Drv1 %in% input$d1gender, 
            Unittype_One %in% input$d1pedcy,
            time.of.day %in% input$time.of.day )

Do I need to change up the == operator? Or maybe I also need to change the wording?

[jamisoncrawford]

Hi @pharri14, I'm not really sure - I used == and it was running but, admittedly, I did not check all of the input widgets. Let me see.

[jamisoncrawford]

@pharri14 seems to be working for me?

[pharri14]

@jamisoncrawford does the map change when you change the direction of the driver?

[jamisoncrawford]

It does! However I also entirely eliminated the first tab. I'm not sure I did anything else to it and don't believe that's the reason. Try focusing on a single input and a single widget, e.g. one of the score cards in the upper row. Then experiment with it maybe? I'll email you back the .Rmd now and maybe you can spot the difference.

On Tue, Jun 23, 2020, 6:47 PM Peyton notifications@github.com wrote:

@jamisoncrawford https://github.com/jamisoncrawford does the map change when you change the direction of the driver?

— You are receiving this because you were mentioned. Reply to this email directly, view it on GitHub https://github.com/DS4PS/cpp-526-sum-2020/issues/26#issuecomment-648467087, or unsubscribe https://github.com/notifications/unsubscribe-auth/ADXLEPCRZP53BHSVEDNHH7TRYEWGLANCNFSM4OFJIW7Q .

[pharri14]

@jamisoncrawford that worked. And then I copied that code chunk into my main .Rmd file and the whole thing worked. Thanks for all of the help with this part!

[jamisoncrawford]

Awesome! Glad it works! Feel free to send before you submit and I can give you some feedback to make sure it hits all the (radio) buttons and checks all the boxes!