An embedded and charset-unspecified text was scrubbed... Name: not available URL: <https://stat.ethz.ch/pipermail/r-help/attachments/20091116/c0fa2704/attachment-0001.pl>
No Visible Binding for global variable
3 messages · Doran, Harold, William Dunlap, Duncan Murdoch
-----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.
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.