how to make a loop function with "adonis"? - r

data(dune)
data(dune.env)
results<-list()
for (i in colnames(dune.env)){
results[[i]]<- adonis(dune ~ i, data=dune.env, permutations=99)
}
When I test each name in colnames(dune.env), it can work.
But it can not work in the loop function above. I think it is due to the i in the loop fuction has " ". How to fix it? Thanks.

I know nothing about adonis, but I do know that formulas are language objects which do not take nicely to being treated as though they were ordinary character objects.
for (i in colnames(dune.env)){
form <- as.formula(paste("dune", i, sep="~"))
results[[i]]<- adonis(form, data=dune.env, permutations=99)
}

Related

print text when calling a model

I hope this is not a double post. I've been looking for an answer.
I have a function that returns a rather big list. So i would like it to print some text in between all the results of the list. A bit as you know it from lm and other models.
Consider this R script
y<-function(z)
{
l<-list()
print("hello world")
l$answer<-2*z
return(l)
}
x<-y(5)
This is a small example. I tried a solution with print but this is a bad solution , simply because it executes print when i save the variable as x<-fun(5). I just want it to execute text when you ask it explicit, or even better,if you can construct your own "summary" command to a list.
Thanks for your time.
If I understood what you want to do , I think you are looking to implement the S3method print.
set the class attribute :"someclass" of the y function return value
define print.someclass
here the code:
y<-function(z)
{
l<-list()
l$answer<-2*z
## Roland comment : usually better to preserve existing classes:
class(l) <- c('someclass', class(l))
return(l)
}
print.someclass<-
function(x,...){ ## add here what you want to print
print("hello world")
}
x<-y(5)
Now when you type x at console or print(x):
x
[1] "hello world"

Add formula into function

I have this example data
install.packages('neuralnet')
library(neuralnet)
DV<-runif(20,min=-3,max=3)
RV_1<-runif(20,min=-3,max=3)
RV_2<-runif(20,min=-3,max=3)
formula<-'RV_1+RV_2'
df<-data.frame(DV=DV,RV_1=DV_1,RV2=RV_2)
and I learn the neural network this way
neuralnet(DV~RV_1+RV_2,data=df,hidden=5)
and everything works well.
But if I need to use it in function for more combinations I need to use it like
testfun<-function(x,y){
nnet<<-neuralnet(x~y,data=df,hidden=5)
}
testfun(DV,formula)
Which doesn't work
I've tried these approaches
testfun<-function(x,y){
nnet<<-neuralnet(print(x,quote=FALSE)~print(y,quote=FALSE),data=df,hidden=5)
}
or
testfun<-function(x,y){
nnet<<-neuralnet(as.symbol(x)~as.symbol(y),data=df,hidden=5)
}
or
testfun<-function(x,y){
nnet<<-neuralnet(get(x)~get(y),data=df,hidden=5)
}
But nothing works. The problem is that I cannot change the formula object and I still cannot go trough.
Any advices how to solve this problem?
Try this?
testfun<-function(x,y) {
neuralnet(as.formula(paste(x, "~", y, sep ="")), data=df, hidden=5)
}
nnet <- testfun("var1", "var2")

Warning meassage: number of items to replace is not a multiple of replacement length

I got warnings when running this code.
For example, when I put
tm1<- summary(tmfit)[c(4,8,9)],
I can get the result, but I need to run this code for each $i$.
Why do I get this error?
Is there any way to do this instead of via a for loop?
Specifically, I have many regressants ($y$) with the same two regressors ($x$'s).
How I can get these results of regression analysis(to make some comparisons)?
dreg=read.csv("dayreg.csv")
fundr=read.csv("fundreturnday.csv")
num=ncol(fundr)
exr=dreg[,2]
tm=dreg[,4]
for(i in 2:num)
{
tmfit=lm(fundr[,i]~exr+tm)
tm1[i]<- summary(tmfit)[c(4,8,9)]
}
Any help is highly appreciated
Try storing your result into a list instead of a vector.
dreg=read.csv("dayreg.csv")
fundr=read.csv("fundreturnday.csv")
num=ncol(fundr)
exr=dreg[,2]
tm = list()
for(i in 2:num)
{
tmfit=lm(fundr[,i]~exr+tm)
tm1[[i]]<- summary(tmfit)[c(4,8,9)]
}
You can look at an element in the list like so
tm1[[2]]

how to subtract two vectors in OpenBUGS

I am having a very hard time trying to subtract two vectors in my OpenBUGS model. The last line of the code below keeps giving the error "expected right parenthesis error":
model {
for ( i in 1:N) {
for(j in 1:q) {
vv[i,j] ~ dnorm(vz[i,j],tau.eta[j])
}
vz[i,1:q] ~ dmnorm(media.z[i,], K.delta[,])
for(j in 1:q) {
mean.z[i,j] <- inprod(K[i,] , vbeta[j,])
}
K[i,1] <- 1.0
for(j in 1:N) {
K[i,j+1] <- sum(ve[,i] - ve[,j])
}
}
If I change that line to K[i,j+1] <- sum(ve[,i]) - sum(ve[,j]), then the model works fine, but that is not what I want to do. I would like to subtract element-wise.
I searched SO for OpenBUGS, but there are only a few unrelated topics:
OpenBUGS - Variable is not defined
OpenBUGS: missing value in Bernoulli distribution
In Stats Stack Exchange there is this post which is close, but I still could not make how to implement this in my model:
https://stats.stackexchange.com/questions/20653/vector-multiplication-in-bugs-and-jags/20739#20739
I understand I have to write a for loop, but this thing is sure giving me a big headache. :)
I tried changing that line to:
for(k in 1:p) { temp [k] <- ve[k,i] - ve[k,j] }
K[i,j+1] <- sum(temp[])
where 'p' is the number of rows in each 've'. Now I keep getting the error "multiple definitions of node temp[1]".
I could definitely use some help. It will be much appreciated.
Best regards to all and thanks in advance!
PS: I wanted to add the tag "OpenBUGS" to this question but unfortunately I couldn't because it would be a new tag and I do not have enough reputation. I added "winbugs" instead.
The "multiple definitions" error is because temp[k] is redefined over and over again within a loop over i and another loop over j - you can only define it once. To get around that, use i and j subscripts like
for(k in 1:p) { temp[k,i,j] <- ve[k,i] - ve[k,j] }
K[i,j+1] <- sum(temp[,i,j])
Though if that compiles and runs, I'd check the results to make sure that's exactly what you want mathematically.

R's text mining package... adding a new function to getTransformation

I am attempting to add a new stemmer that works using a table look up method. if h is the hash the contains the stemming operation, it is encoded as follows: keys as words before stemming and values as words post-stemming.
I would like to ideally add a custom hash that allows me to do the following
myCorpus = tm_map(myCorpus, replaceWords, h)
the replaceWords function is applied to each document in myCorpus and uses the hash to stem the contents of the document
Here is the sample code from my replaceWords function
$hash_replace <- function(x,h) {
if (length(h[[x]])>0) {
return(h[[x]])
} else {
return(x)
}
}
replaceWords <- function(x,h) {
y = tolower(unlist(strsplit(x," ")))
y=y[which(as.logical(nchar(y)))]
z = unlist(lapply(y,hash_replace,h))
return(paste(unlist(z),collapse=' '))
}
Although this works, the transformed corpus is no longer contains content of type "TextDocument" or "PlainTextDocument" but of type "character"
I tried using
return(as.PlainTextDocument(paste(unlist(z),collapse=' ')))
but that that gives me an error while trying to run.
In the previous versions of the R's tm package, I did see a replaceWords function that allowed for synonym and WORDNET based subtitution. But I no longer see it in the current version of tm package (especially when I call the function getTransformations())
Does anybody out there have ideas on how I can make this happen?
Any help is greatly appreciated.
Cheers,
Shivani
Thanks,
Shivani Rao
You just need to use the PlainTextDocument function instead of as.PlainTextDocument. R will automatically return the last statement in your function, so it works if you just make the last line
PlainTextDocument(paste(unlist(z),collapse=' '))

Resources