Related
I encounter a problem with the package shp2graph. I want to use the function PN.amalgamation which works fine (see below). Afterwards, I would like to create an igraph object. Here the code fails to do that.
I can create igraph objects just fine with every non-amalgamated shp2graph object.
Here my sample code, which largely is a copy paste from the description of the package shp2graph:
library(igraph)
library(shp2graph)
data(ORN)
rtNEL<-readshpnw(ORN.nt, ELComputed=TRUE)
res.sl<-SL.extraction(rtNEL[[2]],rtNEL[[3]])
res.me<-ME.simplification(res.sl[[1]],res.sl[[2]],DegreeL=res.sl[[4]])
res.pn<-PN.amalgamation(res.me[[1]],res.me[[2]],DegreeL=res.me[[4]])
ptcoords<-Nodes.coordinates(res.pn[[1]])
plot(ORN.nt)
points(ptcoords, col="green")
plot(ORN.nt)
points(Nodes.coordinates(rtNEL[[2]]), col="red")
# igraph created from amalgamation is wrong
test <- nel2igraph(nodelist= res.pn[[1]], edgelist=res.pn[[2]], Directed = TRUE)
plot(test,vertex.size=1,edge.width=1,edge.arrow.size=0,vertex.label=NA)
# res.me is one step before amalgamation
test <- nel2igraph(nodelist= res.me[[1]], edgelist=res.me[[2]], Directed = TRUE)
plot(test,vertex.size=1,edge.width=1,edge.arrow.size=0,vertex.label=NA)
Any help is appreciated.
I have found that the bug lies somehow in the interaction with the igraph package. The issue is that the labels of the nodes create by PN.amalgamation are not continuous anymore; some are missing, since we deleted them. However, igraph somehow still tries to create them and gives then the following warning:
For anyone having the same trouble here a work-around, which re-indeces the labels.
Create your own nel2igraph function:
nel2igraph_corr <- function (nodelist, edgelist, weight = NULL, eadf = NULL, Directed = FALSE)
{
nodes <- nodelist[, 1]
Ne <- length(edgelist[, 1])
Nn <- length(nodes)
for (i in 1:Nn) {
kk <- nodelist[i,][[1]]
edgelist[which(edgelist[,c(2)]==kk),2] <- i
edgelist[which(edgelist[,c(3)]==kk),3] <- i
nodelist[i,][[1]] <- i
}
if (!is.null(weight)) {
if (length(weight) != Ne && is.numeric(weight))
stop("Please give right edge weight, which must be numeric and the same length as edges elment")
}
if (!is.null(eadf)) {
if (length(eadf[, 1]) != Ne)
stop("The eadf must be numeric and the same length as edges elment")
}
gr <- graph.edgelist(unique(edgelist[, c(2, 3)]), directed = T)
gr <- set.vertex.attribute(gr, "x", V(gr), Nodes.coordinates(nodelist)[,1])
gr <- set.vertex.attribute(gr, "y", V(gr), Nodes.coordinates(nodelist)[,
2])
gr.es <- E(gr)
if (!is.null(weight))
gr <- set.edge.attribute(gr, "weight", gr.es, weight)
if (!is.null(eadf)) {
eanms <- colnames(eadf)
n <- length(eanms)
for (i in 1:n) gr <- set.edge.attribute(gr, eanms[i],
gr.es, eadf[, i])
}
gr
}
I want to plot or visualize the result of each layers out from a trained CNN with mxnet in R. Like w´those abstract art from what a nn's each layer can see.
But I don't know how. Please somebody help me. One way I can think out is to put the weights and bias back to every step and plot the step out. But when I try to put model$arg.params$convolution0_weight back to mx.symbol.Convolution(), I get
Error in mx.varg.symbol.Convolution(list(...)) :
./base.h:291: Unsupported parameter type object type for argument weight, expect integer, logical, or string.
Can anyone help me?
I thought out one way, but encounter a difficulty at one step. Here is what I did.
I found all the trained cnn's parameters inmodel$arg.params , and to compute with parameters we can use mx.nd... founctions as bellow:
`#convolution 1_result
conv1_result<- mxnet::mx.nd.Convolution(data=mx.nd.array(train_array),weight=model$arg.params$convolution0_weight,bias=model$arg.params$convolution0_bias,kernel=c(8,8),num_filter = 50)
str(conv1_result)
tanh1_result<-mx.nd.Activation(data= conv1_result, act_type = "sigmoid")
pool1_result <- mx.nd.Pooling(data = tanh1_result, pool_type = "avg", kernel = c(4,4), stride = c(4,4))
conv2 result
conv2_result<- mxnet::mx.nd.Convolution(data=pool1_result,weight=model$arg.params$convolution1_weight,bias=model$arg.params$convolution1_bias,kernel=c(5,5),num_filter = 50)
tanh2_result<-mx.nd.Activation(data= conv1_result, act_type = "sigmoid")
pool2_result <- mx.nd.Pooling(data = tanh1_result, pool_type = "avg", kernel = c(4,4), stride = c(4,4))
1st fully connected layer result
flat_result <- mx.nd.flatten(data = pool2_result)
fcl_1_result <- mx.nd.FullyConnected(data = flat_result,weight = model$arg.params$fullyconnected0_weight,bias = model$arg.params$fullyconnected0_bias, num_hidden = 500)
tanh_3_result <- mx.nd.Activation(data = fcl_1_result, act_type = "tanh")
2nd fully connected layer result
fcl_2_result <- mx.nd.FullyConnected(data = tanh_3,weight = model$arg.params$fullyconnected1_weight,bias = model$arg.params$fullyconnected1_bias, num_hidden =100)`
but when I came to mx.nd.FullyConnected() step , I encountered not sufficient memory(i have 16 GB RAM) and R crashed.
So, does anyone know how to batch_size the input data in
mx.nd.FullyConnected(), or any method to make mx.nd.FullyConnected() run successfully as mx.model.FeedForward.create()
did?
Here is the code that can help you to achieve what you want. The code below displays activations of 2 convolution layers of LeNet. The code gets as an input MNIST dataset, which is 28x28 grayscale images (downloaded automatically), and produces images as activations.
You can grab outputs from executor. To see the list of available outputs use names(executor$ref.outputs)
The result of each output is available as a matrix with values in [-1; 1] range. The dimensions of the matrix depends on parameters of the layer. The code use these matrices to display as greyscaled images where -1 is white pixel, 1 - black pixel. (most of the code is taken from https://github.com/apache/incubator-mxnet/issues/1152 and massaged a little bit)
The code is a self sufficient to run, but I have noticed that if I build the model second time in the same R session, the names of ouputs get different indices, and later the code fails because the expected names of outputs are hard coded. So if you decide to create a model more than once, you will need to restart R session.
Hope it helps and you can adjust this example to your case.
library(mxnet)
download.file('https://apache-mxnet.s3-accelerate.dualstack.amazonaws.com/R/data/mnist_csv.zip', destfile = 'mnist_csv.zip')
unzip('mnist_csv.zip', exdir = '.')
train <- read.csv('train.csv', header=TRUE)
data.x <- train[,-1]
data.x <- data.x/255
data.y <- train[,1]
val_ind = 1:100
train.x <- data.x[-val_ind,]
train.x <- t(data.matrix(train.x))
train.y <- data.y[-val_ind]
val.x <- data.x[val_ind,]
val.x <- t(data.matrix(val.x))
val.y <- data.y[val_ind]
train.array <- train.x
dim(train.array) <- c(28, 28, 1, ncol(train.x))
val.array <- val.x
dim(val.array) <- c(28, 28, 1, ncol(val.x))
# input layer
data <- mx.symbol.Variable('data')
# first convolutional layer
convLayer1 <- mx.symbol.Convolution(data=data, kernel=c(5,5), num_filter=30)
convAct1 <- mx.symbol.Activation(data=convLayer1, act_type="tanh")
poolLayer1 <- mx.symbol.Pooling(data=convAct1, pool_type="max", kernel=c(2,2), stride=c(2,2))
# second convolutional layer
convLayer2 <- mx.symbol.Convolution(data=poolLayer1, kernel=c(5,5), num_filter=60)
convAct2 <- mx.symbol.Activation(data=convLayer2, act_type="tanh")
poolLayer2 <- mx.symbol.Pooling(data=convAct2, pool_type="max",
kernel=c(2,2), stride=c(2,2))
# big hidden layer
flattenData <- mx.symbol.Flatten(data=poolLayer2)
hiddenLayer <- mx.symbol.FullyConnected(flattenData, num_hidden=500)
hiddenAct <- mx.symbol.Activation(hiddenLayer, act_type="tanh")
# softmax output layer
outLayer <- mx.symbol.FullyConnected(hiddenAct, num_hidden=10)
LeNet1 <- mx.symbol.SoftmaxOutput(outLayer)
# Group some output layers for visual analysis
out <- mx.symbol.Group(c(convAct1, poolLayer1, convAct2, poolLayer2, LeNet1))
# Create an executor
executor <- mx.simple.bind(symbol=out, data=dim(val.array), ctx=mx.cpu())
# Prepare for training the model
mx.set.seed(0)
# Set a logger to keep track of callback data
logger <- mx.metric.logger$new()
# Using cpu by default, but set gpu if your machine has a supported one
devices=mx.cpu(0)
# Train model
model <- mx.model.FeedForward.create(LeNet1, X=train.array, y=train.y,
eval.data=list(data=val.array, label=val.y),
ctx=devices,
num.round=1,
array.batch.size=100,
learning.rate=0.05,
momentum=0.9,
wd=0.00001,
eval.metric=mx.metric.accuracy,
epoch.end.callback=mx.callback.log.train.metric(100, logger))
# Update parameters
mx.exec.update.arg.arrays(executor, model$arg.params, match.name=TRUE)
mx.exec.update.aux.arrays(executor, model$aux.params, match.name=TRUE)
# Select data to use
mx.exec.update.arg.arrays(executor, list(data=mx.nd.array(val.array)), match.name=TRUE)
# Do a forward pass with the current parameters and data
mx.exec.forward(executor, is.train=FALSE)
# List of outputs available.
names(executor$ref.outputs)
# Plot the filters of a sample from validation set
sample_index <- 99 # sample number in validation set. Change it to if you want to see other samples
activation0_filter_count <- 30 # number of filters of the "convLayer1" layer
par(mfrow=c(6,5), mar=c(0.1,0.1,0.1,0.1)) # number of rows x columns in output
dim(executor$ref.outputs$activation0_output)
for (i in 1:activation0_filter_count) {
outputData <- as.array(executor$ref.outputs$activation0_output)[,,i,sample_index]
image(outputData,
xaxt='n', yaxt='n',
col=gray(seq(1,0,-0.1)))
}
activation1_filter_count <- 60 # number of filters of the "convLayer2" layer
dim(executor$ref.outputs$activation1_output)
par(mfrow=c(6,10), mar=c(0.1,0.1,0.1,0.1)) # number of rows x columns in output
for (i in 1:activation1_filter_count) {
outputData <- as.array(executor$ref.outputs$activation1_output)[,,i,sample_index]
image(outputData,
xaxt='n', yaxt='n',
col=gray(seq(1,0,-0.1)))
}
As a result you should see the following images for a validation sample #2 (use RStudio left and right arrows to navigate between them).
I think I have read every page on the internet that mentions coldiss and I am still having trouble getting the labels to look correctly. In the image I inserted, the matrices look good but the labels are default numbers (so aren't that useful for a stand alone image) and in the ordered matrix the matrix gets ordered correctly, but the labels didn't re-order, which doesn't make sense.
[Matrix output images][1]
My questions are:
1) How do I get the labels to order properly for the ordered matrix? If the cells in the heat map are changing colors after being ordered, the respective labels should be different too.
2) Is it possible to edit the coldiss function to use my isolate labels that can be found in the top row or first column to label the heat map rather than the default numbers?
Here is the code I'm running.
library(gclus)
library(ape)
source("coldiss.txt")
tree<-read.tree("BP_SNPS_only-BioNJ_tree_100BS")
PatristicDistMatrix100BS<-cophenetic.phylo(tree)
coldiss(D = PatristicDistMatrix100BS, nc = 4, byrank = TRUE, diag = TRUE)
Here is the coldiss.txt file:
# coldiss()
# Color plots of a dissimilarity matrix, without and with ordering
#
# License: GPL-2
# Author: Francois Gillet, 23 August 2012
#
"coldiss" <- function(D, nc = 4, byrank = TRUE, diag = FALSE)
{
require(gclus)
if (max(D)>1) D <- D/max(D)
if (byrank) {
spe.color <- dmat.color(1-D, cm.colors(nc))
}
else {
spe.color <- dmat.color(1-D, byrank=FALSE, cm.colors(nc))
}
spe.o <- order.single(1-D)
speo.color <- spe.color[spe.o, spe.o]
op <- par(mfrow=c(1,2), pty="s")
if (diag) {
plotcolors(spe.color, rlabels=attributes(D)$Labels,
main="Dissimilarity Matrix",
dlabels=attributes(D)$Labels)
plotcolors(speo.color, rlabels=attributes(D)$Labels[spe.o],
main="Ordered Dissimilarity Matrix",
dlabels=attributes(D)$Labels[spe.o])
}
else {
plotcolors(spe.color, rlabels=attributes(D)$Labels,
main="Dissimilarity Matrix")
plotcolors(speo.color, rlabels=attributes(D)$Labels[spe.o],
main="Ordered Dissimilarity Matrix")
}
par(op)
}
# Usage:
# coldiss(D = dissimilarity.matrix, nc = 4, byrank = TRUE, diag = FALSE)
# If D is not a dissimilarity matrix (max(D) > 1), then D is divided by max(D)
# nc number of colours (classes)
# byrank= TRUE equal-sized classes
# byrank= FALSE equal-length intervals
# diag = TRUE print object labels also on the diagonal
# Example:
# coldiss(spe.dj, nc=9, byrank=F, diag=T)
Here is an abbreviated version of PatristicDistMatrix100BS:
CDC-B043_1995 CDC-A267_1994 CDC-A161_1992 CDC-C931_1998
CDC-B043_1995 0 0.00099 0.00099 0.00166
CDC-A267_1994 0.00099 0 0.00066 0.00133
CDC-A161_1992 0.00099 0.00066 0 0.00133
CDC-C931_1998 0.00166 0.00133 0.00133 0
I hope this provides all the relevant information and thank you for any help you can provide even if it's a completely different function.
There is nothing wrong in the code. The main problem I think is some other packages you have loaded. I also had same problem but when I tried separately it worked well and as you require. Just remove other packages or calculate separately. For more details have a look on the code of chapter three of this document (http://adn.biol.umontreal.ca/~numericalecology/numecolR/). Here is the code I work with.
(vegan must be loaded after ade4 to avoid some conflicts)
library(ade4)
library(vegan)
library(gclus)
library(cluster)
library(FD)
files must be in the working directory. You can search this file from internet from this link (https://github.com/JoeyBernhardt/NumericalEcology)
source("coldiss.R")
source("panelutils.R")
Then calculate your dissimilarity matrix and plot using the code
BCD <- vegdist(df[-1])
coldiss(BCD, byrank = FALSE, diag = TRUE)
Hopefully it will work.
I have used smoothing to create two "functions" fd4 and fd6.
fit6 <- smooth.basis(tid6, zbegfor, fdParobj2)
fd6 <- fit6$fd
I want to measure the L2 distance between them on the interval [0,1], but I haven't been able to find an appropriate way.
||f − g||_2 = sqrt(int(|f(x)-g(x)|^2,0,1))
The best bet has been this one: How to calculate functional L_2 norm using R, but when I use fd6 instead of f <- function(x) x^2, I get the following message:
"Error in fac - fdmat : non-conformable arrays".
I've spent hours trying to find a solution. Please help me!
Now with reproducible code:
library(fda)
# Smoothing of movement pattern without obstacle rescaled to the interval [0,1]
without <- c(22.5050173512478, 22.5038665040295, 22.5171851824298, 22.5368096190746,
22.5770229184757, 22.6709727229898, 22.8195669635573, 23.0285400460222,
23.3240853426905, 23.6895323912605, 24.0905709304813, 24.5674870961964,
25.129085512519, 25.7433521858875, 26.4096817521118, 27.1338935155912,
27.906416101033, 28.7207273157549, 29.5431756517467, 30.3697951466496,
31.2214907341765, 32.0625307132683, 32.8786845916855, 33.671550678219,
34.4449992914392, 35.1852293010227, 35.8866367048324, 36.5650863548079,
37.1776116180247, 37.7706354957587, 38.3082855431959, 38.8044130844639,
39.2471137254193, 39.6193031585418, 39.9685683244076, 40.2345560551869,
40.4394442661545, 40.5712407258558, 40.6905311089523, 40.712419802203,
40.6704560575084, 40.5583379372846, 40.3965425630546, 40.1443139907057,
39.8421899334408, 39.4671160834355, 39.018733225651, 38.5381390971577,
38.035680135599, 37.4625783280288, 36.8649362406917, 36.2320264206665,
35.5599736527209, 34.8983871226943, 34.2058073957721, 33.4893682831911,
32.7568501019309, 32.0241649500974, 31.3036406455137, 30.587636320768,
29.8962657607091, 29.2297665999702, 28.6003939337949, 28.0003531206639,
27.433551463149, 26.9088532545635, 26.4265682839796, 25.974193299003,
25.5553146923473, 25.1701249455904, 24.8107813804098, 24.4776168601955,
24.167582682288, 23.8726502760669, 23.589703789663, 23.3222235336882,
23.0616248799115, 22.8185342685607, 22.6767541125512, 22.6567795841271,
22.6488510112824, 22.6436058079441, 22.6391304188382)
timewithout <- (1:length(without))/length(without) # For scaling
splineBasis = create.bspline.basis(c(0,1), nbasis=25, norder=6) # The basis for smoothing
basis = fdPar(fdobj=splineBasis, Lfdobj=2, lambda=0.00001)
fitwithout <- smooth.basis(timewithout, without, basis) # Smoothing
fdwithout <- fitwithout$fd
# Same but movement is over an obstacle
with <- c(22.4731637093167, 22.4655561889073, 22.4853719755102, 22.4989400065304,
22.5495656349031, 22.666945409755, 22.8368941117498, 23.0846080078369,
23.4160560011242, 23.8285634914224, 24.2923085321078, 24.8297004047422,
25.4884540279408, 26.2107053559, 27.0614232848574, 27.9078055119721,
28.8449720096674, 29.8989669834473, 30.996962022701, 32.1343108758062,
33.3286403418359, 34.6364870430171, 35.9105342483246, 37.1883582665643,
38.467212668323, 39.7381525466373, 41.0395064969214, 42.3095531191294,
43.5708069740233, 44.7881178787717, 45.9965529977777, 47.1643807808923,
48.284786275036, 49.3593991064962, 50.3863035442644, 51.3535489662494,
52.2739716491521, 53.1338828493223, 53.9521101656512, 54.7037562884229,
55.3593092084143, 55.9567618011946, 56.4768579145271, 56.9251919073806,
57.2971965985674, 57.5937987523734, 57.8158626068961, 57.9554856023804,
58.009777126789, 57.9863251605612, 57.8932199088797, 57.6988126618694,
57.4350394069443, 57.1112025796509, 56.7580579506751, 56.2680669960935,
55.6963799946038, 55.0574070566765, 54.3592140352073, 53.6072275005723,
52.7876353306759, 51.9172334605074, 50.9879178368431, 49.9953932631072,
48.9460707853802, 47.8511977258834, 46.6827266395278, 45.4635999409637,
44.2633368255294, 43.0386729762103, 41.7880095105045, 40.4834298069985,
39.1610223705633, 37.9241872458281, 36.7158342529737, 35.5408830466013,
34.4070964101159, 33.307156473109, 32.2514661493348, 31.2475129673168,
30.2990631096187, 29.4096423238141, 28.590173995037, 27.8437368908309,
27.17493959411, 26.5779670740351, 26.0377946174036, 25.5731202027558,
25.1761397934058, 24.8319659155494, 24.5479180062239, 24.2940808334792,
24.09388897537, 23.934861348149, 23.7999923744404, 23.6877461628934,
23.5982309560843, 23.5207597985246, 23.4354446383638, 23.3604065265148,
23.2819126915765, 23.1725048152396, 23.0637455648184, 22.9426779696074,
22.8079176617495, 22.69360227086, 22.6622165457034, 22.6671302753094,
22.66828206305, 22.6703162730529, 22.6715781657376)
timewith <- (1:length(with))/length(with)
fitwith <- smooth.basis(timewith, with, basis) # Smoothing
fdwith <- fitwith$fd
# Plots for understanding
plot(fdwith, col=2) # Smoothed curve for movement over obstacle
plot(fdwithout, col=2, add = TRUE) # Same but no obstacle
# I have to find the L2-distance between these curves
First, one can take advantage of the possibility to perform arithmetic operations with fd objects: fdwith - fdwithout. Second, maybe there is a better way to extract values from fd objects at specific points, but this also works: predict(newdata = 0.5, fdwith - fdwithout). So,
sqrt(integrate(function(x) predict(newdata = x, fdwith-fdwithout)^2, lower = 0, upper = 1)$val)
# [1] 9.592434
I get an error while using the ARD model of the ace function in R. The error is
Error in floating.pie.asp(XX[i], YY[i], pie[i, ], radius = xrad[i], col = piecol) :
floating.pie: x values must be non-negative
library(ape)
library(phylobase)
tree <- read.nexus("data1.nexus")
plot(tree)
data <- read.csv("phagy_species.csv")
clade.full <- extract.clade(tree, node=91)
plot(clade.full)
clade.1 <- drop.tip(clade.full, "Bar_bre")
clade.2<- drop.tip(clade.1, "Par_pho")
clade.3<- drop.tip(clade.2, "Par_iph")
clade.4<- drop.tip(clade.3, "Eur_ser")
clade.5<- drop.tip(clade.4, "Opo_sym")
clade.6<- drop.tip(clade.5, "Mor_pel")
clade.7<- drop.tip(clade.6, "Aph_hyp")
clade.8<- drop.tip(clade.7, "Ere_oem")
clade.9<- drop.tip(clade.8, "Cal_bud")
clade.10<- drop.tip(clade.9, "Lim_red")
clade.11<- drop.tip(clade.10, "Act_str")
clade.12<- drop.tip(clade.11, "Hel_hec")
clade.13<- drop.tip(clade.12,"Col_dir")
clade.14<- drop.tip(clade.13, "Hyp_pau")
clade.15<- drop.tip(clade.14, "Nym_pol")
clade.16<- drop.tip(clade.15, "Mel_cin")
clade.17<- drop.tip(clade.16,"Apa_iri")
clade.18<- drop.tip(clade.17, "Bib_hyp")
clade.19<- drop.tip(clade.18, "Mar_ors")
clade.20<- drop.tip(clade.19, "Apo_cra")
clade.21<- drop.tip(clade.20, "Pse_par")
clade.22 <- drop.tip(clade.21, "Lep_sin")
clade.23<- drop.tip(clade.22, "Dis_spi")
plot(clade.23)
data2 <- as.numeric(data[,2])
model2 <- ace(data2, clade.23, type="discrete", method="ML", model="ARD")
summary(model2)
d <-logLik(model2)
deviance(model2)
AIC(model2)
plot(clade.23, type="phylogram", cex=0.8, font=3, label.offset = 0.004)
co <- c("red", "blue", "green", "black")
nodelabels(pie = model2$lik.anc, piecol = co, cex = 0.5)
And that is when I get the error. There is no error if I use the original tree without trimming. But, when i trim them to my requirements, it goes in the negative.
Here is the data
tree file
data file
The matrix you are using for the proportions of the pie has complex numbers in it. To see this, try:
class(model2$lik.anc[1,1])
The rows of that matrix define the proportions of the pies, and they need to sum to 1. Your code produces a plot with pies if I replace the pie matrix in the nodelabels function like this:
nodelabels(pie = matrix(0.25, 64, 4), piecol = co, cex = 0.5)
because now there is a legitimate matrix for the pie argument with rows that sum to 1.
As for why you have complex numbers in that matrix, I am not sure. It is probably related to all the warnings produced by the ace in your example. But that is a completely different issue.
I had the same problem with my data. I put my data into the matrix (like Slow Ioris suggested) and then unlisted the matrix.
x <- matrix(data=c(model2$lik.anc[,1],model2$lik.anc[,2],model2$lik.anc[,3],model2$lik.anc[,4]))
plotTree(tree,ftype="i",label.offset = 0.02)
nodelabels(pie = unlist(x))
For other people having the same problem also after purging imaginable parts of their data: The nodelabels function gives the same error when you provide a data.frame instead of a matrix to pie.