I want to train the neural network using a sliding window.
I tried to check on the Internet, I found that it is possible if I use the rollapply function.
However, even looking at the example sentences, I could not understand how to use the rollapply function well.
For example, I use the window size as 120 and shift width as 10.
I wrote the code such as the following. But, Error returened!
library(AMORE)
#P is the input vector
P <- matrix(sample(seq(-1,1,length=1000), 1000, replace=FALSE), ncol=1)
# The network will try to approximate the target P^2
target <- P^2
data <- data.frame(P,target)
# We create a feedforward network, with two hidden layers.
# The first hidden layer has three neurons and the second has two neurons.
# The hidden layers have got Tansig activation functions and the output layer is Purelin.
net <- newff(n.neurons=c(1,3,2,1), learning.rate.global=1e-2, momentum.global=0.5,
error.criterium="LMS", Stao=NA, hidden.layer="tansig",
output.layer="purelin", method="ADAPTgdwm")
b <- function(mydata){
dd <- as.data.frame(mydata)
result <- train(dd[,1],dd[,2], error.criterium="LMS", report=TRUE, show.step=100, n.shows=5 )
y <- sim(result$net, dd[,1])
return(y)
}
a <- rollapply(data, width=128, by=10, FUN= b)
Please tell me how to train the neural network by using the rollapply function anyone.
Or, please tell me if there are another way to train the neural network using a sliding window.
Related
I would like to use envelope simulation on a list of kppm objects.
I have a point dataset that is in a grid pattern. I would like to shift each point such that its position in the cell is random, then run a spatstat simulation to determine if the points are randomly distributed (obviously will be at sub cell size scale). Then randonly shift shift each point inside the cell, and re-run the simulation - repeating n times and generate an envelope of all the simulations. There are 2 ways to do this 1) using a list of point sets and 2) using simulate.
Method 1) - on a list called my_kppm_list
Lmat = envelope(fitM, Lest, nsim = 19, global=FALSE, simulate=my_kppm_list)
plot(Lmat)
How to create a list of cluster process models (kppm)?
Naive way:
my_list <- list(kppm_0, kppm_1)
This fails when trying to run simulation:
Lmat = envelope(fitM, Lest, nsim = 19, global=FALSE, simulate=my_list)
Error in envelopeEngine(X = X, fun = fun, simul = simrecipe, nsim = nsim, :
‘simulate’ should be an expression, or a list of point patterns of the same kind as X
I can convert a list to .ppm
fitM_0 <- kppm(create_pts(), ~1, "MatClust")
fitM_1 <- kppm(create_pts(), ~1, "MatClust")
my_list <- list(fitM_0, fitM_1)
ppm_list <- lapply(my_list, as.ppm)
But trying to convert to kppm fails with an error
kppm_list <- lapply(my_list, as.kppm)
Method 2) apply a function in simulation such that a random shift is applied to each point then simulation run, and envelope of all simulations is used (see page 399 of Baddelley et al. Spatial Point Patterns book (2016)):
e_rand <- function(){
j_x <- matrix(unlist(runif(dim(c_df)[1], min=-10, max=10)), ncol = 1, byrow = T)
j_y <- matrix(unlist(runif(dim(c_df)[1], min=-10, max=10)), ncol = 1, byrow = T)
x_j<- c_df[,1]+j_x
y_j<- c_df[,2]+j_y
c_j <- ppp(x = x_j, y = y_j, window = window)
return(c_j)
}
Lmat = envelope(fitM, Lest, nsim = 19, global=TRUE, simulate=e_rand)
However I found that the null model (red dashed line in output plot) had kinks in it when simulate is added - kinks that do not appear without simulate.
How to create a list of cluster process models (kppm)?
This is not the problem. In your example you are successfully creating a list of objects of class kppm. If fit1 and fit2 are fitted models of class kppm, then
m <- list(fit1, fit2)
is a list of objects of class kppm.
The problem is that you then pass this list as an argument to the function envelope which does not accept this format. The error message from envelope.ppp or envelope.kppm says that the argument simulate must be either a fitted model, or a list of point patterns.
An envelope is constructed by generating simulated point patterns, computing a summary function for each simulated pattern, and computing the upper and lower extremes of these summary functions. The argument simulate (if it is given) is a recipe for generating the simulated point patterns. If simulate is an expression like expression(runifpoint(42)) then this expression will be evaluated nsim times to produce nsim different point patterns. If simulate is a fitted model, then nsim simulated realisations of the model will be generated. If simulate is a list of point patterns, then they will be taken as the simulated random patterns.
It is unclear what you want to do with your list of models.
Do you want to construct a single envelope, or a list of envelopes?
Option 1: you have a list m of models of class kppm. For each of these models m[[i]], you want to construct an envelope e[[i]], where the limits are determinedby simulation from m[[i]]`.
Option 2: you have a list m of models of class kppm. For each model m[[i]] you want to generate one point pattern, say X[[i]], and build an envelope e using these patterns.
For option 1, type something like
e <- anylapply(m, function(fit) {
envelope(Y, Lest, nsim = 19, global=FALSE, simulate=fit)})
For option 2,
X <- solapply(m, simulate, nsim=1, drop=TRUE)
e <- envelope(Y, Lest, nsim=19, global=FALSE, simulate=X)
If you wanted something else, please clarify.
Two different methods of the principal component analysis were conducted to analyze the following data (ch082.dat) using the Box1's R-code, below.https://drive.google.com/file/d/1xykl6ln-bUnXIs-jIA3n5S3XgHjQbkWB/view?usp=sharing
The first method uses the rotation matrix (See 'ans_mat' under the '#rotated data' of the Box1's code) and,
the second method uses the 'pcomp' function (See 'rpca' under the '#rotated data' of the Box1's code).
However, there is a subtle discrepancy in the answer between the method using the rotation matrix and the method using the 'pcomp' function.
make it match
My Question
What should I do so that the result of the rotation matrix -based method matches the result of the'pcomp' function?
As far as I've tried with various data, including other data, the actual discrepancies seem to be limited to scale shifts and mirroring transformations.
The results of the rotation matrix -based method is shown in left panel.
The results of the pcomp function -based method is shown in right panel.
Mirror inversion can be seen in "ch082.dat" data.(See Fig.1);
It seems that, in some j, the sign of the "jth eigenvector of the correlation matrix" and the sign of the "jth column of the output value of the prcomp function" may be reversed. If there is a degree of overlap in the eigenvalues, it is possible that the difference may be more complex than mirror inversion.
Fig.1
There is a scale shift for the Box2's data (See See Fig.2), despite the centralization and normalization to the data.
Fig.2
Box.1
#dataload
##Use the 'setwd' function to specify the directory containing 'ch082.dat'.
##For example, if you put this file directly under the C drive of your Windows PC, you can run the following command.
setwd("C:/") #Depending on where you put the file, you may need to change the path.
getwd()
w1<-read.table("ch082.dat",header = TRUE,row.names = 1,fileEncoding = "UTF-8")
w1
#Function for standardizing data
#Thanks to https://qiita.com/ohisama2/items/5922fac0c8a6c21fcbf8
standalize <- function(data)
{ for(i in length(data[1,]))
{
x <- as.matrix(data[,i])
y <- (x-mean(x)/sd(x))
data[,i] <- y
}
return(data)}
#Method using rotation matrix
z_=standalize(w1)
B_mat=cor(z_) #Compute correlation matrix
eigen_m <- eigen(B_mat)
sample_mat <- as.matrix(z_)
ans_mat=sample_mat
for(j in 1:length(sample_mat[1,])){
ans_mat[,j]=sample_mat%*%eigen_m$vectors[,j]
}
#Method using "rpca" function
rpca <- prcomp(w1,center=TRUE, scale=TRUE)
#eigen vectors
eigen_m$vectors
rpca
#rotated data
ans_mat
rpca$x
#Graph Plots
par(mfrow=c(1,2))
plot(
ans_mat[,1],
ans_mat[,2],
main="Rotation using eigenvectors"
)
plot(rpca$x[,1], rpca$x[,2],
main="Principal component score")
par(mfrow=c(1,1))
#summary
summary(rpca)$importance
Box2.
sample_data <- data.frame(
X = c(2,4, 6, 5,7, 8,10),
Y = c(6,8,10,11,9,12,14)
)
X = c(2,4, 6, 5,7, 8,10)
Y = c(6,8,10,11,9,12,14)
plot(Y ~ X)
w1=sample_data
Reference
https://logics-of-blue.com/principal-components-analysis/
(Written in Japanease)
The two sets of results agree. First we can simplify your code a bit. You don't need your function or the for loop:
z_ <- scale(w1)
B_mat <- cor(z_)
eigen_m <- eigen(B_mat)
ans_mat <- z_ %*% eigen_m$vectors
Now the prcomp version
z_pca <- prcomp(z_)
z_pca$sdev^2 # Equals eigen_m$values
z_pca$rotation # Equals eigen_m$vectors
z_pca$x # Equals ans_mat
Your original code mislabeled ans_mat columns. They are actually the principal component scores. You can fix that with
colnames(ans_mat) <- colnames(z_pca$x)
The pc loadings (and therefore the scores) are not uniquely defined with respect to reflection. In other words multiplying all of the loadings or scores in one component by -1 flips them but does not change their relationships to one another. Multiply z_pca$x[, 1] by -1 and the plots will match:
z_pca$x[, 1] <- z_pca$x[, 1] * -1
dev.new(width=10, height=6)
par(mfrow=c(1,2))
plot(ans_mat[,1], ans_mat[,2], main="Rotation using eigenvectors")
plot(z_pca$x[,1], z_pca$x[,2], main="Principal component score")
I am working with different linear regression models in R. I used the DATASET, which has 21263 rows and 82 columns.
All of the regression models have acceptable time consumption except the MM-estimate regression using the R function lmrob.
I was waiting for more than 10 hours to run the first for loop (#Block A), and it does not work. By "does not work", I mean It may give me an output after two days. I tried this code with a smaller DATASET which has 9568 rows, 5 columns and it runs in a one minute.
I am using my standard Laptop.
The steps of my analysis as follows
Uploading and scaling the dataset and then used k-folds split with k=30 because I want to calculate the variance of coefficients for each variable within the k split.
Could you please provide me with any guide?
wdbc = read.csv("train.csv") #critical_temp is the dependent varaible.
wdbcc=as.data.frame(scale(wdbc)) # scaling the variables
### k-folds split ###
set.seed(12345)
k = 30
folds <- createFolds(wdbcc$critical_temp, k = k, list = TRUE, returnTrain = TRUE)
############ Start of MM Regression Model #################
#Block A
lmrob = list()
for (i in 1:k) {
lmrob[[i]] = lmrob(critical_temp~ .,
data = wdbcc[folds[[i]],],setting="KS2014")
}
#Block B
lmrob_coef = list()
lmrob_coef_var = list()
for(j in 1:(lmrob[[1]]$coefficients %>% length())){
for(i in 1:k){
lmrob_coef[[i]] = lmrob[[i]]$coefficients[j]
lmrob_coef_var[[j]] = lmrob_coef %>% unlist() %>% var()
}
}
#Block C
lmrob_var = unlist(lmrob_coef_var)
lmrob_df = cbind(coefficients = lmrob[[1]]$coefficients %>% names() %>% as.data.frame()
, variance = lmrob_var %>% as.data.frame())
colnames(lmrob_df) = c("coefficients", "variance_lmrob")
#Block D
lmrob_var_sum = sum(lmrob_var)
Not an answer, but some code to help you test this for yourself. I didn't run lmrob() on the full dataset, but everything I show below suggests that one full realization of the model (all observations, all predictors) should run in about 10-20 minutes [on a 10-year old MacOS desktop machine], which would extrapolate to approximately 5 hours for 30-fold cross-validation. (It looks like the time scales a little worse than the square root of the number of observations, and nonlinearly even on the log scale with the number of predictors ...) You can try the code below to see if things are much slower on your machine, and to predict how long you think it should take to do the whole problem. Other general suggestions:
is there a chance you're running out of memory? Memory constraints can make things run much slower
if the problem is just that things are too slow, you can easily parallelize across folds if you have access to multiple cores (probably don't do this on a laptop, you'll burn it up)
AWS and other cloud services can be very useful
I set up a test function to record the time taken by lmrob() running on a random subset of predictors and observations from your data set.
Extract data, load packages:
unzip("superconduct.zip")
xx <- read.csv("train.csv")
library(robustbase)
library(ggplot2); theme_set(theme_bw())
library(cowplot)
Define a test function for timing lmrob runs for different numbers of observations and predictors:
nc <- ncol(xx) ## response vble is last column, "critical_temp"
test <- function(nobs=1000,npred=10,seed=NULL, ...) {
if (!is.null(seed)) set.seed(seed)
dd <- xx[sample(nrow(xx),size=nobs),
c(sample(nc-1,size=npred),nc)]
tt <- system.time(fit <- lmrob(critical_temp ~ ., data=dd, ...))
tt[c("user.self","sys.self","elapsed")]
}
t0 <- test()
The minimal example here (1000 observations, 10 predictors) is very fast (0.2 seconds).
This is the basic loop I ran:
res <- expand.grid(nobs=seq(1000,10000,by=1000), npred=seq(10,30,by=2))
res$user.self <- res$sys.self <- res$elapsed <- NA
for (i in seq(nrow(res))) {
cat(res$nobs[i],res$npred[i],"\n")
res[i,-(1:2)] <- test(res$nobs[i],res$npred[i],seed=101)
}
(As you can see in the plot below, I did this again with larger numbers of observations and predictors and used rbind() to combine the results into a single data frame.) I also tried fitting linear models to make predictions of the time taken to do the full data set with all predictors. (Plotting [see below] suggests that the time is log-log-linear in number of observations but nonlinear in number of predictors ...)
m1 <- lm(log10(elapsed)~poly(log10(npred),2)*log10(nobs), data=resc)
pp <- predict(m1, newdata=data.frame(npred=ncol(xx)-1,nobs=nrow(xx)),
interval="confidence")
10^pp ## convert from log10(predicted seconds) to seconds
Test the full data set.
t_all <- test(nobs=nrow(xx),npred=ncol(xx)-1)
I then realized that you were using setting = "KS2014" (as suggested in the documentation) rather than the default: this is at least 5x slower, as suggested by the following comparison:
test(nobs=10000,npred=30)
test(nobs=10000,npred=30,setting = "KS2014")
I re-ran some of the stuff above with setting="KS2014". Making the prediction for the full data set suggested a run-time of about 700 seconds (CI from 300 to 2000 seconds) - still nowhere near as slow as you're suggesting.
gg0 <- ggplot(resc2,aes(x=npred,y=elapsed,colour=nobs,linetype=setting))+
geom_point()+geom_line(aes(group=interaction(nobs,setting)))+
scale_x_log10()+scale_y_log10()
gg1 <- ggplot(resc2,aes(x=nobs,y=elapsed,colour=npred, linetype=setting))+
geom_point()+geom_line(aes(group=interaction(npred,setting)))+
scale_x_log10()+scale_y_log10()
plot_grid(gg0,gg1,nrow=1)
ggsave("lmrob_times.pdf")
I have a question which I assume can be generic, but in my case it is applicable to neural network in R.
For the record I am using both h20 and neuralnet packages.
Since you may know, often, it is advised to scale he input of a neural network, in order to make the NN itself work better with the specific used activation function.
In R to do this there are several ways and I do use scale () / min / max.
Let's pretend that I have a matrix of 700x10 as input so the scaling will produce me two vectors scaled and center of carnality 10.
Now the problem starts when I want to unscale the output.
The formula sayy vOutput * vScaled (full vector) + vCenter (full vector).
Question: Should I use then all the vectors (scaled and Center) in order to the unscaling? or there is a more complex formula or boundaries that I could not find?
#sample data
df <- data.frame(col1 = c(1:5), col2 = c(11:15), target=c(1,0,0,0,1))
#normalize sample data using scale() - except the 'target' column
df_scaled <- scale(df[,-ncol(df)])
df_scaled
#revert back to original data from scaled version
df_original <- as.data.frame(t(apply(df_scaled, 1,
function(x) (x * attr(df_scaled, 'scaled:scale') + attr(df_scaled, 'scaled:center')))))
df_original
I am trying to compare forecast reconciliation methods from the hts package on previously existing forecasts. The forecast.gts function is not available to me since there is no computationally tractable way to create a user defined function that returns the values in a forecast object. Because of this, I am using the combinef() function in the package to redistribute the forecasts. I have been able to work of the proper weights to get the wls and nseries methods, and the ols version is the default. I was able to get the "bottom up" method using:
# Creates sample forecasts, taken from `combinef()` example
library(hts)
h <- 12
ally <- aggts(htseg1)
allf <- matrix(NA, nrow = h, ncol = ncol(ally))
for(i in 1:ncol(ally))
allf[,i] <- forecast(auto.arima(ally[,i]), h = h, PI = FALSE)$mean
allf <- ts(allf, start = 51)
# create the weight vector
numTS <- ncol(allf) # Get the total number of series
numBaseTS <- sum(tail(htseg1$nodes, 1)[[1]]) # Get the number of bottom level series
# Create weights of 0 for all aggregate ts and 1 for the base level
weightVals <- c(rep(0, numTS - numBaseTS), rep(1, numBaseTS))
y.f <- combinef(allf, htseg1$nodes, weights = weightVals)
I was hoping that something like making the first weight 1 and the rest 0 might give me one of the three top down forecast, but that just results in a bunch of 0s or NaN values depending on how you try to look at it.
combinef(allf, htseg1$nodes, weights = c(1, rep(0, numTS - 1)))
I know the top down methods aren't the hardest thing to compute manually, and I can just write a function to do that, but are there any tools in the hts package that can help with this? I'd like to keep the data format consistent to simplify my analysis. Most specifically, I would like to get the "top down forcasted proportions" or tdfp method.
The functions to reconcile the forecasts using the "top-down" method are currently not exported. Probably I should export them to make the "top-down" results as tractable as combinef() in the next version. The workaround is as follows:
hts:::TdFp(allf, nodes = htseg1$nodes)
Hope it helps.