I am trying to write a function to calculate h-point. the function is defined over a rank frequency data frame.
consider the following data.frame :
DATA <-data.frame(frequency=c(49,48,46,38,29,24,23,22,15,12,12,10,10,9,9), rank=c(seq(1, 15)))
and the formula for h-point is :
if {there is an r = f(r), h-point = r }
else { h-point = f(i)j-f(j)i / j-i+f(i)-f(j) }
where f(i) and f(j) are corresponding frequencies for ith and jth ranks and i and j are adjacent ranks that i<f(i) and j>f(j).
NOW, i have tried the following codes :
fr <-function(x){d <-DATA$frequency[x]
return(d)}
for (i in 1:length(DATA$rank)) {
j <- i+1
if (i==fr(i))
return(i)
else(i<fr(i) && j>fr(j)) {
s <-fr(i)*j-fr(j)*i/j-i+fr(i)-fr(j)
return(s)
}}
I also tried:
for (i in 1:length(DATA$rank)) {
j <- i+1
if (i==fr(i))
return(i)
if (i<fr(i) while(j>fr(j))) {
s <-fr(i)*j-fr(j)*i/j-i+fr(i)-fr(j)
return(s)
}}
and neither of them works. for the DATA ,the desired result would be i=11 and j=12, so:
h-point=12×12 - 10×11 / 12 - 11 + 12 - 10
can you please tell me what I`m doing wrong here?
You could do:
h_point <- function(data){
x <- seq(nrow(data))
f_x <- data[["frequency"]][x]
h <- which(x == f_x)
if(length(h)>1) h
else{
i <- which(x<f_x)
j <- which(x>f_x)
s <- which(outer(i,j,"-") == -1, TRUE)
i <- i[s[,1]]
j <- j[s[,2]]
cat("i: ",i, "j: ", j,"\n")
f_x[i]*j - f_x[j]*i / (i-j + f_x[i]-f_x[j])
}
}
h_point(DATA)
i: 11 j: 12
[1] 34
I think I have figured out what you are trying to achieve. My loop will go through DATA and break at any point if rank == frequency for a given row. If might be more prudent to explicitly test this with DATA$rank[i] == fr(i) rather than relying on i, in case tied ranks etc.
The second if statement calculates h-point (s) for rows i and j if row i has rank that is lower than freq and row j has a rank that is higher.
Is this what you wanted?
DATA <-data.frame(frequency=c(49,48,46,38,29,24,23,22,15,12,12,10,10,9,9), rank=c(seq(1, 15)))
fr <-function(x){d <-DATA$frequency[x]
return(d)}
for(i in 1:nrow(DATA)){
j <- i+1
if (i==fr(i)){
s <- list(ij=c(i=i,j=j), h=i)
break
}else if(i <fr(i) && j>fr(j)){
s <-list(ij=c(i=i,j=j),h=fr(i)*j-fr(j)*i/j-i+fr(i)-fr(j))
}}
I am not sure the formula is correct, in your loop you had j-i but in explanation it was i-j. Not sure if the entire i-j+fr(i)-fr(j) is the denominator and similarly for the numerator. Simple fixes.
Related
Consider the below MWE that splits a distance matrix and attempts to compare partitions:
set.seed(1234) # set random seed for reproducibility
# generate random normal variates
x <- rnorm(5)
y <- rnorm(5)
df <- data.frame(x, y) # merge vectors into dataframe
d <- dist(x) # generate distance matrix
splt <- split(d, 1:5) # split data with 5 values in each partition
# compare partitions
for (i in 1:length(splt)) {
for (j in 1:length(splt)) {
if(splt[[i]] != splt[[j]]) {
a <- length(which(splt[[i]] >= min(splt[[j]]))) / length(splt[[i]])
b <- length(which(splt[[j]] <= max(splt[[i]]))) / length(splt[[j]])
}
}
}
# Error in if (splt[[i]] != splt[[j]]) { : the condition has length > 1
The above for loop should compare all unique partitions (i.e., (1, 2), (1, 3), ... ,(4, 5)). However, the condition is greater than 1.
The result for comparing partition 1 (split[[1]]) and partition 2 (split[[2]]) for instance should be a = b = 1.
a <- length(which(splt[[1]] >= min(splt[[2]]))) / length(splt[[1]])
b <- length(which(splt[[2]] <= max(splt[[1]]))) / length(splt[[2]])
I know the solution is to instead use ifelse() but there is no else within the nested loop.
Any ideas on how to proceed?
Is your problem the error message? That is, why R does not like your comparison splt[[i]] == splt[[j]]? The reason is that we get a vector of comparisons:
> splt[[1]] != splt[[2]]
[1] TRUE TRUE
If I understand you correctly, splt[[i]] is equal to splt[[j]] if all entries are equal and different otherwise. If so, change the comparison to be !(all(splt[[i]] == splt[[j]])).
The total loop looks like this:
for (i in 1:length(splt)) {
for (j in 1:length(splt)) {
if (!(all(splt[[i]] == splt[[j]]))) {
a <- length(which(splt[[i]] >= min(splt[[j]]))) / length(splt[[i]])
b <- length(which(splt[[j]] <= max(splt[[i]]))) / length(splt[[j]])
}
}
}
For the next exercise: From a certain numerical value, check if this is a natural number or not so that, if it is, it shows the divisors of this number and, if it is not, it shows an error message.
As there was no predefined function for this I wrote:
n <- 102
x <- n
res <- c()
while (x>0){
if (n%%x == 0){
res[x] <- x
x = x-1
} else {
x = x -1
} print("The values are ", res)
}
res
Works nice, except it´s not storing the values inside the vector. Any ideas?
I´m new to programming and stackoverflow. I hope this question is right posted and presented.
Cheers
What you need is a counter "i" to save the value in the next entry of the vector
n <- 102
x <- n
res <- c()
i<-1
while (x>0){
if (n%%x == 0){
res[i] <- x
x = x-1
i<-i+1
} else {
x = x -1
}
}
res
I am working with a time-series raster brick. The brick has 365 layers representing a value for each day of the year.
I want to create a new layer in which each cell holds the number of day of year in which a certain condition is met.
My current approach is the following (APHRO being the raster brick), but returns the error message below:
enter code here
r <- raster(ncol=40, nrow=20)
r[] <- rnorm(n=ncell(r))
APHRO <- brick(x=c(r, r*2, r))
NewLayer <- calc(APHRO, fun=FindOnsetDate(APHRO))
Returning this error:
Error in .local(x, ...) : not a valid subset
And the function being parsed:
FindOnsetDate <- function (s) {
x=0
repeat {
x+1
if(s[[x]] >= 20 | s[[x]] + s[[x+1]] >= 20 & ChkFalseOnset() == FALSE)
{break}
}
return(x);
}
With the function for the 3rd condition being:
ChkFalseOnset <- function (x) {
for (i in 0:13){
if (sum(APHRO[[x+i:x+i+7]]) >= 5)
{return(FALSE); break}
return(TRUE)
}
}
Thank you in advance!!!!
And please let me know if I should provide more information - tried to keep it parsimonious.
The problem is that your function is no good:
FindOnsetDate <- function (s) {
x=0
repeat {
x+1
if(s[[x]] >= 20 | s[[x]] + s[[x+1]] >= 20)
{break}
}
return(x);
}
FindOnsetDate(1:100)
#Error in s[[x]] :
# attempt to select less than one element in get1index <real>
Perhaps something like this:
FindOnsetDate <- function (s) {
j <- s + c(s[-1], 0)
sum(j > 20 | s > 20)
# if all values are positive, just do sum(j > 20)
}
FindOnsetDate(1:20)
#10
This works now:
r <- calc(APHRO, FindOnsetDate)
I would suggest a basic two-step process. With a 365-days example:
set.seed(123)
r <- raster(ncol=40, nrow=20)
r_list <- list()
for(i in 1:365){
r_list[[i]] <- setValues(r,rnorm(n=ncell(r),mean = 10,sd = 5))
}
APHRO <- brick(r_list)
Use a basic logic test for each iteration:
r_list2 <- list()
for(i in 1:365){
if(i != 365){
r_list2[[i]] <- APHRO[[i]] >= 20 | APHRO[[i]] + APHRO[[i+1]] >= 20
}else{
r_list2[[i]] <- APHRO[[i]] >= 20
}
}
Compute sum by year:
NewLayer <- calc(brick(r_list2), fun=sum)
plot(NewLayer)
I am new in programming, and I just start learning R language. I am trying to do a bubble sort, but it shows the following error message. Can anyone help me solve the problem?
x <-sample(1:100,10)
n <- length(x)
example <- function(x)
{
for (i in 1:n-1)
{
while (x[i] > x[i+1])
{
temp <- x[i+1]
x[i+1] <- x[i]
x[i] <- temp
}
i <- i+1
}
}
example(x)
Error in while (x[i] > x[i + 1]) { : argument is of length zero
x<-sample(1:100,10)
example <- function(x){
n<-length(x)
for(j in 1:(n-1)){
for(i in 1:(n-j)){
if(x[i]>x[i+1]){
temp<-x[i]
x[i]<-x[i+1]
x[i+1]<-temp
}
}
}
return(x)
}
res<-example(x)
#input
x
#output
res
It is working fine with little modification of your code. In 'R' it is better to use sort() function.
x <-sample(1:100,10)
x
res<-sort(x)
res
You have some inaccuracies in your algorithm of sorting. I've made changes to make it work.
set.seed(1)
x <-sample(1:100,10)
x
# [1] 27 37 57 89 20 86 97 62 58 6
example <- function(x)
{
n <- length(x) # better insert this line inside the sorting function
for (k in n:2) # every iteration of the outer loop bubbles the maximum element
# of the array to the end
{
i <- 1
while (i < k) # i is the index for nested loop, no need to do i < n
# because passing j iterations of the for loop already
# places j maximum elements to the last j positions
{
if (x[i] > x[i+1]) # if the element is greater than the next one we change them
{
temp <- x[i+1]
x[i+1] <- x[i]
x[i] <- temp
}
i <- i+1 # moving to the next element
}
}
x # returning sorted x (the last evaluated value inside the body
# of the function is returned), we can also write return(x)
}
example(x)
# [1] 6 20 27 37 57 58 62 86 89 97
BTW, R language has a lot of functions and methods for doing things. This example function can be a learning example, but I advice to use existing function sort for solving real problems.
In R language you should try to avoid loops and make usage of vectorized functions to make the code faster.
It gives you that error message because he cannot compare a value that is out of his bounds which is the case for you at (x[i] > x[i + 1]). Try this if you want to sort your array in a decreasing order:
for (i in 1:n){
j = i
while((j>1)){
if ((X[j]> X[j-1])){
temp = X[j]
X[j] = X[j-1]
X[j-1] = temp
}
j = j-1
}
}
For an increasing order you just have to switch around the > sign in the while loop.
I want to restrict the for cycle to only perform task if j is in some range of i (3 units, for example).
I tried the following piece of code:
a <- c(1:100)
b <- c(1:100)
k1 <- length(a)
k2 <- length(b)
for (i in 1:k1){
for (j in 1:k2){
if (j>=i-3 & j<=i+3){
c<-c(a+b)
}
}
}
What I pretended was
if i=1, j={1,2,3}, if i=6, j={1,2,3,4,5,6}
This doesn´t really work since, j and i will end up running from 1 to 100.
If I understand, the problem is that you are looping through 100 combinations of j, when only three to seven are actually useful.
If this is correct, you can loop through seven iterations of j and filter for values that are positive and within bounds:
width <- 3
for (i in seq_along(a)) {
for (j in (i-width):(i+width)) {
if (j > 0 && j <= length(b)) {
# Do something
}
}
}
When you # Do something in your code, I would advise not assigning to a variable named c.