489 lines
22 KiB
R
489 lines
22 KiB
R
#'@include ROBIBarcodes.R
|
|
NULL
|
|
|
|
svg.A.path="m 53.417969,-13.28125 -29.394532,0 L 19.384766,0 0.48828125,0 27.490234,-72.900391 l 22.41211,0 L 76.904297,0 58.007812,0 53.417969,-13.28125 m -24.707032,-13.525391 19.970704,0 -9.960938,-29.003906 -10.009766,29.003906"
|
|
svg.C.path="M 66.992187,-4.0039062 C 63.541603,-2.2135395 59.944602,-0.86262935 56.201172,0.04882812 52.45763,0.9602855 48.551384,1.4160142 44.482422,1.4160156 32.340462,1.4160142 22.721331,-1.9693991 15.625,-8.7402344 8.5286373,-15.543604 4.9804638,-24.755835 4.9804687,-36.376953 4.9804638,-48.030551 8.5286373,-57.242781 15.625,-64.013672 c 7.096331,-6.803314 16.715462,-10.205004 28.857422,-10.205078 4.068962,7.4e-5 7.975208,0.455803 11.71875,1.367188 3.74343,0.91153 7.340431,2.26244 10.791015,4.052734 l 0,15.087891 c -3.483136,-2.376246 -6.917377,-4.117781 -10.302734,-5.22461 -3.38547,-1.106711 -6.949919,-1.660096 -10.693359,-1.660156 -6.705769,6e-5 -11.979201,2.148496 -15.820313,6.445312 -3.841172,4.296925 -5.761743,10.221398 -5.761719,17.773438 -2.4e-5,7.51956 1.920547,13.427757 5.761719,17.724609 3.841112,4.29689 9.114544,6.445325 15.820313,6.445313 3.74344,1.2e-5 7.307889,-0.553373 10.693359,-1.660157 3.385357,-1.106755 6.819598,-2.84829 10.302734,-5.224609 l 0,15.0878908"
|
|
svg.G.path="m 74.707031,-5.4199219 c -4.68757,2.278649 -9.554101,3.9876317 -14.599609,5.12695315 C 55.061794,0.84635332 49.853466,1.4160142 44.482422,1.4160156 32.340462,1.4160142 22.721331,-1.9693991 15.625,-8.7402344 8.5286373,-15.543604 4.9804638,-24.755835 4.9804687,-36.376953 c -4.9e-6,-11.751254 3.6132727,-20.996037 10.8398443,-27.734375 7.226539,-6.738211 17.122362,-10.107348 29.687499,-10.107422 4.850211,7.4e-5 9.488878,0.455803 13.916016,1.367188 4.459572,0.91153 8.658786,2.26244 12.597656,4.052734 l 0,15.087891 c -4.069078,-2.311142 -8.121808,-4.036401 -12.158203,-5.175782 -4.003962,-1.139263 -8.02414,-1.708924 -12.060547,-1.708984 -7.487019,6e-5 -13.265008,2.099668 -17.333984,6.298828 -4.036485,4.166717 -6.054712,10.140018 -6.054688,17.919922 -2.4e-5,7.714872 1.953099,13.671898 5.859375,17.871094 3.906216,4.199233 9.456341,6.29884 16.650391,6.298828 1.953076,1.2e-5 3.759715,-0.11392 5.419922,-0.341797 1.692654,-0.260404 3.206325,-0.651029 4.541016,-1.171875 l 0,-14.160156 -11.47461,0 0,-12.597657 29.296875,0 0,35.0585941"
|
|
svg.T.path="m 0.48828125,-72.900391 l 67.18749975,0 0,14.208985 -24.169922,0 0,58.691406 -18.798828,0 0,-58.691406 -24.21874975,0 0,-14.208985"
|
|
svg.R.path="m 35.888672,-40.576172 c 3.938762,4.1e-5 6.754515,-0.73238 8.447265,-2.197265 1.725215,-1.4648 2.587844,-3.873652 2.587891,-7.226563 -4.7e-5,-3.320259 -0.862676,-5.696559 -2.587891,-7.128906 -1.69275,-1.432233 -4.508503,-2.148378 -8.447265,-2.148438 l -7.910156,0 0,18.701172 7.910156,0 m -7.910156,12.988281 0,27.587891 -18.7988285,0 0,-72.900391 28.7109375,0 c 9.602817,7.3e-5 16.63406,1.6114 21.09375,4.833985 4.492124,3.222721 6.738216,8.317117 6.738281,15.283203 -6.5e-5,4.817756 -1.171939,8.77283 -3.515625,11.865234 -2.311258,3.092486 -5.810603,5.37113 -10.498047,6.835938 2.571561,0.585971 4.86648,1.920605 6.884766,4.003906 2.050721,2.050809 4.117776,5.175806 6.201172,9.375 L 75,0 54.980469,0 46.09375,-18.115234 c -1.790409,-3.645812 -3.613324,-6.136044 -5.46875,-7.470703 -1.822955,-1.334609 -4.264359,-2.001926 -7.324219,-2.001954 l -5.322265,0"
|
|
svg.Y.path="m -0.9765625,-72.900391 20.5566405,0 16.601563,25.976563 16.601562,-25.976563 20.605469,0 -27.783203,42.1875 0,30.712891 -18.798828,0 0,-30.712891 -27.7832035,-42.1875"
|
|
svg.M.path="m 9.1796875,-72.900391 23.9257815,0 16.601562,39.013672 16.699219,-39.013672 23.876953,0 0,72.900391 -17.773437,0 0,-53.320312 -16.796875,39.30664 -11.914063,0 -16.796875,-39.30664 0,53.320312 -17.8222655,0 0,-72.900391"
|
|
svg.K.path="m 9.1796875,-72.900391 18.7988285,0 0,26.611329 27.099609,-26.611329 21.826172,0 L 41.796875,-38.378906 80.517578,0 56.982422,0 27.978516,-28.710937 27.978516,0 9.1796875,0 l 0,-72.900391"
|
|
svg.W.path="m 2.9785156,-72.900391 18.0175784,0 12.597656,52.978516 12.5,-52.978516 18.115234,0 12.5,52.978516 12.597657,-52.978516 17.871089,0 L 89.990234,0 68.310547,0 55.078125,-55.419922 41.992187,0 20.3125,0 2.9785156,-72.900391"
|
|
svg.S.path="m 59.912109,-70.605469 0,15.429688 c -4.003962,-1.790308 -7.910208,-3.141218 -11.71875,-4.052735 -3.808638,-0.911398 -7.405639,-1.367127 -10.791015,-1.367187 -4.492221,6e-5 -7.81253,0.618549 -9.960938,1.855469 -2.148463,1.237036 -3.22268,3.157607 -3.222656,5.761718 -2.4e-5,1.953176 0.716121,3.483123 2.148437,4.589844 1.464816,1.074266 4.101533,2.002 7.910157,2.783203 l 8.007812,1.611328 c 8.105419,1.627647 13.867132,4.101603 17.285156,7.421875 3.417906,3.320346 5.126889,8.040393 5.126954,14.160157 -6.5e-5,8.040379 -2.392641,14.0299559 -7.177735,17.9687496 -4.752657,3.90625056 -12.02804,5.8593736 -21.826172,5.859375 C 31.070932,1.4160142 26.432265,0.97656152 21.777344,0.09765625 17.122379,-0.78124922 12.467435,-2.0833313 7.8125,-3.8085938 l 0,-15.8691402 c 4.654935,2.473975 9.147118,4.345718 13.476562,5.615234 4.361954,1.236992 8.561169,1.855481 12.597657,1.855469 4.101524,1.2e-5 7.242797,-0.683581 9.423828,-2.050782 2.180944,-1.367171 3.271438,-3.320294 3.271484,-5.859374 -4.6e-5,-2.278624 -0.748744,-4.036435 -2.246094,-5.273438 -1.464886,-1.236953 -4.410847,-2.343722 -8.83789,-3.320312 l -7.275391,-1.611329 c -7.291687,-1.562468 -12.630224,-4.0527 -16.015625,-7.470703 -3.3528732,-3.417927 -5.0293038,-8.024042 -5.0292966,-13.818359 -7.2e-6,-7.259056 2.3437405,-12.841733 7.0312496,-16.748047 4.687481,-3.906178 11.425756,-5.859301 20.214844,-5.859375 4.003868,7.4e-5 8.121702,0.309319 12.353516,0.927734 4.23172,0.586011 8.60997,1.481192 13.134765,2.685547"
|
|
svg.B.path="m 38.378906,-44.677734 c 2.962198,4.4e-5 5.20829,-0.650997 6.738281,-1.953125 1.529902,-1.302036 2.294875,-3.222607 2.294922,-5.761719 -4.7e-5,-2.506456 -0.76502,-4.410751 -2.294922,-5.712891 -1.529991,-1.334576 -3.776083,-2.001893 -6.738281,-2.001953 l -10.40039,0 0,15.429688 10.40039,0 m 0.634766,31.884765 c 3.775999,1.3e-5 6.608027,-0.797512 8.496094,-2.392578 1.920523,-1.595035 2.880809,-4.003887 2.880859,-7.226562 -5e-5,-3.157527 -0.94406,-5.517551 -2.832031,-7.080078 -1.888067,-1.595021 -4.736371,-2.392547 -8.544922,-2.392579 l -11.035156,0 0,19.091797 11.035156,0 m 17.480469,-26.220703 c 4.036397,1.171913 7.161394,3.336624 9.375,6.494141 2.213473,3.157581 3.320243,7.031275 3.320312,11.621094 -6.9e-5,7.031263 -2.376369,12.2721435 -7.128906,15.7226558 C 57.307885,-1.7252587 50.08133,0 40.380859,0 l -31.2011715,0 0,-72.900391 28.2226565,0 c 10.12365,7.3e-5 17.447862,1.53002 21.972656,4.589844 4.557228,3.059961 6.835871,7.959045 6.835937,14.697266 -6.6e-5,3.548227 -0.830143,6.575568 -2.490234,9.082031 -1.660218,2.474 -4.06907,4.313191 -7.226562,5.517578"
|
|
svg.D.path="m 27.978516,-58.691406 0,44.482422 6.738281,0 c 7.682249,1.4e-5 13.541618,-1.904281 17.578125,-5.712891 4.068954,-3.80857 6.103457,-9.342419 6.103515,-16.601562 -5.8e-5,-7.226519 -2.018285,-12.727816 -6.054687,-16.503907 -4.036507,-3.775985 -9.912152,-5.664004 -17.626953,-5.664062 l -6.738281,0 m -18.7988285,-14.208985 19.8242185,0 c 11.067669,7.3e-5 19.303337,0.797599 24.707031,2.392579 5.436139,1.562568 10.091083,4.231837 13.964844,8.007812 3.417898,3.28782 5.956958,7.080134 7.617188,11.376953 1.660079,4.296922 2.490156,9.163454 2.490234,14.59961 -7.8e-5,5.501333 -0.830155,10.416692 -2.490234,14.746093 -1.66023,4.296893 -4.19929,8.089207 -7.617188,11.376953 -3.906314,3.7760487 -8.593809,6.4615929 -14.0625,8.056641 C 48.144483,-0.78124922 39.941366,0 29.003906,0 l -19.8242185,0 0,-72.900391"
|
|
svg.H.path="m 9.1796875,-72.900391 18.7988285,0 0,27.783204 27.734375,0 0,-27.783204 18.798828,0 0,72.900391 -18.798828,0 0,-30.908203 -27.734375,0 0,30.908203 -18.7988285,0 0,-72.900391"
|
|
svg.V.path="m 0.48828125,-72.900391 18.89648475,0 19.335937,53.808594 19.287109,-53.808594 18.896485,0 L 49.902344,0 27.490234,0 0.48828125,-72.900391"
|
|
svg.N.path="m 9.1796875,-72.900391 20.9960935,0 26.513672,50 0,-50 17.822266,0 0,72.900391 -20.996094,0 -26.513672,-50 0,50 -17.8222655,0 0,-72.900391"
|
|
|
|
svg.dash.path="m 5.4199219,-35.888672 l 30.6640621,0 0,14.208985 -30.6640621,0 0,-14.208985"
|
|
|
|
#' Compute the cubic bezier function
|
|
#'
|
|
#' The \code{bezier3} function computes the point of the cubic bezier
|
|
#' curve linking the point P0 to P3 and using P1 and P2 as control points
|
|
#'
|
|
#' @param t the position on the curve estimated as a float between 0 the
|
|
#' starting point and 1 the ending point
|
|
#'
|
|
#' @param p0 a vector of numeric describing the coordinates of the p0 point,
|
|
#' the starting point of the curve.
|
|
#'
|
|
#' @param p1 a vector of numeric describing the coordinates of the p1 point,
|
|
#' the first control point.
|
|
#'
|
|
#' @param p2 a vector of numeric describing the coordinates of the p2 point,
|
|
#' the second control point.
|
|
#'
|
|
#' @param p3 a vector of numeric describing the coordinates of the p3 point,
|
|
#' the final point of the curve.
|
|
#'
|
|
#' @return a numric matrix containing the coordinates of the bezier curve/
|
|
#'
|
|
#' @examples
|
|
#'
|
|
#' bezier3((1:10)/10,c(1,1),c(1,2),c(2,2),c(2,1))
|
|
#'
|
|
#' @author Eric Coissac
|
|
#' @export
|
|
bezier3 = function(t,p0,p1,p2,p3) {
|
|
outer((1-t)^3,p0) + outer(t*(1-t)^2,3*p1) + outer(t^2*(1-t),3*p2) + outer(t^3,p3)
|
|
}
|
|
|
|
lmin = function(l) min(sapply(l,min))
|
|
lmax = function(l) max(sapply(l,max))
|
|
|
|
path.to.polygon = function(path,scalex=TRUE,scaley=TRUE) {
|
|
|
|
x = strsplit(path," ")[[1]]
|
|
y = c()
|
|
for (c in x) {
|
|
if (length(grep(',',c))==0)
|
|
current=c
|
|
else {
|
|
y = c(y,current,c)
|
|
if (current=='m')
|
|
current='l'
|
|
if (current=='M')
|
|
current='L'
|
|
|
|
}
|
|
}
|
|
|
|
dim(y)=c(2,length(y)/2)
|
|
y=t(y)
|
|
operations = y[,1]
|
|
positions = do.call(rbind,strsplit(y[,2],","))
|
|
positions = apply(positions,2,as.numeric)
|
|
|
|
positions = data.frame(operations,x=positions[,1],y=positions[,2])
|
|
|
|
|
|
relatives = positions$operations == tolower(positions$operations)
|
|
operations=toupper(operations)
|
|
|
|
current.x=0
|
|
current.y=0
|
|
|
|
n = dim(positions)[1]
|
|
|
|
absolute.x=c()
|
|
absolute.y=c()
|
|
|
|
remains=0
|
|
|
|
for (i in 1:n) {
|
|
|
|
if (remains==0) {
|
|
if (operations[i]=='C')
|
|
remains=3
|
|
else
|
|
remains=1
|
|
}
|
|
if (relatives[i]) {
|
|
new.x = current.x + positions$x[i]
|
|
new.y = current.y + positions$y[i]
|
|
}
|
|
else {
|
|
new.x = positions$x[i]
|
|
new.y = positions$y[i]
|
|
}
|
|
|
|
absolute.x = c(absolute.x,new.x)
|
|
absolute.y = c(absolute.y,new.y)
|
|
|
|
remains=remains-1
|
|
|
|
if (remains==0) {
|
|
current.x=new.x
|
|
current.y=new.y
|
|
}
|
|
|
|
}
|
|
|
|
c = (1:length(operations))[operations=='C']
|
|
|
|
if (length(c)>0){
|
|
p0=c[0:(length(c)/3-1)*3+1]
|
|
operations[p0+1]="X"
|
|
operations[p0+2]="X"
|
|
}
|
|
|
|
allpath.x=list()
|
|
allpath.y=list()
|
|
path.x = c()
|
|
path.y = c()
|
|
for (i in 1:length(operations)) {
|
|
if (operations[i]=='M' & length(path.x)>0) {
|
|
allpath.x[[length(allpath.x)+1]]=path.x
|
|
allpath.y[[length(allpath.y)+1]]=path.y
|
|
path.x = c()
|
|
path.y = c()
|
|
}
|
|
|
|
|
|
if (operations[i]=='M' | operations[i]=='L') {
|
|
path.x = append(path.x,absolute.x[i])
|
|
path.y = append(path.y,absolute.y[i])
|
|
}
|
|
if (operations[i]=='C') {
|
|
b = bezier3((0:10)/10,c(absolute.x[i-1],absolute.y[i-1]),
|
|
c(absolute.x[i],absolute.y[i]),
|
|
c(absolute.x[i+1],absolute.y[i+1]),
|
|
c(absolute.x[i+2],absolute.y[i+2]))
|
|
path.x = c(path.x,b[-1,1])
|
|
path.y = c(path.y,b[-1,2])
|
|
}
|
|
}
|
|
|
|
allpath.x[[length(allpath.x)+1]]=path.x
|
|
allpath.y[[length(allpath.y)+1]]=path.y
|
|
|
|
allpath.y=lapply(allpath.y,"-")
|
|
|
|
|
|
if (scalex) {
|
|
xmin = lmin(allpath.x)
|
|
sx=lmax(allpath.x)-xmin
|
|
allpath.x=lapply(allpath.x,function(x) (x-xmin)/sx)
|
|
}
|
|
else
|
|
allpath.x=lapply(allpath.x,function(x) x/100)
|
|
|
|
if (scaley) {
|
|
ymin = lmin(allpath.y)
|
|
sy=lmax(allpath.y)-ymin
|
|
allpath.y=lapply(allpath.y,function(x) (x-ymin)/sy)
|
|
}
|
|
else
|
|
allpath.y=lapply(allpath.y,function(x) x/100)
|
|
|
|
o = order(-sapply(allpath.x,length))
|
|
|
|
return(list(x=allpath.x[o],y=allpath.y[o]))
|
|
}
|
|
|
|
#' Draw an empy plot without axis
|
|
#'
|
|
#' The \code{whitepaper} function open a new plot of the given size where
|
|
#' you can add graphical elements. Coordinates on this plot range from
|
|
#' 0 to \code{width} and 0 to \code{height}.
|
|
#'
|
|
#' @param width a numeric value indicating the plot width
|
|
#'
|
|
#' @param height a numeric value indicating the plot height
|
|
#'
|
|
#' @examples
|
|
#'
|
|
#' # open a new empty plot
|
|
#' whitepaper(20,10)
|
|
#'
|
|
#' # add two point on this plot
|
|
#' points(c(10,15),c(3,8))
|
|
#'
|
|
#' @author Eric Coissac
|
|
#'
|
|
#' @export
|
|
whitepaper= function(width,height,xmin=0,ymin=0,asp=NA) {
|
|
plot(c(xmin,xmin+width),c(ymin,ymin+height),
|
|
xlab="",
|
|
ylab="",xaxt="n",yaxt="n",type="n",asp=asp)
|
|
}
|
|
|
|
|
|
#
|
|
# We just prepare the polygon coordinates for all the 16 DNA letters
|
|
#
|
|
|
|
letter.polygons = list(A=path.to.polygon(svg.A.path),
|
|
C=path.to.polygon(svg.C.path),
|
|
G=path.to.polygon(svg.G.path),
|
|
T=path.to.polygon(svg.T.path),
|
|
R=path.to.polygon(svg.R.path),
|
|
Y=path.to.polygon(svg.Y.path),
|
|
M=path.to.polygon(svg.M.path),
|
|
K=path.to.polygon(svg.K.path),
|
|
W=path.to.polygon(svg.W.path),
|
|
S=path.to.polygon(svg.S.path),
|
|
B=path.to.polygon(svg.B.path),
|
|
D=path.to.polygon(svg.D.path),
|
|
H=path.to.polygon(svg.H.path),
|
|
V=path.to.polygon(svg.V.path),
|
|
N=path.to.polygon(svg.N.path),
|
|
dash=path.to.polygon(svg.dash.path,scaley=FALSE)
|
|
)
|
|
|
|
|
|
#' Draw a single DNA letter on a plot
|
|
#'
|
|
#' The function \code{plotDNAletter} draws a single DNA letter on an existing
|
|
#' plot. The alphabet is restricted to the IUPAC DNA characters plus the dash
|
|
#' '-' allowing to indicate gaps.
|
|
#'
|
|
#' @param x an value indicating the x coordinate for locating the letter
|
|
#' on the plot.
|
|
#'
|
|
#' @param y an value indicating the y coordinate for locating the letter
|
|
#' on the plot.
|
|
#'
|
|
#' @param cex the X character expension factor. By default a letter width is of
|
|
#' one unit in the user coordinate system.
|
|
#'
|
|
#' @param cey the Y character expension factor. By default a letter height is of
|
|
#' one unit in the user coordinate system.
|
|
#'
|
|
#' @param col the color used to fill the letter.
|
|
#'
|
|
#' @param background the background color of the letter.
|
|
#'
|
|
#' @param border the color of the border of the letter.
|
|
#'
|
|
#' @examples
|
|
#'
|
|
#' # open an empty plot
|
|
#' whitepaper(10,10)
|
|
#'
|
|
#' # plot some DNA letters
|
|
#' plotDNAletter(5,5,'A',col='green')
|
|
#' plotDNAletter(7,6,'C',cex=2,cey=1.5,col='blue')
|
|
#' plotDNAletter(2,3,'-')
|
|
#' plotDNAletter(2,7,'A',col='green',background="yellow",border="black")
|
|
#'
|
|
#' @seealso \code{\link{whitepaper}}
|
|
#' @author Eric Coissac
|
|
#' @export
|
|
plotDNAletter = function(x,y,c,cex=1,cey=1,col="black",background="white",border=col) {
|
|
if (cex > 0 & cey > 0){
|
|
if (c=="-")
|
|
p=letter.polygons[['dash']]
|
|
else
|
|
p=letter.polygons[[c]]
|
|
|
|
px = lapply(p$x,function(a) a*cex+x)
|
|
py = lapply(p$y,function(a) a*cey+y)
|
|
color=c(col,rep(background,length(px)-1))
|
|
border=c(border,rep(background,length(px)-1))
|
|
polygon(c(x,x,x+cex,x+cex),c(y,y+cey,y+cey,y),col=background,border=background)
|
|
mapply(polygon,px,py,col=color,border=border)
|
|
}
|
|
}
|
|
|
|
#' Draw a DNA logo on a graph
|
|
#'
|
|
#' The function \code{dnalogo} draws a DNA logo on an already existing plot.
|
|
#'
|
|
#' @param data a matrix where each line represents a symbol and each column
|
|
#' represents a position. The values stored in the matrice indicate
|
|
#' the relative weight of a symbol at the considered position.
|
|
#'
|
|
#' @param x an value indicating the x coordinate for locating the logo
|
|
#' on the plot.
|
|
#'
|
|
#' @param y an value indicating the y coordinate for locating the logo
|
|
#' on the plot.
|
|
#'
|
|
#' @param width a value indicating the total width of the logo
|
|
#'
|
|
#' @param height a value indicating the total height of the logo
|
|
#'
|
|
#' @param col a named character vector (e.g \code{(A="purple",T="yellow")})
|
|
#' or a matrix of the same size than data indicating the color
|
|
#' for each letter.
|
|
#'
|
|
#' @param cex a float between 0 and 1 indicating the relative width
|
|
#' of a letter column.
|
|
#'
|
|
#'
|
|
#' @examples
|
|
#' # Load the sample ecoPCR data file
|
|
#' data(GH.ecopcr)
|
|
#'
|
|
#' # create a blank plot
|
|
#' whitepaper(25,10)
|
|
#'
|
|
#' # computes the logo shape with the shanon formula
|
|
#' G.shanon = ecopcr.forward.shanon(GH.ecopcr)
|
|
#'
|
|
#' # plot the logo
|
|
#' dnalogo(G.shanon,2,6,width=20,height=2)
|
|
#'
|
|
#' # computes the logo shape with the shanon formula
|
|
#' # by grouping matches according to their mismatches
|
|
#' G.shanon.error = ecopcr.forward.shanon(GH.ecopcr,
|
|
#' group=GH.ecopcr$forward_mismatch>=1)
|
|
#'
|
|
#' # Display the structure
|
|
#' G.shanon.error
|
|
#'
|
|
#' # Plot the logo corresponding only to matches with errors
|
|
#' dnalogo(G.shanon.error$'TRUE',2,3,width=20,height=2)
|
|
#'
|
|
#' @seealso \code{\link{dnalogoplot}}
|
|
#' @author Eric Coissac
|
|
#' @keywords metabarcodes
|
|
#'
|
|
#' @export
|
|
dnalogo = function(data,x=0,y=0,width=NULL,height=NULL,col=NULL,cex=0.8)
|
|
{
|
|
computey = function(p) {
|
|
o = draworder[,p]
|
|
x = c(0,cumsum(data[o,p])[2:length(o) - 1])
|
|
names(x)=letters[o]
|
|
return(x[letters])
|
|
}
|
|
|
|
ddata = dim(data)
|
|
ncol = ddata[2]
|
|
nrow = ddata[1]
|
|
letters = row.names(data)
|
|
|
|
|
|
if (is.character(col) | is.null(col)) {
|
|
dnacol = c(A='green',C='blue',G='orange',T='red')
|
|
name.color = names(col)
|
|
dnacol[name.color]=col
|
|
dnacol=dnacol[letters]
|
|
dnacol=sapply(dnacol,function(x) do.call(rgb,as.list(col2rgb(x)/255)))
|
|
dnacol=matrix(rep(dnacol,ncol),nrow=nrow)
|
|
}
|
|
|
|
draworder = apply(data,2,order)
|
|
ypos = sapply(1:ncol,computey)
|
|
xpos = matrix(rep(1:ncol,rep(nrow,ncol)),nrow=4) - 0.5
|
|
|
|
|
|
if (! is.null(width)) {
|
|
actualwidth = ncol + 1
|
|
xpos = xpos / actualwidth * width
|
|
cex = cex / actualwidth * width
|
|
}
|
|
|
|
if (! is.null(height)) {
|
|
actualheight= max(colSums(data))
|
|
ypos = ypos / actualheight * height
|
|
data = data / actualheight * height
|
|
}
|
|
|
|
if (! is.null(x))
|
|
xpos = xpos + x
|
|
|
|
if (! is.null(y))
|
|
ypos = ypos + y
|
|
|
|
hide = mapply(plotDNAletter,
|
|
as.vector(xpos),as.vector(ypos),
|
|
rep(letters,ncol),
|
|
cex,as.vector(data),
|
|
as.vector(dnacol))
|
|
}
|
|
|
|
#' Plot a DNA logo
|
|
#'
|
|
#' The function \code{dnalogoplot} draws a DNA logo.
|
|
#'
|
|
#' @param data a matrix where each line represents a symbol and each column
|
|
#' represents a position. The values stored in the matrice indicate
|
|
#' the relative weight of a symbol at the considered position.
|
|
#'
|
|
#' @param col a named character vector (e.g \code{(A="purple",T="yellow")})
|
|
#' or a matrix of the same size than data indicating the color
|
|
#' for each letter.
|
|
#'
|
|
#' @param primer the primer sequence. THe letters will be used to label the
|
|
#' X axis.
|
|
#'
|
|
#' @param xlab X axis label using font and character expansion
|
|
#' par("font.lab") and color par("col.lab")
|
|
#'
|
|
#' @param ylab Y axis label, same font attributes as xlab.
|
|
#'
|
|
#' @param main The main title (on top) using font and size (character expansion)
|
|
#' \code{par("font.main")} and color \code{par("col.main")}.
|
|
#'
|
|
#' @param sub Sub-title (at bottom) using font and size \code{par("font.sub")}
|
|
#' and color \code{par("col.sub")}.
|
|
#'
|
|
#' @param line specifying a value for line overrides the default placement of
|
|
#' labels, and places them this many lines outwards
|
|
#' from the plot edge.
|
|
#'
|
|
#' @param outer a logical value. If \code{TRUE}, the titles are placed in the outer
|
|
#' margins of the plot.
|
|
#'
|
|
#' @param cex a float between 0 and 1 indicating the relative width
|
|
#' of a letter column.
|
|
#'
|
|
#' @param cex.primer a float between 0 and 1 indicating the size
|
|
#' of the primer axis.
|
|
#'
|
|
#' @examples
|
|
#' # Load the sample ecoPCR data file
|
|
#' data(GH.ecopcr)
|
|
#'
|
|
#' # computes the logo shape with the shanon formula
|
|
#' G.shanon = ecopcr.forward.shanon(GH.ecopcr)
|
|
#'
|
|
#' par(mfrow=c(2,1))
|
|
#'
|
|
#' # plot the logo
|
|
#' dnalogoplot(G.shanon,primer="GGGCAATCCTGAGCCAA",
|
|
#' xlab="Primer H",ylab='bits',
|
|
#' main="Primer conservation")
|
|
#'
|
|
#' # computes the logo shape with the shanon formula
|
|
#' # by grouping matches according to their mismatches
|
|
#' G.shanon.error = ecopcr.forward.shanon(GH.ecopcr,
|
|
#' group=GH.ecopcr$forward_mismatch>=1)
|
|
#'
|
|
#' # Display the structure
|
|
#' G.shanon.error
|
|
#'
|
|
#' # Plot the logo corresponding only to matches with errors
|
|
#' dnalogoplot(G.shanon.error$'TRUE',ylab='bits')
|
|
#'
|
|
#' @seealso \code{\link{dnalogo}}
|
|
#' @author Eric Coissac
|
|
#' @keywords metabarcodes
|
|
#'
|
|
#' @export
|
|
dnalogoplot = function(data,col=NULL,primer=NULL,cex=0.8,cex.lab=1.0,xlab=NULL,ylab=NULL,main=NULL,sub=NULL,line=NA,outer=FALSE) {
|
|
ddata = dim(data)
|
|
ncol = ddata[2]
|
|
nrow = ddata[1]
|
|
actualwidth = ncol + 1
|
|
actualheight= max(colSums(data))
|
|
|
|
whitepaper(actualwidth,actualheight)
|
|
if (is.null(primer))
|
|
labels= TRUE
|
|
else
|
|
labels = strsplit(primer,"")[[1]]
|
|
axis(1,at=1:ncol,labels=labels,cex.axis=cex.lab)
|
|
axis(2)
|
|
title(main=main,sub=sub,xlab=xlab,ylab=ylab,line=line,outer=outer)
|
|
dnalogo(data,col=col,cex=cex)
|
|
}
|
|
|
|
|