I have a piece of code below. I am not able to understand how exactly "decompose.graph" works. In the below code, I want to see what is there in "comps". but it shows as some structure of lists, which I m not able to understand.
Also which function can I use to see the graphical representation of "comps"(I tried plot but it is not working)
gr<-graph(c(1,2,1,3,1,4,2,3,2,4,3,4),directed=FALSE)
cl<-cliques(gr,min=2,max=2)
edges <- c()
for (i in seq_along(cl)) {
for (j in seq_along(cl)) {
if ( length(unique(c(cl[[i]], cl[[j]]))) == 3 ) {
edges <- c(edges, c(i,j))
}
}
}
plot(clq.graph) <- simplify(graph(edges))
V(clq.graph)$name <- seq_len(vcount(clq.graph))
comps <- decompose.graph(clq.graph)
lapply(comps, function(x) {
unique(unlist(cl[ V(x)$name ]))
})
Generally speaking if you want to see the code behind a function in R, you can type the function name at the command and press Enter. This will give you an overview of the code. For example:
> decompose
will give you:
function (x, type = c("additive", "multiplicative"), filter = NULL)
{
type <- match.arg(type)
l <- length(x)
f <- frequency(x)
if (f <= 1 || length(na.omit(x)) < 2 * f)
stop("time series has no or less than 2 periods")
if (is.null(filter))
filter <- if (!f%%2)
c(0.5, rep(1, f - 1), 0.5)/f
else rep(1, f)/f
trend <- filter(x, filter)
season <- if (type == "additive")
x - trend
else x/trend
periods <- l%/%f
index <- seq(1L, l, by = f) - 1
figure <- numeric(f)
for (i in 1L:f) figure[i] <- mean(season[index + i], na.rm = TRUE)
figure <- if (type == "additive")
figure - mean(figure)
else figure/mean(figure)
seasonal <- ts(rep(figure, periods + 1)[seq_len(l)], start = start(x),
frequency = f)
structure(list(x = x, seasonal = seasonal, trend = trend,
random = if (type == "additive") x - seasonal - trend else x/seasonal/trend,
figure = figure, type = type), class = "decomposed.ts")
}
<environment: namespace:forecast>
I tried the same for decompose.graph but I don't seem to have the function available. Is this isn a special library? I also have some challenges to execute your code as also the function cliques doesn't seem to be available; including what library you are working with would help.
Run the following code, you will know what's the function of decompose.graph()
library(igraph)
g <- sample_gnp(10, 1/10)
plot(g)
components <- decompose.graph(g, min.vertices=2)
par(mfrow = c(1, length(components)))
for (i in 1:length(components)){
plot(components[[i]])
}
First you will get a graph like this:
Graph created by sample_gnp()
After decompose.graph() you will get subgraphs like this:
Subgraph after decompose.graph()
Related
I'm creating a neural network and i want to use the library torch for its autograd function. Now i can convert my data to a torch_tensor, but as soon as i then add that tensor to a list of other tensors they seem to lose their torch properties (which are needed to calculate the gradient at the end of the feedforward loop).
The reason i want to put the tensors in a list is because i want the number of hidden layers and neurons per hidden layer to be customizable by the end-user. Previously, before i started using torch, i accomplished that by making a list of all the separate weight matrices, the amount of which is determined by a user-provided variable.
This is the main learning function for my neural network:
train <- function(x, y, hidden = 4, layers = 3, rate = 0.01, iterations = 10000) {
d <- ncol(x) + 1
x <- torch_tensor(x)
Wn <- list()
Wn[[1]] <- torch_randn(d, hidden[1], requires_grad = T)
if(layers > 1){
for(j in 2:layers){
Wn[[j]] <- torch_randn(hidden[j-1] + 1, hidden[j], requires_grad = T)
}
}
Wn[[layers + 1]] <- torch_randn(hidden[length(hidden)] + 1, 1, requires_grad = T)
for (i in 1:iterations) {
ff <- feedforward(x, Wn)
Wn <- backpropagate(y, Wn, ff, learn_rate = rate)
}
return(Wn)
}
My feedforward function looks like this:
feedforward <- function(x, Wn) {
h <- list(x)
for(k in 1:length(Wn)){
Zn <- cbind(1, h[[k]]) %*% Wn[[k]]
h[[k + 1]] <- relu(Zn)
}
return(h)
}
with relu <- function(x) { max(0,x) }
Is there any way of making this work? Or should i try to find a different method to do the feedforward function?
I tried to create a function f and create the function so when a value x is inserted, it spits out a function f from y.But, when I try to run the code to plot, it gives me an error that says that my y_value has no length.
f <- function(x){
if (x<0){
print(y_values<-x*x*x)
}
if(x>0 & x<=1){
print(y_values<-x*x)
}
if(x>1){
print(y_values<-sqrt(x))
}
}
x_values <- seq(-2, 2, by = 0.1)
y_values <- rep(NA, length(x_values))
for (i in seq_along(x_values)) {
x <- x_values[i]
y_values[i] <- f(x)
}
# output
plot(x_values, y_values, type = "l")
Two issues:
From ?print
‘print’ prints its argument and returns it invisibly (via
‘invisible(x)’)
So all your function f does is print the values to the console (instead of returning them).
As per your definition of f, the function does not know how to deal with x=0; so this will create a problem when you store the output of f(0) later.
We can fix these issues by slightly altering f as
f <- function(x) {
y_values <- NA
if (x<0){
y_values<-x*x*x
}
if(x>0 & x<=1){
y_values<-x*x
}
if(x>1){
y_values<-sqrt(x)
}
return(y_values)
}
Then
x_values <- seq(-2, 2, by = 0.1)
y_values <- rep(NA, length(x_values))
for (i in seq_along(x_values)) {
x <- x_values[i]
y_values[i] <- f(x)
}
plot(x_values, y_values, type = "l")
You could also use Vectorize to obtain a vectorised function f2, which allows you to pass x_values as a vector, thereby avoiding the explicit for loop:
f2 <- Vectorize(f)
x_values <- seq(-2, 2, by = 0.1)
y_values <- f2(x_values)
The resulting plot is the same.
I would recommend you explore other methods for coding something like this:
here is one option that doesn't use a for loop. If you are simply working on using for loops then the fix Mauritus Evers made should work for you.
library(tidyverse)
data.frame(x_values = seq(-2, 2, by = 0.1)) %>%
mutate(y_values = case_when(x_values < 0 ~ x_values^3,
x_values>=0 & x_values<=1 ~ x_values^2,
x_values>1 ~ sqrt(x_values))) %>%
ggplot(aes(x_values, y_values)) + geom_point()
note that I changed your code to produce output when x_value = 0.
my code is like the following:
unemp <- c(1:10)
bsp_li <- list(c(1:10),c(11:20),c(21:30))
var_data_rep <- lapply(bsp_li, function(x) {cbind(as.numeric(x), as.numeric(unemp))} ) # Create VAR data matrices
var_data_rep2 <- lapply(var_data_rep, function(x) {colnames(x) = c("rGDP", "U"); return(x)}) # Name columns
var_data_rep_ts <- lapply(var_data_rep2, function(x) {ts(x, frequency=1, start=c(1977))} ) # Make it ts again
var_data_rep_lag <- lapply(var_data_rep_ts, function(x) {VARselect(x, lag.max = 5, type = "const")} ) # Take lag with lowest SC criteria (VAR.pdf)
VARgdp_rep <- lapply(var_data_rep_ts, function(x) {VAR(x, p = var_data_rep_lag$x$selection[['SC(n)']], type = "const"); return(x)} ) # Lag=lowest SC criteria from var_data_rep_lag
if i run only the last line r always gives me the error:
Error in if ((dimension < 1) | (dimension > n)) stop("wrong embedding dimension") :
argument is of length zero
Called from: embed(y, dimension = p + 1)
But if im running it with Source then it seems to work.. any suggestions?
This seems to work (at least no error is thrown) :
VARgdp_rep <-
lapply(index(var_data_rep_ts),
function(x) {
res <- VAR(var_data_rep_ts[[x]], p =
var_data_rep_lag[[x]]$selection[['SC(n)']], type = "const");
return(res)
}
)
In you code, return(x) is strange because after doing VAR calculations .. you just return the x withc was pass to the function.
And $x seems to have no meaning here.
There is my data (x and y columns are relevant):
https://www.dropbox.com/s/b61a7enhoa0p57p/Simple1.csv
What I need is to fit the data with the polyline. Matlab code that does this is:
spline_fit.m:
function [score, params] = spline_fit (points, x, y)
min_f = min(x)-1;
max_f = max(x);
points = [min_f points max_f];
params = zeros(length(points)-1, 2);
score = 0;
for i = 1:length(points)-1
in = (x > points(i)) & (x <= points(i+1));
if sum(in) > 2
p = polyfit(x(in), y(in), 1);
pred = p(1)*x(in) + p(2);
score = score + norm(pred - y(in));
params(i, :) = p;
else
params(i, :) = nan;
end
end
test.m:
%Find the parameters
r = [100,250,400];
p = fminsearch('spline_fit', r, [], x, y)
[score, param] = spline_fit(p, x, y)
%Plot the result
y1 = zeros(size(x));
p1 = [-inf, p, inf];
for i = 1:size(param, 1)
in = (x > p1(i)) & (x <= p1(i+1));
y1(in) = x(in)*param(i,1) + param(i,2);
end
[x1, I] = sort(x);
y1 = y1(I);
plot(x,y,'x',x1,y1,'k','LineWidth', 2)
And this does work fine, producing following optimization: [102.9842, 191.0006, 421.9912]
I've implemented the same idea in R:
library(pracma);
spline_fit <- function(x, xx, yy) {
min_f = min(xx)-1;
max_f = max(xx);
points = c(min_f, x, max_f)
params = array(0, c(length(points)-1, 2));
score = 0;
for( i in 1:length(points)-1)
{
inn <- (xx > points[i]) & (xx <= points[i+1]);
if (sum(inn) > 2)
{
p <- polyfit(xx[inn], yy[inn], 1);
pred <- p[1]*xx[inn] + p[2];
score <- score + norm(as.matrix(pred - yy[inn]),"F");
params[i,] <- p;
}
else
params[i,] <- NA;
}
score
}
But I get very bad results:
> fminsearch(spline_fit,c(100,250,400), xx = Simple1$x, yy = Simple1$y)
$xval
[1] 100.1667 250.0000 400.0000
$fval
[1] 4452.761
$niter
[1] 2
As you can see, it stops after 2 iterations and doesn't produce good points.
I'll be very glad for any help in resolving this issue.
Also, if anyone knows how to implement this in C# using any free library, it will be even better. I know whereto get polyfit, but not fminsearch.
The problem here is that the likelihood surface is very badly behaved -- there are both multiple minima and discontinuous jumps -- which will make the results you get with different optimizers almost arbitrary. I will admit that MATLAB's optimizers are remarkably robust, but I would say that it's pretty much a matter of chance (and where you start) whether an optimizer will get to the global minimum for this case, unless you use some form of stochastic global optimization such as simulated annealing.
I chose to use R's built-in optimizer (which uses Nelder-Mead by default) rather than fminsearch from the pracma package.
spline_fit <- function(x, xx = Simple1$x, yy=Simple1$y) {
min_f = min(xx)-1
max_f = max(xx)
points = c(min_f, x, max_f)
params = array(0, c(length(points)-1, 2))
score = 0
for( i in 1:(length(points)-1))
{
inn <- (xx > points[i]) & (xx <= points[i+1]);
if (sum(inn) > 2)
{
p <- polyfit(xx[inn], yy[inn], 1);
pred <- p[1]*xx[inn] + p[2];
score <- score + norm(as.matrix(pred - yy[inn]),"F");
params[i,] <- p;
}
else
params[i,] <- NA;
}
score
}
library(pracma) ## for polyfit
Simple1 <- read.csv("Simple1.csv")
opt1 <- optim(fn=spline_fit,c(100,250,400), xx = Simple1$x, yy = Simple1$y)
## [1] 102.4365 201.5835 422.2503
This is better than the fminsearch results, but still different from the MATLAB results, and worse than them:
## Matlab results:
matlab_fit <- c(102.9842, 191.0006, 421.9912)
spline_fit(matlab_fit, xx = Simple1$x, yy = Simple1$y)
## 3724.3
opt1$val
## 3755.5 (worse)
The bbmle package offers an experimental/not very well documented set of tools for exploring optimization surfaces:
library(bbmle)
ss <- slice2D(fun=spline_fit,opt1$par,nt=51)
library(lattice)
A 2D "slice" around the optim-estimated parameters. The circles show the optim fit (solid) and the minimum value within each slice (open).
png("splom1.png")
print(splom(ss))
dev.off()
A 'slice' between the matlab and optim fits shows that the surface is quite rugged:
ss2 <- bbmle:::slicetrans(matlab_fit,opt1$par,spline_fit)
png("slice1.png")
print(plot(ss2))
dev.off()
i´d like to assign factors representing quantiles. Thus I need them to be numeric.
That´s why I wrote the following function, which is basically the answer to my problem:
qdum <- function(v,q){
qd = quantile(v,1:(q)/q)
v = as.data.frame(v)
v$b = 0
names(v) <- c("a","b")
i=1
for (i in 1:q){
if(i == 1)
v$b[ v$a < qd[1]] = 1
else
v$b[v$a > qd[i-1] & v$a <= qd[i]] = i
}
all = list(qd,v)
return(all)
}
you may laugh now :) .
The returned list contains a variable that can be used to assign every observation to its corresponding quantile. My question is now: is there a better way (more "native" or "core") to do it? I know about quantcut (from the gtools package), but at least with the parameters I got, I ended up with only with those unhandy(? - at least to me) thresholds.
Any feedback thats helps to get better is appreciated!
With base R, use quantiles to figure out the splits and then cut to convert the numeric variable to discrete:
qcut <- function(x, n) {
cut(x, quantile(x, seq(0, 1, length = n + 1)), labels = seq_len(n),
include.lowest = TRUE)
}
or if you just want the number:
qcut2 <- function(x, n) {
findInterval(x, quantile(x, seq(0, 1, length = n + 1)), all.inside = T)
}
I'm not sure what quantcut is but I would do the following
qdum <- function(v, q) {
library(Hmisc)
quantilenum <- cut2(v, g=q)
levels(quantilenum) <- 1:q
cbind(v, quantilenum)
}