The following function draws the rectangle r1 as required, but an attempt to offsets it by 0.5 in native units fails. I have tried x=unit(1,"native"), etc. but this does not solve the trivial problem. Thank you for your help.
#rm(list=ls(all=TRUE))
library(grid)
vp__g = viewport(xscale=c(-1.5,5.5), yscale=c(-5.5,2.0))
pushViewport(vp__g)
test = function() {
r1 = rectGrob(x=0, y=0, width=2, height=1, default.units="native")
grid.draw(r1)
r1a = editGrob(r1, vp=viewport(x=0.5,y=0.5), name="r1a")
grid.draw(r1a)
}
test()
Related
I'm trying to draw car trips on a plane. I'm using Plotters library.
Here is some code example of trips' drawing procedure:
pub fn save_trips_as_a_pic<'a>(trips: &CarTrips, resolution: (u32, u32))
{
// Some initializing stuff
/// <...>
let root_area =
BitMapBackend::new("result.png", (resolution.0, resolution.1)).into_drawing_area();
root_area.fill(&WHITE).unwrap();
let root_area =
root_area.margin(10,10,10,10).titled("TITLE",
("sans-serif", 20).into_font()).unwrap();
let drawing_areas =
root_area.split_evenly((cells.1 as usize, cells.0 as usize));
for (index, trip) in trips.get_trips().iter().enumerate(){
let mut chart =
ChartBuilder::on(drawing_areas.get(index).unwrap())
.margin(5)
.set_all_label_area_size(50)
.build_ranged(50.0f32..54.0f32, 50.0f32..54.0f32).unwrap();
chart.configure_mesh().x_labels(20).y_labels(10)
.disable_mesh()
.x_label_formatter(&|v| format!("{:.1}", v))
.y_label_formatter(&|v| format!("{:.1}", v))
.draw().unwrap();
let coors = trip.get_points();
{
let draw_result =
chart.draw_series(series_from_coors(&coors, &BLACK)).unwrap();
draw_result.label(format!("TRIP {}",index + 1)).legend(
move |(x, y)|
PathElement::new(vec![(x, y), (x + 20, y)], &random_color));
}
{
// Here I put red dots to see exact nodes
chart.draw_series(points_series_from_trip(&coors, &RED));
}
chart.configure_series_labels().border_style(&BLACK).draw().unwrap();
}
}
What I got now on Rust Plotters:
So, after drawing it in the 'result.png' image file, I struggle to understand these "lines", because I don't see the map itself. I suppose, there is some way in this library to put a map "map.png" in the background of the plot. If I would use Python, this problem will be solved like this:
# here we got a map image;
img: Image.Image = Image.open("map-image.jpg")
img.putalpha(64)
imgplot = plt.imshow(img)
# let's pretend that we got our map size in pixels and coordinates
# just in right relation to each other.
scale = 1000
x_shift = 48.0
y_shift = 50.0
coor_a = Coordinate(49.1, 50.4)
coor_b = Coordinate(48.9, 51.0)
x_axis = [coor_a.x, coor_b.x]
x_axis = [(element-x_shift) * scale for element in x_axis]
y_axis = [coor_a.y, coor_b.y]
y_axis = [(element-y_shift) * scale for element in y_axis]
plt.plot(x_axis, y_axis, marker='o')
plt.show()
Desired result on Python
Well, that's easy on Python, but I got no idea, how to do similar thing on Rust.
My objective function considers ellipse arc lengths. Within the objective function, I use uniroot to find the semi-minor axis b for the semi-major a and arc angle provided by nsga.
I've written a constraint function to ensure that the limits provided to uniroot are of opposite sign.... but it's not working. The program crashes becasue f() values are not of opposite sign.
I've simplified the program to the example below... was hoping for help on getting this to work. Thank you.
library(RConics)
library(mco)
###############################################################
#FUNCTIONS
###############################################################
restricts<-function(invec,len){
lwr<-sign(get_b(1, as.numeric(invec[1]), len, as.numeric(invec[2])))
uppr<-sign(get_b(as.numeric(invec[1]), as.numeric(invec[1]), len, as.numeric(invec[2])))
restrictions <- logical(1)
restrictions[1] <- (lwr != uppr)
return (restrictions)
}
objective<-function(invec, len){
a<-as.numeric(invec[1])
theta=as.numeric(invec[2])
b_out<-uniroot(get_b,c(1,a),a=a,len=len,theta=theta)
b<-b_out$root
ps<- c(
a*cos(d2r(90+theta)),
b*sin(d2r(90+theta))
)
end<- atan(-b*cot(d2r(180+(90-theta)))/a) - pi/2+pi/2
rot <- 0.52-end
final<- RotMat(rot)%*%ps
return(abs(final[2]))
}
r2d<-function(theta) theta*180/pi
d2r<-function(theta) theta*pi/180
RotMat<-function(theta) rbind(c(cos(theta),-sin(theta)),c(sin(theta),cos(theta)))
get_b<-function(b,a,len,theta){
return(
len-arcLengthEllipse(
p1 = c(0,b),
p2 = c(a*cos(d2r(90+theta)), b*sin(d2r(90+theta))),
saxes = c(a,b),
n = 5)
)
}
###############################################################
#MAIN
###############################################################
mods<-nsga2(objective, idim=2, odim=1,
constraints = restricts,
cdim=1,
generations=10, popsize=100,
cprob=0.9, cdist=1,
mprob=0.2, mdist=20,
lower.bounds = c(130,1), #70.6, 86.6
upper.bounds = c(203,90),
len=204)
I have been working with the proxy package in R to implement a distance measure that weights Euclidean distance by the propagated errors of each individual point. The formula to do this is
sqrt((xi - xj)2) + (yi - yj)2) + ...(ni - nj)2) ÷ sqrt((σxi2 + σxj2) + (σyi2 + σyj2) + ...(σni2 + σnj2)).
I was able to get proxy to work for me in a basic sense (see proxy package in R, can't make it work) and replicated plain Euclidean distance functionality, hooray for the amateur.
However, once I started writing the function for the error-weighted distance, I immediately ran into a difficulty: I need to read in the errors as distinct from the points and have them processed distinctly.
I know that R has very strong functionality and I'm sure it can do this, but for the life of me, I don't know how. It looks like proxy's dist can handle two matrix inputs, but how would I tell it that matrix X is the points and matrix Y is the errors, and then have each go to its appropriate part of the function before being ultimately combined into the distance measure?
I had been hoping to use proxy directly, but I also realized that it looks like I can't. I believe I was able to come up with a function that works. First, the distance function:
DistErrAdj <- function(x,y) {
sing.err <- sqrt((x^2) + (y^2))
sum(sing.err)
}
Followed, of course, by
library(proxy)
pr_DB$set_entry(FUN=DistErrAdj,names="DistErrAdj")
Then, I took code already kindly written from augix (http://augix.com/wiki/Make%20trees%20in%20R,%20test%20its%20stability%20by%20bootstrapping.html) and altered it to suit my needs, to wit:
boot.errtree <- function(x, q, B = 1001, tree = "errave") {
library(ape)
library(protoclust)
library(cluster)
library(proxy)
func <- function(x,y) {
tr = agnes((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")), diss = TRUE, method = "average")
tr = as.phylo(as.hclust(tr))
return(tr)
}
if (tree == "errprot") {
func <- function(x,y) {
tr = protoclust((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")))
tr = as.phylo(tr)
return(tr)
}
}
if (tree == "errdiv") {
func <- function(x,y) {
tr = diana((dist(x, method = "euclidean")/dist(q, method = "DistErrAdj")), diss=TRUE)
tr = as.phylo(as.hclust(tr))
return(tr)
}
}
tr_real = func(x)
plot(tr_real)
bp <- boot.phylo(tr_real, x, FUN=func, B=B)
nodelabels(bp)
return(bp)
}
It seems to work.
I am writing a code to generate four stimulations and then generate graphs. My code works, but I want instead of generating four graphs I want to combine them all in one graph. How can I do that?
My code:
queueSimulation <- function(arriverate, servrate, endtime) {
queue = numeric(0)
arrivetimes = rexp(10000, arriverate)
servtimes = rexp(10000, servrate)
clock = 0.0
clist=c()
qlist=c()
while(clock <= endtime) {
if(length(queue) > 0 && queue[1] < arrivetimes[1]) {
clock = clock + queue[1]
queue = queue[-1]
}
else {
clock = clock + arrivetimes[1]
queue[length(queue) + 1] = servtimes[1]
arrivetimes = arrivetimes[-1]
servtimes = servtimes[-1]
}
#queue_size= length(round(clock, 2))
clist = c(clist , clock)
qlist = c(qlist , length(queue))
}
a<-data.frame(time=clist , qsize=qlist)
print(a)
mean1<-mean(qlist)
cat("Average :", mean1, "\n")
plot(a)
}
and calling the function:
queueSimulation(1.0, 5.0, 100)
queueSimulation(2.0, 4.0, 100)
queueSimulation(2.3, 3.5, 100)
queueSimulation(4.0, 5.0, 100)
There might be a better solution to this, but how about slightly changing your approach.
1- In your function, add two variables, one for color (cl) and one to tell your function if your plotting the main plot or just adding lines (pl). 1 for main and 0 for lines.
function(arriverate, servrate, endtime,cl,pl) {
2- call your plot with an if statement, and fix your y axis to range from 0 to 200.
if(pl==1){plot(a,col=cl,ylim=c(0,200),type="l")} else{lines(a,col=cl)}}
and then, call your function with theses two variables (cl and pl) :
queueSimulation(1.0, 5.0, 100,"red",1)
queueSimulation(2.0, 4.0, 100,"blue",0)
queueSimulation(2.3, 3.5, 100,"green",0)
queueSimulation(4.0, 5.0, 100,"black",0)
The problem I see with this is that your simulations can get values way over 200 for the y axis, maybe try to find a way to get max y values in one of your call.
Take a look at layout, specifically put layout(matrix(1:4,nrow=2)) (or a variant) before you call your plotting functions.
i would like to implement a function in R which is able to increase the size of a buffer in a for-loop.
The overall-plan is to write a package, which uses a test- and a reference-shapefile. It should create a buffer around the reference shapefile and increases the size as long as necessary, to intersect the whole test-shapefile.
Therefore, i already wrote some code snippets to insert the shapefiles and create the first buffer:
require("rgeos")
require("rgdal")
l1=readOGR(dsn="C:/Maps", layer="osm_ms1")
l2=readOGR(dsn="C:/Maps", layer="osm_ms2")
proj4string(l2) = CRS("+init=epsg:31467") ## DHDN / 3-degree Gauss-Kruger zone 3
l2buffer <- gBuffer(l2, width=0.001, capStyle="ROUND")
plot(l2buffer, col="black")
lines(l2, col="red")
lines(l1, col="blue")
Until now, every works fine.
After that, i wanted to transfer this method to a for-loop with a buffer for every step:
i = 0.001
buffergrow = function(shape) {
for (k in 1:10) {
linebuffer[k] <- gBuffer(l2, width=i, capStyle="ROUND")
plot(linebuffer[k])
i = i+0.001
}
}
> buffergrow(l2)
Error in linebuffer[k] <- gBuffer(shape, width = i, capStyle = "ROUND") :
Object 'linebuffer' not found
As you can see, an error occurs when i call the function 'buffergrow' with 'l2' as the argument (shape). Does anybody has an idea why this happens? I tried already some other ideas, but i need some help.
Optionally / Additionally: Do you have some hints for me, regarding the further work for my overall plan?
Best regards,
Stefan
You have to initialize an object before accessing its subelements.
E.g.:
foo <- double(10)
for (i in 1:10) {
foo[i] <- i;
}
# or
linebuffer <- list()
for (i in 1:10) {
linebuffer[[i]] <- i;
}
But you don't need an object linebuffer in your usecase.
Try the following instead:
buffergrow = function(shape) {
for (k in 1:10) {
plot(gBuffer(l2, width=i, capStyle="ROUND"))
i = i+0.001
}
}
EDIT:
If you need to store the gBuffer results:
buffergrow = function(shape) {
i <- 1
linebuffer <- vector("list", 10)
for (k in 1:10) {
linebuffer[[k]] <- gBuffer(l2, width=i, capStyle="ROUND")
plot(linebuffer[[k]])
i = i+0.001
}
return(linebuffer)
}