[R] function output with for loop and if statement
Gavin Simpson
gavin.simpson at ucl.ac.uk
Thu Apr 23 10:18:17 CEST 2009
On Wed, 2009-04-22 at 15:51 -0400, aaron wells wrote:
> Hello all, turns out i'm having a bad R week. I am at my wits end
> with a function that I am trying to write. When I run the lines of
> code outside of a function, I get the desired output. When I wrap the
> lines of code into a function it doesn't work as expected. Not sure
> what is going on here. I suspected that the syntax of the if
> statement with the for loop was the culprit, but when I only ran the
> part of the code with the for loop with no if statement I still had
> the above problem (works outside function, fails when wrapped into a
> function). Below is the code and example output. Please help!
It would help a lot if you spaced your code out a bit around key
operators and structural elements.
Anyway, you didn't enclose the if/else blocks in {} in such cases, only
the line following the if(...) is run if the clause is TRUE - the lines
after that, but the code you provided doesn't even load into R - the
lone else is a syntax error. So it is a bit difficult to see what is
going on and you don;t provide an example any of us can reproduce as we
don't have your data objects.
I edited your functions below to do what I think you intended and to
clean it up a bit. Perhaps we can use this as starting point if the
function here:
`concov.test` <- function(vegetation, specieslist)
{
test.veg <- vegetation
names(test.veg) <- specieslist$LifeForm
nams <- unique(names(test.veg))
tmp <- matrix(nrow = nrow(test.veg), ncol = length(nams))
for (i in nams) {
test.out <- apply(test.veg[, names(test.veg)==i], 1, sum)
tmp.match <- nams[nams==i]
tmp.col <- match(tmp.match, nams)
tmp[1:nrow(test.veg), tmp.col] <- test.out
tmp.out <- data.frame(row.names(test.veg), tmp, row.names = 1)
names(tmp.out) <- nams
## do you need this or is this for debugging?
print(tmp.out)
tmp.out.sort <- tmp.out[, order(names(tmp.out))]
}
if(table(names(tmp.out))[i] == 1) {
nams.srt <- names(tmp.out.sort)
tmp.match2 <- nams.srt[nams.srt == i]
tmp.col2 <- match(tmp.match2, names.srt)
tmp.out.sort[1:nrow(test.veg), tmp.col2] <-
test.veg[, names(test.veg)==i]
return(tmp.out.sort)
} else {
return(tmp.out.sort)
}
}
doesn't do what you want. Please provide a small, reproducible example
(that means with data, dummy or otherwise) so we can run the code and
test changes against your data.
HTH
G
>
>
> Thanks,
>
> Aaron
>
>
>
> concov.test<-function(vegetation,specieslist)
> {
> test.veg<-vegetation
> names(test.veg)<-specieslist$LifeForm
> tmp<-matrix(nrow=nrow(test.veg),ncol=length(unique(names(test.veg))))
> for (i in unique(names(test.veg))) {test.out<-apply(test.veg[,names(test.veg)==i],1,sum)
> tmp.match<-unique(names(test.veg))[unique(names(test.veg))==i]
> tmp.col<-match(tmp.match,unique(names(test.veg)))
> tmp[1:nrow(test.veg),tmp.col]<-test.out
> tmp.out<-data.frame(row.names(test.veg),tmp,row.names=1);names(tmp.out)<-unique(names(test.veg))
> tmp.out
> tmp.out.sort<-tmp.out[,order(names(tmp.out))]
> }
> if(table(names(tmp.out))[i]==1)
> tmp.match2<-names(tmp.out.sort)[names(tmp.out.sort)==i]
> tmp.col2<-match(tmp.match2,names(tmp.out.sort))
> tmp.out.sort[1:nrow(test.veg),tmp.col2]<-test.veg[,names(test.veg)==i]
> return(tmp.out.sort)
> else return(tmp.out.sort)
> }
>
>
>
> ----Incorrect output when run as function-----
>
>
>
> > test<-concov.test(ansveg_all,spplist.class)
> > test
> Bare_Ground Deciduous_Shrubs Deciduous_Tree Evergreen_Shrubs Evergreen_Tree Forbs Grasses Lichens Mosses Sedges
> ANSG_T01_01_2008 NA NA NA NA NA NA NA NA 95.0 NA
> ANSG_T01_02_2008 NA NA NA NA NA NA NA NA 16.0 NA
> ANSG_T01_03_2008 NA NA NA NA NA NA NA NA 71.0 NA
> ANSG_T01_04_2008 NA NA NA NA NA NA NA NA 10.0 NA
> ANSG_T02_01_2008 NA NA NA NA NA NA NA NA 92.2 NA
> ANSG_T02_02_2008 NA NA NA NA NA NA NA NA 14.0 NA
>
> .
>
> .
>
> .
>
>
>
> ----Correct output when code is run outside of a function----
>
>
>
> > test.veg<-ansveg_all
> > names(test.veg)<-spplist.class$LifeForm
> > tmp<-matrix(nrow=nrow(test.veg),ncol=length(unique(names(test.veg))))
> >
> > for (i in unique(names(test.veg))) {test.out<-apply(test.veg[,names(test.veg)==i],1,sum)
> + tmp.match<-unique(names(test.veg))[unique(names(test.veg))==i]
> + tmp.col<-match(tmp.match,unique(names(test.veg)))
> + tmp[1:nrow(test.veg),tmp.col]<-test.out
> + tmp.out<-data.frame(row.names(test.veg),tmp,row.names=1);names(tmp.out)<-unique(names(test.veg))
> + tmp.out
> + tmp.out.sort<-tmp.out[,order(names(tmp.out))]
> + }
> > if(table(names(tmp.out))[i]==1)
> + tmp.match2<-names(tmp.out.sort)[names(tmp.out.sort)==i]
> > tmp.col2<-match(tmp.match2,names(tmp.out.sort))
> > tmp.out.sort[1:nrow(test.veg),tmp.col2]<-test.veg[,names(test.veg)==i]
> > return(tmp.out.sort)
> > else return(tmp.out.sort)
> >
> >
> > tmp.out.sort
> Bare_Ground Deciduous_Shrubs Deciduous_Tree Evergreen_Shrubs Evergreen_Tree Forbs Grasses Lichens Mosses Sedges
> ANSG_T01_01_2008 0 57.0 1.0 40.0 35.0 22.0 5.0 35.0 95.0 1.1
> ANSG_T01_02_2008 0 0.0 0.0 0.0 0.0 34.0 0.0 0.0 16.0 24.0
> ANSG_T01_03_2008 0 31.0 0.0 47.0 1.0 9.1 3.0 3.0 71.0 14.0
> ANSG_T01_04_2008 0 0.0 0.0 12.0 0.0 13.2 0.0 0.0 10.0 16.0
> ANSG_T02_01_2008 0 15.0 1.0 22.0 36.0 9.2 2.0 38.0 92.2 0.1
> ANSG_T02_02_2008 0 33.0 66.0 23.0 2.0 5.0 0.0 3.0 14.0 0.0
> .
>
> .
>
> .
>
>
> _________________________________________________________________
> Rediscover Hotmail: Get quick friend updates right in your inbox.
>
> Updates2_042009
> [[alternative HTML version deleted]]
>
> ______________________________________________
> R-help at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-help
> PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
> and provide commented, minimal, self-contained, reproducible code.
--
%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%
Dr. Gavin Simpson [t] +44 (0)20 7679 0522
ECRC, UCL Geography, [f] +44 (0)20 7679 0565
Pearson Building, [e] gavin.simpsonATNOSPAMucl.ac.uk
Gower Street, London [w] http://www.ucl.ac.uk/~ucfagls/
UK. WC1E 6BT. [w] http://www.freshwaters.org.uk
%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%~%
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 197 bytes
Desc: This is a digitally signed message part
URL: <https://stat.ethz.ch/pipermail/r-help/attachments/20090423/354e43a6/attachment-0002.bin>
More information about the R-help
mailing list