Quantcast
Channel: Active questions tagged r - Stack Overflow
Viewing all articles
Browse latest Browse all 201839

Toggle input options and slider range

$
0
0

I gotten some great help to have reactive function working from Chris. However, there is still some issues I have and hoping there could be suggestions.

Firstly, within the reactive function, I am trying to get a range of months. I tried this

(as.integer(format(peo$LOCATION.EFFECTIVE.DATE,"%m")) > input$month[1] &
 as.integer(format(peo$LOCATION.EFFECTIVE.DATE,"%m")) < input$month[2])

but it does not work. It looks like it only pulls the actual input$month[i] values when I am trying to pull a sequence of months based on slider input, input$month[1]:input$month[2].

Secondly, I am not satisfied with the way my inputs work. Hoping to get some suggestions because the inputs are nested within each other. I feel like a user should have the option to choose either Tier or PEO and then LOCATION.EFFECTIVE.DATE. So maybe, if a user uses the Tier option, PEO is not selectable and if a user uses PEO then Tier is not selectable. Maybe a switch to toggle either Tier or PEO

library(shiny)
library(plotly)
library(leaflet)
library(dplyr)
library(tidyverse)


peo <- read.csv("https://raw.githubusercontent.com/cwong79/DATA608/master/PEO1.csv")
#Dataset needs work, need to create Peo Tiers

peo$NAICSClassCode <- as.numeric(substr(peo$NAICS, start = 1, stop = 2))

type <- c("Agriculture, Forestry, Fishing and Hunting", 
          "Mining", 
          "Utilities", 
          "Construction", 
          "Manufacturing", 
          "Wholesale Trade", 
          "Retail Trade",
          "Transportation and Warehousing", 
          "Information", 
          "Finance and Insurance", 
          "Real Estate Rental and Leasing", 
          "Professional, Scientific, and Technical Services", 
          "Management of Companies and Enterprises", 
          "Administrative and Support and Waste Management and Remediation Services", 
          "Educational Services", 
          "Health Care and Social Assistance", 
          "Arts, Entertainment, and Recreation", 
          "Accommodation and Food Services", 
          "Other Services (except Public Administration)", 
          "Public Administration")
naicsdata <- data.frame(type)
peo$NAICS_TYPE <- cut(peo$NAICSClassCode, c(1, 11, 21, 22, 23, 34, 42, 46, 50, 51, 52, 53, 54, 55, 57, 61, 63, 71, 73, 82, Inf), type)

peo$NAICS_TYPE <- as.character(peo$NAICS_TYPE)
peo$NAICS_TYPE[is.na(peo$NAICS_TYPE)] <- "Unknown"

peo$LOCATION.EFFECTIVE.DATE <- as.Date(peo$LOCATION.EFFECTIVE.DATE, "%m/%d/%y")
peo$RenewalMonth <- format(peo$LOCATION.EFFECTIVE.DATE, "%B")

peo %>% group_by(peo$NAMED.INSURED) %>% summarize(count=n())
peo %>% group_by(peo$NAICS_TYPE) %>% summarize(count=n())
#Dataset needs work, need to create Peo Tiers (1,2,3), Better for visualization

tier1 <- c("ADP TOTAL SOURCE INC", "A 1 HR A DIVISION OF OASIS OUTSOURCING INC", "COADVANTAGE CORP", "INSPERITY INC", "OASIS ACQUISITION INC", "OASIS ACQUISITION INC A PAYCHEX CO", "OASIS DHR LLC", "OASIS OUTSOURCING CONTRACT II INC", "OASIS OUTSOURCING INC", "PAYCHEX BUSINESS SOLUTIONS LLC", "PAYCHEX HR OUTSOURCING LLC", "TRINET GROUP INC", "TRINET HR II HOLDINGS INC", "TRINET HR IV LLC")
tier2 <- c("ALLY HR LLC DBA MATRIXONESOURCE", "ALPHASTAFF GROUP INC", "CHOICE EMPLOYER SOLUTIONS INC", "CORNERSTONE CAPITAL GROUP INC", "DECISION HR", "FLORIDA RESOURCE MANAGEMENT LLC", "FRANKCRUM 2 INC", "IMPACT STAFF LEASING LLC", "JUSTWORKS EMPLOYMENT GROUP LLC", "KYMBERLY GROUP PAYROLL SOLUTIONS INC", "OCMI III INC DBA PEOPAYGO", "REGIS GROUP HOLDINGS INC", "SOUTH EAST PERSONNEL LEASING INC", "STAFFLINK OUTSOURCING INC", "THE S2 HR GROUP LLC", "TLR OF BONITA INC", "WORKFORCE BUSINESS SERVICES INC")

peo$Tier <- with(peo, ifelse(NAMED.INSURED %in% tier1, "1", 
                      ifelse(NAMED.INSURED %in% tier2, "2", "3")))

rsconnect::setAccountInfo(name='cwong79', token='5B0BCB17374463CE3B80CCA8BB3F28F8', secret='QvX9JgFebCgQkFbm9tL3KsRhSPItHDMfXVRN+qaJ')

options(mapbox.accessToken = "pk.eyJ1IjoiY3dvbmc3OSIsImEiOiJjazNkNW4wOTQwa3pjM2Jva3JwZHB0OXFmIn0.h-12OxqTpTI0Pj7Wk7HJnQ")

#Set up ui
ui <-  fluidPage(
    titlePanel("PEO Choices"),
    sidebarPanel(h5("", width=1),
                 checkboxGroupInput(inputId = "TierFlag",
                                    label = h4("Tier"), 
                                    choices = setNames(object = c("1", "2", "3"),
                                                       nm = c("1", "2", "3")),
                                    selected = c("1", "2", "3")), 
                 selectInput(inputId = "PeoType",
                             label = h4("Peo"),
                             choices = sort(unique(peo$NAMED.INSURED)),
                             multiple = TRUE),
                 sliderInput(inputId = "month",
                             label = h4("Month"),
                             min = 1,
                             max = 12,
                             value = c(2, 10),
                             step = 1,
                             width = "100%",
                             ticks = FALSE),
                 position="right"),

    #App mainPanel content and styles
    mainPanel(fluidRow(leafletOutput(outputId = "map")))
  )


#Set up server
server <- function(input, output){
  #Build leaflet map

#Set colors manually
pal <- colorFactor(
  palette = c('#1f78b4', '#b2df8a', '#feb24c'),
  domain = peo$Tier
)

#Build leaflet map
map <- leaflet() %>%
  #addCircles(data = peo, lat = ~ Latitude, lng = ~ Longitude, weight = 1) %>%
  addTiles() %>%  # Add default OpenStreetMap map tiles
  setView(-80.121, 26.194, zoom = 9) %>%
  addProviderTiles("MapBox", 
                     options = providerTileOptions(id = "mapbox.light", noWrap = FALSE, 
                                                   accessToken = 'pk.eyJ1IjoiY3dvbmc3OSIsImEiOiJjazNkNW4wOTQwa3pjM2Jva3JwZHB0OXFmIn0.h-12OxqTpTI0Pj7Wk7HJnQ')) %>%
  addCircles(lng = peo$Longitude, lat = peo$Latitude,
             popup = paste("Company Name:", peo$EMPLOYER, "<br>",
                           "PEO Type:", peo$NAMED.INSURED, "<br>",
                           "Industry:", peo$NAICS_TYPE, "<br>"),
             weight = 2, opacity = 0.5, radius = 5,
             color = pal(peo$Tier),     
             group = "myMarkers") %>%
  addLegend('bottomright',
            title = "Tiers",
            pal = pal,
            values = peo$Tier,
            opacity = 1)


#Filter data
  datFilt <- reactive({
    PeoSearch <- paste0(input$TierFlag, collapse='|')
    peo[grepl(PeoSearch, peo$Tier) | 
              peo$NAMED.INSURED %in% input$PeoType | 
              (as.integer(format(peo$LOCATION.EFFECTIVE.DATE,"%m")) > input$month[1] &
              as.integer(format(peo$LOCATION.EFFECTIVE.DATE,"%m")) < input$month[2]),
       ]
  })


observe({
    tryCatch({
      if(nrow(datFilt())==0) {showNotification("Nothing selected", type='warning')
        leafletProxy("map") %>% clearShapes()
        } else{ 
        leafletProxy("map", data=datFilt()) %>%
          clearShapes() %>%
          clearControls() %>%
          addCircles(lng = datFilt()$Longitude, lat = datFilt()$Latitude,
                     popup = paste("Company Name:", datFilt()$EMPLOYER, "<br>",
                                   "PEO Type:", datFilt()$NAMED.INSURED, "<br>",
                                   "Industry:", datFilt()$NAICS_TYPE, "<br>"),
                     weight = 2, opacity = 0.5, radius = 5,
                     color = pal(datFilt()$Tier)) %>%
          addLegend('bottomright',
                    title = "Tiers",
                    pal = pal,
                    values = peo$Tier,
                    opacity = 1)
      }}, 
      error= function(e){
        showNotification(paste0(e), type='err')
      })

   })

  output$map <- renderLeaflet(map)
}

#Run app
shinyApp(ui = ui, server = server)

Viewing all articles
Browse latest Browse all 201839

Trending Articles



<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>