library(tidyverse)
library(magrittr)
library(knitr)
library(kableExtra)
library(sparkline)
library(reactable)
library(table1)
library(lubridate)
library(reactablefmtr)
library(htmltools)
library(flextable)

Homework 4 Tables

Data Source

https://www.gsa.gov/travel/plan-book/per-diem-rates/per-diem-files

Summary

The U.S. General Services Administration sets rates for travel reimbursement annually for both lodging and for meals and incidental expenses. In 2023, the standard reimbursement for lodging will be $98 and the standard reimbursement for meals will be $59. Typically a large metropolis or a popular tourist destination will have its own per Diem that may vary depending on the season.

I have taken the per diem files created tables from multiple years to show what the rates would be during a holiday in the Spring (St. Patrick’s Day), the Summer (Independence Day), and the Fall (Thanksgiving Day). I create a reactable table that is filterable by year to show what the most expensive destinations may be.

Data Manipulation

I upload the data and reformat the dollar columns as numbers. I calculate the difference between the destination’s lodging rate and the standard US lodging rate. For destinations without seasonal rate dependence, I set the season to start on January 1st and end on December 31. I use the lubridate package to convert the dates for seasonal rates into time intervals that the holidays may fall into.

To compare data from different years, I move these data manipulations into a function. I run the function on data from 2020-2022 and combine the rows into a large tibble.

# get the standard rates for continental US over all years
standardrates <- read.csv("conusSTANDARDrates.csv",header=TRUE)

perdiem2023 <- read.csv("FY2023_PerDiemMasterRatesFile.csv",header=TRUE,skip=2)

newnames <- c("index","State","Destination","County","Season.Start","Season.End","Lodging","MandIE") 
names(perdiem2023) <- newnames

perdiem2023 %<>% mutate(Lodging=as.integer(str_remove(Lodging,"[ $]"))) %>% 
  mutate(MandIE=as.integer(str_remove(MandIE,"[ $]"))) %>% select(-index) %>% 
  mutate(State=as.factor(State)) 
USAdefaultLodging <- (standardrates %>% filter(year==2023))$standardLodging
USAdefaultMandIE <- (standardrates %>% filter(year==2023))$standardMIE
perdiem2023 %<>% mutate(LdiffUSDefault=Lodging-USAdefaultLodging)
perdiem2023 %<>% mutate(MdiffUSDefault=MandIE-USAdefaultMandIE)
perdiem2023 %>% head(2)

##   State Destination    County Season.Start  Season.End Lodging MandIE
## 1    AL  Birmingham Jefferson                              113     69
## 2    AL Gulf Shores   Baldwin    October 1 February 28     137     69
##   LdiffUSDefault MdiffUSDefault
## 1             15             10
## 2             39             10

perdiem2023%<>% mutate(Season.Start=if_else(Season.Start=="","January 1",Season.Start))
perdiem2023%<>% mutate(Season.End=if_else(Season.End=="","December 31",Season.End))

perdiem2023%<>% mutate(Season.End=mdy(paste(Season.End," 2023")))
perdiem2023%<>% mutate(Season.Start=mdy(paste(Season.Start," 2023")))
perdiem2023 %<>% mutate(Season=interval(Season.Start,Season.End))

baddates1 <- perdiem2023 %>% filter(Season<0)
baddates2 <- perdiem2023 %>% filter(Season<0)
perdiem2023 %<>% filter(Season>0)

baddates1 %<>% mutate(Season.End=mdy("December 31 2023")) %>%  mutate(Season=interval(Season.Start,Season.End))
baddates2 %<>% mutate(Season.Start=mdy("January 1 2023")) %>%  mutate(Season=interval(Season.Start,Season.End))

PD2023 <- bind_rows(perdiem2023,baddates1,baddates2) %>% arrange(State,Destination,County,Season.Start)

PD2023 %<>% mutate(Holiday="NOT")
dfID <- PD2023 %>%   mutate(Holiday=if_else(ymd("2023-07-4")%within%Season,"Independence Day",Holiday)) %>% dplyr::filter(Holiday!="NOT")
dfTD <- PD2023 %>%   mutate(Holiday=if_else(ymd("2023-11-24")%within%Season,"Thanksgiving Day",Holiday)) %>% dplyr::filter(Holiday!="NOT")
dfPD <- PD2023 %>%   mutate(Holiday=if_else(ymd("2023-3-17")%within%Season,"St. Patricks Day",Holiday)) %>% dplyr::filter(Holiday!="NOT")
PD2023 <- bind_rows(dfID,dfTD,dfPD) %>% arrange(State,Destination,County,Season.Start)
PD2023 %<>% mutate(Holiday=as.factor(Holiday))
PD2023 %<>%mutate(year=2023)

convert_PD_df <- function(mydf,myyear){
 newnames <- c("index","State","Destination","County","Season.Start","Season.End","Lodging","MandIE") 
names(mydf) <- newnames

mydf %<>% mutate(Lodging=as.integer(str_remove(Lodging,"[ $]"))) %>% 
  mutate(MandIE=as.integer(str_remove(MandIE,"[ $]"))) %>% select(-index) %>% 
  mutate(State=as.factor(State)) 
USAdefaultLodging <- (standardrates %>% filter(year==myyear))$standardLodging
USAdefaultMandIE <- (standardrates %>% filter(year==myyear))$standardMIE
mydf %<>% mutate(LdiffUSDefault=Lodging-USAdefaultLodging)
mydf %<>% mutate(MdiffUSDefault=MandIE-USAdefaultMandIE)
mydf %>% head(2)
mydf%<>% mutate(Season.Start=if_else(Season.Start=="","January 1",Season.Start))
mydf%<>% mutate(Season.End=if_else(Season.End=="","December 31",Season.End))

mydf%<>% mutate(Season.End=mdy(paste(Season.End,myyear)))
mydf%<>% mutate(Season.Start=mdy(paste(Season.Start,myyear)))
mydf %<>% mutate(Season=interval(Season.Start,Season.End))

baddates1 <- mydf %>% filter(Season<0)
baddates2 <- mydf %>% filter(Season<0)
mydf %<>% filter(Season>0)

yearend=paste("December 31",myyear)
yearstart=paste("January 1",myyear)
baddates1 %<>% mutate(Season.End=mdy(yearend)) %>%  
  mutate(Season=interval(Season.Start,Season.End))
baddates2 %<>% mutate(Season.Start=mdy(yearstart)) %>%
  mutate(Season=interval(Season.Start,Season.End))
mynewPD <- bind_rows(mydf,baddates1,baddates2) %>%
  arrange(State,Destination,County,Season.Start)

mynewPD %<>% mutate(Holiday="NOT")
july4=paste("July 4",myyear)
thankgiv <- paste("November 24",myyear)
stpaddy <- paste("March 17",myyear)
dfID <- mynewPD %>%   mutate(Holiday=if_else(mdy(july4)%within%Season,
                                             "Independence Day",Holiday)) %>%
  dplyr::filter(Holiday!="NOT")
dfTD <- mynewPD %>%   mutate(Holiday=if_else(mdy(thankgiv)%within%Season,
                                             "Thanksgiving Day",Holiday)) %>%
  dplyr::filter(Holiday!="NOT")
dfPD <- mynewPD %>%   mutate(Holiday=if_else(mdy(stpaddy)%within%Season,
                                             "St. Patricks Day",Holiday)) %>%
  dplyr::filter(Holiday!="NOT")
mynewPD <- bind_rows(dfID,dfTD,dfPD) %>% 
  arrange(State,Destination,County,Season.Start)
mynewPD %<>% mutate(Holiday=as.factor(Holiday))
mynewPD %<>%mutate(year=as.integer(myyear)) 
return(mynewPD)
}

perdiem2022 <- read.csv("FY2022_PerDiemMasterRatesFile.csv",header=TRUE,skip=2)
perdiem2021 <- read.csv("FY2021_PerDiemMasterRatesFile.csv",header=TRUE,skip=2)
perdiem2020 <- read.csv("FY2020_PerDiemMasterRatesFile.csv",header=TRUE,skip=2)

PD_allyears <- bind_rows(PD2023,convert_PD_df(perdiem2022,2022),
                         convert_PD_df(perdiem2021,2021),
                         convert_PD_df(perdiem2020,2020))

PD_allyears %>% filter(Destination=="Fresno",Holiday=="Independence Day")

##   State Destination County Season.Start Season.End Lodging MandIE
## 1    CA      Fresno Fresno   2023-01-01 2023-12-31     113     69
## 2    CA      Fresno Fresno   2022-01-01 2022-12-31     110     69
## 3    CA      Fresno Fresno   2021-01-01 2021-12-31     110     66
## 4    CA      Fresno Fresno   2020-01-01 2020-12-31     110     66
##   LdiffUSDefault MdiffUSDefault                         Season          Holiday
## 1             15             10 2023-01-01 UTC--2023-12-31 UTC Independence Day
## 2             14             10 2022-01-01 UTC--2022-12-31 UTC Independence Day
## 3             14             11 2021-01-01 UTC--2021-12-31 UTC Independence Day
## 4             14             11 2020-01-01 UTC--2020-12-31 UTC Independence Day
##   year
## 1 2023
## 2 2022
## 3 2021
## 4 2020

Static Tables

I use table1 package to compare Lodging and Meals rates across different holidays for the 2023 data set. Then I create a table comparing Summer and Fall rates between New York and Florida for the 2023 set.

label(PD2023$MandIE) <- "Meals and Incidentals,USD"
label(PD2023$Lodging) <- "Lodging,USD"
tableA <- table1(~Lodging+MandIE|Holiday, data=PD2023 ,topclass="Rtable1-shade")
tableA

	Independence Day (N=316)	St. Patricks Day (N=316)	Thanksgiving Day (N=316)	Overall (N=948)
Lodging,USD
Mean (SD)	151 (54.8)	142 (54.3)	131 (33.0)	141 (49.1)
Median [Min, Max]	133 [98.0, 459]	124 [98.0, 485]	122 [98.0, 289]	126 [98.0, 485]
Meals and Incidentals,USD
Mean (SD)	68.1 (5.47)	68.1 (5.47)	68.1 (5.47)	68.1 (5.46)
Median [Min, Max]	69.0 [59.0, 79.0]	69.0 [59.0, 79.0]	69.0 [59.0, 79.0]	69.0 [59.0, 79.0]

tableB <- table1(~Lodging+MandIE|Holiday*State, data=PD2023 %>% filter(State%in%c("FL","NY"),Holiday%in%c("Independence Day","Thanksgiving Day")))
tableB

	Independence Day		Thanksgiving Day		Overall
	FL (N=22)	NY (N=19)	FL (N=22)	NY (N=19)	FL (N=44)	NY (N=38)
Lodging,USD
Mean (SD)	163 (64.8)	138 (37.5)	139 (38.4)	129 (41.4)	151 (54.1)	133 (39.3)
Median [Min, Max]	137 [98.0, 329]	119 [101, 220]	132 [98.0, 289]	117 [98.0, 286]	134 [98.0, 329]	118 [98.0, 286]
Meals and Incidentals,USD
Mean (SD)	67.2 (3.29)	69.5 (4.68)	67.2 (3.29)	69.5 (4.68)	67.2 (3.25)	69.5 (4.62)
Median [Min, Max]	69.0 [59.0, 74.0]	69.0 [64.0, 79.0]	69.0 [59.0, 74.0]	69.0 [64.0, 79.0]	69.0 [59.0, 74.0]	69.0 [64.0, 79.0]

Reactable Table

I created a Reactable table to show the most expensive Destinations to travel. I aggregate to display the maximum lodging and the mean meals expenses for each for each state by year. I allow selection of the data by year. As you drill down into the state’s destinations, there is a bar chart to show how much more expensive they would be compared to the standard lodging.

# PD_allyears%>% 
  # select(State, Destination, Lodging,LdiffUSDefault,MandIE, Holiday,year)
reactable_table <-PD_allyears %>%
  group_by(State,year) %>% 
  dplyr::select(State, Destination, Lodging,LdiffUSDefault,MandIE, Holiday,year) %>% 
  reactable(groupBy = c("year","State"),
            paginateSubRows = TRUE,
            filterable = TRUE,
            style = list(fontSize = "1rem"),columns = list(
    year=colDef(name="Year",filterable=TRUE,
             filterInput = function(values, name) {
        tags$select(
          # Set to undefined to clear the filter
          onchange = sprintf("Reactable.setFilter('year-select',
                             '%s', event.target.value || undefined)", name),
          # "All" has an empty value to clear the filter, and is the default option
          tags$option(value = "", "All"),
          lapply(unique(values), tags$option),
          "aria-label" = sprintf("Filter %s", name),
          style = "width: 100%; height: 28px;"
        ) },
                ),
    State=colDef(
      filterInput = function(values, name) {
        tags$select(
          # Set to undefined to clear the filter
          onchange = sprintf("Reactable.setFilter('year-select',
                             '%s', event.target.value || undefined)", name),
          # "All" has an empty value to clear the filter, and is the default option
          tags$option(value = "", "All"),
          lapply(unique(values), tags$option),
          "aria-label" = sprintf("Filter %s", name),
          style = "width: 100%; height: 28px;"
        ) }
    ),
   Destination=colDef(
      filterInput = function(values, name) {
        tags$select(
          # Set to undefined to clear the filter
          onchange = sprintf("Reactable.setFilter('year-select',
                             '%s', event.target.value || undefined)", name),
          # "All" has an empty value to clear the filter, and is the default option
          tags$option(value = "", "All"),
          lapply(unique(values), tags$option),
          "aria-label" = sprintf("Filter %s", name),
          style = "width: 100%; height: 28px;"
        ) }
    ),
    Lodging = colDef(aggregate = "max",filterable = FALSE,
                     format = list(cell=colFormat(currency = "USD"),
                                   aggregated = colFormat(prefix = "maximum =",
                                                          currency = "USD")),
                     name = "Lodging"),
    LdiffUSDefault = colDef(name = "Over Standard Lodging Rate",filterable = FALSE,
                            cell = data_bars(., fill_color = c("red","black"),
                                             fill_gradient = TRUE,
                                             number_fmt=scales::number_format(accuracy=1)
                                             )),
    MandIE = colDef(aggregate = "mean",filterable = FALSE,
                    format = list(cell=colFormat(currency = "USD"),
                                  aggregated = colFormat(prefix = "mean =",
                                                         currency = "USD")),
                    name = "Meals & Incidentals"),
    Holiday=colDef(
      filterInput = function(values, name) {
        tags$select(
          # Set to undefined to clear the filter
          onchange = sprintf("Reactable.setFilter('year-select',
                             '%s', event.target.value || undefined)", name),
          # "All" has an empty value to clear the filter, and is the default option
          tags$option(value = "", "All"),
          lapply(unique(values), tags$option),
          "aria-label" = sprintf("Filter %s", name),
          style = "width: 100%; height: 28px;"
        ) }
    )
    ),
    defaultSorted = "Lodging",
    defaultSortOrder = "desc",
    theme=clean(),
    defaultPageSize = 15,
    elementId = "year-select")  %>%   add_title("Per Diem Travel Rates ") %>% 
  add_subtitle("as issued by the US Goverment for various holidays.") %>% 
  add_source("https://www.gsa.gov/travel/plan-book/per-diem-rates/per-diem-files")
  
reactable_table

Per Diem Travel Rates

as issued by the US Goverment for various holidays.