In drc() package, drm fct = L.4 finds wrong intercept parameters, even though the graph is right - drm

I have a problem with the following code.
It calculates the drc curve correctly, but the ec50 wrongly, although the are closely related...
x <- c(-1, -0.114074, 0.187521, 0.363612, 0.488551, 0.585461, 0.664642, 0.730782, 0.788875, 0.840106, 0.885926, 0.92737, 0.965202, 1)
y <- c(100, 3.978395643, 0.851717911, 0.697307565, 0.512455497, 0.512455497, 0.482273052, 0.479293487, 0.361024717, 0.355324864, 0.303120838, 0.286539832, 0.465692047, 0.358045152)
mat <- cbind(x, y)
df <- as.data.frame(mat)
calc <- drm(
formula = y ~ x,
data = df,
fct = L.4(names = c("hill", "min_value", "max_value", "ec50"))
)
plot <- ggplot(df, aes(x=x, y=y), color="black") +
geom_point() +
labs(x = "x", y = "y") +
theme(
axis.title.x = element_text(color="black", size=10),
axis.title.y = element_text(color="black", size=10),
axis.line.x = element_line(color = "black"),
axis.line.y = element_line(color = "black")
) +
stat_smooth(
formula = y ~ x,
method = "drm", color="black",
method.args = list(fct = L.4(names = c("hill", "min_value", "max_value", "ec50"))),
se = FALSE
) +
theme(panel.background=element_rect(fill="white"))+
ylim(0, NA)
ec50 <- ED(calc,50)
print(ec50)
print(calc)
print(plot)
This is the graph I obtain:
But if I print the parameters of the function L.4, I have the following result:
hill:(Intercept) 6.3181
min_value:(Intercept) 0.3943
max_value:(Intercept) 111.0511
ec50:(Intercept) -0.6520
max_value:(Intercept) is obviously wrong (it has to be 100), and, as a consequence, ec50 is wrong too.
I would also add that for other sets of data, the min_value:(Intercept) is wrong too (with values < 0...)
I cannot find the mistake, because the graph derived from the same function L.4 shows the right values.
Thank you very much for your help!

The upper asymptote in your case assumes a symmetrical curve (due to 4PL fitting). Meaning that both bottom and upper asymptote have the same inflection.
Your data might max out at 100 but the formula calculates the upper asymptote further than 100 (111) because that's where the actual asymptote lies, not the end of your data.
So the graph is based on your data, but the estimated parameters forces a symmetrical curve to fit it, and your asymptote increases. This will also shift the EC50.

Related

Delete meshgrid points between a bounding box points

I am looking for an efficient way to delete points of a meshgrid that comes inside the bounding box of blocks (block 1 and 2 in the code). My Code is:
x_max, x_min, y_max, y_min = 156.0, 141.0, 96.0, 80.0
offset = 5
stepSize = 0.2
x = np.arange(x_min-offset, x_max+offset, stepSize)
y = np.arange(y_min-offset, y_max+offset, stepSize)
xv, yv = np.meshgrid(x, y)
#bounding box (and pints inside) that I want to remove for mesh
block1 = [(139.78, 86.4), (142.6, 86.4), (142.6, 88.0), (139.78, 88.0)]
block2 = [(154.8, 87.2), (157.6, 87.2), (157.6, 88.8), (154.8, 88.8)]
As per one of the answer, I could generate the required result if I have only one block to be removed from the mesh. If I have multiple blocks then it won't work. What could be the optimized way to remove multiple blocks from mesh grid. The final figure should look like this:
Mesh
Edit: Improved questions and edited code.
Simply redefine your x and y around your block:
block_xmin = np.min(block[:,0])
block_xmax = np.max(block[:,0])
block_ymin = np.min(block[:,1])
block_ymax = np.max(block[:,1])
X = np.hstack((np.arange(x_min-offset, block_xmin, stepSize), np.arange(block_xmax, x_max+offset, stepSize)))
Y = np.hstack((np.arange(y_min-offset, block_ymin, stepSize), np.arange(block_ymax, y_max+offset, stepSize)))
XV, YV = np.meshgrid(X, Y)
I think I figured it out based on the explanation of #hpaulj (I cannot up-vote his suggestions as well probably due to low points). I can append blocks in allBlocks array and then run a loop over allBlocks an simultaneous disabling the points in mesh. Here is my solution:
x_new = np.copy(xv)
y_new = np.copy(yv)
ori_x = xv[0][0]
ori_y = yv[0][0]
for block in allBlocks:
block_xmin = np.min((block[0][0], block[1][0]))
block_xmax = np.max((block[0][0], block[1][0]))
block_ymin = np.min((block[0][1], block[1][1]))
block_ymax = np.max((block[0][1], block[3][1]))
rx_min, rx_max = int((block_xmin-ori_x)/stepSize), int((block_xmax-ori_x)/stepSize)
ry_min, ry_max = int((block_ymin-ori_y)/stepSize), int((block_ymax-ori_y)/stepSize)
for i in range(rx_min,rx_max+1):
for j in range(ry_min,ry_max+1):
x_new[j][i] = np.nan
for i in range(ry_min,ry_max+1):
for j in range(rx_min,rx_max+1):
y_new[i][j] = np.nan

setting point sizes when using Gadfly in Julia

In my attempts to practice Julia, I've made a program which draws a bifurcation diagram. My code is as follows:
function bifur(x0,y0,a=1.3,b=0.4,n=1000,m=10000)
i,x,y=1,x0,y0
while i < n && abs(x) < m
x,y = a - x^2 + y, b * x
i += 1
end
if abs(x) < m
return x
else
return 1000
end
end
la = Float64[];
lx = Float64[];
for a=0:400
for j = 1:1000
x0 = rand()
y0 = rand()
x = bifur(x0,y0,a/100)
if x != 1000
push!(la,a/100)
push!(lx,x)
end
end
end
using Gadfly
myplot = Gadfly.plot( x=la, y=lx , Scale.x_discrete, Scale.y_continuous, Geom.point)
draw(PNG("myplot.png",10inch,8inch),myplot)
The output I get is this image:
In order to make my plot look more like this:
I need to be able to set point sizes to as small as one pixel. Then by increasing the iteration length I should be able to get a better bifurcation diagram. Does anyone know how to set the point sizes in Gadfly diagrams in Julia?
[Just to encapsulate the comments as an answer...]
Gadfly's Theme defaults can be changed. In particular, point_size is probably what you are looking for.
For changing the automatic plot scale/range settings, have a look at Gadfly's Scale params.

How to find variability of a set of Cartesian Points (xyz) or fitting/distance to 3D line and/or plane?

So I was looking at this question:
Matlab - Standard Deviation of Cartesian Points
Which basically answers my question, except the problem is I have xyz, not xy. So I don't think Ax=b would work in this case.
I have, say, 10 Cartesian points, and I want to be able to find the standard deviation of these points. Now, I don't want standard deviation of each X, Y and Z (as a result of 3 sets) but I just want to get one number.
This can be done using MATLAB or excel.
To better understand what I'm doing, I have this desired point (1,2,3) and I recorded (1.1,2.1,2.9), (1.2,1.9,3.1) and so on. I wanted to be able to find the variability of all the recorded points.
I'm open for any other suggestions.
If you do the same thing as in the other answer you linked, it should work.
x_vals = xyz(:,1);
y_vals = xyz(:,2);
z_vals = xyz(:,3);
then make A with 3 columns,
A = [x_vals y_vals ones(size(x_vals))];
and
b = z_vals;
Then
sol=A\b;
m = sol(1);
n = sol(2);
c = sol(3);
and then
errs = (m*x_vals + n*y_vals + c) - z_vals;
After that you can use errs just as in the linked question.
Randomly clustered data
If your data is not expected to be near a line or a plane, just compute the distance of each point to the centroid:
xyz_bar = mean(xyz);
M = bsxfun(#minus,xyz,xyz_bar);
d = sqrt(sum(M.^2,2)); % distances to centroid
Then you can compute variability anyway you like. For example, standard deviation and RMS error:
std(d)
sqrt(mean(d.^2))
Data about a 3D line
If the data points are expected to be roughly along the path of a line, with some deviation from it, you might look at the distance to a best fit line. First, fit a 3D line to your points. One way is using the following parametric form of a 3D line:
x = a*t + x0
y = b*t + y0
z = c*t + z0
Generate some test data, with noise:
abc = [2 3 1]; xyz0 = [6 12 3];
t = 0:0.1:10;
xyz = bsxfun(#plus,bsxfun(#times,abc,t.'),xyz0) + 0.5*randn(numel(t),3)
plot3(xyz(:,1),xyz(:,2),xyz(:,3),'*') % to visualize
Estimate the 3D line parameters:
xyz_bar = mean(xyz) % centroid is on the line
M = bsxfun(#minus,xyz,xyz_bar); % remove mean
[~,S,V] = svd(M,0)
abc_est = V(:,1).'
abc/norm(abc) % compare actual slope coefficients
Distance from points to a 3D line:
pointCentroidSeg = bsxfun(#minus,xyz_bar,xyz);
pointCross = cross(pointCentroidSeg, repmat(abc_est,size(xyz,1),1));
errs = sqrt(sum(pointCross.^2,2))
Now you have the distance from each point to the fit line ("error" of each point). You can compute the mean, RMS, standard deviation, etc.:
>> std(errs)
ans =
0.3232
>> sqrt(mean(errs.^2))
ans =
0.7017
Data about a 3D plane
See David's answer.

How to project night sky into camera?

I want to write something like a virtual telescope that looks into the night sky.
Till now I've a star catalog and I want to project them into a plane to get a mock picture.
I speculate the projection to be a gnomonic projection, which can be found here and here.
In the second link, an alg on calculating the pixel position of stars.
Forward:
Define
scale: number of pixels per degree in the map
alpha, delta: Equatorial coordinates of a given position
alpha0, delta0: Equatorial coordinates of the map center
A = cos(delta) x cos(alpha - alpha0)
F = scale x (180/pi)/[sin(delta0) x sin(delta) + A x cos(delta0)]
then the pixel coordinates in the image are
LINE = -F x [cos(delta0) x sin(delta) - A x sin(delta0)]
SAMPLE = -F x cos(delta) x sin(alpha - alpha0)
Reverse:
Define
X = SAMPLE/(scale x 180/pi)
Y = LINE/(scale x 180/pi)
D = arctan[(X^2 + Y^2)^0.5]
B = arctan(-X/Y)
XX = sin(delta0) x sin(D) x cos(B) + cos(delta0) x cos(D)
YY = sin(D) x sin(B)
then the right ascension and declination are
alpha = alpha0 + arctan(YY/XX)
delta = arcsin[sin(delta0) x cos(D) - cos(delta0) x sin(D) x cos(B)]
NOTE: The arctangent functions for B and alpha must be four-quadrant arctangents.
However I don't know whether the angles should be in deg or rad, and what's the meaning of SAMPLE and LINE.
And I'm neither sure about using gnomonic projection.
Any help or discussion is welcome.
Yeah, just perform an ordinary camera projecion.

Recreate ggplot's geom_smooth CI background - in R basic?

I wish to recreate this graph:
(from here)
Using R base graphics.
I have no clue how to do that. Any advice ?
(My motivation is that I wish to create a plot where the line width (and/or color) will reflect another dimension. Until now - ggplot2 is the only place I found in R for how to do this. I would be happy to be able to do this also in base R)
See help(polygon) and example(polygon) (esp the Brownian motion example) -- the varying width is pretty common in some fields to show variability through time.
The same example is also in demo(graphics):
## An example showing how to fill between curves.
par(bg="white")
n <- 100
x <- c(0,cumsum(rnorm(n)))
y <- c(0,cumsum(rnorm(n)))
xx <- c(0:n, n:0)
yy <- c(x, rev(y))
plot(xx, yy, type="n", xlab="Time", ylab="Distance")
polygon(xx, yy, col="gray")
title("Distance Between Brownian Motions")
I don't know if exactly replicating the graph is possible in base graphics. In grid graphics it is possible. Nevertheless, the following code gets you an example that's something like what you want. Adapt it to the data set.
n <- 20
x <- rnorm(n)
y <- rnorm(n)
o <- order(x)
x <- x[o]
y <- y[o]
m <- loess(y~x, span = 1) #ggplot seems to smooth more than default
f <- predict(m, se = TRUE)
ci <- f$se * qt(0.975, f$df)
cih <- f$fit + ci
cil <- f$fit - ci
plot(x,y, ylim = c(min(cil,y), max(cih,y)))
lines(x, f$fit, lwd = 2)
xx <- c(x, rev(x))
yy <- c(cil, rev(cih))
polygon(xx, yy, col="#A9A9A930", border = NA)
OK, I spent a little too much time messing with this... note the last line is the ggplot version so you can compare the two.
#loess and error curves almost just like ggplot2
op <- par(las=1, mar = c(3,3,1,1))
n <- 30
x <- sort(rnorm(n)) #(varying density in predictor)
x <- x + abs(min(x))
x <- x/max(x)*2*pi
y <- sin(x)+rnorm(n) #(curvy)
m <- loess(y~x)
xx <- seq(min(x), max(x), (max(x)-min(x))/1000) #increase density of values to predict over to increase quality of curve
f <- predict(m, xx, se = TRUE)
ci <- f$se * qt(0.975, f$df)
cih <- f$fit + ci
cil <- f$fit - ci
plot(x,y, ylim = c(min(cil,y), max(cih,y)), cex.axis = 0.85, xlab = '', ylab = '', type = 'n')
title(xlab = 'x', ylab = 'y',line = 2)
grid(col = 'gray')
points(x,y, pch = 19, cex = 0.65)
lines(xx, f$fit, col = 'blue', lwd = 1.2)
xx <- c(xx, rev(xx))
yy <- c(cil, rev(cih))
polygon(xx, yy, col=rgb(0.1,0.1,0.1,0.25), border = NA)
par(op)
#qplot(x,y, geom = 'point') + stat_smooth()
And to get the smooth curve, look at loess and predict.loess
Would geom_ribbon in GGPlot be what you need? This creates a variable-width line.

Resources