### R code from vignette source 'vignettes/biosvd/inst/doc/biosvd.Rnw'
### Encoding: UTF-8

###################################################
### code chunk number 1: yeast_data_import
###################################################
library(biosvd)
data(YeastData_alpha)
YeastData


###################################################
### code chunk number 2: yeast_compute_eigensystem_data
###################################################
eigensystem <- compute(YeastData)


###################################################
### code chunk number 3: yeast_plot_eigensystem_data_fraction
###################################################
plot(eigensystem, plots="fraction", figure=TRUE)
fractions(eigensystem)[[1]]


###################################################
### code chunk number 4: yeast_plot_eigensystem_data_lines
###################################################
plot(eigensystem, plots="allLines", figure=TRUE)


###################################################
### code chunk number 5: yeast_plot_eigensystem_data_heatmap
###################################################
plot(eigensystem, plots="heatmap", figure=TRUE, prefix="YeastData")


###################################################
### code chunk number 6: yeast_remove_eigenfeature_data
###################################################
eigensystem <- exclude(eigensystem,excludeEigenfeatures=c(1,2,8,10:18))


###################################################
### code chunk number 7: yeast_compute_eigensystem_variance
###################################################
eigensystem <- compute(eigensystem, apply='variance')
entropy(eigensystem)
fractions(eigensystem)[[1]]
plot(eigensystem, plots="lines", figure=TRUE)
eigensystem <- exclude(eigensystem, excludeEigenfeatures=1)


###################################################
### code chunk number 8: yeast_generate_report
###################################################
fractions(eigensystem)[c(1,2)]
report(eigensystem, colorIdAssays="Cell.cycle.stage", colorIdFeatures="Cell.cycle.stage", prefix="YeastData")


###################################################
### code chunk number 9: yeast_polarplot_assays
###################################################
library(grid)
eigenfeature.xaxis <- 2
eigenfeature.yaxis <- 1
colorIdAssays <- assayMatrix(eigensystem)[,"Cell.cycle.stage"]
unique.col.ids <- sort(unique(colorIdAssays), na.last=NA)
col.assays <- rep(0,ncol(matrix(eigensystem)))
col.map <- rainbow(length(unique.col.ids))
for (z in c(1:length(unique.col.ids))) {col.assays[which(colorIdAssays %in% unique.col.ids[z])] <- col.map[z]}

coordinates.assays <- base::matrix(0,nrow=ncol(matrix(eigensystem)),ncol=2)
for (z in c(1:ncol(eigenassays(eigensystem)))) {coordinates.assays[z,] <- c(assaycorrelations(eigensystem)[eigenfeature.xaxis,z]/sqrt(matrix(eigensystem)[,z] %*% matrix(eigensystem)[,z]), assaycorrelations(eigensystem)[eigenfeature.yaxis,z]/sqrt(matrix(eigensystem)[,z] %*% matrix(eigensystem)[,z]))}
radii.assays <- signif(sqrt(coordinates.assays[,1]^2+coordinates.assays[,2]^2),3)
names(radii.assays) <- colnames(matrix(eigensystem))
phase.assays <- atan(assaycorrelations(eigensystem)[eigenfeature.yaxis,]/assaycorrelations(eigensystem)[eigenfeature.xaxis,])/pi
names(phase.assays) <- colnames(matrix(eigensystem))
coordinates.assays <- signif(coordinates.assays,3)
rownames(coordinates.assays) <- colnames(matrix(eigensystem))
  
vp0 <- viewport(x=0,width=0.05,just="left",name="vp0")
vp1 <- viewport(x=0.1,y=0.1,width=0.75,height=0.75,just=c("left","bottom"),name="vp1")
vp2 <- viewport(x=0.1,y=0,width=0.75,height=0.1,just=c("left","bottom"),name="vp2")
vp3 <- viewport(x=1,width=0.2,just="right",name="vp3")
pushViewport(vp0)
grid.text(paste("Assay correlation with eigenassay ",eigenfeature.yaxis,sep=""), y=0.5, rot=90)
upViewport()
pushViewport(vp1)
grid.circle(x=0.5,y=0.5,r=0.5,gp=gpar(lty="dashed"))
grid.circle(x=0.5,y=0.5,r=0.25,gp=gpar(lty="dashed",fill="grey"))
grid.lines(x=unit(c(0,1),"npc"),y=unit(c(0.5,0.5),"npc"),arrow=NULL)
grid.lines(x=unit(c(0.5,0.5),"npc"),y=unit(c(0,1),"npc"),arrow=NULL)
for (z in c(1:length(unique.col.ids))) {
  indices <- which(colorIdAssays %in% unique.col.ids[z])
  grid.points(x=unit((coordinates.assays[indices,1]+1)/2,"npc"),y=unit((coordinates.assays[indices,2]+1)/2,"npc"), pch=z,gp=gpar(col=col.map[z],cex=0.7))
}
grid.text(c(1:length(colorIdAssays)),just="left",x=(coordinates.assays[,1]+1)/2+0.02,y=(coordinates.assays[,2]+1)/2)
grid.lines(x=unit(c(0.5,(coordinates.assays[1,1]+1)/2),"npc"),y=unit(c(0.5,(coordinates.assays[1,2]+1)/2),"npc"),arrow=arrow(angle=30, length=unit(0.02,"npc"),ends="last",type="open"))
upViewport()
pushViewport(vp2)
grid.text(paste("Assay correlation with eigenassay ",eigenfeature.xaxis,sep=""), x=0.5, y=0.5)
upViewport()
pushViewport(vp3)
grid.points(pch=1:length(unique.col.ids),x=unit(rep(0.5,length(unique.col.ids)),"lines"),y=unit(1,"npc")-unit(c(1:length(unique.col.ids)),"lines"),gp=gpar(col=col.map))
grid.text(unique.col.ids,just="left",x=unit(rep(1.5,length(unique.col.ids)),"lines"), y=unit(1,"npc")-unit(c(1:length(unique.col.ids)),"lines"),gp=gpar(col=col.map))
upViewport()


###################################################
### code chunk number 10: yeast_polarplot_features
###################################################
colorIdFeatures <- featureMatrix(eigensystem)[,"Cell.cycle.stage"]
unique.row.ids <- sort(unique(colorIdFeatures), na.last=NA)
col.features <- rep(0,nrow(matrix(eigensystem)))
row.map <- rainbow(length(unique.row.ids))
for (z in c(1:length(unique.row.ids))) {col.features[which(colorIdFeatures %in% unique.row.ids[z])] <- row.map[z]}

coordinates.features <- base::matrix(0,nrow=nrow(matrix(eigensystem)),ncol=2)
for (z in c(1:nrow(matrix(eigensystem)))) {coordinates.features[z,] <- c(featurecorrelations(eigensystem)[eigenfeature.xaxis,z]/sqrt(matrix(eigensystem)[z,] %*% matrix(eigensystem)[z,]), featurecorrelations(eigensystem)[eigenfeature.yaxis,z]/sqrt(matrix(eigensystem)[z,] %*% matrix(eigensystem)[z,]))}
radii.features <- signif(sqrt(coordinates.features[,1]^2+coordinates.features[,2]^2),3)
names(radii.features) <- rownames(matrix(eigensystem))
phase.features <- atan(featurecorrelations(eigensystem)[eigenfeature.yaxis,]/featurecorrelations(eigensystem)[eigenfeature.xaxis,])/pi
names(phase.features) <- rownames(matrix(eigensystem))
coordinates.features <- signif(coordinates.features,3)
rownames(coordinates.features) <- rownames(matrix(eigensystem))
phase.features.converted <- phase.features*pi
phase.features.converted[which(coordinates.features[,1]<0)] <- phase.features.converted[which(coordinates.features[,1]<0)]+pi
phase.features.converted[which(coordinates.features[,1]>0 & coordinates.features[,2]<0)] <- phase.features.converted[which(coordinates.features[,1]>0 & coordinates.features[,2]<0)]+(2*pi)
phase.features.converted <- signif(phase.features.converted,3)

vp0 <- viewport(x=0,width=0.05,just="left",name="vp0")
vp1 <- viewport(x=0.1,y=0.1,width=0.75,height=0.75,just=c("left","bottom"),name="vp1")
vp2 <- viewport(x=0.1,y=0,width=0.75,height=0.1,just=c("left","bottom"),name="vp2")
vp3 <- viewport(x=1,width=0.2,just="right",name="vp3")
pushViewport(vp0)
grid.text(paste("Feature correlation with eigenfeature ",eigenfeature.yaxis,sep=""), y=0.5, rot=90)
upViewport()
pushViewport(vp1)
grid.circle(x=0.5,y=0.5,r=0.5,gp=gpar(lty="dashed"))
grid.circle(x=0.5,y=0.5,r=0.25,gp=gpar(lty="dashed",fill="grey"))
grid.lines(x=unit(c(0,1),"npc"),y=unit(c(0.5,0.5),"npc"),arrow=NULL)
grid.lines(x=unit(c(0.5,0.5),"npc"),y=unit(c(0,1),"npc"),arrow=NULL)
for (z in c(1:length(unique.row.ids))) {
  indices <- which(colorIdFeatures %in% unique.row.ids[z])
  grid.points(x=unit((coordinates.features[indices,1]+1)/2,"npc"),y=unit((coordinates.features[indices,2]+1)/2,"npc"), pch=z,gp=gpar(col=row.map[z],cex=0.7))
}
grid.lines(x=unit(c(0.5,(coordinates.features[1,1]+1)/2),"npc"),y=unit(c(0.5,(coordinates.features[1,2]+1)/2),"npc"),arrow=arrow(angle=30, length=unit(0.02,"npc"),ends="last",type="open"))
upViewport()
pushViewport(vp2)
grid.text(paste("Feature correlation with eigenfeature ",eigenfeature.xaxis,sep=""), x=0.5, y=0.5)
upViewport()
pushViewport(vp3)
grid.points(pch=1:length(unique.row.ids),x=unit(rep(0.5,length(unique.row.ids)),"lines"),y=unit(1,"npc")-unit(c(1:length(unique.row.ids)),"lines"),gp=gpar(col=row.map))
grid.text(unique.row.ids,just="left",x=unit(rep(1.5,length(unique.row.ids)),"lines"), y=unit(1,"npc")-unit(c(1:length(unique.row.ids)),"lines"),gp=gpar(col=row.map))
upViewport()


###################################################
### code chunk number 11: yeast_sortedheatmap
###################################################
library(gplots)
eigensystem.sorted <- sort(eigensystem, decreasing=FALSE, eigenfeature.xaxis=eigenfeature.xaxis, eigenfeature.yaxis=eigenfeature.yaxis, colorIdFeatures=factor(colorIdFeatures))
col.features <- rep(0,nrow(matrix(eigensystem)))
for (z in c(1:length(unique.row.ids))) {col.features[which(colorIdFeatures(eigensystem.sorted) %in% unique.row.ids[z])] <- row.map[z]}
contrast <- 3  
pal <- colorRampPalette(c(rgb(1,0,0), rgb(0,1,0)), space="rgb")
contrastMatrix <- contrast* matrix(eigensystem.sorted)
contrastMatrix[which(contrastMatrix>1)] <- 1
contrastMatrix[which(contrastMatrix<(-1))] <- -1
contrastMatrix <- (contrastMatrix - min(contrastMatrix))/(max(contrastMatrix)-min(contrastMatrix))
heatmap.2(contrastMatrix, Rowv=NA, Colv=NA, RowSideColors=col.features, ColSideColors=col.assays, scale="none", dendrogram="none", col=pal, trace="none", xlab="Assays", ylab="Features", labRow=NA, margins=c(9,3), main="YeastData", key=TRUE)
legend("left",legend=c("Assay annotation",as.character(unique.col.ids),"","Feature annotation",as.character(unique.row.ids)),fill=c("white",col.map,"white","white",row.map), bty="n", border=FALSE, cex=0.7, y.intersp=0.7)


###################################################
### code chunk number 12: hela_compute_eigensystem_data
###################################################
data(HeLaData_exp_DoubleThym_2)
HeLaData
eigensystem <- compute(HeLaData)
fractions(eigensystem)[[1]]
entropy(eigensystem)
plot(eigensystem, plots="allLines", figure=TRUE)
eigensystem <- exclude(eigensystem,excludeEigenfeature=c(1,7,10:12))


###################################################
### code chunk number 13: hela_compute_eigensystem_variance
###################################################
eigensystem <- compute(eigensystem, apply='variance')
entropy(eigensystem)
fractions(eigensystem)[[1]]
plot(eigensystem, plots=c("heatmap","fraction","lines"), prefix="HeLaData")
eigensystem <- exclude(eigensystem, excludeEigenfeatures=1)


###################################################
### code chunk number 14: hela_generate_report
###################################################
report(eigensystem, colorIdAssays="Cell.cycle.stage", colorIdFeatures="Cell.cycle.stage", prefix="HeLaData")


###################################################
### code chunk number 15: hela_sortedheatmap
###################################################
eigenfeature.xaxis <- 2
eigenfeature.yaxis <- 1
colorIdAssays <- assayMatrix(eigensystem)[,"Cell.cycle.stage"]
unique.col.ids <- sort(unique(colorIdAssays), na.last=NA)
col.assays <- rep(0,ncol(matrix(eigensystem)))
col.map <- rainbow(length(unique.col.ids))
for (z in c(1:length(unique.col.ids))) {col.assays[which(colorIdAssays %in% unique.col.ids[z])] <- col.map[z]}

eigensystem.sorted <- sort(eigensystem, decreasing=FALSE, eigenfeature.xaxis, eigenfeature.yaxis, "Cell.cycle.stage")
unique.row.ids <- sort(unique(colorIdFeatures), na.last=NA)
col.features <- rep(0,nrow(matrix(eigensystem)))
row.map <- rainbow(length(unique.row.ids))
for (z in c(1:length(unique.row.ids))) {col.features[which(colorIdFeatures(eigensystem.sorted) %in% unique.row.ids[z])] <- row.map[z]}
contrast <- 3  
pal <- colorRampPalette(c(rgb(1,0,0), rgb(0,1,0)), space="rgb")
contrastMatrix <- contrast* matrix(eigensystem.sorted)
contrastMatrix[which(contrastMatrix>1)] <- 1
contrastMatrix[which(contrastMatrix<(-1))] <- -1
contrastMatrix <- (contrastMatrix - min(contrastMatrix))/(max(contrastMatrix)-min(contrastMatrix))
heatmap.2(contrastMatrix, Rowv=NA, Colv=NA, RowSideColors=col.features, ColSideColors=col.assays, scale="none", dendrogram="none", col=pal, trace="none", xlab="Assays", ylab="Features", labRow=NA, margins=c(9,3), main="HeLaData", key=TRUE)
legend("left",legend=c("Assay annotation",as.character(unique.col.ids),"","Feature annotation",as.character(unique.row.ids)),fill=c("white",col.map,"white","white",row.map), bty="n", border=FALSE, cex=0.7, y.intersp=0.7)


###################################################
### code chunk number 16: starvation_compute_eigensystem_data (eval = FALSE)
###################################################
## data(StarvationData)
## StarvationData
## eigensystem <- compute(StarvationData)
## fractions(eigensystem)[c(1,2)]
## plot(eigensystem, plots=c("fraction","lines","allLines"), figure=TRUE, prefix="StarvationData")
## eigensystem <- exclude(eigensystem,excludeEigenfeature=c(1,11,12,14:24))


###################################################
### code chunk number 17: starvation_plot_eigensystem_1
###################################################
data(StarvationData)
StarvationData
eigensystem <- compute(StarvationData)
fractions(eigensystem)[c(1,2)]
plot(eigensystem, plots="fraction", figure=TRUE, prefix="StarvationData")


###################################################
### code chunk number 18: starvation_plot_eigensystem_2
###################################################
plot(eigensystem, plots="lines", figure=TRUE, prefix="StarvationData")


###################################################
### code chunk number 19: starvation_plot_eigensystem_3
###################################################
plot(eigensystem, plots="allLines", figure=TRUE, prefix="StarvationData")
eigensystem <- exclude(eigensystem,excludeEigenfeature=c(1,11,12,14:24))


###################################################
### code chunk number 20: starvation_compute_eigensystem_variance
###################################################
eigensystem <- compute(eigensystem, apply='variance')
plot(eigensystem, plots="lines", figure=TRUE)
eigensystem <- exclude(eigensystem, excludeEigenfeatures=0)


###################################################
### code chunk number 21: starvation_generate_report
###################################################
report(eigensystem, colorIdAssays="Species", prefix="StarvationData")


###################################################
### code chunk number 22: starvation_sortedheatmap
###################################################
eigenfeature.xaxis <- 2
eigenfeature.yaxis <- 1
colorIdAssays <- assayMatrix(eigensystem)[,"Species"]
unique.col.ids <- sort(unique(colorIdAssays), na.last=NA)
col.assays <- rep(0,ncol(matrix(eigensystem)))
col.map <- rainbow(length(unique.col.ids))
for (z in c(1:length(unique.col.ids))) {col.assays[which(colorIdAssays %in% unique.col.ids[z])] <- col.map[z]}

colorIdFeatures <- rep(1,nrow(matrix(eigensystem)))
eigensystem.sorted <- sort(eigensystem, decreasing=FALSE, eigenfeature.xaxis, eigenfeature.yaxis, colorIdFeatures)
unique.row.ids <- sort(unique(colorIdFeatures), na.last=NA)
col.features <- rep(0,nrow(matrix(eigensystem)))
row.map <- rainbow(length(unique.row.ids))
for (z in c(1:length(unique.row.ids))) {col.features[which(colorIdFeatures(eigensystem.sorted) %in% unique.row.ids[z])] <- row.map[z]}
contrast <- 3  
pal <- colorRampPalette(c(rgb(1,0,0), rgb(0,1,0)), space="rgb")
contrastMatrix <- contrast*matrix(eigensystem.sorted)
contrastMatrix[which(contrastMatrix>1)] <- 1
contrastMatrix[which(contrastMatrix<(-1))] <- -1
contrastMatrix <- (contrastMatrix - min(contrastMatrix))/(max(contrastMatrix)-min(contrastMatrix))
heatmap.2(contrastMatrix, Rowv=NA, Colv=NA, RowSideColors=col.features, ColSideColors=col.assays, scale="none", dendrogram="none", col=pal, trace="none", xlab="Assays", ylab="Features", labRow=NA, margins=c(9,3), main="StarvationData", key=TRUE)
legend("left",legend=c("Assay annotation",as.character(unique.col.ids),"","Feature annotation",as.character(unique.row.ids)),fill=c("white",col.map,"white","white",row.map), bty="n", border=FALSE, cex=0.7, y.intersp=0.7)


###################################################
### code chunk number 23: sessionInfo
###################################################
toLatex(sessionInfo(), locale=FALSE)