I'm working with panel data in R and am endeavoring to build a function that returns every user ID where PCA==1. I've largely gotten this to work, with one small problem: it only returns the values when I end the function with print() but does not do so when I end the function with return(). As I want the ids in a vector so I can later subset the data to only include those IDs, that's a problem. Code reflected below - can anyone advise on what I'm doing wrong?
The version that works (but doesn't do what I want):
retrievePCA<-function(data) {
for (i in 1:dim(data)[1]) {
if (data$PCA[i] == 1) {
id<-data$CPSIDP[i]
print(id)
}
}
}
retrievePCA(data)
The version that doesn't:
retrievePCA<-function(data) {
for (i in 1:dim(data)[1]) {
if (data$PCA[i] == 1) {
id<-data$CPSIDP[i]
return(id)
}
}
}
vector<-retrievePCA(data)
vector
Your problem is a simple misunderstanding of what a function and returning from a function does.
Take the small example below
f <- function(x){
x <- x * x
return x
x <- x * x
return x
}
f(2)
[1] 4
4 is returned, 8 is not. That is because return exits the function returning the specific value. So in your function the function hits the first instance where PCA[i] == 1 and then exits the function. Instead you should create a vector, list or another alternative and return this instead.
retrievePCA<-function(data) {
ids <- vector('list', nrow(data))
for (i in 1:nrow(data)) {
if (data$PCA[i] == 1) {
ids[[i]] <-data$CPSIDP[i]
}
}
return unlist(ids)
}
However you could just do this in one line
data$CPSIDP[data$PCA == 1]
I am trying to define a function with a for loop and inside a conditional in R studio. Yesterday I was able with the help of another thread to devise this piece of code. The problem is that I want to sum the vector elements ma for any possible x, so that is inside the function l. This is a simpler case which I am trying to solve to adapt the original model. However, I do not know how to proceed.
ma<-rep(0,20)
l <- function(x, ma) {
for(i in seq_along(ma)) {
if(i %% 2 == 1) {
ma[i] <- i + x
} else {
ma[i] <- 0
}
}
return(ma)
}
My problem is that I would like to have the sum of i+x+0+i+x... for any possible x. I mean a function of the kind for any possible x.
Question:
Can someone explain to me how to implement such a function in R?
Thanks in advance!
I am going to update the original function:
Theta_alpha_s<-function(s,alpha,t,Basis){
for (i in seq_along(Basis)){
if(i%% 2==1) {Basis[i]=s*i^{-alpha-0.5}*sqrt(2)*cos(2*pi*i*t)}
else{Basis[i]=s*i^{-alpha-0.5}*sqrt(2)*sin(2*pi*i*t)}
}
return(Basis)
}
If you don't want to change the values in Basis, you can create a new vector in the function (here result) that you will return:
l = function(s,alpha,t,Basis){
is.odd = which(Basis %% 2 == 1)
not.odd = which(Basis %% 2 == 0)
result = rep(NA, length(Basis))
result[is.odd] = s*is.odd^{-alpha-0.5}*sqrt(2)*cos(2*pi*is.odd*t)
result[not.odd] = s*not.odd^{-alpha-0.5}*sqrt(2)*sin(2*pi*not.odd*t)
#return(result)
return(c(sum(result[is.odd]), sum(result[not.odd])))
}
enter image description here
I know there exists function 'unique' which works similar to what I want to make, but I want to make this function.
I want this function finally returns 'result' which contains unique elements of input vector.
But I don't know why this function's result is totally different from my expect.
Why c which is to combine before result and new unique element is not working.
Please tell me how to fix my code.
Thank you.
I think what you expect might be something like below, where result should be an argument of m_uni:
m_uni <- function(x,result = c()) {
if (class(x)=='numeric'| class(x)=='character') {
if (length(x) <= 1){
return(result)
} else {
if (x[length(x)] %in% result) {
x <- x[-length(x)]
m_uni(x,result)
} else {
result <- c(result,x[length(x)])
x <- x[-length(x)]
m_uni(x,result)
}
}
} else {
return('This function only gets numeric or character vector')
}
}
such that
> m_uni(x)
[1] 0 4 5 -2
The algorithm is from https://www.math.upenn.edu/~wilf/eastwest.pdf page 16 RandomKSubsets
RandomKSubsets = function(n, k){
if (n<0 | k<0 | k<n){
return()
}
else {
if (n==0 && k==0){
return(c())
}
else {
rno = runif(1)
if (rno < n/k){
east = RandomKSubsets(n-1,k-1)
return (c(east, k))
}
else{
west = RandomKSubsets(n,k-1)
return(west)
}
}
}
}
Running the program with k=4000 and n=1200 I run into recursion depth limit. I tried options(expressions=500000) but it's not enough for the algorithm. How can I run this code for my variables?
This is close to tail recursion: the only recursive calls are in the return statements. This blog: http://blog.moertel.com/posts/2013-05-11-recursive-to-iterative.html describes how to change such functions into loops. I followed the mostly mechanical process described there, and came up with this version:
RandomKSubsetsLoop = function(n, k) {
acc <- NULL
while (TRUE) {
if (n<0 | k<0 | k<n){
return(acc)
}
else {
if (n==0 && k==0){
return(acc)
}
else {
rno = runif(1)
if (rno < n/k){
acc <- c(k, acc)
k <- k - 1
n <- n - 1
next
}
else{
k <- k - 1
next
}
}
}
break
}
}
I haven't tested it extensively, but it produces the same result as the original in this test:
set.seed(1)
RandomKSubsets(5, 10)
# [1] 1 3 6 9 10
set.seed(1)
RandomKSubsetsLoop(5, 10)
# [1] 1 3 6 9 10
You'll probably want to do more extensive testing, and read the blog to make sure I've done things as it describes.
By the way, there are other algorithms to do this sampling, e.g. the one described in
AUTHOR="McLeod, A.I. and Bellhouse, D.R. ",
YEAR = 1983,
TITLE="A convenient algorithm for drawing a simple random sample",
JOURNAL="Applied Statistics",
VOLUME="32",
PAGES="182-184"
That one is based on a loop by design, and has the advantage that you don't need to know the population size (k in your notation) in advance: you just keep updating your sample until there are no more items to process.
Background
I'm developing a function that takes in a value for w between 1 and 3 and returns n values from one of 3 distributions.
The problem I am having is when n or w are not of length 1. So I've added 2 parameters nIsList and wIsList to create the functionality I want. The way I want this to work is as follows:
(Works as needed)
If nIsList ex( c(1,2,3) ) return a list equivalent to running consume(w,1), consume(w,2), consume(w,3)
(Works as needed)
If wIsList ex( c(1,2,3) ) return a list equivalent to running consume(1,n), consume(2,n), consume(3,n)
(Doesn't work as needed)
If nIsList ex(1,2,3) and wIsList ex(1,2,3)
return a list equivalent to running consume(1,1), consume(2,2), consume(3,3). Instead, I get a list equivalent to running [consume(1,1), consume(1,2), consume(1,3)], [consume(2,1), consume(2,2), consume(2,3)], [consume(3,1),consume(3,2), consume(3,3)]
I understand why I am getting the results I am getting. I just can't seem to figure out how to get the result I want. (As explained above)
Question
I want the function to provide a list for each element in w and n that is consume(w[i], n[i]) when wIsList & nIsList are True. Is there a way to do that using lapply?
The code:
library("triangle")
consume <- function(w, n=1, nIsList=F, wIsList=F){
if(!nIsList & !wIsList){
if(w==1){
return(rtriangle(n,0.3,0.8))
}else if(w==2){
return(rtriangle(n,0.7,1))
}else if(w==3){
return(rtriangle(n,0.9,2,1.3))
}
}
else if(nIsList & !wIsList){
return(sapply(n, consume, w=w))
}
else if(nIsList & wIsList){
return(lapply(n, consume, w=w, wIsList=T))
}
else if(!nIsList & wIsList){
return(lapply(w, consume, n))
}
}
Note: I am having trouble summarizing this question. If you have any suggestions for renaming it please let me know and I will do so.
Thanks to JPC's comment, using mapply does the trick. The new code is as follows:
consume <- function(w, n=1){
nIsList <- length(n) > 1 # Change based on JPC's second comment
wIsList <- length(w) > 1 # Change based on JPC's second comment
if(!nIsList & !wIsList){
if(w==1){
return(rtriangle(n,0.3,0.8))
}else if(w==2){
return(rtriangle(n,0.7,1))
}else if(w==3){
return(rtriangle(n,0.9,2,1.3))
}
}
else if(nIsList & !wIsList){
return(sapply(n, consume, w=w))
}
else if(nIsList & wIsList){
return(mapply(consume,w,n)) ## Updated portion
}
else if(!nIsList & wIsList){
return(lapply(w, consume, n))
}
}