I have a 3d array as below:
prob = array(0,c(7,7,7))
Now, i need to refill it by random numbers as below:
pop = sample(1:100, 7**3, replace=TRUE)
pop = pop/sum(pop)
if simply assign the value to it then it will remove all the dimentions of prob :
prob = pop
print(dim(prob))
The output of the print is:
> print(dim(prob))
NULL
Therefore, apparently the prob = pop erase the dimensions.
How can i assign data but keep the 3d dimensions?
You can perform subset assignment as follows:
prob[] = pop
This will replace the values but preserve dimensions and other attributes.
However, this seems unnecessary in your case: why assign after the fact, when you can initialise?
pop = sample(1 : 100, 7 ** 3, replace = TRUE)
prob = array(pop / sum(pop), c(7, 7, 7))
There’s no need to pre-assign prob as a zero array, and in fact I’d consider that an anti-pattern: in general you should treat variables as read-only, unless there are specific reasons to reassign/modify them (and there rarely are).
Related
Is there any fast function that is able to calculate a rolling average that is weighted? This is necessary because I have multiple observation (not always the same number) per data point (change in seconds) and I average that. When I take the rolling average, I want to re-weight to get an unbiased rolling average.
So far, I came up with this solution (in this example with a window of 3 seconds).
sam <- data.table(val_mean=c(1:15),N=c(11:25))
sam[,weighted:=val_mean*N]
sam[,rollnumerator:=rollapply(weighted,3,sum,fill=NA,align="left")]
sam[,rolldenominator:=rollapply(N,3,sum,fill=NA,align="left")]
sam[,rollnumerator/rolldenominator]
I couldn't find any question that already addresses this problem.
This is not about unequal spacing of the data: I can take care of that by expanding my data.table with NAs to include each second (the example above is equally spaced). Also, I don't want to include weights in the sense of RcppRoll's roll_mean: There, weights are fixed for all time windows ("A vector of length n, giving the weights for each element within a window."), while in my case the weights change according to the values currently processed. Thirdly, I don't want an adaptive window size, it should stay fixed (say at 3 seconds).
1) Use by.column = FALSE:
library(data.table)
library(zoo)
wmean <- function(x) weighted.mean(x[, 1], x[, 2])
sam[, rollapplyr(.SD, 3, wmean, by.column = FALSE, fill = NA, align = "left")]
2) Another approach is to encode the values and weights into a complex vector:
wmean_cmplx <- function(x) weighted.mean(Re(x), Im(x))
sam[, rollapply(complex(real = val_mean, imag = N), 3, wmean_cmplx,
fill = NA, align = "left")]
I have two sets of points stored in R as sf objects. Point object x contains 204,467 and point y contains 5,297 points.
In theory, I would want to calculate the distance from all points in x to all points in y. I understand that this would create a beast of a matrix, but it is doable using st_distance(x, y, by_element=FALSE) in the sf package in about 40 minutes on my i7 desktop.
What I want to do is to calculate the distance from all of the points in x to all of the points in y, then I want to convert this into a data.frame, that contains all variables for the respective x and y pair of points. This is because I want flexibility in terms of aggregation using dplyr, for instance, I want to find the number of points in y, that is within 10, 50, 100 km from x, and where x$year < y$year.
I successfully created the distance matrix, which has around 1,083,061,699 cells. I know this is a very inefficient way of doing this, but it gives flexibility in terms of aggregation. Other suggestions are welcome.
Below is code to create two sf point objects, and measure the distance between them. Next, I would want to convert this into a data.frame with all variables from x and y, but this is where I fail to proceed.
If my suggested workflow is unfeasible, can someone provide an alternative solution to measure distance to all points within a predefined radius, and create a data.frame of the result with all variables from x and y?
# Create two sf point objects
set.seed(123)
library(sf)
pts1 <- st_as_sf(x = data.frame(id=seq(1,204467,1),
year=sample(seq(from = 1990, to = 2018, by = 1), size = 204467, replace = TRUE),
xcoord=sample(seq(from = -180, to = 180, by = 1), size = 204467, replace = TRUE),
ycoord=sample(seq(from = -90, to = 90, by = 1), size = 204467, replace = TRUE)),
coords=c("xcoord","ycoord"),crs=4326)
pts2 <- st_as_sf(x = data.frame(id=seq(1,5297,1),
year=sample(seq(from = 1990, to = 2018, by = 1), size = 5297, replace = TRUE),
xcoord=sample(seq(from = -180, to = 180, by = 1), size = 5297, replace = TRUE),
ycoord=sample(seq(from = -90, to = 90, by = 1), size = 5297, replace = TRUE)),
coords=c("xcoord","ycoord"),crs=4326)
distmat <- st_distance(pts1,pts2,by_element = FALSE)
I would consider approaching this differently. Once you have your distmat matrix, you can do the types of calculation you describe without needing a data.frame. You can use standard subsetting to find which points meet your specified criteria.
For example, to find the combinations of points where pts1$year is greater than pts2$year we can do:
subset_points = outer(pts1$year, pts2$year, `>`)
Then, to find how many of these are separated more than 100 km, we can do
library(units)
sum(distmat[subset_points] > (100 * as_units('km', 1)))
A note on memory usage
However you approach this with sf or data.frame objects, the chances are that you will start to bump up against RAM limits with 1e9 floating points in each matrix or column of a data.table. You might think about instead converting your distance matrix to a raster. Then the raster can be stored on disk rather than in memory, and you can utilise the memory-safe functions in the raster package to crunch your way through.
How we might use rasters to work from disk and save RAM
We can use memory-safe raster operations for the very large matrices like this, for example:
library(raster)
# convert our matrices to rasters, so we can work on them from disk
r = raster(matrix(as.numeric(distmat), length(pts1$id), length(pts2$id)))
s = raster(subset_points)
remove('distmat', 'subset_points')
# now create a raster equal to r, but with zeroes in the cells we wish to exclude from calculation
rs = overlay(r,s,fun=function(x,y){x*y}, filename='out1.tif')
# find which cells have value greater than x (1e6 in the example)
Big_cells = reclassify(rs, matrix(c(-Inf, 1e6, 0, 1e6, Inf, 1), ncol=3, byrow=TRUE), 'out.tiff', overwrite=T)
# and finally count the cells
N = cellStats(Big_cells, sum)
I'm trying to write a function that loops over rows of a dataframe and uses information about other rows to determine the output for each loop.
Consider the following dataframe, which is meant to represent people who have a longitude coordinate, a latitude coordinate, and a value to represent if they are or are not sick:
game.mat<-as.data.frame(matrix(0, nrow = 100, ncol = 3))
colnames(game.mat)<-c("PosX","PosY","Sick")
game.mat[,"PosX"]<-sample(x = c(1:100), 100, replace = TRUE)
game.mat[,"PosY"]<-sample(x = c(1:100), 100, replace = TRUE)
game.mat[,"Sick"]<-sample((c(rep(0,8),rep(1,2))),100,replace=TRUE)
Some minority of people will be sick at baseline. My function is meant to infect people who have neighboring x-y coordinates with a sick person (so anyone who is adjacent to someone who is sick). I considered embedding a function like this in an ifelse statement:
search_sick<-function(d,corx,cory){
d2<-d[d$PosX<corx+2&d$PosX>corx-2&d$PosY<cory+2&d$PosY>cory-2,]
if(sum(d2$Sick>0)){
d$Sick<-1
} else{
d$Sick<-0
}
}
But it makes everyone sick, perhaps because it gives everyone a value of 1 if anyone is next to a sick person. I also considered using an apply function. But from what I understand about apply, it will only operate within the a single row at a time so it will be impossible to retrieve information about whether other rows have neighboring coordinate values.
I hope this makes sense. Happy to provide any additional information.
Here's an example using apply
set.seed(1)
game.mat<-as.data.frame(matrix(0, nrow = 100, ncol = 3))
colnames(game.mat)<-c("PosX","PosY","Sick")
game.mat[,"PosX"]<-sample(x = c(1:100), 100, replace = TRUE)
game.mat[,"PosY"]<-sample(x = c(1:100), 100, replace = TRUE)
game.mat[,"Sick"]<-sample((c(rep(0,8),rep(1,2))),100,replace=TRUE)
#plot the sick individuals in red
plot(PosY~PosX, data=game.mat, col=as.factor(Sick), pch=16)
We'll modify your function to have a flexible search radius "r", and to return the indices of the newly infected individuals
search_sick<-function(d, corx, cory, r){
indx<-which(d$PosX<corx+r & d$PosX>corx-r & d$PosY<cory+r & d$PosY>cory-r)
}
contagious<-game.mat[game.mat$Sick==1,]
infected<-apply(contagious, 1, function(x) {
search_sick(game.mat, x[1], x[2], r=10)
})
game.mat$T1<-game.mat$Sick
game.mat$T1[unique(unlist(infected))]<-1
#circle points which have become sick
points(PosY~PosX, data=game.mat[game.mat$Sick==0 & game.mat$T1==1,], col="red", cex=2)
I have a standard graph with 3 node attributes: "a", "b", and "c". I have code that causes the values of "a" and "b" to change constantly and "c" is dependent on these values. To accommodate the changing values I have the following code running in a for loop.
V(g)$c[V(g)$a <= V(g)$b] <- sample(c(0, 1), vcount(g), replace = TRUE, prob = c(.9, .1))
However it returns the warning:
number of items to replace is not a multiple of replacement length. and although the code runs, it doesn't take into account the weights for the values. How would I go about fixing this code?
The problem is that your sample statement generates vcount(g) values - one for every node in your graph. But you are trying to store these values into V(g)$c[V(g)$a <= V(g)$b]. Presumably sometimes not every node has V(g)$a <= V(g)$b so there are fewer spots to store the data. The simple way to fix this is to generate only the right number of values for the attribute c. One way to do that would be
V(g)$c[V(g)$a <= V(g)$b] <-
sample(c(0, 1), sum(V(g)$a <= V(g)$b), replace = TRUE, prob = c(.9, .1))
This is just your original statement except that I have replaced vcount(g) with sum(V(g)$a <= V(g)$b) which counts the number of nodes for which V(g)$a <= V(g)$b .
For example I have a vector: a = my_function(1000)!
head(a,15)
[1] 0.4011032 0.4867019 0.9831197 1.1138037 3.2740297 3.7853916 4.6833426 6.9224802 7.5878639
[10] 8.0706788 8.4404792 9.4149317 9.4176043 10.2345215 11.1884374
I want to use cut function(or some alternative) to divide this vector into intervals. BUT I want, that maximum size of each interval will be, for example, 5.
EDITED:
breaks: breaks <- seq(from = 1, by = 4,length.out = 100)
So the first interval is: (1,5] . And first seven variables of a vector falls into this interval. But I want, that size of each intervall to be 5. It means that first 5 variables
[1] 0.4011032 0.4867019 0.9831197 1.1138037 3.2740297
lies in first interval. And variables 3.7853916 4.6833426 lies in second interval(with length equall 5).
How can I do that?
Is this what you are looking for:
a <- rnorm(100)
a <- sort(a)
b <- matrix(data = a, nrow = 10, ncol = 10, dimnames = list(1:10))
You can create a new variable which defines the group of belongness, just sorting the values and labeling them with a number (each one repeated 5 times).
cbind(sort(rnorm(100)), rep(1:20,each=5))
Note thate in rep, instead of 1:20 you should put n/5 being n the number of elements.
If you need to define the intervals, you need only to define theme using the median between the highest value of one set and the minimum one of the following.