Does RInterface.GetArrayToVBA() always return an array? - r

Referring to this question from Wilmott Forums, I've just written the following function:
Public Function KmeansPrice(ByVal priceArray As Range, _
ByVal clustersNumber As Integer) As Double
' Following rows are reproducible only if RExcel has been installed
' on your Excel!
Dim y() As Double
RInterface.StartRServer
RInterface.PutArrayFromVBA "x", priceArray
RInterface.PutArrayFromVBA "n", clustersNumber
RInterface.RRun "x = as.numeric(x)"
RInterface.RRun "cluster = kmeans(x, n)$cluster"
RInterface.RRun "bestBid = rep(NA, n)"
RInterface.RRun "for(i in 1:n)" & _
"{" & _
" assign(paste('group.', i, sep = ''), " & _
" x[cluster == i]);" & _
" bestBid[i] = max(get(paste('group.', i, sep = '')))" & _
"}"
RInterface.RRun "y = min(bestBid) + 0.01"
y = RInterface.GetArrayToVBA("y")
KmeansPrice = y(0, 0)
End Function
Of course I've prototyped it in R before and it worked properly, then I guess that the cause of this error:
Error -2147220501
in Module RExcel.RServer
Error in variable assignment
is related to the wrong usage of RInterface.GetArrayToVBA() for what concerns dimensions and indexing of arrays from R to VBA.
Is anyone able to make the code above work? A working example with an array of just five or ten elements as priceArray and clustersNumber equal to 2 or 3 would be sufficient.

I'm not familiar with the clustering function, but this returns a result without breaking.
I prefer to make my functions in an R editor and then source the code, so I did this in R, then sourced my R function.
kmeansPrice <- function(priceArray,clustersNumber)
{
`[` <- function(...) base::`[`(...,drop=FALSE) #in case we have a 1 dimensional table
x<-priceArray
n<- clustersNumber
x<-matrix(as.numeric(x),nrow=dim(x)[1],ncol=dim(x)[2])
cluster = kmeans(x, n)$cluster
bestBid = rep(NA, n)
for(i in 1:n)
{
assign(paste('group.', i, sep = ''),
x[cluster == i])
bestBid[i] = max(get(paste('group.', i, sep = '')))
}
return(min(bestBid) + 0.01)
}
Then you can just
Public Function KmeansPrice(ByVal priceArray As Range, _
ByVal clustersNumber As Integer) As Double
rinterface.PutArrayFromVBA "priceArray", priceArray.Value 'I think this ".Value" was your problem'
rinterface.PutArrayFromVBA "clustersNumber", clustersNumber
rinterface.RRun "theResult <- kmeansPrice(priceArray,clustersNumber)"
y = rinterface.GetRExpressionValueToVBA("theResult") 'preferred to GetArrayToVBA for single-value results'
KmeansPrice = y
End Function
and run it with example data: a 2x4 table that evaluates to
[,1] [,2]
[1,] 5 9
[2,] 6 10
[3,] 7 11
[4,] 8 12
with 3 "clusters"
Sub runkmeans()
theResult = KmeansPrice(Range("BH2:BI5"), 3)
MsgBox (theResult)
End Sub
which yields 6.01

Related

can't step into function calls or loops in Rstudio

I can't step into function calls or into the for loop in Rstudio.
for (i in seq_len(max(last))) {
r = normdata$.return[smpls[[i]]]
m = normmat(i)
for (j in which(i <= last)) {
x = lm.fit(cbind(intercept = 1, m[, avail[i, ] & include[last[j], ], drop = F]), r)
temp[[j]][[i]] = if (!calc.tstat)
cbind(Estimate = coef(x))
else {
terms = terms(as.formula(paste(fieldmap["return"], paste(names(coef(x)), collapse
=" + "), sep = " ~ ")))
coef(summary.lm(structure(modifyList(x, list(terms = terms)), class = "lm")))[,
1:2, drop = F]
}
}
}
f = function(l, i, flip) t(sapply(l[!sapply(l, is.null)],
function(x) setNames(x[, i][fields], fields) * (if (flip) sign else 1)))
When I put my cursur on the first for loop line and hit run, it ignores my breakpoints inside both for loops and exits to the f= function line. On the Console, I can see:
Browse[9]> max(last) [1] 131
Browse[9]> j
[1] 1
Browse[9]> i
[1] 1
Browse[9]> temp[[j]][[i]]
NULL
Browse[9]> coef(x)
intercept BY_FY0 CY_FY0 CY_NTM DY_NTM EBITDA_EV_FY0 EBITDA_EV_NTM EY_FY0 EY_NTM FUND_PB
-7.236841e-10 1.121348e-01 -6.650536e-02 1.198634e-02 -5.849855e-02 8.291955e-02 -3.586112e-02 -6.218132e-02 1.936980e-01 -1.064521e-01
IRR SAL_YIELD_NTM
-3.522072e-02 6.294885e-02
Browse[9]> calc.tstat
[1] FALSE
I'm expecting temp[[1]][[1]] is set to coef(x), as calc.tstat is FALSE. But it remains NULL.
Could someone shed me some light on how to wake up my Rstudio please? Or I need a wakeup call?
Without access to your normdata object we can't investigate your exact problem. Two general suggestions:
Before running your code, run this at the console:
compiler::enableJIT(0)
This occasionally makes RStudio's IL-to-source matching more accurate.
Instead of setting rstudio breakpoints, add them in code: add browser() calls where you wish to break.

Julia UndefVarError on Metaprogramming

I'm trying to do a solver for equations. When I run the code the X variable appears to be undefined, but it prints out perfectly. What am I missing?
I should give the program some numbers, than operations as Macros and it should create an outer product matrix of the operations applied.
function msu()
print("Insert how many values: ")
quantity = parse(Int64, readline())
values = []
for i in 1:quantity
println("x$i")
num1 = parse(Float64, readline())
push!(values, num1)
end
println(values)
print("How many operations? ")
quantity = parse(Int64, readline())
ops = []
for i in 1:quantity
push!(ops, Meta.parse(readline()))
end
mat = zeros((quantity, quantity))
for i in 1:length(mat)
sum = 0
for j in 1:length(values)
# here begins problems, the following prints are for debugging purpose
print(length(values))
func = Meta.parse("$(ops[convert(Int64, ceil(j / quantity))]) * $(ops[convert(Int64, j % quantity)])")
print(func)
x = values[j]
println(x)
sum += eval(func)
end
mat[i] = sum
end
println(mat)
end
msu()
The original code was in Spanish, if you find any typo it's probably because I skipped a translation.

Parallel operations over arrays in Julia

What is the parallel (over multiple CPUs) version of this code in Julia?
V = zeros(3)
for i = 1:100000
cc = rand(1:3)
V[cc] += 1
end
This is a direct rewrite of your loop that is thread, tread-safe and avoiding false sharing:
using Random
using Base.Threads
V = let
mt = Tuple([MersenneTwister() for _ in 1:nthreads()])
Vv = Tuple([zeros(3) for _ in 1:nthreads()])
#threads for i = 1:100000
#inbounds cc = rand(mt[threadid()], 1:3)
#inbounds Vv[threadid()][cc] += 1
end
reduce(+, Vv)
end
However, in general for such a small job probably using threading will not give you much benefit. Also if you really need performance probably the code should be restructured a bit e.g. like this:
function worker(iters, rng)
v = zeros(3)
for i = 1:iters
cc = rand(rng, 1:3)
v[cc] += 1
end
v
end
V = let
mt = Tuple([MersenneTwister() for _ in 1:nthreads()])
Vv = [zeros(3) for _ in 1:nthreads()]
jobs_per_thread = fill(div(100000, nthreads()),nthreads())
for i in 1:100000-sum(jobs_per_thread)
jobs_per_thread[i] += 1
end
#assert sum(jobs_per_thread) == 100000
#threads for i = 1:nthreads()
Vv[threadid()] = worker(jobs_per_thread[threadid()], mt[threadid()])
end
reduce(+, Vv)
end
Also under Julia 1.3 you will not have to do manual MersenneTwister management, as Julia will create separate PRNG per thread.

Problem with Bayesian Network with bnlearn cpquery in shiny server - supplying evidence

I am building a ShinyDashboard assessment tool with a Bayesian network engine using bnlearn. It is a discrete network created using expert knowledge to build the conditional probability tables. The shiny front end is used to elicit evidence, however, when I try and apply the evidence at the back-end using cpquery, it is not working. If I hard code the evidence in the backend shiny server, it works. So I think it is something to do with accessing the input variables I am missing.
I have tried various ways of formatting the evidence for cpquery but to no avail and as I have said, tried hard coding values, which worked fine.
This works fine!
Index <- shiny::reactive({
cpquery(fitted = tdag,
event = (A == "High"), # event
evidence = ( (B == "Yes") & # evidence
(C == "Medium") &
(D == "Medium") &
(E == "Yes") &
(G == "High") &
(H == "Low")
), # end evidence
n = 1000000, # no of samples generated
debug = TRUE
) # end cpqery
}) # end reactive
This does not:
Index <- shiny::reactive({
# Create a string of the selected evidence
str1 <<- paste0(
"(B == '", input$BChoiceInp, "') & ",
"(C == '", input$CChoiceInp, "') & ",
"(D == '", input$DChoiceInp, "') & ",
"(E == '", input$EChoiceInp, "') & ",
"(G == '", input$GChoiceInp, "') & ",
"(H == '", input$HChoiceInp, "')"
)
cpquery(fitted = tdag,
event = (A == "High"), # event
evidence = (eval(parse(text = str1))), # evidence
n = 1000000, # no of samples generated
debug = TRUE
) # end cpqery
}) # end reactive
I have also tried using
str2 = "(A == "'High'")"
eval(parse(text = paste("cpquery(fitted,",str2,",",str1,", n = 100000, debug=TRUE)")))
Same result.
The network runs but the result is as below - it does not seem to see the inputs.:
* checking which nodes are needed.
> event involves the following nodes: A
> evidence involves the following nodes: B C D E G H
> upper closure is ' A B C D E F G H I J '
> generating observations from 10 / 10 nodes.
* generated 10000 samples from the bayesian network.
> evidence matches 0 samples out of 10000 (p = 0).
> event matches 0 samples out of 0 (p = 0).
* generated 10000 samples from the bayesian network.
> evidence matches 0 samples out of 10000 (p = 0).
> event matches 0 samples out of 0 (p = 0).
This is the result with evidence hardcoded - works fine:
* generated 10000 samples from the bayesian network.
> evidence matches 39 samples out of 10000 (p = 0.0039).
> event matches 30 samples out of 39 (p = 0.7692308).
* generated 10000 samples from the bayesian network.
> evidence matches 33 samples out of 10000 (p = 0.0033).
> event matches 21 samples out of 33 (p = 0.6363636).
* generated 10000 samples from the bayesian network.
> evidence matches 36 samples out of 10000 (p = 0.0036).
> event matches 23 samples out of 36 (p = 0.6388889).
* generated a grand total of 1e+06 samples.
> event matches 2666 samples out of 4173 (p = 0.6388689)
Heeeelllp!
The solution, many thanks to user20650, is to use renderText around the whole calculation. Works beautifully.
library(shiny)
library(bnlearn)
tdag = bn.fit(hc(learning.test[5:6]), learning.test[5:6])
shinyApp(
ui = basicPage(
selectInput("e", "E:", choices=letters[1:3] ),
selectInput("f", "F:", choices=letters[1:2] ),
textOutput("prob")
),
server = function(input, output, session) {
output$prob <- renderText({
event <- paste0("(F == '", input$f, "')")
evidence <- paste0("(E == '", input$e, "')")
eval(parse(text=paste(
'cpquery(fitted=tdag,
event = ', event, ',
evidence = ', evidence, ',
n = 100000,
debug = TRUE)'
)))})}
)

Print an extra space if the value is positive

I'm trying to get a visually clear output of my program:
a = -1234
b = 1234
#printf "a = %s%1.2e" "" a
#printf "b = %s%1.2e" " " b
which gives:
a = 1.23e+03
b = -1.23e+03
(The point is to add an extra space for positive number)
Now I want to automate it. I tried to write a funtion:
function negspace(x::Number)
if x < 0
return "", x
else
return " ", x
end
end
and print with
a = -1234
b = 1234
#printf "a = %s%1.2e" negspace( a )
#printf "b = %s%1.2e" negspace( b )
Even simpler is to use the printf format flag to do this directly by putting a space after the %:
julia> #sprintf("a = % 1.2e", -1234)
"a = -1.23e+03"
julia> #sprintf("b = % 1.2e", 1234)
"b = 1.23e+03"
Found a way:
#!/usr/bin/env julia
function signspace(x::Number)
if x > 0
return #sprintf(" %1.2e", x)
else
return #sprintf( "%1.2e", x)
end
end
a = -1234
b = 1234
println("a = ", signspace(a))
println("b = ", signspace(b))
but I'm not sure it is optimal.

Resources