I am using the BradleyTerry2 package in R to analyse my data. When using the BTm function to calculate ability scores, the first item in the dataset is removed as a reference, given a score of 0 and then other ability scores are calculated relative to this reference.
Is there a way to use a null hypothesis as a reference, rather than using the first item in the dataset?
This is the code I am using. The "ID" field is player id. This code calculates an ability score for each "Matchup," relative to the first matchup in the dataset.
BTv1 <- BTm(player1=winner,player2=loser,id="ID",formula=~Matchup+(1|ID),data=btmdata)
I am trying to test against the null hypothesis that matchup has no effect on match outcomes, but currently I don't know what ability score corresponds to the null hypothesis. I would like to use this null hypothesis as a reference, rather than using the first matchup in the dataset.
For those wanting to reproduce my results, you can find my files on my university onedrive.
You can test the significance of terms in the model for ability using the anova function, i.e.
anova(BTv1, test = "Chisq")
Using the example data and script that you shared, we get the following result:
Sequential Wald Tests
Model: binomial, link: logit
Response: NULL
Predictor: ~Characters + (1 | ID)
Terms added sequentially (first to last)
Statistic Df P(>|Chi|)
NULL
Characters 46.116 26 0.008853 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Edit: For the model BTv2 with log-ability modelled by ~ Matchup+(1|ID)
Before investigating individual matchups, we should check the significance of the term overall. Unfortunately the anova() method for BTm objects doesn't currently work for terms with inestimable parameters, as in this case. So we'll compute this directly:
cf <- coef(BTv2)[!is.na(coef(BTv2))]
V <- vcov(BTv2)
ind <- grep("Matchup", names(cf))
chisq <- c(t(cf[ind]) %*% chol2inv(chol(V[ind, ind])) %*% cf[ind])
df <- length(ind)
c(chisq = chisq, df = df)
# chisq df
# 107.5667 167.0000
The Chi-squared statistic is less than the degrees of freedom, so the Matchup term is not significant - the model is over-fitting and it's not a good idea to investigate matchup-specific effects.
All the same, let's look at the model when fitted to the matches involving just 3 of the characters, for illustration.
summary(BTv2)$fixef
# Estimate Std. Error z value Pr(>|z|)
# MatchupCaptainFalcon;Falco -0.1327177 0.3161729 -0.4197632 0.6746585
# MatchupCaptainFalcon;Peach 0.1464518 0.3861823 0.3792297 0.7045173
# MatchupFalco;Peach -0.4103029 0.3365761 -1.2190496 0.2228254
In this case only 3 parameters are estimable, the rest are fixed to zero. Under model BTv2 for players i and j playing characters c and d respectively, we have
logit(p(i playing c beats j playing d))
= log_ability_i - log_ability_j + U_i - U_j
= Matchup_{c;d} - Matchup_{d;c} + U_i - U_j
where U_i and U_j are random player effects. So for players of the same baseline ability we have for example,
logit(p(CaptainFalcon beats Falco)) = -0.1327177 - 0 = -0.1327177
logit(p(Falco beats CaptainFalcon)) = 0 - (-0.1327177) = 0.1327177
So this tells you whether one character is favoured over another in a particular pairwise matchup.
Let's return to the BTv1 model based on all the data. In this model, for players of the same baseline ability we have
logit(p(i playing c beats j playing d)) = log_ability_i - log_ability_j
= Characters_c - Characters_d
The effect for "CharactersBowser" is set to zero, the rest are estimable. So e.g.
summary(BTv1)$fixef[c("CharactersFalco", "CharactersPeach"),]
# Estimate Std. Error z value Pr(>|z|)
# CharactersFalco 2.038925 0.9576332 2.129130 0.03324354
# CharactersPeach 2.119304 0.9508804 2.228781 0.02582845
means that
logit(p(Bowser beats Peach)) = 0 - 2.119304 = -2.119304
logit(p(Falcon beats Peach)) = 2.038925 - 2.119304 = -0.080379
So we can still compare characters in a particular matchup. We can use quasi-variances to compare the character effects
# add in character with fixed effect set to zero (Bowser)
V <- cbind(XCharactersBowser = 0, rbind(XCharactersBowser = 0,
vcov(BTv1)))
cf <- c(CharactersBowser = 0, coef(BTv1))
# compute quasi-variances
qv <- qvcalc(V, "XCharacters", estimates = cf,
labels = sub("Characters", "", names(cf)))
# plot and compare
# (need to set ylim because some estimates are essentially infinite)
par(mar = c(7, 4, 3, 1))
plot(qv, ylim = c(-5, 5))
See e.g. https://doi.org/10.1093/biomet/91.1.65 for more on quasi-variances.
Related
Question: Have a look at data set Two.csv. It contains a potentially dependent binary variable Y , and
two potentially independent variables {X1, X2} for each unit of measurement.
(a) Read data set Two.csv into R and have a look at the format of the dependent variable.
Discuss three models which might be appropriate in this data situation. Discuss which
aspects speak in favor of each model, and which aspects against.
(b) Suppose variable Y measures financial ratings A : y = 1, B : y = 2, and C : y = 3, that
is, the creditworthiness A: high, B: intermediate, C: low for unit of measurement firm
i. Model Y by means of an ordered Logit model as a function of {X1,X2} and estimate
your model by means of a built-in command.
(c) Explain the proportional odds-assumption and test whether the assumption is critical
in the context of the data set at hand.
##a) Read data set Two.csv into R and have a look at the format of the dependent variable.
O <- read.table("C:/Users/DELL/Downloads/ExamQEIII2021/Two.csv",header=TRUE,sep=";")
str(O)
dim(O)
View(O)
##b)
library(oglmx)
ologit<- oglmx(y~x1+x2,data=O, link="logit",constantMEAN = FALSE, constantSD = FALSE,
delta=0,threshparam =NULL)
results.ologis <- ologit.reg(y~x1+x2,data=O)
summary(results.ologis)
## x1 1.46251
## x2 -0.45391
margins.oglmx(results.ologis,ascontinuous = FALSE) #Build in command for AMElogit
##c) Explain the proportional odds-assumption and test whether the assumption is critical
#in the context of the data set at hand.
#ordinal Logit WITH proportional odds(PO)
library(VGAM)
a <- vglm(y~x1+x2,family=cumulative(parallel=TRUE),data=O)
summary(a)
#ordinal Logit WITHOUT proportional odds [a considers PO and c doesn't]
c <- vglm(y~x1+x2,family=cumulative(parallel=FALSE),data=O)
summary(c)
pchisq(deviance(a)-deviance(c),df.residual(a)-df.residual(c),lower.tail=FALSE)
## 0.4936413 ## No significant difference in the variance left unexplained. Cannot
#confirm that PO assumption is critical.
#small model
LLa <- logLik(a)
#large model
LLc <- logLik(c)
#2*LLc-2*
df.residual(c)
df.residual(a) #or similarly, via a Likelihood Ratio test.
# or, if you are unsure about the number of degrees of freedom
LL<- 2*(LLc -LLa)
1-pchisq(LL,df.residual(a)-df.residual(c))
## 0.4936413 [SAME AS ## No sign. line]
##Conclusion: Likelihood do not differ significantly with the assumption of non PO.
I'm trying to create a function that has set arguments, and in the body of the function it has a set formula but a random number of variables in the formula, determined only when the data is received. How do I write the function body so that it can adjust itself for an unknown number of variables?
Here's the backstory: I'm using the nls.lm package to optimize a function for a set of parameters in the function. nls.lm requires a function that returns a vector of residuals. This function is pretty simple: observed-predicted values. However, I also need to create a function to actually get the predicted values. This is where it gets tricky, since the predicted value formula contains the parameters that need to be regressed and optimized.
This is my general formula I am trying to perform non-linear regression on:
Y=A+(B-A)/(1+(10^(X-C-N))
Where A and B are global parameters shared across the entire data set and N is some constant. C can be anywhere from 1 to 8 parameters that need to be determined individually depending on the data set associated with each parameter.
Right now my working function contains the formula and 8 parameters to be estimated.
getPredictors<- function(params, xvalues) {
(params$B) + ((params$A-params$B)/(1+(10^(xvalues-
params$1*Indicator[1,]-params$2*Indicator[2,]-
params$3*Indicator[3,]-params$4*Indicator[4,]-
params$5*Indicator[5,]-params$6*Indicator[6,]-
params$7*Indicator[7,]-params$8*Indicator[8,]-
constant))))
}
params is a list of parameters with an initial value. Indicator is a table where each row consists 1's and 0's that act as an indicator variable to correctly pair each individual parameter with its associated data points. In its simplest form, if it had only one data point per parameter, it would look like a square identity matrix.
When I pair this function with nls.lm() I am successful in my regression:
residFun<- function(p, observed, xx) {
observed - getPredictors(p,xx)
}
nls.out<- nls.lm(parameterslist, fn = residFun, observed = Yavg, xx = Xavg)
> summary(nls.out)
Parameters:
Estimate Std. Error t value Pr(>|t|)
1 -6.1279 0.1857 -32.997 <2e-16 ***
2 -6.5514 0.1863 -35.174 <2e-16 ***
3 -6.2077 0.1860 -33.380 <2e-16 ***
4 -6.4275 0.1863 -34.495 <2e-16 ***
5 -6.4805 0.1863 -34.783 <2e-16 ***
6 -6.1777 0.1859 -33.235 <2e-16 ***
7 -6.3098 0.1862 -33.882 <2e-16 ***
8 -7.7044 0.1865 -41.303 <2e-16 ***
A 549.7203 11.5413 47.631 <2e-16 ***
B 5.9515 25.4343 0.234 0.816
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 82.5 on 86 degrees of freedom
Number of iterations to termination: 7
Reason for termination: Relative error in the sum of squares is at most `ftol'.
Now, the problem comes in when the data I receive does not contain 8 parameters. I can't just substitute 0 for these values since I am certain the degrees of freedom change with less parameters. Therefore I will need some way to create a getPredictors function on the fly, depending on the data I receive.
I've tried a couple things. I've tried combining all the parameters into a list of strings like so: (It's still 8 parameters, for comparison reasons, but it can be anywhere from 1-7 parameters.)
for (i in 1:length(data$subjects)){
paramsandindics[i]<-c(paste0("params$",i,"*","Indicator[",i,",]"))
}
combined<-paste0(paramsandindics, collapse="-")
> combined
[1] "params$1*Indicator[1,]-params$2*Indicator[2,]-
params$3*Indicator[3,]-params$4*Indicator[4,]-
params$5*Indicator[5,]-params$6*Indicator[6,]-
params$7*Indicator[7,]-params$8*Indicator[8,]"
Which appears to get me what I need. So I try dropping it into a new equation
getPredictors2<- function(params, xvalues) {
(params$B) + ((params$A-params$B)/
(1+(10^(xvalues-parse(text=combined)-constant))))
}
But I get an error "non-numeric argument to binary operator". Makes sense, it's probably trying to subtract a character string which won't work. So I switch to:
getPredictors2<- function(params, xvalues) {
(params$B) + ((params$A-params$B)/
(1+(10^(xvalues-eval(parse(text=combined))-constant))))
}
Which immediately evaluates the whole thing, producing only 1 parameter, which breaks my regression.
Ultimately I'd like a function that is written to accept a variable or dynamic number of variables to be filled in in the body of the function. These variables need to be written as-is and not evaluated immediately because the Levenberg-Marquardt algorithm, which is employed in the nls.lm (part of the minpack.lm package) requires an equation in addition to initial parameter guesses and residuals to minimize.
A simple example should suffice. I'm sorry if none of my stuff is reproducible- the data set is quite specific and too large to properly upload.
Sorry if this is long winded. This is my first time trying any of this (coding, nonlinear regression, stackoverflow) so I am a little lost. I'm not sure I am even asking the right question. Thank you for your time and consideration.
EDIT
I've included a smaller sample involving 2 parameters as an example. I hope it can help.
Subjects<-c("K1","K2")
#Xvalues
Xvals<-c(-11, -10, -9, -11, -10, -9)
#YValues, Observed
Yobs<-c(467,330,220,567,345,210)
#Indicator matrix for individual parameters
Indicators<-matrix(nrow = 2, ncol = 6)
Indicators[1,]<-c(1,1,1,0,0,0)
Indicators[2,]<-c(0,0,0,1,1,1)
#Setting up the parameters and functions needed for nls.lm
parameternames<-c("K1","K2","A","B")
#Starting values that nls.lm will iterate on
startingestimates<-c(-7,-7,0,500)
C<-.45
parameterlist<-as.list(setNames(startingestimates, parameternames))
getPredictors<- function(params, xx){
(params$A) + ((params$B-params$A)/
(1+(10^(xx-params$K1*Indicators[1,]-params$K2*Indicators[2,]-C))))}
residFunc<- function(p, observed, xx) {
observed - getPredictors(p,xx)
}
nls.output<- nls.lm(parameterlist, fn = residFunc, observed = Yobs, xx = Xvals)
#Latest attempt at creating a dynamic getPredictor function
combinationtext<-c()
combination<-c()
for (i in 1:length(Subjects)){
combinationtext[i]<-c(paste0("params$K",i,"*","Indicators[",i,",]"))
}
combination<-paste0(combinationtext, collapse="-")
getPredictorsDynamic<-function(params, xx){
(params$A) + ((params$B-params$A)/
(1+(10^(xx-(parse(text=combination))-C))))}
residFunc2<- function(p, observed, xx) {
observed - getPredictorsDynamic(p,xx)
}
nls.output2<-nls.lm(parameterlist, fn = residFunc2, observed = Yobs, xx = Xvals)
#Does not work
I am asked to compute a test statistic using the t.test() function, but I need to reduce the type I error. My prof showed us how to change a confidence level for this function, but not the acceptable type I error for null hypothesis testing. The goal is for the argument to automatically compute a p-value based on a .01 error rate rather than the normal .05.
The r code below involves a data set that I have downloaded.
t.test(mid$log_radius_area, mu=8.456)
I feel like I've answered this somewhere, but can't seem to find it on SO or CrossValidated.
Similarly to this question, the answer is that t.test() doesn't specify any threshold for rejecting/failing to reject the null hypothesis; it reports a p-value, and you get to decide whether to reject or not. (The conf.level argument is for adjusting which confidence interval the output reports.)
From ?t.test:
t.test(1:10, y = c(7:20))
Welch Two Sample t-test
data: 1:10 and c(7:20)
t = -5.4349, df = 21.982, p-value = 1.855e-05
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-11.052802 -4.947198
sample estimates:
mean of x mean of y
5.5 13.5
Here the p-value is reported as 1.855e-05, so the null hypothesis would be rejected for any (pre-specified) alpha level >1.855e-05. Note that the output doesn't say anywhere "the null hypothesis is rejected at alpha=0.05" or anything like that. You could write your own function to do that, using the $p.value element that is saved as part of the test results:
report_test <- function(tt, alpha=0.05) {
cat("the null hypothesis is ")
if (tt$p.value > alpha) {
cat("**NOT** ")
}
cat("rejected at alpha=",alpha,"\n")
}
tt <- t.test(1:10, y = c(7:20))
report_test(tt)
## the null hypothesis is rejected at alpha= 0.05
Most R package/function writers don't bother to do this, because they figure that it should be simple enough for users to do for themselves.
I'm doing a beta regression in R, which requires values between 0 and 1, endpoints excluded, i.e. (0,1) instead of [0,1].
I have some 0 and 1 values in my dataset, so I'd like to convert them to the smallest possible neighbor, such as 0.0000...0001 and 0.9999...9999. I've used .Machine$double.xmin (which gives me 2.225074e-308), but betareg() still gives an error:
invalid dependent variable, all observations must be in (0, 1)
If I use 0.000001 and 0.999999, I got a different set of errors:
1: In betareg.fit(X, Y, Z, weights, offset, link, link.phi, type, control) :
failed to invert the information matrix: iteration stopped prematurely
2: In sqrt(wpp) :
Error in chol.default(K) :
the leading minor of order 4 is not positive definite
Only if I use 0.0001 and 0.9999 I can run without errors. Is there any way I can improve this minimum values with betareg? Or should I just be happy with that?
Try it with eps (displacement from 0 and 1) first equal to 1e-4 (as you have here) and then with 1e-3. If the results of the models don't differ in any way you care about, that's great. If they are, you need to be very careful, because it suggests your answers will be very sensitive to assumptions.
In the example below the dispersion parameter phi changes a lot, but the intercept and slope parameter don't change very much.
If you do find that the parameters change by a worrying amount for your particular data, then you need to think harder about the process by which zeros and ones arise, and model that process appropriately, e.g.
a censored-data model: zero/one arise through a minimum/maximum detection threshold, models the zero/one values as actually being somewhere in the tails or
a hurdle/zero-one inflation model: zeros and ones arise through a separate process from the rest of the data, use a binomial or multinomial model to characterize zero vs. (0,1) vs. one, then use a Beta regression on the (0,1) component)
Questions about these steps are probably more appropriate for CrossValidated than for SO.
sample data
set.seed(101)
library(betareg)
dd <- data.frame(x=rnorm(500))
rbeta2 <- function(n, prob=0.5, d=1) {
rbeta(n, shape1=prob*d, shape2=(1-prob)*d)
}
dd$y <- rbeta2(500,plogis(1+5*dd$x),d=1)
dd$y[dd$y<1e-8] <- 0
trial fitting function
ss <- function(eps) {
dd <- transform(dd,
y=pmin(1-eps,pmax(eps,y)))
m <- try(betareg(y~x,data=dd))
if (inherits(m,"try-error")) return(rep(NA,3))
return(coef(m))
}
ss(0) ## fails
ss(1e-8) ## fails
ss(1e-4)
## (Intercept) x (phi)
## 0.3140810 1.5724049 0.7604656
ss(1e-3) ## also fails
ss(1e-2)
## (Intercept) x (phi)
## 0.2847142 1.4383922 1.3970437
ss(5e-3)
## (Intercept) x (phi)
## 0.2870852 1.4546247 1.2029984
try it for a range of values
evec <- seq(-4,-1,length=51)
res <- t(sapply(evec, function(e) ss(10^e)) )
library(ggplot2)
ggplot(data.frame(e=10^evec,reshape2::melt(res)),
aes(e,value,colour=Var2))+
geom_line()+scale_x_log10()
In trying to figure out which one is better to use I have come across two issues.
1) The W statistic given by wilcox.test is different from that of coin::wilcox_test. Here's my output:
wilcox_test:
Exact Wilcoxon Mann-Whitney Rank Sum Test
data: data$variableX by data$group (yes, no)
Z = -0.7636, p-value = 0.4489
alternative hypothesis: true mu is not equal to 0
wilcox.test:
Wilcoxon rank sum test with continuity correction
data: data$variable by data$group
W = 677.5, p-value = 0.448
alternative hypothesis: true location shift is not equal to 0
I'm aware that there's actually two values for W and that the smaller one is usually reported. When wilcox.test is used with comma instead of "~" I can get the other value, but this comes up as W = 834.5. From what I understand, coin::statistic() can return three different statistics using ("linear", "standarized", and "test") where "linear" is the normal W and "standardized" is just the W converted to a z-score. None of these match up to the W I get from wilcox.test though (linear = 1055.5, standardized = 0.7636288, test = -0.7636288). Any ideas what's going on?
2) I like the options in wilcox_test for "distribution" and "ties.method", but it seems that you can not apply a continuity correction like in wilcox.test. Am I right?
I encountered the same issue when trying to apply Wendt formula to compute effect sizes using the coin package, and obtained aberrant r values due to the fact that the linear statistic outputted by wilcox_test() is unadjusted.
A great explanation is already given here, and therefore I will simply address how to obtain adjusted U statistics with the wilcox_test() function. Let's use a the following data frame:
d <- data.frame( x = c(rnorm(n = 60, mean = 10, sd = 5), rnorm(n = 30, mean = 16, sd = 5)),
g = c(rep("a",times = 60), rep("b",times = 30)) )
We can perform identical tests with wilcox.test() and wilcox_test():
w1 <- wilcox.test( formula = x ~ g, data = d )
w2 <- wilcox_test( formula = x ~ g, data = d )
Which will output two distinct statistics:
> w1$statistic
W
321
> w2#statistic#linearstatistic
[1] 2151
The values are indeed totally different (albeit the tests are equivalent).
To obtain the U statistics identical to that of wilcox.test(), you need to subtract wilcox_test()'s output statistic by the minimal value that the sum of the ranks of the reference sample can take, which is n_1(n_1+1)/2.
Both commands take the first level in the factor of your grouping variable g as reference (which will by default be alphabetically ordered).
Then you can compute the smallest sum of the ranks possible for the reference sample:
n1 <- table(w2#statistic#x)[1]
And
w2#statistic#linearstatistic- n1*(n1+1)/2 == w1$statistic
should return TRUE
Voilà.
It seems to be one is performing Mann-Whitney's U and the other Wilcoxon rank test, which is defined in many different ways in literature. They are pretty much equivalent, just look at the p-value. If you want continuity correction in wilcox.test just use argument correct=T.
Check https://stats.stackexchange.com/questions/79843/is-the-w-statistic-outputted-by-wilcox-test-in-r-the-same-as-the-u-statistic