R Crowd simulation with individual behavior - r

When i execute a crowd simulation, all dots start going to the suggested metting point (reffer to the code). However the dots (people leaving the room) start to step over the other dots, something that shouldnt be happening according to my excersice.
Here is the code:
dimensionX=10
dimensionY=10
numberPeople=20
velocity=0.001
varianzavelocidad=runif(1, min=0, max=5)
x<-dimensionX*runif(numberPeople)
y<-dimensionY*runif(numberPeople)
plot(x,y,xlim=c(0,dimensionX),ylim=c(0,dimensionY))
for(i in 1:10000) {
for(j in 1:numberPeople) {
ang <- atan((y[j]-5)/(10-x[j]))
x[j]<-x[j]+velocity*varianzavelocidad*cos(ang)
y[j]<-y[j]-velocity*varianzavelocidad*sin(ang)
}
x[x>10]=10
plot(x,y,xlim=c(0,dimensionX),ylim=c(0,dimensionY))
}
My thoughts were that i should be working with an If()/Else() condition inside the J array, however am not sure how to read each J object and set a condition that if the dot/point tries to step over another dot/point it would compare a strength value between the dots trying to step over.
A clue of how i would like to make it work:
dimensionX=10
dimensionY=10
numberPeople=20
velocity=0.001
strength=runit(1) *******
varianzavelocidad=runif(1, min=0, max=5)
x<-dimensionX*runif(numberPeople)
y<-dimensionY*runif(numberPeople)
plot(x,y,xlim=c(0,dimensionX),ylim=c(0,dimensionY))
for(i in 1:10000) {
for(j in 1:numberPeople) {
ang <- atan((y[j]-5)/(10-x[j]))
x[j]<-x[j]+velocity*varianzavelocidad*cos(ang)
y[j]<-y[j]-velocity*varianzavelocidad*sin(ang)
}
if(X[j1] = X[J2] && Y[J1] = Y[J2]) {
//MAKE THE DOTS CHOOSE BETWEEN THE STRONGEST //using strength value
} else() { they keep on going }
x[x>10]=10
plot(x,y,xlim=c(0,dimensionX),ylim=c(0,dimensionY))
}
I have tried downloading foreach function but honestly havent been able to find a way to use it correctly. Any thoughts?

Related

Set default answer tu `menu` after a given amount of time

In R, is it possible to create a function that sets a default answer after some defined amount of time for menu (or to create something that works like that)?
My best not-working idea is to try using {future}.
Example
library(future)
plan(multisession(workers = 2))
zero_after_s <- function(s) Sys.sleep(s)
zero_after_t_menu <- function(
choices, graphics = FALSE, title = NULL, t = 0
) {
if (t == 0) {
menu(choices, graphics, title)
} else {
time_passed <- future(zero_after_s(t))
while (!resolved(time_passed)) {
return(menu(choices, graphics, title))
}
0
}
}
switch(
zero_after_t_menu(c("List letters", "List LETTERS"), t = 5) + 1,
cat("Nothing done (maybe t seconds passed without answers)\n"),
letters,
LETTERS
)
This cannon work because while will cycle and check its argument only when its body finishes the cycle, i.e., the user has answered to menu. I put this just as a tentative idea of a solution.
I try to call menu from the future (it seems more promising), but I cannot interact with it anymore (obviously), and anyway, it throws an error because menu cannot be used non-interactively :-)
zero_after_t_menu <- function(
choices, graphics = FALSE, title = NULL, t = 0
) {
if (t == 0) {
menu(choices, graphics, title)
} else {
res %<-% future(menu(choices, graphics, title), earlySignal = TRUE)
Sys.sleep(t)
if (resolved(res)) res else 0
}
}
Any ideas or suggestions?
Thank you,
Corrado.
PS: my actual use case is a loop across some (many) files to be (slowly) preprocessed. Under some conditions, I would like to have the opportunity to select what to do. Still, given that it is a very long execution, during nights or not-monitoring time, I would like a safe default selection (e.g., "skip that iteration for the future") to be made automatically to permit the loop to go on without my supervision.

R loop for fuction until special value is reached [duplicate]

Can you confirm if the next break cancels the inner for loop?
for (out in 1:n_old){
id_velho <- old_table_df$id[out]
for (in in 1:n)
{
id_novo <- new_table_df$ID[in]
if(id_velho==id_novo)
{
break
}else
if(in == n)
{
sold_df <- rbind(sold_df,old_table_df[out,])
}
}
}
Well, your code is not reproducible so we will never know for sure, but this is what help('break')says:
break breaks out of a for, while or
repeat loop; control is transferred to
the first statement outside the
inner-most loop.
So yes, break only breaks the current loop. You can also see it in action with e.g.:
for (i in 1:10)
{
for (j in 1:10)
{
for (k in 1:10)
{
cat(i," ",j," ",k,"\n")
if (k ==5) break
}
}
}
your break statement should break out of the for (in in 1:n).
Personally I am always wary with break statements and double check it by printing to the console to double check that I am in fact breaking out of the right loop. So before you test add the following statement, which will let you know if you break before it reaches the end. However, I have no idea how you are handling the variable n so I don't know if it would be helpful to you. Make a n some test value where you know before hand if it is supposed to break out or not before reaching n.
for (in in 1:n)
{
if (in == n) #add this statement
{
"sorry but the loop did not break"
}
id_novo <- new_table_df$ID[in]
if(id_velho==id_novo)
{
break
}
else if(in == n)
{
sold_df <- rbind(sold_df,old_table_df[out,])
}
}

Avoid loop in moving window in R

I have an example R script for spectrum calculation. I divide the signal into several blocks and do the calculation for each block.
spect=function(x,samplingfrequency=1,blocksize=2^12)
{
T=length(x)
blocks=trunc(T/blocksize)
localfreq=c() ; localspec=c()
for(i in 1:blocks){localfreq[[i]]=c() ; localspec[[i]]=c() }
for(i in 1:blocks)
{
time=c( (1+(i-1)*blocksize) : (i*blocksize) )
localspectrum=spectrum(x[time],plot=FALSE)
localfreq[[i]]=localspectrum$freq
localspec[[i]]=localspectrum$spec
}
averagespec=rep(0,(blocksize/2))
for(freq in 1:(blocksize/2))
{
for(block in 1:blocks)
{
averagespec[freq]=(averagespec[freq]+localspec[[block]][freq])
}
averagespec[freq]=averagespec[freq]/blocks
}
par(mar=c(5.1,5.1,2.5,1.5))
plot(c(1:(blocksize/2))/(blocksize/2)*samplingfrequency/2,averagespec,log="xy",t="l",xlab="frequency [Hz]",ylab="average spectrum [a.u.]",cex.lab=1.8,cex.axis=1.8)
abline(v=(samplingfrequency/2),col=2)
abline(v=(1/blocksize*samplingfrequency),col=4)
}
here x is your time series input. I don't use the spectrum function from R directly since the result is too noisy. I was wonder if I could somehow avoid those forloops in my script?

How to suitably avoid RangeErrors when "looking around" this 2D array?

I have a 2D array structure to represent a grid of tiles that is a part of the game I am making. One aspect of the game is that the grid is filled in in a somewhat random fashion, based on analysis of a text file. Right from the outset though, I already realised that just leaving it be pretty much randomly done like this without sticking in some kind of validity checks or prevention mechanism, to stop really badly configured grid from forming, would not work out. The main problem I want to avoid is too many tiles that would be untraversable being close together, potentially severing chunks of the grid from the rest.
The idea I came up with to try avoid some really bad grids is to check when assigning a tile value to each "grid square" during generation with logic like this
if (tileBeingInserted.isTraversable()) {
//all is well
return true;
} else {
//we may have a problem, are there too many untraversables nearby?
//Proceed to check all squares "around" the current one.
}
To be clear, checking around the current square means checking the square immediately adjacent in each of the 8 cardinal directions. Now, my problem is that I am trying to reason out how to code this so that it will certainly not give a RangeErrorat any point or at least catch it and recover if it must. As an example, you could clearly take one of the corner squares to be the worst scenario in the sense that only 2 of the squares the algorithm would want to check are within the array's bounds. Naturally, if a RangeErrorhappens for this reason I just want the program to progress onward without issue so the structure
try {
//check1
//check2...8
} catch (RangeError e) {
}
is unacceptable because as soon as a single out of range square is tested the code falls out of the check block. An alternative I thought of, but do not like because of its messiness, would be to individually wrap each check in a try-catch and yes that would work I guess but that's some horrid looking code...so can anyone help me out here? Is there perhaps a different angle from which to come at this problem of avoiding the RangeErrors that I am not seeing?
So my code for testing whether another untraversable tile should be placed has shaped up like this:
bool _tileFitsWell(int tileTypeInt, int row, int col)
{
//...initialise some things, set stuff up
...
if (tile.traversable == true) {
//In this case a new traversable tile is being put in, so no problems.
return true;
} else {
//begin testing what tiles are around the current tile
//Test NW adjacent
if (row > 0 && col > 0) {
temp = tileAt(row - 1, col - 1);
if (!temp.traversable) {
strikeCount++;
}
}
//Test N adjacent
if (row > 0) {
temp = tileAt(row - 1, col - 1);
if (!temp.traversable) {
strikeCount++;
}
}
//Test NE adjacent
if (row > 0 && col < _grid[0].length - 2) {
temp = tileAt(row - 1, col 1);
if (!temp.traversable) {
strikeCount++;
}
}
//Test W adjacent
if (col > 0) {
temp = tileAt(row, col - 1);
if (!temp.traversable) {
strikeCount++;
}
}
}
return strikeCount < 2;
}
The code inside each "initial" if-statement (the ones that check row and col) is a bit pseudocode-ish for simplicity's sake. As I explained in a previous comment, the reason why I don't need to check tiles in the other 4 cardinal directions is since these checks are done while filling the map, tiles in those positions will always be either uninitialised or just out of bounds, depending on what tile the function is called to check at a given time.

R: Break for loop

Can you confirm if the next break cancels the inner for loop?
for (out in 1:n_old){
id_velho <- old_table_df$id[out]
for (in in 1:n)
{
id_novo <- new_table_df$ID[in]
if(id_velho==id_novo)
{
break
}else
if(in == n)
{
sold_df <- rbind(sold_df,old_table_df[out,])
}
}
}
Well, your code is not reproducible so we will never know for sure, but this is what help('break')says:
break breaks out of a for, while or
repeat loop; control is transferred to
the first statement outside the
inner-most loop.
So yes, break only breaks the current loop. You can also see it in action with e.g.:
for (i in 1:10)
{
for (j in 1:10)
{
for (k in 1:10)
{
cat(i," ",j," ",k,"\n")
if (k ==5) break
}
}
}
your break statement should break out of the for (in in 1:n).
Personally I am always wary with break statements and double check it by printing to the console to double check that I am in fact breaking out of the right loop. So before you test add the following statement, which will let you know if you break before it reaches the end. However, I have no idea how you are handling the variable n so I don't know if it would be helpful to you. Make a n some test value where you know before hand if it is supposed to break out or not before reaching n.
for (in in 1:n)
{
if (in == n) #add this statement
{
"sorry but the loop did not break"
}
id_novo <- new_table_df$ID[in]
if(id_velho==id_novo)
{
break
}
else if(in == n)
{
sold_df <- rbind(sold_df,old_table_df[out,])
}
}

Resources