Restricted Boltzmann Machine - r

I am currently trying to work on RBM in R using deepnet package.I trained an RBM using my own dataset with 3 input points.After training the network I got 2 sets of weights and 2 sets of biases.
My code runs like this
a<-matrix(c(1,0,0,0,1,0,0,0,1,1,1,1),nrow=4,ncol=3,byrow=T)
RBM_trn<-rbm.train(a, 2, numepochs = 30, batchsize = 100, learningrate=0.8,
momentum =0.5 ,visible_type = "bin",hidden_type = "bin" , cd = 1)
RBM_trn
The results I obtained were in the sets of 2.I got two 2x3 weight matrix.What does the other matrix mean?


Check this: https://github.com/cran/deepnet/blob/master/R/rbm_train.R
Where W and B corresponds to learnt weight and bias at every iteration using stochastic (or mini-batch) gradient descent to optimize the cost function, VW and VB combines the momentum as well (helping to minimize noisy weight updates).

Related

parameter optimisation in Hawkes Point Process in R

I have a data set with 1,000 of people some of which know each other and others do not. I am trying to predict using a hawkes point process which individuals (or nodes) will adopt a behaviour.
The issue is I am attempting to optimise the parameters.
I am assuming the edge list of who knows who is the alpha input into Hawkes, that lambda is a constant background value for all nodes and its the decay function beta I am trying to calculate.
I have this as an example, which runs but not certain this is the correct way to calculate this parameter?
library(hawkes)
#Multivariate Hawkes process - with 10 nodes
lambda0<-c(rep(0.2,10)) # set to constant to assume background intensity is equal for all nodes
alpha<-matrix(c(0.05,0.05,0,0.05,0,0.05,0.05,0,0,0.05, # matrix of who knows who 0.05 indicating a link 0 no link
0.05,0.05,0,0,0,0,0,0,0,0,
0,0,0.05,0,0,0,0,0,0,0,
0.05,0,0,0.05,0,0,0,0,0,0,
0,0,0,0,0.05,0,0,0,0,0,
0.05,0,0,0,0,0.05,0,0,0,0,
0.05,0,0,0,0,0,0.05,0,0,0,
0,0,0,0,0,0,0,0.05,0,0,
0,0,0,0,0,0,0,0,0.05,0,
0.05,0,0,0,0,0,0,0,0,0.05
),byrow=TRUE,nrow=10)
beta<-c(rep(0.7,10)) # set the initial values of beta to be able to generate some random history of events
history<-simulateHawkes(lambda0,alpha,beta,3600) # within 1 hour random generation of events for the 10 nodes
nloglik_bi_hawkes <- function(params, history){
beta <- c(params[1], params[2],params[3], params[4],params[5], params[6],params[7], params[8],params[9], params[10]) # in my real data I may have 1,000 of nodes so may need to optimise beta for more than 10.
return(likelihoodHawkes(lambda0, alpha, beta, history))
}
params_hawkes <- optim(c(rep(1,10)), nloglik_bi_hawkes, history = history) # to store the values of beta

A few points:
when using random numbers use set.seed to make the run reproducible
the beta <- line in the question is equivalent to beta <- params
the nloglik_bi_hawkes function is not really needed since you can pass likelihoodHawkes directly to optim. Fixed parameters to it can be passed to optim and it will forward them.
When I tried the code in the question it stopped after 500 function evaluations without converging. Use method = "BFGS" instead.
Thus we have
library(hawkes)
set.seed(123)
lambda0 <- rep(0.2,10)
alpha<-matrix(c(0.05,0.05,0,0.05,0,0.05,0.05,0,0,0.05,
0.05,0.05,0,0,0,0,0,0,0,0,
0,0,0.05,0,0,0,0,0,0,0,
0.05,0,0,0.05,0,0,0,0,0,0,
0,0,0,0,0.05,0,0,0,0,0,
0.05,0,0,0,0,0.05,0,0,0,0,
0.05,0,0,0,0,0,0.05,0,0,0,
0,0,0,0,0,0,0,0.05,0,0,
0,0,0,0,0,0,0,0,0.05,0,
0.05,0,0,0,0,0,0,0,0,0.05
),byrow=TRUE,nrow=10)
beta <- rep(0.7,10)
history <- simulateHawkes(lambda0, alpha, beta, 3600)
fm <- optim(rep(1, 10), likelihoodHawkes, method = "BFGS",
lambda0 = lambda0, alpha = alpha, history = history)
fm
giving:
$par
[1] 0.2656976 0.1371221 0.6215783 0.1425127 0.4481591 0.1409979 0.1428707
[8] 0.7836967 0.6930492 0.1490555
$value
[1] 15793.9
$counts
function gradient
105 26
$convergence
[1] 0
$message
NULL

Running separate epochs for fit_one_cycle function in fastai

I am trying to run different epochs of fit_one_cycle function separately; saving the model, loading it and starting a new epoch:
learn = language_model_learner(data, AWD_LSTM, drop_mult=0.5, pretrained=False).to_fp16()
learn.load('/content/gdrive/My Drive/Language Model/language_model')
learn.load_encoder('/content/gdrive/My Drive/Language Model/model_encoder');
lr = 1e-3
lr *= bs/48 # Scale learning rate by batch size
learn.unfreeze()
learn.fit_one_cycle(1, lr, moms=(0.8,0.7))
learn.save('/content/gdrive/My Drive/Language Model/language_model')
learn.save_encoder('/content/gdrive/My Drive/Language Model/model_encoder')
Question: how I should change the learning rate after each epoch?

You can check Discriminative Layer Training which uses different learning rates for different layers in the model.
Create layer groups of the model using
# creates 3 layer groups with start, middle and end groups
learn.split(lambda m: (m[0][6], m[1]))
# only randomly initialized head now trainable
learn.freeze()
Note: No need to manually split the layers fit_one_cycle automatically splits randomly.
Manually setting LR rate and weight decay for each layer group
# all layers now trainable
learn.unfreeze()
# optionally, separate LR and WD for each group for 5 epochs
learn.fit_one_cycle(5, max_lr=slice(1e-5,1e-3), wd=(1e-4,1e-4,1e-1))

Setting up a statnet model in R

I would like to simulate exponential family random graphs, and I just started learning to use the statnet and ergm R packages. From the tutorial I found online, I am able to learn an ERGM model from an example dataset:
# install.packages('statnet')
# install.packages('ergm')
# install.packages('coda')
library(statnet)
set.seed(123)
data(package='ergm') # tells us the datasets in our packages
data(florentine) # loads flomarriage and flobusiness data
# Triad model
flomodel <- ergm(flomarriage ~ edges + triangle)
summary(flomodel)
Currently, I would like to use the simulate command to simulate networks with a pre-specified number of nodes from a pre-specified formula (that is not learned from any particular dataset), for example, P(y) = 1/Z exp(a * num_edges + b * num_triangles), where a and b are user-specified coefficients.
How should I go about writing such a model in statnet?

You can simulate from a given formula with simulate (or simulate.formula):
simulate(flomarriage ~ edges + triangles, coef = c(3,1))
To fix a simulation to have the same number of edges as the given graph (flomarriage in this case)
simulate(flomarriage ~ edges + triangles, coef = c(3,1), constraints = ~edges)
Not every constraint you might want to apply is available since each requires a specific mcmc sampler, but for a list of what is available see ?ergm.constraints
To fix the simulation to have an arbitrary number of nodes and edges (not based on an observed data) a workaround is to create such a network first. For example, to simulate over networks with 17 nodes and 16 edges.
test.mat = matrix(0, 17, 17)
test.mat[1,] = 1 #adds 16 edges
test.net = as.network(test.mat, directed = F)
test.sim = simulate(test.net ~ triangles, coef = 1, constraints = ~edges)
summary.statistics(test.sim ~ edges() + triangles())
p.s. I don't recommend using the triangles term in ERGM models. The geometrically weighted terms (gwesp, gwdsp) are the best substitutes which are more stable.

how to create a random loss sample in r using if function

I am working currently on generating some random data for a school project.
I have created a variable in R using a binomial distribution to determine if an observation had a loss yes=1 or not=0.
Afterwards I am trying to generate the loss amount using a random distribution for all observations which already had a loss (=1).
As my loss amount is a percentage it can be anywhere between 0
What Is The Intuition Behind Beta Distribution # stats.stackexchange
In a third step I am looking for an if statement, which combines my two variables.
Please find below my code (which is only working for the Loss_Y_N variable):
Loss_Y_N = rbinom(1000000,1,0.01)
Loss_Amount = dbeta(x, 10, 990, ncp = 0, log = FALSE)
ideally I can combine the two into something like
if(Loss_Y_N=1 then Loss_Amount=dbeta(...) #... is meant to be a random variable with mean=0.15 and should be 0<x=<1
else Loss_Amount=0)
Any input highly appreciated!

Create a vector for your loss proportion. Fill up the elements corresponding to losses with draws from the beta. Tweak the parameters for the beta until you get the desired result.
N <- 100000
loss_indicator <- rbinom(N, 1, 0.1)
loss_prop <- numeric(N)
loss_prop[loss_indicator > 0] <- rbeta(sum(loss_indicator), 10, 990)

How to draw the regression tree correctly when clustering using R

I get stuck when trying to build a model.
I want to class the dataset freeny into 10 subsets by year.
data(freeny)
options(digits=2)
year<-as.integer(rownames(freeny))
freeny<-cbind(freeny,year)
freeny = freeny[sample(1:nrow(freeny),length(1:nrow(freeny))),1:ncol(freeny)]
freenyValues= freeny[,1:5]
freenyTargets=decodeClassLabels(freeny[,6])
freeny = splitForTrainingAndTest(freenyValues,freenyTargets,ratio=0.15)
km<-kmeans(freeny$inputsTrain,10,iter.max = 100, nstart = 5)
kclust=km$cluster
library(tree)
kclust=as.factor(kclust)
mdp=cbind(freeny$inputsTrain,kclust)
mdp<-data.frame(mdp)
mdp.tr=tree(kclust~.,mdp)
but the result is that the tree only has 5 terminal nodes.It should be 10 terminal nodes because I divide into 10 clusters by kmeans. What's wrong?

No. It shouldn't. tree is an algorithm that tries to fit a tree given predictor and response, and stops if
the terminal nodes are too small or too few to be split.
(manual page). Try adjusting the minsize parameter (see ?tree.control).
minsize: The smallest allowed node size: a weighted quantity. The
default is 10.
I think the following will do what is intended:
mdp.tr=tree(kclust~.,mdp, minsize= 1)

Resources