This question already has answers here:
if/else constructs inside and outside functions
(2 answers)
Closed 5 years ago.
I constructed the function, but the R gives me the error. But I does not know what I did wrongly.
Error: unexpected '}' in "}"
Vect_fun=function(x,a) {
if(a=1)
{
y= mean(x,na.rm=TRUE)
}
else{
if(a=2)
{
y= na.aggregate(x)
}
else {
y=x[!is.na(x)]
}
}
y
}
Use double equal sign to comparing.
Vect_fun = function(x, a) {
if (a == 1) {
y = mean(x, na.rm = TRUE)
}
else {
if (a == 2) {
y = na.aggregate(x)
}
else {
y = x[!is.na(x)]
}
}
y
}
Your formatting is off in addition to needing to use the proper == operator, and else if
You should indent at each level so it's easier to read, and you need to use == for logical operators. Also, else{ if(){ }} is messy. Use else if{ }
Vect_fun <- function(x,a) {
if (a == 1) {
y = mean(x, na.rm = TRUE)
} else if (a == 2) {
y = na.aggregate(x)
return(y)
} else {
y = x[!is.na(x)]
}
return(y)
}
Related
I don't know what is different between two codes. When I use ml.norm(iris[1:4], mode="uv",na.rm=FALSE) and dh.norm(iris[1:4], mode="uv",na.rm=FALSE), the results are different..`
ml.norm <- function(x, mode="uv", na.rm=FALSE){
if(class(x)=="data.frame"){
x <- as.matrix(x)
}
else{
return (apply(x,2,ml.norm, mode=mode, na.rm=na.rm))
}
if (mode =="uv"){
x = x/sd(x, na.rm=na.rm)
}
else if (mode =="z"){
x = (x-mean(x))/sd(x, na.rm=na.rm)
}
else{stop(paste("unknow mode", mode))}
return(x)
}
dh.norm <- function (x,mode="uv",na.rm=FALSE) {
# need to check if x is a matrix
if (is.data.frame(x)) {
x=as.matrix(x)
}
if (is.matrix(x)) {
return(apply(x,2,dh.norm,mode=mode,na.rm=na.rm))
}
if (mode == "uv") {
x = x/sd(x,na.rm=na.rm)
} else if (mode == "z") {
# your code here
x = (x - mean(x))/sd(x,na.rm=na.rm)
} else {
stop(paste("unknown mode",mode))
}
return(x)
}
ml.norm
IF x IS data.frame DO convert it into a matrix. THEN check mode and DO stuff.
dh.norm
IF x IS a data.frame DO convert it into a matrix. THEN check if x is a matrix and apply dh.norm on the columns. THEN check the mode and DO stuff.
So ml.norm is missing the return(apply(x,2,[YOUR FUNCTION],mode=mode,na.rm=na.rm)) part if you run it on a data.frame.
I was asked to implement function that calculates n-dimensional matrix determinant using Laplace expansion. This involves recursion. I developed this:
minor<-function(A,i,j) {
return(A[c(1:(i-1),(i+1):dim(A)[1]),c(1:(j-1),(j+1):dim(A)[2])])
}
determinantRec<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1) return(X[1][1])
else {
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k][i]*(-1)^(k+i)*determinantRec(minor(X,k,i),k)
}
return(s)
}
}
where k in determinantRec(X,k) function indicates which row I want to use Laplace expansion along of.
My problem is when I run determinantRec(matrix(c(1,2,3,4),nrow = 2,ncol = 2),1) this error appears:
C stack usage 7970628 is too close to the limit
What is wrong with my code?
#julia, there is one simple type in your code. Just remove the '*' at the end of the definition of 's'. And don't indent the recursion.
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)
determinantRek(X[-k,-i],k)
}
return(s)
}
I did this way and works just fine, although it is super slow, compared to the det function in base R
laplace_expansion <- function(mat){
det1 <- function(mat){
mat[1]*mat[4]-mat[2]*mat[3]
}
determinant <- 0
for(j in 1:ncol(mat)){
mat1 <- mat[-1,-j]
if(nrow(mat1) == 2){
determinant <- determinant+mat[1,j]*(-1)^(1+j)*det1(mat1)
}else{
val <- mat[1,j]*(-1)^(1+j)
if(val != 0){
determinant <- determinant+val*laplace_expansion(mat1)
}
}
}
return(determinant)
}
This is my approach, I think it's cleaner.
deter <- function(X) {
stopifnot(is.matrix(X))
stopifnot(identical(ncol(X), nrow(X)))
if (all(dim(X) == c(1, 1))) return(as.numeric(X))
i <- 1:nrow(X)
out <- purrr::map_dbl(i, function(i){
X[i, 1] * (-1)^(i + 1) * deter(X[-i, -1, drop = FALSE])
})
return(sum(out))
}
Thank you #ArtemSokolov and #MrFlick for pointing the problem cause, it was it. I also discovered that this code does not calculate properly the determinant of 2x2 matrix. After all it looks like that:
determinantRek<-function(X,k) {
if (dim(X)[1] == 1 && dim(X)[2] == 1)
return(X[1,1])
if (dim(X)[1] == 2 && dim(X)[2] == 2)
return(X[1,1]*X[2,2]-X[1,2]*X[2,1])
else
s = 0
for (i in 1:dim(X)[2]) {
s = s + X[k,i]*(-1)^(k+i)*
determinantRek(X[-k,-i],k)
}
return(s)
}
Debuging with browser() was also helpful :)
I have the code below, which seems to accomplish what I'm trying to do but also throws the error output shown below the code. What I'm trying to do, is run through the loop the first time with x = 1, then for each time the loop runs after that I want x = y, the result of the previous loop. I always fumble with loops so any tips are greatly appreciated.
Code:
for(i in 1:5)
{
if(i=1)
{
x<-1
}
else
{
x<-y
}
y<-x*i
y
}
ERRORS:
for(i in 1:5)
+ {
+ if(i=1)
Error: unexpected '=' in:
"{
if(i="
> {
+ x<-1
+ }
> else
Error: unexpected 'else' in " else"
> {
+ x<-y
+ }
> y<-x*i
> y
[1] 25
> }
Error: unexpected '}' in "}"
Here is your code re-written with slightly clearer syntax
for (i in 1:5) {
if (i == 1) {
x <- 1
} else {
x <- y
}
y <- x * i
}
Or even better syntax.
for (i in 1:5) {
x <- ifelse(i == 1, 1, y)
y <- x * i
}
I have made a function that tests which numbers in a range that are multiple of 6 and/or 3, or none of them.
Multi <- function(x,y) {
z = x:y
for (i in z) {
if (i%%1!=0 | i<0) {
print("Error!")
break
} else if (i%%3==0 & i%%6==0) {
print(paste(i, "is multiple of both 3 and 6"))
} else if (i%%3==0) {
print(paste(i, "is multiple of 3"))
} else {
print(paste(i, "is not multiple"))
}
}
}
The loop works as I want it to, but within the first if-statement, I would also like it to print "Error!" if a character/string is provided. The message I get when trying Multi("Hello",10) is:
Error in x:y : NA/NaN argument
In addition: Warning message:
In Multi("Hello", 10) : NAs introduced by coercion
I have tried the suppressWarnings() function, but I couldn't make it work.
Any suggestions?
Try this:
Multi <- function(x,y) {
if (!is.numeric(x) | !is.numeric(y)) {
print("Error!")
} else {
z = x:y
for (i in z) {
if (i%%1!=0 | i<0) {
print("Error!")
break
} else if (i%%3==0 & i%%6==0) {
print(paste(i, "is multiple of both 3 and 6"))
} else if (i%%3==0) {
print(paste(i, "is multiple of 3"))
} else {
print(paste(i, "is not multiple"))
}
}
}
}
Multi(1,10)
Multi('Hello', 10) # now it will print Error without a NaN: 'Hello':10 was causing this NaN
You can reduce the code a little bit also
sapply(1:10, function(i) ifelse(i%%3==0,
ifelse(i%%6==0,
paste(i, "is multiple of both 3 and 6"),
paste(i, "is multiple of 3")),
paste(i, "is not multiple")))
Using:
mean (x, trim=0.05)
Removes 2.5% from each side of the distribution, which is fine for symmetrical two-tailed data. But if I have one tailed or highly asymmetric data I would like to be able to remove just one side of the distribution. Is there a function for this or do I have write myself a new one? If so, how?
Just create a modified mean.default. First look at mean.default:
mean.default
Then modify it to accept a new argument:
mean.default <-
function (x, trim = 0, na.rm = FALSE, ..., side="both")
{
if (!is.numeric(x) && !is.complex(x) && !is.logical(x)) {
warning("argument is not numeric or logical: returning NA")
return(NA_real_)
}
if (na.rm)
x <- x[!is.na(x)]
if (!is.numeric(trim) || length(trim) != 1L)
stop("'trim' must be numeric of length one")
n <- length(x)
if (trim > 0 && n) {
if (is.complex(x))
stop("trimmed means are not defined for complex data")
if (any(is.na(x)))
return(NA_real_)
if (trim >= 0.5)
return(stats::median(x, na.rm = FALSE))
lo <- if( side=="both" || side=="right" ){ floor(n * trim) + 1 }else{1}
hi <- if( side=="both" || side=="left" ){ n + 1 - (floor(n * trim) + 1 ) }else{ n}
x <- sort.int(x, partial = unique(c(lo, hi)))[lo:hi]
cat(c(length(x), lo , hi) )
}
.Internal(mean(x))
}
I don't know of a function. Something like the following would trim off the upper tail of the distribution before taking the mean.
upper.trim.mean <- function(x,trim) {
x <- sort(x)
mean(x[1:floor(length(x)*(1-trim))])
}
This should account for either side, or both sides for trimming.
trim.side.mean <- function(x, trim, type="both"){
if (type == "both") {
mean(x,trim)}
else if (type == "right") {
x <- sort(x)
mean(x[1:floor(length(x)*(1-trim))])}
else if (type == "left"){
x <- sort(x)
mean(x[max(1,floor(length(x)*trim)):length(x)])}}
one.sided.trim.mean <- function(x, trim, upper=T) {
if(upper) trim = 1-trim
data <- mean(x[x<quantile(x, trim)])
}
I found that all the answers posted do not match when checked manually. So I created one of my own. Its long but simple enough to understand
get_trim <- function(x,trim,type)
{
x <- sort(x)
ans<-0
if (type=="both")
{
for (i in (trim+1):(length(x)-trim))
{
ans=ans+x[i];
}
print(ans/(length(x)-(2*trim)))
}
else if(type=="left")
{
for (i in (trim+1):(length(x)))
{
ans=ans+x[i];
}
print(ans/(length(x)-trim))
}
else if (type=="right")
{
for (i in 1:(length(x)-trim))
{
ans=ans+x[i];
}
print(ans/(length(x)-trim))
}
}