ggplot2 not saving geom_raster() plots correctly - r

I plotting a 52 x 52 matrix with geom_raster through ggplot.
Code is here:
m <- NULL
for(i in 1:nrow(df)){
for(z in 1:nrow(df)){
if(df[i,][4] > df[z,][4]){m<-c(m,((df[i,][[4]]/df[z,][[4]])*100)-100)}
if(df[i,][4] < df[z,][4]){m<-c(m,((df[z,][[4]]/df[i,][[4]])*100)-100)}
if(df[i,][4] == df[z,][4]){m<-c(m,0.0)}}}
m <- matrix(m,nrow=nrow(df))
colnames(m) <- df$PDB
rownames(m) <- df$PDB
p1 <- ggplot(melt(m),aes(Var1,Var2,fill=value)) + geom_raster() + labs(x="PDB",y="PDB")
p1 <- p1 + theme(axis.text.x = element_text(angle=90,hjust=1))
print(p1)
ggsave(file="ccs_diff_ehss.pdf")
The issue I have is when I save the file I get the following outputs:
Through file > save as >:
Through ggsave:
Output from print(p1):
As you can see the out from print(p1) as a lot sharper than ggsave and manual saving. How can I save the images as outputted from print(p1)?
Here is a subsbset of my matrix:
1a29 1cll 1clm 1cm1 1exr 1g4y 1iq5 1lin 1mxe1 1mxe2
1a29 0.000000 18.8967136 19.0727700 3.814554 20.539906 19.3075117 9.330986 1.584507 5.6924883 5.8098592
1cll 18.896714 0.0000000 0.1480750 14.527982 1.382034 0.3455084 8.749329 17.042172 12.4930594 12.3682751
1clm 19.072770 0.1480750 0.0000000 14.697569 1.232134 0.1971414 8.910360 17.215482 12.6596335 12.5346644
1cm1 3.814554 14.5279819 14.6975692 0.000000 16.110797 14.9236857 5.313737 2.195263 1.8089316 1.9219898
1exr 20.539906 1.3820336 1.2321341 16.110797 0.000000 1.0329562 10.252281 18.659734 14.0477512 13.9212424
1g4y 19.307512 0.3455084 0.1971414 14.923686 1.032956 0.0000000 9.125067 17.446563 12.8817324 12.7565169
1iq5 9.330986 8.7493290 8.9103596 5.313737 10.252281 9.1250671 0.000000 7.625650 3.4425319 3.3277870
1lin 1.584507 17.0421722 17.2154824 2.195263 18.659734 17.4465627 7.625650 0.000000 4.0439053 4.1594454
1mxe1 5.692488 12.4930594 12.6596335 1.808932 14.047751 12.8817324 3.442532 4.043905 0.0000000 0.1110494
1mxe2 5.809859 12.3682751 12.5346644 1.921990 13.921242 12.7565169 3.327787 4.159445 0.1110494 0.0000000

I realize this is an older thread but it looks like it gets about 7 views a month. Perhaps this will help those visitors:
There is a chance that the image viewer application itself is applying a smoothing algorithm. I came across your post while trying to resolve the same issue and eventually discovered that I needed to turn off smoothing in the PDF viewer preferences. Now the output file looks identical to the plot in R.
This is the thread that tipped me off (includes some extra directions about where to locate the settings). https://groups.google.com/forum/#!topic/ggplot2/8VLuo1cw6SE

Take a look at the ggsave documentation -- perhaps you can increase your resolution by manually specifying the dimensions or the dpi.

Related

How to print plus-minus and beta signs in bquote, and correctly export to pdf

¿How do you print the ± sign in a bquote() expression in R?
I have tried the following:
pm
%pm%
±
These have not worked.
UPDATE #1 Here is some sample code
plot(NULL,xlim=c(0,10),ylim=c(0,10),xlab=NA,ylab=NA,xaxs="i",yaxs="i")
c <- "name"
p <- .004
n <- 969
b <- 1.23
s <- 0.45
tmp.txt <- paste(c(c," (n=",n,")\nslope = ",b,"±",s,"\n",ifelse(p==0,"p<.001",paste0("p=",p))),collapse="")
text(9.5,9.5,labels=tmp.txt,adj=c(1,1),cex=.75)
What I am trying to do is to make the 2nd line have beta (the symbol) instead of slope, and the ± symbol to appear. If I use expression, I can get the beta, but not the ±; if I just paste in ß (or something similar), it won't run.
UPDATE #2: It appears I HAVE to use bquote()...else the beta character won't print when piped out via pdf().
An answer to this question suggests using paste with bquote. You could then use the Unicode character of ±:
x <- 232323
plot(1:10, main = bquote(paste(ARL[1], " curve for ", S^2, "; x=\U00B1",.(x))))
Note that this example (minus the inclusion of \U00B1) came from fabian's answer to the previously linked question.
I appreciate the advice given, but it didn't fully accomplish my goal. Here is the workaround I came up with (and I personally think it is just short of asinine...but I'm at a loss).
c <- "name"
p <- .004
n <- 969
b <- 1.23
s <- 0.45
## draw empty plot
plot(NULL,xlim=c(0,10),ylim=c(0,10),xlab=NA,ylab=NA,xaxs="i",yaxs="i")
## place the "poor man's substitute"
tmp.txt <- paste(c(c," (n=",n,")\nslope = ",b,"±",s,"\n",ifelse(p==0,"p<.001",paste0("p=",p))),collapse="")
text(9.5,9.5,labels=tmp.txt,adj=c(1,1),cex=.75)
## place the next best option
tmp.txt <- paste(c(c," (n=",n,")\n\U03B2 = ",b,"±",s,"\n",ifelse(p==0,"p<.001",paste0("p=",p))),collapse="")
text(9.5,7.5,labels=tmp.txt,adj=c(1,1),cex=.75)
## place the two boxes to superimpose the bquote() version
tmp.txt2 <- paste(c(c," (n=",n,")\n\n",ifelse(p==0,"p<.001",paste0("p=",p))),collapse="")
text(9.5,5.5,labels=tmp.txt2,adj=c(1,0.5),cex=.75)
text(9.5,5.5,labels=bquote(beta == .(b)%+-%.(s)),adj=c(1,0.5,cex=.75))
## same as above, but piped to a *.pdf
pdf("tmp_output.pdf")
plot(NULL,xlim=c(0,10),ylim=c(0,10),xlab=NA,ylab=NA,xaxs="i",yaxs="i")
tmp.txt <- paste(c(c," (n=",n,")\nslope = ",b,"±",s,"\n",ifelse(p==0,"p<.001",paste0("p=",p))),collapse="")
text(9.5,9.5,labels=tmp.txt,adj=c(1,1),cex=.75)
tmp.txt <- paste(c(c," (n=",n,")\n\U03B2 = ",b,"±",s,"\n",ifelse(p==0,"p<.001",paste0("p=",p))),collapse="")
text(9.5,7.5,labels=tmp.txt,adj=c(1,1),cex=.75)
tmp.txt2 <- paste(c(c," (n=",n,")\n\n",ifelse(p==0,"p<.001",paste0("p=",p))),collapse="")
text(9.5,5.5,labels=tmp.txt2,adj=c(1,0.5),cex=.75)
text(9.5,5.5,labels=bquote(beta == .(b)%+-%.(s)),adj=c(1,0.5,cex=.75))
dev.off()
If you run this, it appears to work both inside of R and in the resulting *.pdf file.
As always, a more elegant (and sensible) solution would be much appreciated.

Save plot without showing it at all

Is it possible to save a plot without displaying it at all ?
I made a little ggplot hack to be able to copy graphs to powerpoint easily, it copies the plot to the clipboard, but one can see the device window open and close fast, it's a bit awkward, can I avoid this ?
I'm using windows and rstudio.
reproducible code:
library(ggplot)
`-.gg` <- function(e1,e2){
assertthat::assert_that(is.numeric(e2),
length(e2)<= 2)
if(identical(e2,0)) return(invisible(NULL))
W <- 8
H <- 4.5
dev.new(width=W * head(e2,1), height=H * tail(e2,1),noRStudioGD =TRUE)
print(e1)
savePlot("clipboard", type="wmf")
dev.off()
e1
}
ggplot(data.frame(x=1:10,y=1:10),aes(x,y)) + geom_point() - 1 - 0
Edit:
My code, and chosen solution, have issues dealing with semi-transparency.It's ok most of the time, but exceptions will be annoying.
Maybe a path to a general solution would be to save it with tempfile then read it into the clipboard, either through an appropriate R function, or with command line using system (maybe something that would open the file invisibly and copy).
This works on Windows: use the win.metafile() device. If you give no filename, it saves to the clipboard. So your function should be
library(ggplot2)
`-.gg` <- function(e1,e2){
assertthat::assert_that(is.numeric(e2),
length(e2)<= 2)
if(identical(e2,0)) return(invisible(NULL))
W <- 8
H <- 4.5
win.metafile(width=W * head(e2,1), height=H * tail(e2,1))
print(e1)
dev.off()
e1
}
ggplot(data.frame(x=1:10,y=1:10),aes(x,y)) + geom_point() - 1 - 0
On windows and R 3.4.2, using Sys.sleep was able to view the plot instead of blink and miss
`-.gg` <- function(e1,e2){
assertthat::assert_that(is.numeric(e2),
length(e2)<= 2)
if(identical(e2,0)) return(invisible(NULL))
W <- 8
H <- 4.5
dev.new(width=W * head(e2,1), height=H * tail(e2,1),noRStudioGD =TRUE)
print(e1)
savePlot("clipboard", type="wmf")
Sys.sleep(3) ##
dev.off()
e1
}
ggplot(data.frame(x=1:10,y=1:10),aes(x,y)) + geom_point() - 1 - 0

R subscript out of bounds corrected?

I generated the following data matrix called arrayDataMatrixQuantile in R:
DNp73flflV2324I DNp73flflV2324J DNp73flflV2324K DNp73nullV2523B DNp73nullV2523C DNp73nullV2523E
ENSMUSG00000028180 8.185794 5.6914560 5.693373 6.9734687 8.8689120 5.9152113
ENSMUSG00000028182 0.000000 0.1749128 0.000000 0.1685122 0.1784736 0.1229401
ENSMUSG00000028185 0.000000 0.0000000 0.000000 0.0000000 0.0000000 0.0000000
ENSMUSG00000028184 7.439927 8.8635180 10.288115 11.8621800 13.4530467 13.4414667
ENSMUSG00000028187 7.458357 10.0175407 14.108493 11.7789400 19.7581400 12.1482933
ENSMUSG00000028186 0.400568 0.1346390 3.450423 0.1643176 0.0000000 0.0000000
I want to generate log2 of each of the values and output that. The R code I wrote:
log2_matrix<-matrix( nrow(arrayDataMatrixQuantile),ncol(arrayDataMatrixQuantile)) #opens new matrix
for (i in 1:nrow(arrayDataMatrixQuantile)) {
for (j in 1:ncol(arrayDataMatrixQuantile)) {
add <- ((arrayDataMatrixQuantile[i,j])+10^-5) #Added 10-5 to avoid errors with 0 values
log2_matrix[i,j] <-add }
}
This code gives the following error:
Error in [<-(*tmp*, i, j, value = 2.50880030780749) : subscript out of bounds
However, once I change the line :
log2_matrix<-matrix( nrow(arrayDataMatrixQuantile),ncol(arrayDataMatrixQuantile))
to
log2_matrix<-matrix(0, nrow(arrayDataMatrixQuantile),ncol(arrayDataMatrixQuantile))
it works. I dont know how adding a "0" in the new matrix gets rid of the error. I used that as I saw other users adding a 0 at the start of each new matrix. Any advise on this?
We could do this either using apply
apply(arrayDataMatrixQuantile, 2, FUN=function(x) x+ 10^-5)
Or directly add the number to the entire dataset
arrayDataMatrixQuantile+10^-5
Regarding the error in the OP's code, it happened because the matrix created was not of the same dimensions as the "arrayDataMatrixQuantile"
log2_matrix<- matrix( nrow(arrayDataMatrixQuantile),
ncol(arrayDataMatrixQuantile))
The "log2_matrix" doesn't have a data argument and its dimensions are 6,1 with 6 as the value (from the nrow(...)). Instead, we need to add a , before the nrow(..) so that we get a matrix of NA with dimensions 6,6
log2_matrix <- matrix(, nrow(arrayDataMatrixQuantile),
ncol(arrayDataMatrixQuantile))

Save R plot with Mars and Venus symbols as pdf

I am trying to save plots which have female (\u2640) and male (\u2642) symbols. Here is an example to create a plot using this symbols (I am using RStudio):
gender <- rbinom(n=100, size=100, prob=0.5)
plot(gender, cex=2.5,
pch=ifelse(gender %% 2 == 0, -0x2642L, -0x2640L),
col=ifelse(gender %% 2 == 0, 2, 3), main="\u2640 and \u2642 Symbols")
It works and generates a plot with those symbols Plot. I can save it as picture (PNG) but when I try to save it as pdf all the symbols don't show up Plot.
Here is how I try to save it as pdf:
pdf("plot.pdf")
gender <- rbinom(n=100, size=100, prob=0.5)
plot(gender, cex=2.5,
pch=ifelse(gender %% 2 == 0, -0x2642L, -0x2640L),
col=ifelse(gender %% 2 == 0, 2, 3), main="\u2640 and \u2642 Symbols")
dev.off()
I saw another post about similar problem here and it was suggested to use the CairoPDF. It did not work. I tried other family settings but it did not work either. Is there any other work around to save it as pdf with those symbols or the only way it is to save it as a picture. I would prefer to save it as pdf.
After a lot of tentatives I switched to command line and use quartz. After plotting the graph I use:
quartz.save(type = 'pdf', file = 'output.pdf')
It works perfectly. Why does it not works using the first code pdf("plot.pdf") but works with quartz.save(type = 'pdf', file = 'output.pdf')? Is it something with my system?
Thank you.
On my Mac this gives a pdf with astrological symbols. (Cobbled together from a search of similar questions on SO.) I didn't make the extra effort to "wrap" the full set neatly so the "printing of the later ones doesn't show up, but you can see Mars and Venus.
cairo_pdf("Venus_Mars.pdf",family="ArialUnicodeMS")
plot(1,1)
TestUnicode <- function(start="263c", end="2653", ...)
{
nstart <- as.hexmode(start)
nend <- as.hexmode(end)
r <- nstart:nend
s <- ceiling(sqrt(length(r)))
for(i in seq(r)) {
try(points(.6+(i/10), .8 , pch=-1*r[i],...))
}
}
TestUnicode()
dev.off()

R arules, mine only rules from specific column

I would like to mine specific rhs rules. There is an example in the documentation which demonstrates that this is possible, but only for a specific case (as we see below). First an data set to illustrate my problem:
input <- matrix( c( rep(10001,6) , rep(10002,3) , rep(10003,3), 100001,100002,100003,100004,100005,100006,100002,100003,100007,100002,100003,100008,rep('a',6),rep('b',6)), ncol=3)
colnames(input) <- c(letters[1:3])
input <- as.data.frame(input)
Now i can create rules:
r <- apriori(input)
To see the rules:
inspect(r)
I would like to only mine rules that have b=... on the rhs. For specific values this can be done by adding:
appearance = list(rhs = c("b=100001", "b=100002"),default="lhs")
to the apriori command. I will also have to adjust the confidence if i want to find them ofcourse. The problem lies in the number of elements in column b. I can manualy type all the elements in the "b=....." format in this example, but I can't in my own data.
I tried to get the values of b using unique() and then giving that to the rhs, but it will generate an error because i give values like: "100001" "100002" instead of "b=100001" "b=100002".
Is there a was to only get rhs rules from a specific column?
If not, is there an easy way to generate 'want' from 'current?
current <- c("100001", "100002", "100003", "100004", "100005", "100006", "100007", "100008")
want <- c("b=100001", "b=100002", "b=100003", "b=100004", "b=100005", "b=100006", "b=100007", "b=100008")
Somewhat related is this question: Creating specific rules with arules in r
But that has the same problem for me, only a different way.
You can use subset:
r <- apriori(input, parameter = list(support = 0.1, confidence = 0.1))
inspect( subset( r, subset = rhs %pin% "b=" ) )
# lhs rhs support confidence lift
# 1 {} => {b=100002} 0.2500000 0.2500000 1.000000
# 2 {} => {b=100003} 0.2500000 0.2500000 1.000000
# 3 {c=b} => {b=100002} 0.1666667 0.3333333 1.333333
# 4 {c=b} => {b=100003} 0.1666667 0.3333333 1.333333
For you second question, you can use paste:
paste0( "b=", current )
# [1] "b=100001" "b=100002" "b=100003" "b=100004" "b=100005" "b=100006" "b=100007"
# [8] "b=100008"
The arules documentation now has an example that does exactly what you want:
bItems <- grep("^b=", itemLabels(input), value = TRUE)
rules <- apriori(input, parameter = list(support = 0.1, confidence = 0.1),
appearance = list(rhs = bItems))
I haven't actually tested this with your example code (the arules documentation example uses a transactions object, not a data.frame), but grep-ing those column labels should work out.

Resources