I am learning about loops and I have this code to check if a number is prime or not, but doesn't work. Where is the bug?
x <- 7
y <- seq(1,sqrt(x),by=1)
for(i in 1: sqrt(x)){
if(y[x%%y == 0]) {
print("FALSE")
}else{
print("TRUE")
}
}
This gives me the right solution, but it repeats the answer as many times as number of elements in i. Also I would like to ask how to use function inside a for with if:
i <- c(1: sqrt(x))
y3 <- x%%i == 0
y4 <- y3[-1]
for(value in i){
if(y4 == FALSE) {
print("TRUE")
}else{
print("FALSE")
}
}
version 3, gives me the solution but for evey element in i:
x <- 107
i <- c(1: sqrt(x))
y3 <- c(x%%i == 0)
y4 <- y3[-1]
for(value in i){
if(all(y4==F)) {
print("TRUE")
}else{
print("FALSE")
}
}
Since you mentioned that you must use a loop, the following code will work:
x <- 7
y <- seq(1, ceiling(sqrt(x)), by=1)
# is.factor is a vector which checks whether each element in y is a factor or not
# initialize to F
is.factor = F
# Start at y = 2 because 1 will be a factor
for(i in 2:length(y) ){
# Check whether current value in vector is a factor of x or not
# if not a factor, set value in index to F, otherwise set to T
ifelse( x%%y[i] != 0, is.factor[i] <- F, is.factor[i] <- T)
# If we are at the last element in y, print a result
if(i == length(y)){
# check if we have any factors.
# if we have any factors (i.e. any index in is.factor vector is T), then number is not prime
ifelse( any(is.factor), print("FALSE"), print("TRUE") )
}
}
You can do this-
check_prime <- function(num) {
if (num == 2) {
TRUE
} else if (any(num %% 2:(num-1) == 0)) {
FALSE
} else {
TRUE
}
}
> check_prime(7)
[1] TRUE
Related
EDIT: I found a solution thanks to the paper A survey of algorithms for calculating power indices of weighted majority games
I'd like to solve the following problem:
Given a set N={1,..,n} with a vector of weights W={w_1,..,w_n}, sorted in descending order and with total sum 1,
find all subsets C (also called "coalitions") of N such that
C is "winning", that means that the sum of the weights of elements inside the subset C exceeds a certain threshold (e.g. 0.5)
C is "minimal", that means that removing any element from C will make the subset not "winning" anymore.
To clarify, an example could be: N={1,2,3} W={0.45,0.35,0.2}
The "winning" subsets here are {1,2},{2,3},{1,3} and {1,2,3} since they all exceed 0.5 total weight
only {1,2}, {2,3} and {1,3} are minimal, since in {1,2,3} you could remove one element and get the ones above.
From the paper cited above, I now implemented this code which recursively generates the list of all minimal winning coalitions
MWC = function(w,threshold=0.5){
n = length(w)
l = list()
enumerate = function(S1,n1,b1){
if(n1==n){
return(list(c(S1,n1)))
}else{
if(sum(w[(n1+1):n]) >= b1){
l = c(l,enumerate(S1,n1+1,b1))
}
if(w[n1] >= b1){
l=c(l,list(c(S1,n1)))
}else{
l = c(l,enumerate(c(S1,n1),n1+1,b1-w[n1]))
return(l)
}
}
}
return(enumerate(c(),1,threshold))
}
w = c(0.46,0.3,0.19,0.05)
MWC(w)
The code runs up to around n = 20, after the exponential complexity makes everything unfeasible.
One solution to your problem will be using while loop and applying the above constraints within the loop.
Below is the working code:
N = 1:10
W <- c(0.60, 0.40, 0.33, 0.30, 0.25, 0.20, 0.15, 0.10, 0.05, 0.03);
Winning_Sets <- c()
i <- 1
while (i != (length(N) - 1)) {
if (i == 1) {
Subsets <- combn(N, i)
} else {
Keep_Combs <- Subsets[,which(Intermediate_Sets == 'No_Match')]
Subsets <- combn(N, i)
if (i == 2) {
Subsets <- apply(Subsets, 2, function(x) {
x <- x[x[i - 1] %in% Keep_Combs]
})
} else {
Subsets <- apply(Subsets, 2, function(x) {
unlist(apply(Keep_Combs, 2, function(y) {
if (identical(y, x[1:(i - 1)]) == TRUE) {
x
}
}))
})
}
Subsets <- do.call('cbind', Subsets)
}
Intermediate_Sets <- apply(Subsets, 2, function(x) {
if (sum(W[x]) > 0.5) {
paste('{', paste(x, collapse = ','), '}', sep = '')
} else {
'No_Match'
}
})
Winning_Sets <- append(Winning_Sets, unlist(Intermediate_Sets[Intermediate_Sets != 'No_Match']))
if (length(which(Intermediate_Sets == 'No_Match')) > 0) {
i <- i + 1
} else {
i <- length(N) - 1
}
}
Output:
Winning_Sets
[1] "{1}" "{2,3}" "{2,4}" "{2,5}" "{2,6}" "{2,7}"
[7] "{3,4}" "{3,5}" "{3,6}" "{4,5}" "{2,8,9}" "{2,8,10}"
[13] "{3,7,8}" "{3,7,9}" "{3,7,10}" "{4,6,7}" "{4,6,8}" "{4,6,9}"
[19] "{4,6,10}" "{4,7,8}" "{5,6,7}" "{5,6,8}" "{3,8,9,10}" "{4,7,9,10}"
[25] "{5,6,9,10}" "{5,7,8,9}" "{5,7,8,10}" "{6,7,8,9,10}"
I am trying to run this code:
check_zeros <- function(x) { # WIP
if (x == 0) {
!(df[gsub('\\b0+','',format(as.Date(formation$study_start_dates_list[i]),'%m/%d/%Y')), names(x)] == df[gsub('\\b0+','',format(as.Date(formation$study_end_dates_list[i]),'%m/%d/%Y')), names(x)])
}
}
remove_undesired_stocks2 <- function(n) {
i = 1
listofdfs_filtered <- list()
for (i in 1:n) {
a <- subset(average_returns, row.names(average_returns) == i)
b <- as.data.frame(sapply(subset(average_returns, row.names(average_returns) == i), function(x) all(x == 0 | is.nan(x) | check_zeros(x) )))
c <- a[, !b]
listofdfs_filtered[[i]] <- c
}
return(listofdfs_filtered)
}
Error comes out as:
Error in if (x == 0) { : missing value where TRUE/FALSE needed
I think it is bc there is a NaN going into x == 0 of the check_zeros function.
Any how I can overcome this? Thanks in advance.
I think I solved it myself:
the check_zero function is constructed in a way which cannot take objects with length > 1. more specifically logic inside if cannot use objects length > 1.
Since I was using a object with length > 1, there was an error
You should use ifelse in this case:
check_zeros <- function(x) {
ifelse(x == 0, (df[gsub('\\b0+','',format(as.Date(formation$study_start_dates_list[i]),'%m/%d/%Y')), names(x)] == df[gsub('\\b0+','',format(as.Date(formation$study_end_dates_list[i]),'%m/%d/%Y')), names(x)]), FALSE)
}
Cheers.
I am comparing a 20-day moving average against a 50-day, 100-day 200-day and 333-day. The condition is essentially just
if(20MA > 50MA > 100MA > 200MA > 333MA) {
return TRUE
} else{
FALSE
}
Is there a way in R to handle this without multiple nested if statements?
if(tail(MA_20,n=1) > tail(MA_50,n=1) > tail(MA_100,n=1) > tail(MA_200,n=1) > tail(MA_333,n=1)) {
score[1] <- 1
} else{
score[1] <- -1
}
Use && (see help("&") for other logical operators)
if (tail(MA_20,n=1) > tail(MA_50,n=1) &&
tail(MA_50,n=1) > tail(MA_100,n=1) &&
tail(MA_100,n=1) > tail(MA_200,n=1) &&
tail(MA_200,n=1) > tail(MA_333,n=1)) {
score[1] <- 1
} else {
score[1] <- -1
}
The if statement will return true if all four of those comparisons are true.
The ifelse function might be helpful for you in speeding up your code as it helps vectorize comparisons.
The following way seems more complicated but is more flexible. It first gets all variables named after the pattern "MA_" and sapply the tail to extract the last element. Then uses diff to see if they are in decreasing order.
First make up some data.
library(zoo)
set.seed(1234) # Reproducible results
n <- 1e3
x <- rnorm(n)
MA_20 <- rollmean(x, k = 20)
MA_50 <- rollmean(x, k = 50)
MA_100 <- rollmean(x, k = 100)
MA_333 <- rollmean(x, k = 333)
Now the problem.
score <- NULL
ma <- stringr::str_sort(ls(pattern = "^MA_"), numeric = TRUE)
MA_last <- sapply(ma, function(m) tail(get(m), n = 1))
score[1] <- if(all(diff(MA_last) > 0)) 1 else -1
Here is my code:
n <- 10
set.seed(100)
d <- rep(NA, n)
d[1] <- 0
y <- runif(n)
a <- 5
for (i in (2:(length(y)+1))) {
d[i] <- d[i-1] + y[i-1]
}
store.x <- NULL
for(j in 1:a) {
x <- runif(1, min = 0, max = sum(y))
for (i in 1:(length(y))) {
if(x <= d[i+1] && x > d[i]) {
store.x[j] <- i
break
}
}
}
store.x
Now store.x prints out 7, 9, 4, 6, 8. I want to be able to put these into a matrix where the numbers that store.x prints correspond to the columns and the row is in order of the numbers. So the first entry would be in row 1 column 7, next would be row 2 column 9 and so on. I want to start with a n by n matrix filled with zeros and then add one the row/column that these numbers are in. I'm not sure how to go about doing this. Any help would be appreciated!
So creating a matrix mt that will be filled and then NA's changed to zeros.
n <- 10
set.seed(100)
d <- rep(NA, n)
d[1] <- 0
y <- runif(n)
a <- 220
mt = matrix(nrow = n, ncol = n)
mt[is.na(mt)] = 0
for (i in (2:(length(y)+1))) {
d[i] <- d[i-1] + y[i-1]
}
store.x <- NULL
for(j in 1:a) {
x <- runif(1, min = 0, max = sum(y))
for (i in 1:(length(y))) {
if(x <= d[i+1] && x > d[i]) {
store.x[j] <- i
if(length(which(i == store.x)) > 1){
mt[which(mt[,i] != 0),i] = mt[which(mt[,i] != 0),i] + 1
} else {
mt[(which(rowSums(mt) == 0)[1]),i] = 1
}
break
}
}
}
what i added was this following logic
if(length(which(i == store.x)) > 1){
mt[which(mt[,i] != 0),i] = mt[which(mt[,i] != 0),i] + 1
} else {
mt[(which(rowSums(mt) == 0)[1]),i] = 1
}
if the number created exists in store.x more than once then we find the existing entry (column corresponds to i and row will be the one which is not 0). If the number does not exist we then find the first row which has no entry and use that.
I've got the following code in R:
func.time <- function(n){
times <- c()
for(i in 1:n){
r <- 1 #x is the room the mouse is in
X <- 0 #time, starting at 0
while(r != 5){
if(r == 1){
r <- sample(c(2,3),1) }
else if(r == 2){
r <- sample(c(1,3), 1) }
else if(r == 3){
r <- sample(c(1,2,4,5), 1) }
else if (r == 4){
r <- sample(c(3,5), 1) }
X <- X + 1
}
times <- c(X, times)
}
mean(times)
}
func.time(10000)
It works fine, but I've been told that using switch() can speed it up seeing as I've got so many if else statements but I can't seem to get it to work, any help is appreciated in advance.
Edit
I've tried this:
func.time <- function(n) {
times <- c()
for(i in 1:n) {
r <- 1 #x is the room the mouse is in
X <- 0 #time, starting at 0
while(r != 5) {
switch(r, "1" = sample(c(2,3), 1),
"2" = sample(c(1,3), 1),
"3" = sample(c(1,2,4,5), 1),
"4" = sample(c(3,5)))
X <- X + 1
}
times <- c(X, times)
}
mean(times)
}
func.time(10000)
But it was a basic attempt, I'm not sure I've understood the switch() method properly.
I though Dominic's assessment was very useful but when I went to examine the edit it was being held up on what I thought was an incorrect basis. So I decided to just fix the code. When usign a numeric argument to the EXPR parameter you do not use the item=value formalism but rather just put in the expressions:
func.time <- function(n){times <- c()
for(i in 1:n){; r <- 1; X <- 0
while(r != 5){
r <- switch(r,
sample(c(2,3), 1) , # r=1
sample(c(1,3), 1) , # r=2
sample(c(1,2,4,5), 1), #r=3
sample(c(3,5), 1) ) # r=4
X <- X + 1 }
times <- c(X, times) }
mean(times) }
func.time(1000)
#[1] 7.999
For another example of how to use switch with a numeric argument to EXPR, consider my answer to this question: R switch statement with varying outputs throwing error