I wanted to do some simple image comparisons with R (the reason I am not using python is that the workflow is in R). I tried to search for ms-ssim implementations in packages in R, but did find any except for spatialcompare::msssim. However, as I mentioned in my post yesterday, I figured out that the result of this function might not be correct for my input (could be related to matrix to raster transformation?). Are there any more suggestions for appropriate ms-ssim codes? I actually self-implemented one based on SpatialPack::SSIM because it seems easy to just downsample the image again and again, but am not sure if I am writing it correctly. I'll put it as an answer.
My demo code for a very simple ms-ssim:
calcMSSSIM<-function(Mat1,Mat2){
weight = c(0.0448, 0.2856, 0.3001, 0.2363, 0.1333)
level<-5
array<-c()
ssim<-SpatialPack::SSIM(Mat1, Mat2, alpha=1, beta=1, gamma=1,
eps=c(0.01,0.03), L=max(tmp1,tmp2))$SSIM
array[1]<-ssim$comps["contrast"]*ssim$comps["structure"]
result<-abs(array[1])^weight[1]
for (i in 2:level) {
tmp1 <- EBImage::resize(tmp1, w=dim(tmp1)[1]/2, filter="none")
tmp2 <- EBImage::resize(tmp2, w=dim(tmp2)[1]/2, filter="none")
ssim <- SpatialPack::SSIM(tmp1,tmp2,alpha=1, beta=1, gamma=1,
eps=c(0.01,0.03), L=max(tmp1,tmp2))$SSIM
array[i]<-ssim$comps["contrast"]*ssim$comps["structure"]
result <- result*abs(array[i])^weight[i]
}
lum<-ssim$comps["luminance"]
result<-result*lum^weight[i]
return(list(array,result))
}
Is it correct?
Related
I have been learning how to code in R recently, so I'm not familiarized with apply at all. As far as I know loops are not so efficient in R, so I'm trying to use apply function but I'm not getting any results.
This is my loop:
encoder_output <- function(sequence, vocabulary){
auxlist <- list()
for (i in sequence) {
encoded <- to_categorical(i, num_classes=vocabulary)
auxlist <- append(auxlist, encoded)
}
arrOutput <- array(unlist(auxlist),dim =c(nrow(sequence),ncol(sequence),vocabulary))
return(arrOutput)
}
And here is my apply:
encode_output <- function(sequence, vocabulary){
auxlist <- list()
apply(sequence, 1,function(x){
encoded <- to_categorical(x, num_classes=vocabulary)
auxlist <- append(auxlist, encoded)
})
array <- array(unlist(auxlist), dim= c(nrow(sequence),ncol(sequence),vocabulary) )
return(array)
}
But in my apply function, I'm getting an error in unlist, because it says that auxlist is empty.
I don't know what I'm doing wrong. Btw, sequence is a 2D matrix. I believe that this code is enough to solve my question, but if necessary I will update it with more code.
Thanks guys!
PS: I'm using keras library to user to_categorical.
Ah. This is the classic coding environment issue. The return function will only give you a result within the code, but not show up in your environment. So try this:
assign(New_array_Name,array = df,.GlobalEnv)
Another way to do it is to have it as an output to assign it to another 'external' variable. In this case, remove return(arrOutput), replace it with arrOutput. And, in the console or wherever you run your code, use the following line.
variable <- encoder_output(...)
I'm struggling to clearly explain this problem.
Essentially, something has seemed to have happened within the R environment and none of the code I write inside my functions are working and not data is being saved. If I type a command line directly into the console it works (i.e. Monkey <- 0), but if I type it within a function, it doesn't store it when I run the function.
It could be I'm missing a glaring error in the code, but I noticed the problem when I accidentally clicked on the debugger and tried to excite out of the browser[1] prompt which appeared.
Any ideas? This is driving me nuts.
corr <- function(directory, threshold=0) {
directory <- paste(getwd(),"/",directory,"/",sep="")
file.list <- list.files(directory)
number <- 1:length(file.list)
monkey <- c()
for (i in number) {
x <- paste(directory,file.list[i],sep="")
y <- read.csv(x)
t <- sum(complete.cases(y))
if (t >= threshold) {
correl <- cor(y$sulfate, y$nitrate, use='pairwise.complete.obs')
monkey <- append(monkey,correl)}
}
#correl <- cor(newdata$sulfate, newdata$nitrate, use='pairwise.complete.obs')
#summary(correl)
}
corr('specdata', 150)
monkey```
It's a namespace issue. Functions create their own 'environment', that isn't necessarily in the global environment.
Using <- will assign in the local environment. To save an object to the global environment, use <<-
Here's some information on R environments.
I suggest you give a look at some tutorial on using functions in R.
Briefly (and sorry for my horrible explanation) objects that you define within functions will ONLY be defined within functions, unless you explicitly export them using (one of the possible approaches) the return() function.
browser() is indeed used for debugging, keeps you inside the function, and allows you accessing objects created inside the function.
In addition, to increase the probability to have useful answers, I suggest that you try to post a self-contained, working piece of code allowing quickly reproducing the issue. Here you are reading some files we have no access to.
It seems to me you have to store the output yourself when you run your script:
corr_out <- corr('specdata', 150)
I am doing java and R integration using JRI.
Please find below script
String path = "C:\\Users\\hrpatel\\Desktop\\CSVs\\DataNVOCT.csv";
rengine.eval("library(tseries)");
rengine.eval(String.format("mydata <- read.csv('%s')",path.replace('\\', '/')));
String exportFilePath= "C:\\Users\\hrpatel\\Desktop\\CSVs\\arima3.jpg";
rengine.eval("Y <- NewVisits");
rengine.eval("t <- Day.Index");
rengine.eval("summary(Y)");
rengine.eval("adf.test(Y, alternative='stationary')");
rengine.eval("adf.test(Y, alternative='stationary', k=0)");
rengine.eval("acf(Y)");
rengine.eval("pacf(Y)");
rengine.eval("mydata.arima101 <- arima(Y,order=c(1,0,1))");
rengine.eval("mydata.pred1 <- predict(mydata.arima101, n.ahead=1000)");
rengine.eval(String.format("jpeg('%s')",exportFilePath.replace('\\', '/')));
rengine.eval("plot(t,Y)");
rengine.eval("lines(mydata.pred1$pred, col='blue',size=10)");
rengine.eval("lines(mydata.pred1$pred+1*mydata.pred1$se, col='red')");
rengine.eval("lines(mydata.pred1$pred-1*mydata.pred1$se, col='red')");
rengine.eval("dev.off()");
In above codebase when i tried plot(t,Y) or plot(Y). it export a blank image, while in case of plot(mydata) it is working file.
One more thing when i run above code in R it creates the image(using JRI it shows blank image).
I have spend 1 day to solve this but i dont found any solution.
Please suggest if you have any alternatives.
Your help is needed.
Thanks in Advance
if i understand correctly, you have a data set named mydata, that has two columns, NewVisits, and Day.Index, in that case you need to change:
rengine.eval("Y <- NewVisits");
to
rengine.eval("Y <- mydata$NewVisits");
and
rengine.eval("t <- Day.Index");
to
rengine.eval("t <- mydata$Day.Index");
This also explains why plot(mydata) works for you - because R recognizes it.
if this isn't the solution, then i cant see where you are reading NewVisits and Day.Index from
BTW i stongly recommend to plot using the ggplot package
I like to pop out results in a window so that they're easier to see and find (e.g., they don't get lost as the console continues to scroll). One way to do this is to use sink() and file.show(). For example:
y <- rnorm(100); x <- rnorm(100); mod <- lm(y~x)
sink("tempSink", type="output")
summary(mod)
sink()
file.show("tempSink", delete.file=T, title="Model summary")
I commonly do this to examine model fits, as above, but also for a wide variety of other functions and objects, such as: summary(data.frame), anova(model1, model2), table(factor1, factor2). These are common, but other situations can arise as well. The point here is that both the nature of the function and the object can vary.
It is somewhat tedious to type out all of the above every time. I would like to write a simpler function that I can call, something like the following would be nice:
sinkShow <- function(obj, fun, title="output") {
sink("tempSink", type="output")
apply(obj, ?, fun)
sink()
file.show("tempSink", delete.file=T, title=title)
}
Clearly, this doesn't work. There are several issues. First, how would you do this so that it won't crash with the wrong type of object or function without having to have a list of conditional executions (i.e., if(is.list(obj) { lapply...). Second, I'm not sure how to handle the margin argument. Lastly, this doesn't work even when I try simple, contrived examples where I know that everything is set appropriately, so there seems to be something fundamentally wrong.
Does anyone know how such a situation can be handled simply and easily? I'm not new to R, but I've never been formally taught it; I've picked up tricks in an ad-hoc manner, i.e., I'm not a very sophisticated R programmer. Thanks.
Rather than use apply I think you want do.call. Make sure to wrap it in a print since it is inside of a function.
Here is one possible implementation:
sinkShow <- function( obj, fun, title='Output', ...) {
file <- tempfile()
args <- c(list(obj),list(...))
capture.output( do.call( fun, args ), file=file )
file.show(file, delete.file=TRUE, title=title)
}
Though it should probably be renamed since I skipped using sink as well. I might modify this a bit and put it into the TeachingDemos package.
Use page. Here's some sample models:
d <- data.frame(y1=rnorm(100), y2=rnorm(100), x=rnorm(100))
mod <- lm(y1~x, data=d)
mods <- list(mod1=lm(y1~x, data=d), mod2=lm(y2~x, data=d))
And here's how you'd use page:
page(summary(mod), method="print")
page(lapply(mods, summary), method="print")
For my original post, which had code that turned out to be a near-reimplementation of page, see the edit history.
Is there an easy way to read the value of the cells rather than the formula?
By the way I only get this problem in a spreadsheet that I have published but not in spreadsheets that are private.
So for instance in a cell whose value was created by simply using the value from the cell immediately to the left in the Google spreadsheet I would prefer to get the value rather than =RC[-1]
When one exports with Google Spreadsheets as a csv then that does not happen.
I am using the following line of code in R
y2009<-sheetAsMatrix(ts2$y2009,header=TRUE, as.data.frame=TRUE, trim=TRUE)
If you haven't stumbled upon this webpage, it looks useful (I haven't tried it myself...)
http://blog.revolutionanalytics.com/2009/09/how-to-use-a-google-spreadsheet-as-data-in-r.html
It looks like the package that used to be used (RGoogleData) is currently being maintained.
Good Luck!
Not a clever solution, but evaluating the formula does work. For example with the following function:
getValues <- function(x) {
m <- apply(x, 2, function(x) as.character(x))
for (i in 1:nrow(m)) {
formulas <- which(substr(m[i,], 1, 4) == "=RC[")
t <- sub('=RC[', '', m[i, formulas], fixed=TRUE)
t <- sub(']', '', t, fixed=TRUE)
t <- as.numeric(t)
m[i, formulas] <- m[i, (formulas + t)]
}
return(m)
}
getValues(y2009) should return a data frame with all required values. I know this is a quite dumb "solution" with lot of compromises but I hope you could code a lot cleaner function for the task! :)
The original question was written 2009-09. At the time I was using RGoogleDocs to read google spreadsheets. In the last few months I discovered an actively created and maintained package called "googlesheets: Manage Google Spreadsheets from R" by Jennifer Bryan and Joanna Zhao in British Columbia, Canada. At first it was only on GitHub and now it is in the Cran repository. It works well. It is good for reading and writing. It does not expose one's google password. All problems that I previously had in RGoogleDocs have been made irrelevant by googlesheets.