enter image description here
I use 'openImage' package to import multiple images,
#this sets the directory
list\<- list.files("C://Users//Bilal//Desktop//test//bb", all.files
= FALSE,full.names = TRUE)
#this loop to import the images
df<-data.frame()
#df <-list()
for (i in seq_along(lista)) {
pic<-readImage(lista[i])
pic<-rgb_2gray(pic)
pic<-resizeImage(pic, width = 48, height = 64)
pic<-as.vector(pic)
pre_pic<-t(pic)
df<-rbind(df,pre_pic)}
#this code is used to open the image but the second line does not work
#Error in image.default(df, xaxt = "n", yaxt = "n", col = grayscale) :
#'z' must be a matrix
grayscale <- gray(seq(0, 1, length = 100))
image(df[,,1], xaxt='n', yaxt='n', col=grayscale)
This is what I expect to see
I understand now what's happening; thanks for sharing the image. First- you were/are using grDevices::image() <- the base R function.
The error tells you that R can't determine how you shaped your data. When you flattened the matrix into a vector, you knew it was 48 x 64, but that information wasn't there when you sent it to image.
You could do either one of the following:
# before making it a vector
image(t(p3), col = grayscale, yaxt = 'n', xaxt = 'n')
# after making it a row in a data frame
image(t(matrix(unlist(df[1,]), ncol = 64, nrow = 48)),
col = grayscale, yaxt = 'n', xaxt = 'n')
Related
I have a script that defines 4 variables and finally yields a graphic representation of them.
Each time I run the script, the representation is different.
I would like to add a line of code so that each representation is saved as a png file (or jpg) and will not be overwritten by the next image from the following iteration.
Thanks for any advice.
Code:
f1=jitter(sample(c(2,3),1));
f2=jitter(sample(c(2,3),1));
f3=jitter(sample(c(2,3),1));
f4=jitter(sample(c(2,3),1));
d1=runif(1,0,1e-02);
d2=runif(1,0,1e-02);
d3=runif(1,0,1e-02);
d4=runif(1,0,1e-02)
p1=runif(1,0,pi);
p2=runif(1,0,pi);
p3=runif(1,0,pi);
p4=runif(1,0,pi);
xt = function(t) exp(-d1*t)*sin(t*f1+p1)+exp(-d2*t)*sin(t*f2+p2)
yt = function(t) exp(-d3*t)*sin(t*f3+p3)+exp(-d4*t)*sin(t*f4+p4)
t=seq(1, 100, by=0.001)
dat=data.frame(t=t, x=xt(t), y=yt(t))
with(dat, plot(x,y, type="l", xlim =c(-2,2), ylim =c(-2,2), xlab = "", ylab = "", xaxt='n', yaxt='n'))
Here is an attempt to answer your question. I tested your code and at least it works on Ubuntu 18.04.
# your code up
# create the file
png(filename = "test.png", width = 480, height = 480, units = "px", pointsize = 12, bg = "white", res = NA, type = c("cairo", "cairo-png", "Xlib", "quartz"))
# plot
with(dat, plot(x,y, type="l", xlim =c(-2,2), ylim =c(-2,2), xlab = "", ylab = "", xaxt='n', yaxt='n'))
# close the file
dev.off()
I am wondering if it is possible to extract out the main hex colors from image files containing team sports logos. I have the following vector of logos:
dput(team.logos[1:5))
c("https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/399.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/2066.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/42.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/311.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/160.png")
Using the following website (https://html-color-codes.info/colors-from-image/) - I am able to see that the hex color values in the first image (UAlbany) are #FEBE10 for yellow, and #3F1E6B for the purple, as well as white.
My question is - is there any way to scrape these hex values for each image in my vector in R (so I don't have to manually load each image and click to find each hex value).
Thanks!
Another option using the imager package...
require('imager')
require('data.table')
team.logos <- c("https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/399.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/2066.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/42.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/311.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/160.png")
#this function takes an image in imager's cimg format and
#returns the hex colour codes for any colours covering more than
#a threshold proportion of pixels (default is set to 0.05)
getHexPrimaries <- function(img, pcnt.threshold = 0.05){
#convert cimg to workable format
channel.labels <- c('R','G','B','A')[1:dim(img)[4]]
img <- as.data.table(as.data.frame(img))
img[,channel := factor(cc ,labels=channel.labels)]
img <- dcast(img, x+y ~ channel, value.var = "value")
#sort by unique rgb combinations and identify the primary colours
colours.sorted <- img[, .N, by=list(R,G,B)][order(-N)]
colours.sorted[ , primary := N/sum(N) > pcnt.threshold]
#convert to hex
hex.primaries <-
apply(colours.sorted[primary==TRUE], 1, function(row){
hex <- rgb(row[1], row[2], row[3], maxColorValue=1)
hex
})
hex.primaries
}
hex.list <- lapply(team.logos, function(logo.url) {
download.file(logo.url,'temp.png', mode = 'wb')
img <- load.image('temp.png')
getHexPrimaries(img)
})
Give this a try. The png library allows one to load a RGB file and then it is a matter of converting the three channels into the Hex codes.
I confirmed the codes are correct for the first image, good luck with the rest.
logos<-c("https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/399.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/2066.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/42.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/311.png",
"https://a.espncdn.com/combiner/i?img=/i/teamlogos/ncaa/500/160.png")
plot(NA, xlim = c(0, 2), ylim = c(0, 5), type = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
library(png)
for (filen in seq_along(logos)) {
#download and read file
#this will overwrite the file each time,
#create a list if you would like to save the files for the future.
download.file(logos[filen], "file1.png")
image1<-readPNG("file1.png")
#plot if desired
#plot(NA, xlim = c(0, 2), ylim = c(0, 5), type = "n", xaxt = "n", yaxt = "n", xlab = "", ylab = "")
rasterImage(image1, 0, filen-1, 1, filen)
#convert the rgb channels to Hex
outR<-as.hexmode(as.integer(image1[,,1]*255))
outG<-as.hexmode(as.integer(image1[,,2]*255))
outB<-as.hexmode(as.integer(image1[,,3]*255))
#paste into to hex value
hex<-paste0(outR, outG, outB)
#remove the white and black
hex<-hex[hex != "ffffff" & hex != "000000"]
#print top 5 colors
print(head(sort(table(hex), decreasing = TRUE)))
}
Here is the sample output, the hex color with the number of pixels with that color.
print(head(sort(table(hex), decreasing = TRUE)))
#hex
#c3c4c6 00275d 00265c c2c3c5 001e57 00255c
#67929 39781 838 744 649 633
I have SSIS package that gets data into database and then executes R Script. R script creates new folder (names it based on the current date) and generate some pdf files into this folder. I have deployed this package on server and created Job that executes it every night. The problem is that each morning I am finding only empty folders (with correct date name) without any pdf files. However, If I execute that package manually in Visual Studio it works fine and pdfs are there. Am I missing something here? I appreciate every answer.
EDIT
When I execute manually it is directly on the server
Package looks like this
and here is my R script
dir.create(file.path(output.path, date))
library(RODBC)
conn <- odbcConnect("Azure", uid = "aaaaa", pwd = "aaaaa")
etldata <- sqlFetch(conn,"dbo.EtlLogsData", stringsAsFactors = FALSE)
pdf(paste('ETL_Duration_For_Effective_Date_', date,'.pdf',sep = ""),
width = 12,
height = 8,
paper = 'special')
par(mar = c(5, 17, 5, 3))
plot(c(min(etldata_day$st_sec), max(etldata_day$et_sec)),
c(sn[1], sn[1]),
ylim = c(0, n),
yaxt = 'n',
xaxt = 'n',
ylab = '',
xlab = 'Time',
main = paste('ETL Duration With Effective Date ', date, sep = ""))
abline(h = sn, untf = FALSE, col = "gray90")
for (i in 1:n){
lines(c(etldata_day$st_sec[i], etldata_day$et_sec[i]),
c(sn[i], sn[i]),
type = "l", lwd = 2)
arrows(etldata_day$st_sec[i], sn[i],
etldata_day$et_sec[i], sn[i],
length = 0.025, angle = 90, lwd = 2)
arrows(etldata_day$et_sec[i], sn[i],
etldata_day$st_sec[i], sn[i],
length = 0.025, angle = 90, lwd = 2)
}
# Print y axis labels
axis(2, at = sn, labels = etldata_day$TaskName, las = 1, cex.axis = 1)
# Print x axis labels
xat <- seq(from = min(etldata_day$st_sec), to = max(etldata_day$et_sec), length.out = 10)
xlabels <- secondsToString(xat)
axis(1, at = xat, labels = substr(xlabels,1,8), cex.axis = 1)
dev.off()
After plot() I use some FOR cycles, and LINES(),
I am plotting a time series with the timePlot function of the open air package of R. The graph has grey grid lines in the background that I would like to turn off but I do not find a way to do it. I would expect something simple such as grid = FALSE, but that is not the case. It appears to be rather complex, requiring the use of extra arguments which are passed to xyplot of the library lattice. I believe the answer lies some where in the par.settings function but all attempts have failed. Does anyone have any suggestions to this issue?
Here is by script:
timeozone <- import(i, date="date", date.format = "%m/%d/%Y", header=TRUE, na.strings="")
ROMO = timePlot(timeozone, pollutant = c("C7", "C9", "C10"), group = TRUE, stack = FALSE,y.relation = "same", date.breaks = 9, lty = c(1,2,3), lwd = c(2, 3, 3), fontsize = 15, cols = c("black", "black"), ylab = "Ozone (ppbv)")
panel = function(x, y) {
panel.grid(h = 0, v = 0)
panel.xyplot(x,y)
}
I have this plot which i generate it from this code:
m <- bcea(e=effects,c=costs, ref=2, interventions=treatments, Kmax=50000)
The plot is:
evi.plot(m)
Now, i need to export this evpi.plot(m) in an excel file, not the jpeg created, but the data along with it, i mean what created the X and Y axis.
I've been using something like this but it's not for this case
write.table( thresholds, 'clipboard', sep='\t', row.names=FALSE, col.names=FALSE )
In the documentation for function bcea from package BCEA you can see the structure of your object:
Value
An object of the class "bcea" containing the following elements
n.sim Number of simulations produced by the Bayesian model
n.comparators Number of interventions being analysed
...
k
The vector of values for the grid approximation of the willingness to pay
...
evi The vector of values for the Expected Value of Information, as a
function of the willingness to pay
And if you look at the function definition of evi.plot you will see that your x and y-values are the elements named k and evi:
> evi.plot
function (he)
{
options(scipen = 10)
plot(he$k, he$evi, t = "l", xlab = "Willingness to pay",
ylab = "EVPI", main = "Expected Value of Information")
if (length(he$kstar) > 0) {
points(rep(he$kstar, 3), c(-10000, he$evi[he$k == he$kstar]/2,
he$evi[he$k == he$kstar]), t = "l", lty = 2, col = "dark grey")
points(c(-10000, he$kstar/2, he$kstar), rep(he$evi[he$k ==
he$kstar], 3), t = "l", lty = 2, col = "dark grey")
}
}
<environment: namespace:BCEA>
So:
res <- cbind(m$k, m$evi)
write.table(res, file="bcea.csv", sep=',', row.names=FALSE, col.names=FALSE )