I am trying to use the stepacross function in the vegan package of R.
When I do, it throws an error and fails to run the code
Error in stepacross(distance.dat, path = "extended") :
object 'C_stepacross' not found
Anybody know the cause of this or what to do to fix it?
I'm using R (64-bit) 4.0.2 and vegan 2.5-6 (old version use is intentional).
It worked a few weeks ago, and I have made no changes since.
The C_stepacross object in question shows up in the stepacross() function code:
getAnywhere(stepacross)
function (dis, path = "shortest", toolong = 1, trace = TRUE,
...)
{
path <- match.arg(path, c("shortest", "extended"))
if (!inherits(dis, "dist"))
dis <- as.dist(dis)
oldatt <- attributes(dis)
n <- attr(dis, "Size")
if (path == "shortest")
dis <- .C(dykstrapath, dist = as.double(dis), n = as.integer(n),
as.double(toolong), as.integer(trace), out = double(length(dis)),
NAOK = TRUE)$out
else dis <- .C(C_stepacross, dis = as.double(dis), as.integer(n),
as.double(toolong), as.integer(trace), NAOK = TRUE)$dis
attributes(dis) <- oldatt
attr(dis, "method") <- paste(attr(dis, "method"),
path)
dis
}
You don't provide a reproducible example, but I can reproduce this problem if I don't use vegan::stepacross, but a different copy of the function. Check your workspace – it probably has a copy of this function. The C function is registred for use in vegan functions, but not for functions in other namespaces. This example will reproduce your problem:
library(vegan)
data(dune)
d <- vegdist(dune)
stepacross <- vegan::stepacross
environment(stepacross) <- environment() ## set to working environment
dd <- stepacross(d, "ext")
## Error in stepacross(d, "ext") : object 'C_stepacross' not found
dd <- vegan::stepacross(d, "ext") ### this will be OK
rm(stepacross) ## removes the local copy
dd <- stepacross(d, "ext") ## this will be OK: vegan copy was untouched
If getAnyewhere finds first a vegan version of stepacross, the last line of its output will be
<environment: namespace:vegan>
In your example this line was missing suggesting that your copy of stepacross was not in namespace:vegan. Moreover, getAnywhere should give package:vegan as the first place where this function was found.
Related
I which to use the buffer.dist() function of the GSIF package developed by Tomislav Hengl et al. (2018). It has not been updated since 2019 and was taken down from CRAN.
I downloaded the latest version of GSIF (v0.5-5 - 2019-01-04) from the CRAN repository and loaded the functions manually into the R workspace. All functions can be found in the folder "R".
> sessionInfo()
R version 4.2.1 (2022-06-23)
Platform: x86_64-apple-darwin17.0 (64-bit)
Running under: macOS Big Sur 11.6
# Manually load GSIF environment (manually download from CRAN repository)
source("AAAA.R") # needs to be loaded first
# Manually load function buffer.dist()
source("buffer.dist.R")
# Load library
library(sp)
library(plotKML)
library(raster)
library(gstat)
## Follow the workflow in the tutorial: https://peerj.com/articles/5518/GeoMLA_README_thengl.pdf
# Load example data from gstat package
data(meuse, echo = FALSE)
data(meuse.grid)
# transform into SpatialPoints objects (input data requirement for buffer.dist() )
meuse.sp <- SpatialPointsDataFrame(meuse[1:2], meuse[3:14], proj4string = CRS('+init=epsg:4326'))
meuse.grid.spdf <- SpatialPixelsDataFrame(meuse.grid[1:2], meuse.grid[6], proj4string = CRS('+init=epsg:4326'))
# derive buffer distances for each individual point, using the buffer function in the raster package which derives a gridded map for each observation point ()
grid.dist0 <- buffer.dist(meuse.sp["zinc"],
meuse.grid.spdf[1],
as.factor(1:nrow(meuse.sp)))
This gives me the following error message:
Error in x#coords[i, , drop = FALSE] : subscript out of bounds
Here is the buffer.dist() function (Hengl et al., 2018):
setMethod("buffer.dist", signature(observations = "SpatialPointsDataFrame", predictionDomain = "SpatialPixelsDataFrame"), function(observations, predictionDomain, classes, width, ...){
if(missing(width)){ width <- sqrt(areaSpatialGrid(predictionDomain)) }
if(!length(classes)==length(observations)){ stop("Length of 'observations' and 'classes' does not match.") }
## remove classes without any points:
xg = summary(classes, maxsum=length(levels(classes)))
selg.levs = attr(xg, "names")[xg > 0]
if(length(selg.levs)<length(levels(classes))){
fclasses <- as.factor(classes)
fclasses[which(!fclasses %in% selg.levs)] <- NA
classes <- droplevels(fclasses)
}
## derive buffer distances
s <- list(NULL)
for(i in 1:length(levels(classes))){
s[[i]] <- raster::distance(rasterize(observations[which(classes==levels(classes)[i]),1]#coords, y=raster(predictionDomain)), width=width, ...)
}
s <- s[sapply(s, function(x){!is.null(x)})]
s <- brick(s)
s <- as(s, "SpatialPixelsDataFrame")
s <- s[predictionDomain#grid.index,]
return(s)
})
I went through all steps of the function manually. It is in the second last row where the bug seems to occur:
s <- s[predictionDomain#grid.index,]
Error in x#coords[i, , drop = FALSE] : subscript out of bounds
Do you have any suggestion how to fix the issue?
You do not describe what that method does, but it seems that it does something like this:
bufdist <- function(obs, r, classes, width) {
s <- list()
cls <- sort(unique(classes))
for (i in 1:length(cls)) {
obsi <- obs[classes==cls[i], ]
x <- rasterize(obsi, r)
s[[i]] <- buffer(x, width, background=NA)
}
names(s) <- cls
rast(s)
}
library(terra)
f <- system.file("ex/elev.tif", package="terra")
r <- rast(f)
set.seed(1)
v <- spatSample(r, 50, as.points=TRUE)
cls <- sample(LETTERS[1:4], 50, replace=TRUE)
b <- bufdist(v, r, cls, 7500)
plot(b, col="red")
I load fPortfolio with a pre-installed data frame attached:
library(fPortfolio)
library(PerformanceAnalytics)
data("edhec")
rets <- edhec
# compute the tangency portfolio
tp <- tangencyPortfolio(as.timeSeries(edhec))
frontier <- portfolioFrontier(as.timeSeries(edhec))
#plot(frontier) # Plots frontier, don't need this
# The problem is when I run this code:
weightsSlider(object = frontier, control = list())
When I run the last line, weightsSlider I get an Error:
Error in tclVar(starts[i]) : could not find function "tclVar"
A separate window opens up that says 'window slider'.
If I run:
capabilities()["tclVar"]
I get the error:
<NA>
NA
And when I run:
tcltk::tclVar
I get the error:
function (init = "")
{
n <- .TkRoot$env$TclVarCount <- .TkRoot$env$TclVarCount +
1L
name <- paste0("::RTcl", n)
l <- list(env = new.env())
assign(name, NULL, envir = l$env)
reg.finalizer(l$env, function(env) tcl("unset", names(env)))
class(l) <- "tclVar"
tclvalue(l) <- init
l
}
<bytecode: 0x000001b271b9ddd0>
<environment: namespace:tcltk>
I installed both the tcl and the tcltk2 packages.
fPortfolio rdocumentation
fPortfolio github
I'm trying to run this code, and I'm using mhadaptive package, but the problem is that when I run these code without writing metropolis_hastings (that is one part of mhadaptive package) error does not occur, but when I add mhadaptive package the error occur. What should I do?
li_F1<-function(pars,data) #defining first function
{
a01<-pars[1] #defining parameters
a11<-pars[2]
epsilon<<-pars[3]
b11<-pars[4]
a02<-pars[5]
a12<-pars[6]
b12<-pars[7]
h<-pars[8]
h[[i]]<-list() #I want my output is be listed in the h
h[[1]]<-0.32082184 #My first value of h is known and other values should calculate by formula
for(i in 2:nrow(F_2_))
{
h[[i]]<- ((a01+a11*(h[[i-1]])*(epsilon^2)*(h[[i-1]])*b11)+(F1[,2])*((a02+a12*(h[[i-1]])*(epsilon^2)+(h[[i-1]])*b12)))
pred<- h[[i]]
}
log_likelihood<-sum(dnorm(prod(h[i]),pred,sd = 1 ,log = TRUE))
return(h[i])
prior<- prior_reg(pars)
return(log_likelihood + prior)
options(digits = 22)
}
prior_reg<-function(pars) #defining another function
{
epsilon<<-pars[3] #error
prior_epsilon<-pt(0.95,5,lower.tail = TRUE,log.p = FALSE)
return(prior_epsilon)
}
F1<-as.matrix(F_2_) #defining my importing data and simulatunig data with them
x<-F1[,1]
y<-F1[,2]
d<-cbind(x,y)
#using mhadaptive package
mcmc_r<-Metro_Hastings(li_func = li_F1,pars=c(10,15,10,10,10,15),par_names=c('a01','a02','a11','a12','b11','b12'),data=d)
By running this code this error occur.
Error in h[[i]] <- list() : replacement has length zero
I'll so much appreciate who help me.
hi i am getting this error message while installing DMwR package from RGUI-3.3.1.
Error in read.dcf(file.path(pkgname, "DESCRIPTION"), c("Package", "Type")) :
cannot open the connection
In addition: Warning messages:
1: In unzip(zipname, exdir = dest) : error 1 in extracting from zip file
2: In read.dcf(file.path(pkgname, "DESCRIPTION"), c("Package", "Type")) :
cannot open compressed file 'bitops/DESCRIPTION', probable reason 'No such file or directory'
Approach 1:
The error being reported is inability to open a connection. In Windows that is often a firewall problem and is in the Windows R FAQ. The usual first attempt should be to run internet2.dll. From a console session you can use:
setInternet2(TRUE)
NEWS for R version 3.3.1 Patched (2016-09-13 r71247)
(Windows only) Function
setInternet2()
has no effect and will be removed in due
course. The choice between methods
"internal"
and
"wininet"
is now made by the
method
arguments of
url()
and
download.file()
and their defaults can be set
via
options. The out-of-the-box default remains
"wininet"
(as it has been since
R
3.2.2)
You are using version 3.3.1, this is why it is not working anymore.
Approach 2
The error is suggesting that the package requires another package bitops that is not available. That package is not in any of the dependencies but perhaps one of the dependencies requires it in turn(In this case, it is: ROCR).
Try installing:
install.packages("bitops",repos="https://cran.r-project.org/bin/windows/contrib/3.3/bitops_1.0-6.zip",dependencies=TRUE,type="source")
The package DMwR contains packages abind, zoo, xts, quantmod and ROCR as imports. So, additionally to installing 5 packages you must install DMwR package, Install these packages manually.
Install packages in following sequence:
install.packages('abind')
install.packages('zoo')
install.packages('xts')
install.packages('quantmod')
install.packages('ROCR')
install.packages("DMwR")
library("DMwR")
Approach 3:
chooseCRANmirror()
Select CRAN mirror from popup list. Then install packages:
install.packages("bitops")
install.packages("DMwR")
Package ‘DMwR’ was removed from the CRAN repository.
Formerly available versions can be obtained from the archive.
https://CRAN.R-project.org/package=DMwR
You can use the function as written in CRAN package. Copy the following code in a new RScript, run it and save it for future use if you want. Once you run this function, you should be able to use the way you have been trying to use it.
# ===================================================
# Creating a SMOTE training sample for classification problems
#
# If called with learner=NULL (the default) is does not
# learn any model, simply returning the SMOTEd data set
#
# NOTE: It does not handle NAs!
#
# Examples:
# ms <- SMOTE(Species ~ .,iris,'setosa',perc.under=400,perc.over=300,
# learner='svm',gamma=0.001,cost=100)
# newds <- SMOTE(Species ~ .,iris,'setosa',perc.under=300,k=3,perc.over=400)
#
# L. Torgo, Feb 2010
# ---------------------------------------------------
SMOTE <- function(form,data,
perc.over=200,k=5,
perc.under=200,
learner=NULL,...
)
# INPUTS:
# form a model formula
# data the original training set (with the unbalanced distribution)
# minCl the minority class label
# per.over/100 is the number of new cases (smoted cases) generated
# for each rare case. If perc.over < 100 a single case
# is generated uniquely for a randomly selected perc.over
# of the rare cases
# k is the number of neighbours to consider as the pool from where
# the new examples are generated
# perc.under/100 is the number of "normal" cases that are randomly
# selected for each smoted case
# learner the learning system to use.
# ... any learning parameters to pass to learner
{
# the column where the target variable is
tgt <- which(names(data) == as.character(form[[2]]))
minCl <- levels(data[,tgt])[which.min(table(data[,tgt]))]
# get the cases of the minority class
minExs <- which(data[,tgt] == minCl)
# generate synthetic cases from these minExs
if (tgt < ncol(data)) {
cols <- 1:ncol(data)
cols[c(tgt,ncol(data))] <- cols[c(ncol(data),tgt)]
data <- data[,cols]
}
newExs <- smote.exs(data[minExs,],ncol(data),perc.over,k)
if (tgt < ncol(data)) {
newExs <- newExs[,cols]
data <- data[,cols]
}
# get the undersample of the "majority class" examples
selMaj <- sample((1:NROW(data))[-minExs],
as.integer((perc.under/100)*nrow(newExs)),
replace=T)
# the final data set (the undersample+the rare cases+the smoted exs)
newdataset <- rbind(data[selMaj,],data[minExs,],newExs)
# learn a model if required
if (is.null(learner)) return(newdataset)
else do.call(learner,list(form,newdataset,...))
}
# ===================================================
# Obtain a set of smoted examples for a set of rare cases.
# L. Torgo, Feb 2010
# ---------------------------------------------------
smote.exs <- function(data,tgt,N,k)
# INPUTS:
# data are the rare cases (the minority "class" cases)
# tgt is the name of the target variable
# N is the percentage of over-sampling to carry out;
# and k is the number of nearest neighours to use for the generation
# OUTPUTS:
# The result of the function is a (N/100)*T set of generated
# examples with rare values on the target
{
nomatr <- c()
T <- matrix(nrow=dim(data)[1],ncol=dim(data)[2]-1)
for(col in seq.int(dim(T)[2]))
if (class(data[,col]) %in% c('factor','character')) {
T[,col] <- as.integer(data[,col])
nomatr <- c(nomatr,col)
} else T[,col] <- data[,col]
if (N < 100) { # only a percentage of the T cases will be SMOTEd
nT <- NROW(T)
idx <- sample(1:nT,as.integer((N/100)*nT))
T <- T[idx,]
N <- 100
}
p <- dim(T)[2]
nT <- dim(T)[1]
ranges <- apply(T,2,max)-apply(T,2,min)
nexs <- as.integer(N/100) # this is the number of artificial exs generated
# for each member of T
new <- matrix(nrow=nexs*nT,ncol=p) # the new cases
for(i in 1:nT) {
# the k NNs of case T[i,]
xd <- scale(T,T[i,],ranges)
for(a in nomatr) xd[,a] <- xd[,a]==0
dd <- drop(xd^2 %*% rep(1, ncol(xd)))
kNNs <- order(dd)[2:(k+1)]
for(n in 1:nexs) {
# select randomly one of the k NNs
neig <- sample(1:k,1)
ex <- vector(length=ncol(T))
# the attribute values of the generated case
difs <- T[kNNs[neig],]-T[i,]
new[(i-1)*nexs+n,] <- T[i,]+runif(1)*difs
for(a in nomatr)
new[(i-1)*nexs+n,a] <- c(T[kNNs[neig],a],T[i,a])[1+round(runif(1),0)]
}
}
newCases <- data.frame(new)
for(a in nomatr)
newCases[,a] <- factor(newCases[,a],levels=1:nlevels(data[,a]),labels=levels(data[,a]))
newCases[,tgt] <- factor(rep(data[1,tgt],nrow(newCases)),levels=levels(data[,tgt]))
colnames(newCases) <- colnames(data)
newCases
}
It has been removed from the CRAN library. There are instructions on how to retrieve it from the archive.
Either follow the link - https://packagemanager.rstudio.com/client/#/repos/2/packages/DMwR
OR copy-paste the three lines of code mentioned below:
install.packages("devtools")
devtools::install_version('DMwR', '0.4.1')
library("DMwR")
EDIT: this is the error I got while downloading the DMwR package in 2022, but looks like when the question was posted, the error happened because of another reason.
The reason is that the package 'DMwR' was built under R version 3.4.3 So the solution is actually explained in the marked answer in details. Hence, to be short:Just run the script below to get the problem solved!
install.packages('abind')
install.packages('zoo')
install.packages('xts')
install.packages('quantmod')
install.packages('ROCR')
install.packages("DMwR")
library("DMwR")
I'm trying to duplicate some code and am running into troubles with WinBUGS. The code was written in 2010 and I think that back then, the package was installed with additional files which R is now looking for and can't find (hence the error), but I'm not sure.
R stops trying to run #bugs.directory (see code) and the error is:
Error in file(con, "rb") : cannot open the connection
In addition: Warning message:
In file(con, "rb") :
cannot open file 'C:/Users/Hiwi/Documents/R/Win-library/3.0/R2winBUGS/System/Rsrc/Registry.odc': No such file or directory
Error in bugs.run(n.burnin, bugs.directory, WINE = WINE, useWINE = useWINE, :
WinBUGS executable does not exist in C:/Users/Hiwi/Documents/R/Win-library/3.0/R2winBUGS
I have the results of the analysis so if there is another way of conducting a Bayesian analysis for the "rawdata" file (in the 14 day model with [-3,0] event window) or if someone would PLEASE shed some light on what's wrong with the code, I would be forever grateful.
The code is:
rm(list=ls(all=TRUE))
setwd("C:/Users/Hiwi/Dropbox/Oracle/Oracle CD files/analysis/chapter6_a")
library(foreign)
rawdata <- read.dta("nyt.dta",convert.factors = F)
library(MASS)
summary(glm.nb(rawdata$num_events_14 ~ rawdata$nyt_num))
# WinBUGS code
library("R2WinBUGS")
nb.model <- function(){
for (i in 1:n){ # loop for all observations
# stochastic component
dv[i]~dnegbin( p[i], r)
# link and linear predictor
p[i] <- r/(r+lambda[i])
log(lambda[i] ) <- b[1] + b[2] * iv[i]
}
#
# prior distributions
r <- exp(logr)
logr ~ dnorm(0.0, 0.01)
b[1]~dnorm(0,0.001) # prior (please note: second element is 1/variance)
b[2]~dnorm(0,0.001) # prior
}
write.model(nb.model, "negativebinomial.bug")
n <- dim(rawdata)[1] # number of observations
winbug.data <- list(dv = rawdata$num_events_14,
iv = rawdata$nyt_num,
n=n)
winbug.inits <- function(){list(logr = 0 ,b=c(2.46,-.37)
)} # Ausgangswerte aus der Uniformverteilung zwischen -1 und 1
bug.erg <- bugs(data=winbug.data,
inits=winbug.inits,
#inits=NULL,
parameters.to.save = c("b","r"),
model.file="negativebinomial.bug",
n.chains=3, n.iter=10000, n.burnin=5000,
n.thin=1,
codaPkg=T,
debug=F,
#bugs.directory="C:/Users/Hiwi/Documents/R/Win-library/3.0/R2winBUGS/"
bugs.directory="C:/Users/Hiwi/Documents/R/Win-library/3.0/R2winBUGS"
)
tempdir()
setwd(tempdir())
file.rename("codaIndex.txt","simIndex.txt")
file.rename("coda1.txt","sim1.txt")
file.rename("coda2.txt","sim2.txt")
file.rename("coda3.txt","sim3.txt")
posterior <- rbind(read.coda("sim1.txt","simIndex.txt"),read.coda("sim2.txt","simIndex.txt"),read.coda("sim3.txt","simIndex.txt"))
post.df <- as.data.frame(posterior)
summary(post.df)
quantile(post.df[,2],probs=c(.025,.975))
quantile(post.df[,2],probs=c(.05,.95))
quantile(post.df[,2],probs=c(.10,.90))
tempdir()
Difficult to say for sure without sitting at your PC... Maybe it is something to do with R2WinBUGS looking in the wrong directory for WinBUGS.exe? You can point R2WinBUGS to the right place using the bugs.directory argument in the bugs function.
If not, try and install OpenBUGS and give R2OpenBUGS a go.