#setwd("/Users/michael/Desktop")

setwd("C:\\Users\\Michael\\Desktop")

df <- read.csv("2016VISPDAT - Copy.csv", header = TRUE)
# Trimming Gender Values
df$Gender %>%
  gsub(pattern = "Gender Non-Conforming \\(i.e. not exclusively male or female\\)",
       replacement = "Non-Comforming") %>%
  gsub(pattern = "Trans Female \\(MTF or Male to Female\\)",
       replacement = "Trans Female") %>%
  gsub(pattern = "Trans Male \\(FTM or Female to Male\\)",
       replacement = "Trans Male") -> df$Gender

Overview of Data

Looking at Chart 1, it appears that Blacks/African Americans have a similar inner group variance, range, and mean. The Black/African American group does have two outliers, while the White group has one. The American Indian or Alaska Native group also has a similiar inner group variance, but a smaller range and a lower mean.

Looking at Chart 2, it appears that Males have the greatest inner group variance as well as the largest range. Trans Female appear to have the highest mean.

Looking at Chart 3, there does not appear to be a linear relationship between Age and Score total.

Looking at Chart 4, we see the distribution of scores are skewed right with a center appearing around 6 and a peak appearing at 4. This would indicate that about 50% of the scores are between 4 and 8.

par(mfrow = c(2,2))
x <- boxplot(df$Score.Total ~ df$Race,
        main = "Mean Score by Race (Chart 1)",
        xlab = "Race",
        ylab = "Mean Total Score",
        names = c("AI/AN", "Asian", "BL/AA", "NH/ OPI", "Other MR", "White"),
        col = c("skyblue", "skyblue1", "skyblue2", "Skyblue3", "skyblue4", "royalblue"))

boxplot(df$Score.Total ~ df$Gender,
        main = "Mean Score by Gender (Chart 2)",
        xlab = "Gender",
        ylab = "Mean Total Score",
        col = c("red", "cadetblue", "blue", "skyblue", "skyblue4"))

plot(df$Age, df$Score.Total,
     main = "Age vs Score Total (Chart 3)",
     xlab = "Age",
     ylab = "Score Total")

hist(df$Score.Total,
     main = "Distribution of Score Totals (Chart 4)",
     xlab = "Score Total",
     ylab = "Frequency",
     breaks = seq(from = 0,  to = 17, by = 1),
     xaxt = 'n',
     ylim = c(0,350),
     col = c("cadetblue"))
axis(1, at = seq(from = 0,  to = 17, by = 1), labels = seq(from = 0,  to = 17, by = 1))

kable(ddply(df, "Race", summarise,
      N    = length(Score.Total),
      mean = mean(Score.Total),
      sd   = sd(Score.Total),
      firstQuartile = summary(Score.Total)[2],
      thirdQuartile = summary(Score.Total)[5]), caption = "Summary Table 1: Race vs Total Score")

Summary Table 1: Race vs Total Score
Race	N	mean	sd	firstQuartile	thirdQuartile
American Indian or Alaska Native	10	6.200000	3.293090	4.25	7.75
Asian	2	7.000000	5.656854	5.00	9.00
Black or African American	1454	5.920220	2.790055	4.00	8.00
Native Hawaiian or Other Pacific Islander	2	9.000000	0.000000	9.00	9.00
Other Multi-Racial	1	10.000000	NA	10.00	10.00
White	736	6.512228	2.889787	4.00	8.00

kable(ddply(df, "Gender", summarise,
      N    = length(Score.Total),
      mean = mean(Score.Total),
      sd   = sd(Score.Total),
      firstQuartile = summary(Score.Total)[2],
      thirdQuartile = summary(Score.Total)[5] ), caption = "Summary Table 2: Gender vs Total Score")

Summary Table 2: Gender vs Total Score
Gender	N	mean	sd	firstQuartile	thirdQuartile
Female	1147	5.721883	2.684433	4	7
Male	1034	6.539652	2.950524	4	9
Non-Comforming	1	4.000000	NA	4	4
Trans Female	23	7.652174	2.228099	7	9

kable(t(as.matrix(summary(df$Score.Total))), caption = "Summary Table 4: Distribution of Total Scores")

Summary Table 4: Distribution of Total Scores
Min.	1st Qu.	Median	Mean	3rd Qu.	Max.
0	4	6	6.124717	8	16

Looking at the density distributions of the total scores, we notice that all of the below distributions are slightly skewed right, meaning that a slight majority of the scores fall on the lower end of the scale. The “Distribution of White Total Scores” appears to have a greater consistency between 3 and 8.

People that identify as female appear to have a greater density of values between 2 and 8 while people that identify as male have a greater distribution of scores between 2 and 9.

white.total <- df$Score.Total[df$Race == "White"]
poc.total <- df$Score.Total[df$Race != "White"]
male.total <- df$Score.Total[df$Gender == "Male"]
female.total <- df$Score.Total[df$Gender == "Female"]

par(mfrow = c(2,2))
hist(white.total,
     main = "Distribution of White Total Scores",
     xlab = "Total Score",
     ylab = "Density",
     col = "royalblue",
     ylim = c(0,.15),
     las = 1,
     breaks = seq(from = 0,  to = 17, by = 1),
     xaxt = 'n',
     freq = FALSE)
abline(h = .075)
axis(1, at = seq(from = 0,  to = 17, by = 1), labels = seq(from = 0,  to = 17, by = 1))

hist(poc.total,
     main = "Distribution of Persons of Color Total Scores",
     xlab = "Total Score",
     ylab = "Density",
     col = "skyblue",
     ylim = c(0,.15),
     las = 1,
     breaks = seq(from = 0,  to = 17, by = 1),
     xaxt = 'n',     
     freq = FALSE)
abline(h = .075)
axis(1, at = seq(from = 0,  to = 17, by = 1), labels = seq(from = 0,  to = 17, by = 1))

hist(male.total,
     main = "Distribution of Male Total Scores",
     xlab = "Total Score",
     ylab = "Density",
     col = "cadetblue",
     ylim = c(0,.15),
     las = 1,
     breaks = seq(from = 0,  to = 17, by = 1),
     xaxt = 'n',     
     freq = FALSE)
axis(1, at = seq(from = 0,  to = 17, by = 1), labels = seq(from = 0,  to = 17, by = 1))
abline(h = .075)

hist(female.total,
     main = "Distribution of Female Total Scores",
     xlab = "Total Score",
     ylab = "Density",
     col = "red",
     ylim = c(0,.15),
     las = 1,
     breaks = seq(from = 0,  to = 17, by = 1),
     xaxt = 'n',     
     freq = FALSE)
axis(1, at = seq(from = 0,  to = 17, by = 1), labels = seq(from = 0,  to = 17, by = 1))
abline(h = .075)

Statistical Difference in Mean Total Score by Race

First, we look at too see if there is a statistical difference in mean score between Whites and People of Color.

t.result<-t.test(poc.total, white.total, alternative = "two.sided", conf.level = .95)
t.table <- c(t.result$statistic, t.result$parameter, p = t.result$p.value)
t.display <- kable(t(t.table), caption = "Difference in Means Summary Table")

df$grp.race <- ifelse(df$Race == "White", 1, 0)
m <- lm(df$Score.Total ~ df$grp.race)
m.sum <- summary(m)
m.sum.table <- kable(m.sum$coefficients, caption = "Coefficient Table for Linear Association")

#par(mfrow = c(2,2))
#plot(fitted(m), resid(m))
#hist(resid(m))
#plot(df$Score.Total, resid(m))
#plot(df$Age, resid(m))
#plot(m)

### Test 1 Hypothesis:

#- The total score means between Whites and Black/ African American are the same
#- H0: mu = 0
#- H1: mu ≠ 0
#- alpha = 0.05

#### Deciding Factor:
#- If p <= 0.05, then sufficient evidence to suggest total score means are not the same
#- Else, not enough evidence to suggest the total score means are different

Test Result

Difference in Means Summary Table
t	df	p
-4.505195	1428.935	7.2e-06

Conclusion

Since p < 0.05, we have sufficient evidence to suggest that the mean total scores are different between Whites and People of Color. With p < 0.01, it appears that 99% of the time there is a significant difference in scores between People of Color and Whites.

### Test 2 Hypothesis

#- There is no linear association between Race and total score. That is, Race is not a predictive factor in Total Score
#- H0: B1 = 0
#- H1: B1 ≠ 0
#- Alpha = 0.05

#### Deciding Factor:

#- If p <= 0.05, then sufficient evidence to suggest a linear association between Race and Total Score. That is, Race is predictive of total score

#- Else, not enough evidence to suggest a linear association between Race and Total Score.

Race as a Predictor of Total Score

Next, looking to see if Race is a predictor of Total Score. Or, looking to see if there is a linear association between Race and Total Score.

Test Result

Coefficient Table for Linear Association
	Estimate	Std. Error	t value	Pr(>\|t\|)
(Intercept)	5.9305650	0.0737812	80.38048	0.0e+00
df$grp.race	0.5816633	0.1277059	4.55471	5.5e-06

Conclusion

Since p < 0.01, we have sufficient evidence to suggest that race is a predictor of total score. That is, there appears to be a linear association between the two.

Here, df$grp.race represents People of Color as the reference group. The estimate value of 0.581 represents the expected increase in score for Whites, when compared to People of Color

Cross-Tabulations and Chi-Square Analysis to Test the Relationship between Race and Type of Housing Intervention

df$priority <- ifelse(df$Score.Total >= 8, 1, 0)
black.priority <- subset(df, df$grp.race == 0)
white.priority <- subset(df, df$grp.race == 1)

black.priority$priority <- ifelse(black.priority$Score.Total >= 8, 1, 0)
white.priority$priority <- ifelse(white.priority$Score.Total >= 8, 1, 0)


df$priority4 <- ifelse(df$Score.Total >= 4 & df$Score.Total < 8, 1, 0)
black.priority4 <- subset(df, df$grp.race == 0)
white.priority4 <- subset(df, df$grp.race == 1)

black.priority4$priority <- ifelse(black.priority$Score.Total >= 4 & black.priority$Score.Total < 8, 1, 0)
white.priority4$priority <- ifelse(white.priority$Score.Total >= 4 & white.priority$Score.Total < 8, 1, 0)


#Chi Square Test for Independence between Race and Score Totals

x <- cbind(NonPriority = nrow(subset(df, df$Score.Total<4 & df$grp.race == 0)),
           FourtoEight = nrow(subset(df, df$Score.Total>=4 & df$Score.Total <8 & df$grp.race == 0)), 
           AboveEight = nrow(subset(df, df$Score.Total>=8 & df$grp.race == 0)))

y <- cbind(NonPriority = nrow(subset(df, df$Score.Total<4 & df$grp.race == 1)),
           FourtoEight = nrow(subset(df, df$Score.Total>=4 & df$Score.Total <8 & df$grp.race == 1)), 
           AboveEight = nrow(subset(df, df$Score.Total>=8 & df$grp.race == 1)))

contingency.table<-rbind(x,y)
row.names(contingency.table) <- c("People of Color", "White")
display.table <- kable(contingency.table, caption = "Total Score Summary Table")
chi <- chisq.test(contingency.table, correct = FALSE)
display.chi <- kable(t(c(chi$statistic, chi$parameter, pvalue = chi$p.value)), caption = "Chi-Squared Test")


x2 <- cbind(NonPriority = nrow(subset(df, df$Score.Total<4 & df$grp.race == 0)),
           Priority = nrow(subset(df, df$Score.Total>=4 & df$grp.race == 0)))

y2 <- cbind(NonPriority = nrow(subset(df, df$Score.Total<4 & df$grp.race == 1)),
           Priority = nrow(subset(df, df$Score.Total>=4 & df$grp.race == 1)))

contingency.table2<-rbind(x2,y2)
row.names(contingency.table2) <- c("People of Color", "White")
display.table2 <- kable(contingency.table2, caption = "Total Score Summary Table")


chi2<-chisq.test(contingency.table2, correct = FALSE)
display.chi2 <- kable(t(c(chi2$statistic, chi2$parameter, pvalue = chi2$p.value)), caption = "Chi-Squared Test")


fish<-fisher.test(contingency.table2)
display.fish <- kable(t(c(pvalue=fish$p.value, fish$estimate)), caption = "Fisher Test")

Chi Test for Indepence

The Chi-Test helps determine if two categorical variables are independent of each other. Here, we are going to test to see if Housing intervention type is independent of race.

Total Score Summary Table
	NonPriority	FourtoEight	AboveEight
People of Color	301	742	426
White	116	356	264

The above table shows how many clients fall into each of the three categories: Non Priority (Scores below four), Scores between 4-8, and Scores greater than 8.

The below Chi-Test results indicate that the two categorical factors of race and housing placement are not independent. That is, housing placement appears to be dependent on race.

Chi-Squared Test
X-squared	df	pvalue
13.64629	2	0.0010883

Statistical Difference in Proportions of Scorers by Race

# Test or Proportions
test.prop <- prop.test(c(nrow(black.priority[black.priority$priority ==1,]), 
            nrow(white.priority[white.priority$priority ==1,])),
          c(nrow(black.priority), nrow(white.priority)), alternative = "two.sided",
          conf.level = 0.95, correct = FALSE)
test.prop.table <- c(test.prop$statistic, test.prop$parameter, p = test.prop$p.value)
test.prop.table <- kable(t(test.prop.table), caption = "Proportion Test Summary")

Scores of 8 or More

The proportion of clients that received a score of 8 or higher were examined by race to determine if a difference in prioritization existed.

### Test Hypothesis

#- H0:p1=p2  (The underlying population proportion receiving total scores of 8 or above among Whites is the same as the population proportion receiving total scores of 8 or above among Black or African American)
#- H1:p1≠p2 (the underlying population proportion receiving total scores of 8 or above among Whites is not the same as the population proportion receiving total scores of 8 or above among Black or African American)
#- Alpha =0.05


#### Deciding Factor

#- If p <= 0.05, the underlying population proportion is not the same between Whites and Black or African American

Test Result

Proportion Test Summary
X-squared	df	p
10.76443	1	0.0010347

Conclusion

Since p < 0.05, we have sufficient evidence to suggest that the underlying population proportion receiving total scores of 8 or above among Whites is different from the population proportion receiving total scores of 8 or above among People of Color.

Scores between 4 and 8

test.prop2 <- prop.test(c(nrow(black.priority4[black.priority4$priority ==1,]), 
            nrow(white.priority4[white.priority4$priority ==1,])),
          c(nrow(black.priority4), nrow(white.priority4)), alternative = "two.sided",
          conf.level = 0.95, correct = FALSE)
test.prop.table2 <- c(test.prop2$statistic, test.prop2$parameter, p = test.prop2$p.value)
test.prop.table2 <- kable(t(test.prop.table2), caption = "Proportion Test Summary")

Test Result

Proportion Test Summary
X-squared	df	p
0.8990544	1	0.3430354

Conclusion

Since p > 0.05, we do not have sufficient evidence that the underlying population proportion receiving total scores between 4 and 8 among whites is different from the population proportion receiving total scores between 4 and 8 among People of Color.

Race as a Risk Predicator to Total Scores

Scores Above 8

### Test Hypothesis
#
#- H0: B1 = 0 (There is no association between Race and High Prioritization Score)
#- H1: B1 ≠ 0 (There is an association between Race and High Prioritization Score)
#- Alpha = 0.05
#
##### Deciding Factor:
#
#- If p <= 0.05, we do not have sufficient evidence to suggest an association 


# Scores Above 8
#simple logistic regression model
m<-glm(df$priority ~ df$grp.race, family = binomial)
logistic.sum <- summary(m)

#ORs per 1 unit increase
# same as calculation by hand (OR):  exp(0.02119)
# same as calculation by hand (OR 95% CI lower):  exp((m$coefficients[2]- qnorm(0.975)*summary(m)$coefficients[2,2]))
# same as calculation by hand (OR 95% CI upper):  exp((m$coefficients[2]+ qnorm(0.975)*summary(m)$coefficients[2,2]))
OR <- exp(cbind(OR = coef(m), confint.default(m)))

logistic.sum.display <- t(as.matrix(c(logistic.sum$coefficients[2,-3], OR[-1,])))
row.names(logistic.sum.display) <- c("Race")


logistic.sum.table <- kable(logistic.sum.display,
                            caption = "Simple Logestic for Score Greater than 8")

# Scores between 4 - 8
#simple logistic regression model
m4<-glm(df$priority4 ~ df$grp.race, family = binomial)
logistic.sum4 <- summary(m4)


#ORs per 1 unit increase
# same as calculation by hand (OR):  exp(0.02119)
# same as calculation by hand (OR 95% CI lower):  exp((m$coefficients[2]- qnorm(0.975)*summary(m)$coefficients[2,2]))
# same as calculation by hand (OR 95% CI upper):  exp((m$coefficients[2]+ qnorm(0.975)*summary(m)$coefficients[2,2]))
OR4 <- exp(cbind(OR = coef(m4), confint.default(m4)))


logistic.sum.display4 <- t(as.matrix(c(logistic.sum4$coefficients[2,-3], OR4[-1,])))
row.names(logistic.sum.display4) <- c("Race")


logistic.sum.table4 <- kable(logistic.sum.display4,
                            caption = "Simple Logestic for Score Between 4 - 8")



# Multiple Logistic Regression to match C4 Table 5
df$grp.eth <- ifelse(df$Ethnicity == "Hispanic/Latino (HUD)", 1, 0)
df$grp.gender <- ifelse(df$Gender == "Male" |
                          df$Gender == "Trans Male (FTM or Female to Male)", 1, 0)
m.reg <- glm(df$priority ~ df$grp.race + df$grp.gender + df$Age + df$grp.eth)
m.reg.sum <- summary(m.reg)

#overall test
#install.packages("aod")
library(aod)
wald.result <- wald.test(b = coef(m.reg), Sigma = vcov(m.reg), Terms = 2:5)

#ORs per 1 unit increase
m.reg.OR <- exp(cbind(OR = coef(m.reg), confint.default(m.reg)))

#ROC curve
#install.packages("pROC")
#library(pROC)

#using model with chol and sex and age
#df$prob<-predict(m.reg,type=c("response"))  
#g <- roc(df$priority ~ df$prob)
#plot(1-g$specificities, g$sensitivities, type = "l",
#xlab = "1 - Specificity", ylab = "Sensitivity", main = "ROC Curve")
#abline(a=0,b=1)
#grid()

multiple.logestic.display <- cbind(m.reg.sum$coefficients[2:5,-3], m.reg.OR[2:5,])
row.names(multiple.logestic.display) <- c("Race***", "Gender***", "Age", "Ethnicity")

multiple.logestic.display.table <- kable(multiple.logestic.display, caption = "Logistic Regression Analysis: Factors Predicting a High Score (8+)")

Test Result

Simple Logestic for Score Greater than 8
	Estimate	Std. Error	Pr(>\|z\|)	OR	2.5 %	97.5 %
Race	0.3143872	0.0959829	0.0010549	1.36942	1.134582	1.652865

Conclusion

Since p < 0.05, we have sufficient evidence to suggest an association between Race and Higher Prioritization Score. That is, there is sufficient evidence to predict a high prioritization score above 8 based on race.

Here, the df$grp.race has People of Color as the Reference Group. So, for the Odds Ratio, Whites are 1.37 times more likely than People of Color to have a higher score. ## Scores between 4 and 8

Test Result

Simple Logestic for Score Between 4 - 8
	Estimate	Std. Error	Pr(>\|z\|)	OR	2.5 %	97.5 %
Race	-0.0856633	0.0903537	0.3430845	0.9179032	0.7689316	1.095736

Conclusion

Since p > 0.05 we do not have sufficient evidence to suggest an association between Race and Higher Prioritization Score. That is, there is not sufficient evidence to predict a high prioritization score between 4 and 8 based on race.

Here, the df$grp.race has People of Color as the Reference Group. So, for the Odds Ratio, Whites are .92 times more likely than People of Color to have a higher score. In other words, People of color are more likely to fall in this range.

Factors Predicting a High Score (8+)

Test Result

Logistic Regression Analysis: Factors Predicting a High Score (8+)
	Estimate	Std. Error	Pr(>\|t\|)	OR	2.5 %	97.5 %
Race***	0.0868820	0.0209826	0.0000359	1.0907680	1.0468199	1.136561
Gender***	0.1450963	0.0204092	0.0000000	1.1561509	1.1108162	1.203336
Age	-0.0011441	0.0008844	0.1959266	0.9988565	0.9971265	1.000590
Ethnicity	0.1392067	0.1033135	0.1779837	1.1493616	0.9386768	1.407334

Conclusion

When comparing multiple factors in determining risk for a High Score of greater than 8, Race and Gender appear to be significant contributors. Age and Ethnicity, however, do not appear to be significant in predicting risk for a higher score.

In the above table, People of Color are the reference group for race, the Gender Identification of Female is the reference group for gender, and Non-Hispanic is the reference group for ethnicity.

For gender, people that identify as Male are 1.15 times more likely to have a higher score than those who identify as Female.

For race, Whites are 1.09 times more likely than People of Color to have a score above 8.

Logistic Regression Analysis: Race as a Predictor of Endorsing Individual Subscales

In this section, logistic regression was performed on the subscales of the VISPDAT. Each individual question was coded according to the VISDAT scoring mechanism of endorsement. If a client endorsed a subscale, they would receive an outcome of 1.

Test Results

# Making modifications to data for 1/0 coding
data <- df

# Question 3 Modifications
data$Q3 %>%
  gsub(pattern = "Greater than 10",
       replacement = 11) %>%
  gsub(pattern = "Refused", replacement = 0) -> data$Q3 
data$Q3 <- as.numeric(data$Q3)


# Question 4 Modifications
# 4a
data$Q4a %>%
  gsub(pattern = "Greater than 10",
       replacement = 11)%>%
  gsub(pattern = "Refused", replacement = 0)  -> data$Q4a 
data$Q4a <- as.numeric(data$Q4a)

# 4b
data$Q4b %>%
  gsub(pattern = "Greater than 10",
       replacement = 11) %>%
  gsub(pattern = "Refused", replacement = 0) -> data$Q4b 
data$Q4b <- as.numeric(data$Q4b)


# 4c
data$Q4c %>%
  gsub(pattern = "Greater than 10",
       replacement = 11) %>%
  gsub(pattern = "Refused", replacement = 0) -> data$Q4c 
data$Q4c <- as.numeric(data$Q4c)

#4d
data$Q4d %>%
  gsub(pattern = "Greater than 10",
       replacement = 11) %>%
  gsub(pattern = "Refused", replacement = 0) -> data$Q4d 
data$Q4d <- as.numeric(data$Q4d)

#4e
data$Q4e %>%
  gsub(pattern = "Greater than 10",
       replacement = 11) %>%
  gsub(pattern = "Refused", replacement = 0) -> data$Q4e 
data$Q4e <- as.numeric(data$Q4e)

#4f
data$Q4f %>%
  gsub(pattern = "Greater than 10",
       replacement = 11) %>%
  gsub(pattern = "Refused", replacement = 0) -> data$Q4f 
data$Q4f <- as.numeric(data$Q4f)

# Coding into 1/0 per VISPDAT Guidelines of endorsement
# A. Housing history
data$shelter.tran.safe <- ifelse(data$Q1 == "Shelters" | data$Q1 == "Transitional Housing" | data$Q1 == "Safe Haven", 0, 1)

data$consecutive.homeless.4plus <- ifelse(data$Q2 == "One year or more" | 
                                            data$Q3 >= 4, 1, 0)
# B. Risks
data$emergency.service <- ifelse((data$Q4a + data$Q4b + data$Q4c + data$Q4d + data$Q4e + data$Q4f) >= 4 , 1, 0)

data$risk.of.harm <- ifelse(data$Q5 == "Yes" | data$Q6 == "Yes", 1, 0)

data$legal.issues <- ifelse(data$Q7 == "Yes", 1, 0)

data$exploitation <- ifelse(data$Q9 == "Yes" | data$Q8 == "Yes", 1, 0)

# c. Socialization & Daily Functioning
data$money.managment <- ifelse(data$Q10 == "Yes" | data$Q11 == "No", 1, 0)

data$meaningful.activity <- ifelse(data$Q12 == "No", 1, 0)

data$self.care <- ifelse(data$Q13 == "No", 1,0)

data$social.relation <- ifelse(data$Q14 == "Yes", 1,0)
  

# D. Wellness

data$physical.health <- ifelse(data$Q15 == "Yes"|
                                 data$Q16 == "Yes" |
                                 data$Q17 == "Yes" |
                                 data$Q18 == "Yes" |
                                 data$Q19 == "Yes" |
                                 (data$Q20 == "Yes" &
                                    data$grp.gender == 0), 1, 0)

data$substance.use <- ifelse(data$Q21 == "Yes" |
                               data$Q22 == "Yes", 1, 0)

data$mental.health <- ifelse(data$Q23a == "Yes" | data$Q23b == "Yes" |
                               data$Q23c == "Yes" | data$Q24 == "Yes", 1, 0)

data$tri.morbidity <- ifelse(data$physical.health == 1 &
                               data$substance.use == 1 &
                               data$mental.health == 1, 1, 0)

data$medication <- ifelse(data$Q25 == "Yes" | data$Q26 == "Yes", 1, 0)

data$abuse.trauma <- ifelse(data$Q27 == "Yes", 1, 0)

# Begin Multiple Single Logistic Regression to Build Multivariate Table

# A. Housing History
shelter.tran.safe.m <- glm(data$shelter.tran.safe ~ data$grp.race, family = binomial)
shelter.tran.safe.sum <- summary(glm(data$shelter.tran.safe ~ data$grp.race, family = binomial))

consecutive.homeless.m <- glm(data$consecutive.homeless.4plus ~ data$grp.race, family = binomial)
consecutive.homeless.sum <- summary(glm(data$consecutive.homeless.4plus ~ data$grp.race, family = binomial))

# B. Risks
emergency.service.m <- glm(data$emergency.service ~ data$grp.race, family = binomial)
emergency.service.sum <- summary(glm(data$emergency.service ~ data$grp.race, family = binomial))

risk.of.harm.m <-glm(data$risk.of.harm ~ data$grp.race, family = binomial)
risk.of.harm.sum <- summary(glm(data$risk.of.harm ~ data$grp.race, family = binomial))

legal.issues.m <- glm(data$legal.issues ~ data$grp.race, family = binomial)
legal.issues.sum <- summary(glm(data$legal.issues ~ data$grp.race, family = binomial))

risk.of.exploitation.m <- glm(data$exploitation ~ data$grp.race, family = binomial)
risk.of.exploitation.sum <- summary(glm(data$exploitation ~ data$grp.race, family = binomial))

# C. Socialization and Daily Functioning
money.managment.m <- glm(data$money.managment ~ data$grp.race, family = binomial)
money.managment.sum <- summary(glm(data$money.managment ~ data$grp.race, family = binomial))

meaningful.activity.m <- glm(data$meaningful.activity ~ data$grp.race, family = binomial)
meaningful.activity.sum <- summary(glm(data$meaningful.activity ~ data$grp.race, family = binomial))

self.care.m <- glm(data$self.care ~ data$grp.race, family = binomial)
self.care.sum <- summary(glm(data$self.care ~ data$grp.race, family = binomial))

social.relation.m <- glm(data$social.relation ~ data$grp.race, family = binomial)
social.relation.sum <- summary(glm(data$social.relation ~ data$grp.race, family = binomial))

# D. Wellness
physical.health.m <- glm(data$physical.health ~ data$grp.race, family = binomial)
physical.health.sum <- summary(glm(data$physical.health ~ data$grp.race, family = binomial))

substance.use.m <- glm(data$substance.use ~ data$grp.race, family = binomial)
substance.use.sum <- summary(glm(data$substance.use ~ data$grp.race, family = binomial))

mental.health.m <- glm(data$mental.health ~ data$grp.race, family = binomial)
mental.health.sum <- summary(glm(data$mental.health ~ data$grp.race, family = binomial))

tri.morbidity.m <- glm(data$tri.morbidity ~ data$grp.race, family = binomial)
tri.morbidity.sum <- summary(glm(data$tri.morbidity ~ data$grp.race, family = binomial))

medication.m <- glm(data$medication ~ data$grp.race, family = binomial)
medication.sum <- summary(glm(data$medication ~ data$grp.race, family = binomial))

abuse.trauma.m <- glm(data$abuse.trauma ~ data$grp.race, family = binomial)
abuse.trauma.sum <- summary(glm(data$abuse.trauma ~ data$grp.race, family = binomial))


# Begin OR and CI for Multivariate table

# A. Housing History
shelter.tran.safe.OR <- exp(cbind(OR = coef(shelter.tran.safe.m), confint.default(shelter.tran.safe.m)))
consecutive.homeless.OR <- exp(cbind(OR = coef(consecutive.homeless.m), confint.default(consecutive.homeless.m)))

# B. Risks
emergency.service.OR <- exp(cbind(OR = coef(emergency.service.m), confint.default(emergency.service.m)))
risk.of.harm.OR <- exp(cbind(OR = coef(risk.of.harm.m), confint.default(risk.of.harm.m)))
legal.issues.OR <- exp(cbind(OR = coef(legal.issues.m), confint.default(legal.issues.m)))
risk.of.exploitation.OR <- exp(cbind(OR = coef(risk.of.exploitation.m), confint.default(risk.of.exploitation.m)))

# C. Socialization and Daily Function
money.managment.OR <- exp(cbind(OR = coef(money.managment.m), confint.default(money.managment.m)))
meaningful.activity.OR <- exp(cbind(OR = coef(meaningful.activity.m), confint.default(meaningful.activity.m)))
self.care.OR <- exp(cbind(OR = coef(self.care.m), confint.default(self.care.m)))
social.relation.OR <- exp(cbind(OR = coef(social.relation.m), confint.default(social.relation.m)))

# D. Wellness
physical.health.OR <- exp(cbind(OR = coef(physical.health.m), confint.default(physical.health.m)))
substance.use.OR <- exp(cbind(OR = coef(substance.use.m), confint.default(substance.use.m)))
mental.health.OR <- exp(cbind(OR = coef(mental.health.m), confint.default(mental.health.m)))
tri.morbidity.OR <- exp(cbind(OR = coef(tri.morbidity.m), confint.default(tri.morbidity.m)))
medication.OR <- exp(cbind(OR = coef(medication.m), confint.default(medication.m)))
abuse.trauma.OR <- exp(cbind(OR = coef(abuse.trauma.m), confint.default(abuse.trauma.m)))



# Combining variables for table

x <- rbind(shelter.tran.safe.sum$coefficients[2, -3],
           consecutive.homeless.sum$coefficients[2, -3],
           emergency.service.sum$coefficients[2, -3],
           risk.of.harm.sum$coefficients[2,-3],
           legal.issues.sum$coefficients[2,-3],
           risk.of.exploitation.sum$coefficients[2,-3],
           money.managment.sum$coefficients[2,-3],
           meaningful.activity.sum$coefficients[2,-3],
           self.care.sum$coefficients[2,-3],
           social.relation.sum$coefficients[2,-3],
           physical.health.sum$coefficients[2, -3],
           substance.use.sum$coefficients[2,-3],
           mental.health.sum$coefficients[2,-3],
           tri.morbidity.sum$coefficients[2,-3],
           medication.sum$coefficients[2,-3],
           abuse.trauma.sum$coefficients[2,-3])

row.names(x)<-c( 
"Shelter/Tran Housing/Safe Haven***",
"Consecutive Homeless***",
"Emergency Service**", 
"Risk of Harm**",
"Legal Issues**",
"Risk of Exploitation**",
"Money Managment***",
"Meaningful Activity",
"Self Care**",
"Social Relationship**", 
"Physical Health***",
"Substance Use***",                
"Mental Health***",
"Tri-Morbidity***",
"Medications***",
"Abuse and Trauma***")


y<-rbind(shelter.tran.safe.OR[-1,],
      consecutive.homeless.OR[-1,],
      emergency.service.OR[-1,],
      risk.of.harm.OR[-1,],
      legal.issues.OR[-1,],
      risk.of.exploitation.OR[-1,],
      money.managment.OR[-1,],
      meaningful.activity.OR[-1,],
      self.care.OR[-1,],
      social.relation.OR[-1,],
      physical.health.OR[-1,],
      substance.use.OR[-1,],
      mental.health.OR[-1,],
      tri.morbidity.OR[-1,],
      medication.OR[-1,],
      abuse.trauma.OR[-1,])

multivariate.display <- cbind(x, y)

colnames(multivariate.display)[3] <- "Pr(>z)"

multivariate.display.table <- kable(multivariate.display)

	Estimate	Std. Error	Pr(>z)	OR	2.5 %	97.5 %
Shelter/Tran Housing/Safe Haven***	-0.2872394	0.0918006	0.0017543	0.7503320	0.6267765	0.898244
Consecutive Homeless***	0.2954466	0.1043485	0.0046353	1.3437263	1.0951894	1.648665
Emergency Service**	0.1845135	0.0909798	0.0425529	1.2026332	1.0062157	1.437392
Risk of Harm**	0.2123129	0.0909998	0.0196421	1.2365348	1.0345397	1.477970
Legal Issues**	0.2218323	0.0975697	0.0229914	1.2483620	1.0310722	1.511444
Risk of Exploitation**	0.2372910	0.0968144	0.0142465	1.2678100	1.0486862	1.532720
Money Managment***	0.3114776	0.0937100	0.0008879	1.3654412	1.1363364	1.640737
Meaningful Activity	-0.0061644	0.0933261	0.9473365	0.9938546	0.8277201	1.193334
Self Care**	-0.2965480	0.1466947	0.0432247	0.7433800	0.5576274	0.991009
Social Relationship**	0.2061137	0.0907178	0.0230846	1.2288930	1.0287147	1.468024
Physical Health***	0.3051117	0.0925708	0.0009808	1.3567765	1.1316494	1.626690
Substance Use***	0.4926841	0.1005050	0.0000009	1.6367034	1.3440640	1.993058
Mental Health***	0.2999706	0.1067706	0.0049621	1.3498191	1.0949448	1.664021
Tri-Morbidity***	0.5092047	0.1872617	0.0065437	1.6639673	1.1527823	2.401830
Medications***	0.2878538	0.1060306	0.0066312	1.3335623	1.0833278	1.641598
Abuse and Trauma***	0.2740299	0.0905087	0.0024645	1.3152541	1.1014594	1.570547

**p < 0.05

***p < 0.01

Female is reference group

People of Color is Reference Group

Conclusion

For individual adults (receiving any prioritization score), race was a predictor of endorsing 15 of the 16 subscales. Whites were more likely to endorse 13 of these subscales. These subscales include:

Consecutive Homelessness
Emergency Service
Risk of Harm
Legal Issues
Risk of Exploitation
Money Managment
Social Relationship
Physical Health
Substance Use
Mental Health
Tri-Morbidity
Medications
Abuse and Trauma

People of Color were more likely to endorse 2 of these subscales, which include:

Outside/ Other
Self Care

This would imply that 2 of the 16 subscales are designed to capture vulnerabilities that POC are more likely to report. Odds ratios are presented below.

row.names(y) <- c( 
"Outside/Other***",
"Consecutive Homeless***",
"Emergency Service**", 
"Risk of Harm**",
"Legal Issues**",
"Risk of Exploitation**",
"Money Managment***",
"Meaningful Activity",
"Self Care**",
"Social Relationship**", 
"Physical Health***",
"Substance Use***",                
"Mental Health***",
"Tri-Morbidity***",
"Medications***",
"Abuse and Trauma***")



x <- barplot(t(y[,1]),
        las = 2, 
        cex.names = .5, 
        yaxt = 'n',
        xaxt = 'n',
        col = "darksalmon",       
        ylab = "Odds Ratio",
        xlab = " ",
        main = "Race as a Predictor of Subscales",
        ylim = c(0,2))
abline(h = 1)
axis(side=2, at=seq(from = 0, to = 2, by = .5), las = 1, labels = TRUE)
text(cex=.8, x=colMeans(t(x))-.25, y = -.15, rownames(y), xpd=TRUE, srt=40)
mtext(side=1, line=4, "Subscales", cex=1)

grid(nx = 0, ny = 4, lty = 1)

barplot(t(y[,1]),
        las = 2, 
        cex.names = .5, 
        yaxt = 'n',
        xaxt = 'n',
        col = "darksalmon",        
        ylab = "Odds Ratio",
        xlab = " ",
        main = "Race as a Predictor of Subscales",
        add = TRUE,
        ylim = c(0,2))
abline(h = 1)
axis(side=2, at=seq(from = 0, to = 2, by = .5), las = 1, labels = TRUE)
text(cex=.8, x=colMeans(t(x))-.25, y = -.15, rownames(y), xpd=TRUE, srt=40)
mtext(side=1, line=4, "Subscales", cex=1)

Logistic Regression Analysis: VI-SPDAT Subscales Predicting a High Score (8+) among White and BIPOC

Analyses were run by race group. In other words, White clients were filtered out to explore odds ratios for POC only and vice versa. The table and chart below shows the odds ratio of each VI-SPDAT subscale in predicting a recommendation of PSH/Housing or score greater than 8.

The number of subscales that are predictive (i.e., those that have higher odds ratios) of a score above 8 for Whites is 9, compared to the 7 for POC. Of 16 subscales, Whites had higher odds ratio for 8 of the scales, POC had higher odds ratio for 6 of the scales, 1 of the scales was equal, and 1 scale was inconclusive.

# Logistic Regression Analysis: VI-SPDAT Subscales Predicting a High Score (8+)
# among White Single Adults and BIPOC Single Adults

black <- subset(data, data$grp.race == 0)
white <- subset(data, data$grp.race == 1)

# Begin for Black/AfricanAmerican
# A. Subscale 
housing.history.m <- glm(black$priority ~ black$shelter.tran.safe +
                           black$consecutive.homeless.4plus, family = binomial)

housing.history.sum <- summary(housing.history.m)

housing.history.OR <- exp(cbind(OR = coef(housing.history.m), confint.default(housing.history.m)))

# B. Subscale
risk.m <- glm(black$priority ~ black$emergency.service + 
                black$risk.of.harm +
                black$legal.issues + 
                black$exploitation, family = binomial)

risk.sum <- summary(risk.m)

risk.OR <- exp(cbind(OR = coef(risk.m), confint.default(risk.m)))

# C. Subscale
social.daily.funct.m <- glm(black$priority ~ black$money.managment +
                              black$meaningful.activity +
                              black$self.care + 
                              black$social.relation, family = binomial)

social.daily.funct.sum <- summary(social.daily.funct.m)

social.daily.funct.OR <- exp(cbind(OR = coef(social.daily.funct.m), confint.default(social.daily.funct.m)))

# D. Subscale
wellness.m <- glm(black$priority ~ black$physical.health + 
                    black$substance.use +
                    black$mental.health + 
                    black$tri.morbidity + 
                    black$medication +
                    black$abuse.trauma, family = binomial)

wellness.sum <- summary(wellness.m)

wellness.OR <- exp(cbind(OR = coef(wellness.m), confint.default(wellness.m)))

b.sum<- rbind(housing.history.sum$coefficients[c(2:3),-3], risk.sum$coefficients[c(2:5),-3],
      social.daily.funct.sum$coefficients[c(2:5),-3], wellness.sum$coefficients[c(2:7),-3])

row.names(b.sum) <- c( 
  "Shelter/Tran Housing/Safe Haven",
  "Consecutive Homeless",
  "Emergency Service", 
  "Risk of Harm",
  "Legal Issues",
  "Risk of Exploitation",
  "Money Managment",
  "Meaningful Activity",
  "Self Care",
  "Social Relationship", 
  "Physical Health",
  "Substance Use",                
  "Mental Health",
  "Tri-Morbidity",
  "Medications",
  "Abuse and Trauma")
options(scipen = 10)
b.OR <- rbind(housing.history.OR[-1,],
              risk.OR[-1,],
              social.daily.funct.OR[-1,],
              wellness.OR[-1,])
b.table <- cbind(round(b.sum,3), round(b.OR,4))


# Begin for White
# A. Subscale 
w.housing.history.m <- glm(white$priority ~ white$shelter.tran.safe + white$consecutive.homeless.4plus, family = binomial)
w.housing.history.sum <- summary(w.housing.history.m)
w.housing.history.OR <- exp(cbind(OR = coef(w.housing.history.m), confint.default(w.housing.history.m)))

# B. Subscale
w.risk.m <- glm(white$priority ~ white$emergency.service + white$risk.of.harm +
                white$legal.issues + white$exploitation, family = binomial)
w.risk.sum <- summary(w.risk.m)
w.risk.OR <- exp(cbind(OR = coef(w.risk.m), confint.default(w.risk.m)))

# C. Subscale
w.social.daily.funct.m <- glm(white$priority ~ white$money.managment + white$meaningful.activity +
                              white$self.care + white$social.relation, family = binomial)
w.social.daily.funct.sum <- summary(w.social.daily.funct.m)
w.social.daily.funct.OR <- exp(cbind(OR = coef(w.social.daily.funct.m), confint.default(w.social.daily.funct.m)))

# D. Subscale
w.wellness.m <- glm(white$priority ~ white$physical.health + white$substance.use +
                    white$mental.health + white$tri.morbidity + white$medication +
                    white$abuse.trauma, family = binomial)
w.wellness.sum <- summary(w.wellness.m)
w.wellness.OR <- exp(cbind(OR = coef(w.wellness.m), confint.default(w.wellness.m)))

w.sum <- rbind(w.housing.history.sum$coefficients[c(2:3),-3], w.risk.sum$coefficients[c(2:5),-3],
           w.social.daily.funct.sum$coefficients[c(2:5),-3], w.wellness.sum$coefficients[c(2:7),-3])

w.OR <- rbind(w.housing.history.OR[-1,],
              w.risk.OR[-1,],
              w.social.daily.funct.OR[-1,],
              w.wellness.OR[-1,])
w.table <- cbind(round(w.sum,3), round(w.OR,4))

# ------------------

w.sum2 <- summary(glm(white$priority ~ white$shelter.tran.safe + white$consecutive.homeless.4plus +
      white$emergency.service + white$risk.of.harm + white$legal.issues + white$exploitation +
      white$money.managment + white$meaningful.activity + white$self.care +
      white$social.relation + white$physical.health + white$substance.use + white$mental.health +
      white$tri.morbidity + white$medication + white$abuse.trauma))

w.m2 <- glm(white$priority ~ white$shelter.tran.safe + white$consecutive.homeless.4plus +
      white$emergency.service + white$risk.of.harm + white$legal.issues + white$exploitation +
      white$money.managment + white$meaningful.activity + white$self.care +
      white$social.relation + white$physical.health + white$substance.use + white$mental.health +
      white$tri.morbidity + white$medication + white$abuse.trauma)
options(scipen = 3)
w.OR2<-exp(cbind(OR = coef(w.m2), confint.default(w.m2)))

w.table2 <- cbind(round(w.sum2$coefficients[-1,-3],3), round(w.OR2[-1,],4))

b.m2 <- glm(black$priority ~ black$shelter.tran.safe + black$consecutive.homeless.4plus +
           black$emergency.service + black$risk.of.harm + black$legal.issues + black$exploitation +
           black$money.managment + black$meaningful.activity + black$self.care +
           black$social.relation + black$physical.health + black$substance.use + black$mental.health +
           black$tri.morbidity + black$medication + black$abuse.trauma)
b.sum2<- summary(b.m2)
b.OR2<-exp(cbind(OR = coef(b.m2), confint.default(b.m2)))
b.table2 <- cbind(round(b.sum2$coefficients[-1,-3],3), round(b.OR2[-1,],4))
row.names(b.table2) <- c( 
  "Shelter/Tran Housing/Safe Haven",
  "Consecutive Homeless",
  "Emergency Service", 
  "Risk of Harm",
  "Legal Issues",
  "Risk of Exploitation",
  "Money Managment",
  "Meaningful Activity",
  "Self Care",
  "Social Relationship", 
  "Physical Health",
  "Substance Use",                
  "Mental Health",
  "Tri-Morbidity",
  "Medications",
  "Abuse and Trauma")
# ------------

# Binding sum and OR table
# SWAPED b.table/w.table WITH b.table2 AND w.table2
subscale.display<-cbind(b.table, w.table)
colnames(subscale.display)[3] <- colnames(subscale.display)[9] <- "Pr(>z)"


# Adding Sig indicators to Black/African American
subscale.display[1,3] <- paste(subscale.display[1,3], "***",  sep = "")
subscale.display[2,3] <- paste(subscale.display[2,3], "***",  sep = "")
subscale.display[3,3] <- paste(subscale.display[3,3], "***",  sep = "")
subscale.display[4,3] <- paste(subscale.display[4,3], "***",  sep = "")
subscale.display[5,3] <- paste(subscale.display[5,3], "***",  sep = "")
subscale.display[6,3] <- paste(subscale.display[6,3], "***",  sep = "")
subscale.display[7,3] <- paste(subscale.display[7,3], "***",  sep = "")
subscale.display[8,3] <- paste(subscale.display[8,3], "***",  sep = "")
subscale.display[9,3] <- paste(subscale.display[9,3], "***",  sep = "")
subscale.display[10,3] <- paste(subscale.display[10,3], "***", sep = "")
subscale.display[11,3] <- paste(subscale.display[11,3], "***", sep = "")
subscale.display[12,3] <- paste(subscale.display[12,3], "***", sep = "")
subscale.display[13,3] <- paste(subscale.display[13,3], "***", sep = "")
#subscale.display[14,3] <- paste(subscale.display[14,3], "***",  sep = "")
subscale.display[15,3] <- paste(subscale.display[15,3], "***", sep = "")
subscale.display[16,3] <- paste(subscale.display[16,3], "***", sep = "")
#
## Adding Sig indicators to White
subscale.display[1,9] <- paste(subscale.display[1,9], "***", sep = "")
subscale.display[2,9] <- paste(subscale.display[2,9], "***", sep = "")
subscale.display[3,9] <- paste(subscale.display[3,9], "***", sep = "")
subscale.display[4,9] <- paste(subscale.display[4,9], "***", sep = "")
subscale.display[5,9] <- paste(subscale.display[5,9], "***", sep = "")
subscale.display[6,9] <- paste(subscale.display[6,9], "***", sep = "")
subscale.display[7,9] <- paste(subscale.display[7,9], "**", sep = "")
subscale.display[8,9] <- paste(subscale.display[8,9], "***", sep = "")
subscale.display[9,9] <- paste(subscale.display[9,9], "***", sep = "")
subscale.display[10,9] <- paste(subscale.display[10,9], "***", sep = "")
subscale.display[11,9] <- paste(subscale.display[11,9], "***", sep = "")
subscale.display[12,9] <- paste(subscale.display[12,9], "***", sep = "")
subscale.display[13,9] <- paste(subscale.display[13,9], "***", sep = "")
#subscale.display[14,9] <- paste(subscale.display[14,9], "***", sep = "")
subscale.display[15,9] <- paste(subscale.display[15,9], "***", sep = "")
subscale.display[16,9] <- paste(subscale.display[16,9], "***", sep = "")



subscale.display.table <- kable(subscale.display, caption = "Logistic Regression Analysis: VI-SPDAT Subscales Predicting a High Score (8+)
      among White and BIPOC")

Logistic Regression Analysis: VI-SPDAT Subscales Predicting a High Score (8+) among White and BIPOC
	Estimate	Std. Error	Pr(>z)	OR	2.5 %	97.5 %	Estimate	Std. Error	Pr(>z)	OR	2.5 %	97.5 %
Shelter/Tran Housing/Safe Haven	1.175	0.125	0***	3.2388	2.5368	4.1349	1.652	0.17	0***	5.2173	3.7398	7.2787
Consecutive Homeless	1.223	0.163	0***	3.3986	2.4688	4.6787	1.036	0.231	0***	2.8187	1.7919	4.4341
Emergency Service	1.49	0.158	0***	4.4363	3.2535	6.0491	1.608	0.22	0***	4.9933	3.2463	7.6805
Risk of Harm	1.842	0.161	0***	6.308	4.5983	8.6534	1.873	0.227	0***	6.5072	4.1744	10.1439
Legal Issues	1.304	0.168	0***	3.6841	2.6512	5.1195	1.407	0.229	0***	4.0839	2.6079	6.3952
Risk of Exploitation	2.086	0.16	0***	8.0532	5.8855	11.0194	1.911	0.221	0***	6.7607	4.3863	10.4204
Money Managment	0.876	0.138	0***	2.4016	1.8315	3.1492	1.03	0.192	0**	2.8	1.9232	4.0766
Meaningful Activity	0.468	0.135	0.001***	1.5961	1.2262	2.0777	0.746	0.177	0***	2.1079	1.4903	2.9815
Self Care	1.579	0.183	0***	4.8499	3.3861	6.9466	1.534	0.292	0***	4.636	2.6134	8.2242
Social Relationship	1.819	0.144	0***	6.1658	4.6516	8.173	1.562	0.187	0***	4.7695	3.3057	6.8815
Physical Health	1.494	0.175	0***	4.4529	3.1615	6.2718	1.085	0.234	0***	2.9587	1.872	4.676
Substance Use	1.533	0.192	0***	4.6315	3.1773	6.7511	0.904	0.236	0***	2.4699	1.5548	3.9236
Mental Health	1.661	0.194	0***	5.2665	3.5986	7.7074	1.789	0.246	0***	5.9855	3.6949	9.6963
Tri-Morbidity	0.56	0.473	0.236	1.7515	0.6929	4.4278	0.718	0.585	0.219	2.0505	0.6519	6.4494
Medications	1.718	0.184	0***	5.5728	3.8822	7.9996	1.799	0.227	0***	6.0463	3.8766	9.4304
Abuse and Trauma	2.411	0.177	0***	11.1501	7.8742	15.789	1.5	0.209	0***	4.4831	2.9779	6.7491

**p < 0.05

***p<0.01

Female is reference Group

Conclusion

OR.barplot.table <- cbind(b.OR[,1], w.OR[,1])
row.names(OR.barplot.table) <- c( 
  "Outside/Other*",
  "Consecutive Homeless*",
  "Emergency Service*", 
  "Risk of Harm*",
  "Legal Issues*",
  "Risk of Exploitation*",
  "Money Managment*",
  "Meaningful Activity*",
  "Self Care*",
  "Social Relationship*", 
  "Physical Health*",
  "Substance Use*",
  "Mental Health*",
  "Tri Morbidity",
  "Medications*",
  "Abuse and Trauma*")
colnames(OR.barplot.table) <- c("POC", "White")

x <- barplot(t(OR.barplot.table),
        las = 2, 
        cex.names = .5, 
        yaxt = 'n',
        xaxt = 'n',
        col = c("cadetblue", "skyblue"), 
        beside = TRUE,        
        ylab = "Odds Ratio",
        xlab = " ",
        main = "VI-SPDAT Subscales as Predictors of High Vulnerability Scores: By Race",
        ylim = c(0,12))
axis(side=2, at=seq(from = 0, to = 12, by = 1), las = 1, labels = TRUE)
text(cex=1, x=colMeans(x)-.25, y=-1, rownames(OR.barplot.table), xpd=TRUE, srt=30)
mtext(side=1, line=4, "Subscales", cex=1)

grid(nx = 0, ny = 12, lty = 1)

barplot(t(OR.barplot.table),
        las=2,
        xaxt = 'n',
        yaxt = 'n',
        col = c("cadetblue", "skyblue"), 
        beside = TRUE,
        legend = TRUE,
        ylab = "Odds Ratio",
        xlab = "Subscales",
        main = "VI-SPDAT Subscales as Predictors of High Vulnerability Scores: By Race",
        ylim = c(0,22), add = TRUE)
axis(side=2, at=seq(from = 0, to = 12, by = 1), las = 1, labels = TRUE)
text(cex=1, x=colMeans(x)-.25, y=-1, rownames(OR.barplot.table), xpd=TRUE, srt=30)
mtext(side=1, line=4, "Subscales",cex=1)

Discordance of odds ratios between racial groups identifies subscales that are more predictive of a higher prioritization score for White clients. In other words, endorsement of these subscales results in a higher likelihood of receiving a higher prioritization score. For the dataset, we identified the three subscales that were most discordant (and statistically significant predictors of a high score for both racial groups)

Where do you sleep most frequently? If the person answers anything other than “shelter”, “transitional housing”, or “safe haven,” then score 1. [OR = 5.22 White; OR=3.23 POC.]
Have you ever had trouble maintaining your housing, or been kicked out of an apartment, shelter program or other place you were staying, because of: a) A mental health issue or concern? b) A past head injury? c) A learning disability, developmental disability, or other impairment? Do you have any mental health or brain issues that would make it hard for you to live independently because you’d need help? IF “YES” TO ANY OF THE ABOVE, THEN SCORE 1 FOR MENTAL HEALTH. [OR=5.98 White; OR=5.26 POC.]
10:Is there any person, past landlord, business, bookie, dealer, or government group like the IRS that thinks you owe them money? 11:Do you get any money from the government, an inheritance, an allowance, working under the table, a regular job, or anything like that? IF “YES” TO QUESTION 10 OR “NO” TO QUESTION 11, THEN SCORE 1 FOR MONEY MANAGEMENT. [OR = 2.8 White; OR=2.4 POC.]

It appears that larger amounts of discordance of odds ratio favor People of Color, with having three subscales with larger discordance.

These subscales include risk of exploitation, social relationship, and abuse & trauma.

Additional Tables

t <-rbind(
  table(data$shelter.tran.safe),
  table(data$consecutive.homeless.4plus),
  table(data$emergency.service),
  table(data$risk.of.harm),
  table(data$legal.issues),
  table(data$exploitation),
  table(data$money.managment),
  table(data$meaningful.activity),
  table(data$self.care),
  table(data$social.relation),
  table(data$physical.health),
  table(data$substance.use),
  table(data$mental.health),
  table(data$tri.morbidity),
  table(data$medication),
  table(data$abuse.trauma))

w <- rbind(
  table(white$shelter.tran.safe),
  table(white$consecutive.homeless.4plus),
  table(white$emergency.service),
  table(white$risk.of.harm),
  table(white$legal.issues),
  table(white$exploitation),
  table(white$money.managment),
  table(white$meaningful.activity),
  table(white$self.care),
  table(white$social.relation),
  table(white$physical.health),
  table(white$substance.use),
  table(white$mental.health),
  table(white$tri.morbidity),
  table(white$medication),
  table(white$abuse.trauma))

b<- rbind(
  table(black$shelter.tran.safe),
  table(black$consecutive.homeless.4plus),
  table(black$emergency.service),
  table(black$risk.of.harm),
  table(black$legal.issues),
  table(black$exploitation),
  table(black$money.managment),
  table(black$meaningful.activity),
  table(black$self.care),
  table(black$social.relation),
  table(black$physical.health),
  table(black$substance.use),
  table(black$mental.health),
  table(black$tri.morbidity),
  table(black$medication),
  table(black$abuse.trauma))


x <- cbind(t,w,b)
colnames(x) <- c("Total No","Total Yes","White No", "White Yes", "POC No", "POC Yes")
row.names(x) <- c( 
  "Shelter/Tran Housing/Safe Haven",
  "Consecutive Homeless",
  "Emergency Service", 
  "Risk of Harm",
  "Legal Issues",
  "Risk of Exploitation",
  "Money Managment",
  "Meaningful Activity",
  "Self Care",
  "Social Relationship",
  "Abuse and Trauma",
  "Physical Health",
  "Substance Use",                
  "Mental Health",
  "Tri-Morbidity",
  "Medications")

kable(x, caption = "VISPDAT Subscale Endorsement by Race")

VISPDAT Subscale Endorsement by Race
	Total No	Total Yes	White No	White Yes	POC No	POC Yes
Shelter/Tran Housing/Safe Haven	1233	972	446	290	787	682
Consecutive Homeless	599	1606	172	564	427	1042
Emergency Service	1259	946	398	338	861	608
Risk of Harm	1263	942	396	340	867	602
Legal Issues	1549	656	494	242	1055	414
Risk of Exploitation	1531	674	486	250	1045	424
Money Managment	875	1330	256	480	619	850
Meaningful Activity	1379	826	461	275	918	551
Self Care	1946	259	664	72	1282	187
Social Relationship	1052	1153	326	410	726	743
Abuse and Trauma	929	1276	274	462	655	814
Physical Health	1635	570	498	238	1137	332
Substance Use	1722	483	549	187	1173	296
Mental Health	2082	123	681	55	1401	68
Tri-Morbidity	1711	494	546	190	1165	304
Medications	1152	1053	351	385	801	668

kable(table(df$Q1, df$Race), caption = "Q1")

Q1
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
Other (Specify)	0	0	109	0	1	34
Outdoors	7	1	563	1	0	256
Safe Haven	0	0	9	0	0	9
Shelters	3	1	707	1	0	366
Transitional Housing	0	0	66	0	0	71

kable(table(df$Q2, df$Race), caption = "Q2")

Q2
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
Currently in stable housing	0	0	15	0	0	6
Less than 1 year	2	1	523	0	0	219
One year or more	8	1	916	2	1	510
Refused	0	0	0	0	0	1

kable(table(df$Q3, df$Race), caption = "Q3")

Q3
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
0	0	0	14	0	0	7
1	7	1	604	1	0	293
10	0	0	14	0	0	1
2	0	0	217	0	1	141
3	0	0	128	0	0	69
4	1	0	167	0	0	85
5	0	0	84	1	0	43
6	1	0	37	0	0	25
7	0	0	16	0	0	8
8	0	0	17	0	0	8
9	0	0	7	0	0	3
Greater than 10	1	1	149	0	0	53

kable(table(df$Q4a, df$Race), caption = "Q4a")

Q4a
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
0	4	2	540	0	0	225
1	6	0	308	0	0	168
10	0	0	7	1	0	6
2	0	0	224	0	0	114
3	0	0	121	1	0	77
4	0	0	79	0	0	49
5	0	0	62	0	0	36
6	0	0	35	0	1	19
7	0	0	11	0	0	8
8	0	0	16	0	0	6
9	0	0	2	0	0	0
Greater than 10	0	0	48	0	0	27
Refused	0	0	1	0	0	1

kable(table(df$Q4b, df$Race), caption = "Q4b")

Q4b
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
0	8	2	994	0	0	474
1	2	0	213	0	0	130
10	0	0	3	0	0	1
2	0	0	104	1	1	47
3	0	0	49	1	0	37
4	0	0	24	0	0	21
5	0	0	21	0	0	6
6	0	0	18	0	0	7
7	0	0	2	0	0	2
8	0	0	8	0	0	1
9	0	0	3	0	0	1
Greater than 10	0	0	15	0	0	9

kable(table(df$Q4c, df$Race), caption = "Q4c")

Q4c
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
0	7	2	995	0	0	455
1	2	0	244	1	1	139
10	0	0	2	0	0	1
2	0	0	89	1	0	73
3	0	0	53	0	0	36
4	1	0	27	0	0	15
5	0	0	14	0	0	5
6	0	0	13	0	0	4
7	0	0	4	0	0	2
8	0	0	4	0	0	1
Greater than 10	0	0	9	0	0	4
Refused	0	0	0	0	0	1

kable(table(df$Q4d, df$Race), caption = "Q4d")

Q4d
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
0	9	2	1227	1	0	632
1	0	0	112	1	0	65
10	0	0	1	0	0	1
2	0	0	52	0	1	18
3	1	0	23	0	0	9
4	0	0	13	0	0	6
5	0	0	4	0	0	2
6	0	0	7	0	0	0
7	0	0	1	0	0	0
8	0	0	2	0	0	0
Greater than 10	0	0	11	0	0	3
Refused	0	0	1	0	0	0

kable(table(df$Q4e, df$Race), caption = "Q4e")

Q4e
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
0	5	1	1079	0	1	518
1	3	1	190	0	0	104
10	0	0	1	0	0	1
2	1	0	64	1	0	39
3	0	0	47	0	0	20
4	0	0	28	0	0	16
5	0	0	18	0	0	9
6	0	0	7	0	0	4
7	0	0	1	0	0	2
8	0	0	5	0	0	2
9	0	0	0	0	0	1
Greater than 10	1	0	14	1	0	19
Refused	0	0	0	0	0	1

kable(table(df$Q4f, df$Race), caption = "Q4f")

Q4f
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
0	8	2	1238	1	1	595
1	1	0	162	0	0	107
10	0	0	1	0	0	0
2	1	0	30	0	0	17
3	0	0	9	0	0	9
4	0	0	7	0	0	1
5	0	0	1	0	0	0
6	0	0	1	0	0	1
7	0	0	0	0	0	1
8	0	0	1	0	0	0
Greater than 10	0	0	4	1	0	5

kable(table(df$Q5, df$Race), caption = "Q5")

Q5
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	6	1	952	2	1	462
Yes	4	1	502	0	0	274

kable(table(df$Q6, df$Race), caption = "Q6")

Q6
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	8	1	1231	1	0	569
Refused	0	0	2	0	0	1
Yes	2	1	221	1	1	166

kable(table(df$Q7, df$Race), caption = "Q7")

Q7
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	8	1	1042	2	1	494
Refused	0	0	1	0	0	0
Yes	2	1	411	0	0	242

kable(table(df$Q8, df$Race), caption = "Q8")

Q8
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	9	1	1302	2	1	621
Refused	0	0	1	0	0	0
Yes	1	1	151	0	0	115

kable(table(df$Q9, df$Race), caption = "Q9")

Q9
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	8	1	1101	1	0	541
Refused	0	0	2	0	0	0
Yes	2	1	351	1	1	195

kable(table(df$Q10, df$Race), caption = "Q10")

Q10
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	8	1	1026	1	0	542
Refused	0	0	1	0	0	1
Yes	2	1	427	1	1	193

kable(table(df$Q11, df$Race), caption = "Q11")

Q11
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	4	1	602	2	0	373
Refused	0	0	0	0	0	1
Yes	6	1	852	0	1	362

kable(table(df$Q12, df$Race), caption = "Q12")

Q12
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	5	2	544	0	0	275
Refused	0	0	1	0	0	0
Yes	5	0	909	2	1	461

kable(table(df$Q13, df$Race), caption = "Q13")

Q13
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	3	1	183	0	0	72
Yes	7	1	1271	2	1	664

kable(table(df$Q14, df$Race), caption = "Q14")

Q14
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	6	0	719	0	0	326
Refused	0	0	1	0	0	0
Yes	4	2	734	2	1	410

kable(table(df$Q15, df$Race), caption = "Q15")

Q15
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	10	2	1315	2	1	668
Yes	0	0	139	0	0	68

kable(table(df$Q16, df$Race), caption = "Q16")

Q16
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	8	2	1073	2	1	499
Yes	2	0	381	0	0	237

kable(table(df$Q17, df$Race), caption = "Q17")

Q17
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	9	2	1279	2	1	672
Refused	0	0	0	0	0	2
Yes	1	0	175	0	0	62

kable(table(df$Q18, df$Race), caption = "Q18")

Q18
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	8	1	1310	2	1	650
Refused	0	0	2	0	0	0
Yes	2	1	142	0	0	86

kable(table(df$Q19, df$Race), caption = "Q19")

Q19
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	4	1	1168	1	0	503
Refused	0	0	1	0	0	2
Yes	6	1	285	1	1	231

kable(table(df$Q20, df$Race), caption = "Q20")

Q20
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
N/A or Refused	5	0	551	0	0	186
No	5	2	869	2	1	523
Yes	0	0	34	0	0	27

kable(table(df$Q21, df$Race), caption = "Q21")

Q21
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	9	1	1174	0	1	516
Refused	0	0	1	0	0	0
Yes	1	1	279	2	0	220

kable(table(df$Q22, df$Race), caption = "Q22")

Q22
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	9	1	1344	2	1	692
Refused	0	0	2	0	0	1
Yes	1	1	108	0	0	43

kable(table(df$Q23a, df$Race), caption = "Q23a")

Q23a
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	10	2	1322	2	1	621
Refused	0	0	1	0	0	1
Yes	0	0	131	0	0	114

kable(table(df$Q23b, df$Race), caption = "Q23b")

Q23b
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	10	2	1363	2	1	673
Yes	0	0	91	0	0	63

kable(table(df$Q23c, df$Race), caption = "Q23c")

Q23c
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	9	2	1332	1	0	671
Refused	0	0	2	0	0	0
Yes	1	0	120	1	1	65

kable(table(df$Q24, df$Race), caption = "Q24")

Q24
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	10	2	1375	2	1	691
Refused	0	0	2	0	0	0
Yes	0	0	77	0	0	45

kable(table(df$Q25, df$Race), caption = "Q25")

Q25
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	8	2	1196	1	1	557
Refused	0	0	1	0	0	0
Yes	2	0	257	1	0	179

kable(table(df$Q26, df$Race), caption = "Q26")

Q26
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	9	2	1369	1	1	700
Yes	1	0	85	1	0	36

kable(table(df$Q27, df$Race), caption = "Q27")

Q27
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
No	6	1	791	0	0	349
Refused	0	0	3	0	0	2
Yes	4	1	660	2	1	385

kable(table(df$Referral.Rank, df$Race), caption = "Referral Rank")

Referral Rank
	American Indian or Alaska Native	Asian	Black or African American	Native Hawaiian or Other Pacific Islander	Other Multi-Racial	White
0	0	0	45	0	0	25
1	0	0	39	0	0	20
2	2	1	138	0	0	44
3	2	0	334	0	0	196
4	0	0	153	0	0	94
5	6	1	684	1	1	298
Missing Info	0	0	61	1	0	59

Individual VISPDAT

1/1/2016 - 9/21/2020

Overview of Data

Statistical Difference in Mean Total Score by Race

Test Result

Conclusion

Race as a Predictor of Total Score

Test Result

Conclusion

Cross-Tabulations and Chi-Square Analysis to Test the Relationship between Race and Type of Housing Intervention

Chi Test for Indepence

Statistical Difference in Proportions of Scorers by Race

Scores of 8 or More

Test Result

Conclusion

Scores between 4 and 8

Test Result

Conclusion

Race as a Risk Predicator to Total Scores

Scores Above 8

Test Result

Conclusion

Test Result

Conclusion

Factors Predicting a High Score (8+)

Test Result

Conclusion

Logistic Regression Analysis: Race as a Predictor of Endorsing Individual Subscales

Test Results

Conclusion

Logistic Regression Analysis: VI-SPDAT Subscales Predicting a High Score (8+) among White and BIPOC

Conclusion

Additional Tables