Related
I don't make to many complicated functions and typically stick with very basic ones. I have a question, how do I create a function that takes a dataset and normalizes based on desired normalization method and boxplots the output? Currently norm_method is different between the norm methods, was wondering if there is a way to call this in the start of function to pull through the correct method? Below is the code I created, but am stuck how to proceed.
library(reshape2) # for melt
library(cowplot)
demoData;
# target_deoData will need to be changed at some point
TestFunc <- function(demoData) {
# Q3 norm (75th percentile)
target_demoData <- normalize(demoData ,
norm_method = "quant",
desiredQuantile = .75,
toElt = "q_norm")
# Background normalization without spike
target_demoData <- normalize(demoData ,
norm_method = "neg",
fromElt = "exprs",
toElt = "neg_norm")
boxplot(assayDataElement(demoData[,1:10], elt = "q_norm"),
col = "red", main = "Q3",
log = "y", names = 1:10, xlab = "Segment",
ylab = "Counts, Q3 Normalized")
boxplot(assayDataElement(demoData[,1:10], elt = "neg_norm"),
col = "blue", main = "Neg",
log = "y", names = 1:10, xlab = "Segment",
ylab = "Counts, Neg. Normalized")
}
You might want to consider designing your normalize() and assayDataElement() functions to take ..., which provides more flexibility.
In lieu of that, given the examples above, you could make a simple configuration list, and elements of that configuration are passed to your normalize() and assayDataElement() functions, like this:
TestFunc <- function(demoData, method=c("quant", "neg")) {
method = match.arg(method)
method_config = list(
"quant" = list("norm_args" = list("norm_method" = "quant", desired_quantile = 0.75, "toElt" = "q_norm"),
"plot_args" = list("col"="red", main="Q3", ylab = "Counts, Q3 Normalized")),
"neg" = list("norm_args" = list("fromElt" = "exprs", "toElt" = "neg_norm"),
"plot_args" = list("col"="blue", main="Neg", ylab = "Counts, Neg Normalized"))
)
mcn = method_config[[method]][["norm_args"]]
mcp = method_config[[method]][["plot_args"]]
# normalize the data
target_demoData = do.call(normalize, c(list(data = demoData[1:10]), mcn))
# get the plot
boxplot(assayDataElement(
demoData[1:10], elt=mcp[["toElt"]],col = mcp[["col"],main = mcp[["main"]],
log = "y", names = 1:10, xlab = "Segment",ylab = mcp[["ylab"]]
)
}
Again, using this approach is not as flexible as ... (and consider splitting into two functions.. one that returns normalized data, and a second function that generates the plot..
I am new to R programming. When i try to plot the "optimize.portfolio" object from portfolioAnalytics package, Im getting the error below.
Error in applyFUN(R = R, weights = wts, FUN = risk.col
argument "arguments" is missing, with no default
In addition: Warning message:
In chart.Scatter.DE(object = DE, risk.col = risk.col, return.col = return.col,
mean or ES do not match extractStats output of $objective_measures slot
Below is my code.
library(PortfolioAnalytics)
library(DEoptim)
library(PerformanceAnalytics)
#get stock data
s = c("AMGN", "CSCO", "BA", "C")
start = "2017-01-01"
end = "2019-01-01"
getSymbols(s, from = start, to = end)
#create dateframe with close prices
p.price = NULL
for ( i in seq_along(s)){
j = s[i]
p.price = cbind(p.price, Cl(get(j)))
}
p.ret = na.omit(ROC(p.price))
colnames(p.ret) = gsub(".Close", "", colnames(p.ret))
funds = colnames(p.ret)
#create portfolio
ip = portfolio.spec(funds)
ip = add.constraint(ip, type ="weight_sum",
min_sum = 0.99, max_sum = 1.01)
ip = add.constraint(ip, type = "long_only")
ip = add.objective(ip, type = "return", name = "mean")
ip = add.objective(ip, type = "risk", name = "StdDev")
.storage = new.env()
opt = optimize.portfolio(p.ret, ip, optimize_method = "DEoptim",
search_size = 1000, trace = TRUE, traceDE = 5)
running the two below gives the mentioned error message
plot(opt)
chart.RiskReward(opt)
running the below, plots the weights without problem
chart.Weights(opt)
Thanks in advance!
The argument risk.col in chart.RiskReward() is set to "ES" by default, but you call function add.objective() by setting type = "risk", name = "StdDev".
try setting name = "ES" in add.objective(), or
setting risk.col = "StdDev" in chart.RiskReward()
The code I used:
competition <- ENMevaluate(occ = occ_coord, env = env, bg.coords = bg_coord, method = "randomkfold", RMvalues=seq(0.5, 5, 0.5), fc = c("L", "LQ", "H", "LQH"), algorithm='maxent.jar')
Unable to solve this, previously used a different code which sad kfolds is an unused arguement that is why replaced it to the above^
Previous Code:
competition <- ENMevaluate(occ = occ_coord, env = env, bg.coords = bg_coord, method = "randomkfold", kfolds=4, RMvalues=seq(0.5,4,0.5), fc = c("L", "LQ", "H", "LQH"), algorithm='maxent.jar')
Previous Error:
Error in ENMevaluate(occ = occ_coord, env = env, bg.coords = bg_coord, : unused argument (kfolds = 4)
Anything will be helpful right now as I am very short on time (<24 hours).
Thank you!
I'm having a problem with implementing the function bt.matching.find from the SIT toolbox which is hosted on Github. After downloading the toolbox following the steps described here, I tried to replicate the code described in this blog
library(SIT.dates)
library(SIT)
objt <- bt.matching.find(Cl(data), normalize.fn = normalize.mean, dist.fn = 'dist.euclidean', plot=T)
R did not find the function, so I tried using spacing to access the function
objt <- SIT:::bt.matching.find(Cl(data), normalize.fn = normalize.mean, dist.fn = 'dist.euclidean', plot=T)
But this time I got a weird error which has nothing to do with any argument in the function
Error in last(data, n.reference) : could not find function "last"
I did research on the function bt.matching.find using the function getAnywhere and here's what I got
getAnywhere("bt.matching.find")
A single object matching ‘bt.matching.find’ was found
It was found in the following places
namespace:SIT
with value
function (data, n.query = 90, n.reference = 252 * 10, n.match = 10,
normalize.fn = normalize.mean.sd, dist.fn = dist.euclidean,
plot = FALSE, plot.dist = FALSE, layout = NULL, main = NULL)
{
data = last(data, n.reference)
reference = coredata(data)
n = len(reference)
query = reference[(n - n.query + 1):n]
reference = reference[1:(n - n.query)]
main = paste(main, join(format(range(index(data)[(n - n.query +
1):n]), "%d%b%Y"), " - "))
n.query = len(query)
n.reference = len(reference)
dist.fn.name = ""
if (is.character(dist.fn)) {
dist.fn.name = paste("with", dist.fn)
dist.fn = get(dist.fn)
}
dist = rep(NA, n.reference)
query.normalized = match.fun(normalize.fn)(query)
for (i in n.query:n.reference) {
window = reference[(i - n.query + 1):i]
window.normalized = match.fun(normalize.fn)(window)
dist[i] = match.fun(dist.fn)(rbind(query.normalized,
window.normalized))
if (i%%100 == 0)
cat(i, "\n")
}
min.index = c()
temp = dist
temp[temp > mean(dist, na.rm = T)] = NA
for (i in 1:n.match) {
if (any(!is.na(temp))) {
index = which.min(temp)
min.index[i] = index
temp[max(0, index - 2 * n.query):min(n.reference,
(index + n.query))] = NA
}
}
n.match = len(min.index)
if (plot) {
dates = index(data)[1:len(dist)]
if (is.null(layout)) {
if (plot.dist)
layout(1:2)
else layout(1)
}
par(mar = c(2, 4, 2, 2))
if (plot.dist) {
plot(dates, dist, type = "l", col = "gray", main = paste("Top
Historical Matches for",
main, dist.fn.name), ylab = "Distance", xlab = "")
abline(h = mean(dist, na.rm = T), col = "darkgray",
lwd = 2)
points(dates[min.index], dist[min.index], pch = 22,
col = "red", bg = "red")
text(dates[min.index], dist[min.index], 1:n.match,
adj = c(1, 1), col = "black", xpd = TRUE)
}
plota(data, type = "l", col = "gray", LeftMargin = 1,
main = iif(!plot.dist, paste("Top Historical Matches for",
main), NULL))
plota.lines(last(data, 90), col = "blue")
for (i in 1:n.match) {
plota.lines(data[(min.index[i] - n.query + 1):min.index[i]],
col = "red")
}
text(index4xts(data)[min.index - n.query/2], reference[min.index -
n.query/2], 1:n.match, adj = c(1, -1), col = "black",
xpd = TRUE)
plota.legend(paste("Pattern: ", main, ",Match Number"),
"blue,red")
}
return(list(min.index = min.index, dist = dist[min.index],
query = query, reference = reference, dates = index(data),
main = main))
}
<bytecode: 0x000000e7e11c8a00>
<environment: namespace:SIT>
I tried calling the function using backports package
library(backports)
.onLoad <- function(libname, pkgname) {
backports::import(SIT, "bt.matching.find", force = TRUE)
}
But this also didn't work
Why is R not able to access the function? could this be because this package was built under an older version?
Additional information
Environment
sessionInfo()
R version 3.5.3 (2019-03-11)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 8.1 x64 (build 9600)
The problem was solved with help from the developer of the package, for anyone who is interested in using the code, here are the adjustments that should be done
library(SIT)
library(quantmod)
tickers = 'SPY'
data = getSymbols(tickers, src = 'yahoo', from = '1950-01-01', auto.assign = F)
obj = SIT:::bt.matching.find(Cl(data), normalize.fn = SIT:::normalize.mean, dist.fn = 'dist.euclidean', plot=T)
matches = SIT:::bt.matching.overlay(obj, plot.index=1:90, plot=T)
layout(1:2)
matches = SIT:::bt.matching.overlay(obj, plot=T, layout=T)
SIT:::bt.matching.overlay.table(obj, matches, plot=T, layout=T)
I'm trying to set up priors for my MLM using brms. I have ran my model with the priors I had set with no error messages and now would like to check them using pp_check. I get an the 'Error in sdata[[paste0("Y", usc(resp))]] : subscript out of bounds' error and couldn't find any tips as to why this is happening. Thanks!
Edit: I have checked the structure of my fit and only the init variables are 0, which I think should be the case since I set the initialisation parameter to 0? Otherwise there is nothing problematic as I can see.
I couldn't try anything since googling led to nothing.
library(brms)
df <- data.frame( subjno = as.factor(c('sub-01', 'sub-01','sub-01','sub-01','sub02','sub02','sub02','sub02')),
L1 = c(0.898922096, -0.673393065, -2.240150247,-0.932520537, -0.472701111, -0.188825324,0.808675919, 0.293666248),
L2 = c(0.64888, 2.0891, -0.655322708, 0.007098555, -0.648887797, -0.249716343, -0.698128026,0.119511014),
W1 = c(0.5,0.5,-0.5,-0.5,0.5,-0.5,0.5,-0.5), W2 = c(0.5,-0.5,0.5,-0.5,0.5,0.5,-0.5,-0.5),
t = as.factor(c(12,23,34,45,12,23,34,45)))
ff_s = brmsformula(cbind(L1,L2) ~ W1 * W2 * t +
(W1*W2* t|p|subjno))
get_prior(formula = ff_s, family = gaussian(),
data = df)
pp_s <- c(set_prior('normal(0,1)', class = "b"),
set_prior("normal(0,10)", class = "sd", resp = 'L1'),
set_prior("normal(0,10)", class = "sd", resp = 'L2'),
set_prior("normal(0,5)", class = "sigma",resp = 'L1'),
set_prior("normal(0,5)", class = "sigma",resp = 'L2'),
set_prior("normal(0,10)", class = "Intercept", resp = 'L1'),
set_prior("normal(0,10)", class = "Intercept", resp = 'L2'),
set_prior("lkj(3)", class = "cor"))
fit_s <- brm(formula = ff_s,
data = df, family = gaussian(),
prior = pp_s,
chains = 6, cores = 3,
iter = 2e3, warmup = 1e3,
init = 0,
sample_prior = "only")
pp_check(fit_s)
I found out that I was calling the function pp_check without specifying the level I am interested in, problem solved!