Plotting a Throw Trajectory in R - r

Here's the data
structure(list(ThrowSpeed = 73.01448, PopTime = 1.600322, ExchangeTime = 0.69207,
TimeToBase = 0.908252, CatchPositionX = -1.37782, CatchPositionY = 2.65907,
CatchPositionZ = 0.5019, ThrowPositionX = -4.6391, ThrowPositionY = 4.21092,
ThrowPositionZ = 3.75256, BasePositionX = 62.55366, BasePositionY = 3.48949,
BasePositionZ = 62.22463, ThrowTrajectoryXc0 = -4.58109,
ThrowTrajectoryXc1 = 81.31084, ThrowTrajectoryXc2 = -8.11795,
ThrowTrajectoryYc0 = 4.26976, ThrowTrajectoryYc1 = 13.99541,
ThrowTrajectoryYc2 = -16.32979, ThrowTrajectoryZc0 = 3.7578,
ThrowTrajectoryZc1 = 67.17178, ThrowTrajectoryZc2 = -3.07957), row.names = c(NA, -1L), class = "data.frame")
Essentially I want to make a graph where the catcher (CatchPosition) and Base (BasePosition) are visible with a visualization in R of the throw (ThrowTrajectory)
I understand this is rather open ended, so if you have any ideas or suggestions onto how to create an effective visual for this in R, it would be very helpful!

These variable names are not self explanatory, but here goes a shot:
library(ggplot2)
ggplot(df) +
geom_point(aes(CatchPositionX, CatchPositionY, color = "Catch")) +
geom_point(aes(BasePositionX, BasePositionY, color = "Base")) +
geom_segment(aes(x = ThrowTrajectoryXc1, xend = ThrowTrajectoryXc2,
y = ThrowTrajectoryYc1, yend = ThrowTrajectoryYc2),
color = "black", arrow = arrow())

Related

Remove specific markers from legend

Sorry if this question has already been answered but I could not find the solution to what I am after. I have a plot that uses both geom_line and geom_point. The result of this is that in the legend, it adds both a line and a point when they should have one or the other. I want to keep the circles for the data tg1 and tg2 and remove the line and then do the opposite to the data full i.e. keep the line but remove the circle. I have seen that something like this works where you want to remove dots from all of the legend entries but nothing to only do specifics Removing ggplot2's geom_point icons from the legend. Can anyone help? Thanks.
#code for plot
library(ggplot2)
library(tidypaleo)
ggplot(LGRSL, aes(x =mmsl , y = Age))+
coord_flip()+
theme_classic(12)+
geom_point(data=tg1,aes(x=mmslc,y=Year,col="Fort Denison 1"),pch=1,size=2)+
geom_point(data=tg2,aes(x=mmslc,y=Year,col="Fort Denison 2"),pch=1,size=2)+
geom_lineh(data = full, aes(x=Lutregalammslc,y=Year,col="Full budget"))+
scale_colour_manual(values=c("grey15","grey50","black"))
## data
## tg1
structure(list(Year = 1886:1891, SLR = c(6919L, 6935L, 6923L,
6955L, 6956L, 6957L), mmsl = c(-0.158, -0.142, -0.154, -0.122,
-0.121, -0.12), m = c(6.919, 6.935, 6.923, 6.955, 6.956, 6.957
), GIA.correction = c(-0.02814, -0.02793, -0.02772, -0.02751,
-0.0273, -0.02709), SLRc = c(6.89086, 6.90707, 6.89528, 6.92749,
6.9287, 6.92991), mmslc = c(-0.19667, -0.18046, -0.19225, -0.16004,
-0.15883, -0.15762)), row.names = c(NA, 6L), class = "data.frame")
##tg2
structure(list(Year = 1915:1920, SLR = c(7011L, 6929L, 6987L,
6945L, 6959L, 6951L), mmsl = c(-0.066, -0.148, -0.09, -0.132,
-0.118, -0.126), m = c(7.011, 6.929, 6.987, 6.945, 6.959, 6.951
), GIA.correction = c(-0.02205, -0.02184, -0.02163, -0.02142,
-0.02121, -0.021), SLRc = c(6.98895, 6.90716, 6.96537, 6.92358,
6.93779, 6.93), mmslc = c(-0.09858, -0.18037, -0.12216, -0.16395,
-0.14974, -0.15753)), row.names = c(NA, 6L), class = "data.frame")
##full
structure(list(Year = 1900:1905, Lutregala = c(-0.103609677,
-0.118603251, -0.134550791, -0.105553735, -0.103983082, -0.121731984
), Wapengo = c(-0.095213147, -0.096005337, -0.115700625, -0.097696891,
-0.084444784, -0.109161066), Tarra = c(-0.106672829, -0.109537943,
-0.135256365, -0.101357772, -0.089716518, -0.104258351), Lutregalammsl = c(-0.292863465,
-0.307857039, -0.323804579, -0.294807523, -0.29323687, -0.310985772
), Wapengommsl = c(-0.257028279, -0.257820469, -0.277515756,
-0.259512023, -0.246259916, -0.270976198), Tarrammsl = c(-0.30925682,
-0.312121933, -0.337840355, -0.303941762, -0.292300508, -0.306842342
), LgGIAc = c(-0.01921, -0.01904, -0.01887, -0.0187, -0.01853,
-0.01836), WapGIAc = c(-0.02486, -0.02464, -0.02442, -0.0242,
-0.02398, -0.02376), TarGIAc = c(-0.02373, -0.02352, -0.02331,
-0.0231, -0.02289, -0.02268), Lutregalammslc = c(-0.312073465,
-0.326897039, -0.342674579, -0.313507523, -0.31176687, -0.329345772
), Wapmmslc = c(-0.281888279, -0.282460469, -0.301935756, -0.283712023,
-0.270239916, -0.294736198), Tarmmslc = c(-0.33298682, -0.335641933,
-0.361150355, -0.327041762, -0.315190508, -0.329522342)), row.names = c(NA,
6L), class = "data.frame")
##LGRSL
structure(list(depths = c(0.5, 1.5, 2.5, 3.5, 4.5, 5.5), RSL = c(0.047746907,
0.025564293, 0.021733558, 0.007855661, -0.004909879, 0.01747051
), RSLerror = c(0.058158556, 0.057902654, 0.057988654, 0.057957388,
0.057905405, 0.057226072), Age = c(2017.456716, 2013.594255,
2006.92838, 1999.675523, 1994.729181, 1990.518154), Ageerror = c(0.373138707,
0.77640096, 1.430582242, 1.627131115, 3.222393394, 3.239674718
), mmsl = c(0.01993169, -0.002250924, -0.006081659, -0.019959556,
-0.032725096, -0.010344707)), row.names = c(NA, 6L), class = "data.frame")
##LGRSLgp
structure(list(Age = 1892:1897, mean = c(-0.298147401, -0.304630597,
-0.31023294, -0.315506983, -0.321225142, -0.327190675), error = c(0.051858047,
0.04985084, 0.047760525, 0.045624121, 0.043505044, 0.041477551
), min = c(-0.246289354, -0.254779758, -0.262472416, -0.269882862,
-0.277720098, -0.285713124), max = c(-0.350005447, -0.354481437,
-0.357993465, -0.361131103, -0.364730186, -0.368668226), x = c(-0.02125,
-0.02108, -0.02091, -0.02074, -0.02057, -0.0204), meangia = c(-0.276897401,
-0.283550597, -0.28932294, -0.294766983, -0.300655142, -0.306790675
), rate = c(NA, -4.967327, -4.946326, -4.964493, -4.977451, -4.911859
), raterror = c(NA, 3.581013, 3.796417, 4.022157, 4.226762, 4.255126
), mmsl = c(-0.325962618, -0.332445814, -0.338048157, -0.3433222,
-0.349040359, -0.355005892)), row.names = c(NA, 6L), class = "data.frame")
Here is a way.
Override the guide legend with a list of vectors of values for each of the aesthetics involved, shape and linetype. Note the different ways to specify what is to be removed.
I have also simplified the code a bit.
library(ggplot2)
library(dplyr)
colrs <- c("Fort Denison 1" = "grey15",
"Fort Denison 2" = "grey50",
"Full budget" = "black")
legnd <- list(shape = c(1, 1, NA),
linetype = c("blank", "blank", "solid"))
bind_rows(
tg1 %>% mutate(col = "Fort Denison 1"),
tg2 %>% mutate(col = "Fort Denison 2")
) %>%
ggplot(aes(x = mmslc, y = Year, colour = col)) +
geom_point(pch = 1, size = 2) +
geom_lineh(data = full, aes(x = Lutregalammslc, col = "Full budget"))+
scale_colour_manual(values = colrs,
guide = guide_legend(override.aes = legnd)) +
coord_flip() +
theme_classic(base_size = 12)

R ggplot2 line two rows and all columns

I have this dataset:
structure(list(AgeGroup = c("Old", "Young"), Point.1 = c(0.401899407258065,
0.432845035714286), Point.2 = c(0.435610404, 0.448826385964912
), Point.3 = c(0.466951088, 0.473339649122807), Point.4 = c(0.490997664,
0.505416649122807), Point.5 = c(0.51047508, 0.517228789473684
), Point.6 = c(0.519614064, 0.520077087719298), Point.7 = c(0.524924236,
0.522939438596491), Point.8 = c(0.535448152, 0.523846929824561
), Point.9 = c(0.539298204, 0.529132140350877), Point.10 = c(0.546288992,
0.535221877192982), Point.11 = c(0.552286756, 0.544069684210526
), Point.12 = c(0.548644056, 0.547988701754386), Point.13 = c(0.546028996,
0.556100789473684), Point.14 = c(0.551464336, 0.557342807017544
), Point.15 = c(0.55835804, 0.552995140350877), Point.16 = c(0.560958056,
0.555753035087719), Point.17 = c(0.566631508, 0.553254912280702
), Point.18 = c(0.573644824, 0.557015719298246), Point.19 = c(0.579504268,
0.560797315789474), Point.20 = c(0.583600364, 0.560459526315789
), Point.21 = c(0.591889884, 0.563138245614035), Point.22 = c(0.598549332,
0.578847140350877), Point.23 = c(0.605920632, 0.59655149122807
), Point.24 = c(0.612308084, 0.611475473684211), Point.25 = c(0.618838952,
0.627695631578947), Point.26 = c(0.626865524, 0.640329719298246
), Point.27 = c(0.634642932, 0.642362438596491), Point.28 = c(0.639958892,
0.640706877192982), Point.29 = c(0.642219468, 0.654251789473684
), Point.30 = c(0.651740076, 0.674775824561404), Point.31 = c(0.657197604,
0.679311385964912), Point.32 = c(0.657618572, 0.673946421052632
), Point.33 = c(0.653554616, 0.67093849122807), Point.34 = c(0.648990388,
0.673238403508772), Point.35 = c(0.643885328, 0.669246245614035
), Point.36 = c(0.636234632, 0.670007543859649), Point.37 = c(0.632127604,
0.667657561403509), Point.38 = c(0.631252172, 0.665906228070175
), Point.39 = c(0.637404984, 0.677649561403509), Point.40 = c(0.6451598,
0.679067614035088), Point.41 = c(0.648019716, 0.688604824561403
), Point.42 = c(0.645375244, 0.692729175438596), Point.43 = c(0.647187664,
0.691994543859649), Point.44 = c(0.651923432, 0.681522859649123
), Point.45 = c(0.650062976, 0.674073456140351), Point.46 = c(0.638525956,
0.660092263157895), Point.47 = c(0.627772732, 0.652689456140351
), Point.48 = c(0.615988064, 0.650307087719298), Point.49 = c(0.599147952,
0.651349771929825), Point.50 = c(0.584897698795181, 0.63722649122807
)), class = "data.frame", row.names = c(NA, -2L))
which a subset of the 50 points looks like:
AgeGroup Point.1 Point.2 Point.3 Point.4 Point.5 Point.6 Point.7 Point.8 Point.9 Point.10 Point.11 Point.12 Point.13 Point.14 Point.15 Point.16
1 Old 0.4018994 0.4356104 0.4669511 0.4909977 0.5104751 0.5196141 0.5249242 0.5354482 0.5392982 0.5462890 0.5522868 0.5486441 0.5460290 0.5514643 0.5583580 0.5609581
2 Young 0.4328450 0.4488264 0.4733396 0.5054166 0.5172288 0.5200771 0.5229394 0.5238469 0.5291321 0.5352219 0.5440697 0.5479887 0.5561008 0.5573428 0.5529951 0.5557530
I am having difficulty plotting all columns on one graph, where X is just 1:50 tick marks and Y is the value of each point, color coded by AgeGroup.
I have tried melt, but I dont think thats necessary as it transposes the data and doubles the Point values.
I've tried variations of the following:
ggplot(YaxL, aes(x=1:50,y=YaxL[2:51])) + geom_point()
and
ggplot(YaxL, aes(x = 1:50)) +
geom_line(aes(y = YaxLDF[1,1], colour = "Old")) +
geom_line(aes(y = YaxLDF[2,1], colour = "Young"))
I feel like I'm overthinking this, help appreciated.
Try this approach. You can reshape to long with pivot_longer() and use the separate() function to extract the point position. After that the design of the plot is very practical. I have used the data you shared as YaxL. Always first try to reshape your data and then the plots can be easily built. Here the code:
library(tidyverse)
#Data process and plot
YaxL %>% pivot_longer(-1) %>%
separate(name,c('name','x'),sep='\\.') %>%
mutate(x=as.numeric(x)) %>%
dplyr::select(-name) %>%
ggplot(aes(x=x,y=value,color=AgeGroup,group=AgeGroup))+
geom_point()
Output:

How to draw an arrowhead in the middle of an edge in ggraph

Is it possible to draw an arrowhead in the middle of an edge using ggraph::geom_edge_link(), and if so how can this be done?
Rather than something like this with the arrowheads drawn at the ends of the edges:
library(ggraph)
library(tidygraph)
library(dplyr)
create_notable('bull') %>%
ggraph(layout = 'graphopt') +
geom_edge_link(arrow = arrow(length = unit(4, 'mm')),
end_cap = circle(3, 'mm')) +
geom_node_point(size = 5) +
theme_graph()
I'd like to be able to achieve something like this:
I've checked the ggraph::geom_edge_link() and grid::arrow() documentation but couldn't see anything obvious about how to do this.
I haven't used the ggraph package myself, but based on my understanding of the underlying grobs, you can try the following:
Step 1. Run the following line in your console:
trace(ggraph:::cappedPathGrob, edit = TRUE)
Step 2. In the pop-up window, change the last chunk of code from this:
if (is.null(start.cap) && is.null(end.cap)) {
if (constant) {
grob(x = x, y = y, id = id, id.lengths = NULL, arrow = arrow,
name = name, gp = gp, vp = vp, cl = "polyline")
}
else {
grob(x0 = x[!end], y0 = y[!end], x1 = x[!start],
y1 = y[!start], id = id[!end], arrow = arrow,
name = name, gp = gp, vp = vp, cl = "segments")
}
} else {
gTree(x = x, y = y, id = id, arrow = arrow, constant = constant,
start = start, end = end, start.cap = start.cap,
start.cap2 = start.cap2, start.captype = start.captype,
end.cap = end.cap, end.cap2 = end.cap2, end.captype = end.captype,
name = name, gp = gp, vp = vp, cl = "cappedpathgrob")
}
To this:
if(is.null(arrow)) {
# same code as before, if no arrow needs to be drawn
if (is.null(start.cap) && is.null(end.cap)) {
if (constant) {
grob(x = x, y = y, id = id, id.lengths = NULL, arrow = arrow,
name = name, gp = gp, vp = vp, cl = "polyline")
}
else {
grob(x0 = x[!end], y0 = y[!end],
x1 = x[!start], y1 = y[!start],
id = id[!end], arrow = arrow,
name = name, gp = gp, vp = vp, cl = "segments")
}
} else {
gTree(x = x, y = y, id = id, arrow = arrow, constant = constant,
start = start, end = end, start.cap = start.cap,
start.cap2 = start.cap2, start.captype = start.captype,
end.cap = end.cap, end.cap2 = end.cap2, end.captype = end.captype,
name = name, gp = gp, vp = vp, cl = "cappedpathgrob")
}
} else {
# split x/y/ID values corresponding to each ID into two halves; first half to
# end with the specified arrow aesthetics; second half (with a repetition of the
# last value from first half, so that the two halves join up) has arrow set to NULL.
id.split = split(id, id)
id.split = lapply(id.split,
function(i) c(rep(TRUE, ceiling(length(i)/2)),
rep(FALSE, length(i) - ceiling(length(i)/2))))
id.split = unsplit(id.split, id)
id.first.half = which(id.split == TRUE)
id.second.half = which(id.split == FALSE |
(id.split == TRUE & c(id.split[-1], FALSE) == FALSE))
if (is.null(start.cap) && is.null(end.cap)) {
if (constant) {
gList(grob(x = x[id.first.half], y = y[id.first.half], id = id[id.first.half],
id.lengths = NULL, arrow = arrow,
name = name, gp = gp, vp = vp, cl = "polyline"),
grob(x = x[id.second.half], y = y[id.second.half], id = id[id.second.half],
id.lengths = NULL, arrow = NULL,
name = name, gp = gp, vp = vp, cl = "polyline"))
}
else {
# I haven't modified this chunk as I'm not familiar with ggraph,
# & haven't managed to trigger constant == FALSE condition yet
# to test out code modifications here
grob(x0 = x[!end], y0 = y[!end],
x1 = x[!start], y1 = y[!start],
id = id[!end], arrow = arrow,
name = name, gp = gp, vp = vp, cl = "segments")
}
} else {
gList(gTree(x = x[id.first.half], y = y[id.first.half], id = id[id.first.half],
arrow = arrow, constant = constant,
start = start, end = end, start.cap = start.cap,
start.cap2 = start.cap2, start.captype = start.captype,
end.cap = end.cap, end.cap2 = end.cap2, end.captype = end.captype,
name = name, gp = gp, vp = vp, cl = "cappedpathgrob"),
gTree(x = x[id.second.half], y = y[id.second.half], id = id[id.second.half],
arrow = NULL, constant = constant,
start = start, end = end, start.cap = start.cap,
start.cap2 = start.cap2, start.captype = start.captype,
end.cap = end.cap, end.cap2 = end.cap2, end.captype = end.captype,
name = name, gp = gp, vp = vp, cl = "cappedpathgrob"))
}
}
Step 3. Run ggraph code as per normal:
set.seed(777) # set seed for reproducibility
create_notable('bull') %>%
ggraph(layout = 'graphopt') +
geom_edge_link(arrow = arrow(length = unit(4, 'mm')),
end_cap = circle(0, 'mm')) +
geom_node_point(size = 5) +
theme_graph()
# end_cap parameter has been set to 0 so that the segments join up;
# you can also refrain from specifying this parameter completely.
This effect will remain in place for the rest of your current R session (i.e. all arrowed segments created by ggraph have their arrows in the middle rather than at the end) until you run the following line:
untrace(ggraph:::cappedPathGrob)
Thereafter, normal behaviour will resume.

How to put a text legend on a ggplot graph of data?

I have some data:
donnees <- structure(list(mean.time = c(66.2181493259296, 38.4214009587611,28.3780846407761, 23.6036479741174, 21.1194982724492, 18.2304201307749, 17.255935716945, 15.1999929855212, 14.4373235262462), interval.time = c(2.02676652919753, 1.11352244913202, 0.852970451889973, 0.659463003712615, 0.637078718678222, 0.555560539640353, 0.523901049738113, 0.459577876757762, 0.42846867586966), mean.speed = c(93.3820017657387, 161.279607915939, 218.506927701215,257.296969741989, 295.210612887155, 344.350019217133, 364.011355824999, 409.234700329235, 437.398681209406), interval.speed = c(2.88657084170069, 5.02519369247631, 6.79320499564379, 7.66765106354858, 9.45539113245263, 10.9383151684182, 12.2017419883015, 13.715012760365, 16.6173823082674), mean.dist = c(5059.20542230044, 5025.32849954932, 4979.53881596498, 4994.56758567708, 4980.47651740827, 4991.06590346422, 4984.66564161804, 4932.67139724921, 4991.32367321949), interval.distance = c(44.8556012621449, 41.8511306706474, 42.6986600944198, 43.1898193770464, 42.7477524465553, 43.4197913676737, 42.9860392430236, 41.6610917291015, 42.4239685871405), lambda = 1:9), .Names = c("mean.time", "interval.time", "mean.speed", "interval.speed", "mean.dist", "interval.distance", "lambda"), row.names = c(NA, 9L), class = "data.frame")
I use the following function to get the confident interval for a given lambda:
int.ech = function(vector,conf.level=0.95,na.rm=T){
if (length(vector)==0) { cat("Erreur ! Le vecteur ",substitute(vector),"est vide.\n")}
else { s = var(vector,na.rm=na.rm)
n = length(vector)-sum(is.na(vector))
ddl = n - 1 ; proba = (1-conf.level)*100 ; proba = (100-proba/2)/100
t_student = qt(proba, ddl) # quantile
intervalle = t_student * sqrt(s/n)
moyenne = mean(vector,na.rm=na.rm) ; return(intervalle) }
}
Then, I plot the data with ggplot :
ggplot(donnees, aes(x = lambda, y = donnees$mean.speed))+
geom_point() + geom_path(color = "blue") +
geom_errorbar(aes(ymin = donnees$mean.speed - donnees$interval.speed, ymax = donnees$mean.speed + donnees$interval.speed)) +
labs(title = 'Distibution of the infection speed (m/min) once the malware have reached the edge in function of lambda (users/km)', x = "lambda : users density (users/km)", y = "Infection speed (m/min)") +
labs(linetype='custom title')
I have a text which I want to put on legend of this graph :
texte <- c(paste("window =",win,"km",sep= " "),paste("r_infection =", radius*1000,"m",sep=" "),paste("gamma =",gamma,"km/km^2",sep=" "))
The problem is when I want to execute the legend function :
legend("topleft", legend = texte)
I have this error :
Error in strwidth(legend, units = "user", cex = cex, font = text.font) : plot.new has not been called yet
For information, I get the same answer when I just execute :
ggplot(donnees, aes(x = lambda, y = meanspeed)) + legend("topleft", legend = texte)
Thank you for your help.

Plot multiple rows as columns with ggplotly

I have the following data
dput(head(new_data))
structure(list(series = c("serie1", "serie2", "serie3",
"serie4"), Chr1_Coverage = c(0.99593043561, 0.995148711122,
0.996666194154, 1.00012127128), Chr2_Coverage = c(0.998909597935,
0.999350808049, 0.999696737431, 0.999091916132), Chr3_Coverage = c(1.0016871729,
1.00161108919, 0.997719609642, 0.999887319775), Chr4_Coverage = c(1.00238874787,
1.00024296426, 1.0032143002, 1.00118558895), Chr5_Coverage = c(1.00361001984,
1.00233184803, 1.00250793369, 1.00019989912), Chr6_Coverage = c(1.00145962318,
1.00085036645, 0.999767433622, 1.00018523387), Chr7_Coverage = c(1.00089620637,
1.00201715802, 1.00430458519, 1.00027257509), Chr8_Coverage = c(1.00130277775,
1.00332841536, 1.0027493578, 0.998107829176), Chr9_Coverage = c(0.998473062701,
0.999400379593, 1.00130178863, 0.9992796405), Chr10_Coverage = c(0.996508132358,
0.999973856701, 1.00180072957, 1.00172163916), Chr11_Coverage = c(1.00044015107,
0.998982489577, 1.00072330837, 0.998947935281), Chr12_Coverage = c(0.999707836898,
0.996654676531, 0.995380321719, 1.00116773966), Chr13_Coverage = c(1.00199118466,
0.99941499519, 0.999850500793, 0.999717689167), Chr14_Coverage = c(1.00133747054,
1.00232593477, 1.00059139379, 1.00233368187), Chr15_Coverage = c(0.997036875653,
1.0023727983, 1.00020943048, 1.00089130742), Chr16_Coverage = c(1.00527426537,
1.00318861724, 1.0004269482, 1.00471256502), Chr17_Coverage = c(0.995530811404,
0.995103514254, 0.995135851149, 0.99992196636), Chr18_Coverage = c(0.99893371568,
1.00452723685, 1.00006262572, 1.00418478844), Chr19_Coverage = c(1.00510422346,
1.00711968194, 1.00552123413, 1.00527171097), Chr20_Coverage = c(1.00113612137,
1.00130658886, 0.999390191542, 1.00178637085), Chr21_Coverage = c(1.00368753618,
1.00162782873, 1.00056883447, 0.999797571642), Chr22_Coverage = c(0.99677846234,
1.00168287612, 0.997645576841, 0.999297594524), ChrX_Coverage = c(1.04015901555,
0.934772492047, 0.98981339011, 0.999960536561), ChrY_Coverage = c(9.61374227868e-09,
2.50609172398e-07, 8.30448295172e-08, 1.23741398572e-08)), .Names = c("series",
"Chr1_Coverage", "Chr2_Coverage", "Chr3_Coverage", "Chr4_Coverage",
"Chr5_Coverage", "Chr6_Coverage", "Chr7_Coverage", "Chr8_Coverage",
"Chr9_Coverage", "Chr10_Coverage", "Chr11_Coverage", "Chr12_Coverage",
"Chr13_Coverage", "Chr14_Coverage", "Chr15_Coverage", "Chr16_Coverage",
"Chr17_Coverage", "Chr18_Coverage", "Chr19_Coverage", "Chr20_Coverage",
"Chr21_Coverage", "Chr22_Coverage", "ChrX_Coverage", "ChrY_Coverage"
), row.names = c(NA, -4L), class = c("tbl_df", "tbl", "data.frame"
))
and I would like to plot it as this
I thought of transposing the data starting from the second column and name the new transposed data by the first column in the initial data with the following code:
output$Plot_1 <- renderPlotly({
Plot_1_new_data[,2:24] <- lapply(Plot_1_new_data[,2:24], as.numeric)
# first remember the names
n <- as.data.frame(Plot_1_new_data[0:nrow(Plot_1_new_data),1])
# transpose all but the first column (name)
Plot_1_new_data_T <- as.data.frame(t(Plot_1_new_data[,-1]))
colnames(Plot_1_new_data_T) <- n
#plot data
library(reshape)
melt_Transposed_Plot_1_new_data <- melt(Plot_1_new_data_T,id="series")
ggplotly(melt_Transposed_Plot_1_new_data,aes(x=series,y=value,colour=variable,group=variable)) + geom_line()
})
However, when I check the "Plot_1_new_data_T" it seems that the first column is named as c("serie1","serie2",..."serie14") and the rest is named as NA.
Any idea how to proceed because I am new to both R and shiny.
Something like this?
xm = melt(x)
ggplot(xm[xm$variable != 'ChrY_Coverage' & xm$variable != 'ChrX_Coverage', ],
aes(as.integer(variable), value, color=series)) +
geom_line() +
scale_x_continuous(breaks = as.integer(xm$variable),
labels = as.character(xm$variable)) +
theme(axis.text.x = element_text( angle=45, hjust = 1))
ggplotly()
Note that the last two columns were removed from this plot, because they are of such a different scale that including them masks any variation in the other columns. If you want to include all the columns, you could use this instead:
ggplot(xm, aes(as.integer(variable), value, color=series)) +
geom_line() +
...

Resources