R CMD Check Errors on Examples, Examples Work - r

I don't have as much computer science experience so I'm a bit overwhelmed! I have an R package that is already released on the CRAN. It passed its CMD checks and worked fine, but I made a change. It is a Gibbs sampler, so I had it output quantile based CIs, but I changed it to HPD. But now it's failing it's CMD checks and I don't know why. The specific problem is with the examples. I have run the examples and they seem to work. I have also tried dontrun and donttest, but the same error occurred. The strangest thing is that R automatically provides the result of its attempts to run the code, with the error report. But the output provided appears accurate. Everything seems to be working, except the CMD check flags it as an error and stops the checks. Please help! I am really not a computer scientist, so I am very much out of my element! The error is at the bottom! Thank you all!
Error:
base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
base::cat("bcor", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
Error in format(x[1L:3L], digits = 7L) : unused argument (digits = 7)
Calls: ->
Execution halted
Problem code (though this isn't the only one that's had issues, depending on which is tested first):
bcor=function(data,iter,burn,seed,CI,S0,nu0,mu0){
filler=matrix(nrow=ncol(data),ncol=ncol(data))
for (a in 1:ncol(data)){
for (b in 1:ncol(data)){
filler[a,b]=ifelse(a==b,cov(data,use="pairwise.complete.obs")[a,b],0)}}
filler1=matrix(nrow=ncol(data),ncol=ncol(data))
for (a in 1:ncol(data)){
for (b in 1:ncol(data)){
filler1[a,b]=ifelse(missing(S0),filler[a,b],S0[a,b])}}
for (a in 1:ncol(data)){
for (b in 1:ncol(data)){
filler1[a,b]=ifelse(missing(S0),filler[a,b],S0[a,b])}}
S0=filler1
L0=S0
nu0=ifelse(missing(nu0),ncol(data)*(ncol(data)+1)/2-1,nu0)
filler2=vector(length=ncol(data))
for (a in 1:ncol(data)){
filler2[a]=ifelse(missing(mu0),rep(0,ncol(data)),mu0)
}
mu0=filler2
n=nrow(data)
ybar=colMeans(data,na.rm=T)
Sigma=cov(data,use="pairwise.complete.obs")
seed=ifelse(missing(seed),999,seed)
iter=ifelse(missing(iter),5000,iter)
burn=ifelse(missing(burn),iter/2,burn)
THETA=SIGMA=NULL
set.seed(seed)
pct=rep(0,iter+1)
print(noquote("Sampling, this may take a minute"))
for(s in 1:iter)
{
###Update theta
Ln=solve(solve(L0) + n*solve(Sigma))
mun=Ln%*%(solve(L0)%*%mu0+n*solve(Sigma)%*%ybar)
theta=mvrnorm(1,mun,Ln)
###Update sigma
Sn=S0 + (t(data)-c(theta))%*%t( t(data)-c(theta))
Sigma=solve(rwish(nu0+n, solve(Sn)))
###Save results
THETA=rbind(THETA,theta)
SIGMA=rbind(SIGMA,c(Sigma))
pct[s+1]=(round(s/iter*10,1))*10
if(pct[s+1]!=pct[s]){print(noquote(paste(pct[s+1],"%")))}
}
CI=ifelse(missing(CI),0.95,CI)
CI=ifelse(CI>1,CI/100,CI)
COR=NULL
mat=matrix(nrow=ncol(data),ncol=ncol(data))
cor=matrix(nrow=ncol(data),ncol=ncol(data),0)
print(noquote("Calculating correlations, this may take a minute"))
pct=rep(0,nrow(SIGMA)-burn+1)
for (s in burn:nrow(SIGMA)){
mat=matrix(SIGMA[s,],nrow=ncol(data),ncol=ncol(data))
for (a in 1:ncol(data)){
for (b in 1:ncol(data)){
cor[a,b]=mat[a,b]/sqrt(mat[a,a]*mat[b,b])
COR=rbind(COR,c(cor))
}
}
num=(s-burn+1)
denom=(nrow(SIGMA)-burn)
pct[s-burn+2]=round((num/denom)*10,1)*10
if(pct[s-burn+2]!=pct[s-burn+1]){print(noquote(paste(pct[s-burn+2],"%")))}
}
COR_M=NULL
COR_SD=NULL
COR_LL=NULL
COR_UL=NULL
for (a in 1:ncol(COR)){
COR_M[a]=quantile(probs=c(0.5),COR[,a])
COR_SD=sd(COR[1:nrow(COR),a])
COR_LL[a]=emp.hpd(COR[,a],conf=CI)[1]
COR_UL[a]=emp.hpd(COR[,a],conf=CI)[2]
}
star_ll=ifelse(COR_LL<0,1,0)
star_ul=ifelse(COR_UL<0,1,0)
star=ifelse(star_ll+star_ul==1," ","*")
COR_M1=paste(round(COR_M,2),star)
COR1=matrix(COR_M1,nrow=ncol(data),ncol=ncol(data))
table=data.frame(COR1)
colnames(table)=c(colnames(data))
rownames(table)=c(colnames(data))
diag(table)="1 "
Out=list()
Out$MU=THETA
Out$SIGMA=SIGMA
Out$M=matrix(COR_M,nrow=ncol(data),ncol=ncol(data))
Out$SD=matrix(COR_SD,nrow=ncol(data),ncol=ncol(data))
Out$LL=matrix(COR_LL,nrow=ncol(data),ncol=ncol(data))
Out$UL=matrix(COR_UL,nrow=ncol(data),ncol=ncol(data))
Out$Table=table
return(Out)

Related

scheduled cores ... did not deliver results, all values of the jobs will be affected in parallel::mclapply() in R 4.0.1

I'm using parallel::mclapply() with R 4.0.1 and getting the following warning: "scheduled cores ... did not deliver results, all values of the jobs will be affected".
Here the result of my investigation: inspecting the function source code, I realized that it happens when the vector dr is not all TRUE. This means that for some cores the second condition inside the for loop below (is.raw(a)) is never executed. a is the value returned by readChild(), that if returned raw data at least once, the condition would be verified at least once. So I'm thinking that readChild() is returning NULL.
readChild and readChildren return a raw vector with a "pid" attribute if data were available, an integer vector of length one with the process ID if a child terminated or NULL if the child no longer exists (no children at all for readChildren).
I ask you to validate or reject my conclusions. Finally if true what are the possible reasons?
while (!all(fin)) {
s <- selectChildren(ac[!fin], -1)
if (is.null(s)) break # no children -> no hope we get anything (should not happen)
if (is.integer(s))
for (ch in s) {
a <- readChild(ch)
if (is.integer(a)) {
core <- which(cp == a)
fin[core] <- TRUE
} else if (is.raw(a)) {
core <- which(cp == attr(a, "pid"))
job.res[[core]] <- ijr <- unserialize(a)
if (inherits(ijr, "try-error"))
has.errors <- c(has.errors, core)
dr[core] <- TRUE
} else if (is.null(a)) {
# the child no longer exists (should not happen)
core <- which(cp == ch)
fin[core] <- TRUE
}
}
}
This error message can occur when the child process dies/crashes, e.g.
> y <- parallel::mclapply(1:2, FUN = function(x) if (x == 1) quit("no") else x)
Warning message:
In parallel::mclapply(1:2, FUN = function(x) if (x == 1) quit("no") else x) :
scheduled core 1 did not deliver a result, all values of the job will be affected
> str(y)
List of 2
$ : NULL
$ : int 2
That a child process completely dies is of course not good. It can happen for several reasons. My best guess is that you parallelize something that must not be parallelized. Forked processing (=mclapply()) is known to be unstable with code that multi-thread, among other things.
For what's it worth, if you use the future framework instead (disclaimer: I'm the author), you'll get an error message that is a bit more informative, e.g.
> library(future.apply)
> plan(multicore)
> y <- future_lapply(1:2, FUN = function(x) if (x == 1) quit("no") else x)
Error: Failed to retrieve the result of MulticoreFuture (future_lapply-1) from
the forked worker (on localhost; PID 19959). Post-mortem diagnostic: No process
exists with this PID, i.e. the forked localhost worker is no longer alive.

How to solve error in while looping EM algorithm in R

my project needs the EM algorithm below, where is all the code. The error is in the while loop, which is where the hope and maximization steps are. The error message is "Error in while (abs (Elogv [r] - Elogv [r - 1])> = 1e-06) {: missing value where TRUE / FALSE needed". How do I resolve this error if the while loop contains no true and false commands, and if I have already checked in detail that there are no errors in the commands and no NA's value? Grateful for the attention, who can save me.
n=100
u<-runif(n)
QUANTIL <- function(u){
Q <- rep(NA, length(u))
for (i in 1:length(u)) {
if(u[i] < 0.2634253829){
Q[i] <- 1*tan(pi*(0.9490353482*u[i]-0.5))+0
}
if(u[i]>=0.2634253829 && u[i] < 0.7365746171){
Q[i] <- 1*qnorm(1.4428629504*u[i]-0.2214315)+0
}
if(u[i]>0.7365746171){
Q[i] <- 1*tan(pi*(0.9490353482*u[i]-0.4490353))+0
}
}
return(Q)
}
x<-QUANTIL(u)
y<-c(sort(x))
i<-seq(1,n)
v<-c(i/(n+1))
t<-QUANTIL(v)
mi<-median(y)
s<-c(y[26:73])
sigma<-sqrt(sum((s-mi)^2)/(n-1))
p=0.4731492342
alpha<-(2*t^3)/(1+t^2)^2
beta<-(1-t^2)/(1+t^2)^2
eta<-(t^4-t^2)/(1+t^2)^2
lambda<-2*t/(1+t^2)^2
gama<-(-t^2)
delta<-2*t
k<-((p*0.6930665173/sigma*sqrt(2*pi))*exp((-1/2*sigma^2)*((y-mi)^2)))/(((p*0.6930665173/sigma*sqrt(2*pi))*exp((-1/2*sigma^2)*(y-mi)^2))+((((1-p)*1.0537015317/sigma*pi))*(1/(1+((y-mi)/sigma)^2))))
r<-2
Elogv<-sum(k*((-1/2)*((y-mi)/sigma)^2))-sum(k*log(sigma*sqrt(2*pi)))-sum((1-k)*log(sigma*pi))-sum((1-k)*log(1+((y-mi)/sigma)^2))+sum(k*log(p))+(n-sum(k))*log(1-p)+log(0.6930665173)*sum(k)+log(1.0537015317)*sum(1-k)
Elogv[1]<-0
while (abs(Elogv[r]-Elogv[r-1])>=0.000001) {
w<-(2*beta-2*k*beta+k)
q<-k*delta+2*lambda*(1-k)
sigma<-(sum(y*w)*sum(q)-sum(w)*sum(y*q))/(-2*sum(alpha*(1-k))*sum(q)+sum(w)*sum(k*gama-1)+2*sum(w)*sum(eta*(1-k)))
mi<-(sum(y*w)+2*sigma*sum(alpha*(1-k)))/sum(w)
k<-((p*0.6930665173/sigma*sqrt(2*pi))*exp((-1/2*sigma^2)*((y-mi)^2)))/(((p*0.6930665173/sigma*sqrt(2*pi))*exp((-1/2*sigma^2)*(y-mi)^2))+((((1-p)*1.0537015317/sigma*pi))*(1/(1+((y-mi)/sigma)^2))))
Elogv[r]<-sum(k*((-1/2)*((y-mi)/sigma)^2))-sum(k*log(sigma*sqrt(2*pi)))-sum((1-k)*log(sigma*pi))-sum((1-k)*log(1+((y-mi)/sigma)^2))+sum(k*log(p))+(n-sum(k))*log(1-p)+log(0.6930665173)*sum(k)+log(1.0537015317)*sum(1-k)
r<-r+1
It looks to me that the length of Elogv is 1? Thus Elogv[r] has no entry (r is 2!), i.e. evaluates to NA, thus the abs(Elogv[r]-Elogv[r-1]) is NA.
You need Elogv[2] <- 0 before starting the loop?

Unexpected symbol error in R that doesn't match my code

I am coding in R-studio and have a function called saveResults(). It takes:
sce - a Single Cell Experiment object.
opt - a list with five things
clusterLabels - simple dataframe with two columns
The important thing is that I receive an error stating:
Error: unexpected symbol in:
"saveResults(sce = sce, opt = opt, clusteInputs()
zhengMix"
which doesn't agree at all with the parameters I pass into the function. You can see this on the last line of the code block below: I pass in proper parameters, but I receive an error that says I have passed in clusteInputs(), and zhengMix instead of clusterLabels. I don't have a function called clusteInputs(), and zhengMix was several lines above.
# Save the clustering data
InstallAndLoadPackagesForSC3Clustering()
opt <- GetOptionInputs()
zhengMix <- FetchzhengMix(opt)
sce <- CreateSingleCellExperiment(zhengMix)
clusterLabels <- getClusterLabels(sce)
opt <- createNewDirectoriesToSaveData(opt)
saveResults <- function(sce, opt, clusterLabels){
print("Beginning process of saving results...")
maxClusters = ncol(clusterLabels)/2+1
for (n in 2:maxClusters){
savePCAasPDF(sce, opt, numOfClusters = n, clusterLabels)
saveClusterLabelsAsRDS(clusterLabels, numOfClusters = n, opt)
}
saveSilhouetteScores(sce, opt)
print("Done.")
}
saveResults(sce = sce, opt = opt, clusterLabels = clusterLabels)
Does anyone have an idea what is going on? I'm pretty stuck on this.
This isn't the best solution, but I fixed my own problem by removing the code out of the function and running it there caused no issues.

R : "argument is missing, with no default "

I am running the following code to minimize a function thanks to optim() in R but I have the following message : "argument "h" is missing, with no default".
I checked on previous messages where it is said that it is often a comma before a parenthesis, but does not seem to be the case in my code.
Could you please help me to understand what to do ? Thank you very much.
Here is the code :
A<-function(t,k,h,s){
out<-exp((h-(s*s/(2*k*k)))*(B(t,k)-t)-(s*s/(4*k))*(B(t,k)^2))
return(out)
}
B<-function(t, k){
out<-(1-exp(-k*t))/k
return(out)
}
P<-function(a, b, r){
out<-a*exp(-b*r)
return(out)
}
somme<-function(k,h,s){
out<-(P(A(1,k,h,s), B(1,k), -0.002)-1.0021)^2+(P(A(2,k,h,s), B(2,k), -0.0016)-1.0036)^2+(P(A(3,k,h,s), B(3,k), -0.001)-1.0038)^2+(P(A(4,k,h,s), B(4,k), -0.0002)-1.002)^2+(P(A(5,k,h,s), B(5,k), 0.00077)-0.9976)^2+(P(A(6,k,h,s), B(6,k), 0.0019)-0.9901)^2+(P(A(7,k,h,s), B(7,k), 0.0031)-0.9796)^2+(P(A(8,k,h,s), B(8,k), 0.0044)-0.9655)^2+(P(A(9,k,h,s), B(9,k), 0.0056)-0.9494)^2+(P(A(10,k,h,s), B(10,k), 0.0067)-0.9317)^2
return(out)
}
init<-c(k=0,h=0,s=0)
result<-optim(par=init, fn=somme)
result
The documentation in help("optim") says (emphasis added by me):
fn
A function to be minimized (or maximized), with first argument the
vector of parameters over which minimization is to take place. It
should return a scalar result.
Thus, this works:
somme <- function(par){
k <- par[[1]]
h <- par[[2]]
s <- par[[3]]
out <- (P(A(1,k,h,s), B(1,k), -0.002)-1.0021)^2+
(P(A(2,k,h,s), B(2,k), -0.0016)-1.0036)^2+
(P(A(3,k,h,s), B(3,k), -0.001)-1.0038)^2+
(P(A(4,k,h,s), B(4,k), -0.0002)-1.002)^2+
(P(A(5,k,h,s), B(5,k), 0.00077)-0.9976)^2+
(P(A(6,k,h,s), B(6,k), 0.0019)-0.9901)^2+
(P(A(7,k,h,s), B(7,k), 0.0031)-0.9796)^2+
(P(A(8,k,h,s), B(8,k), 0.0044)-0.9655)^2+
(P(A(9,k,h,s), B(9,k), 0.0056)-0.9494)^2+
(P(A(10,k,h,s), B(10,k), 0.0067)-0.9317)^2
return(out)
}
init <- c(k = 1, h = 1, s = 1)
result <- optim(par = init, fn = somme)
PS: You seem to be a masochist who likes excessive typing.

Error message in Bubble sort code in R language

I did some programming work on R language to do the bubble sort. Sometimes it works perfectly without any error message, but sometimes, it shows "Error in if (x[i] > x[i + 1]) { : argument is of length zero". Can any one help me check whats wrong with it? I have attached my code below
example <- function(x) {
n <- length(x)
repeat {
hasChanged <- FALSE
n <- n - 1
for(i in 1:n) {
if ( x[i] > x[i+1] ) {
temp <- x[i]
x[i] <- x[i+1]
x[i+1] <- temp
hasChanged <- TRUE
cat("The current Vector is", x ,"\n")
}
}
if ( !hasChanged ) break;
}
}
x <-sample(1:10,5)
cat("The original Vector is", x ,"\n")
example(x)
The error occurs because you are iteratively decreasing n. Depending on the original vector's order (or lack thereof), n can reach the value of 1 after the last change. In that case, a further reduction of n in the next iteration step addresses the value x[0], which is undefined.
With a minimal correction your code will work properly, without giving error messages. Try to replace the line
if ( !hasChanged ) break;
with
if ( !hasChanged | n==1 ) break
Basically you have two termination criteria: Either nothing has been changed in the previous iteration or n is equal to one. In both cases, a further iteration won't change the vector since it is already ordered.
By the way, in R programming you don't need a semicolon at the end of a command. It is tolerated/ignored by the interpreter, but it clutters the code and is not considered good programming style.
Hope this helps.

Resources