R OOP change the name of a slot - r

I'm using MLR package and I stumbled on a problem with an S4 object. More specifically it's the slot name that causes the trouble. I'm looking for a way to change the slot's name, not the value.
Here's a reproducible code example that generates the object in question:
lrn1 = makeLearner("classif.lda", predict.type = "prob")
lrn2 = makeLearner("classif.ksvm", predict.type = "prob")
lrns = list(lrn1, lrn2)
rdesc.outer = makeResampleDesc("CV", iters = 5)
ms = list(auc, mmce)
bmr = benchmark(lrns, tasks = sonar.task, resampling = rdesc.outer,
measures = ms, show.info = FALSE)
preds = getBMRPredictions(bmr, drop = TRUE)
ROCRpreds = lapply(preds, asROCRPrediction)
ROCRperfs = lapply(ROCRpreds, function(x) ROCR::performance(x, "tpr", "fpr"))
The object is made of two lists and I need to change the name slots in both of them. Instead of x.values and y.values the names should be x and y respectively.
str(ROCRperfs$classif.lda)
Formal class 'performance' [package "ROCR"] with 6 slots
..# x.name : chr "False positive rate"
..# y.name : chr "True positive rate"
..# alpha.name : chr "Cutoff"
..# x.values :List of 5
.. ..$ : num [1:43] 0 0 0 0 0 ...
.. ..$ : num [1:42] 0 0 0 0.0526 0.0526 ...
.. ..$ : num [1:42] 0 0 0 0.05 0.05 0.05 0.05 0.05 0.05 0.05 ...
.. ..$ : num [1:43] 0 0 0.0476 0.0476 0.0476 ...
.. ..$ : num [1:43] 0 0 0 0 0 ...
..# y.values :List of 5
.. ..$ : num [1:43] 0 0.0417 0.0833 0.125 0.1667 ...
.. ..$ : num [1:42] 0 0.0455 0.0909 0.0909 0.1364 ...
.. ..$ : num [1:42] 0 0.0476 0.0952 0.0952 0.1429 ...
.. ..$ : num [1:43] 0 0.0476 0.0476 0.0952 0.1429 ...
.. ..$ : num [1:43] 0 0.0435 0.087 0.1304 0.1739 ...
..# alpha.values:List of 5
.. ..$ : num [1:43] Inf 1 1 1 1 ...
.. ..$ : num [1:42] Inf 1 1 1 0.999 ...
.. ..$ : num [1:42] Inf 1 1 1 1 ...
.. ..$ : num [1:43] Inf 1 1 0.999 0.999 ...
.. ..$ : num [1:43] Inf 1 1 1 1 ...
As I'm beginner to OOP in R all I could was to print the slot with slot().
The bottom line is that all I want to do with the object in question is to plot is as follows:
plot(ROCRperfs[[1]], col = "blue", avg = "vertical", spread.estimate = "stderror",
show.spread.at = seq(0.1, 0.8, 0.1), plotCI.col = "blue", plotCI.lwd = 2, lwd = 2)

You cannot change the structure of an S4 class once it's defined. This is a feature, not a bug. By imposing restrictions on what can be done, S4 reduces the chance of bugs creeping into your code.
For example, consider what might happen if you changed the slotnames in the object to x and y, and then passed the object to a function that's expecting x.values and y.values. By not allowing you to make this change, S4 rules out the possibility that code down the line will be given an object whose structure they can't handle.
For your use case, you can just plot the x.values and y.values slots individually:
plot(ROCRperfs[[1]]#x.values, ROCRperfs[[1]]#y.values,
col = "blue", avg = "vertical", spread.estimate = "stderror",
show.spread.at = seq(0.1, 0.8, 0.1), plotCI.col = "blue",
plotCI.lwd = 2, lwd = 2))

Related

How to change internal function in MendelianRandomization function in order to change decimal places in output?

I am running this function on MAC computer where I installed this function:
library(MendelianRandomization)
EggerObject <- mr_egger(MRInputObject,robust = FALSE,penalized = FALSE,correl = FALSE,distribution = "normal",alpha = 0.05)
but the output for p values has only 3 decimal places, I would like to extend it say to 10 decimal places:
> EggerObject
MR-Egger method
(variants uncorrelated, random-effect model)
Number of Variants = 88
------------------------------------------------------------------
Method Estimate Std Error 95% CI p-value
MR-Egger 0.044 0.009 0.027, 0.061 0.000
(intercept) -0.041 0.004 -0.049, -0.033 0.000
------------------------------------------------------------------
I was looking in their documentation https://www.rdocumentation.org/packages/MendelianRandomization/versions/0.4.1/topics/decimals
but I am not sure how to apply this.
I tried this:
> EggerObject <- mr_egger(MRInputObject,robust = FALSE,penalized = FALSE,correl = FALSE,distribution = "normal",alpha = 0.05, decimals(number = p-value, places = 10))
Error in format(round(number, places), nsmall = places) :
object 'p' not found
EDIT:
> str(EggerObject)
Formal class 'Egger' [package "MendelianRandomization"] with 23 slots
..# Model : chr "random"
..# Exposure : chr "exposure"
..# Outcome : chr "outcome"
..# Robust : logi FALSE
..# Penalized : logi FALSE
..# Correlation : logi [1, 1] NA
..# Estimate : num 0.0441
..# StdError.Est: num 0.00861
..# CILower.Est : num 0.0273
..# CIUpper.Est : num 0.061
..# Pvalue.Est : num 2.92e-07
..# Intercept : num -0.041
..# StdError.Int: num 0.00432
..# CILower.Int : num -0.0494
..# CIUpper.Int : num -0.0325
..# Pvalue.Int : num 0
..# Pleio.pval : num 0
..# Causal.pval : num 2.92e-07
..# Alpha : num 0.05
..# SNPs : int 88
..# RSE : num 8.79
..# Heter.Stat : num [1:2] 6649 0
..# I.sq : num 0.959
The EggerObject is an "S4" list and so you can access the value of the Pvalue.Est item using the S4 access function "#". (It's like "$" for ordinary S3 objects.) The explicit print function allows you control of the degree of precision:
print( EggerObject#Pvalue.Est, digits=10)
It's possible that there is an accessor-function for objects of class-"Egger". If such a function exists it would be preferable, since the package author likely knows of potential pitfalls with use of different components of such an object.

R Importing ARIMA model outputs to use in forecast

I have undertaken ARIMA modelling using the auto.arima function for 91 models. The outputs are sitting in a list of lists.
The structure of the outputs for one model looks like the following:
List of 19
$ coef : Named num [1:8] -3.17e-01 -3.78e-01 -8.02e-01 -5.39e+04 -1.33e+05 ...
..- attr(*, "names")= chr [1:8] "ar1" "ar2" "ma1" "Price.Diff" ...
$ sigma2 : num 6.37e+10
$ var.coef : num [1:8, 1:8] 1.84e-02 8.90e-03 -7.69e-03 -8.80e+02 2.83e+03 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:8] "ar1" "ar2" "ma1" "Price.Diff" ...
.. ..$ : chr [1:8] "ar1" "ar2" "ma1" "Price.Diff" ...
$ mask : logi [1:8] TRUE TRUE TRUE TRUE TRUE TRUE ...
$ loglik : num -1189
$ aic : num 2395
$ arma : int [1:7] 2 1 0 0 1 1 0
$ residuals: Time-Series [1:87] from 1 to 87: 1810 -59503 263294 240970 94842 ...
$ call : language auto.arima(y = x[, 2], stepwise = FALSE, approximation = FALSE, xreg = x[, 3:ncol(x)], x = list(x = c(1856264.57,| __truncated__ ...
$ series : chr "x[, 2]"
$ code : int 0
$ n.cond : int 0
$ nobs : int 86
$ model :List of 10
..$ phi : num [1:2] -0.317 -0.378
..$ theta: num -0.802
..$ Delta: num 1
..$ Z : num [1:3] 1 0 1
..$ a : num [1:3] -599787 284456 1887763
..$ P : num [1:3, 1:3] 0.00 0.00 -4.47e-23 0.00 3.33e-16 ...
..$ T : num [1:3, 1:3] -0.317 -0.378 1 1 0 ...
..$ V : num [1:3, 1:3] 1 -0.802 0 -0.802 0.643 ...
..$ h : num 0
..$ Pn : num [1:3, 1:3] 1.00 -8.02e-01 -1.83e-23 -8.02e-01 6.43e-01 ...
$ bic : num 2417
$ aicc : num 2398
$ xreg : Time-Series [1:87, 1:5] from 1 to 87: -0.866 -0.466 -1.383 -0.999 -0.383 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : NULL
.. ..$ : chr [1:5] "Price.Diff" "Easter" "Christmas" "High.Week" ...
$ x : Time-Series [1:87] from 1 to 87: 1856265 1393925 2200962 2209996 2161707 ...
$ fitted : Time-Series [1:87] from 1 to 87: 1854455 1453429 1937668 1969026 2066864 ...
- attr(*, "class")= chr [1:3] "ARIMA" "forecast_ARIMA" "Arima"
When printed the output looks as follows:
Series: x[, 2]
Regression with ARIMA(2,1,1) errors
Coefficients:
ar1 ar2 ma1 Price.Diff Easter Christmas High.Week Low.Week
-0.3170 -0.3777 -0.8017 -53931.11 -133187.55 -53541.62 -347146.59 216202.71
s.e. 0.1356 0.1319 0.1069 28195.33 68789.25 23396.62 -74115.78 66881.15
sigma^2 estimated as 6.374e+10: log likelihood=-1188.69
AIC=2395.38 AICc=2397.75 BIC=2417.47
I have written the following to export my models to text file format:
# export model outputs to newly created folder
for(i in 1:length(ts_outputs)){
sink(paste0(names(ts_outputs[i]), ".txt"))
print(ts_outputs[i])
sink()
}
This works, to view the model outputs themselves, however I need to be able to import the model outputs back into R to use them to forecast out my time series' forward.
I am assuming that I need to put them back into the original structure once re-imported.
Is there a certain package that has already been written to do this?
Are text files the way to go for the original exporting?
I believe the following is the source code from the forecast package which writes the outputs (https://rdrr.io/github/ttnsdcn/forecast-package/src/R/arima.R):
if (length(x$coef) > 0) {
cat("\nCoefficients:\n")
coef <- round(x$coef, digits=digits)
if (se && nrow(x$var.coef)) {
ses <- rep(0, length(coef))
ses[x$mask] <- round(sqrt(diag(x$var.coef)), digits=digits)
coef <- matrix(coef, 1, dimnames=list(NULL, names(coef)))
coef <- rbind(coef, s.e.=ses)
}
print.default(coef, print.gap=2)
}
cm <- x$call$method
if (is.null(cm) || cm != "CSS")
{
cat("\nsigma^2 estimated as ", format(x$sigma2, digits=digits),
": log likelihood=", format(round(x$loglik, 2)),"\n",sep="")
npar <- length(x$coef) + 1
nstar <- length(x$residuals) - x$arma[6] - x$arma[7]*x$arma[5]
bic <- x$aic + npar*(log(nstar) - 2)
aicc <- x$aic + 2*npar*(nstar/(nstar-npar-1) - 1)
cat("AIC=", format(round(x$aic, 2)), sep="")
cat(" AICc=", format(round(aicc, 2)), sep="")
cat(" BIC=", format(round(bic, 2)), "\n",sep="")
}
else cat("\nsigma^2 estimated as ", format(x$sigma2, digits=digits),
": part log likelihood=", format(round(x$loglik, 2)),
"\n", sep="")
invisible(x)
}
Appreciate any direction/advice.

How to get value of fitted curve from an IRT model at specific point in R?

So I have some data that I fit a IRT graded response model to, using this code:
hdat <- read.csv("data.csv", header=TRUE)
library("mirt")
model.grm <- 'height = 1-9'
results.grm <- mirt(data=hdat, model=model.grm, itemtype="graded", SE=TRUE, verbose=FALSE)
coef.grm <- coef(results.grm, IRTpars=TRUE, simplify=TRUE)
items.grm <- as.data.frame(coef.grm$items)
print(items.grm)
png(filename="plot.png")
plot(results.grm, type = 'trace', which.items = c(1),
main = "", par.settings = simpleTheme(lty=1:4,lwd=2),
auto.key=list(points=FALSE,lines=TRUE, columns=4))
dev.off()
And I get this graph:
How do I find out the value of say, P2 at theta = -1?
The object being graphed I think is results.grm#ParObjects$pars[[1]] which has these contents:
Formal class 'graded' [package "mirt"] with 23 slots
..# par : num [1:5] 4.888 2.815 0.561 -1.728 -5.509
..# SEpar : num [1:5] 0.0421 0.0311 0.0252 0.0279 0.0472
..# parnames : chr [1:5] "a1" "d1" "d2" "d3" ...
..# est : Named logi [1:5] TRUE TRUE TRUE TRUE TRUE
.. ..- attr(*, "names")= chr [1:5] "a1" "d1" "d2" "d3" ...
..# dps :function ()
..# dps2 :function ()
..# constr : logi(0)
..# itemclass : int 2
..# parnum : Named int [1:5] 1 2 3 4 5
.. ..- attr(*, "names")= chr [1:5] "a1" "d1" "d2" "d3" ...
..# nfact : int 1
..# nfixedeffects: num 0
..# fixed.design : num [1, 1] 0
..# dat : num [1, 1] 0
..# ncat : int 5
..# gradient : num(0)
..# hessian : num [1:5, 1:5] -4814 1846 362 -1200 -2266 ...
..# itemtrace : num[0 , 0 ]
..# lbound : num [1:5] -Inf -Inf -Inf -Inf -Inf
..# ubound : num [1:5] Inf Inf Inf Inf Inf
..# any.prior : logi FALSE
..# prior.type : int [1:5] 0 0 0 0 0
..# prior_1 : num [1:5] NaN NaN NaN NaN NaN
..# prior_2 : num [1:5] NaN NaN NaN NaN NaN
probtrace(extract.item(results.grm, 1), c(-1)) should work - also, might be helpful to look at https://github.com/philchalmers/mirt/issues/21

multiple lists combines errors in R

I have multiple lists wanted to combine, but got wrong results
The code I used
hiv.Scatter <- list(predictions = predictdata, labels = L)
for (k in 1:2){
hiv.Scatter <-
list(predictions = append(
list(hiv.Scatter$predictions),
list(predictdata)
),
labels = append(list(hiv.Scatter$labels), list(L)))
}
But use the code above, I got very strange results
the results I expected is:
> str(hiv.Scatter)
List of 2
$ predictions:List of 3
..$ : num [1:6] 0.0287 0.00648 0.00926 0.04352 0.01296 ...
..$ : num [1:6] 0.0287 0.00648 0.00926 0.04352 0.01296 ...
..$ : num [1:6] 0.0287 0.00648 0.00926 0.04352 0.01296 ...
$ labels :List of 3
..$ : num [1:6] 1 1 1 1 1 1
..$ : num [1:6] 1 1 1 1 1 1
..$ : num [1:6] 1 1 1 1 1 1
The data I used
> dput(L)
c(1, 1, 1, 1, 1, 1)
> dput(predictdata)
c(0.0287037037037037, 0.00648148148148148, 0.00925925925925926,
0.0435185185185185, 0.012962962962963, 0.00833333333333333)
Thanks for your help
See this,
hiv.Scatter <- list(predictions = list(predictions = predictdata),
labels = list(labels = L))
for (k in 1:2){
hiv.Scatter[[1]] <- append(hiv.Scatter[[1]],
list(predictions = predictdata))
hiv.Scatter[[2]] <- append(hiv.Scatter[[2]], list(labels = L))
}
OR, this
hiv.Scatter <- list(predictions = list(predictions = predictdata),
labels = list(labels = L))
for (k in 1:2){
hiv.Scatter$predictions <- append(hiv.Scatter$predictions,
list(predictions = predictdata))
hiv.Scatter$labels <- append(hiv.Scatter$labels, list(labels = L))
}
Which seems to give the desired output
str(hiv.Scatter)
# List of 2
# $ predictions:List of 3
# ..$ predictions: num [1:6] 0.0287 0.00648 0.00926 0.04352 0.01296 ...
# ..$ predictions: num [1:6] 0.0287 0.00648 0.00926 0.04352 0.01296 ...
# ..$ predictions: num [1:6] 0.0287 0.00648 0.00926 0.04352 0.01296 ...
# $ labels :List of 3
# ..$ labels: num [1:6] 1 1 1 1 1 1
# ..$ labels: num [1:6] 1 1 1 1 1 1
# ..$ labels: num [1:6] 1 1 1 1 1 1

Accessing a slot in the results of wilcox_test

I'm doing a test on some data:
wilcox_test(y ~ x, distribution="exact", conf.int=TRUE)
# Exact Wilcoxon Mann-Whitney Rank Sum Test
#
# data: y by x (1, 2)
# Z = 1.8732, p-value = 0.06106
# alternative hypothesis: true mu is not equal to 0
# 95 percent confidence interval:
# 0 2
# sample estimates:
# difference in location
# 1
The number displayed under difference in location is the Hodges-Lehmann estimator. I want to assign it to a variable for further calculation. But I do not know:
How can I access the value of the "difference in location"?
I looked at str(wilcox_test(y ~ x, distribution="exact", conf.int=TRUE)), which gives me:
Formal class 'ScalarIndependenceTestConfint' [package "coin"] with 7 slots
..# confint :function (level)
..# conf.level : num 0.95
..# nullvalue : num 0
..# distribution:Formal class 'ExactNullDistribution' [package "coin"] with 7 slots
.. .. ..# q :function (p)
.. .. ..# d :function (x)
.. .. ..# support :function ()
.. .. ..# parameters: list()
.. .. ..# pvalue :function (q)
.. .. ..# p :function (q)
.. .. ..# name : chr "exact distribution (via Streitberg-Roehmel algorithm)"
..# statistic :Formal class 'ScalarIndependenceTestStatistic' [package "coin"] with 14 slots
.. .. ..# alternative : chr "two.sided"
.. .. ..# teststatistic : Named num 1.87
.. .. .. ..- attr(*, "names")= chr "1"
.. .. ..# standardizedlinearstatistic: Named num 1.87
.. .. .. ..- attr(*, "names")= chr "1"
.. .. ..# linearstatistic : num 4246
.. .. ..# expectation : Named num 3875
.. .. .. ..- attr(*, "names")= chr "1"
.. .. ..# covariance :Formal class 'Variance' [package "coin"] with 1 slot
.. .. .. .. ..# variance: Named num 39334
.. .. .. .. .. ..- attr(*, "names")= chr "1"
.. .. ..# xtrans : num [1:124, 1] 1 1 1 1 1 1 1 1 1 1 ...
.. .. .. ..- attr(*, "dimnames")=List of 2
.. .. .. .. ..$ : chr [1:124] "1" "2" "3" "4" ...
.. .. .. .. ..$ : chr "1"
.. .. .. ..- attr(*, "assign")= int 1
.. .. ..# ytrans : num [1:124, 1] 114.5 93.5 9 50 114.5 ...
.. .. .. ..- attr(*, "assign")= int 1
.. .. .. ..- attr(*, "dimnames")=List of 2
.. .. .. .. ..$ : NULL
.. .. .. .. ..$ : chr ""
.. .. ..# xtrafo :function (data, numeric_trafo = id_trafo, factor_trafo = f_trafo, ordered_trafo = of_trafo,
surv_trafo = logrank_trafo, var_trafo = NULL, block = NULL)
.. .. ..# ytrafo :function (data)
.. .. ..# x :'data.frame': 124 obs. of 1 variable:
.. .. .. ..$ x: Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
.. .. ..# y :'data.frame': 124 obs. of 1 variable:
.. .. .. ..$ y: num [1:124] 7 5 0 2 7 1 0 9 1 7 ...
.. .. ..# block : Factor w/ 1 level "0": 1 1 1 1 1 1 1 1 1 1 ...
.. .. ..# weights : num [1:124] 1 1 1 1 1 1 1 1 1 1 ...
..# estimates : list()
..# method : chr "Wilcoxon Mann-Whitney Rank Sum Test"
But wilcox_test(...)#estimates only returns:
list()
which appears empty.
So where is the 1 stored that is listed under difference in location in the results???
Additional explanation:
This works:
hle <- wilcox.test(x, y, paired = TRUE, correct = FALSE, conf.int = TRUE)$estimate
But that is a different test and not appropriate to my data.
I had to do a little bit of digging to figure this out since the difference in location value is nested down a couple of levels, but I'll walk you through it using an example object provided in the help file for wilcox_test - the object is named wt, and I'll include it below. For things like this, I usually start by inspecting the show method of the class of interest -
R> class(wt)
[1] "ScalarIndependenceTestConfint"
attr(,"package")
[1] "coin"
R> getMethod("show","ScalarIndependenceTestConfint")
Method Definition:
function (object)
{
x <- object
stat <- x#statistic#teststatistic
names(stat) <- "Z"
dist <- x#distribution
cld <- class(dist)
attributes(cld) <- NULL
distname <- switch(cld, AsymptNullDistribution = "Asymptotic",
ApproxNullDistribution = "Approximative", ExactNullDistribution = "Exact")
dataname <- varnames(x#statistic)
ci <- confint(object, level = object#conf.level)
RET <- list(statistic = stat, p.value = x#distribution#pvalue(stat),
alternative = x#statistic#alternative, method = paste(distname,
x#method), data.name = dataname, conf.int = ci$conf.int,
estimate = ci$estimate)
if (length(x#nullvalue))
RET$null.value = c(mu = x#nullvalue)
if (length(x#estimates))
RET <- c(RET, x#estimates)
class(RET) <- "htest"
print(RET)
invisible(RET)
}
<environment: namespace:coin>
The line of interest is the last item in the RET list - estimate = ci$estimate, which was calculated above as ci <- confint(object, level = object#conf.level). So with the example object, wt.ci <- confint(wt, level=.95), you can do
R> wt.ci$estimate
difference in location
-0.305
which matches
R> wt
Exact Wilcoxon Mann-Whitney Rank Sum Test
data: pd by age (12-26 Weeks, At term)
Z = -1.2247, p-value = 0.2544
alternative hypothesis: true mu is not equal to 0
95 percent confidence interval:
-0.76 0.15
sample estimates:
difference in location
-0.305
From the help file ?wilcox_test():
water_transfer <- data.frame(
pd = c(0.80, 0.83, 1.89, 1.04,
1.45, 1.38, 1.91, 1.64, 0.73, 1.46,
1.15, 0.88, 0.90, 0.74, 1.21),
age = factor(c(rep("At term", 10), rep("12-26 Weeks", 5))))
##
wt <- wilcox_test(pd ~ age, data = water_transfer,
distribution = "exact", conf.int = TRUE)

Resources