Using dygraph with xts-object drops Label in plot - r

I have a seemingly small challenge, but I can't get to an answer. Here is my minimum working example.
fr_nuke <- structure(list(Date = structure(c(1420070400, 1420074000, 1420077600,
1420081200, 1420084800, 1420088400), class = c("POSIXct", "POSIXt"), tzone = ""),
`61` = c(57945, 57652, 57583, 57551, 57465, 57683),
`3244` = c(72666.64, 73508.78, 69749.17, 67080.13, 66357.65, 66524.13),
`778` = c(2.1133, 2.1133, 2.1133, 2.1133, 2.1133, 2.1133),
fcasted_nuke_temp = c(54064.6099092888, 54064.6099092888, 54064.6099092888,
54064.6099092888, 54064.6099092888, 54064.6099092888),
fcasted_nuke_cons = c(55921.043096775, 56319.5688170977, 54540.4094334057,
53277.340242333, 52935.4411965463, 53014.2244890147)),
.Names = c("Date", "61", "3244", "778", "fcasted_nuke_temp", "fcasted_nuke_cons"),
row.names = c(NA, 6L), class = "data.frame")
series1 <- as.xts(fr_nuke$'61', fr_nuke$Date)
series2 <- as.xts(fr_nuke$fcasted_nuke_temp, fr_nuke$Date)
series3 <- as.xts(fr_nuke$fcasted_nuke_cons, fr_nuke$Date)
grp_input <- cbind(series1,series2,series3)
dygraph(grp_input)
The resulting plot does not show the label of the individual series. Specifying the series with
dygraph(grp_input) %>% dySeries("V1", label = "Label1")
Results in:
Error in dySeries(., "V1", label = "Label1") : One or more of the
specified series were not found. Valid series names are: ..1, ..2, ..3
However, it works if I plot only one series (e.g. series1).
dygraph(series1) %>% dySeries("V1", label = "Label1")

Either set the colnames for the grp_input object, or use merge to construct the column names from the object names.
# setting colnames
require(dygraphs)
require(xts)
grp_input <- cbind(series1, series2, series3)
colnames(grp_input) <- c("V1", "V2", "V3")
dygraph(grp_input) %>% dySeries("V1", label = "Label1")
# using merge
require(dygraphs)
require(xts)
grp_input <- merge(series1, series2, series3)
dygraph(grp_input) %>% dySeries("series1", label = "Label1")

Related

Estimate_richness for all phyla in phyloseq

Is there an easy way to get ASV richness for each Phylum for each Station using the estimate_richness function in phyloseq? Or is there another simple way of extracting the abundance data for each taxonomic rank and calculating richness that way?
So far I have just been subsetting individual Phyla of interest using for example:
ps.Prymnesiophyceae <- subset_taxa(ps, Phylum == "Prymnesiophyceae")
alpha_diversity<-estimate_richness(ps.Prymnesiophyceae,measure=c("Shannon","Observed"))
H<-alpha_diversity$Shannon
S1<-alpha_diversity$Observed
S<-log(S1)
evenness<-H/S
alpha<-cbind(Shannon=H,Richness=S1,Evenness=evenness,sample_data(Prymnesiophyceae))
But this is rather a pain when having to do it for e.g. the top 20 phyla.
EDIT:
suggestion by #GTM works well until last step. See comment + dput:
> dput(head(sample_names(ps.transect), n=2)) c("2-1-DCM_S21_L001_R1_001.fastq", "2-1-SA_S9_L001_R1_001.fastq" )
> dput(head(alpha, n=2)) structure(list(Observed = c(31, 25), Shannon = c(2.84184012598765,
2.53358345702604), taxon = c("Prymnesiophyceae", "Prymnesiophyceae" ), sample_id = c("X2.1.DCM_S21_L001_R1_001.fastq", "X2.1.SA_S9_L001_R1_001.fastq" ), S = c(3.43398720448515,
3.2188758248682), evenness = c(0.827562817437384,
0.787101955736294)), row.names = c("X2.1.DCM_S21_L001_R1_001.fastq", "X2.1.SA_S9_L001_R1_001.fastq"), class = "data.frame")
> dput(head(smpl_data, n=1)) new("sample_data", .Data = list("001_DCM", 125L, structure(1L, .Label = "DCM", class = "factor"), structure(1L, .Label = "Transect", class = "factor"), structure(1L, .Label = "STZ", class = "factor"),
structure(1L, .Label = "STFW", class = "factor"), "Oligotrophic",
16L, -149.9978333, -29.997, 130.634, 17.1252, 35.4443, 1025.835008,
1.1968, 1e-12, 5.387, 2.8469, 52.26978546, 98.0505, 0, 0,
0.02, 0.9, 0, 0, 2069.47, 8.057, 377.3), names = c("Station_neat", "Depth_our", "Depth_bin", "Loc", "Front", "Water", "Zone", "Bottle", "Lon", "Lat", "pressure..db.", "Temperature", "Salinity", "Density_kgm.3", "Fluorescence_ugL", "PAR", "BottleO2_mLL", "CTDO2._mLL", "OxygenSat_.", "Beam_Transmission", "N_umolL", "NO3_umolL", "PO4_umolL", "SIL_umolL", "NO2_umolL", "NH4_umolL", "DIC_uMkg", "pH", "pCO2_matm"), row.names = "2-1-DCM_S21_L001_R1_001.fastq",
.S3Class = "data.frame")
You can wrap your code in a for loop to do so. I've slightly modified your code to make it a bit more flexible, see below.
require("phyloseq")
require("dplyr")
# Calculate alpha diversity measures for a specific taxon at a specified rank.
# You can pass any parameters that you normally pass to `estimate_richness`
estimate_diversity_for_taxon <- function(ps, taxon_name, tax_rank = "Phylum", ...){
# Subset to taxon of interest
tax_tbl <- as.data.frame(tax_table(ps))
keep <- tax_tbl[,tax_rank] == taxon_name
keep[is.na(keep)] <- FALSE
ps_phylum <- prune_taxa(keep, ps)
# Calculate alpha diversity and generate a table
alpha_diversity <- estimate_richness(ps_phylum, ...)
alpha_diversity$taxon <- taxon_name
alpha_diversity$sample_id <- row.names(alpha_diversity)
return(alpha_diversity)
}
# Load data
data(GlobalPatterns)
ps <- GlobalPatterns
# Estimate alpha diversity for each phylum
phyla <- get_taxa_unique(ps,
taxonomic.rank = 'Phylum')
phyla <- phyla[!is.na(phyla)]
alpha <- data.frame()
for (phylum in phyla){
a <- estimate_diversity_for_taxon(ps = ps,
taxon_name = phylum,
measure = c("Shannon", "Observed"))
alpha <- rbind(alpha, a)
}
# Calculate the additional alpha diversity measures
alpha$S <- log(alpha$Observed)
alpha$evenness <- alpha$Shannon/alpha$S
# Add sample data
smpl_data <- as.data.frame(sample_data(ps))
alpha <- left_join(alpha,
smpl_data,
by = c("sample_id" = "X.SampleID"))
This is a reproducible example with GlobalPatterns. Make sure to alter the code to match your data by replacing X.SampleID in the left join with the name of the column that contains the sample IDs in your sample_data. If there is no such column, you can create it from the row names:
smpl_data <- as.data.frame(sample_data(ps))
smpl_data$sample_id < row.names(smpl_data)
alpha <- left_join(alpha,
smpl_data,
by = c("sample_id" = "sample_id"))

how to simply plot similar dates of different years in one plot

I have a dataframe with dates. Here are the first 3 rows with dput:
df.cv <- structure(list(ds = structure(c(1448064000, 1448150400, 1448236800
), class = c("POSIXct", "POSIXt"), tzone = "UTC"), y = c(10.4885204292416,
10.456538985014, 10.4264986311659), yhat = c(10.4851491194439,
10.282089547027, 10.4354960430083), yhat_lower = c(10.4169914076864,
10.2162549984153, 10.368531352493), yhat_upper = c(10.5506038959764,
10.3556867861042, 10.5093092789713), cutoff = structure(c(1447977600,
1447977600, 1447977600), class = c("POSIXct", "POSIXt"), tzone = "UTC")),.Names = c("ds",
"y", "yhat", "yhat_lower", "yhat_upper", "cutoff"), row.names = c(NA,
-3L), class = c("`enter code here`tbl_df", "tbl", "data.frame"))
I'm trying to plot the data with ggplot + geom_line from similar day/month combinations in one plot. So, for example, I want the y-value of 2016-01-01 to appear on the same x-value as 2017-01-01. If found a way to do this, but it seems to be a very complex workaround:
library(tidyverse)
library(lubridate)
p <- df.cv %>%
mutate(jaar = as.factor(year(ds))) %>%
mutate(x = as_date(as.POSIXct(
ifelse(jaar==2016, ds + years(1), ds),
origin = "1970-01-01")))
ggplot(p %>% filter(jaar!=2015), aes(x=x, group=jaar, color=jaar)) +
geom_line(aes(y=y))
It works, but as you can see I first have to extract the year, then use an ifelse to add one year to only the 2016 dates, convert with POSIXct because ifelse strips the class, convert back into POSIXct while supplying an origin, and finally remove the timestamp with as_date.
Isn't there a simpler, more elegant way to do this?
Use year<- to replace the year with any fixed leap year:
p <- df.cv %>%
mutate(jaar = as.factor(year(ds)),
x = `year<-`(as_date(ds), 2000))
ggplot(p, aes(x = x, y = y, color = jaar)) +
geom_line()

Using literal month names with year in ramcharts

Here is my code to generate barplot using rAmChart,
library(rAmCharts)
amBarplot(x = "month", y = "value", data = dataset,
dataDateFormat = "MM/YYYY", minPeriod = "MM",
show_values = FALSE, labelRotation = -90, depth = 0.1)
However, is there a way to use month names & year in my x axis? I am trying to use MMM-YY formats.
Sample dataset,
structure(list(value = c(11544, 9588, 9411, 10365, 11154, 12688
), month = c("05/2012", "06/2012", "07/2012", "08/2012", "09/2012",
"10/2012")), .Names = c("value", "month"), row.names = c(NA,
6L), class = "data.frame")
Thanks.
It appears that rAmCharts doesn't expose AmCharts' dateFormats setting in the categoryAxis, so you have to access it through the init event and create your own dateFormats array with a modified format string for the MM period. I'm not very experienced with R, but here's how I managed to make it work using R 3.4.2 and rAmCharts 2.1.5
chart <- amBarplot( ... settings omitted ... )
addListener(.Object = chart,
name = 'init',
expression = paste(
"function(e) {",
"e.chart.categoryAxis.dateFormats = ",
'[{"period":"fff","format":"JJ:NN:SS"},{"period":"ss","format":"JJ:NN:SS"},',
'{"period":"mm","format":"JJ:NN"},{"period":"hh","format":"JJ:NN"},{"period":"DD","format":"MMM DD"},',
'{"period":"WW","format":"MMM DD"},',
'{"period":"MM","format":"MMM-YY"},', # "add YY to default MM format
'{"period":"YYYY","format":"YYYY"}]; ',
'e.chart.validateData();',
"}")
)
Here is a different solution:
library(rAmCharts)
dataset <- structure(list(value = c(11544, 9588, 9411, 10365, 11154, 12688
), month = c("05/2012", "06/2012", "07/2012", "08/2012", "09/2012",
"10/2012")), .Names = c("value", "month"), row.names = c(NA,
6L), class = "data.frame")
dataset$month <- as.character(
format(
as.Date(paste0("01/",dataset$month), "%d/%m/%Y"),
"%B %Y"))
amBarplot(x = "month", y = "value", data = dataset,
show_values = FALSE, labelRotation = -90, depth = 0.1)

Automatically split function output (list) into component data.frames

I have a functions which yields 2 dataframes. As functions can only return one object, I combined these dataframes as a list. However, I need to work with both dataframes separately. Is there a way to automatically split the list into the component dataframes, or to write the function in a way that both objects are returned separately?
The function:
install.packages("plyr")
require(plyr)
fun.docmerge <- function(x, y, z, crit, typ, doc = checkmerge) {
mergedat <- paste(deparse(substitute(x)), "+",
deparse(substitute(y)), "=", z)
countdat <- nrow(x)
check_t1 <- data.frame(mergedat, countdat)
z1 <- join(x, y, by = crit, type = typ)
countdat <- nrow(z1)
check_t2 <- data.frame(mergedat, countdat)
doc <- rbind(doc, check_t1, check_t2)
t1<-list()
t1[["checkmerge"]]<-doc
t1[[z]]<-z1
return(t1)
}
This is the call to the function, saving the result list to the new object results.
results <- fun.docmerge(x = df1, y = df2, z = "df3", crit = c("id"), typ = "left")
In the following sample data to replicate the problem:
df1 <- structure(list(id = c("XXX1", "XXX2", "XXX3",
"XXX4"), tr.isincode = c("ISIN1", "ISIN2",
"ISIN3", "ISIN4")), .Names = c("id", "isin"
), row.names = c(NA, 4L), class = "data.frame")
df2 <- structure(list(id= c("XXX1", "XXX5"), wrong= c(1L,
1L)), .Names = c("id", "wrong"), row.names = 1:2, class = "data.frame")
checkmerge <- structure(list(mergedat = structure(integer(0), .Label = character(0), class = "factor"),
countdat = numeric(0)), .Names = c("mergedat", "countdat"
), row.names = integer(0), class = "data.frame")
In the example, a list with the dataframes df3 and checkmerge are returned. I would need both dataframes separately. I know that I could do it via manual assignment (e.g., checkmerge <- results$checkmerge) but I want to eliminate manual changes as much as possible and am therefore looking for an automated way.

Trouble creating a ggplot jitter plot in r

I am having trouble creating a ggplot jitter plot in R. I have a data frame, aa, and want to make the x-axis to be labelled with each gene name (i.e. AADAT). I want the y-axis to display fold-change values (the numeric values from aa). Also, I have two lists, b1 and b2, containing a certain number of the TCGA samples for each gene and their fold-change values. I want to color all the fold change values from the jitter plot based on whether they belong to b1 or b2. How would I do this?
dput(aa):
structure(list(TCGA.BC.A10Q = c(2.54076411223946, 1.11243159235432,
-8.07819965644818), TCGA.DD.A1EB = c(0.437216525767862, 0.461169651797969,
-1.35226172820141), TCGA.DD.A1EG = c(2.19320501695823, 1.27412886320315,
-3.46331855085169), TCGA.DD.A1EH = c(3.26575582726209, 1.80298461724572,
-4.4298527877724), TCGA.DD.A1EI = c(0.606030095793745, -0.0475743042500462,
-3.03789531487311), TCGA.DD.A3A6 = c(2.92707172081351, 1.0710641387449,
-4.67961035825927), TCGA.DD.A3A8 = c(0.679951440435414, 0.433630069956858,
-2.02366124071563), TCGA.ES.A2HT = c(-0.0812955357950507, 1.76935812455138,
0.236573023675848), TCGA.FV.A23B = c(2.29637640282035, 0.364439713535423,
-1.94003185763597), TCGA.FV.A3I0 = c(3.196518439057, 1.39220627799838,
-7.67942521158398), TCGA.FV.A3R2 = c(0.859594276372461, 1.0282030128145,
0.131890257248429)), .Names = c("TCGA.BC.A10Q", "TCGA.DD.A1EB",
"TCGA.DD.A1EG", "TCGA.DD.A1EH", "TCGA.DD.A1EI", "TCGA.DD.A3A6",
"TCGA.DD.A3A8", "TCGA.ES.A2HT", "TCGA.FV.A23B", "TCGA.FV.A3I0",
"TCGA.FV.A3R2"), row.names = c("ABCC10", "ACBD6", "ACSL1"), class = "data.frame")
dput(b1):
structure(list(ABCC10 = structure(c(2.19320501695823, 0.859594276372461,
3.196518439057, 3.26575582726209, 2.29637640282035), .Names = c("TCGA.DD.A1EG",
"TCGA.FV.A3R2", "TCGA.FV.A3I0", "TCGA.DD.A1EH", "TCGA.FV.A23B"
)), ACBD6 = structure(c(1.80298461724572, 0.433630069956858,
1.76935812455138, 1.27412886320315, 0.461169651797969), .Names = c("TCGA.DD.A1EH",
"TCGA.DD.A3A8", "TCGA.ES.A2HT", "TCGA.DD.A1EG", "TCGA.DD.A1EB"
)), ACSL1 = structure(c(-1.94003185763597, -3.46331855085169,
-3.03789531487311, -4.4298527877724), .Names = c("TCGA.FV.A23B",
"TCGA.DD.A1EG", "TCGA.DD.A1EI", "TCGA.DD.A1EH"))), .Names = c("ABCC10",
"ACBD6", "ACSL1"))
dput(b2):
structure(list(ABCC10 = structure(c(2.54076411223946, 0.437216525767862,
0.606030095793745, 2.92707172081351, 0.679951440435414, -0.0812955357950507
), .Names = c("TCGA.BC.A10Q", "TCGA.DD.A1EB", "TCGA.DD.A1EI",
"TCGA.DD.A3A6", "TCGA.DD.A3A8", "TCGA.ES.A2HT")), ACBD6 = structure(c(1.11243159235432,
-0.0475743042500462, 1.0710641387449, 0.364439713535423, 1.39220627799838,
1.0282030128145), .Names = c("TCGA.BC.A10Q", "TCGA.DD.A1EI",
"TCGA.DD.A3A6", "TCGA.FV.A23B", "TCGA.FV.A3I0", "TCGA.FV.A3R2"
)), ACSL1 = structure(c(-8.07819965644818, -1.35226172820141,
-4.67961035825927, -2.02366124071563, 0.236573023675848, -7.67942521158398,
0.131890257248429), .Names = c("TCGA.BC.A10Q", "TCGA.DD.A1EB",
"TCGA.DD.A3A6", "TCGA.DD.A3A8", "TCGA.ES.A2HT", "TCGA.FV.A3I0",
"TCGA.FV.A3R2"))), .Names = c("ABCC10", "ACBD6", "ACSL1"))
Are you looking for something like this?
library(dplyr); library(tidyr); library(ggplot2)
# convert aa from wide to long format
aa$gene <- rownames(aa)
aa <- aa %>%
gather(TCGA, fold.change, -gene)
# convert lookup lists into data frame for matching
match.table <- rbind(stack(b1) %>% mutate(source = "b1"),
stack(b2) %>% mutate(source = "b2"))
aa <- left_join(aa, match.table,
by = c("gene" = "ind", "fold.change" = "values"))
ggplot(aa,
aes(x = gene, y = fold.change, col = source)) +
geom_jitter() +
theme_light()

Resources