środa, 18 maja 2016

Excel interfacing R via RScript. (draft)

I played a bit, building a trifle application in Excel using R to explore weather data. My purpose was to make the code portable, with relative links - all files in one folder.

Here is my excel VBA code for exchanging data with R. It starts an R script and then reads back a txt file with numerical results and three plots as svg images.


Sub RunRscript2()
Dim shell As Object: Set shell = VBA.CreateObject("WScript.Shell")
Dim waitOnReturn As Boolean: waitOnReturn = True
Dim windowStyle As Integer: windowStyle = 1
Dim errorCode As Long
Dim sFile As String


'Cleanup
ThisWorkbook.Save
Worksheets("Sheet1").Activate
On Error Resume Next
Worksheets("Sheet1").QueryTables("output1").Delete
On Error GoTo 0
Worksheets("Sheet1").Pictures.Delete
'=========

sFile = ThisWorkbook.Path & "\test_xls_connectivity.R"

errorCode = shell.Run("C:\R\R-3.3.0\bin\x64\Rscript.exe " & sFile & "", windowStyle, waitOnReturn)
'errorCode = shell.Run("Rscript.exe " & sFile & "", windowStyle, waitOnReturn)

Worksheets("Sheet1").Range("$F$3").Select
sFile = ThisWorkbook.Path & "\plots.png"

ActiveSheet.Pictures.Insert(sFile).Select

    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
    End With
Worksheets("Sheet1").Range("$F$30").Select
sFile2 = ThisWorkbook.Path & "\plots2.png"

ActiveSheet.Pictures.Insert(sFile2).Select

    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
    End With

Worksheets("Sheet1").Range("$N$3").Select

sFile3 = ThisWorkbook.Path & "\plots3.png"


ActiveSheet.Pictures.Insert(sFile3).Select

    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
    End With

'''''''''''''''''''''''''
strFile = ThisWorkbook.Path & "\output.csv"

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & strFile & "", Destination:=Range("$N$30"))
        .Name = "output1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With


End Sub



And here is my R file which reads data from excel and then returns plots as images and reports in text format that VBA will paste in an Excel sheet. The commented install.packages need to be run once in R (maybe it needs to be corrected so that if the packages are not installed R should install them). Note the args... and then scriptPath... piece of the code which reads the path to the current location of the script. Not my solution - I will attach the source soon, sorry and thanks to the original author.
# install.packages("xlsx")
# install.packages("rattle")
# install.packages("RColorBrewer")
# install.packages("rpart.plot")
# install.packages("scatterplot3d")
require(xlsx)
require(rpart)
# require(rattle) 
require(rpart.plot)
require(ggplot2)
require(scatterplot3d)

rm(list=ls())


args <- commandArgs(trailingOnly = F)  
scriptPath <- normalizePath(dirname(sub("^--file=", "", args[grep("^--file=", args)])))
setwd(scriptPath)
# setwd("C:\\Users\\jkotows2\\Desktop\\testR_xlsm")


#read from Sheet1
DaneBadawcze = read.xlsx("test_R.xlsm",1, encoding = "UTF-8", stringsAsFactors=T)

attach(DaneBadawcze)

fit <- rpart(Padało ~ Temperatura + Ciśnienie + Wilgotność,
             ,data=DaneBadawcze, method= "class")
#cluster<-cutree(hclust(dist(DaneBadawcze[,names(DaneBadawcze)!="Padało"]) ),k = 4)

cluster<-cutree(hclust(dist(DaneBadawcze) ),k = 4)

DaneBadawcze$Klaster<-cluster


#print a plot to a file


fn <- "plots.png"
if (file.exists(fn)) file.remove(fn)

png(fn)
#fancyRpartPlot(fit)
prp(fit,type = 2, fallen.leaves = T, extra = 3, compress = T)
dev.off()

#print another plot to a file
fn <- "plots2.png"
if (file.exists(fn)) file.remove(fn)
png(fn)
scatterplot3d(type="h", x=Temperatura, y=Ciśnienie, z=Wilgotność,color=c("green","blue") [DaneBadawcze$Padało] )
dev.off()

#print another plot to a file
fn <- "plots3.png"
if (file.exists(fn)) file.remove(fn)

png(fn)
scatterplot3d(type="h", x=Temperatura, y=Ciśnienie, z=Wilgotność,color=c("green","blue","red","brown","orange") [DaneBadawcze$Klaster] )
dev.off()


write.csv2(fit$variable.importance, file="output.csv", row.names = T)

#print a report to a file
sink(file="report.txt",  type="output")
  fit$variable.importance

  unlink("report.txt")
sink()

To be continued.

Brak komentarzy:

Prześlij komentarz