I'm trying to optimise the layout of a network I'm constructing with the following code:
gr <- read.table("data.txt", header = F, stringsAsFactors = F)
node.names <- gr[,1]
node.names <- toupper(substr(node.names, 2, nchar(node.names)))
gr <- gr[,-1]
edge.table.index <- which(gr>0.5, arr.ind=T)
d <- data.frame(first = node.names[edge.table.index[,1]], second = node.names[edge.table.index[,2]])
g <- graph.data.frame(d, directed=F)
g[from=V(g), to=V(g)] <- 0
layout.g <- layout.fruchterman.reingold(g)
plot(g, layout = layout.g, vertex.size = 5, vertex.label.cex=.7, vertex.color = "lightblue", vertex.label.family = "sans", edge.color="black", vertex.frame.color= "white")
In particular, what I'm trying to do is decrease the area on which the nodes are displayed such that the connected components are closer together. Previous versions of igraph had the option 'area' in the layout.fruchterman.reingold() function but this doesn't seem to be the case anymore. I've tried playing with various options like vertex size, vertex font size and width/height of the exported pdf file but they don't really do the trick.
Does anyone have a suggestion? Here's a link to the data file, I hope it works:
data.txt
Related
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.
This question is very close to what has been asked here. The answer is great if we want to generate random marks to an already existing point pattern - we draw from a multivariate normal distribution and associate with each point.
However, I need to generate marks that follows the marks given in the lansing dataset that comes with spatstat for my own point pattern. In other words, I have a point pattern without marks and I want to simulate marks with a definite pattern (for example, to illustrate the concept of segregation for my own data). How do I make such marks? I understand the number of points could be different between lansing and my data set but I am allowed to reduce the window or create more points. Thanks!
Here is another version of segregation in four different rectangular
regions.
library(spatstat)
p <- c(.6,.2,.1,.1)
prob <- rbind(p,
p[c(4,1:3)],
p[c(3:4,1:2)],
p[c(2:4,1)])
X <- unmark(spruces)
labels <- factor(LETTERS[1:4])
subwins <- quadrats(X, 2, 2)
Xsplit <- split(X, subwins)
rslt <- NULL
for(i in seq_along(Xsplit)){
Y <- Xsplit[[i]]
marks(Y) <- sample(labels, size = npoints(Y),
replace = TRUE, prob = prob[i,])
rslt <- superimpose(rslt, Y)
}
plot(rslt, main = "", cols = 1:4)
plot(subwins, add = TRUE)
Segregation refers to the fact that one species predominates in a
specific part of the observation window. An extreme example would be to
segregate completely based on e.g. the x-coordinate. This would generate strips
of points of different types:
library(spatstat)
X <- lansing
Y <- cut(X, X$x, breaks = 6, labels = LETTERS[1:6])
plot(Y, cols = 1:6)
Without knowing more details about the desired type of segregation it is
hard to suggest something more useful.
Suppose I have a button and a square, like this:
main = mainWidget $ do
x <- button "Change color."
y <- toggle False x
z <- mapDyn style y
elDynAttr "div" z blank
style :: Bool -> Map String String
style b | b = "style" =: "height: 10ex; width: 10ex; background-color: #f00;"
| otherwise = "style" =: "height: 10ex; width: 10ex; background-color: #900;"
The colour of the square will alternate between bright and dark red when the button is pressed.
I want to replace the button with a green rectangle in such a way that, when mouse pointer is over it, the red square is bright, otherwise dark. For bonus points, I would like the green rectangle to be a div tabindex=0 and to make sure the red square is bright when it has focus, but, once I understand the general approach, I will likely be able to figure that out by myself.
My guess is that there is some API that allows adding event handlers to el, but I did not find one so far. And maybe there is a different approch altogether, that I could not know?
The stuff you need is all found in Reflex.Dom.Widget.Basic. If you create a widget with a function that has a prime in its name, such as el', you can get a hold of an object of type El, which is a member of HasDomEvent. domEvent, the only method of this class, lets you extract an event stream corresponding to one of a selection of event names. Mixing the events together and converting them to an appropriate Dynamic is then done with some usual Reflex tooling found in Reflex.Class and Reflex.Dynamic. You do need to familiarize yourself with these interfaces, but there is a helpful quick reference.
(Make sure to use the documentation matching the version of Reflex you build against, as there are significant changes between versions.)
One way to encode your case is as follows:
main = mainWidget $ do
y <- greenBox
z <- mapDyn style y
elDynAttr "div" z blank
style :: Bool -> Map String String
style ... -- Abridged for brevity.
greenBox :: MonadWidget t m => m (Dynamic t Bool)
greenBox = do
(e, _) <- elAttr' "div" ("style" =: "height: 10ex; width: 10ex; background-color: #0c0;") blank
let
eEnter = domEvent Mouseenter e
eLeave = domEvent Mouseleave e
holdDyn False . leftmost $ [True <$ eEnter, False <$ eLeave]
What we do here is create a widget for the green box that returns a Dynamic indicating whether it is "activated". Everything else is just as it were in your initial example.
Thanks to /u/dalaing for advising me on this.
For my diagramming tool, I'd like to keep the code of the core model isolated from the GUI.
In the following example, the "state " is passed around with vDiag, which is a Tvar. This is a design decision in wx. Now, For my diagramming tool, I 'd like the core model to be "stored" in a fgl Graph, (with complex types in it), and wx will be given only a view on it; say in this example, a list of points for read access when painting, and some functions to write when clicking, dragging, etc.. . I thought first to some Monad stack, but even combining a StateT and the IO from wx does not look trivial , because the io actions are spread all over in the code of the callback (on click , on paint…etc ). It feels like having IO at the bottom of the stack does not fit well anymore.
so how to you pass a STate around, or is it not the way to go ? ( I intuition this is a classic. is this how RFP started ? )
(In the code, which paints red circle when there is a click , the list of points are passed around in a Tvar vDiag. I have tagged "--fgl" where equivalent state accessor would go. and set up a basic fgl test graph accessors to illustrate . I would like to put in a State)
(I originally tried to give it a go without FRP - reactive banana, to understand the problem, but I think I may have already hit it ;-)
module Main where
import Graphics.UI.WX hiding (empty)
import Data.Graph.Inductive
main
= start ballsFrame
ballsFrame
= do
vDiag <- varCreate []
--gDiag <- initg -- fgl
frame <- frame [text := "Demo"]
p <- panel frame []
file <- menuPane [text := "&File"]
quit <- menuQuit file [on command := close frame]
set frame [text:= "testing", menuBar := [file] ]
set p [on click := drawBins vDiag p , on paint := paintDiag vDiag ]
-- fgl pass the var around
return ()
where
drawBins d ppanel pt =
do varUpdate d (pt:)
-- addpoint f g -- fgl : insert a point
repaint ppanel
-- paint the balls
paintDiag vdiag dc view
= do balls <- varGet vdiag -- getPointsFromGraph
-- fgl : change to get the list of points
set dc [brushColor := red, brushKind := BrushSolid]
mapM_ (drawDiag dc) balls
drawDiag dc pt
= circle dc pt 10 []
-- basic fgl test graph accessors I would like to put in a State and replace vDiag
initg:: Gr Point String
initg = mkGraph [(1,pt 10 10),(2,pt 30 30)] [(1,2,"truc"), (2,1,"revtruc")]
getPointsFromGraph :: Graph gr => gr b b1 -> [b]
getPointsFromGraph g = map snd $ labNodes g
-- getPointsFromGraph initg = [Point {pointX = 10, pointY = 10},Point {pointX = 30, pointY = 30}]
addpoint :: DynGraph gr => a -> gr a b -> gr a b
addpoint p g = -- add a point p into graph p
insNode (4,p) g
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.