[R] No Visible Binding for global variable
Duncan Murdoch
murdoch at stats.uwo.ca
Mon Nov 16 20:34:09 CET 2009
On 11/16/2009 1:54 PM, William Dunlap wrote:
>> -----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.
Right. And if you want to keep it quiet, something like
Zobs <- NULL # to satisfy codetools
near the start of the function should work.
Duncan Murdoch
>
> 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.
>>
>
> ______________________________________________
> 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