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

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

df <- read.csv("2016.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 the “Mean Score by Race” boxplot, we notice that Blacks or African American clients have a smaller inner group variation and slightly lower mean when compared to White counter parts. The graph “Mean Score by Gender” shows that clients that identify as male have the largest range of values. Trans Females, Trans Male and Gender Non Conforming appear to have a higher mean score compared to Male and Female. The “Age vs Score Total” scatter plot doesn’t appear to show a linear trend, so no clear correlation appears with age and score total. The “Distribution of Score Totals” appears to be slightly skewed right, with a center appearing to be about 6.

par(mfrow = c(2,2))
boxplot(df$Score.Total ~ df$Race,
        main = "Mean Score by Race (Chart 1)",
        xlab = "Race",
        ylab = "Mean Total Score",
        col = c("blue","lightblue","cadetblue", "skyblue"))
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',
     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	8.000000	NA	8	8
Asian	2	13.000000	2.828427	12	14
Black or African American	268	6.533582	2.611339	5	8
White	86	7.116279	3.152659	5	9

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	153	6.267974	2.541774	4.0	8.00
Male	187	6.983957	2.988285	5.0	9.00
Non-Comforming	2	8.000000	1.414214	7.5	8.50
Trans Female	8	8.000000	1.927248	6.0	9.25
Trans Male	7	7.428571	2.636737	5.5	9.00

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	5	6	6.714286	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. “Distribution of White Total Scores” show a higher density of values score totals greater than 11 compared to the density seen in the “Distribution of Black/ African American Total Scores”. Density, in this case, can be seen as the decimal percentage of frequency. Or, density is the frequency/number of occurrence divided by the total number of scores.

Likewise, males seem to have a higher density of scores greater than 12, with females having a higher density at the 10, 11, and 12 score total.

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 = "skyblue",
     ylim = c(0,.2),
     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))

hist(poc.total,
     main = "Distribution of Persons of Color Total Scores",
     xlab = "Total Score",
     ylab = "Density",
     col = "cadetblue",
     ylim = c(0,.2),
     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))

hist(male.total,
     main = "Distribution of Male Total Scores",
     xlab = "Total Score",
     ylab = "Density",
     col = "blue",
     ylim = c(0,.2),
     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))

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

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
-1.406667	125.7962	0.1619918

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)	6.5867159	0.1693330	38.89801	0.0000000
df$grp.race	0.5295632	0.3450058	1.53494	0.1256893

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.5295 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. While Birmingham only has RRH for youth, this will still help to determine if race is a dependent factor on scoring on the TAYVISPDAT.

Total Score Summary Table
	NonPriority	FourtoEight	AboveEight
People of Color	34	146	91
White	8	47	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 8, while meeting the requirement of having greater than 5 participants in a group, this could still make the Chi-test less ideal. However, the below Chi-Test results indicate that the two categorical factors of race and housing placement are independent.

Chi-Squared Test
X-squared	df	pvalue
0.7074482	2	0.7020687

Fisher’s Test to Test for Independence

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

Total Score Summary Table
	NonPriority	Priority
People of Color	34	237
White	8	78

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.5643328	1.397549

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.1766479	1	0.67427

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.0158546	1	0.899799

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.1087514	0.2588135	0.6743452	1.114885	0.671317	1.851538

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 1.11 times more likely than People of Color to have a higher score. In other words, both races have the same odds of receiving higher scores.

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.0312931	0.2485287	0.8998005	1.031788	0.6339316	1.679339

Conclusion

Here, the df$grp.race has People of Color as the Reference Group. So, for the Odds Ratio, Whites are 1.03 times more likely than People of Color to have a higher score. In other words, both races have the same odds of receiving higher scores.

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.0040419	0.0589399	0.9453649	1.004050	0.8945110	1.127003
Gender	0.0738658	0.0499987	0.1404750	1.076662	0.9761589	1.187513
Age**	0.0309481	0.0134397	0.0218769	1.031432	1.0046173	1.058962
Ethnicity***	0.5639359	0.1959128	0.0042397	1.757577	1.1971622	2.580332

Conclusion

When comparing multiple factors in determining risk for a High Score of greater than 8, Race and Gender do not appear to be significant contributors. Age and Ethnicity, however, appear to be significant in predicting risk for a higher score. While Ethnicity might be significant, the limited sample size might be skewing that conclusion.

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.

As Age increases by one year, we would expect the score to raise approximately 0.03 points. Per one unit increase, a person is 1.03 times more likely to have a higher score, or, someone who is 20 is 1.03 times more likely to have a higher score than a 19 year old.

A person identifying as Hispanic/Latino would expect a score approximately 0.56 points higher. A person identifying as Hispanic/Latino is 1.75 times more likely to have a higher score than those who don’t identify as Hispanic or Latino.

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

In this section, logistic regression was performed on the subscales of the TAYVISPDAT. Each individual question was coded according to the TAYVISDAT 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
# Quest 4 Modifications
# 4a
data$Q4a %>%
  gsub(pattern = "Greater than 10",
       replacement = 11) -> data$Q4a 
data$Q4a <- as.numeric(data$Q4a)

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

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

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

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

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

# Coding into 1/0 per TAYVISPDAT 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 | 
                                            data$Q3 == "Greater than 10", 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" | data$Q8 == "Yes", 1, 0)

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

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

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

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

data$social.relation <- ifelse(data$Q15a == "Yes" | data$Q15b == "Yes" | data$Q15c == "Yes" |
                                 data$Q15d == "Yes", 1, 0)

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

# D. Wellness

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

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

data$mental.health <- ifelse(data$Q25a == "Yes" | data$Q25b == "Yes" |
                               data$Q25c == "Yes" | data$Q26 == "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$Q27 == "Yes" | data$Q28 == "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))

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


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


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

abuse.trauma.OR <- exp(cbind(OR = coef(abuse.trauma.m), confint.default(abuse.trauma.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)))



# 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],
           abuse.trauma.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])

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***")


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,],
      abuse.trauma.OR[-1,],
      physical.health.OR[-1,],
      substance.use.OR[-1,],
      mental.health.OR[-1,],
      tri.morbidity.OR[-1,],
      medication.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.3339472	0.2491101	0.1800631	0.7160916	0.4394664	1.166840
Consecutive Homeless	0.0164349	0.2485647	0.9472828	1.0165707	0.6245381	1.654689
Emergency Service*	0.4462690	0.2514073	0.0758841	1.5624717	0.9545834	2.557469
Risk of Harm	0.3805125	0.2494311	0.1271291	1.4630342	0.8973014	2.385452
Legal Issues**	0.5756084	0.2519317	0.0223258	1.7782120	1.0852727	2.913588
Risk of Exploitation	0.2583650	0.2569028	0.3145640	1.2948113	0.7825830	2.142311
Money Managment*	0.5379910	0.3156979	0.0883564	1.7125628	0.9224100	3.179575
Meaningful Activity	-0.3644010	0.2572955	0.1566952	0.6946126	0.4195003	1.150146
Self Care	-0.5743065	0.3560199	0.1067162	0.5630952	0.2802445	1.131427
Social Relationship	-0.2969008	0.2611043	0.2554979	0.7431177	0.4454564	1.239681
Abuse and Trauma	-0.1534052	0.2478806	0.5360036	0.8577820	0.5276921	1.394355
Physical Health	-0.3827332	0.2603274	0.1415077	0.6819948	0.4094397	1.135984
Substance Use***	0.8387223	0.2628554	0.0014187	2.3134092	1.3820048	3.872535
Mental Health	0.4575942	0.2986421	0.1254610	1.5802676	0.8800877	2.837496
Tri-Morbidity***	1.3429717	0.4775831	0.0049232	3.8304094	1.5021928	9.767079
Medications***	0.9628916	0.2725682	0.0004114	2.6192593	1.5352109	4.468780

*p < 0.10

**p < 0.05

***p < 0.01

Female is reference group

People of Color is Reference Group

Conclusion

For youth (receiving any prioritization score), race was a predictor of endorsing 4 of the 16 subscales. Whites were more likely to endorse all 4 subscales, which included:

Legal Issues
Substance Use
Tri-Morbidity
Medications

This would imply that 0 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",
"Abuse and Trauma",
"Physical Health",
"Substance Use***",                
"Mental Health",
"Tri-Morbidity***",
"Medications***")



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,4))
abline(h = 1)
axis(side=2, at=seq(from = 0, to = 4, by = .5), las = 1, labels = TRUE)
text(cex=.8, x=colMeans(t(x))-.25, y = -.35, rownames(y), xpd=TRUE, srt=45)
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,4))
abline(h = 1)
axis(side=2, at=seq(from = 0, to = 4, by = .5), las = 1, labels = TRUE)
text(cex=.8, x=colMeans(t(x))-.25, y = -.35, rownames(y), xpd=TRUE, srt=45)
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 our divided about equally (i.e., those that have higher odds ratios) of a score above 8 for White than they are for POC. Of 16 subscales, Whites had higher odds ratio for 8 of the scales, POC had higher odds ratio for 7 of the scales, 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 + black$abuse.trauma, 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, 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:6),-3],
              wellness.sum$coefficients[c(2:6),-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",
  "Abuse and Trauma",
  "Physical Health",
  "Substance Use",                
  "Mental Health",
  "Tri-Morbidity",
  "Medications")

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,8), 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 + 
                                white$abuse.trauma, 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, 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:6),-3],
               w.wellness.sum$coefficients[c(2:6),-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,6), round(w.OR,4))

# 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[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[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[4,9] <- paste(subscale.display[4,9], "***", sep = "")
subscale.display[6,9] <- paste(subscale.display[6,9], "***", sep = "")
subscale.display[7,9] <- paste(subscale.display[7,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[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	0.8214958	0.30026282	0.00622057***	2.2739	1.2624	4.096	1.340326	0.505071	0.007961***	3.8203	1.4196	10.2805
Consecutive Homeless	1.37179468	0.29612497	0.00000361***	3.9424	2.2065	7.0441	0.577539	0.498169	0.246324	1.7816	0.6711	4.73
Emergency Service	0.38173108	0.367051	0.29834239	1.4648	0.7134	3.0076	-0.434627	0.668005	0.515282	0.6475	0.1748	2.398
Risk of Harm	1.98902238	0.37113444	0.00000008***	7.3084	3.5311	15.1263	1.894162	0.677505	0.005177***	6.647	1.7617	25.0794
Legal Issues	1.96609225	0.37570018	0.00000017***	7.1427	3.4203	14.9162	0.777779	0.649528	0.23113	2.1766	0.6094	7.7744
Risk of Exploitation	1.84035663	0.35781258	0.00000027***	6.2988	3.1238	12.7007	3.031957	0.67053	0.000006***	20.7378	5.5719	77.1825
Money Managment	1.05508547	0.38349473	0.00593704***	2.8722	1.3545	6.0904	2.136556	1.111987	0.054683*	8.4702	0.958	74.8892
Meaningful Activity	0.63346564	0.31154239	0.04202011**	1.8841	1.0231	3.4697	0.772118	0.581701	0.184394	2.1643	0.6921	6.7682
Self Care	1.60652474	0.3869355	0.00003297***	4.9855	2.3353	10.643	1.661464	0.801776	0.038244**	5.267	1.0942	25.3535
Social Relationship	0.72513267	0.38926449	0.06248651*	2.065	0.9629	4.4286	1.186841	0.662583	0.073256*	3.2767	0.8942	12.0069
Abuse and Trauma	1.88864158	0.35979816	0.00000015***	6.6104	3.2656	13.381	1.17973	0.592413	0.046437**	3.2535	1.0188	10.3899
Physical Health	1.31399436	0.39527445	0.00088654***	3.721	1.7148	8.0746	2.000687	0.826581	0.015502**	7.3941	1.4632	37.3658
Substance Use	1.72314823	0.36267057	0.00000202***	5.6021	2.752	11.4041	1.733041	0.65243	0.007901***	5.6578	1.5751	20.3235
Mental Health	1.40142731	0.41407516	0.00071314***	4.061	1.8037	9.1431	1.674727	0.923571	0.069783*	5.3373	0.8733	32.619
Tri-Morbidity	14.08787118	724.76614443	0.98449184	1313060.4407	0	Inf	16.012076	1970.745951	0.993517	8994067.4049	0	Inf
Medications	1.84787688	0.39754846	0.00000335***	6.3463	2.9116	13.833	1.590187	0.654018	0.01504**	4.9047	1.3612	17.673

*p < .10

**p < 0.05

***p<0.01

Female is reference Group

Conclusion

OR.barplot.table <- cbind(b.OR[-15,1], w.OR[-15,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*",
  "Abuse and Trauma**",
  "Physical Health**",
  "Substance Use***",
  "Mental Health*",
  "Medications**")
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 = "TAY VI-SPDAT Subscales as Predictors of High Vulnerability Scores: By Race",
        ylim = c(0,22))
axis(side=2, at=seq(from = 0, to = 25, by = 1), las = 1, labels = TRUE)
text(cex=1, x=colMeans(x)-.25, y=-1.75, rownames(OR.barplot.table), xpd=TRUE, srt=30)
mtext(side=1, line=4, "Subscales", cex=1)

grid(nx = 0, ny = 22, 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 = "TAY 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 = 25, by = 1), las = 1, labels = TRUE)
text(cex=1, x=colMeans(x)-.25, y=-1.75, 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 youth dataset, we identified the six 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 = 3.82 White; OR=2.27 POC.]
Does anybody force or trick you to do things that you do not want to do? Do you ever do things that may be considered to be risky like exchange sex for money, food, drugs, or a place to stay, run drugs for someone, have unprotected sex with someone you don’t know, share a needle, or anything like that? IF “YES” TO ANY OF THE ABOVE, THEN SCORE 1 FOR RISK OF EXPLOITATION.[OR = 20.73 White; OR=6.29 POC.]
11:Is there any person, past landlord, business, bookie, dealer, or government group like the IRS that thinks you owe them money? 12: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 11 OR “NO” TO QUESTION 12, THEN SCORE 1 FOR MONEY MANAGEMENT. [OR = 9.52 White; OR=2.93 POC.]
Is your current homelessness in any way caused by a relationship that broke down, an unhealthy or abusive relationship, or because family or friends caused you to become evicted? If “yes,” then score 1 for social relationships. [OR=5.02 White; OR=3.59 POC.]
Have you ever had to leave an apartment, shelter program, or other place you were staying because of your physical health? Do you have any chronic health issues with your liver, kidneys, stomach, lungs or heart? If there was space available in a program that specifically assists people that live with HIV or AIDS, would that be of interest to you? 19.Do you have any physical disabilities that would limit the type of housing you could access, or would make it hard to live independently because you’d need help? When you are sick or not feeling well, do you avoid getting medical help? Are you currently pregnant, have you ever been pregnant, or have you ever gotten someone pregnant? IF “YES” TO ANY OF THE ABOVE, THEN SCORE 1 FOR PHYSICAL HEALTH. [OR=7.39 White; OR=3.72 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.33 White; OR=4.06 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))

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 = "TAYVISPDAT Subscale Endorsement by Race")

TAYVISPDAT Subscale Endorsement by Race
	Total No	Total Yes	White No	White Yes	POC No	POC Yes
Shelter/Tran Housing/Safe Haven	148	209	41	45	107	164
Consecutive Homeless	163	194	39	47	124	147
Emergency Service	224	133	47	39	177	94
Risk of Harm	212	145	45	41	167	104
Legal Issues	228	129	46	40	182	89
Risk of Exploitation	236	121	53	33	183	88
Money Managment	87	270	15	71	72	199
Meaningful Activity	209	148	56	30	153	118
Self Care	290	67	75	11	215	56
Social Relationship	111	246	31	55	80	191
Abuse and Trauma	110	247	32	54	78	193
Physical Health	260	97	51	35	209	62
Substance Use	290	67	65	21	225	46
Mental Health	338	19	76	10	262	9
Tri-Morbidity	275	82	54	32	221	50
Medications	164	193	42	44	122	149

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

Q1
	American Indian or Alaska Native	Asian	Black or African American	White
Couch surfing	0	0	27	3
Other (Specify)	0	0	12	1
Outdoors	1	2	122	40
Refused	0	0	0	1
Shelters	0	0	103	40
Transitional Housing	0	0	4	1

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

Q2
	American Indian or Alaska Native	Asian	Black or African American	White
Currently in stable housing	0	0	3	1
Less than 1 year	0	1	134	43
One year or more	1	1	130	42
Refused	0	0	1	0

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

Q3
	American Indian or Alaska Native	Asian	Black or African American	White
0	0	0	3	1
1	0	0	128	47
10	0	0	2	1
2	0	1	53	12
3	0	0	24	7
4	0	0	22	7
5	0	0	13	4
6	0	0	1	1
7	0	0	1	1
8	0	0	0	1
9	0	0	2	0
Greater than 10	1	1	19	4

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

Q4a
	American Indian or Alaska Native	Asian	Black or African American	White
0	0	1	124	30
1	1	0	52	20
10	0	0	4	1
2	0	0	34	21
3	0	0	17	6
4	0	1	11	3
5	0	0	8	2
6	0	0	8	1
7	0	0	2	1
8	0	0	2	0
Greater than 10	0	0	6	1

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

Q4b
	American Indian or Alaska Native	Asian	Black or African American	White
0	0	1	192	52
1	1	0	33	18
10	0	0	1	0
2	0	1	22	8
3	0	0	9	6
4	0	0	3	0
5	0	0	4	2
6	0	0	1	0
8	0	0	1	0
Greater than 10	0	0	2	0

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

Q4c
	American Indian or Alaska Native	Asian	Black or African American	White
0	0	1	192	52
1	1	0	33	18
10	0	0	1	0
2	0	1	22	8
3	0	0	9	6
4	0	0	3	0
5	0	0	4	2
6	0	0	1	0
8	0	0	1	0
Greater than 10	0	0	2	0

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

Q4d
	American Indian or Alaska Native	Asian	Black or African American	White
0	0	2	238	75
1	1	0	23	7
2	0	0	0	2
3	0	0	2	0
4	0	0	1	1
5	0	0	0	1
7	0	0	1	0
8	0	0	1	0
Greater than 10	0	0	2	0

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

Q4e
	American Indian or Alaska Native	Asian	Black or African American	White
0	1	0	178	51
1	0	1	45	19
10	0	0	2	1
2	0	0	19	4
3	0	0	5	3
4	0	0	8	1
5	0	0	2	3
6	0	0	1	0
7	0	0	2	1
9	0	0	0	1
Greater than 10	0	1	6	2

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

Q4f
	American Indian or Alaska Native	Asian	Black or African American	White
0	1	2	219	60
1	0	0	39	21
2	0	0	4	3
3	0	0	2	0
4	0	0	1	0
5	0	0	1	1
6	0	0	1	0
7	0	0	1	0
Greater than 10	0	0	0	1

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

Q5
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	1	187	55
Refused	0	0	1	0
Yes	1	1	80	31

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

Q6
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	0	217	69
Yes	1	2	51	17

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

Q7
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	216	61
Yes	0	1	52	25

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

Q8
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	211	59
Yes	0	0	57	27

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

Q9
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	228	69
Yes	0	1	40	17

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

Q10
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	0	202	59
Yes	0	2	66	27

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

Q11
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	232	72
Yes	0	1	36	14

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

Q12
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	184	68
Yes	0	1	84	18

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

Q13
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	1	117	30
Yes	1	1	151	56

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

Q14
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	1	55	11
Yes	1	1	213	75

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

Q15a
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	1	226	71
Yes	1	1	42	15

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

Q15b
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	0	232	67
Yes	1	2	36	19

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

Q15c
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	0	107	41
Refused	0	0	1	0
Yes	1	2	160	45

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

Q15d
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	0	232	74
Refused	0	0	0	1
Yes	1	2	36	11

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

Q15e
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	2	167	62
Yes	1	0	101	24

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

Q15f
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	0	150	44
Yes	1	2	118	42

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

Q16
	American Indian or Alaska Native	Asian	Black or African American	White
No	0	2	252	81
Yes	1	0	16	5

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

Q17
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	0	245	73
Refused	0	0	1	0
Yes	0	2	22	13

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

Q18
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	232	77
Refused	0	0	0	1
Yes	0	1	36	8

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

Q19
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	261	82
Yes	0	0	7	4

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

Q20
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	181	59
Yes	0	1	87	27

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

Q21
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	168	58
Refused	0	0	2	0
Yes	0	0	98	28

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

Q22
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	259	74
Yes	0	1	9	12

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

Q23
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	1	266	83
Yes	0	1	2	3

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

Q24
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	212	56
Yes	0	0	56	30

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

Q25a
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	0	248	72
Yes	0	2	20	14

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

Q25b
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	258	83
Yes	0	0	10	3

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

Q25c
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	251	79
Yes	0	0	17	7

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

Q26
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	258	77
Refused	0	0	0	1
Yes	0	0	10	8

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

Q27
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	0	226	58
Yes	0	2	42	28

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

Q28
	American Indian or Alaska Native	Asian	Black or African American	White
No	1	2	251	81
Refused	0	0	1	0
Yes	0	0	16	5

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	6	2
1	0	0	4	1
2	0	0	122	25
3	0	1	60	26
4	0	1	23	9
5	1	0	43	18
Missing Info	0	0	10	5

TAY VISPDAT Racial Equity

6/1/2016 - 9/17/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

Scores between 4 and 8

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