Comparing "Unlimited" value to numerical values in ggplot - r

I am trying to make a visual comparison between an input vector and my database.However, the input vector or the database may contain the "UL" character, which means, an infinite number. Think of it as your unlimited voice plan, with which you can make an unlimited number of calls.
Here is the code I have used to try to make a visual comparison between "UL" and other numerical values.
# d is the database data.frame, with which we want to compare the input vector
d = structure(list(Type = c("H1", "H2", "H3"),
P1 = c(2000L, 1500L, 1000L),
P2 = c(60L, 40L, 20L),
P3 = c("UL", 3000L, 2000L)),
class = "data.frame",
row.names = c(NA, -3L))
# d2 is the input vector
d2 = structure(list(Type = "New_offre", P1 = 1200L, P2 = "UL", P3 = 2000),
class = "data.frame",
row.names = c(NA, -1L))
#Check if there are some unlimited values in both d and d2
y1 <-rbind(d,d2)
y <- y1
if("UL" %in% y$P3){
max_P3_scale <- max(as.numeric(y[y$P3!="UL","P3"]))
y[y$P3=="UL","P3"]= 2*max_P3_scale
}
if("UL" %in% y$P2){
max_P2_scale <- max(as.numeric(y[y$P2!="UL","P2"]))
y[y$P2=="UL","P2"]= 2*max_P2_scale
}
y <- transform(y,P1=as.numeric(P1),
P2=as.numeric(P2),
P3=as.numeric(P3))
d <- y[1:nrow(d),]
d2<- y[nrow(d)+1,]
d %>% gather(var1, current, -Type) %>%
mutate(new = as.numeric(d2[cbind(rep(1, max(row_number())),
match(var1, names(d2)))]),
slope = factor(sign(current - new), -1:1)) %>%
gather(var2, val, -Type, -var1, -slope) %>%
ggplot(aes(x = factor(var2,levels = c("new","current")), y = val, group = 1)) +
geom_point(aes(fill = var2), shape = 2,size=4) +
geom_line(aes(colour = slope)) +
scale_colour_manual(values = c("green","green", "red")) +
facet_wrap(Type ~ var1,scales = "free")
My first attempt was to find if there is "UL" values in P2 and P3. If yes, I try to find the maximum numeric value other than "UL". Then, I replace all "UL" occurrences by this maximum value* 2, so the graphical representations will always show that "UL" is maximum.
The issue with this is that I am not able to differentiate between actual values and "UL" ones.
Here is how my plot looks like using this solution

Related

Making 2-way graph (ggplot2) out of a tabyl table changing values

male FALSE TRUE
0 50.0% 66.7%
1 50.0% 33.3%
structure(list(male = 0:1, `FALSE` = c("50.0%", "50.0%"), `TRUE` = c("66.7%",
"33.3%")), row.names = c(NA, -2L), core = structure(list(male = 0:1,
`FALSE` = c(1, 1), `TRUE` = c(4, 2)), class = "data.frame", row.names = c(NA,
-2L)), tabyl_type = "two_way", var_names = list(row = "male",
col = "dummy"), class = c("tabyl", "data.frame"))
How can I make a plot using ggplot2 of this table constructed with janitor? The thing is that I would like two plots side-by-side: one for dummy=TRUE and the other for dummy=FALSE (but changing the labels such that TRUE is replaced by a and FALSE by b -- i am having difficulties with this because TRUE and FALSE are logical). I would also like to replace the values 0 and 1 for c and d respectively.
You can try a tidyverse. The trick is to transform the data from wide to long since this is the prefered input for ggplot. Here I used pivot_longer, but you can also use reshape or melt.
library(tidyverse)
df %>%
pivot_longer(-1) %>%
mutate(name = ifelse(name, "a", "b")) %>%
ggplot( aes(factor(male), value, fill =name)) +
geom_col(position = position_dodge())
Using base R you can try
# transform percentages to numerics
df$a <- as.numeric(gsub("%", "", df$`TRUE`))
df$b <- as.numeric(gsub("%", "", df$`FALSE`))
barplot(cbind(a, b) ~ male, df, beside=T,legend.text = TRUE)

speech-gaze activity plot in ggplot2

I have data with Utterances by speakers in conversation as well as their gazes to one another. The speakers' gazes are in columns A_aoi, B_aoi, and C_aoi, the gaze durations are in A_aoi_dur, B_aoi_dur, and C_aoi_dur. Here's a reproducible snippet of the data:
df0 <- structure(list(Line = c(105L, 106L, 107L, 109L, 110L, 111L, 112L,
113L, 114L, 115L, 116L), Speaker = c("ID01.A", NA, "ID01.A",
NA, "ID01.B", NA, "ID01.A", NA, "ID01.A", NA, "ID01.C"), Utterance = c("so you've ↑obviously↑ thought about it obviously: (.) have made a decision (.) I'm !head!ing in this door (.) one of the cleaning ladies at the UB !grabb!ed my elbow",
"(0.662)", "and said (.) ~no no no !this! is the !womens'! bathroom~=",
"(0.015)", "=((v: gasps))=", "(0.166)", "=NOW", "(0.622)", "!how! this always plays out ",
"(0.726)", "[when was] that¿="), UttStart = c(163898L, 172500L,
173162L, 176100L, 176115L, 176800L, 176966L, 177372L, 177994L,
179328L, 180054L), UttEnd = c(172500, 173162, 176100, 176115,
176800, 176966, 177372, 177994, 179328, 180054, 180668), UttDur = c(8602,
662, 2938, 15, 685, 166, 406, 622, 1334, 726, 614), A_aoi = c("*B*C*B*C*B*C*B*C*B*C",
"C*", "*B*C*C", "C", "C*", "*", "*C", "C", "C*B", "B*", "*"),
A_aoi_dur = c("21,516,79,333,200,634,233,651,17,2332,33,400,33,518,17,532,33,1900,119,1",
"414,248", "1124,412,116,533,600,153", "15", "616,69", "166",
"153,253", "622", "204,151,979", "219,507", "614"), B_aoi = c("A*A*A*A*A",
"A", "A", "A", "A", "A", "A", "A*", "*A*A", "A*A", "A*A"),
B_aoi_dur = c("475,130,567,137,1983,313,787,1400,2810", "662",
"2938", "15", "685", "166", "406", "398,224", "76,136,284,838",
"108,571,47", "116,270,228"), C_aoi = c("A", "A", "A*A*A",
"A", "A", "A", "A", "A*A", "A", "A*A", "A"), C_aoi_dur = c("8602",
"662", "1058,123,1300,144,313", "15", "685", "166", "406",
"264,351,7", "1334", "125,323,278", "614")), row.names = c(NA,
-11L), class = c("tbl_df", "tbl", "data.frame"))
EDIT: new test data with temporally overlapping Utterances:
df0 <- structure(list(Line = 137:145,
Speaker = c("ID01.A", "ID01.A-Q", NA, "ID01.A", "ID01.A-Q", "ID01.A-Q", "ID01.A-Q", "ID01.A-Q",NA),
Utterance = c("↑she gra:bs my elbow (.) I turn to !look! at her↑ and she's like ~this is a (.) womens' bathroom you can't go in there~",
"~this is a (.) womens' bathroom you can't go in there~", "(0.534)",
"and I'm like ~((silent f: blank stare))~ (.) and she didn't, she was just like ~you can't go in~ (.) I'm like ~I'm a !woman!~ she said ~no you're not you can't go in~",
"~((silent f: blank stare))~", "~you can't go in~", "~I'm a !woman!~",
"~no you're not you can't go in~", "(0.487)"),
UttStart = c(208845L, 211450L, 214136L, 214670L, 215409L, 218307L, 219235L, 220076L, 221368L),
UttEnd = c(214136, 214136, 214670, 221368, 217117, 219050, 219885, 221368, 221855),
UttDur = c(5291, 2686, 534, 6698, 1708, 743, 650, 1292, 487),
A_aoi = c("C*B*C*C*B*C*", "C*B*C*", "*B", "B*C*B*C*C*B*B", "C*B", "C*B", "*", "*B","B"),
A_aoi_dur = c("57,445,1100,135,199,333,866,302,832,33,468,521","530,302,832,33,468,521",
"144,390", "377,235,466,399,1268,132,268,132,433,6,716,1412,854","339,399,970", "73,6,664", "650", "438,854", "487"),
B_aoi = c("A*A","A", "A", "A*A*A*A*A*A", "A", "*A*A", "*A", "A*A", "A"),
B_aoi_dur = c("1691,121,3479", "2686", "534", "53,180,3333,134,253,280,203,534,1296,138,294",
"1708", "63,253,280,147", "405,245", "860,138,294", "487"),
C_aoi = c("A", "A", "A", "A*A", "A", "A*", "A", "A", "A"),
C_aoi_dur = c("5291", "2686", "534", "3766,734,2198",
"1708", "129,614", "650", "1292", "487")),
row.names = c(NA, -9L), class = c("tbl_df", "tbl", "data.frame"))
What I'd like to be able to visualize is who is looking at whom and for how long for each Utterance, roughly like in this schematic representation:
What I can do at present is plot the gazes on a minute-by-minute scale, but just the gazes - not the Utterances: Plotting gaze movements by multiple speakers in a single plot. Starting from the data as above, this can be achieved by multiple transformations (shown below) but the resulting plot does not feature the Utterances and it plots the gazes per minute, whereas I need the gazes per Utterance:
I'm fully aware that this is demanding a lot. Help with it is all the more appreciated.
# pivot_longer so that all gazes have their own row:
df0 <- df0 %>%
rename_with(~ str_c(., "_AOI"), ends_with("_aoi")) %>%
pivot_longer(cols = contains("_"),
names_to = c("Gaze_by", ".value"), #
names_pattern = "^(.*)_([^_]+$)"
) %>%
mutate(Gaze_by = sub("^(.).*", "\\1", Gaze_by)) %>%
mutate(AOI = str_replace_all(AOI, "(?<=.)(?=.)", ",")) %>%
separate_rows(c(AOI, dur), sep = ",", convert = TRUE)
# compute starttimes and endtimes for gazes:
df1 <- df0 %>%
group_by(Gaze_by) %>%
mutate(
end = cumsum(dur),
start = end - dur
)
View(df1)
# compute minutes:
df2 <- df1 %>%
mutate(
# which minute does the event start in?
minute_start = as.integer(start/60000),
# which minute does the event end in?
minute_end = as.integer(end/60000),
# does the event straddle a minute mark?
straddler = minute_end > minute_start)
View(df2)
# 1st subset of `df2`:
df2_A1 <- df2 %>%
# filter those rows that contain events straddling minute marks:
filter(straddler=="TRUE") %>%
# reduce the endtime to the exact minute mark:
mutate(end = minute_end*60000)
View(df2_A1)
# 2nd subset of `df2`:
df2_A2 <- df2 %>%
# filter those rows that contain events straddling minute marks:
filter(straddler=="TRUE") %>%
# reduce the starttime to the exact minute mark:
mutate(start = minute_end*60000)
View(df2_A2)
# 3rd subset of `df0`:
df2_A3 <- df2 %>%
# filter those rows that do not contain events straddling minute marks:
filter(!straddler == "TRUE")
View(df2_A3)
# row-bind all three subsets:
df4 <- rbind(df2_A1, df2_A2, df2_A3) %>%
arrange(start) %>%
mutate(
minute = as.integer(start/60000),
# reduce total starttimes to starttimes per minute:
start_pm = start - 60000*minute,
# reduce total endtimes to endtimes per minute:
end_pm = end - 60000*minute)
# plot gaze activity for **ALL** speakers:
df4 %>%
ggplot(aes(x = start_pm,
xend = end_pm,
y = minute + scale(as.numeric(as.factor(Gaze_by))) / 6,
yend = minute + scale(as.numeric(as.factor(Gaze_by))) / 6,
color = AOI)) +
# draw segments for AOI:
geom_segment(size = 2) +
# reverse y-axis scale:
scale_y_reverse(breaks = 0:max(df4$minute),
labels = paste(0:max(df4$minute), "min", " Gaze_by_A\n Gaze_by_B\n Gaze_by_C", sep = " "),
name = NULL) +
# define custom colors:
scale_colour_manual(values = c("*" = "lemonchiffon",
"A" = "darkorange",
"B" = "lawngreen",
"C" = "slateblue1")) +
# plot title:
labs(title = "Gaze activity") +
theme(axis.title.x.bottom = element_blank())
Here is a solution that gets close to what you are looking for, making use of facets. It also uses forcats::fct_reorder and stringr::str_wrap (which are both part of the tidyverse).
This also wraps any long utterances and keeps the x-scale the same for all facets, rather than allowing them to stretch to fill the width.
df4 %>%
mutate(#add text for y axis labels
Gaze_by = paste0("Gaze_by_", Gaze_by),
#reorder facet panels, add speaker at start, and wrap to 120 characters
Utterance = fct_reorder(str_wrap(paste0(substr(Speaker, 6, 6), ": ",
Utterance),
120),
start_pm),
#set a dummy end point for each utterance based on the longest one
max_x = UttStart - min(UttStart) + max(UttDur)) %>%
ggplot(aes(x = start_pm, xend = end_pm,
y = Gaze_by, yend = Gaze_by, #as discrete variable
color = AOI)) +
geom_segment(size = 3) +
geom_point(aes(x = max_x, y = Gaze_by), alpha = 0) + #plot invisible dummy end points
scale_y_discrete(name = NULL, limits = rev) + #rev to get A at the top
facet_wrap(~Utterance, scales = "free_x", ncol = 1) +
scale_colour_manual(values = c("*" = "lemonchiffon",
"A" = "darkorange",
"B" = "lawngreen",
"C" = "slateblue1")) +
labs(title = "Gaze activity") +
theme_minimal() + #removes a lot of lines etc
theme(strip.text = element_text(color = "blue", hjust = 0), #facet strip text
strip.background = element_rect(fill = "white", color = "white"),
axis.title.x.bottom = element_blank())
To cut the utterances into 4-second chunks, you can do something like this...
df4 %>% group_by(Utterance) %>%
#work out relative durations from start of utterance and create subutterances
mutate(relStart = start_pm - min(start_pm),
relEnd = end_pm - min(start_pm),
subNo = map2(relStart, relEnd, ~seq(.x %/% 4000, .y %/% 4000, 1))) %>%
unnest(subNo) %>% #expand one row per subutterance
mutate(Utterance = paste0(Utterance, " (#", subNo + 1, ")"), #add sub no
subStart = pmax(4000 * subNo, relStart), #limits on subUtt
subEnd = pmin(4000 * (subNo + 1), relEnd), #limits on subUtt
start_pm = min(start_pm) + subStart, #redefine start
end_pm = min(start_pm) + subEnd) %>% #redefine end
group_by(Utterance) %>% #regroup as Utterance has changed!
mutate(max_x = min(start_pm) + 4000) %>% #define dummy end points
ungroup() %>%
mutate(Gaze_by = paste0("Gaze_by_", Gaze_by),
Utterance = fct_reorder(str_wrap(paste0(substr(Speaker, 6, 6), ": ", Utterance),
120), start_pm)) %>%
ggplot(...) #...as per code above from this point

how to make a merged heatmap between each two columns of values

How can I put two columns in one heatmap?
Lets say I have the following data
data<- structure(list(names = structure(c(5L, 1L, 10L, 2L, 6L, 4L, 9L,
7L, 11L, 3L, 8L), .Label = c("Bin", "Dari", "Down", "How", "India",
"Karachi", "Left", "middle", "Right", "Trash", "Up"), class = "factor"),
X1Huor = c(1.555555556, 5.2555556, 2.256544, 2.3654225, 1.2665545,
0, 1.889822365, 2.37232101, -1, -1.885618083, 1.128576187
), X2Hour = c(1.36558854, 2.254887, 2.3333333, 0.22255444,
2.256588, 5.66666, -0.377964473, 0.107211253, -1, 0, 0),
X3Hour = c(0, 1.222222222, 5.336666, 1.179323788, 0.832050294,
-0.397359707, 0.185695338, 1.393746295, -1, -2.121320344,
1.523019248), X4Hour = c(3.988620176, 3.544745039, -2.365555,
2.366666, 1.000000225, -0.662266179, -0.557086015, 0.862662186,
0, -1.305459824, 1.929157714), X5Hour = c(2.366666, 2.333365,
4.22222, 0.823333333, 0.980196059, -2.516611478, 2.267786838,
0.32163376, 0, -2.592724864, 0.816496581)), .Names = c("names",
"X1Huor", "X2Hour", "X3Hour", "X4Hour", "X5Hour"), class = "data.frame", row.names = c(NA,
-11L))
This data has 5 columns of values. I want to make a heatmap which half of it is the value from first colum and the other half of each cell is from the second column.
The same for the third column and fourth
The same for the fifth and sixth ( there is no sixth but I can leave it empty)
This is just an example to show what I am looking for. I have searched a lot but I could not find anything like this
The color range from Red to green, if the value is higher than 2 the color red and if the value is lower than -2 the color is green.
Any thought how to do this ?
This is a somewhat hacky solution, but it might work for you, so check this out.
The idea is to utilize geom_polygon to create the triangles and stack them. To do that we first need to generate the triangle coordinates
library(dplyr)
library(tidyr)
library(stringr)
# the following two line create the triangle coordinates
x = rep(c(1,2,2, 1, 1, 2),nrow(data))
y = rep(c(1,1,2, 1, 2, 2),nrow(data)) + rep(0:10, each=6)
Now that we have our coordinates we need to generate their ids, which are the names. But because we want each triangle to be unique, we need to create two unique versions of each name:
names <- data %>%
select(names, X1Huor, X2Hour) %>%
gather("key", "value", X1Huor, X2Hour) %>%
arrange(names, key) %>%
mutate(name = str_c(names, key)) %>%
.$name %>%
rep(each = 3)
And now we do the same with the hours:
hour <- data %>%
select(names, X1Huor, X2Hour) %>%
gather("key", "value", X1Huor, X2Hour) %>%
arrange(names, key) %>%
.$value %>%
rep(each = 3)
datapoly <- data.frame(x = x, y = y , hour = hour, names = names)
Since there are no proper labels for the plot in our datapoly df, we need to create one:
name_labels <- data %>%
select(names) %>%
arrange(names) %>%
.$names
The scene is now set for our graph:
ggplot(datapoly, aes(x = x, y = y)) +
geom_polygon(aes(group = names, fill = hour), color = "black") +
scale_fill_continuous(low = "green", high = "red") +
scale_y_continuous(breaks = 1:nrow(data), labels = name_labels) +
theme(axis.text.y = element_text(vjust = -2),
axis.ticks = element_blank(),
axis.text.x = element_blank(),
axis.title = element_blank())
The output looks like this:
Several points to keep in mind: Is this really a plot you want to be creating and using? Is this really useful for your purposes? Perhaps other, more traditional visualization methods are more suitable. Also, I didn't bother doing the same for the other hour columns as these are quite tedious, but the method on how to achieve them should be clear enough (I hope).

data of class numeric error when plotting vertical and horizontal lines in ggplot

iarray <- iv$iarray
varray <- iv$varray
n<-gsub("^\\{+(.+)\\}+$", '\\1', iarray)
n1 <- strsplit(n,",")
n1 <- unlist(n1)
n1 <- as.numeric(n1)
df <- as.data.frame(n1)
n<-gsub("^\\{+(.+)\\}+$", '\\1', varray)
n2 <- strsplit(n,",")
n2 <- unlist(n2)
n2 <- as.numeric(n2)
df <- cbind(df,n2)
vmpp <-iv$vmpp
impp <- iv$impp
print(impp)
print(vmpp)
})
output$ivcurve <- renderPlot({
ggplot(data3(), aes(x=n2, y= n1)) + geom_line(colour='blue')+ geom_vline(xintercept = vmpp)+ geom_hline(yintercept = impp) + scale_y_continuous(limits = c(-1, 11))
Basically I'm trying to draw an IV curve from the above code.
As seen in the photo I need a horizontal and a vertical line.
But after I added the geom_vline function it gives me the Error : ggplot2 doesn't know how to deal with data of class numeric
iv is a dataframe and iarray and varray basically looks like this.
iarray = "{9.467182035,9.252423958,9.179368178,9.142931845}"
varray = "{-1.025945126,-0.791203874,-0.506481774,-0.255416444}"
And vmpp and impp are basically numbers as 8.5 and 20
suggestions?
P.s :
dput(iv)
structure(list(id = 3L, seris_id = "SERTPTR0003", module_id = 2L,
isc = 9.1043, voc = 37.61426, impp = 8.524, vmpp = 30.0118,
pmpp = 255.8095, unique_halm_id = 4414L, iarray = "{9.471385758,9.251831868,9.174032904,9.135095327,9.109244512,9.087563112,9.081257993,9.079282455,9.078209387,9.077396672,9.076717653,9.076285598,9.075914058,9.075549594,9.075098675,9.074659768,9.074080201,9.073659578,9.073411255,9.073349331,9.073215686,9.073189667,9.073011759,9.072868405,9.072659064,9.072636165,9.072659725,9.072729724,9.072779321,9.072915415,9.072951718,9.072855259,9.072758863,9.072562734,9.072286497,9.072036161,9.071858009,9.07165223,9.071458902,9.071172024,9.070818323,9.070364851,9.069865071,9.069392026,9.069058847,9.068673155,9.068486996,9.0684006,9.068241175,9.067848351,9.067533806,9.066886103,9.066177782,9.0655086,9.065025577,9.064457111,9.064154995,9.063866251,9.063564149,9.063221961,9.06295813,9.062580288,9.062182005,9.06179715,9.061378517,9.060847632,9.06033015,9.059686156,9.058814993,9.057817299,9.056732355,9.055534236,9.054389596,9.05351149,9.052819766,9.052254696,9.051816304,9.051431465,9.051000987,9.050664797,9.050589584,9.050615635,9.050795719,9.051096084,9.05121704,9.050958132,9.050478383,9.049724325,9.048695951,9.047619756,9.046715916,9.04602525,9.045615278,9.045512729,9.045617691,9.045803509,9.045989974,9.046083526,9.045997615,9.045871618,9.045772357,9.045599926,9.045340971,9.045082036,9.04473025,9.044178732,9.043440888,9.042642632,9.04185002,9.041056695,9.040316091,9.039781509,9.039426971,9.039199774,9.039026035,9.038805897,9.038478843,9.037978051,9.037190302,9.036262611,9.035408047,9.034687132,9.03411323,9.033759457,9.033445779,9.033105372,9.032611665,9.031991392,9.031298017,9.030631384,9.029991493,9.02931152,9.028518372,9.027678053,9.026644378,9.025384369,9.023971135,9.022443918,9.020510444,9.018469233,9.015987042,9.013123551,9.009951782,9.006524239,9.002508657,8.99806541,8.993200713,8.987509287,8.980851319,8.97337198,8.964883202,8.955065215,8.944015742,8.931773812,8.91796823,8.902911552,8.886450605,8.868452754,8.848678419,8.827119435,8.80336248,8.777313996,8.748941051,8.718309497,8.685225063,8.649388501,8.610785476,8.569040812,8.52363426,8.474699468,8.422382481,8.366516735,8.307103187,8.244481209,8.178090447,8.10779633,8.033345875,7.954744415,7.871665908,7.784296593,7.692116999,7.595199333,7.493377787,7.386704971,7.275055109,7.158981607,7.038484468,6.913650942,6.784728642,6.651977027,6.515069048,6.374111623,6.228897233,6.079031999,5.924669253,5.766323899,5.604063459,5.43841477,5.26939121,5.096619936,4.919752772,4.738936722,4.554312451,4.366039658,4.174017769,3.978461295,3.779470133,3.576724216,3.370764477,3.162238756,2.951119622,2.737359938,2.521133452,2.302407806,2.08132299,1.858467726,1.632539296,1.397202225,1.149523324,0.890812319,0.62251893,0.349040094,0.084409259,-0.164612445,-0.4001423,-0.625408177,-0.844927296,-1.067373925,-1.297998987,-1.536777099,-1.782558235,-2.033692207,-2.28906274,-2.54694712,-2.806836154,-3.068463186,-3.331653821,-3.596227332,-3.862303417,-4.129421924,-4.397321356,-4.666082505,-4.935632162,-5.206170796,-5.478105728,-5.751638617,-6.027203502,-6.304753878,-6.584235675,-6.865027697,-7.146774939,-7.428922534,-7.711971427,-7.995982555,-8.281623641,-8.569128828,-8.85847189,-9.14887768,-9.440152159,-9.731968139,-10.02382391,-10.315645796,-10.608918155,-10.906228043,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0}",
varray = "{-1.055634971,-0.820094649,-0.530478984,-0.277519378,-0.049665975,0.168173928,0.369832037,0.557189853,0.73806136,0.918444007,1.100988955,1.285835111,1.471379381,1.656087228,1.83947039,2.021804885,2.204138782,2.387586314,2.572217234,2.757544476,2.943083961,3.127927125,3.311936258,3.49497066,3.677517995,3.860273388,4.043516446,4.227247167,4.411953813,4.597148124,4.781785019,4.965795342,5.149247651,5.331933288,5.514618924,5.698279889,5.882706331,6.067759345,6.253369179,6.43883951,6.623542572,6.807967224,6.991834459,7.175283184,7.359219574,7.543715171,7.727930567,7.91102934,8.092315166,8.270881273,8.44728269,8.622987785,8.800575578,8.981370755,9.16634984,9.355446065,9.546982405,9.738937256,9.930334092,10.119987137,10.30698723,10.492242934,10.676242509,10.859335313,11.042009008,11.224684494,11.40735998,11.589966311,11.77250289,11.955040067,12.138134659,12.321927365,12.506347836,12.691464628,12.877626501,13.06357852,13.248553416,13.432761044,13.616063692,13.798391012,13.981067688,14.165071441,14.350401073,14.536497974,14.722526917,14.907441627,15.090542195,15.272247132,15.453463208,15.634886746,15.817842429,16.00302897,16.188982779,16.375285347,16.561309505,16.745870074,16.92840904,17.110739948,17.293002899,17.47610287,17.660388619,17.84523298,18.029659429,18.213737119,18.397257992,18.580849811,18.765279846,18.950546303,19.136368979,19.322329963,19.507382979,19.691527431,19.874834264,20.057444179,20.239565832,20.422106592,20.605414621,20.789699174,20.974891096,21.161129891,21.347647095,21.533745789,21.718937711,21.903640773,22.087576567,22.271163603,22.454611733,22.638548722,22.822346805,23.006144888,23.189873219,23.373392294,23.556911967,23.740989056,23.925624756,24.110540657,24.296084919,24.481558832,24.666267268,24.850416495,25.034286715,25.217528572,25.400211222,25.582891485,25.765153238,25.947554494,26.130303912,26.31319522,26.495810505,26.678077627,26.859158373,27.03919344,27.2183891,27.396813913,27.574889968,27.752475972,27.92950277,28.106320312,28.283627309,28.460794206,28.638101203,28.814990286,28.99097379,29.16472524,29.336732302,29.506996765,29.675866194,29.843757906,30.011789121,30.179820337,30.347501601,30.514694006,30.680631478,30.844614709,31.006505389,31.166790586,31.32526224,31.482546323,31.638644628,31.793695462,31.947491958,32.10059034,32.252713392,32.40427843,32.555147743,32.705110284,32.853817294,33.001129867,33.14656034,33.29010692,33.431979459,33.572526716,33.711957348,33.85055096,33.988306953,34.125295678,34.260890565,34.395089819,34.528311952,34.660559355,34.792040088,34.923102908,35.053748414,35.1835569,35.312946278,35.441359731,35.568936163,35.695816274,35.821859963,35.946717873,36.071016573,36.194685715,36.317446291,36.439648854,36.561153301,36.681402816,36.801235017,36.924136292,37.050595501,37.180333637,37.313071096,37.446575824,37.573873847,37.693009727,37.80489203,37.910636184,38.012195237,38.11396235,38.218102215,38.324333435,38.432308447,38.541817399,38.652023867,38.762158191,38.872501769,38.982844151,39.092768022,39.202552988,39.31199099,39.420452469,39.528287977,39.635566071,39.742146647,39.848308713,39.954401627,40.060004483,40.165396887,40.270857247,40.376317008,40.481775571,40.587234732,40.692485836,40.797320225,40.901805855,41.005874173,41.109873339,41.21366265,41.317242107,41.420542558,41.523772657,41.626762446,41.729471102,41.832232456,41.937530675,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0,0.0}"), .Names = c("id",
"seris_id", "module_id", "isc", "voc", "impp", "vmpp", "pmpp",
"unique_halm_id", "iarray", "varray"), row.names = 1L, class = "data.frame")
Solved it. since the ggplot requires data frames. I just added two more columns to the data frame and added them there.
vmpp <- iv$vmpp
df <- cbind(df,vmpp)
impp <- iv$impp
df <- cbind(df,impp)
print(df)
})
output$ivcurve <- renderPlot({
ggplot(data3(), aes(x=n2, y= n1)) + geom_line(colour='blue')+ scale_y_continuous(limits = c(-1, 11))+ geom_vline(aes(xintercept = vmpp))+ geom_hline(aes(yintercept = impp))

R, basic plot with multiple y values

I am starting to work with R, this has to be a basic question but it doesn't seem obvious how to do it easily. If I have the following data set :
x y
0,1
0,2
1,2
1,4
and so on, so there are multiple y values for each x value. This how can I easily do a plot showing the data and the means and the CI intervals.
I can do it, as I have hodged together a solution off by hacking bits of code together, but there has to be a simpler solution.
This is what I am doing with this very simple data file
cardboard,r1,r2,r3,r4,r5,r6
0,233,130,110,140,160
101,293,340,313,260,366,38
and this mess of code :
er <- read.csv(file="ianevans.csv",head=TRUE,sep=",")
er[,2:7] <- min(er[1,2:7],na.rm=TRUE)/er[,2:7]*100
er$sharpness[1]=mean(as.vector(er[1,2:7], "numeric"),na.rm=TRUE)
er$sharpness[2]=mean(as.vector(er[2,2:7], "numeric"),na.rm=TRUE)
er$se[1]=sd(as.vector(er[1,2:7], "numeric"),na.rm=TRUE)/sqrt(6-1)
er$se[2]=sd(as.vector(er[2,2:7], "numeric"),na.rm=TRUE)/sqrt(6-1)
p <- ggplot(er,aes(x=cardboard,y=sharpness))
p1 <- p + geom_point(aes(y=sharpness,color="red",size=5) )
p2 <- p1 +
scale_shape_discrete(solid=F) +
geom_point(aes(y=r1),color="blue",shape="o",size=3) +
geom_point(aes(y=r2),color="blue",shape="o",size=3) +
geom_point(aes(y=r3),color="blue",shape="o",size=3) +
geom_point(aes(y=r4),color="blue",shape="o",size=3) +
geom_point(aes(y=r5),color="blue",shape="o",size=3) +
geom_point(aes(y=r6),color="blue",shape="o",size=3)
p3 <- p2 +
geom_errorbar(aes(ymax=sharpness+se,ymin=sharpness-se),width=5)
Again this works, more or less, but as you can see there are a bunch of hard coded numbers and there has to be a better way to both have the data file set up and do the plots and easily be able to deal with different amounts of y data for each x data for example. The way some of the data manipulation is done is also awkward as it should be possible do to it without individual references for the means, sd's, .
Here is my attempt to simplify your code. It is based on dplyr and ggplot2:
library(dplyr)
library(ggplot2)
er <- structure(list(cardboard = c("100", "101"), r1 = c(30L, 293L),
r2 = c(233L, 340L), r3 = c(130L, 313L), r4 = c(110L, 260L
), r5 = c(140L, 366L), r6 = c(160L, 38L)), .Names = c("cardboard",
"r1", "r2", "r3", "r4", "r5", "r6"), row.names = c(NA, -2L), class = "data.frame")
d2 <- er %>%
melt(id.vars='cardboard',na.rm=T) %>% # convert to tidy format
group_by(cardboard) %>% # group by cardboard
mutate(v2=min(value)/value) %>% # calculate v2
summarise(sharpness=mean(v2),se=sd(v2)) # calculate mean & sd
# cardboard sharpness se
#1 100 0.3390063 0.3273334
#2 101 0.2688070 0.3585103
ggplot(d2) +
aes(x=cardboard,y=sharpness,ymax=sharpness+se,ymin=sharpness-se) +
geom_pointrange()

Resources