I have read in a csv file about weather on days. One of the variables is called winddirection (windrichting) but it is given in degrees and 0 and 990 have special meaning.
I want to change the numbers to North/South/West/East but when I used the replace function it changed the datatype of the whole vector to char which prevented my next replace with a range to work. So now I ended up with an if/else if/else statement but I can't get it to work. Also I get an error condition has length > 1. Can anyone help me get this to work so I have the ranges 45-135 to east, 135-225 south, etc.
here is my code where mydata$DD is the variable for wind direction with over 2000 values.
windrichting <- mydata$DD
windrichting <- if (windrichting == 990 ){
windrichting == "Veranderlijk"
} else if (windrichting>45 && windrichting<=135){
windrichting == "Oost"
} else if (windrichting>135 && windrichting<=225){
windrichting == "Zuid"
} else if (windrichting>225 && windrichting <=315){
windrichting == "West"
} else if (windrichting ==0){
windrichting == "Windstil"
} else windrichting == "Noord"
Perhaps something along the lines of this?
tmp <- round((windrichting + 45) / 90) %% 8
tmp[windrichting == 990] <- 8
tmp <- factor(tmp, levels = 0:9, labels = c("Noord", "Oost", "Zuid", "West", "Veranderlijk", "Windstil"))
tmp[windrichting == 0] <- "Windstil"
windrichting <- tmp
You can do this using an *apply function.
windrichting_text <- unlist(lapply(windrichting, function (x) {
if (x == 990) {
return("Veranderlijk")
} else if {
....
} else {
return ("Noord")
})
This applies the function defined to all elements in the list.
Related
Let's suppose the next function:
demo_function <- function(x){
if(is.na(x)){
return(NA)
} else if(1 < x < 2){
return("something")
} else {
return("Nothing")
}
}
The idea is that when the argument x is between 1 and 2, say x=0.001, then the function returns something.
However when trying to run the above function, the next error arises:
Error: no function to go from, jumping to a higher level
How could I adjust the function in order to get "something" for the specified argument?
The issue is in the else if i.e. the syntax in R is different than the mathematical notation - multiple expressions are connected by logical operators
else if(1 < x && x < 2)
i.e.
demo_function <- function(x){
if(is.na(x)){
return(NA)
} else if(1 < x && x < 2){
return("something")
} else {
return("Nothing")
}
}
> demo_function(0.01)
[1] "Nothing"
> demo_function(1.5)
[1] "something"
> demo_function(NA)
[1] NA
for (i in 2:100 )
{
count <- 0
for (j in i )
if( (i %% j ) == 0 )
count <- count + 1
if(count == 2 )
print(i)
}
I am trying to print print prime numbers in R. Could any one help me to resolve
Let us look at your code and show what went wrong. It's the inner loop that did not loop at all:
for (i in 2:100 )
{
count <- 0
for (j in 1:i ) # you forgot to provide a vector here
if( i %% j == 0 )
count <- count + 1
if(count == 2)
print(i)
}
The answer above tries to optimise the code some more and is a more efficient solution. For example does it only test odd numbers because even ones clearly aren't prime numbers.
The below code creates the function prime_numbers which returns prime numbers up to an inputted number.
prime_numbers <- function(n) {
if (n >= 2) {
x = seq(2, n)
prime_nums = c()
for (i in seq(2, n)) {
if (any(x == i)) {
prime_nums = c(prime_nums, i)
x = c(x[(x %% i) != 0], i)
}
}
return(prime_nums)
}
else {
stop("Input number should be at least 2.")
}
}
## return the answer to your question
prime_numbers(100)
If you wanted the range 3:100, after running the above code you could run something like this:
a<-prime_numbers(100)
a[a>3]
I hope this helps!
I have a data frame of two columns first is the longitude and second is the latitude. I want to find the coordinates of the center cell.
e.g. the range is lat[31 31.5], lon[33 33.5] if the first values of two columns fulfill this condition then create the third column and put the value 31.25 and create the fourth column and put in it the value 33.25
I have tried nested for loop but it does not work
# my dataframe is cycle8 contain 166 rows and two columns
latitude<- seq(31,37,by=0.5)
longitude<- seq(33,37,by=0.5)
cycle8$latcenter<- 0
cycle8$loncenter<-0
for (m in 1:nrow(cycle8))
{
for(j in seq_along(latitude))
{
for(k in seq_along(longitude))
{
if (cycle8$lat[m]>=j && cycle8$lat[m]<=j+0.5 && cycle8$lon[m]>=k &&
cycle8$lon[m]<=k+0.5)
{
cycle8$latcenter[m]<- j+0.25
cycle8$loncenter[m]<- k+0.25
}
}
}
}
the following code will work and deliver the desired result but it is so long and requires a lot of statement typing
cycle8$latcenter<- 0
for (m in 1:nrow(cycle8))
{
if (cycle8$lat[m]>=31 && cycle8$lat[m]<=31.5 )
{
cycle8$latcenter[m]<- 31+0.25
}
else if
(cycle8$lat[m]>=31.5 && cycle8$lat[m]<=32 ){
cycle8$latcenter[m]<- 31.5+0.25
}
else if
(cycle8$lat[m]>=32 && cycle8$lat[m]<=32.5 ){
cycle8$latcenter[m]<- 32+0.25
}
else if
(cycle8$lat[m]>=32.5 && cycle8$lat[m]<=33 ){
cycle8$latcenter[m]<- 32.5+0.25
}
else if
(cycle8$lat[m]>=33 && cycle8$lat[m]<=33.5 ){
cycle8$latcenter[m]<- 33+0.25
}
else if
(cycle8$lat[m]>=33.5 && cycle8$lat[m]<=34 ){
cycle8$latcenter[m]<- 33.5+0.25
}
else if
(cycle8$lat[m]>=34 && cycle8$lat[m]<=34.5 ){
cycle8$latcenter[m]<- 34+0.25
}
else if
(cycle8$lat[m]>=34.5 && cycle8$lat[m]<=35 ){
cycle8$latcenter[m]<- 34.5+0.25
}
else if
(cycle8$lat[m]>=35 && cycle8$lat[m]<=35.5 ){
cycle8$latcenter[m]<- 35+0.25
}
else if
(cycle8$lat[m]>=35.5 && cycle8$lat[m]<=36 ){
cycle8$latcenter[m]<- 35.5+0.25
}
else if
(cycle8$lat[m]>=36 && cycle8$lat[m]<=36.5 ){
cycle8$latcenter[m]<- 36+0.25
}
else if
(cycle8$lat[m]>=36.5 && cycle8$lat[m]<=37 ){
cycle8$latcenter[m]<- 36.5+0.25
}
}
My solution avoids for-loops, sapply or other similiar functions. The logic behind the code is as follows: Since the ranges have decimals .50 or .00, the centered values will always be .25 or .75. This means that we simply need to replace the decimals; all decimals between .00 and.50 become.25, while the other ones become .75.
Here the code for this
# generate data
latitude <- seq(30, 32, .1)
longitude <- seq(30, 32, .1)
cycle8 <- data.frame(latitude, longitude)
# make a function that replaces decimals as explained above
lat_lon <- function(vec){
decimals <- as.character(format(vec, nsmall= 1))
decimals <- as.numeric(gsub("^.*\\.", "", decimals))
decimals <- ifelse(decimals < 5, .25, .75)
values <- as.numeric(gsub("\\..*","",vec)) + as.numeric(decimals)
return(values)
}
# apply function
cycle8$lat_center <- lat_lon(latitude)
cycle8$lon_center <- lat_lon(longitude)
# see results
cycle8
EDIT
Because you want 30.00 to be 29.75 and 30.50 to be 30.25, here is an edit. But the logic remains the same.
latitude <- seq(30, 32, .1)
longitude <- seq(30, 32, .1)
cycle8 <- data.frame(latitude, longitude)
lat_lon <- function(vec){
decimals <- as.character(format(vec, nsmall= 1))
decimals <- as.numeric(gsub("^.*\\.", "", decimals))
decimals_new <- ifelse(decimals > 5 | decimals == 0, .75, .25)
values <- as.numeric(gsub("\\..*","",vec)) + as.numeric(decimals_new)
values[decimals == 0] <- values[decimals == 0] - 1
return(values)
}
cycle8$lat_center <- lat_lon(latitude)
cycle8$lon_center <- lat_lon(longitude)
cycle8
# The other way of solving this question is
mydata<- c(35.666,35.4578,35.0, 33.50,32.10)
centered_value <- function(val){
a<- trunc(val)
b<- val %% 1
c<- ifelse(b/0.5 > 1, a +0.75 , ifelse(b/0.5> 1, a+0.25, ifelse(b/0.5 ==0, a-
0.25,a+0.25)))
}
d<- centered_value(mydata)
d
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'm backtesting trading strategies with R. This is at the moment my code.
- MergedSet$FXCloseRate contains the closing price for a certain currency pair
- MergedSet$RiskMA is the moving average of a certain risk index
- the rest should be clear
This formula at the Moment is not really fast over 11'000 entries. Why? Are data frames too slow? Where can I optimise here?
############
# STRATEGY #
############
#Null out trades and position
MergedSet$Trade <- 0
MergedSet$Position<-0
MergedSet$DailyReturn<-0
MergedSet$CumulativeReturn<-0
MergedSet$Investment<-0
MergedSet$CumulativeReturn[1:MAPeriod] <- 1
MergedSet$Investment[1:MAPeriod] <- InitialInvestment
#Strategy
n<-nrow(MergedSet)
for(i in seq(MAPeriod+1,n)){
#Updating the position
if(MergedSet$RiskMA[i] <= ParamDwn && MergedSet$RiskMA[i-1] > ParamDwn){
#sell signal, so short if no or long position active otherwise do nothing
if(MergedSet$Position[i-1] == 0 || MergedSet$Position[i-1] == 1){
MergedSet$Position[i] = -1
MergedSet$Trade[i] = 1
}
} else if(MergedSet$RiskMA[i] >= ParamUp && MergedSet$RiskMA[i-1] < ParamUp){
#buy signal, go long if no or short position active, otherwise do nothing
if(MergedSet$Position[i-1] == 0 || MergedSet$Position[i-1] == -1){
MergedSet$Position[i] = 1
MergedSet$Trade[i] = 1
}
} else {
MergedSet$Position[i] = MergedSet$Position[i-1]
}
#Return calculation
if(MergedSet$Position[i] == 1){
#long
MergedSet$DailyReturn[i] = MergedSet$FXCloseRate[i]/MergedSet$FXCloseRate[i-1]-1
} else if(MergedSet$Position[i] == -1){
#short
MergedSet$DailyReturn[i] = MergedSet$FXCloseRate[i-1]/MergedSet$FXCloseRate[i]-1
}
}