Final

[jmacost5]

I was running the document to see what it looks like to get an idea of the tabs and it is giving me an error. http://127.0.0.1:5011/final-project-dashboard-template.rmd

[jmacost5]

Should I be putting the commute.type variable in a different place?

checkboxGroupInput("days", label = h3("Day of Week"), 
    choices = list("Monday"    = "Mon", 
                   "Tuesday"   = "Tue", 
                   "Wednesday" = "Wed", 
                   "Thursday"  = "Thu",
                   "Friday"    = "Fri",
                   "Saturday"  = "Sat",
                   "Sunday"    = "Sun" ),
    selected = c("Sun"))

radioButtons("commute.type", label = h3("Commute Type"),
    choices = c("Work", "Morning Commute", "School Pickup", "Evening Commute", "Night", "Midnight to Dawn"), selected = c("Work"))

# parameters

Outputs

Traffic Accidents By Day and Commute

#leaflet
renderLeaflet({

  days.of.week <- input$days    # vector will all checked values
  dat$commute.type <- dat$time.of.day

dat <- mutate( dat, commute.type = time.of.day )
dat %>%
    filter( day %in% input$days, commute.type %in% input$some_widget_name )

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

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

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

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

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

})

[jmacost5]

For this one I am getting an Error too, I am trying to use the variable for being under the influence, I noticed that there was drug and Alcohol influence So I tried to make it for both. These are the main things I changed.

radioButtons("AlcoholUse_Drv1", "DrugUse_Drv1", label = h4("Driver 1 Influence"),
    choices = c("No Apparent Influence", "Alcohol", "Drugs", "Alcohol & Drugs"), selected = c("No Apparent Influence"))
radioButtons("AlcoholUse_Drv2", "DrugUse_Drv2", label = h4("Driver 2 Influence"),
    choices = c("No Apparent Influence", "Alcohol", "Drugs", "Alcohol & Drugs"), selected = c("No Apparent Influence"))

  d10 <-
    dat %>%
    filter( Age_Drv1 >= input$driver.1.age[1] & Age_Drv1 <= input$driver.1.age[2], 
            Gender_Drv1 %in% input$driver.1.gender, 
            Unittype_One %in% input$driver.1.AlcoholUse,
            Unittype_One %in% input$driver.1.DrugUse

d11 <-
    dat %>%
    filter( Age_Drv2 >= input$driver.2.age[1] & Age_Drv2 <= input$driver.2.age[2], 
            Gender_Drv2 %in% input$driver.2.gender, 
            Unittype_Two %in% input$driver.2.AlcoholUse
            Unittype_Two %in% input$driver.2.DrugUse

[castower]

Hello all, I'm curious if anyone has tried to change their icons? I want to replace the one for injuries with an injured icon from font-awesome, but I'm a little confused on what I'm doing wrong.

I have changed the code to the following:

renderValueBox({

  days.of.week <- input$days    # vector will all checked values
  time.of.accident <- input$time

   d2 <- 
    dat %>%
    filter( day %in% input$days, 
            time.of.day %in% time.of.accident )

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

To reference this icon: https://fontawesome.com/icons/user-injured?style=solid

However, my icon isn't showing up and I'm not sure what to do. I also tried typing in "fas-fa-user-injured", but it also didn't do anything. Any advice would be great!

-Courtney

[lecy]

@castower That's an Font Awesome version 5.4.0 icon. It might be that R flexdashboard hasn't updated the most recent versions.

Try an icon from version 5.1.0 or earlier. Do they work?

[castower]

@castower That's an Font Awesome version 5.4.0 icon. It might be that R flexdashboard hasn't updated the most recent versions.

Try an icon from version 5.1.0 or earlier. Do they work?

Ah, yes that must be the issue. The ones from 5.1.0 work fine. Thanks!

[lecy]

@sunaynagoel I wonder if knitr 1.25.1 is not the development package we installed, and it can't find it as a result? The current version is 1.25:

https://cran.r-project.org/web/packages/knitr/index.html

Can you uninstall knitr and try the regular install (now that we know the problem from before was not knitr). Should be something like:

require(devtools)
install_version("knitr", version = "1.25", repos = "http://cran.us.r-project.org")

https://support.rstudio.com/hc/en-us/articles/219949047-Installing-older-versions-of-packages

[lecy]

@jmacost5 I think there is an issue in how you are trying to link input widgets and your filter functions.

Filters require a vector name and a value (or values). The value comes from the input widget stored at input$widget_name.

I don't see you linking widget names and input values here:

radioButtons("AlcoholUse_Drv1", "DrugUse_Drv1", label = h4("Driver 1 Influence"),
    choices = c("No Apparent Influence", "Alcohol", "Drugs", "Alcohol & Drugs"), 
    selected = c("No Apparent Influence"))

  d10 <-
    dat %>%
    filter( Age_Drv1 >= input$driver.1.age[1] & Age_Drv1 <= input$driver.1.age[2], 
            Gender_Drv1 %in% input$driver.1.gender, 
            Unittype_One %in% input$driver.1.AlcoholUse,
            Unittype_One %in% input$driver.1.DrugUse

First, you have two widget names: "AlcoholUse_Drv1", "DrugUse_Drv1".

Second, you should be referencing the values captured by the radioButton in the filter function here:

Unittype_One %in% input$driver.1.AlcoholUse  # should be input$AlcoholUse_Drv1 ?

Third, the Unittype_One variable describes the vehicle type:

> table( dat$Unittype_One )
      Driver   Driverless Pedalcyclist   Pedestrian 
       27549           29          709          183 

The variable AlcoholUse_Drv1 describes alcohol use.

> table( dat$AlcoholUse_Drv1 )
                                    Alcohol No Apparent Influence 
                  380                  1246                 26844 

You might mean the constructed variable d1.substance?

dat <- 
  dat %>% 
  mutate( d1.substance = case_when( AlcoholUse_Drv1 == "Alcohol" & 
                                      DrugUse_Drv1 == "No Apparent Influence" ~ "Alcohol", 
                                   AlcoholUse_Drv1 == "No Apparent Influence" & 
                                     DrugUse_Drv1 == "Drugs" ~ "Drugs", 
                                   AlcoholUse_Drv1 == "Alcohol" & 
                                     DrugUse_Drv1 == "Drugs" ~ "Alcohol and Drugs", 
                                   AlcoholUse_Drv1 == "No Apparent Influence" & 
                                     DrugUse_Drv1 == "No Apparent Influence" ~ "No Apparent Influence"))

[sunaynagoel]

@sunaynagoel I wonder if knitr 1.25.1 is not the development package we installed, and it can't find it as a result? The current version is 1.25:

https://cran.r-project.org/web/packages/knitr/index.html

Can you uninstall knitr and try the regular install (now that we know the problem from before was not knitr). Should be something like:

require(devtools)
install_version("knitr", version = "1.25", repos = "http://cran.us.r-project.org")

https://support.rstudio.com/hc/en-us/articles/219949047-Installing-older-versions-of-packages

@lecy It worked. Thanks a lot.

[castower]

Hello all, I'm probably completely overlooking something here, but I'm currently trying to figure out why my point plot isn't changing with the day of the week.

Here is my input for the dashboard:

Driver Characteristics
```{r}
selectInput("days", label = h3("Day of Week"), 
    choices = list("Monday"    = "Mon", 
                   "Tuesday"   = "Tue", 
                   "Wednesday" = "Wed", 
                   "Thursday"  = "Thu",
                   "Friday"    = "Fri",
                   "Saturday"  = "Sat",
                   "Sunday"    = "Sun" ),
    selected = c("Sun"))
selectInput("d1gender", label = h4("Driver 1 Gender"), 
    choices = c("Male","Female", "Unknown"), selected = c("Male"))
radioButtons("d1pedcy", label = h4("Driver 1 Transportation"),
    choices = c("Driver", "Pedalcyclist", "Pedestrian"), selected = c("Driver"))

And here is my code for the output:

renderPlot({

Chart2 <- 
  dat %>% 
  filter( as.numeric(hour) >= 0, day %in% input$days, Gender_Drv1 %in% input$d1gender, Unittype_One %in% input$d1pedcy) %>%
  group_by( hour ) %>%
  summarize( harm = sum(Totalinjuries) + sum(Totalfatalities) ) 

#Graph:
plot.new()
plot.window( xlim=c(0, 24), ylim=c(0, 1500), family= "sans" )
points( Chart2$hour, Chart2$harm, col="firebrick", pch=19, type="b", cex=2 )
xlab="Hour of the Day" 
ylab="Number of Injuries and Accidents"
main="Total number of Injuries and Accidents by Hour of the Day"
axis( side=1, at=c(0, 4, 8, 12, 16, 20, 24), labels=c(0, 4, 8, 12, 16, 20, 24), family="sans", lty="solid" )
axis( side=2, at=c(0, 300, 600, 900, 1200, 1500), labels=c(0, 300, 600, 900, 1200, 1500), family="sans", lty = "solid" )

points( x=Chart2$hour, y=Chart2$harm, 
        pch=20,  cex=1.2, col="firebrick", type="o" )

})

I plan to filter further to have three charts that show the changes in accidents for different age groups, but for the moment I'm just trying to get the chart to work.

It currently filters fine for transportation style and gender, but it keeps presenting the exact same dataset for everyday of the week and I can't seem to figure out what is causing this. Any help would be greatly appreciated!

[sunaynagoel]

@castower it happened to me as well. It turned out that I was using same vector name multiple times in my code. Once it was fixed it ran fine.

[castower]

@castower it happened to me as well. It turned out that I was using same vector name multiple times in my code. Once it was fixed it ran fine.

THANK YOU! That fixed it! I had two 'days'.

[castower]

Ok, now that I've tried to filter by age, my points have completely disappeared from my chart. They're still counted in the number of crashes tab at the top of the screen, but they aren't plotted anywhere. I also tried just filtering by age.cat == "Young Adult" and the points appeared, but they weren't filtered at all. I don't want age to be one of the filters in the input, because I want to have three separate charts for 'Young Adult', 'Adult', and 'Senior'.

renderPlot({

Chart2 <- 
  dat %>% 
  filter( as.numeric(hour) >= 0, day %in% input$days2, Gender_Drv1 %in% input$d1gender, Unittype_One %in% input$d1pedcy, age.cat == "Young Adult" %in% input$days2) %>%
  group_by( hour ) %>%
  summarize( harm = sum(Totalinjuries) + sum(Totalfatalities) ) 

#Graph:
plot.new()
plot.window( xlim=c(0, 24), ylim=c(0, 1500), family= "sans" )
points( Chart2$hour, Chart2$harm, col="firebrick", pch=19, type="b", cex=2 )
xlab="Hour of the Day" 
ylab="Number of Injuries and Accidents"
main="Total number of Injuries and Accidents by Hour of the Day"
axis( side=1, at=c(0, 4, 8, 12, 16, 20, 24), labels=c(0, 4, 8, 12, 16, 20, 24), family="sans", lty="solid" )
axis( side=2, at=c(0, 300, 600, 900, 1200, 1500), labels=c(0, 300, 600, 900, 1200, 1500), family="sans", lty = "solid" )

points( x=Chart2$hour, y=Chart2$harm, 
        pch=20,  cex=1.2, col="firebrick", type="o" )

})

[lecy]

@castower You have two criteria here:

age.cat == "Young Adult" %in% input$days2

Should be this?

age.cat == "Young Adult"

[castower]

@castower You have two criteria here:

age.cat == "Young Adult" %in% input$days2

Should be this?

age.cat == "Young Adult"

I tried to input

age.cat == "Young Adult"

That fixed it, thanks! I thought it wasn't filtering that way at first, but I needed to save the file and run it again.

[lecy]

If you are creating the same plots repeatedly for levels of a factor, this code can be handy:

# library( ggplot2 )

Salaries %>% filter( yearID > 2000 & lgID == "AL" ) %>% 
             group_by( teamID, yearID ) %>% 
             summarize( Mean_Player_Salary=mean(salary) ) -> t1

qplot( data=t1, x=yearID, y=Mean_Player_Salary, 
       geom=c("point", "smooth")  ) + 
       facet_wrap( ~ teamID, ncol=5 )

[castower]

# library( ggplot2 )

Salaries %>% filter( yearID > 2000 & lgID == "AL" ) %>% 
             group_by( teamID, yearID ) %>% 
             summarize( Mean_Player_Salary=mean(salary) ) -> t1

qplot( data=t1, x=yearID, y=Mean_Player_Salary, 
       geom=c("point", "smooth")  ) + 
       facet_wrap( ~ teamID, ncol=5 )

Can this be utilized with shiny?

I tried the following code:

Chart3 <- dat %>%
  filter( age.cat == "Senior", as.numeric(hour) >= 0, day %in% input$days3, Gender_Drv1 %in% input$d1gender, Unittype_One %in% input$d1pedcy) %>%
  group_by( age.cat, hour ) %>%
  summarize( harm = sum(Totalinjuries) + sum(Totalfatalities) )

qplot( data=Chart3, x=hour, y=harm, 
       geom=c("point", "smooth")  ) + 
       facet_wrap( ~ age.cat, ncol=5 )

and got errors:

dat %>%
+   filter( age.cat == "Senior", as.numeric(hour) >= 0, day %in% input$days3, Gender_Drv1 %in% input$d1gender, Unittype_One %in% input$d1pedcy) %>%
+   group_by( age.cat, hour ) %>%
+   summarize( harm = sum(Totalinjuries) + sum(Totalfatalities) ) -> Chart3
Error in day %in% input$days3 : object 'input' not found
> 
> qplot( data=Chart3, x=hour, y=harm, 
+        geom=c("point", "smooth")  ) + 
+        facet_wrap( ~ age.cat, ncol=5 )
Error in ggplot(data, mapping, environment = caller_env) : 
  object 'Chart3' not found
> 

[lecy]

The error is in your filter function, not the plot:

Error in day %in% input$days3 : object 'input' not found

Are you running the chunk? You might have to run the full file to instantiate the input object.

[lecy]

Also remove this logical statement from the filter, or it would only have one group.

filter( age.cat == "Senior", ... )

[castower]

@lecy

Okay, I made those changes and ran this code:

```{r}
Chart3 <- dat %>%
  filter( age.cat, as.numeric(hour) >= 0, day %in% input$days3, Gender_Drv1 %in% input$d1gender, Unittype_One %in% input$d1pedcy) %>%
  group_by( age.cat, hour ) %>%
  summarize( harm = sum(Totalinjuries) + sum(Totalfatalities) )

qplot( data=Chart3, x=hour, y=harm, 
       geom=c("point", "smooth")  ) + 
       facet_wrap( ~ age.cat, ncol=5 )

The window gave me the following error:

Error: operations are possible only for numeric, logical, or complex types

[castower]

If it helps, here is my input:

```{r}
selectInput("days3", label = h3("Day of Week"), 
    choices = list("Monday"    = "Mon", 
                   "Tuesday"   = "Tue", 
                   "Wednesday" = "Wed", 
                   "Thursday"  = "Thu",
                   "Friday"    = "Fri",
                   "Saturday"  = "Sat",
                   "Sunday"    = "Sun" ),
    selected = c("Sun"))
selectInput("d1gender", label = h4("Driver 1 Gender"), 
    choices = c("Male","Female", "Unknown"), selected = c("Male"))
radioButtons("d1pedcy", label = h4("Driver 1 Transportation"),
    choices = c("Driver", "Pedalcyclist", "Pedestrian"), selected = c("Driver"))

[katiegentry07]

When I added my code for both input & output, it deleted any data for the other tabs. What would cause that?

Also, is there a way to change the length of the bar at the top of the dashboard?

[lecy]

@castower You can see a working example here. Did you change renderLeaflet to renderPlot?

dashboard-example.zip

[lecy]

@katiegentry07 Make sure that each widget has a unique name (widgetID).

checkbox( "days.01", ... ) checkbox( "days.02", ... )

Otherwise selections on one part of the dashboard might overwrite data on another part.

You can't set the width of the dashboard because it is responsive, which means it changes size based upon the size of the screen it is on. Not sure what you mean by the bar at top - the menu bar?

[katiegentry07]

@lecy, hmm I'll look into the naming. The top menu bar is wider than the naming and so it is blocking some of the choices that I have selected in the sidebar. Is that something that is adjustable? I can't find coding that seems to correlate, but it should be adjustable theoretically.

[castower]

I added the renderplot brackets around the code and now it will run, but it produces this error:

[lecy]

@katiegentry07 Try maximizing the viewing window, or click the "Open in browser" option at top left.

[lecy]

@castower What do this give you?

class( dat$age.cat )  # should be a factor

[castower]

@castower What do this give you?

class( dat$age.cat )  # should be a factor

Mine has become a character somehow.

> class(dat$age.cat)
[1] "character"

[lecy]

@castower Or maybe:

Chart3$hour <- as.numeric( Chart3$hour )
Chart3$harm <- as.numeric( Chart3$harm )
Chart3$age.cat <- as.factor( Chart3$age.cat ) 

qplot( data=Chart3, x=hour, y=harm, 
       geom=c("point", "smooth")  ) + 
       facet_wrap( ~ age.cat, ncol=5 )

[castower]

I tried running this:

renderPlot({

Chart3 <- dat %>%
  filter( age.cat, as.numeric(hour) >= 0, day %in% input$days3, Gender_Drv1 %in% input$d1gender2, Unittype_One %in% input$d1pedcy2) %>%
  group_by( age.cat, hour ) %>%
  summarize( harm = sum(Totalinjuries) + sum(Totalfatalities) )

Chart3$hour <- as.numeric( Chart3$hour )
Chart3$harm <- as.numeric( Chart3$harm )
Chart3$age.cat <- as.factor( Chart3$age.cat ) 

qplot( data=Chart3, x=hour, y=harm, 
       geom=c("point", "smooth")  ) + 
       facet_wrap( ~age.cat, ncol=5 )

})

and it produces the same error.

[jmacost5]

Does this work then? This one is saying there is an error Input

radioButtons("commute.type", label = h3("Commute Type"),
    choices = c("Work", "Morning Commute", "School Pickup", "Evening Commute", "Night", "Midnight to Dawn"), selected = c("Work"))```

Output

```renderLeaflet({

  days.of.week <- input$days    # vector will all checked values
  dat$commute.type <- dat$time.of.day

dat <- mutate( dat, commute.type = time.of.day )
dat %>%
    filter( day %in% input$days, commute.type %in% input$some_widget_name )

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

This is being weird too

```radioButtons("AlcoholUse_Drv1", label = h4("Driver 1 Influence"),
    choices = c("No Apparent Influence", "Alcohol"), selected = c("No Apparent Influence"))
radioButtons("AlcoholUse_Drv2", label = h4("Driver 2 Influence"),
    choices = c("No Apparent Influence", "Alcohol"), selected = c("No Apparent Influence"))Driver

Driver 1

    dat %>%
    filter( Age_Drv1 >= input$driver.1.age[1] & Age_Drv1 <= input$driver.1.age[2], 
            Gender_Drv1 %in% input$driver.1.gender, 
            AlcoholUse_Drv1 %in% input$driver.1.AlcoholUse) ```

Driver 2

d11 <- dat %>% filter( Age_Drv2 >= input$driver.2.age[1] & Age_Drv2 <= input$driver.2.age[2], Gender_Drv2 %in% input$driver.2.gender, AlcoholUse_Drv2 %in% input$driver.2.AlcoholUse )```

[lecy]

@castower

Can you send me your RMD via email?

Also try this - am curious what your table looks like.

renderPrint({

Chart3 <- dat %>%
  filter( age.cat, as.numeric(hour) >= 0, day %in% input$days3, Gender_Drv1 %in% input$d1gender2, Unittype_One %in% input$d1pedcy2) %>%
  group_by( age.cat, hour ) %>%
  summarize( harm = sum(Totalinjuries) + sum(Totalfatalities) ) %>%
  select( hour, harm, age.cat )

dput( Chart3 )

})

Then paste your output.

[jmacost5]

So this is going to be weird, I used the templet for the lab and only have a file with the tabs I am working on in one file and the other file is going to be for the tabs that are already made I was going to put them in at the end. I am dong to note that in my email I did not put the above graphic in yet.

[lecy]

@jmacost5

The widget name here is "commute.type":

radioButtons("commute.type", label = h3("Commute Type"),
    choices = c("Work", "Morning Commute", "School Pickup", 
              "Evening Commute", "Night", "Midnight to Dawn"), 
selected = c("Work"))

Time of day was defined in the beginning:

dat <- 
  dat %>% 
  mutate( time.of.day = case_when( hour >= 6 & hour <= 9 ~ "Morning Commute", 
                                   hour >= 16 & hour <= 19 ~ "Evening Commute", 
                                   hour >= 14 & hour <= 15 ~ "School Pickup", 
                                   hour >= 9 & hour <= 13 ~ "Work", 
                                   hour >= 20 & hour <= 23 ~ "Night", 
                                   hour <= 5 & hour >= 0 ~ "Midnight to Dawn") )

So this is wrong:

dat %>%
    filter( day %in% input$days, commute.type %in% input$some_widget_name )

This is right:

dat %>%
    filter( day %in% input$days, time.of.day %in% input$commute.type )

"some_widget_name" was just a placeholder as an example.

[castower]

renderPrint({

Chart3 <- dat %>%
  filter( age.cat, as.numeric(hour) >= 0, day %in% input$days3, Gender_Drv1 %in% input$d1gender2, Unittype_One %in% input$d1pedcy2) %>%
  group_by( age.cat, hour ) %>%
  summarize( harm = sum(Totalinjuries) + sum(Totalfatalities) ) %>%
  select( hour, harm, age.cat )

dput( Chart3 )

})

The only output I'm getting is

[jmacost5]

For some reason d2 is not being found when I run my program completely

[castower]

Hello all, I've almost got my dashboard done, but one problem that I have discovered is that when the bar charts I created do not have a value, instead of just presenting a blank graph, it gives the following error:

Error: Aesthetics must be either length 1 or the same as the data (1): y

I've currently made a sidebar note to indicate that this simply means there's no data, but I'm curious if there is a way to stop this error.

Here is my code:

Input:

selectInput("collision", label = h3("Type of Collision"), 
    choices = list("ANGLE (Front To Side)(Other Than Left Turn)",
                   "Head On",
                   "Left Turn",
                   "Other",
                   "Rear End",
                   "Sideswipe Same Direction",
                   "Single Vehicle",
                   "Unknown" ),
    selected = c("Rear End"))
selectInput("gen", label = h3("Gender"), 
    choices = c("Male",
                "Female", 
                "Unknown"), 
    selected = c("Male"))
radioButtons("weather", label = h3("Weather"),
    choices = c("Dust Storm" = "Blowing Sand Soil Dirt", 
                "Clear", 
                "Cloudy",
                "Rain",
                "Unknown"), 
    selected = c("Clear"))

Output:

 renderPlot( {

Chart4 <- dat %>% filter( age.cat== "Youth", Gender_Drv1 %in% input$gen, Weather %in% input$weather, Collisionmanner %in% input$collision) %>%
  group_by( age.cat ) %>%
  summarize( harm = sum(Totalinjuries) + sum(Totalfatalities) )

ggplot(data=Chart4, aes(x=input$collision, y=Chart4$harm)) +
  geom_bar(stat="identity", fill="firebrick") + labs(x="Collision Type", y = "Number of Harmful Crashes") + theme_minimal()

})

For example, if I select dust storm and female, my Youth and Senior categories produce the error message above.

[RickyDuran]

When I try to publish, I am getting this request, although when trying to do it with something else I didn't get this, and created an app in shiny.

[jmacost5]

I am doing just the alcohol consumption. Does this make sense for out code?

Drivers 2 {data-orientation=rows} =====================================

Sidebar {.sidebar}

Driver Characteristics

sliderInput("driver.1.age", label = h4("Driver 1 Age"), 
            min = 15, max = 100, value = c(18,36) )
sliderInput("driver.2.age", label = h4("Driver 2 Age"), 
            min = 15, max = 100, value = c(18,36) )
selectInput("driver.1.gender", label = h4("Driver 1 Gender"), 
    choices = c("Male","Female", "Unknown"), selected = c("Male"))
selectInput("driver.2.gender", label = h4("Driver 2 Gender"), 
    choices = c("Male","Female", "Unknown"), selected = c("Male"))
radioButtons("AlcoholUse_Drv1", label = h4("Driver 1 Influence"),
    choices = c("No Apparent Influence", "Alcohol"), selected = c("No Apparent Influence"))
radioButtons("AlcoholUse_Drv2", label = h4("Driver 2 Influence"),
    choices = c("No Apparent Influence", "Alcohol"), selected = c("No Apparent Influence"))

Row

Number of Crashes

renderValueBox({
  d2 <-
    dat %>%
    filter( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
            Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2], 
            Gender_Drv1 %in% input$d1gender, 
            Gender_Drv2 %in% input$d2gender, 
            Unittype_One %in% input$d1pedcy, 
            Unittype_Two %in% input$d2pedcy)

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

Total Injuries

renderValueBox({
  d2 <-
    dat %>%
    filter( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
            Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2], 
            Gender_Drv1 %in% input$d1gender, 
            Gender_Drv2 %in% input$d2gender, 
            Unittype_One %in% input$d1pedcy, 
            Unittype_Two %in% input$d2pedcy )

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

Total Fatalities

renderValueBox({
  d2 <-
    dat %>%
    filter( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
            Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2], 
            Gender_Drv1 %in% input$d1gender, 
            Gender_Drv2 %in% input$d2gender, 
            Unittype_One %in% input$d1pedcy, 
            Unittype_Two %in% input$d2pedcy )

  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( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
            Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2], 
            Gender_Drv1 %in% input$d1gender, 
            Gender_Drv2 %in% input$d2gender, 
            Unittype_One %in% input$d1pedcy, 
            Unittype_Two %in% input$d2pedcy )

  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"))
})

Column

Driver 1

renderLeaflet({

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

  d10 <-
    dat %>%
    filter( Age_Drv1 >= input$driver.1.age[1] & Age_Drv1 <= input$driver.1.age[2], 
            Gender_Drv1 %in% input$driver.1.gender, 
            AlcoholUse_Drv1 %in% input$driver.1.AlcoholUse)

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

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

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

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

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

})

Driver 2

renderLeaflet({

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

  d11 <-
    dat %>%
    filter( Age_Drv2 >= input$driver.2.age[1] & Age_Drv2 <= input$driver.2.age[2], 
            Gender_Drv2 %in% input$driver.2.gender, 
             AlcoholUse_Drv2 %in% input$driver.2.AlcoholUse )

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

  point.size2 <- d11$Totalinjuries + d11$Totalfatalities

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

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

  addCircles( tempe2, lng=d11$Longitude, lat=d11$Latitude,
              fillColor=d11$col.vec, fillOpacity=0.5, 
              stroke=F, radius=50*(1+0.33*point.size2),
              popup=crash.details2 )

})

[lecy]

@RickyDuran Are you trying to publish through shinyapp.io or through R Studio Connect? Connect is a different service that we currently don't have configured. I would need to know more about what steps you followed to get that window to diagnose.

[RickyDuran]

@lecy, after reading through some of the thread that was hidden, I noticed you had said to redownload the template. I did so, and it seems to have fixed the issue.

[lecy]

@castower It would require conditional statements (control structures in computer speak) that we have not learned yet.

I can send some code if you want to try it out.

if( condition is met)
{  do the thing }
if( condition is not met )
{ print something else }

[lecy]

@jmacost5

Does this make sense for out code?

Can you be more specific? Do you want feedback on the design or on something not working? What are you trying to show with that tab?

[castower]

@castower It would require conditional statements (control structures in computer speak) that we have not learned yet.

I can send some code if you want to try it out.

if( condition is met)
{  do the thing }
if( condition is not met )
{ print something else }

@lecy That would be great. If it helps, basically what I'm trying to accomplish is:

If there's one more crashes then the chart displays.

If not, then there's a blank chart OR maybe a message that says 'No data available' instead of the odd error message that would be hard for someone unfamiliar with R to understand.

I can re-send my .rmd file if needed.

Thanks!

[RickyDuran]

When trying to deploy the app, I get the message: ERROR: An error has occurred. Check your logs or contact the app author for clarification. It is showing up in the viewer, in R, but not in Shinyapps.

[jmacost5]

I am getting an error when I put it into the shinny document. I just do not understand how to make it better

Here is the code I have currently:Driver Characteristics {data-orientation=rows} =====================================

Sidebar {.sidebar}

Driver Characteristics

sliderInput("driver.1.age", label = h4("Driver 1 Age"), 
            min = 15, max = 100, value = c(18,36) )
sliderInput("driver.2.age", label = h4("Driver 2 Age"), 
            min = 15, max = 100, value = c(18,36) )
selectInput("driver.1.gender", label = h4("Driver 1 Gender"), 
    choices = c("Male","Female", "Unknown"), selected = c("Male"))
selectInput("driver.2.gender", label = h4("Driver 2 Gender"), 
    choices = c("Male","Female", "Unknown"), selected = c("Male"))
radioButtons("AlcoholUse_Drv1", label = h4("Driver 1 Influence"),
    choices = c("No Apparent Influence", "Alcohol"), selected = c("No Apparent Influence"))
radioButtons("AlcoholUse_Drv2", label = h4("Driver 2 Influence"),
    choices = c("No Apparent Influence", "Alcohol"), selected = c("No Apparent Influence"))

Row

Number of Crashes

renderValueBox({
  d2 <-
    dat %>%
    filter( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
            Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2], 
            Gender_Drv1 %in% input$d1gender, 
            Gender_Drv2 %in% input$d2gender, 
            AlcoholUse_Drv1 %in% input$driver.1.AlcoholUse,
            AlcoholUse_Drv2 %in% input$driver.2.AlcoholUse )

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

Total Injuries

renderValueBox({
  d2 <-
    dat %>%
    filter( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
            Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2], 
            Gender_Drv1 %in% input$d1gender, 
            Gender_Drv2 %in% input$d2gender, 
           AlcoholUse_Drv1 %in% input$driver.1.AlcoholUse,
            AlcoholUse_Drv2 %in% input$driver.2.AlcoholUse  )

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

Total Fatalities

renderValueBox({
  d2 <-
    dat %>%
    filter( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
            Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2], 
            Gender_Drv1 %in% input$d1gender, 
            Gender_Drv2 %in% input$d2gender, 
            AlcoholUse_Drv1 %in% input$driver.1.AlcoholUse,
            AlcoholUse_Drv2 %in% input$driver.2.AlcoholUse  )

  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( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
            Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2], 
            Gender_Drv1 %in% input$d1gender, 
            Gender_Drv2 %in% input$d2gender, 
            AlcoholUse_Drv1 %in% input$driver.1.AlcoholUse,
            AlcoholUse_Drv2 %in% input$driver.2.AlcoholUse  )

  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 Characteristics

renderLeaflet({

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

  d2 <-
    dat %>%
    filter( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
            Age_Drv2 >= input$d2age[1] & Age_Drv2 <= input$d2age[2], 
            Gender_Drv1 %in% input$d1gender, 
            Gender_Drv2 %in% input$d2gender, 
            AlcoholUse_Drv1 %in% input$driver.1.AlcoholUse,
           AlcoholUse_Drv2 %in% input$driver.2.AlcoholUse )

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

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

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

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

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

})

[etbartell]

I am attempting to make a plot showing different degrees of injury severity over time. The sidebar with the inputs is working but the output area is blank. I think it's because the date is a character variable that can be graphed but I'm not sure. I tired converting it to numeric but it just made everything "NA". Here is my input:

dat$MDY <- format( date.vec, format="%D" )

selectInput( "injuries", label = strong("Traffic Acciddent Injury Trends"), choices = c( "No Injury", "Possible Injury", "Non Incapacitating Injury", "Incapacitating Injury", "Fatal" ), selected = "No Injury")

dateRangeInput("date_range", label = h3("Date Range"), start = "01/01/2017", end = "12/31/2017", min = "01/012012", max = "12/31/2017", format = "mm/dd/yyyy", startview = "month", language = "en", separator = " to ")

and the current draft of my output:

renderPlot({

  d4 <-
    dat %>%
    filter( Injuryseverity %in% input$injuries, MDY >= input$date_range[1] & MDY < input$date[2] ) %>%
    count( MDY, Injuryseverity ) %>%
    group_by( MDY ) %>%
    mutate( total.injury = n )
  plot.new()
  plot.window(xlim = c(input$date[1], input$date[2]), ylim = c(0,10))
  points( d4$MDY, d4$total.injury, col = "dodgerblue4", pch=19, type = "l", cex = 2)
  xlab="Date"
  ylab="Injury Count"
  main="Tempe Accident Injury Trends"
})

[meliapetersen]

Hi, I am having an issue with my dropdown widgets connecting to the map. I am able to select the different options, but the crashes are not showing up on the leaflet. Here is my code:

` Traffic Accidents By Substance Abuse =====================================

Inputs {.sidebar}

selectInput("d1.substance", label = h4("Driver 1 Substance Use"), 
    choices = c("Alcohol", "Drugs", "No Apparent Use", "Unknown"), selected = c("No Apparent Use"))
selectInput("d2.substance", label = h4("Driver 2 Substance Use"), 
    choices = c("Alcohol", "Drugs", "No Apparent Use", "Unknown"), selected = c("No Apparent Use"))

# parameters

Outputs

Traffic Accidents By Substance Abuse

#leaflet
renderLeaflet({

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

  d2 <-
    dat %>%
    filter( d1.substance %in% input$d1.substance, 
            d2.substance %in% input$d2.substance, 
             )

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

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

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

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

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

})
```   `

[lecy]

@jmacost5 It is the same issue you were having before: https://github.com/DS4PS/cpp-526-fall-2019/issues/27#issuecomment-540358416

You name your widget driver.1.age:

sliderInput("driver.1.age", label = h4("Driver 1 Age"), 
            min = 15, max = 100, value = c(18,36) )

But then in the renderValueBoxes section you are referencing a widget named d1age.

 d2 <-
    dat %>%
    filter( Age_Drv1 >= input$d1age[1] & Age_Drv1 <= input$d1age[2], 
    ... 

You will always reference the user input at input$widget_name where widget_name is whatever name you give it. If you use different names the render function will not be able to find the user inputs.

Should be:

sliderInput( "driver.1.age", label = h4("Driver 1 Age"), 
            min = 15, max = 100, value = c(18,36)  )

 d2 <-
    dat %>%
    filter( Age_Drv1 >= input$driver.1.age[1] & Age_Drv1 <= input$driver.1.age[2], 
    ... 

[lecy]

@etbartell You are missing a date separator here in the min argument:

dateRangeInput( "date_range", label = h3("Date Range"), 
    start = "01/01/2017", end = "12/31/2017", 
    min = "01/012012", max = "12/31/2017", 
    format = "mm/dd/yyyy", startview = "month", language = "en", separator = " to ")

You might double-check the variable type returned by the date widget. I suspect it is a character vector, and you might have to convert it to a date object before using in a date comparison.

https://shiny.rstudio.com/gallery/widget-gallery.html

It can be tricky because a date compared to text will still evaluate, it just casts both as text:

widget.dates <- c("01/01/2017","12/31/2017")
widget.dates.1 <- strptime( widget.dates, format="%m/%d/%Y" )
class( widget.dates.1 )
widget.dates.2 <- format( widget.dates.1, format="%D" )
class( widget.dates.2 )

widget.dates.1
[1] "2017-01-01 MST" "2017-12-31 MST"
widget.dates.1 > "06/01/2017" # comparison to text
[1] TRUE TRUE
widget.dates.1 >  strptime( "06/01/2017", format="%m/%d/%Y" )# comparison to date
[1] FALSE  TRUE