R user-defined function called but not running - r

I am new to R, and I am trying to create a user-defined function and run it inside a for loop. The function is defined in the same script before it is called. However, when the function is called, the code inside the function doesn't run. No syntax errors occur.
Here is the function definition:
placeInVector <- function(subjectID, morpho) {
if (morpho == "Alg") {
algVec <- c(algVec, subjectID)
}
else if (morpho == "Anem") {
anemVec <- c(anemVec, subjectID)
}
else if (morpho == "Barn") {
barnVec <- c(barnVec, subjectID)
}
else if (morpho == "Biv") {
bivVec <- c(bivVec, subjectID)
}
else if (morpho == "BrBryo") {
brbryoVec <- c(brbryoVec, subjectID)
}
else if (morpho == "ColTuni") {
coltuniVec <- c(coltuniVec, subjectID)
}
else if (morpho == "EnBryo") {
enbryoVec <- c(enbryoVec, subjectID)
}
else if (morpho == "Nothing") {
nothingVec <- c(nothingVec, subjectID)
}
else if (morpho == "SolTuni") {
soltuniVec <- c(soltuniVec, subjectID)
}
else if (morpho == "Spng") {
spngVec <- c(spngVec, subjectID)
}
else if (morpho == "TubeWm") {
tubewmVec <- c(tubewmVec, subjectID)
}
}
Here is where the function is called later on in the script:
for (subject in subjects$SubjectID) {
currentRow <- finalIDs %>%
filter(SubjectID == subject)
morphoID <- as.character(currentRow$FinalIDs1)
if (morphoID != "NONE") {
placeInVector(subject, morphoID)
}
}
Note: all of the vectors referenced in the function definition (algVec, anemVec, etc.) are defined as empty vectors.

As far as I understand, you are trying to add elements to vectors. Because I don't have a reproducible example, I will use my own. Here, add_to_vector adds elements to a and b:
a <- c(1,2)
b <- c("a","b")
add_to_vector <- function(vec, to_add){
vec <- c(vec, to_add)
return(vec)
}
a <- add_to_vector(a, 3)
b <- add_to_vector(b, "c")
Hopefully, this gives you an idea of how R works.
Output
> a
[1] 1 2 3
> b
[1] "a" "b" "c"

Related

Non Stop Loop in Divide and Conquer Algorithm

I am doing 'find majority element' using R. And when the function me is running, it would not stop and got "Error: C stack usage 7971200 is too close to the limit"
I have checked single majority element comparison and it works.
So which step i went wrong?
library(Dict)
maj.com <- function(a,b) {
if (is.null(a)&& is.null(b)) {
return(NULL)
}
if (!(is.null(a)) && is.null(b)) {
return(a)
}
if (is.null(a) && !(is.null(b)) ){
return(b)
}
if (unlist(a[1]) == unlist(b[1])) {
a[2] = as.integer(a[2])+ as.integer(b[2])
return(a)
}
if (unlist(a[1]) != unlist(b[1]) && as.integer(a[2]) > as.integer(b[2])) {
a[2] = as.integer(a[2]) - as.integer(a[2])
return(a)
}
if (unlist(a[1]) != unlist(b[1]) && as.integer(a[2]) < as.integer(b[2])) {
b[2] = as.integer( b[2] )- as.integer(a[2])
return(b)
}
if (unlist(a[1]) != unlist(b[1]) && as.integer(a[2]) == as.integer(b[2])) {
return(NULL)
}
}
mydict <- function(key,value) {
return(list(key,value))
}
me <- function(arr) {
n = length(arr)
m = round(n/2)
if (n>1) {
return(maj.com(me(arr[1:m]),me(arr[m+1:n])))
}
else {
print(arr)
return(mydict(arr,1))
}
}

After add new code, things cannot knit out

I met a wired situation. After add new code The code cannot knit out.
function_name <- function (...)
{
output <- if (output_format == "list") {
evolved.ts
} else if (output_format == "tsibble") {
as.tsibble(evolved.ts)
}
return(output)
}
You could read the arguments with args <- list(...):
function_name <- function (...)
{
args <- list(...)
# Code
output <- if (args$output_format == "list") {
evolved.ts
} else if (output_format == "tsibble") {
as.tsibble(evolved.ts)
}
return(output)
}

what is different between two codes?

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.

IF ELSE function works in simple case, but my expanded function does not

I am trying to create functions that evaluates numbers and adds them to a category dependent on set criteria.
I wrote a "stupid" function with a lot of repetitions and lines, that can solve the job in a simple case:
# Findgroup (Everything manually typed out)
# Purpose of function:
#If 1 or 2: output A
#If 3 or 4: output B
#If 5 or 6: output random A/B (bonus if this can be balanced equally over the dataset)
# Else output "error"
findGroup <- function(x){ if (x == 1) {
"A"
} else if (x == 2) {
"A"
} else if (x == 3) {
"B"
} else if (x == 4) {
"B"
}else if (x == 5) {
sample(c("sA","sB"),1)
}else if (x == 6) {
sample(c("sA","sB"),1)
} else {
"Error"
}}
# Brief test: All matches expectations
findGroup(1) # Returns A
findGroup(3) # Returns B
findGroup(5) # Samples
findGroup(7) # Returns Error
This is okay, if I had to evaluate a few numbers. But what should I do if the list of numbers is much more elaborate? I tried to write a function that solves this in fewer lines, but the result does not work:
# Findgroup new
# Purpose of function:
#If 2:8: output A
#If 10:16: output B
#If 1,9: output random A/B (bonus if this can be balanced equally)
findGroupNew <- function(x){ if (x == 2|3|4|5|6|7|8) {
"A"
} else if (x == 10|11|12|13|14|15|16) {
"B"
} else if (x == 1||9) {
sample(c("sA","sB"),1)
} else {
"Error"
}}
# Brief test: All return A!!!
findGroupNew(1) # Should sample
findGroupNew(3) # Should Return A
findGroupNew(11) # Should Return B
findGroupNew(17) # Should Return Error
It may be a stupid mistake such as not having used the right sign for OR, but having tried solutions such as using || and & has not been successful.
I hope there is a quick fix to this issue and will appreciate your feedback.
Use %in% to check for multiple values.
findGroupNew <- function(x) {
if (x %in% 2:6) {
return("A")
} else if (x %in% 10:16) {
return("B")
} else if (x %in% c(1, 9)) {
return(sample(c("sA","sB"),1))
} else {
return("Error")
}
}
findGroupNew(1)
#[1] "sB"
findGroupNew(3)
#[1] "A"
findGroupNew(11)
#[1] "B"
findGroupNew(7)
#[1] "Error"

Why is break() not working in this loop? (but stop is)

I am trying to build a matrix model which ends if certain conditions are invoked - however for some reason the break() command isn't working, although stop() does. Unfortunately stop() is not what I need as I need to run the model a number of times.
The first break command in the model works, but I have left it in with dth>100 so that you can see for yourselves
n.steps <- 200
ns <- array(0,c(14,n.steps))
ns[13,1]<-rpois(1,3)
ns[14,1] <- 1
k<-0
for (i in 1:n.steps){
k<-k+1
ns[13,1]<-rpois(1,2)
death<-sample(c(replicate(1000,
sample(c(1,0), prob=c(surv.age.a, 1-surv.age.a), size = 1))),1)
ns[14,k] <- death
if (death == 0) {
dth <- sample(1:100, 1)
if (dth > 100) {
ns[14,k]<-0
print("stop.1")
break()
} else {
while (death == 0) {
if (ns[13, k] > 0) {
rep.vec[i]<-ns[13,k]
ns[13, k] <- ns[13, k] - 1
ns[14,k+1]<-1
print("replace")
} else {
if (ns[13, k] == 0) {
print("stop.2")
ns[14,k+1]<-0
break()
}
}
}
}
}
}
Try this (only showing the relevant portions):
for (i in 1:n.steps){
# ...
break.out.of.for <- FALSE
while (death == 0) {
if (ns[13, k-1] > 0) {
# ...
} else {
if (ns[13, k] == 0) {
# ...
break.out.of.for = TRUE
break
}
}
if (break.out.of.for) {
break
}
}

Resources