Error in R Markdown (non-numeric argument to binary operator) - r

I only get this error in attempting to knit in R Markdown to a Word document. The code runs fine elsewhere (in the Rscript).Also I have already had previous code showing:
numericScores = transform(correctedScores, beer2_score = as.numeric(beer2_score))
numericScores = transform(correctedScores, beer3_score = as.numeric(beer3_score))
numericScores = transform(correctedScores, beer4_score = as.numeric(beer4_score))
numericScores = transform(correctedScores, beer5_score = as.numeric(beer5_score))
numericScores = transform(correctedScores, beer6_score = as.numeric(beer6_score))
# testing to see if they are indeed numeric
sapply(numericScores, mode)
correctedGuesses = Guesses[complete.cases(Guesses), ]
str(correctedGuesses)
correctedGuesses
correctedScores = numericScores[complete.cases(numericScores), ]
str(correctedScores)
correctedScores
########
# trying to put scores in correct order
# first I will label the beers with their names
for(i in 1:45){
for(j in 2:7) {
if (Order[i,j] == 1) { Order[i, j] = "Miller"}
if (Order[i,j] == 2) { Order[i, j] = "Natural"}
if (Order[i,j] == 3) { Order[i, j] = "Keystone"}
if (Order[i,j] == 4) { Order[i, j] = "Busch"}
if (Order[i,j] == 5) { Order[i, j] = "Bud"}
if (Order[i,j] == 6) { Order[i, j] = "Miller"}
}
}
# Deleting the unused/unavailable Order rows
Order = Order[-c(4, 33),]
Miller_sc = 0
Natural_sc = 0
Keystone_sc = 0
Busch_sc = 0
Bud_sc = 0
B = c(
Miller_sc,
Natural_sc,
Keystone_sc,
Busch_sc,
Bud_sc )
for (i in 1:43) {
for (j in 2:7) {
if (Order[i,j] == "Miller") {B[1] = B[1] + correctedScores[i,j]}
if (Order[i,j] == "Natural") {B[2] = B[2] + correctedScores[i,j]}
if (Order[i,j] == "Keystone") {B[3] = B[3] + correctedScores[i,j]}
if (Order[i,j] == "Busch") {B[4] = B[4] + correctedScores[i,j]}
if (Order[i,j] == "Bud") {B[5] = B[5] + correctedScores[i,j]}
}
}
The error reads:
Error in B[3] + correctedScores[i, j]: non-numeric argument to binary
operator Calls: ... handle ->withCallingHandlers ->
withVisible -> eval -> eval Execution halted

The usual reason for an error like this is that the code in your document refers to a variable in your global environment. When you knit the document, it can't see that variable, so you get an error.
Most commonly that error would be some variation on "variable not found". You're getting a different error, so R is finding a variable with the right name somewhere else.
Without the full document, we can't tell you for sure what variable would be causing your problems. When I take a quick look at your script, I see these variables with no definitions:
correctedScores
beer2_score # etc., though these might be columns in correctedScores
Guesses
Order
I also notice that the first 4 lines of your script do nothing, since the 5th line overwrites their result.

Related

How to convert equation from R code into readable text?

I have defined multiple different functions, each containing one equation each, like so:
catalanFormula <- function(n){
return( (factorial(2 * n)) / ((factorial(n + 1)) * factorial(n)) )
}
triangularFormula <- function(n){
return( (n * (n+1)) / 2 )
}
I am then plotting each function using the plot() function from base R. What I want to do is be able to include the equation in my plot as a label or text, but in a way that is easily understandable. I know I can use LaTeX to write each equation manually, but I was wondering if there is a package or method anyone knows of that can deparse a mathematical equation in R and turn it into a standard readable mathematical equation. The only math occurring is factorials, multiplication, division, exponents, addition, and subtraction.
For example, I want to convert
(factorial(2 * n)) / ((factorial(n + 1)) * factorial(n))
into something that looks like this.
Then, be able to use the output within the text() function of base R plotting.
With the Ryacas package you can transform a math expression to its corresponding LaTeX code. But the factorial must be given as !:
library(Ryacas)
eq <- yac_symbol("(2 * n)! / ((n + 1)! * n!)")
tex(eq)
# "\\frac{\\left( 2 n\\right) !}{\\left( n + 1\\right) ! n!}"
Another possibility is to call Python from R and use the pytexit library:
from pytexit import py2tex
py2tex("math.factorial(2 * n) / ((factorial(n + 1)) * factorial(n))")
# $$\frac{\operatorname{factorial}\left(2n\right)}{\operatorname{factorial}\left(n+1\right) \operatorname{factorial}\left(n\right)}$$
You can also take a look at PyLaTeX and lax.
Here's a base R function that will walk the abstract syntax tree to replace the factorial and / functions with the corresponding ?plotmath markup so you can add them to R plots.
returnToPlotmath <- function(fun) {
swap <- function(x) {
if (class(x) %in% c("call","(")) {
x <- as.list(x)
if (as.character(x[[1]])=="/") {
x[[1]] = quote(frac)
x[[2]] = swap(x[[2]])
x[[3]] = swap(x[[3]])
} else if (as.character(x[[1]])=="factorial") {
x[[1]] = quote(`*`)
if (is.call(x[[2]])) {
x[[2]] = as.call(list(quote(`(`), x[[2]]))
} else {
x[[2]] = swap(x[[2]])
}
x[[3]] = "!"
} else if (as.character(x[[1]])=="*") {
if(is.call(x[[2]]) | is.call(x[[3]])) {
x[[1]] = quote(`%.%`)
x[[2]] = swap(x[[2]])
x[[3]] = swap(x[[3]])
}
} else {
x[[2]] = swap(x[[2]])
if (length(x)==3) x[[3]] = swap(x[[3]])
}
return(as.call(x))
} else {
return(x)
}
}
body_exprs <- body(fun)[[2]]
swap(body_exprs[[length(body_exprs)]])
}
This does assume that the return is the last statement in the function body {} block. You can get the expression with
returnToPlotmath(catalanFormula)
# frac(((2 * n) * "!"), (((n + 1) * "!") %.% (n * "!")))
returnToPlotmath(triangularFormula)
# frac((n %.% (n + 1)), 2)
And you can add them to plot titles and such
plot(main=returnToPlotmath(catalanFormula), 1, 1)
plot(main=returnToPlotmath(triangularFormula), 1, 1)
This solution is highly specific to the functions you need to transform. But it could be extended if needed.
The expr2latex() function from simsalapar parses expressions to LaTeX, and can be extended to include the factorial symbol with a minor addition to the code:
expr2latex2 <- function(expr) {
L <- length(expr)
c.BinTable <- simsalapar:::c.BinTable
if(!L) "" else {
Symb <- is.symbol(expr)
F <- if(Symb) expr else expr[[1]]
cF <- simsalapar:::mDeparse(F)
FF <- simsalapar:::renderAtom(F, Len=L, d.a = cF)
if(Symb && L != 1)
stop("is.symbol(.), but length(.) = ", L, " != 1")
else if(!Symb && typeof(expr) != "language" && L != 1)
stop("is not language nor symbol), but length(.) = ", L, " != 1")
switch(L,
## length 1:
FF,
{ ## length 2: e.g. "- 1", "+ x", "!TRUE", "~ ff",
#browser()
rhs <- expr2latex2(expr[[2]])
if (cF == "bold") paste0("\\mathbf{", rhs, "}")
else if(cF == "italic") paste0("\\mathit{", rhs, "}")
else if(cF == "factorial") paste0("(",rhs,")!") #extra case added in for factorial
else if(!simsalapar:::isOp(cF)) # not a binary operator ==> "function call":
paste0(FF,"(",rhs,")") ## e.g. "O(n)"
else if(cF == "{") paste0("{", rhs, "}")
else if(cF == "(") paste0("(", rhs, ")")
else paste(FF, rhs)
},
{ ## length 3:
lhs <- expr2latex2(expr[[2]])
rhs <- expr2latex2(expr[[3]])
if(cF == "[") ## subscript
paste0(lhs, "_{", rhs, "}")
else if(cF == "~") ## space
paste(lhs, "\\", rhs)
## not treated, as plotmath() does neither :
## else if(cF == "[[")
## paste0(lhs, "[[", rhs, "]]")
else if(cF %in% c.BinTable)
paste(lhs, simsalapar:::getTab(cF, simsalapar:::BinTable), rhs)
else if(cF %in% c.RelTable)
paste(lhs, simsalapar:::getTab(cF, simsalapar:::RelTable), rhs)
else if(simsalapar:::isOp(cF)) ## e.g. U + x
paste(lhs, FF, rhs)
else ## log(x, 2)
paste0(FF, "(", lhs, ",", rhs, ")")
},
## length >=4 : F(a, b, c, ...)
stop("length(expr) = ",L," (>= 4); not yet implemented") # TODO MM
)## end{switch}
}
}
original function
expr2latex( quote( (factorial(2 * n)) / ((factorial(n + 1)) * factorial(n)) ) )
#[1] "(factorial(2 n)) / ((factorial(n + 1)) factorial(n))"
revised treatment of factorials
expr2latex2( quote( (factorial(2 * n)) / ((factorial(n + 1)) * factorial(n)) ) )
#[1] "((2 n)!) / (((n + 1)!) (n)!)"

If & ifelse statement in R

As the new user in R, I met few problems when I tried to evaluate a.
Code:
// time2 are numbers //
a = d3$Time2
b = c(...)
for (i in 1:65){
for (j in 1:1762){
if( (a[j]>=1474161415+900*(i-1))&(a[j]<1474161415+900*i) ){ a[j] = b[j] }
}
}
Results:
Error in if ((a[j] >= 1474161415 + 900 * (i - 1)) & (a[j] < 1474161415 + :
missing value where TRUE/FALSE needed
Also I have tried:
ifelse( ((a[j]>=1474161415+900*(i-1)) & (a[j]<1474161415+900*i)) , a[j]=b[j])
Results:
-unexpected '=' in -ifelse( ((a[j]-=1474161415+900-(i-1)) &
(a[j]-1474161415+900-i)) , a[j]=--

MATLAB to R Conversion: Append values to an existing empty array through for loop

I have the below code with me. This code was written originally in MATLAB. I have two questions here:
1) What would be the corresponding command in R for the below command in MATLAB:
duet(i).p = [];
2) In the below code I am getting all the correct 6 values for duet$n, but I am not getting correct values for duet$p. My question is how to append the values to an empty existing array duet$p[i] in R through the for loop iterations.
This line is not working in the below code:
duet$p[i] <- c(duet$p[i],j)
I might also have declared duet$p[i] <- array() incorrectly.
The values for duet.n and duet.p from MATLAB are:
duet.n
2 0 2 0 1 3
duet.p
[] [3,6] [] [1,3,5,6] [1,6] []
In R, I am getting duet$n values correctly, but I am not able to get the array kind of results for duet$p.
Any help to get the duet$p values would be appreciated.
x <- matrix(c(-1,2,4,1,7,4.2,3,0,1.2,-1.2,5.1,4,2,3.1,1.1,1,1,9,0,1,2,2,8,1,2,2,2,2,2,2),nrow=6,ncol=5,byrow=T)
fro=1;N=6;M=2;V=3;
F <- list(f=c())
duet = list()
for (i = 1 : N){
duet$n[i] = 0
duet$p[i] = array() ## Create an empty array
for (j in 1 : N){
dl = 0
de = 0
dm = 0
for (k = 1 : M){
if (x[i,V + k] < x[j,V + k]){
dl = dl + 1
} else if (x[i,V + k] == x[j,V + k]){
de = de + 1
} else{
dm = dm + 1
}
}
if (dl == 0 & de != M){
duet$n[i] = duet$n[i] + 1
} else if (dm == 0 & de != M){
duet$p[i] = c(duet$p[i],j)
}
}
if (duet$n[i] == 0){
x[i,6] = 1
F$f = c(F$f,i)
}
}
This appears to get the output you want:
x <- matrix(c(-1,2,4,1,7,4.2,3,0,1.2,-1.2,5.1,4,2,3.1,1.1,1,1,9,0,1,2,2,8,1,2,2,2,2,2,2),nrow=6,ncol=5,byrow=T)
fro=1;N=6;M=2;V=3;
F <- list(f=c())
duet = list(n=rep(0,N), p=lapply(1:N, function(x)c()))
for (i in 1 : N){
duet$n[i] = 0
#duet$p[[i]] = c() ## Create an empty array
#if(i==2) browser()
for (j in 1 : N){
k=1:M
dl <- sum(x[i,V + k] < x[j,V + k])
de <- sum(x[i,V + k] == x[j,V + k])
dm <- sum(x[i,V + k] > x[j,V + k])
if (dl == 0 & de != M){
duet$n[i] = duet$n[i] + 1
} else if (dm == 0 & de != M){
duet$p[[i]] = c(duet$p[[i]],j)
}
}
if (duet$n[i] == 0){
#x[i,6] = 1
F$f = c(F$f,i)
}
}
What have I done?
commented out the line x[i,6] =1, because there isn't an x[i,6], and I'm not sure what you meant it to be. You will need to sort this out.
Initialised duet$n as a vector
Initialised duet$p as a list of n empty vectors
removed the k loop as conditional counting in R can be done as the sum of elements where the condition is TRUE.
corrected the syntax of for loops: = became in
I think you're trying to do duet[i]$p instead of what you're doing. Also you need to initialize each cell as a list

R function keeps returning NULL

I am having a very odd problem in R. The question was to make a function for global and semi global allignment. Appropriate algorithms were made which are able to "print out" the correct allignment. However "returning" the alginment seems to be a problem for the semi global algorithm.
Below are the functions for both alignments which both contain two functions: one computing the score matrix and the other outputs the alignment. As you can see, the output function for semi global was inspired by the global one but although it is able to print out values A and B, when returning A and B a value NULL is returned.
It came to my attention that when making defining A and B, they also contain a NULL part which seen by printing the structures of A and B at the end. This is also the case in the global alignment but does not seem to be a problem here.
Global Alignment Algorithm
########### GLOBAL ALLIGNMENT ALGORITHM ############
GA_score = function(v,w,score.gap=-3,score.match=8,score.mismatch=-5){
v = strsplit(v,split="")[[1]]
w = strsplit(w,split="")[[1]]
S = matrix(0,nrow=(length(v)+1),ncol = (length(w)+1) )
S[1,1] = 0
for(j in 2:dim(S)[2]){
S[1,j] = score.gap*(j-1)
}
for(i in 2:dim(S)[1]){
S[i,1] = score.gap*(i-1)
for(j in 2:dim(S)[2]){
if(v[i-1]==w[j-1]){diag = S[i-1,j-1] + score.match} else {diag = S[i-1,j-1] + score.mismatch}
down = S[i-1,j] + score.gap
right = S[i,j-1] + score.gap
S[i,j] = max(diag,down,right)
}
}
return(S)
}
GA_output = function(v,w,S,score.gap=-3,score.match=8,score.mismatch=-5){
v = strsplit(v,split="")[[1]]
w = strsplit(w,split="")[[1]]
A=c()
B=c()
GA_rec = function(A,B,S,i,j,v,w,score.gap,score.match,score.mismatch){
if (i==1 | j==1){
if(i>1){
for(i1 in seq(i-1,1,-1)){
A = c(v[i1],A)
B = c("-",B)
}
}
if(j>1){
for(j1 in seq(j-1,1,-1)){
A = c("-",A)
B = c(w[j1],B)
}
}
return(list(v=A,w=B))
}
if(v[i-1]==w[j-1] ){diag = score.match} else {diag=score.mismatch}
if (S[i,j] == (S[i-1,j-1] + diag)){
A.temp = c(v[i-1],A)
B.temp = c(w[j-1],B)
GA_rec(A.temp,B.temp,S,i-1,j-1,v,w,score.gap,score.match,score.mismatch)
}
else if (S[i,j] == (S[i-1,j] + score.gap)){
A.temp <- c(v[i-1],A)
B.temp <- c("-",B)
GA_rec(A.temp,B.temp,S,i-1,j,v,w,score.gap,score.match,score.mismatch)
}
else {
A.temp = c("-",A)
B.temp = c(w[j-1],B)
GA_rec(A.temp,B.temp,S,i,j-1,v,w,score.gap,score.match,score.mismatch)
}
}
return( GA_rec(A,B,S,length(v)+1,length(w)+1,v,w,score.gap,score.match,score.mismatch))
}
Semi-Global Alignment Algorithm
########### SEMI GLOBAL ALLIGNMENT ALGORITHM ############
SGA_score = function(sequence1,sequence2,score.gap=-1,score.match=1,score.mismatch=-1){
v=sequence2
w=sequence1
v = strsplit(v,split="")[[1]]
w = strsplit(w,split="")[[1]]
S = matrix(0,nrow=length(v)+1,ncol=length(w)+1)
for(i in 1:(length(w)+1)){
for( j in 1:(length(v)+1)){
if (i==1|j==1){S[i,j]=0}
else{
if((i==length(w)+1) | (j==length(v)+1)){
from.top = S[i,j-1]
from.left = S[i-1,j]
}
else{
from.top = max(S[i,j-1]+score.gap) # Max is artifact from max(0,... )
from.left = max(S[i-1,j]+score.gap)
}
if(w[i-1] == v[j-1]){
from.diag = S[i-1,j-1]+score.match
}
else{
from.diag = S[i-1,j-1]+score.mismatch
}
S[i,j] = max(from.top,from.left,from.diag)
}
}
}
return(S)
}
SGA_output = function(v,w,S,score.gap=-1,score.match=1,score.mismatch=-1){
v = strsplit(v,split="")[[1]]
w = strsplit(w,split="")[[1]]
A=c()
B=c()
print(str(A))
print(str(B))
SGA_rec = function(A,B,S,i,j,v,w,score.gap,score.match,score.mismatch){
if (i==1 | j==1){
if(i>1){
for(i1 in seq(i-1,1,-1)){
A = c(v[i1],A)
B = c("-",B)
}
}
if(j>1){
for(j1 in seq(j-1,1,-1)){
A = c("-",A)
B = c(w[j1],B)
}
}
print(A)
print(B)
out = list(v=A,w=B)
#print(out)
print(str(A))
print(str(B))
print(str(out))
return(out)
}
if(v[i-1]==w[j-1] ){diag = score.match} else {diag=score.mismatch}
if (S[i,j] == (S[i-1,j-1] + diag)){
A.temp = c(v[i-1],A)
B.temp = c(w[j-1],B)
SGA_rec(A.temp,B.temp,S,i-1,j-1,v,w,score.gap,score.match,score.mismatch)
}
#####
if ( j==length(w)+1) { # Are we in last row?
score.temp = score.gap
score.gap=0
}
else{score.temp=score.gap}
if(S[i,j] == (S[i-1,j] + score.gap)){
A.temp <- c(v[i-1],A)
B.temp <- c("-",B)
score.gap = score.temp
SGA_rec(A.temp,B.temp,S,i-1,j,v,w,score.gap,score.match,score.mismatch)
}
score.gap=score.temp
####
if(i==length(v)+1){
score.temp=score.gap
score.gap=0
}
else{score.temp=score.gap}
if(S[i,j] == (S[i,j-1] + score.gap)){
A.temp = c("-",A)
B.temp = c(w[j-1],B)
score.gap=score.temp
SGA_rec(A.temp,B.temp,S,i,j-1,v,w,score.gap,score.match,score.mismatch)
}
}
return(SGA_rec(A,B,S,length(v)+1,length(w)+1,v,w,score.gap,score.match,score.mismatch))
}
S1 = SGA_score("ACGTCAT","TCATGCA")
S1
align = SGA_output("ACGTCAT","TCATGCA",S1)
align
I am surpised that the global alignment works but the semi global one doesn't, even tough they both have this NULL part (can someone maybe explain what this is? Has it something to do with internal objects in a function?) and the semi global knows what A and B is.
Any help is greatly appreciated!
SGA_rec seems to be missing a return value. You need an else {return(<something>)) after the last if.
Illustration:
fun <- function() if (FALSE) 1
x <- fun()
x
#NULL
Read help("NULL") to learn what it means.

Error .. missing value where TRUE/FALSE needed

I have been trying to run this code (below here) and I have gotten that message "Error in if (temp[ii] == 0) { : missing value where TRUE/FALSE needed"...
temp = c(2.15, 3.5, 0, 0, 0, 1.24, 5.42, 6.87)
tm = length(temp)
for (i in 1:tm){
if (temp[i] == 0) {
counter3 = 1
last = temp[i - 1]
for (ii in i + 1:tm){
if (temp[ii] == 0) {
counter3 = counter3 + 1
}
if (temp[ii] != 0) {
nxt = temp[i + counter3]
}
}
}
}
Your problem is that temp[ii] is returning NA because ii goes out of bounds:
ii = i + 1:tm #Your declaration for ii
ii = 1:tm + 1:tm #Evaluates to
So ii will definitely be larger than tm (and therefore length(temp) at some point.
In order to better understand/debug for loops, consider printing just the indices:
for(i in 1:tm)
{
print(i)
for(ii in i + 1:tm)
print(ii)
}
At a guess I'm going to say that this is in R - if so I'm guessing that this line:
if (temp[i] == 0) (or temp[ii] == 0)
is resulting in an NA, and if conditions must have a TRUE or FALSE value.
Using a debugger if you can, I'd interrogate the value of temp[i] before the if block.
Difficult without knowing the language, but i think the issue is that the value in ii can be greater than the length of temp when i is at its upper bound. I'd have expected an index out of range or something similar but, without knowing the language, who knows! Hope you get your problem fixed.

Resources