so I am in dire need of help. I have finally managed to construct my R-INLA model and get it to graph as needed. via the code below:
First I create the stacks (note this is the very end of my INLA process, the mesh etc has already been done)
stk.abdu = inla.stack(data = list(y = 1, e = 0), A = list(abdu.mat, 1),tag = 'abdu', effects = list(list(i = 1:sc.mesh.5$n), data.frame(Intercept = 1,dwater=winter.abdu$dwater,elev=winter.abdu$elev,forest=winter.abdu$forest,developed=winter.abdu$developed,openwater=winter.abdu$OpenWater,barren=winter.abdu$barren,shrubland=winter.abdu$shrubland,herb=winter.abdu$herb,planted=winter.abdu$planted,wetland=winter.abdu$wetland,dist=winter.abdu$dwater)))
stk.quad = inla.stack(data = list(y = 0, e = 0.1), A = list(quad.mat, 1),tag = 'quad', effects = list(list(i = 1:sc.mesh.5$n), data.frame(Intercept = 1,dwater=dummy$dwater,elev=dummy$elev,forest=dummy$forest,developed=dummy$developed,openwater=dummy$openwater,barren=dummy$barren,shrubland=dummy$shrubland,herb=dummy$herb,planted=dummy$planted,wetland=dummy$wetland,dist=dummy$dwater)))
stk.prd<-inla.stack(data = list(y = NA), A = list(Aprd, 1),tag = 'prd', effects = list(list(i = 1:sc.mesh.5$n), data.frame(Intercept = 1,dwater=prddf2$dwater,elev=prddf2$elev,forest=prddf2$forest,developed=prddf2$developed,openwater=prddf2$openwater,barren=prddf2$barren,shrubland=prddf2$shrubland,herb=prddf2$herb,planted=prddf2$planted,wetland=prddf2$wetland,dist=prddf2$dwater)))
stk.all.prd = inla.stack(stk.abdu,stk.quad,stk.prd)
Next I fit my model
ft.inla.prd<-inla(y ~ 0 + Intercept + elev + dwater + forest+ developed + f(inla.group(dist,n=50,method="quantile"),model="rw1",scale.model=TRUE)+f(i,model=sc.spde),family="binomial",data=inla.stack.data(stk.all.prd),control.predictor = list(A = inla.stack.A(stk.all.prd),compute=TRUE),E=inla.stack.data(stk.all.prd)$e,control.compute=list(dic = TRUE),control.fixed=list(expand.factor.strategy="INLA"))
Then I change the predicted values from logit to probabilities
ft.inla.prd$newfield <- exp(ft.inla.prd$summary.random$i$mean)/(1 + exp(ft.inla.prd$summary.random$i$mean))
And finally I use inla.mesh.project and levelplot to create my image
xmean <- inla.mesh.project(projgrid,ft.inla.prd$newfield)
levelplot(xmean, col.regions=topo.colors(99), main='Probability of Presence',xlab='', ylab='', scales=list(draw=FALSE))
So my problem is that I now want to export this data (what is projected as the graph) as a raster so that I can work with it in ArcGIS. However, I have not been able to find a way to do so.
Any input is greatly appreciated
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 would like to know how to set the sigma_subject_slope of a random intercept model in powerlmm. `As in the code below, is 'sigma_subject_slope' = 1 correct since it is not a random slope?
p1 <- study_parameters(n1 = 3,
n2 = 15,
sigma_subject_intercept = ,
*sigma_subject_slope = **1***,
sigma_error = ***,
effect_size = cohend(***,
standardizer = "pretest_SD"))
p1
I am doing Wavelet Analysis in R using Biwavelet. However, I receive the error message:
Error in check.datum(y) :
The step size must be constant (see approx function to interpolate)
When I run the following code:
wtc.AB = wtc(t1, t2, nrands = nrands)
Please share your help here. Complete Code is:
# Import your data
Data <- read.csv("https://dl.dropboxusercontent.com/u/18255955/Tutorials/Commodities.csv")
# Attach your data so that you can access variables directly using their
# names
attach(Data)
# Define two sets of variables with time stamps
t1 = cbind(DATE, ISLX)
t2 = cbind(DATE, GOLD)
# Specify the number of iterations. The more, the better (>1000). For the
# purpose of this tutorial, we just set it = 10
nrands = 10
wtc.AB = wtc(t1, t2, nrands = nrands)
# Plotting a graph
par(oma = c(0, 0, 0, 1), mar = c(5, 4, 5, 5) + 0.1)
plot(wtc.AB, plot.phase = TRUE, lty.coi = 1, col.coi = "grey", lwd.coi = 2,
lwd.sig = 2, arrow.lwd = 0.03, arrow.len = 0.12, ylab = "Scale", xlab = "Period",
plot.cb = TRUE, main = "Wavelet Coherence: A vs B")```
I use the R package fPortfolio for portfolio optimization for a rolling portfolio (adaptive asset allocation). Therefore, I use the backtesting function.
I aim at constructing a portfolio for a set of assets for a predefined target return (and minimized risk) or for a predefined target risk and maximized returns.
Even allowing for short selling (as proposed in another post 5 years ago) seems not to work. Besides, I do not want to allow for short selling in my approach.
I cannot figure out why changing values for target return or target risk do not influence the solution at all.
Where do I go wrong?
require(quantmod)
require(fPortfolio)
require(PortfolioAnalytics)
tickers= c("SPY","TLT","GLD","VEIEX","QQQ","SHY")
getSymbols(tickers)
data.raw = as.timeSeries(na.omit(cbind(Ad(SPY),Ad(TLT),Ad(GLD),Ad(VEIEX),Ad(QQQ),Ad(SHY))))
data.arith = na.omit(Return.calculate(data.raw, method="simple"))
colnames(data.arith) = c("SPY","TLT","GLD","VEIEX","QQQ","SHY")
cvarSpec <- portfolioSpec(
model = list(
type = "CVAR",
optimize = "maxReturn",
estimator = "covEstimator",
tailRisk = list(),
params = list(alpha = 0.05, a = 1)),
portfolio = list(
weights = NULL,
targetReturn = NULL,
targetRisk = 0.08,
riskFreeRate = 0,
nFrontierPoints = 50,
status = 0),
optim = list(
solver = "solveRglpk.CVAR",
objective = NULL,
params = list(),
control = list(),
trace = FALSE))
backtest = portfolioBacktest()
setWindowsHorizon(backtest) = "12m"
assets <- SPY ~ SPY + TLT + GLD + VEIEX + QQQ + SHY
portConstraints ="LongOnly"
myPortfolio = portfolioBacktesting(
formula = assets,
data = data.arith,
spec = cvarSpec,
constraints = portConstraints,
backtest = backtest,
trace = TRUE)
setSmootherLambda(myPortfolio$backtest) <- "1m"
myPortfolioSmooth <- portfolioSmoothing(myPortfolio)
backtestPlot(myPortfolioSmooth, cex = 0.6, font = 1, family = "mono")
I'm attempting to get a r visualization running in PowerBI. It runs fine in R, but for some reason it never finishes loading in PowerBI (no error message, just the timeout screen after 5 minutes). After some experimenting, I've noticed that if I remove one plotly overlay from the create and save widget section, it will load fine. It doesn't matter which one.
I am new to R and powerBi, so any advice on a workaround would be really appreciated.
source('./r_files/flatten_HTML.r')
############### Library Declarations ###############
libraryRequireInstall("ggplot2");
libraryRequireInstall("plotly");
####################################################
################### Actual code ####################
# plot histogram of risk density using monte carlo output
x = Values[,1]; #grab first column of dataframe as dataframe
# create CDF function and overlay onto histogram
cdf = ecdf(x);
# calculate mean cordinates to draw a mean line for selected data
meancordinates = function(xdata) {
v = sum(xdata)
meanxcord = v/length(xdata)
meancord = list(meanxcord = meanxcord, meanycord = cdf(meanxcord))
return(meancord)
};
mean = meancordinates(x);
# calculate median cordinates to draw a median line for selected data
mediancordinates = function(xdata) {
medianxcord = median(xdata)
mediancord = list(medianxcord = medianxcord, medianycord = cdf(medianxcord))
return(mediancord)
};
median = mediancordinates(x)
# calculate the 80% cordinates to draw a 80% line for selected data
eightycordinates = function(xdata) {
eightyxcord = x[which(abs(cdf(xdata)-0.80) == min(abs(cdf(xdata)-0.80)))]
eightycord = list(eightyxcord = eightyxcord, eightyycord = cdf(eightyxcord))
return(eightycord);
}
eighty = eightycordinates(x);
####################################################
############# Create and save widget ###############
p = plot_ly(x = x, type = "histogram", histnorm = "probability density", name = "Histogram")
p = p %>% add_segments(
x = median$medianxcord, xend = median$medianxcord,
y = 0, yend = median$medianycord,
name = "Median")
p = p %>% add_segments(
x = eighty$eightyxcord, xend = eighty$eightyxcord,
y = 0, yend = eighty$eightyycord,
name = "80%")
p = p %>% add_segments(
x = mean$meanxcord, xend = mean$meanxcord,
y = 0, yend = mean$meanycord,
name = "Mean")
p = p %>% add_lines(x = x, y = cdf(x), name = "CDF");
internalSaveWidget(p, 'out.html');
####################################################