Getting the output of a script in Matlab called from R - r

I am trying to call a very simple script in Matlab from RStudio. However, whenever I run the following code, without getting any error, it will return 0 to me. Would you please let me know how I can call Matlab scripts in R and get their outputs?
run_matlab_script("C:/Users/XXX/Desktop/Sum.m", verbose = TRUE, desktop = FALSE, splash = FALSE,
display = TRUE, wait = TRUE, single_thread = FALSE)
Note that to use the above function, I am using "matlabr" package in r. Moreover, my simple script in Matlab includes the below code:
b=1+2
Thanks in advance!

matlab::run_matlab_script uses system to call matlab. As of today, that function (current commit is c01d310) looks like:
run_matlab_script = function(
fname,
verbose = TRUE,
desktop = FALSE,
splash = FALSE,
display = FALSE,
wait = TRUE,
single_thread = FALSE,
...){
stopifnot(file.exists(fname))
matcmd = get_matlab(
desktop = desktop,
splash = splash,
display = display,
wait = wait,
single_thread = single_thread)
cmd = paste0(' "', "try, run('", fname, "'); ",
"catch err, disp(err.message); ",
"exit(1); end; exit(0);", '"')
cmd = paste0(matcmd, cmd)
if (verbose) {
message("Command run is:")
message(cmd)
}
x <- system(cmd, wait = wait, ...)
return(x)
}
Noteworthy (to me) is that run_matlab_script includes ... in its formals, and passes that unchanged to system. In fact, its help documentation specifically says that is what it does:
#' #param ... Options passed to \code{\link{system}}
Because of this, we can try to capture its output by looking at system. From ?system,
intern: a logical (not 'NA') which indicates whether to capture the
output of the command as an R character vector.
which suggests that if you change your call to
ret <- run_matlab_script("C:/Users/XXX/Desktop/Sum.m", verbose = TRUE, desktop = FALSE,
splash = FALSE, display = TRUE, wait = TRUE, single_thread = FALSE,
intern = TRUE)
you will get its output in out.

Related

How do I save a forceNetwork within an R shiny app as a pdf or svg file?

I am trying to save a forceNetwork created using the networkD3 package as a pdf or svg file. So far I have been able to save the network as an html file using the saveNetwork function. But I want to save it as a pdf file or even an svg file to give the user the ability to manipulate the network further. I have the following code in my server function which utilizes an actionButton with ID download_network in the UI.
observeEvent(input$download_network,{
req(data_net())
data <- data_net()
edges <- data$edges
nodes <- data$nodes
fn <- forceNetwork(
Links = edges,
Nodes = nodes,
fontFamily = "Arial",
Nodesize = "size",
Source = "Source ID",
Target = "Target ID",
NodeID = "Gene.Symbol",
charge = -50,
Group = "Type",
zoom = TRUE,
opacity = 1,
legend = TRUE,
opacityNoHover = 1
)
fn <- htmlwidgets::onRender(fn,jsCode = '
function (el, x) {
d3.select("svg").append("g").attr("id","legend-layer");
var legend_layer = d3.select("#legend-layer");
d3.selectAll(".legend")
.each(function() { legend_layer.append(() => this); });
}
')
saveNetwork(
fn,
file = "/Users/blah/Desktop/network.html"
)
})
This works fine, but again, I want to be able to save the network as either a pdf or svg file within the application. Thanks for any help.

How do I format values in my lua table to be: t = {['foo'] = true, ['bar'] = true}?

This is in relation to a previous question: Checking values across multiple location and returning a match only if the sources are unique.
Essentially, the function relys on the data being in the format:
local vendors = {
Asda = {Kellogg = true, Cadbury = true, Nestle = true, Johnsons = true, Pampers = true, Simple = true},
Tesco = {Kellogg = true, Cadbury = true, Nestle = true, Johnsons = true},
Spar ={Nestle = true, Johnsons = true, Pampers = true, Simple = true}
}
However, I am collecting the data by cycling through path locations and adding them into a table, which just creates a list such as:
Asda = {"Kellogg", "Cadbury", "Nestle", "Johnsons", "Pampers", "Simple"}
There is another way I can add them:
local Asda = {}
for index = 1, 9 do
local pathAsda = factReference -- some path location which changes by index increasing
if pathAsda ~= "" then
Asda[#Asda+1] = {[Asda] = true} -- table.insert(Asda, pathAsda), for the previously mentioned format
end
Which would leave me with:
Asda= {{Kellogg = true}, {Cadbury = true}, {Nestle = true}, {Johnsons = true}, {Pampers = true}, {Simple = true}}
I'd then use:
table.insert(vendorSources,Asda)
Neither of these formats work with the function in the answer and I can't seem to figure out how to amend any section to enable this to work.
function intersection(s1, s2) -- finds out if two sets (s1 & s2) overlap
local output = {}
for key in pairs(s1) do
output[#output + 1] = s2[key]
end
return output
end
Is there a way to edit either list (Asda) to be in the correct format?
You'd need to use Asda[pathAsda] = true instead of Asda[#Asda+1] = {[pathAsda] = true}, but keep in mind that the order elements is not guaranteed in this case.

Skip a value in a loop if URL doesn't exist

I am trying to get a code to grab all NBA box scores for the month of October. I want the code to try every URL possible for the combination of dates (27-31) and the 30 teams. However, as not all of the teams play every day, some combinations won't exist, so I am trying to implement the try function to skip the non-existent URLs, but I cant seem to figure it out. Here is what I have written so far:
install.packages("XML")
library(XML)
teams = c('ATL','BKN','BOS','CHA','CHI',
'CLE','DAL','DEN','DET','GS',
'HOU','IND','LAC','LAL','MEM',
'MIA','MIL','MIN','NOP','NYK',
'OKC','ORL','PHI','PHX','POR',
'SAC','SA','TOR','UTA','WSH')
october = c()
for (i in teams){
for (j in (c(27:31))){
url = paste("http://www.basketball-reference.com/boxscores/201510",
j,"0",i,".html",sep = "")
data <- try(readHTMLTable(url, stringsAsFactors = FALSE))
if(inherits(data, "error")) next
away_1 = as.data.frame(data[1])
colnames(away_1) = c("Players","MP","FG","FGA","FG%","3P","3PA","3P%","FT","FTA",
"FT%", "ORB","DRB","TRB","AST","STL","BLK","TO","PF","PTS","+/-")
away_1 = away_1[away_1$Players != "Reserves",]
away_1 = away_1[away_1$MP != "Did Not Play",]
away_1$team = rep(toupper(substr(names(as.data.frame(data[1]))[1],
5, 7)),length(away_1$Players))
away_1$loc = rep(i,length(away_1$Players))
home_1 = as.data.frame(data[3])
colnames(home_1) = c("Players","MP","FG","FGA","FG%","3P","3PA","3P%","FT","FTA",
"FT%", "ORB","DRB","TRB","AST","STL","BLK","TO","PF","PTS","+/-")
home_1 = home_1[home_1$Players != "Reserves",]
home_1 = home_1[home_1$MP != "Did Not Play",]
home_1$team = rep(toupper(substr(names(as.data.frame(data[2]))[1],
5, 7)),length(home_1$Players))
home_1$loc = rep(i,length(home_1$Players))
game = rbind(away_1,home_1)
october = rbind(october, game)
}
}
Everything above and below the following lines appears to work:
data <- try(readHTMLTable(url, stringsAsFactors = FALSE))
if(inherits(data, "error")) next
I just need to properly format these two.
For anyone interested, I figured it out using url.exists in RCurl. Just impliment the following after the url definition line:
if(url.exists(url) == TRUE){...}
How about using tryCatch for error handling?
result = tryCatch({
expr
}, warning = function(w) {
warning-handler-code
}, error = function(e) {
error-handler-code
}, finally = {
cleanup-code
})
where readHTMLTable will be use as the main part ('expr'). You can simply return missing value if error/warning occurs and then omit missing values on final result.

web2py SQLFORM.grid url

When I try to put form = SQLFORM.grid(db.mytable) in my controller the request changes to my/web/site/view?_signature=520af19b1095db04dda2f1b6cbea3a03c3551e13 which causes my if statement in controller to collapse. Can smbd please explain why this happens?
If I put user_signature=False then on view load the grid is shown (though the looks is awful, and I still need to find out how to change the view of my table), but on search,edit, etc. click, the same thing happens again. The url is changed and I get an error
Any suggestions?
thank you
EDIT
This is my edit function
#auth.requires_login()
def edit():
#Load workers
workers = db(db.worker.w_organisation == 10).select(db.worker.w_id_w, db.worker.w_organisation, db.worker.w_first_name, db.worker.w_last_name,db.worker.w_nick_name,db.worker.w_email,db.worker.w_status,db.worker.w_note).as_list()
#Define the query object. Here we are pulling all contacts having date of birth less than 18 Nov 1990
query = ((db.worker.w_organisation == 10) & (db.worker.w_status==db.status.s_id_s))
#Define the fields to show on grid. Note: (you need to specify id field in fields section in 1.99.2
fields = (db.worker.w_first_name, db.worker.w_last_name,db.worker.w_nick_name,db.worker.w_email,db.status.s_code,db.worker.w_note)
#Define headers as tuples/dictionaries
headers = { 'worker.w_first_name' : 'Ime',
'worker.w_last_name' : 'Priimek',
'worker.w_nick_name' : 'Vzdevek',
'worker.w_email' : 'E-posta',
'status.s_code': 'Status',
'worker.w_note' : 'Komentar' }
#Let's specify a default sort order on date_of_birth column in grid
default_sort_order=[db.worker.w_last_name]
#Creating the grid object
form = SQLFORM.grid(query=query, fields=fields, headers=headers,searchable=True, orderby=default_sort_order,create=True, \
deletable=True, editable=True, maxtextlength=64, paginate=25,user_signature=False
)
form = SQLFORM.grid(db.worker,user_signature=False)
workersDb = db((db.worker.w_organisation == 10) & (db.worker.w_status==db.status.s_id_s)).select(db.worker.w_id_w, \
db.worker.w_organisation, db.worker.w_first_name, \
db.worker.w_last_name,db.worker.w_nick_name,db.worker.w_email,\
db.status.s_code,db.worker.w_note).as_list()
workersList = []
for rec in workersDb:
status = rec['status']['s_code']
workers = rec['worker']
if not rec["worker"]["w_first_name"]:
polno_ime = rec["worker"]["w_last_name"]
elif not rec["worker"]["w_last_name"]:
polno_ime = rec["worker"]["w_first_name"]
else:
polno_ime = rec["worker"]["w_first_name"] + " " + rec["worker"]["w_last_name"]
rec["worker"]['w_full_name'] = polno_ime
rec["worker"]["w_status"] = status
data = rec["worker"]
#print rec
#print data
workersList.append(rec["worker"])
# If type of arg is int, we know that user wants to edit a script with an id of the argument
if(request.args[0].isdigit()):
script = db(getDbScript(request.args[0])).select(db.script.sc_lls, db.script.sc_name, db.script.id, db.script.sc_menu_data).first()
formData = str(script["sc_menu_data"])
#form = SQLFORM.grid(db.auth_user)
#print formData
# If we dont get any results that means that user is not giving proper request and we show him error
#print script
#Parsing script to be inserted into view
if not script:
return error(0)
return dict(newScript = False, script = script, formData = formData, workers = workersList, form = form)
# If the argument is new we prepare page for new script
elif request.args[0] == 'new':
scripts = db((auth.user.organization == db.script.sc_organization)).select(db.script.sc_name, db.script.id, workers = workersList, form = form)
return dict(newScript = True, scripts = scripts, workers = workersList, form = form)
# Else error
else:
return error(0)
also not to mention the sqlgrid looks awful, here is link to the picture https://plus.google.com/103827646559093653557/posts/Bci4PCG4BQQ

Error in panel$intname : $ operator is invalid for atomic vectors

I am working on the r panel package. Now if I have a function that uses a radiogroup button, and if i attempt to run the function from inside the rpanel menu, I get this error:
Error in panel$intname : $ operator is invalid for atomic vectors
However if I run the function per sé i.e. not from inside the rpanel menu, but by calling it independently, the above error doesn't appear. Here is a simple example. Try in 2 ways (1) run the whole code and click on Addition and then click Add in the menu (2) run the add function alone and call with add(). The former results in the above error and the latter doesn't. Also, i saw that this error comes only when i have a rp.radiogroup in my panel.
I saw the post in Why doesn't R allow $ operator on atomic vectors? but how do i solve my issue? My sample Code is below:
install.packages(c("rpanel","tkrplot"))
my.menu <- function(panel) {
library(rpanel,tkrplot)
if (panel$menu=="Add"){
add()
}
else
panel
}
main.panel <- rp.control(title = "Main Menu",size=c(200,150))
rp.menu(panel = main.panel, var = menu,
labels = list(list("Addition", "Add")),action = my.menu)
# function to do adddition
add <- function(){
my.draw <- function(panel) {
if(panel$vals=="numbers"){
val<-as.numeric(panel$nmbr1)+as.numeric(panel$nmbr2)
}
else if(panel$vals=="strings"){
val <- paste(as.character(panel$nmbr1), "and" ,as.character(panel$nmbr2))
}
plot(1:10, 1:10, type="n", xlab="", ylab="",
axes=FALSE, frame = TRUE)
text(5, 5, paste("Result: ", val),cex=1.4)
panel
}
my.redraw <- function(panel) {
rp.tkrreplot(panel, my.tkrplot)
panel
}
my.panel <- rp.control(title = "Addition")
rp.textentry(panel = my.panel, var = nmbr1,
labels = "First: ", action = my.redraw, initval="100")
rp.textentry(panel = my.panel, var = nmbr2,
labels = "Second:", action = my.redraw, initval="200")
rp.radiogroup(panel = my.panel, var = vals,
values = c("numbers", "strings"),
action = my.redraw, title = "Type")
rp.tkrplot(panel = my.panel, name = my.tkrplot, plotfun = my.draw)
}
You may simply escape using $: Change
panel$vals
to:
panel["vals"]

Resources