# DAMAGE ASSIGNMENT CROSSWALK FUNCTION
#This function is used in the CA16_mort_prelim sequence to assign damage and severity codes using a uniform system.
# While the damage and severity codes are different for 2001-2004, 2005-2012, and 2012-2016, the function uses a reference table to crosswalk the levels and reassign them to :
#1) either "MAJOR" or "MINOR" severity (based on the thresholds used in 2013 -)
#2) A PTIPS group classification (based on either the DMG_AGENT1_CD_PNWRS or DAMAGE_AGENT_CD1, depending on the year.)
# Depends: C:/Users/stellac/Box Sync/Work/CA_mort_shared/Data/Wksp/reference_sevcodes.csv
# currently built from:
#"C:/Users/stellac/Box Sync/Work/CA_mort_shared/Data/Wksp/sevmerge1.csv" and
#"C:/Users/stellac/Box Sync/Work/CA_mort_shared/Data/Wksp/sevmerge2.csv"
#using
# C:/Users/stellac/Documents/Repos/mortfia/code/sevcodes.R
# ####### PREPARATION: PULL IN THE SEVERITY REFERENCE SHEET ( only for using standalone)
# # see sevcodes.R for xwalk spreadsheet
# dir_sev <- "C:/Users/stellac/Box Sync/Work/CA_mort_shared/Data/Wksp/"
# path <- paste0(dir_sev, "reference_sevcodes.csv", sep = "")
# sevref <- read.csv(path)
# head(sevref)
# sevref <- filter(sevref, PTIPSCODE > 1)
# # select the brief columns and ignore the rest though they are helpful definitions to keep around.
# sevref <- sevref[,-c(10,14)]
#
# # tree.in is tree4 and sevref.in is sevref:
# tree.in <- tree4
# sevref.in <- sevref
##### DAMAGE ASSIGNMENT FUNCTION HERE
damage_assign <- function(tree.in, sevref.in){
# Extract just the damage codes into a separate data frame:
tree_dmg <- select(tree.in, TRE_CN, PLT_CN, INVYR,
DAMSEV1, DAMSEV2,
DAMLOC1_PNWRS, DMG_AGENT1_CD_PNWRS, SEVERITY1_CD_PNWRS,
DAMLOC2_PNWRS, DMG_AGENT2_CD_PNWRS, SEVERITY2_CD_PNWRS,
SEVERITY1A_CD_PNWRS, SEVERITY1B_CD_PNWRS,
SEVERITY2A_CD_PNWRS, SEVERITY2B_CD_PNWRS,
DAMAGE_AGENT_CD1, DAMAGE_AGENT_CD2,
MIST_CL_CD, MIST_CL_CD_PNWRS)
dim(tree_dmg)
tree_dmg$DMG_AGENT1_CD_PNWRS <- ifelse(tree_dmg$DMG_AGENT1_CD_PNWRS == 0,
NA, tree_dmg$DMG_AGENT1_CD_PNWRS)
###############################################
# 1ST step is assigning groups to the codes - these will be used for binning up the damages later
names(sevref.in) <- c("DMG_GRP", "DMG_GRPNM", "DMG_CD",
"DMG_CDNM", "PTIPSCODE", "PTIPSNAME",
"PTIPSXWALK", "PTIPSXWALKNM", "SEV_LEVELS",
"PTIPS_THRESH_VAL", "SEVCODE", "SEVBIN")
sevcode <- sevref.in
sevcode$DMG_AGENT1_CD_PNWRS <- sevcode$DMG_CD
sevcode$DMG_AGENT2_CD_PNWRS <- sevcode$DMG_CD
sevcode$SEVERITY1_CD_PNWRS <- sevcode$SEV_CD
sevcode$SEVERITY1A_CD_PNWRS <- sevcode$SEV_CD
sevcode$SEVERITY1B_CD_PNWRS <- sevcode$SEV_CD
sevcode$SEVERITY2_CD_PNWRS <- sevcode$SEV_CD
sevcode$SEVERITY2A_CD_PNWRS <- sevcode$SEV_CD
sevcode$SEVERITY2B_CD_PNWRS <- sevcode$SEV_CD
#
sevcode$DAMAGE_AGENT_CD1_XW <- sevcode$PTIPSXWALK
sevcode$DAMAGE_AGENT_CD2_XW <- sevcode$PTIPSXWALK
#Populate group for each severity level, giving the PTIPS XWALK groups the DAM1_GRP_CD title.
sevcode_grp1 <- select(sevcode, PTIPSXWALK, PTIPSXWALKNM, DMG_AGENT1_CD_PNWRS)
names(sevcode_grp1) <- c("DAM1_GRP_CD", "DAM1_PTIPSXWALKNM", "DMG_AGENT1_CD_PNWRS")
sevcode_grp1 <- unique(sevcode_grp1)
tdmg_grp1 <- left_join(tree_dmg, sevcode_grp1)
sevcode_grp2 <- select(sevcode, PTIPSXWALK, PTIPSXWALKNM, DMG_AGENT2_CD_PNWRS)
names(sevcode_grp2) <- c("DAM2_GRP_CD", "DAM2_PTIPSXWALKNM", "DMG_AGENT2_CD_PNWRS")
sevcode_grp2 <- unique(sevcode_grp2)
# TDMG: master dataframe join
tdmg <- left_join(tdmg_grp1, sevcode_grp2)
dim(tdmg)
#dim(tree4)
#######################################
# 2ND STEP: ZEROS are NA. What a mess.
# First clean up the D1 data :
tdmg$SEVERITY1_CD_PNWRS <- ifelse(tdmg$SEVERITY1_CD_PNWRS == 0,
NA, tdmg$SEVERITY1_CD_PNWRS)
tdmg$SEVERITY1A_CD_PNWRS <- ifelse(tdmg$SEVERITY1A_CD_PNWRS == 0,
NA, tdmg$SEVERITY1A_CD_PNWRS)
tdmg$SEVERITY1B_CD_PNWRS <- ifelse(tdmg$SEVERITY1B_CD_PNWRS == 0,
NA, tdmg$SEVERITY1B_CD_PNWRS)
tdmg$DMG_AGENT1_CD_PNWRS <- ifelse((is.na(tdmg$SEVERITY1_CD_PNWRS) == TRUE &
is.na(tdmg$SEVERITY1A_CD_PNWRS) == TRUE &
is.na(tdmg$SEVERITY1B_CD_PNWRS == TRUE)),
NA, tdmg$DMG_AGENT1_CD_PNWRS)
# Then clean up the D2 data :
tdmg$SEVERITY2_CD_PNWRS <- ifelse(tdmg$SEVERITY2_CD_PNWRS == 0,
NA, tdmg$SEVERITY2_CD_PNWRS)
tdmg$SEVERITY2A_CD_PNWRS <- ifelse(tdmg$SEVERITY2A_CD_PNWRS == 0,
NA, tdmg$SEVERITY2A_CD_PNWRS)
tdmg$SEVERITY2B_CD_PNWRS <- ifelse(tdmg$SEVERITY2B_CD_PNWRS == 0,
NA, tdmg$SEVERITY2B_CD_PNWRS)
tdmg$DMG_AGENT2_CD_PNWRS <- ifelse((is.na(tdmg$SEVERITY2_CD_PNWRS) == TRUE &
is.na(tdmg$SEVERITY2A_CD_PNWRS) == TRUE &
is.na(tdmg$SEVERITY2B_CD_PNWRS == TRUE)),
NA, tdmg$DMG_AGENT2_CD_PNWRS)
# And the D1 and D2 from 2012 forward:
tdmg$DAMAGE_AGENT_CD1 <- ifelse(tdmg$DAMAGE_AGENT_CD1 == 0,
NA, tdmg$DAMAGE_AGENT_CD1)
tdmg$DAMAGE_AGENT_CD2 <- ifelse(tdmg$DAMAGE_AGENT_CD2 == 0,
NA, tdmg$DAMAGE_AGENT_CD2)
# Now append the damage group codes for 2012-2016 based on the cleaned up columns:
# only applies to the few rows in 2012 that HAVE DAMAGE_AGENT_CD observations.
tdmg$DAM1_GRP_CD <- ifelse((tdmg$INVYR >= 2012 & tdmg$DAMAGE_AGENT_CD1 %in% sevcode$PTIPSXWALK),
tdmg$DAMAGE_AGENT_CD1,
ifelse((tdmg$INVYR >= 2012 & is.na(tdmg$DAMAGE_AGENT_CD1) == FALSE),
round_any(tdmg$DAMAGE_AGENT_CD1, 500),
tdmg$DAM1_GRP_CD))
tdmg$DAM2_GRP_CD <- ifelse((tdmg$INVYR >= 2012 & tdmg$DAMAGE_AGENT_CD2 %in% sevcode$PTIPSXWALK),
tdmg$DAMAGE_AGENT_CD2,
ifelse((tdmg$INVYR >= 2012 & is.na(tdmg$DAMAGE_AGENT_CD2) == FALSE),
round_any(tdmg$DAMAGE_AGENT_CD2, 500),
tdmg$DAM2_GRP_CD))
##########################
# Damage & Severity # 1 Assignments
###########################
# Clean routine: Some (11781) rows contain percentages instead of severity ratings.
# these apply only in some codes, but let's apply a solution that
# is universal in case they sneak into other codes, too. The
# problematic column is SEVERITY1A_CD_PNWRS
tdmg$pct1 <- ifelse(tdmg$SEVERITY1A_CD_PNWRS > 5, tdmg$SEVERITY1A_CD_PNWRS, NA)
# round down to get the % rating into an integer
tdmg$pct1 <- trunc((tdmg$pct1)/10)
# Then sort that bin into major and minor dependent on CODE
# # some agents are low threshold, some are higher.
sevref.1 <- sevcode[sevcode$PTIPS_THRESH_VAL == 1,]
thresh1 <- unique(sevref.1$DMG_CD); thresh1
sevref.2 <- sevcode[sevcode$PTIPS_THRESH_VAL == 2,]
thresh2 <- unique(sevref.2$DMG_CD);thresh2
# This gives the percentages a severity rating , major or minor
tdmg$pct_sev1 <- ifelse(tdmg$DMG_AGENT1_CD_PNWRS %in% thresh1 & tdmg$pct1 >= 1 , "MAJ",
ifelse(tdmg$DMG_AGENT1_CD_PNWRS %in% thresh2 & tdmg$pct1 >= 2 , "MAJ",
ifelse(tdmg$pct1 > 0, "MIN", NA)))
#########################################
# Assigning MAJOR or MINOR based on severity rankings as recorded in years 2001-2004
tdmg$DAM1_SEV04 <- ifelse((tdmg$INVYR %in% c(2001, 2002, 2003, 2004) &
tdmg$DMG_AGENT1_CD_PNWRS %in% thresh1 &
tdmg$SEVERITY1_CD_PNWRS >= 1), "MAJ",
ifelse((tdmg$INVYR %in% c(2001, 2002, 2003, 2004) &
tdmg$DMG_AGENT1_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY1_CD_PNWRS >= 2), "MAJ",
ifelse((tdmg$INVYR %in% c(2001, 2002, 2003, 2004) &
tdmg$DMG_AGENT1_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY1_CD_PNWRS < 2), "MIN", NA)))
tdmg$DAM1_SEV13 <- ifelse((tdmg$INVYR %in% c(2012:2016) &
tdmg$DAMAGE_AGENT_CD1 %in% c(1000:100000)),"MAJ",NA)
# Assigning MAJOR or MINOR based on severity rankings as recorded 2005-2012
tdmg$DAM1_SEV <- ifelse(is.na(tdmg$DAM1_SEV04) == FALSE, tdmg$DAM1_SEV04,
ifelse((is.na(tdmg$DAM1_SEV04) == TRUE &
tdmg$INVYR %in% c(2005:2012) &
is.na(tdmg$pct_sev1) == TRUE &
tdmg$DMG_AGENT1_CD_PNWRS %in% thresh1 &
tdmg$SEVERITY1A_CD_PNWRS >= 1), "MAJ",
ifelse((is.na(tdmg$DAM1_SEV04) == TRUE &
tdmg$INVYR %in% c(2005:2012) & is.na(tdmg$pct_sev1) == TRUE &
tdmg$DMG_AGENT1_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY1A_CD_PNWRS >= 2), "MAJ",
ifelse((is.na(tdmg$DAM1_SEV04) == TRUE &
tdmg$INVYR %in% c(2005:2012) & is.na(tdmg$pct_sev1) == TRUE &
tdmg$DMG_AGENT1_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY1A_CD_PNWRS < 2), "MIN",
tdmg$DAM1_SEV04))))
# Add back the percentage-based values to the rows that have NA
tdmg$DAM1_SEV <- ifelse(is.na(tdmg$DAM1_SEV) == TRUE, tdmg$pct_sev1, tdmg$DAM1_SEV)
# Identify the rows that have not yet been given a severity rating (these are the holes in the routine)
#tdmg_nosev <- filter(tdmg, DMG_AGENT1_CD_PNWRS > 0 & is.na(DAM1_SEV) == TRUE, )
# If WPBR trees are getting NA, pull data from the SEVERITY_1B column
tdmg$DAM1_SEV <- ifelse(tdmg$DMG_AGENT1_CD_PNWRS == 36 & tdmg$SEVERITY1B_CD_PNWRS >= 2 &
is.na(tdmg$DAM1_SEV) == TRUE, "MAJ",
ifelse(tdmg$DMG_AGENT1_CD_PNWRS == 36 & tdmg$SEVERITY1B_CD_PNWRS == 1 &
is.na(tdmg$DAM1_SEV) == TRUE, "MIN", tdmg$DAM1_SEV ))
# This is to catch trees with severity recorded in a column from outside its inventory year (ie late observations). Assumes they have a SEVERITY1A as that is the most common.
# In this case a row from 2004 with a SEVERITY1A value.
tdmg$DAM1_SEV <- ifelse((is.na(tdmg$DAM1_SEV) == TRUE &
tdmg$DMG_AGENT1_CD_PNWRS > 0 &
tdmg$DMG_AGENT1_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY1A_CD_PNWRS >= 2), "MAJ",
ifelse((is.na(tdmg$DAM1_SEV) == TRUE &
tdmg$DMG_AGENT1_CD_PNWRS > 0 &
tdmg$DMG_AGENT1_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY1A_CD_PNWRS < 2), "MIN",
ifelse((is.na(tdmg$DAM1_SEV) == TRUE &
tdmg$DMG_AGENT1_CD_PNWRS > 0 &
tdmg$DMG_AGENT1_CD_PNWRS %in% thresh1 &
tdmg$SEVERITY1A_CD_PNWRS >= 1),"MAJ", tdmg$DAM1_SEV)))
tdmg$DAM1_SEV <- ifelse((tdmg$INVYR %in% c(2012:2016) & tdmg$DAM1_SEV13 == "MAJ"), tdmg$DAM1_SEV13, tdmg$DAM1_SEV)
#CHECK - are there any of these? If no, proceed (this check is defunct, lots after 2012.).
filter(tdmg, INVYR < 2012 & is.na(DAM1_SEV) == TRUE & DMG_AGENT1_CD_PNWRS > 0)
#########################
# Damage & Severity #2
##########################
# Clean routine: Some rows may contain percentages instead of severity ratings.
# these apply only in some codes, but let's apply a solution that is universal in case they sneak into other codes, too. The problematic column is SEVERITY2A_CD_PNWRS
tdmg$pct2 <- ifelse(tdmg$SEVERITY2A_CD_PNWRS > 5, tdmg$SEVERITY2A_CD_PNWRS, NA)
nrow(filter(tdmg, pct2 > 1)) # 11781 are using %
# round down to get the % rating into an integer
tdmg$pct2 <- trunc((tdmg$pct2)/10)
# This gives the percentages a severity rating , major or minor
tdmg$pct_sev2 <- ifelse(tdmg$DMG_AGENT2_CD_PNWRS %in% thresh1 & tdmg$pct1 >= 1 , "MAJ",
ifelse(tdmg$DMG_AGENT2_CD_PNWRS %in% thresh2 & tdmg$pct1 >= 2 , "MAJ",
ifelse(tdmg$pct2 > 0, "MIN", NA)))
#########################################
# Assigning MAJOR or MINOR based on severity rankings as recorded in years 2001-2004
tdmg$DAM2_SEV04 <- ifelse((tdmg$INVYR %in% c(2001, 2002, 2003, 2004) &
tdmg$DMG_AGENT2_CD_PNWRS %in% thresh1 &
tdmg$SEVERITY2_CD_PNWRS >= 1), "MAJ",
ifelse((tdmg$INVYR %in% c(2001, 2002, 2003, 2004) &
tdmg$DMG_AGENT2_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY2_CD_PNWRS >= 2), "MAJ",
ifelse((tdmg$INVYR %in% c(2001, 2002, 2003, 2004) &
tdmg$DMG_AGENT2_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY2_CD_PNWRS < 2), "MIN", NA)))
tdmg$DAM2_SEV13 <- ifelse((tdmg$INVYR %in% c(2012:2016) &
tdmg$DAMAGE_AGENT_CD2 %in% c(1000:100000)),"MAJ",NA)
# Assigning MAJOR or MINOR based on severity rankings as recorded in years 2005-2012
tdmg$DAM2_SEV <- ifelse(is.na(tdmg$DAM2_SEV04) == FALSE, tdmg$DAM2_SEV04,
ifelse((is.na(tdmg$DAM2_SEV04) == TRUE &
tdmg$INVYR %in% c(2005:2012) &
is.na(tdmg$pct_sev2) == TRUE &
tdmg$DMG_AGENT2_CD_PNWRS %in% thresh1 &
tdmg$SEVERITY2A_CD_PNWRS >= 1), "MAJ",
ifelse((is.na(tdmg$DAM2_SEV04) == TRUE &
tdmg$INVYR %in% c(2005:2012) & is.na(tdmg$pct_sev2) == TRUE &
tdmg$DMG_AGENT2_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY2A_CD_PNWRS >= 2), "MAJ",
ifelse((is.na(tdmg$DAM2_SEV04) == TRUE &
tdmg$INVYR %in% c(2005:2012) & is.na(tdmg$pct_sev2) == TRUE &
tdmg$DMG_AGENT2_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY2A_CD_PNWRS < 2), "MIN",
tdmg$DAM2_SEV04))))
# Add back the percentage-based values to the rows that have NA
tdmg$DAM2_SEV <- ifelse(is.na(tdmg$DAM2_SEV) == TRUE, tdmg$pct_sev2, tdmg$DAM2_SEV)
# Identify the rows that have not yet been given a severity rating (these are the holes in the routine)
tdmg_nosev <- filter(tdmg, DMG_AGENT2_CD_PNWRS > 0 & is.na(DAM2_SEV) == TRUE )
tdmg_nosev # NONE
# If WPBR trees are getting NA, pull data from the SEVERITY_1B column
tdmg$DAM2_SEV <- ifelse(tdmg$DMG_AGENT2_CD_PNWRS == 36 & tdmg$SEVERITY2B_CD_PNWRS >= 2 &
is.na(tdmg$DAM2_SEV) == TRUE, "MAJ",
ifelse(tdmg$DMG_AGENT2_CD_PNWRS == 36 & tdmg$SEVERITY2B_CD_PNWRS == 1 &
is.na(tdmg$DAM2_SEV) == TRUE, "MIN", tdmg$DAM2_SEV ))
tdmg$DAM2_SEV <- ifelse((tdmg$INVYR %in% c(2012:2016) & tdmg$DAM2_SEV13 == "MAJ"), tdmg$DAM2_SEV13, tdmg$DAM2_SEV)
# This is to catch trees with severity recorded in a column from outside its inventory year (ie late observations).
# Assumes they have a SEVERITY2A as that is the most common.
# In this case a row from 2004 with a SEVERITY2A value.
tdmg$DAM2_SEV <- ifelse((is.na(tdmg$DAM2_SEV) == TRUE &
tdmg$DMG_AGENT2_CD_PNWRS > 0 &
tdmg$DMG_AGENT2_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY2A_CD_PNWRS >= 2),"MAJ",
ifelse((is.na(tdmg$DAM2_SEV) == TRUE &
tdmg$DMG_AGENT2_CD_PNWRS > 0 &
tdmg$DMG_AGENT2_CD_PNWRS %in% thresh2 &
tdmg$SEVERITY2A_CD_PNWRS < 2), "MIN",
ifelse((is.na(tdmg$DAM2_SEV) == TRUE &
tdmg$DMG_AGENT2_CD_PNWRS > 0 &
tdmg$DMG_AGENT2_CD_PNWRS %in% thresh1 &
tdmg$SEVERITY2A_CD_PNWRS >= 1),"MAJ", tdmg$DAM2_SEV)))
#check - are there any of these? If no, proceed.
filter(tdmg, is.na(DAM2_SEV) == TRUE & DMG_AGENT2_CD_PNWRS > 0)
###########################################################
# Organize a new df with the crosswalked damage and severity assignments + mistletoe
###########################################################
head(tdmg)
tdmg$DAM1_SEV <- as.factor(tdmg$DAM1_SEV)
tdmg$DAM2_SEV <- as.factor(tdmg$DAM2_SEV)
tdmg_sel <- select(tdmg, TRE_CN, PLT_CN, INVYR,
MIST_CL_CD, MIST_CL_CD_PNWRS,
DMG_AGENT1_CD_PNWRS, DAM1_GRP_CD, DAM1_PTIPSXWALKNM, DAM1_SEV,
DMG_AGENT2_CD_PNWRS, DAM2_GRP_CD, DAM2_PTIPSXWALKNM, DAM2_SEV)
#class(tdmg_sel$DAM2_SEV)
flevels(tdmg_sel$DAM1_PTIPSXWALKNM)
flevels(tdmg_sel$DAM2_PTIPSXWALKNM)
# this routine cleans up the dwarf and leafy mistletoe data into a merged MINOR/MAJOR column;
#in 1994 it has MIST_CL_CD (1-6) codes in it which should be ignored.
tdmg_sel$MIST_MERGE <- ifelse(tdmg_sel$MIST_CL_CD %in% c(1:2), "MIN",
ifelse(tdmg_sel$MIST_CL_CD >= 3, "MAJ",
ifelse(tdmg_sel$MIST_CL_CD_PNWRS == 7, "MIN",
ifelse(tdmg_sel$MIST_CL_CD_PNWRS == 8, "MAJ", NA))))
tdmg_sel$MIST_MERGE <- as.factor(tdmg_sel$MIST_MERGE)
# flevels(tdmg_sel$MIST_MERGE) # 4031 Major Mistletoe.
# flevels(tdmg_sel$DMG_AGENT1_CD_PNWRS) # 592 in parasititic plants
# flevels(tdmg_sel$DMG_AGENT2_CD_PNWRS) # 157 parasititc
# one possibility would be to zero-out the mistletoe data
# in EITHER the damage + severity rankings or the
#mistletoe rankings, to avoid double counting. Then the columns could be added up?
# I'd ignore DMG_AGENT1_CD == 54 and substitute the more populated MIST_MERGE I think.
summary(tdmg_sel)
tdmg_sel1 <- tdmg %>%
group_by(DAM1_PTIPSXWALKNM) %>%
summarise(DAM_COUNT = lgt(DAM1_PTIPSXWALKNM))
tdmg_sel2 <- tdmg %>%
group_by(DAM1_PTIPSXWALKNM) %>%
summarise(DAM_COUNT = lgt(DAM1_PTIPSXWALKNM))
return(tdmg_sel)
}
########################################################################################################
# tdmg4_sel_test <- damage_assign(tree4, sevref)
# summary(tdmg4_sel_test)
#
# # Summary tables by name:
# tdmg_sel1 <- tdmg4_sel_test %>%
# group_by(DAM1_PTIPSXWALKNM) %>%
# summarise(DAM_COUNT = lgt(DAM1_PTIPSXWALKNM))
#
# tdmg_sel2 <- tdmg4_sel_test %>%
# group_by(DAM2_PTIPSXWALKNM) %>%
# summarise(DAM_COUNT = lgt(DAM2_PTIPSXWALKNM))
#
# print.data.frame(arrange(tdmg_sel1, desc(DAM_COUNT)))
# print.data.frame(arrange(tdmg_sel2, desc(DAM_COUNT)))
#
# # By year and name:
# tdmg_sel_inyr <- tdmg4_sel_test %>%
# group_by(INVYR, DAM1_PTIPSXWALKNM) %>%
# summarise(DAM_COUNT = lgt(DAM1_PTIPSXWALKNM))
# print.data.frame(arrange(tdmg_sel_inyr, DAM1_PTIPSXWALKNM))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.