diff --git a/Causes.r b/Causes.r new file mode 100644 index 0000000..4296946 --- /dev/null +++ b/Causes.r @@ -0,0 +1,42 @@ +library(tidyverse) +library(factoextra) +library(fixest) +library(corrplot) +################################Other work +DF1999 <- read_csv("Data/Raw_Data/Mortality_Rates_New/US_Single_Age_1999-2020.csv") %>% select(Year,Sex,Age=`Single-Year Ages Code`,Mortality_Rate=`Crude Rate`) %>% mutate(Mortality_Rate=parse_number(Mortality_Rate)) %>% filter(!is.na(Mortality_Rate)) %>% mutate(Mortality_Rate=as.numeric(Mortality_Rate)) +DF2018 <- read_csv("Data/Raw_Data/Mortality_Rates_New/US_Single_Age_2018-2023.csv") %>% select(Year,Sex,Age=`Single-Year Ages Code`,Mortality_Rate=`Crude Rate`) %>% filter(!is.na(Mortality_Rate))%>% mutate(Mortality_Rate=parse_number(Mortality_Rate)) %>% filter(!is.na(Mortality_Rate)) %>% mutate(Mortality_Rate=as.numeric(Mortality_Rate)) + +OLDER1 <- read_csv("Data/Raw_Data/Mortality_Rates_New/US_10_Year_Age_Groups_1999-2020.csv")%>% rename(Age=`Ten-Year Age Groups Code`,Mortality_Rate=`Crude Rate`) %>% filter(Age=='85+')%>% mutate(Age=85,Year=as.numeric(Year),Mortality_Rate=parse_number(Mortality_Rate)) %>% select(Year,Sex,Age,Mortality_Rate) %>% mutate(Mortality_Rate=as.numeric(Mortality_Rate),Age=as.numeric(Age)) +OLDER2 <- read_csv("Data/Raw_Data/Mortality_Rates_New/US_10_Year_Age_Groups_2018-2023.csv")%>% rename(Age=`Ten-Year Age Groups Code`,Mortality_Rate=`Crude Rate`) %>% filter(Age=='85+')%>% mutate(Age=85,Year=as.numeric(Year),Mortality_Rate=parse_number(Mortality_Rate)) %>% select(Year,Sex,Age,Mortality_Rate)%>% mutate(Mortality_Rate=as.numeric(Mortality_Rate),Age=as.numeric(Age)) + +#NOTE should add 85+ for 2018-2023 +DF <- rbind(DF1999,DF2018,OLDER1,OLDER2) %>% unique %>% group_by(Year,Sex,Age) %>% arrange(Year,Sex,Age) %>% mutate(Age=as.numeric(Age)) %>% ungroup + +US_CAUSES <- read_csv("Data/Raw_Data/Mortality_Rates_New/US_Cause_of_Death_1999-2020.csv") %>% select(Year,ICD=`ICD Sub-Chapter Code`,Death_Rate=`Crude Rate`) %>% filter(!is.na(Death_Rate)) %>% mutate(Death_Rate=ifelse(Death_Rate=='Suppressed' |Death_Rate=='Unreliable',NA,Death_Rate)) %>% rbind(read_csv("Data/Raw_Data/Mortality_Rates_New/US_Cause_of_Death_2018-2023.csv") %>% select(Year,ICD=`ICD Sub-Chapter Code`,Death_Rate=`Crude Rate`) %>% filter(!is.na(Death_Rate)) %>% mutate(Death_Rate=ifelse(Death_Rate=='Suppressed' |Death_Rate=='Unreliable',NA,Death_Rate))) %>% mutate(Death_Rate=parse_number(Death_Rate)) %>% arrange(Year,ICD) %>% group_by(ICD) %>% filter(max(is.na(Death_Rate))==0,min(Death_Rate)!=max(Death_Rate)) %>% ungroup %>% unique +US_CAUSES <- read_csv("Data/Raw_Data/Mortality_Rates_New/US_Cause_of_Death_1999-2020.csv") %>% select(Year,ICD=`ICD Sub-Chapter Code`,Death_Rate=`Crude Rate`) %>% filter(!is.na(Death_Rate)) %>% mutate(Death_Rate=ifelse(Death_Rate=='Suppressed' |Death_Rate=='Unreliable',NA,Death_Rate)) %>% rbind(read_csv("Data/Raw_Data/Mortality_Rates_New/US_Cause_of_Death_2018-2023.csv") %>% select(Year,ICD=`ICD Sub-Chapter Code`,Death_Rate=`Crude Rate`) %>% filter(!is.na(Death_Rate)) %>% mutate(Death_Rate=ifelse(Death_Rate=='Suppressed' |Death_Rate=='Unreliable',NA,Death_Rate))) %>% mutate(Death_Rate=parse_number(Death_Rate)) %>% arrange(Year,ICD) %>% group_by(ICD) %>% filter(max(is.na(Death_Rate))==0,min(Death_Rate)!=max(Death_Rate)) %>% ungroup %>% unique +BIND <- read_csv("Data/Raw_Data/Mortality_Rates_New/US_Cause_of_Death_1999-2020.csv") %>% select(ICD=`ICD Sub-Chapter Code`,NAME=`ICD Sub-Chapter`) %>% unique +US_CAUSES <- US_CAUSES %>% left_join(BIND) %>% select(-ICD) %>% rename(ICD=NAME) + +#hist(US_CAUSES$Death_Rate,breaks=150) +US_CAUSES +CAUSE_SUMMARY <- US_CAUSES %>% group_by(ICD) %>% summarize(Rate=mean(Death_Rate)) %>% summarize(ICD,Rate, Rank=rank(desc(Rate))) %>% arrange(Rank) %>% ungroup %>% filter(Rank<=40) +CAUSE_SUMMARY %>% print(n=100) + +ICD_WIDE <- US_CAUSES %>% inner_join(CAUSE_SUMMARY %>% print(n=40) %>% select(ICD_RANK=Rank,ICD)) %>% select(-ICD) %>% unique %>% pivot_wider(values_from=Death_Rate,names_from=ICD_RANK,names_prefix="ICD_") +ICD_WIDE <- ICD_WIDE %>% select(c("Year",sort(colnames(ICD_WIDE[,-1])))) +#### +US_AGE_ADJ <- rbind(read_csv("Data/Raw_Data/Mortality_Rates_New/US_Age_Adjusted_1979-1998.csv") %>% select(Year,Sex,US_Adj_Death_Rate=`Crude Rate`),read_csv("Data/Raw_Data/Mortality_Rates_New/US_Age_Adjusted_1999-2020.csv") %>% select(Year,Sex,US_Adj_Death_Rate=`Crude Rate`),read_csv("Data/Raw_Data/Mortality_Rates_New/US_Age_Adjusted_2018-2023.csv") %>% select(Year,Sex,US_Adj_Death_Rate=`Crude Rate`)) %>% unique +#### +REG_DATA <- DF %>% left_join(US_AGE_ADJ) %>% left_join(ICD_WIDE) +#REG_DATA <- DF %>% left_join(ICD_WIDE) + +TEST <- REG_DATA %>% pivot_wider(values_from=Mortality_Rate,names_from=Age,names_prefix="Age_") +TEST[,4:129] <- TEST[,4:129]/t(TEST[,3]) +REG_DATA %>% pivot_wider(values_from=Mortality_Rate,names_from=Age,names_prefix="Age_") %>% group_by(Sex) +REG_DATA +MOD <- feols(Age_.[0:85]~US_Adj_Death_Rate+Sex*Year,TEST %>% filter(Sex=="Male")) +summary(MOD[[1]]) +acf(resid(MOD[[43]])) +predict(MOD[[2]],TEST[1,]) + + diff --git a/Mortality_Rate_Analysis.r b/Mortality_Rate_Analysis.r index 9cef05e..6204f51 100644 --- a/Mortality_Rate_Analysis.r +++ b/Mortality_Rate_Analysis.r @@ -22,7 +22,6 @@ DF <- rbind(LIN_1999,LIN_2018,WY_1999,US_1999,US_2018,WY_2018,WY_1979,US_1979,LI ggplot(DF,aes(x=Year,y=Mort_Rate,group=Region,color=Region,fill=Region))+geom_point()+geom_smooth(method="lm")+ facet_grid(. ~ Sex) ggplot(DF,aes(x=Year,y=Mort_Rate,group=Region,color=Region,fill=Region))+geom_point()+geom_smooth(span=0.4)+ facet_grid(. ~ Sex) ggplot(DF,aes(x=Year,y=Mort_Rate,group=Region,color=Region,fill=Region))+geom_point()+geom_line()+ facet_grid(. ~ Sex) -ggplot(DF,aes(x=Year,y=Mort_Rate,group=Region,color=Region,fill=Region))+geom_point()+geom_smooth() ########################################################ARIMA PANDIMIC_INDEX <- read_csv("https://fred.stlouisfed.org/graph/fredgraph.csv?bgcolor=%23ebf3fb&chart_type=line&drp=0&fo=open%20sans&graph_bgcolor=%23ffffff&height=450&mode=fred&recession_bars=off&txtcolor=%23444444&ts=12&tts=12&width=1320&nt=0&thu=0&trc=0&show_legend=yes&show_axis_titles=yes&show_tooltip=yes&id=WUPI&scale=left&cosd=1996-01-01&coed=2025-07-01&line_color=%230073e6&link_values=false&line_style=solid&mark_type=none&mw=3&lw=3&ost=-99999&oet=99999&mma=0&fml=a&fq=Annual&fam=sum&fgst=lin&fgsnd=2020-02-01&line_index=1&transformation=lin&vintage_date=2025-11-20&revision_date=2025-11-20&nd=1996-01-01") %>% mutate(Year=year(observation_date)) %>% select(Year,WUPI)%>% mutate(L_WUPI=lag(WUPI),L_TWO_WUPI=lag(WUPI,2)) DF <- DF %>% ungroup%>% group_by(Sex,Region) %>% arrange(Sex,Region,Year) %>% mutate(L_Mort_Rate=lag(Mort_Rate)) %>% ungroup @@ -111,7 +110,6 @@ fviz_nbclust(COR_DAT,kmeans,nboot=1000) km.res <- kmeans(COR_DAT, 3, nstart = 1) fviz_cluster(km.res,COR_DAT) print(km.res) - COR_DAT SINGLE_DATA %>% filter(!is.numeric(Mortality_Rate)) SINGLE_DATA <- SINGLE_DATA %>% mutate(Age=as.numeric(Age),US_Rate=as.numeric(US_Rate),Year=as.numeric(Year),Mortality_Rate=as.numeric(Mortality_Rate)) @@ -143,12 +141,42 @@ resid(MOD) predict -REG_SINGLE_DATA <- SINGLE_DATA_PLAIN %>% pivot_wider(values_from="Mortality_Rate",names_from=c("Age")) +REG_SINGLE_DATA <- SINGLE_DATA_PLAIN %>% mutate( %>% pivot_wider(values_from="Mortality_Rate",names_from=c("Age")) MALE <- REG_SINGLE_DATA %>% filter(Sex=='Male') FEMALE <- REG_SINGLE_DATA %>% filter(Sex=='Female') library(corrplot) corrplot(cor(MALE %>% select(-Sex))) -MALE +US_CAUSES <- read_csv("Data/Raw_Data/Mortality_Rates_New/US_Cause_of_Death_1999-2020.csv") %>% select(Year,ICD=`ICD Sub-Chapter Code`,Death_Rate=`Crude Rate`) %>% filter(!is.na(Death_Rate)) %>% mutate(Death_Rate=ifelse(Death_Rate=='Suppressed' |Death_Rate=='Unreliable',NA,Death_Rate)) %>% rbind(read_csv("Data/Raw_Data/Mortality_Rates_New/US_Cause_of_Death_2018-2023.csv") %>% select(Year,ICD=`ICD Sub-Chapter Code`,Death_Rate=`Crude Rate`) %>% filter(!is.na(Death_Rate)) %>% mutate(Death_Rate=ifelse(Death_Rate=='Suppressed' |Death_Rate=='Unreliable',NA,Death_Rate))) %>% mutate(Death_Rate=parse_number(Death_Rate)) %>% arrange(Year,ICD) %>% group_by(ICD) %>% filter(max(is.na(Death_Rate))==0,min(Death_Rate)!=max(Death_Rate)) %>% ungroup %>% unique +BIND <- read_csv("Data/Raw_Data/Mortality_Rates_New/US_Cause_of_Death_1999-2020.csv") %>% select(ICD=`ICD Sub-Chapter Code`,NAME=`ICD Sub-Chapter`) %>% unique +US_CAUSES <- US_CAUSES %>% left_join(BIND) %>% select(-ICD) %>% rename(ICD=NAME) +US_CAUSES %>% group_by(ICD) %>% summarize(Rate=mean(Death_Rate)) %>% summarize(ICD,Rate, Rank=rank(desc(Rate))) %>% arrange(Rank) +ggplot(US_CAUSES,aes(x=Year,y=scale(Death_Rate),group=ICD,color=ICD,fill=ICD)) +geom_point() +geom_smooth()+theme(legend.position="bottom") +US_CAUSES +parse_number(REG_SINGLE_DATA[,3:89]) +US_CAUSES <- US_CAUSES %>% pivot_wider(values_from=Death_Rate,names_from=ICD) +CAUS_MAT <- US_CAUSES %>% select(-Year) +sd(t(CAUS_MAT)[,118]) + +CAUS_MAT <- scale(CAUS_MAT) + +fviz_nbclust(CAUS_MAT,kmeans,"gap_stat") #6 +fviz_nbclust(CAUS_MAT,kmeans,"wss") #5 +fviz_nbclust(CAUS_MAT,kmeans) #2 + +km.res <- kmeans(CAUS_MAT, 6, nstart = 1) +fviz_cluster(km.res,CAUS_MAT) +summary(km.res +print(km.res) +km.res$cluster + +corrplot(cor(US_CAUSES)) +MALE <- US_CAUSES %>% left_join(MALE) %>% select(Year,Sex,US_Rate,everything()) +MALE %>% tail +COR_MALE <- MALE %>% select(-Sex) %>% as.matrix +corrplot(cor(COR_MALE,use="pairwise.complete"),type="lower",diag=FALSE,) +?corrplot + +COR_MALE corrplot(cor(cbind(MALE[,1],MALE[,4:ncol(MALE)]/t(MALE[,3])))) corrplot(cor(log(FEMALE %>% select(-Sex)))) TEMP <- MALE %>% select(RATE=`36`,US_Rate,Year) %>% as.data.frame