[R] No Visible Binding for global variable
William Dunlap
wdunlap at tibco.com
Mon Nov 16 19:54:39 CET 2009
> -----Original Message-----
> From: r-help-bounces at r-project.org
> [mailto:r-help-bounces at r-project.org] On Behalf Of Doran, Harold
> Sent: Monday, November 16, 2009 10:45 AM
> To: r-help at r-project.org
> Subject: [R] No Visible Binding for global variable
>
> While building a package, I see the following:
>
> * checking R code for possible problems ... NOTE
> cheat.fit: no visible binding for global variable 'Zobs'
> plot.jml: no visible binding for global variable 'Var1'
>
> I see the issue has come up before, but I'm having a hard
> time discerning how solutions applied elsewhere would apply
> here. The entire code for both functions is below, but the
> only place the variable "Zobs" appears in the function cheat.fit is:
>
> cheaters <- cbind(data.frame(cheaters), exactMatch)
> names(cheaters)[1] <- 'Zobs'
> names(cheaters)[2] <- 'Nexact'
> cheaters$Zcrit <- Zcrit
> cheaters$Mean <- means
> cheaters$Var <- vars
> cheaters <- subset(cheaters, Zobs >= Zcrit)
The code in the codetools package does not know
that subset() does not evaluate its second argument
in the standard way. Hence it gives a false alarm
here.
Bill Dunlap
Spotfire, TIBCO Software
wdunlap tibco.com
> result <- list("pairs" =
> c(row.names(cheaters)), "Ncheat" = nrow(cheaters),
> "TotalCompare" = totalCompare, "alpha" = alpha,
> "ExactMatch" = cheaters$Nexact, "Zobs" =
> cheaters$Zobs, "Zcrit" = Zcrit,
> "Mean" = cheaters$Mean, "Variance" =
> cheaters$Var, "Probs" = stuProbs)
> result
>
> and the only place Var1 appears in the plot function is here
>
> prop.correct <- subset(data.frame(prop.table(table(tmp[,
> i+1], tmp$Estimate), margin=2)), Var1 == 1)[, 2:3]
>
> Many thanks,
> Harold
>
> > sessionInfo()
> R version 2.10.0 (2009-10-26)
> i386-pc-mingw32
>
> locale:
> [1] LC_COLLATE=English_United States.1252
> [2] LC_CTYPE=English_United States.1252
> [3] LC_MONETARY=English_United States.1252
> [4] LC_NUMERIC=C
> [5] LC_TIME=English_United States.1252
>
> attached base packages:
> [1] stats graphics grDevices utils datasets methods base
>
> cheat.fit <- function(dat, key, wrongChoice, alpha = .01, rfa
> = c('nr', 'uni', 'bsct'), bonf = c('yes','no'), con = 1e-12,
> lower = 0, upper = 50){
> bonf <- tolower(bonf)
> bonf <- match.arg(bonf)
> rfa <- match.arg(rfa)
> rfa <- tolower(rfa)
> dat <- t(dat)
> correctStuMat <- numeric(ncol(dat))
> for(i in 1:ncol(dat)){
> correctStuMat[i] <-
> mean(key==dat[,i], na.rm= TRUE)
> }
>
> correctClsMat <- numeric(length(key))
> for(i in 1:length(key)){
> correctClsMat[i] <-
> mean(key[i]==dat[i,], na.rm= TRUE)
> }
>
> ### this is here for cases if all students in a class
> ### did not answer the item
> correctClsMat[is.na(correctClsMat)] <- 0
>
> pCorr <- function(R,c,q){
>
> numer <- function(R,a,c,q){
> result <-
> sum((1-(1-R)^a)^(1/a), na.rm= TRUE)-c*q
> result
> }
>
> denom <- function(R,a,c,q){
> result <- sum(na.rm= TRUE,
> -((1 - (1 - R)^a)^(1/a) * (log((1 - (1 - R)^a)) * (1/a^2)) +
> (1 - (1 - R)^a)^((1/a) - 1) *
> ((1/a) * ((1 - R)^a * log((1 - R))))))
> result
> }
>
> aConst <- function(R, c, q, con){
> a <- .5 # starting value for a
> change <- 1
> while(abs(change) > con) {
> r1 <- numer(R,a,c,q)
> r2 <- denom(R,a,c,q)
> change <- r1/r2
> a <- a - change
> }
> a
> }
>
> bisect <- function(R, c, q, lower, upper, con){
> f <- function(a) sum((1 -
> (1-R)^a)^(1/a)) - c * q
> if(f(lower) * f(upper) > 0)
>
> stop("endpoints must have opposite signs")
> while(abs(lower-upper) > con){
> x = .5 * (lower+upper)
> if(f(x) *
> f(lower) >=0) lower = x
> else upper = x
> }
> .5 * (lower+upper)
> }
>
> if(rfa == 'nr'){
> if(any(correctClsMat==1))
> correctClsMat[correctClsMat==1]<-.9999 else correctClsMat
> if(any(correctClsMat==0))
> correctClsMat[correctClsMat==0]<-.0001 else correctClsMat
> a <- aConst(R,c,q, con)
> } else if(rfa == 'uni'){
> f <- function(R, a, c, q)
> sum((1 - (1-R)^a)^(1/a)) - c * q
> a <- uniroot(f,
> c(lower,upper), R = R, c = c, q = q)$root
> } else if(rfa == 'bsct'){
> a <- bisect(R, c, q, lower =
> lower, upper = upper, con)
> }
>
> result <- (1-(1-R)^a)^(1/a)
> result
> } # end pCorr function
>
> stuProbs <- matrix(0, ncol=ncol(dat), nrow=nrow(dat))
> for(i in 1:ncol(dat)){
> if(correctStuMat[i]==1){
> stuProbs[,i] <- 1
> } else if(correctStuMat[i]==0){
> stuProbs[,i] <- 0
> } else {
> stuProbs[,i] <-
> pCorr(correctClsMat, correctStuMat[i], q = length(key))
> }
> }
>
> stuProbs[which(is.na(dat))] <- NA # this is a
> bit kludgy. But, it places NAs in the right place
>
> matchProb <- function(StuMat, wrongMat, numItems){
> ind <- combn(c(1:ncol(StuMat)),2) # These are
> all the possible combinations
> result <- matrix(0, ncol=ncol(ind), nrow=numItems)
> for(j in 1:ncol(ind)){
> for(i in 1:numItems){
>
> if(is.na(StuMat[i,ind[1,j]]) | is.na(StuMat[i,ind[2,j]]) ) {
>
> result[i,j] <- NA
>
> } else { result[i,j] <- StuMat[i,ind[1,j]] * StuMat[i,ind[2,j]] +
>
> (1-StuMat[i,ind[1,j]]) * (1-StuMat[i,ind[2,j]]) *
> sum(wrongChoice[[i]]^2)
> }
> }
> }
> result <- data.frame(result)
> names(result) <- paste('S',paste(ind[1,],
> ind[2,], sep=''), sep='')
> result
> }
>
> aa <- matchProb(stuProbs, wrongChoice,
> numItems = nrow(dat))
>
> matchTotal <- function(dat){
> ind <- combn(c(1:ncol(dat)),2) # These are
> all the possible combinations
> Match <- numeric(ncol(ind))
> for(j in 1:ncol(ind)){
> Match[j] <- sum(dat[,
> ind[1,j]] == dat[, ind[2,j]], na.rm=TRUE) ### added this just now
> }
> Match <- data.frame(Match)
> row.names(Match) <- paste('S',paste(ind[1,],
> ind[2,], sep=':'), sep='')
> Match
> }
>
> exactMatch <- matchTotal(dat)
> means <- colSums(aa, na.rm=TRUE)
> vars <- colSums(aa*(1-aa), na.rm= TRUE)
> cheaters <- (exactMatch - .5 - means)/sqrt(vars)
> totalCompare <- nrow(cheaters)
> if(bonf == 'yes'){
> alpha <- alpha/nrow(cheaters)
> Zcrit <- qnorm(alpha, mean =
> 0, sd = 1, lower.tail = FALSE)
> } else {
> Zcrit <- qnorm(alpha, mean = 0, sd = 1, lower.tail = FALSE)
> }
>
> cheaters <- cbind(data.frame(cheaters), exactMatch)
> names(cheaters)[1] <- 'Zobs'
> names(cheaters)[2] <- 'Nexact'
> cheaters$Zcrit <- Zcrit
> cheaters$Mean <- means
> cheaters$Var <- vars
> cheaters <- subset(cheaters, Zobs >= Zcrit)
> result <- list("pairs" =
> c(row.names(cheaters)), "Ncheat" = nrow(cheaters),
> "TotalCompare" = totalCompare, "alpha" = alpha,
> "ExactMatch" = cheaters$Nexact, "Zobs" =
> cheaters$Zobs, "Zcrit" = Zcrit,
> "Mean" = cheaters$Mean, "Variance" =
> cheaters$Var, "Probs" = stuProbs)
> result
> }
>
> plot.jml <- function(x, ask = TRUE, all = TRUE, item, ...){
> par(ask = ask)
> xvals <- seq(from=-5, to =5, by=.01)
> params <- coef(x)
> L <- length(params)
> tmp <- data.frame(x$model.frame)
> tmp$Raw.Score <- rowSums(tmp)
> mle <- summary(scoreCon(coef(x)))$coef[c(1,3)]
> tmp <- merge(tmp, mle, by='Raw.Score', sort = FALSE)
> if(all){
> for(i in 1:L ){
> exp <- 1/(1 +
> exp(params[i] - xvals))
> prop.correct
> <- subset(data.frame(prop.table(table(tmp[, i+1],
> tmp$Estimate), margin=2)),
> Var1 == 1)[, 2:3]
>
> names(prop.correct)[1:2] <- c('Estimate', 'prop')
>
> prop.correct$Estimate <- as.numeric(levels(prop.correct$Estimate))
> plot(xvals,
> exp, type='l', ylim = c(0,1), xlab = 'Ability', ylab =
> 'Proportion Correct', ...)
>
> points(prop.correct$Estimate, prop.correct$prop, ...)
> title(main =
> paste("Plot of Item", i))
> }
> } else {
> par(ask = FALSE)
> i <- item
> exp <- 1/(1 + exp(params[i] - xvals))
> prop.correct <-
> subset(data.frame(prop.table(table(tmp[, i+1], tmp$Estimate),
> margin=2)),
> Var1 == 1)[, 2:3]
> names(prop.correct)[1:2] <-
> c('Estimate', 'prop')
> prop.correct$Estimate <-
> as.numeric(levels(prop.correct$Estimate))
> plot(xvals, exp, type='l',
> ylim = c(0,1), xlab = 'Ability', ylab = 'Proportion Correct', ...)
> points(prop.correct$Estimate,
> prop.correct$prop, ...)
> title(main = paste("Plot of Item", i))
> }
> par(ask = FALSE)
> }
>
> [[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.
>
More information about the R-help
mailing list