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

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

df <- read.csv("FSPDAT.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

This analysis looks at the subscale A - E for the F-SPDAT and attempts to mimic the report produced by C4 Innovations. The C4 Innovations report did not mention the Pre-Survey Score as a part of the total score. As well, C4 did not include Subscale E in their report.

Looking at Chart 1, it appears that Black/African American Families have a similiar mean total score compared to White Families. Whites have the largest inner group variance, but both Black/African American and White Families have similar ranges of values.

Looking at Chart 2, gender scores would be taken from the head of household. When Males are the head of household, it appears that mean total score is higher than Female head of households. Males have a larger inner group variation, however, Females have a larger range of scores.

Looking at Chart 3, no linear relationship appears to occur with total score and age. However, it does appear that the highest scores occur among younger peoples.

Looking at Chart 4, the distribution of scores appears slightly skewed with a center around 8 and 50% of the values between 6 and 10.

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",
        col = c("skyblue", "skyblue1", "skyblue2", "royalblue"))

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

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,50),
     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	1	4.000000	NA	4.00	4.00
Asian	2	9.500000	2.121320	8.75	10.25
Black or African American	214	7.887850	2.976676	6.00	10.00
White	61	8.213115	3.286917	6.00	11.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	228	7.842105	3.053355	6	10.00
Male	50	8.480000	2.970879	6	10.75

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.
1	6	8	7.956835	10	16

The “Distribution of White Total Scores” shows that White Families score a 5 and 8 most often within their group, while the “Distribution of Persons of Color Total Scores” shows that Families of Color score a 5 and a 7 most often.

The distribution of the White Scores appear have a higher density for scores above 12. As well, it appears that total scores are more equally distribution among families of color.

For the “Distribution of Male Total Scores”, it appears the most common scores are 5 and 8, compared to 5 and 6 for females.

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,.25),
     las = 1,
     breaks = seq(from = 0,  to = 17, by = 1),
     xaxt = 'n',
     freq = FALSE)
abline(h = .1)
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,.25),
     las = 1,
     breaks = seq(from = 0,  to = 17, by = 1),
     xaxt = 'n',     
     freq = FALSE)
abline(h = .1)
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,.25),
     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 = .1)

hist(female.total,
     main = "Distribution of Female Total Scores",
     xlab = "Total Score",
     ylab = "Density",
     col = "red",
     ylim = c(0,.25),
     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 = .1)

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
-0.7033398	89.50397	0.4836696

Conclusion

Since p > 0.05, we do not have sufficient evidence to suggest that the mean total score is different between Whites and People of Color. That is, it appears that at least 95% of the time, there is no significant difference in scores between races.

### 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)	7.8847926	0.2067594	38.1351160	0.0000000
df$grp.race	0.3283221	0.4413902	0.7438365	0.4576082

Conclusion

Since p > 0.05, we do not have sufficient evidence to suggest that race is a predictor of total score. That is, there does not appear 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.32 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(below8 = nrow(subset(df, df$Score.Total<8 & df$grp.race == 0)),
           Above8 = nrow(subset(df, df$Score.Total>=8 & df$grp.race == 0)))

y2 <- cbind(below8 = nrow(subset(df, df$Score.Total<8 & df$grp.race == 1)),
           Above8 = nrow(subset(df, df$Score.Total>=8 & 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	15	87	115
White	2	28	31

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. We can see that one of the category has a total of 2, making the Chi-test less ideal. However, the below Chi-Test results indicate that the two categorical factors of race and housing placement are independent.

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

Chi-Squared Test
X-squared	df	pvalue
1.459534	2	0.4820213

Fisher’s Test to Test for Independence

To get a more accurate test of independence, the housing priority categories are changed to the following: Scores Below 8 and Scores above 8. As well, to compensate for the small sample size, a Fisher’s Test is performed instead of the Chi Test.

Total Score Summary Table
	below8	Above8
People of Color	102	115
White	30	31

As can be seen in the below table, the p value is greater than 0.05, and suggests that Race and Prioritization are independent.

Fisher Test
pvalue	odds ratio
0.7737101	0.91681

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
0.0903885	1	0.7636838

Conclusion

Since p > 0.05, we do not have sufficient evidence 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.6625558	1	0.4156591

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.0871695	0.2899844	0.763719	0.9165217	0.5191676	1.617998

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 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 .91 times more likely than People of Color to have a higher score. That is, Whites are less likely than People of Color to have a higher prioritization score, however, this is not significant. ## 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.2373233	0.291897	0.4161965	1.267851	0.7154923	2.246629

Conclusion

Here, the df$grp.race has People of Color as the Reference Group. So, for the Odds Ratio, Whites are 1.26 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.0406920	0.0730987	0.5782081	0.9601248	0.8319667	1.108025
Gender*	0.1389178	0.0792984	0.0809250	1.1490296	0.9836311	1.342240
Age	-0.0007772	0.0031059	0.8025949	0.9992231	0.9931589	1.005324
Ethnicity	0.2629008	0.2279504	0.2497860	1.3006977	0.8320408	2.033331

Conclusion

When comparing factors that predict a score of 8 or above, we find that Race, Age, and Ethnicity are not significant predictors. Gender is a significant predictor at the 0.10 level, but not the o.05 level, which is more common standard for significance.

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

In this section, logistic regression was performed on the subscales of the F-SPDAT. Each individual question was coded according to the F-SPDAT 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 7 Modifications
data$Q7 %>%
  gsub(pattern = "Greater than 10",
       replacement = 11) %>%
  gsub(pattern = "Refused", replacement = 0) -> data$Q7 
data$Q7 <- as.numeric(data$Q7)


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

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


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

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

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

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

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

data$consecutive.homeless.4plus <- ifelse(data$Q6 == "One year or more" | 
                                            data$Q7 >= 4, 1, 0)
# B. Risks
data$emergency.service <- ifelse((data$Q8a + data$Q8b + data$Q8c + data$Q8d + data$Q8e + data$Q8f) >= 4 , 1, 0)

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

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

data$exploitation <- ifelse(data$Q12 == "Yes" | data$Q13 == "Yes", 1, 0)

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

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

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

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

# D. Wellness

data$physical.health <- ifelse(data$Q19 == "Yes"|
                                 data$Q20 == "Yes" |
                                 data$Q21 == "Yes" |
                                 data$Q22 == "Yes" |
                                 data$Q23 == "Yes", 1, 0)

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

data$mental.health <- ifelse(data$Q26a == "Yes" | data$Q26b == "Yes" |
                               data$Q26c == "Yes" | data$Q27 == "Yes", 1, 0)

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

data$medication <- ifelse(data$Q29 == "Yes" | data$Q30 == "Yes", 1, 0)

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

# E. Family Unit

data$family.legal <- ifelse(data$Q32 == "Yes" | data$Q33 == "Yes", 1, 0)

data$needs.of.children <- ifelse(data$Q34 == "Yes" | data$Q35 == "Yes" | data$Q36 == "No",1,0)

data$family.stability <- ifelse(data$Q37 == "Yes" | data$Q38 == "Yes", 1, 0)

data$parental.engagement <- ifelse(data$Q39 == "No" | data$Q40a == "Yes" | 
                                     data$Q40b == "Yes" | data$Q41 == "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))

# E. Family Unit
family.legal.m <-glm(data$family.legal ~ data$grp.race, family = binomial)
family.legal.sum <- summary(family.legal.m)

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

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

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

# 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)))

# E. Family Unit
family.legal.OR <- exp(cbind(OR = coef(family.legal.m), confint.default(family.legal.m)))

needs.of.children.OR <- exp(cbind(OR = coef(needs.of.children.m), confint.default(needs.of.children.m)))

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

parental.engagement.OR <- exp(cbind(OR = coef(parental.engagement.m), 
                                    confint.default(parental.engagement.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],
           family.legal.sum$coefficients[2,-3],
           needs.of.children.sum$coefficients[2,-3],
           family.stability.sum$coefficients[2,-3],
           parental.engagement.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",
"Family Legal Issues",
"Needs of Children",
"Family Stability",
"Parental Engagement")


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,],
      family.legal.OR[-1,],
      needs.of.children.OR[-1,],
      family.stability.OR[-1,],
      parental.engagement.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.0755076	0.2951580	0.7980892	0.9272727	0.5199583	1.653661
Consecutive Homeless	0.0658092	0.2927637	0.8221458	1.0680229	0.6016994	1.895752
Emergency Service	0.3417106	0.2916731	0.2413765	1.4073529	0.7945668	2.492732
Risk of Harm	0.4236752	0.2965919	0.1531542	1.5275654	0.8541621	2.731866
Legal Issues	0.2094348	0.3211945	0.5143691	1.2329810	0.6569845	2.313969
Risk of Exploitation	-0.0884686	0.3349619	0.7916909	0.9153318	0.4747429	1.764813
Money Managment	0.4306777	0.3132918	0.1692290	1.5382997	0.8324660	2.842598
Meaningful Activity	-0.2509087	0.3199002	0.4328440	0.7780934	0.4156543	1.456570
Self Care	0.1428860	0.3682986	0.6980439	1.1535983	0.5604776	2.374384
Social Relationship	-0.1611193	0.2914495	0.5803862	0.8511905	0.4807779	1.506985
Physical Health*	0.5473957	0.2928351	0.0615816	1.7287449	0.9737988	3.068970
Substance Use***	1.0966814	0.3979159	0.0058502	2.9942130	1.3727013	6.531145
Mental Health**	0.8350724	0.3528795	0.0179595	2.3049808	1.1542391	4.602978
Tri-Morbidity*	1.7156601	0.9247756	0.0635651	5.5603448	0.9076769	34.062160
Medications*	0.5476013	0.3232293	0.0902354	1.7291005	0.9176708	3.258018
Abuse and Trauma	-0.4618340	0.2911721	0.1127121	0.6301270	0.3561081	1.114998
Family Legal Issues	-0.5243930	0.5622941	0.3510289	0.5919146	0.1966226	1.781905
Needs of Children	-0.4536398	0.2912952	0.1193945	0.6353115	0.3589515	1.124443
Family Stability	0.2339378	0.3216593	0.4670518	1.2635659	0.6726683	2.373531
Parental Engagement	-0.2181725	0.2917754	0.4546162	0.8039867	0.4538258	1.424323

*p<0.1

**p < 0.05

***p < 0.01

Female is reference group

People of Color is Reference Group

Conclusion

For families (receiving any prioritization score), race was a predictor of endorsing 2 of the 20 subscales at the 0.05 level and 3 of the 20 subscales at the 0.10 level. Whites were more likely to endorse these subscales, which included:

Substance Use**
Mental Health**
Physical Health*
Tri-Morbidity*
Medications*

This would imply that 0 of the 20 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",
"Family Legal Issues",
"Needs of Children",
"Family Stability",
"Parental Engagement")



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,6))
abline(h = 1)
axis(side=2, at=seq(from = 0, to = 6, by = .5), las = 1, labels = TRUE)
text(cex=.8, x=colMeans(t(x))-.25, y = -.5, rownames(y), xpd=TRUE, srt=40)
mtext(side=1, line=4, "Subscales", cex=1)

grid(nx = 0, ny = 6, 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,6))
abline(h = 1)
axis(side=2, at=seq(from = 0, to = 6, by = .5), las = 1, labels = TRUE)
text(cex=.8, x=colMeans(t(x))-.25, y = -.5, rownames(y), xpd=TRUE, srt=40)
mtext(side=1, line=4, "Subscales", cex=1)

Logistic Regression Analysis: F-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 F-SPDAT subscale in predicting a recommendation of PSH/Housing or score greater than 8.

7 of the subscales are predictive(i.e., those that have higher odds ratios) of a score above 8. Per group, 6 of the subscales had a higher odds ratio for Whites, compared to the 1 for POC. 3 scales were inconclusive.

# Logistic Regression Analysis: F-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)))


# E. Family Unit
family.unit.m <- glm(black$priority ~ black$family.legal + 
                    black$needs.of.children +
                    black$family.stability + 
                    black$parental.engagement, family = binomial)

family.unit.sum <- summary(family.unit.m)

family.unit.OR <- exp(cbind(OR = coef(family.unit.m), confint.default(family.unit.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],
      family.unit.sum$coefficients[c(2:5), -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",
"Family Legal Issues",
"Needs of Children",
"Family Stability",
"Parental Engagement")

options(scipen = 10)

b.OR <- rbind(housing.history.OR[-1,],
              risk.OR[-1,],
              social.daily.funct.OR[-1,],
              wellness.OR[-1,],
              family.unit.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)))

# E. Family Unit
w.family.unit.m <- glm(white$priority ~ white$family.legal + 
                    white$needs.of.children +
                    white$family.stability + 
                    white$parental.engagement, family = binomial)
w.family.unit.sum <- summary(w.family.unit.m)
w.family.unit.OR <- exp(cbind(OR = coef(w.family.unit.m), confint.default(w.family.unit.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.family.unit.sum$coefficients[c(2:5), -3])

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

# ------------------
# NOT UPDATED FOR FAMILY E. FAMILY UNIT
#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
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 = "")
subscale.display[18,3] <- paste(subscale.display[18,3], "***", sep = "")
subscale.display[19,3] <- paste(subscale.display[19,3], "**", sep = "")
subscale.display[20,3] <- paste(subscale.display[20,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[18,9] <- paste(subscale.display[18,9], "***", sep = "")
subscale.display[20,9] <- paste(subscale.display[20,9], "***", sep = "")


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

Logistic Regression Analysis: F-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.724	0.315	0***	5.6086	3.0237	10.4034	1.036	0.545	0.058*	2.8179	0.9675	8.2072
Consecutive Homeless	0.881	0.307	0.004***	2.4126	1.3217	4.4038	0.612	0.541	0.258	1.8443	0.6388	5.3245
Emergency Service	1.722	0.392	0***	5.5983	2.5978	12.0642	0.021	0.878	0.981	1.0207	0.1825	5.7093
Risk of Harm	1.015	0.412	0.014**	2.7594	1.2314	6.1832	3.796	0.969	0***	44.5088	6.6682	297.0848
Legal Issues	1.101	0.408	0.007***	3.0081	1.3534	6.686	1.933	0.961	0.044**	6.9136	1.0514	45.4611
Risk of Exploitation	3.747	0.769	0***	42.407	9.4011	191.2926	2.186	1.297	0.092*	8.8987	0.6998	113.1564
Money Managment	0.277	0.306	0.366	1.3191	0.7236	2.4046	1.782	0.88	0.043**	5.9447	1.0601	33.3365
Meaningful Activity	0.869	0.328	0.008***	2.3845	1.2546	4.532	-0.829	0.794	0.296	0.4365	0.0921	2.0692
Self Care	1.645	0.483	0.001***	5.1824	2.011	13.3553	3.184	1.184	0.007***	24.1326	2.3683	245.9106
Social Relationship	0.952	0.303	0.002***	2.5913	1.4302	4.6951	2.489	0.742	0.001***	12.0536	2.8173	51.5699
Physical Health	-0.035	0.357	0.921	0.9654	0.4794	1.9442	1.159	0.714	0.104	3.1874	0.7867	12.9144
Substance Use	0.881	0.681	0.196	2.4134	0.6357	9.1625	1.926	1.086	0.076*	6.8623	0.816	57.7099
Mental Health	2.729	0.827	0.001***	15.3184	3.0293	77.4606	0.658	0.861	0.445	1.9305	0.3573	10.4298
Tri-Morbidity	11.44	1013.843	0.991	92946.7161	0	Inf	13.375	2206.064	0.995	643913.5441	0	Inf
Medications	2.712	0.615	0***	15.0643	4.5124	50.2913	1.236	0.817	0.13	3.4419	0.6944	17.0611
Abuse and Trauma	2.004	0.375	0***	7.4223	3.5563	15.4911	2.209	0.782	0.005***	9.1052	1.9652	42.1858
Family Legal Issues	0.9	0.571	0.114	2.4607	0.8043	7.5283	-1.27	1.504	0.398	0.2807	0.0147	5.3486
Needs of Children	1.801	0.33	0***	6.0548	3.1725	11.5559	1.839	0.665	0.006***	6.292	1.7078	23.1814
Family Stability	0.852	0.384	0.026**	2.3442	1.1049	4.9739	0.049	0.7	0.945	1.0497	0.2664	4.1366
Parental Engagement	1.287	0.334	0***	3.6227	1.8822	6.9725	2.057	0.665	0.002***	7.8227	2.1267	28.7738

*p < 0.1

**p < 0.05

***p<0.01

Female is reference Group

Conclusion

OR.barplot.table <- cbind(b.OR[c(-4,-6,-14),1], w.OR[c(-4,-6,-14),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***",
"Family Legal Issues",
"Needs of Children***",
"Family Stability",
"Parental Engagement***")

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 = "F-SPDAT Subscales as Predictors of High Vulnerability Scores: By Race",
        ylim = c(0,25))
axis(side=2, at=seq(from = 0, to = 25, by = 1), las = 1, labels = TRUE)
text(cex=.9, x=colMeans(x)-.25, y=-1.85, rownames(OR.barplot.table), xpd=TRUE, srt=35)
mtext(side=1, line=4, "Subscales", cex=1)

grid(nx = 0, ny = 25, 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 = "F-SPDAT Subscales as Predictors of High Vulnerability Scores: By Race",
        ylim = c(0,25), add = TRUE)
axis(side=2, at=seq(from = 0, to = 25, by = 1), las = 1, labels = TRUE)
text(cex=.9, x=colMeans(x)-.25, y=-1.85, rownames(OR.barplot.table), xpd=TRUE, srt=35)
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 subscales that were most discordant (and statistically significant predictors of a high score for both racial groups)

Where do you and your family sleep most frequently? If the person answers anything other than “shelter”, “transitional housing”, or “safe haven,” then score 1. [OR = 2.82 White; OR=5.61 POC.]
Do you or anyone in your family have any legal stuff going on right now that may result in them being locked up, having to pay fines, or that make it more difficult to rent a place to live? IF “YES”, THEN SCORE 1 FOR LEGAL ISSUES. [OR = 6.91 White; OR=3.00 POC.]
Is everyone in your family currently able to take care of basic needs like bathing, changing clothes, using a restroom getting food and clean water and other things like that? If “no,” then score 1 for self-care. [OR=24.13 White; OR=5.18 POC.]
Is your family’s current homelessness in any way caused by a relationship that broke down, an unhealthy or abusive relationship, or because other family or friends caused your family to become evicted? IF “YES” THEN SCORE 1 FOR SOCIAL RELATIONSHIPS. [OR=12.1 White; OR=2.59 POC.]
Has your family’s current period of homelessness been caused by an experience of emotional, physical, psychological, sexual, or other type of abuse, or by any other trauma you or anyone in your family have experienced? IF “YES”, SCORE 1 FOR ABUSE AND TRAUMA. [OR=9.11 White; OR=7.42 POC.]
39: Do you have two or more planned activities each week as a family such as outings to the park, going to the library, visiting other family, watching a family movie, or anything like that? 40: After school, or on weekends or days when there isn’t school, is the total time children spend each day where there is no interaction with you or another responsible adult… a) 3 or more hours per day for children aged 13 or older? b) 2 or more hours per day for children aged 12 or younger? 41: IF THERE ARE CHILDREN BOTH 12 AND UNDER & 13 AND OVER: Do your older kids spend 2 or more hours on a typical day helping their younger sibling(s) with things like getting ready for school, helping with homework, making them dinner, bathing them, or anything like that? IF “NO” TO QUESTION 39, OR “YES” TO ANY OF QUESTIONS 40 OR 41, SCORE 1 FOR PARENTAL ENGAGEMENT. [OR=7.82 White; OR=3.62 POC.]

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),
  table(data$family.legal),
  table(data$needs.of.children),
  table(data$family.stability),
  table(data$parental.engagement))

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),
  table(white$family.legal),
  table(white$needs.of.children),
  table(white$family.stability),
  table(white$parental.engagement))

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),
  table(black$family.legal),
  table(black$needs.of.children),
  table(black$family.stability),
  table(black$parental.engagement))


x <- cbind(t,w,b)
colnames(x) <- c("Total No","Total Yes","White No", "White Yes", "POC No", "POC Yes")
row.names(x) <- 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",
  "Family Legal Issues",
  "Needs of Children",
  "Family Stability",
  "Parental Engagement")

kable(x, caption = "F-SPDAT Subscale Endorsement by Race")

F-SPDAT Subscale Endorsement by Race
	Total No	Total Yes	White No	White Yes	POC No	POC Yes
Outside/Other	110	168	25	36	85	132
Consecutive Homeless	122	156	26	35	96	121
Emergency Service	164	114	32	29	132	85
Risk of Harm	181	97	35	26	146	71
Legal Issues	205	73	43	18	162	55
Risk of Exploitation	206	72	46	15	160	57
Money Managment	103	175	18	43	85	132
Meaningful Activity	189	89	44	17	145	72
Self Care	228	50	49	12	179	38
Social Relationship	119	159	28	33	91	126
Physical Health	148	130	26	35	122	95
Substance Use	247	31	48	13	199	18
Mental Health	233	45	45	16	188	29
Tri-Morbidity	273	5	58	3	215	2
Medications	214	64	42	19	172	45
Abuse and Trauma	121	157	32	29	89	128
Family Legal Issues	251	27	57	4	194	23
Needs of Children	117	161	31	30	86	131
Family Stability	206	72	43	18	163	54
Parental Engagement	116	162	28	33	88	129

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

Q5
	American Indian or Alaska Native	Asian	Black or African American	White
Other (Specify)	0	0	13	2
Outdoors	0	2	116	34
Refused	0	0	1	0
Safe Haven	0	0	1	1
Shelters	1	0	81	24
Transitional Housing	0	0	2	0

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

Q6
	American Indian or Alaska Native	Asian	Black or African American	White
Less than 1 year	1	0	103	27
One year or more	0	2	111	34

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

Q7
	American Indian or Alaska Native	Asian	Black or African American	White
0	0	0	6	2
1	1	0	107	29
10	0	0	1	1
2	0	0	46	15
3	0	0	12	6
4	0	0	10	2
5	0	0	0	1
6	0	0	1	1
7	0	0	1	2
Greater than 10	0	2	30	2

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

Q8a
	American Indian or Alaska Native	Asian	Black or African American	White
0	1	1	77	21
1	0	0	50	8
2	0	0	31	10
3	0	1	18	6
4	0	0	16	6
5	0	0	10	4
6	0	0	2	3
7	0	0	1	0
8	0	0	1	0
Greater than 10	0	0	8	3

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

Q8b
	American Indian or Alaska Native	Asian	Black or African American	White
0	1	1	158	45
1	0	0	26	12
2	0	1	12	2
3	0	0	6	1
4	0	0	4	0
5	0	0	2	1
6	0	0	1	0
8	0	0	2	0
Greater than 10	0	0	3	0

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

Q8c
	American Indian or Alaska Native	Asian	Black or African American	White
0	1	2	145	40
1	0	0	42	13
2	0	0	11	4
3	0	0	6	2
4	0	0	5	2
5	0	0	1	0
6	0	0	2	0
7	0	0	1	0
10	0	0	1	0

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

Q8d
	American Indian or Alaska Native	Asian	Black or African American	White
0	1	2	178	54
1	0	0	22	6
2	0	0	2	1
3	0	0	2	0
4	0	0	4	0
5	0	0	3	0
7	0	0	1	0
Greater than 10	0	0	2	0

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

Q8e
	American Indian or Alaska Native	Asian	Black or African American	White
0	1	0	152	37
1	0	0	29	8
10	0	0	0	1
2	0	1	11	4
3	0	0	6	2
4	0	1	8	0
5	0	0	2	2
6	0	0	1	3
7	0	0	2	2
Greater than 10	0	0	3	2

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

Q8f
	American Indian or Alaska Native	Asian	Black or African American	White
0	1	2	193	56
1	0	0	16	3
2	0	0	4	2
4	0	0	1	0

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

Q9
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	160	39
Yes	0	0	54	22

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

Q10
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	185	50
Yes	0	0	29	11

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

Q11
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	1	161	43
Yes	1	1	53	18

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

Q12
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	190	57
Refused	0	0	1	0
Yes	0	0	23	4

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

Q13
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	0	167	46
Yes	0	2	47	15

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

Q14
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	141	49
Yes	0	1	73	12

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

Q15
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	0	82	36
Yes	0	2	132	25

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

Q16
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	1	71	17
Yes	1	1	143	44

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

Q17
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	1	37	12
Yes	1	1	177	49

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

Q18
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	0	89	28
Refused	0	0	1	0
Yes	0	2	124	33

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

Q19
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	198	57
Yes	0	0	16	4

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

Q20
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	166	40
Refused	0	0	1	0
Yes	0	0	47	21

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

Q21
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	196	58
Refused	0	0	2	0
Yes	0	0	16	3

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

Q22
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	197	59
Yes	0	0	17	2

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

Q23
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	181	44
Yes	0	0	33	17

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

Q24
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	201	52
Yes	0	1	13	9

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

Q25
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	208	56
Yes	0	0	6	5

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

Q26a
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	203	55
Yes	0	0	11	6

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

Q26b
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	212	55
Yes	0	0	2	6

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

Q26c
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	200	57
Yes	0	0	14	4

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

Q27
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	201	59
Refused	0	0	1	0
Yes	0	0	12	2

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

Q28
	American Indian or Alaska Native	Asian	Black or African American	White
N/A or Refused	1	0	79	21
No	0	1	119	28
Yes	0	1	16	12

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

Q29
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	171	42
Yes	0	0	43	19

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

Q30
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	207	60
Yes	0	0	7	1

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

Q31
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	87	32
Yes	0	1	127	29

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

Q32
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	204	59
Refused	0	0	0	1
Yes	0	0	10	1

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

Q33
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	2	194	57
Refused	0	0	1	1
Yes	1	0	19	3

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

Q34
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	122	41
Refused	0	0	0	1
Yes	0	0	92	19

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

Q35
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	189	58
Refused	0	0	0	1
Yes	0	0	25	2

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

Q36
	American Indian or Alaska Native	Asian	Black or African American	White
N/A or Refused	0	0	32	24
No	0	1	36	13
Yes	1	1	146	24

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

Q37
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	190	53
Refused	0	0	0	1
Yes	0	0	24	7

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

Q38
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	174	47
Refused	0	0	0	1
Yes	0	0	40	13

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

Q39
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	2	57	26
Refused	0	0	1	1
Yes	1	0	156	34

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

Q40a
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	182	53
Refused	0	0	4	5
Yes	0	0	28	3

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

Q40b
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	179	54
Refused	0	0	5	5
Yes	0	1	30	2

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

Q41
	American Indian or Alaska Native	Asian	Black or African American	White
N/A or Refused	0	0	87	24
No	1	1	73	29
Yes	0	1	54	8

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

Referral Rank
	American Indian or Alaska Native	Asian	Black or African American	White
0	0	0	1	0
1	0	0	0	1
2	0	2	103	21
3	0	0	49	12
4	0	0	10	2
5	0	0	33	18
Missing Info	1	0	18	7

F-SPDAT

1/1/2018 - 9/22/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

Fisher’s Test to Test for Independence

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: F-SPDAT Subscales Predicting a High Score (8+) among White and BIPOC

Conclusion

Additional Tables