[R] Need help with vector designations in a Function

From: <khobson_at_fd9ns01.okladot.state.ok.us>
Date: Fri 13 May 2005 - 03:14:23 EST

My function works fine if the X and Y exist in the T314 data. How can I code the macro to allow vector designations in the function different than X and Y? Maybe something to do with environment?

rm(list=ls())

# Data from NCHRP Appendix A -
http://trb.org/publications/nchrp/nchrp_w71.pdf T314 <- structure(list(Lab = as.integer(c(1:60)), X = c(4.89, 3.82, 2.57,

2.3,2.034, 2, 1.97, 1.85,1.85, 1.85, 1.84, 1.82, 1.82, 1.77, 1.76, 1.67,
1.66,
1.63, 1.62,1.62, 1.55, 1.54, 1.54, 1.53, 1.53, 1.44, 1.428, 1.42, 1.39,
1.36,
1.35, 1.31, 1.28, 1.24, 1.24, 1.23, 1.22, 1.21, 1.19, 1.18, 1.18, 1.18,
1.17,
1.16, 1.13, 1.13, 1.099, 1.09, 1.09, 1.08, 1.07, 1.05, 0.98, 0.97, 0.84,
0.808,
0.69, 0.63, 0.6, 0.5), Y = c(5.28, 3.82, 2.41, 2.32, 2.211, 1.46, 2.24,
1.91,
1.78, 1.63, 1.81, 1.92, 1.2, 1.67, 1.28, 1.59, 1.45, 2.06, 1.91, 1.19,
1.26,
1.79, 1.39, 1.48, 0.72, 1.29, 1.517, 1.71, 1.12, 1.38, 0.93, 1.36, 1.2,
1.23,
0.71, 1.29, 1.26, 1.48, 1.26, 1.33, 1.21, 1.04, 1.57, 1.42, 1.08, 1.04,
1.33,
1.33, 1.2, 1.05, 1.24, 0.91, 0.99, 1.06, 1.27, 0.702, 0.77, 0.58, 1,
0.38)),

.Names = c("Lab", "X", "Y" ), class = "data.frame", row.names = as.character(c(1:60)))

### Be sure to remove NA data prior to oOut() oOut <- function(dsin, dsout, X, Y)
  {
  oOutsub <- function(olimit){
# Get Medians for Invalid Data Determination
    Xmed <- median(dsin$X); Ymed <- median(dsin$Y)
# Make new dataset with (Y-X)-(Ymedian-Xmedian) column
    dsout <- cbind(dsin, XY=(dsin$Y-dsin$X)-(Ymed-Xmed))
# Get median for new column
    XYmed <- median(dsout$XY)
    iqx <- diff(quantile(dsin$X, c(0.125, .875)))     iqy <- diff(quantile(dsin$Y, c(0.125, .875)))     iqxy <- diff(quantile(dsout$XY, c(0.125, .875)))
# Invalid Upper Limits

    iulX <- quantile(dsin$X, 0.875)+olimit*iqx

    iulY <- quantile(dsin$Y, 0.875)+olimit*iqy     iulXY <- quantile(dsout$XY, 0.875)+olimit*iqxy
# Invalid Lower Limits

    illX <- quantile(dsin$X, 0.125)-olimit*iqx     illY <- quantile(dsin$Y, 0.125)-olimit*iqy     illXY <- quantile(dsout$XY, 0.125)-olimit*iqxy

    dsout <- subset(dsout, with(dsout, X <= iulX & X >= illX))
    dsout <- subset(dsout, with(dsout, Y <= iulY & Y >= illY))
    dsout <- subset(dsout, with(dsout, XY <= iulXY & XY >= illXY))
    dsout
    }
  dsout <- oOutsub(1.555) #Eliminates Invalid Data   dsin <- dsout
  dsout <- oOutsub(0.674) #Eliminates Outlier Data   dsout <- dsout[1:(ncol(dsout)-2)] #Trim outer 2 XY columns   dsout
  }

T314.o <- oOut(T314, T314.o, X, Y)
T314.o # showing resutls. Notice 2nd XY name

cv <- function(x)
{
sd(x)/(mean(x))*100
}

T314 <- cbind(T314, X.mean=mean(T314$X))
T314 <- cbind(T314, X.sd=sd(T314$X))
T314 <- cbind(T314, X.cv=cv(T314$X))
T314 <- cbind(T314, Y.count=NROW(T314$Y))
T314 <- cbind(T314, Y.mean=mean(T314$Y))
T314 <- cbind(T314, Y.sd=sd(T314$Y))
T314 <- cbind(T314, Y.cv=cv(T314$Y))

T314.o <- cbind(T314.o, X.mean=mean(T314.o$X))
T314.o <- cbind(T314.o, X.sd=sd(T314.o$X))
T314.o <- cbind(T314.o, X.cv=cv(T314.o$X))
T314.o <- cbind(T314.o, Y.count=NROW(T314.o$Y))
T314.o <- cbind(T314.o, Y.mean=mean(T314.o$Y))
T314.o <- cbind(T314.o, Y.sd=sd(T314.o$Y)) T314.o <- cbind(T314.o, Y.cv=cv(T314.o$Y))

T314.o <- cbind(T314.o, ElimLabs=paste(setdiff(T314$Lab, T314.o$Lab), collapse=", "))
# Number of standard deviations
T314.o <- cbind(T314.o, X.nsd=(T314.o$X-T314.o$X.mean)/T314.o$X.sd) T314.o <- cbind(T314.o, Y.nsd=(T314.o$Y-T314.o$Y.mean)/T314.o$Y.sd) # X Ratings next
T314.o<-cbind(T314.o, X.rate=NA)
for (i in 1:nrow(T314.o))

{s<-ifelse(T314.o$X.nsd[i]<0,-1,1)
if(abs(T314.o$X.nsd[i])<1) T314.o$X.rate[i]=s*5
if(abs(T314.o$X.nsd[i])>=1 & T314.o$X.nsd[i]<1.5) T314.o$X.rate[i]=s*4
if(abs(T314.o$X.nsd[i])>=1.5 & T314.o$X.nsd[i]<2) T314.o$X.rate[i]=s*3
if(abs(T314.o$X.nsd[i])>=2 & T314.o$X.nsd[i]<2.5) T314.o$X.rate[i]=s*2
if(abs(T314.o$X.nsd[i])>=2.5 & T314.o$X.nsd[i]<3) T314.o$X.rate[i]=s*1
if(abs(T314.o$X.nsd[i])>=3) T314.o$X.rate[i]=0
}
# Y Ratings next
T314.o<-cbind(T314.o, Y.rate=NA)
for (i in 1:nrow(T314.o))
{s<-ifelse(T314.o$Y.nsd[i]<0,-1,1)
if(abs(T314.o$Y.nsd[i])<1) T314.o$Y.rate[i]=s*5
if(abs(T314.o$Y.nsd[i])>=1 & T314.o$Y.nsd[i]<1.5) T314.o$Y.rate[i]=s*4
if(abs(T314.o$Y.nsd[i])>=1.5 & T314.o$Y.nsd[i]<2) T314.o$Y.rate[i]=s*3
if(abs(T314.o$Y.nsd[i])>=2 & T314.o$Y.nsd[i]<2.5) T314.o$Y.rate[i]=s*2
if(abs(T314.o$Y.nsd[i])>=2.5 & T314.o$Y.nsd[i]<3) T314.o$Y.rate[i]=s*1
if(abs(T314.o$Y.nsd[i])>=3) T314.o$Y.rate[i]=0
}

mailto:khobson@odot.org
Kenneth Ray Hobson, P.E.
Oklahoma DOT - QA & IAS Manager
200 N.E. 21st Street
Oklahoma City, OK 73105-3204
(405) 522-4985, (405) 522-0552 fax

Visit our website at:
http://www.okladot.state.ok.us/materials/materials.htm



R-help@stat.math.ethz.ch mailing list
https://stat.ethz.ch/mailman/listinfo/r-help PLEASE do read the posting guide! http://www.R-project.org/posting-guide.html Received on Fri May 13 03:18:58 2005

This archive was generated by hypermail 2.1.8 : Fri 03 Mar 2006 - 03:31:44 EST