How to plot a 3d scatter plot in R? - r

I have MATLAB code that I am trying to convert into R.
Here is the MATLAB code:
x1=[2 3 1 2 2.5];
x2=[2 3 2.1 2 2.5];
yy=[2 3 6 6.5 9.5];
xx=[x1; x2];
AA=yy*xx'*inv(xx*xx');
xx1=[0 0 4 4];
xx2=[0 4 0 4];
xxx=[xx1; xx2];
yy1=AA*xxx;
yy2=reshape(yy1,2,2);
[mg1,mg2]=meshgrid(0:4:4);
figure;
plot3(x1,x2,yy,'r.');
grid on;
axis([0 4 0 4 0 12]);
hold on;
surf(mg1,mg2,yy2);
view([259 44]);
xlabel('Feature 1');ylabel('Feature 2');zlabel("Responses");
This is the R code which I made from the above MATLAB code
x1 = matrix(c(2, 3, 1, 2, 2.5), nrow=1, ncol = 5)
x2 = matrix(c(2, 3, 2.1, 2, 2.5), nrow=1, ncol = 5)
yy = matrix(c(2, 3, 6, 6.5, 9.5), nrow=1, ncol = 5)
xx = rbind(x1,x2)
AA = yy %*% t(xx) %*% solve(xx %*% t(xx))
xx1 = matrix(c(0, 0, 4, 4), nrow = 1, ncol = 4)
xx2 = matrix(c(0, 4, 0, 4), nrow = 1, ncol = 4)
xxx = rbind(xx1,xx2)
yy1 = AA %*% xxx
yy2 = matrix(yy1,nrow = 2, ncol = 2)
s3d <-scatterplot3d(x1,x2,yy, pch=16, highlight.3d=TRUE,
type="h", main="3D Scatterplot")
fit <- lm(yy ~ x1+x2)
s3d$plane3d(fit)
grid()
persp(mg1,mg2,yy2,
theta=30, phi=30, expand=0.6,
col='lightblue', shade=0.75, ltheta=120,
ticktype='detailed')
At this point, I get the following error:
Error in s3d$plane3d(fit) : dims [product 55] do not match the length of object [0]
Obtained Output:
Required Output:

Related

What color does plot.xts use?

Does anybody know what colours plot.xts uses? I can't find anything on the help page.
I would like to use the same colours in my legend.
Or is there another way to get the same plot with addLegend()?
Here the code I am using:
library(xts)
library(PerformanceAnalytics)
library(TTR)
xts1 <- xts(matrix(rnorm(300), ncol = 3), order.by = as.Date(1:100))
xts2 <- xts(matrix(rnorm(300), ncol = 3), order.by = as.Date(1:100))
colnames(xts1) <- c("A", "B", "C")
colnames(xts2) <- c("A", "B", "C")
plot_chart <- function(x) {
ff <- tempfile()
png(filename = ff)
chart.CumReturns(x)
dev.off()
unlink(ff)
}
m <- matrix(c(1, 2, 3, 3), nrow = 2, ncol = 2, byrow = TRUE)
layout(mat = m, heights = c(0.8, 0.1))
par(mar = c(2, 2, 1, 1))
plot_chart(xts1)
addSeries(reclass(apply(xts1, 2, runSD), xts1))
par(mar = c(2, 2, 1, 1))
plot_chart(xts2)
addSeries(reclass(apply(xts2, 2, runSD), xts2))
par(mar=c(0, 0, 1, 0))
plot(1, type = "n", axes = FALSE, xlab = "", ylab = "")
# which colors do I have to insert in here?
plot_colors <- c("blue", "green", "pink")
legend(x = "top", inset = 0,
legend = colnames(xts1),
col = plot_colors, lwd = 7, cex = .7, horiz = TRUE)
Answer
Use the colorset argument of chart.CumReturns:
plot_chart <- function(x, col) {
ff <- tempfile()
png(filename = ff)
chart.CumReturns(x, colorset = col)
dev.off()
unlink(ff)
}
par(mar = c(2, 2, 1, 1))
plot_chart(xts1, col = plot_colors)
addSeries(reclass(apply(xts1, 2, runSD), xts1))
par(mar = c(2, 2, 1, 1))
plot_chart(xts2, col = plot_colors)
addSeries(reclass(apply(xts2, 2, runSD), xts2))

Calling ROI "LP "and "QP" functions

I am trying to reproduce some of the examples given by the ROI creators.
For example in http://statmath.wu.ac.at/courses/optimization/Presentations/ROI-2011.pdf (slides 15-17) there is the example:
library("ROI")
#ROI: R Optimization Infrastructure
#Installed solver plugins: cplex, lpsolve, glpk, quadprog, symphony, nlminb.
#Default solver: glpk.
(constr1 <- L_constraint(c(1, 2), "<", 4))
#An object containing 1 linear constraints.
(constr2 <- L_constraint(matrix(c(1:4), ncol = 2), c("<", "<"), c(4, 5)))
#An object containing 2 linear constraints.
rbind(constr1, constr2)
#An object containing 3 linear constraints.
(constr3 <- Q_constraint(matrix(rep(2, 4), ncol = 2), c(1, 2), "<", 5))
#An object containing 1 constraints.
#Some constraints are of type quadratic.
foo <- function(x) {sum(x^3) - seq_along(x) %*% x}
F_constraint(foo, "<", 5)
lp <- LP(objective = c(2, 4, 3), L_constraint(L = matrix(c(3, 2, 1, 4, 1, 3, 2, 2, 2), nrow = 3), dir = c("<=", "<=", "<="), rhs = c(60, 40, 80)), maximum = TRUE)
qp <- QP(Q_objective(Q = diag(1, 3), L = c(0, -5, 0)), L_constraint(L = matrix(c(-4, -3, 0, 2, 1, 0, 0, -2, 1), ncol = 3, byrow = TRUE), dir = rep(">=", 3), rhs = c(-8, 2, 0)))
When I run it I get the errors
Error in LP(objective = c(2, 4, 3), L_constraint(L = matrix(c(3, 2, 1, :
could not find function "LP"
and
Error in QP(Q_objective(Q = diag(1, 3), L = c(0, -5, 0)), L_constraint(L = matrix(c(-4, :
could not find function "QP"
In fact the functions are not in ROI's namespace. e.g.
ROI::LP
Error: 'LP' is not an exported object from 'namespace:ROI'
The same syntax appears in other examples I found on the web but the functions LP and QP are never defined.
I am using ROI 0.3.0
Can someone tell me what is going wrong?
The commands LP and QP were both changed to OP.
library("ROI")
## ROI: R Optimization Infrastructure
## Registered solver plugins: nlminb, alabama, cbc, cccp, clp, deoptim, ecos, glpk, ipop, lpsolve, msbinlp, neos, nloptr, ucminf, spg, cgm, vmm, bobyqa, newuoa, uobyqa, hjk, nmk, lbfgs, optimx, qpoases, quadprog, scs, symphony.
## Default solver: auto.
(constr1 <- L_constraint(c(1, 2), "<", 4))
## An object containing 1 linear constraint.
(constr2 <- L_constraint(matrix(c(1:4), ncol = 2), c("<", "<"), c(4, 5)))
## An object containing 2 linear constraints.
rbind(constr1, constr2)
## An object containing 3 linear constraints.
(constr3 <- Q_constraint(matrix(rep(2, 4), ncol = 2), c(1, 2), "<", 5))
## An object containing 0 linear constraints
## 1 quadratic constraint.
foo <- function(x) {sum(x^3) - seq_along(x) %*% x}
F_constraint(foo, "<", 5)
## An object containing 1 nonlinear constraint.
lp <- OP(objective = c(2, 4, 3),
L_constraint(L = matrix(c(3, 2, 1, 4, 1, 3, 2, 2, 2), nrow = 3),
dir = c("<=", "<=", "<="),
rhs = c(60, 40, 80)), maximum = TRUE)
qp <- OP(Q_objective(Q = diag(1, 3), L = c(0, -5, 0)),
L_constraint(L = matrix(c(-4, -3, 0, 2, 1, 0, 0, -2, 1), ncol = 3, byrow = TRUE),
dir = rep(">=", 3), rhs = c(-8, 2, 0)))
The slides you refer to are outdated. The new documentation is on http://roi.r-forge.r-project.org !

How to calculate the number of edges between nodes of a certain group?

I have the following dataset and the following script:
library(GGally)
library(ggnet)
library(network)
library(sna)
library(ggplot2)
# edgelist
e <- data.frame(sender = c(1, 1, 1, 1, 2, 2, 2, 3, 3, 3, 3, 4, 4, 5),
receiver = c(2, 3, 4, 5, 1, 3, 1, 1, 2, 2, 4, 3, 2, 4))
# information about the nodes (vertices)
v <- data.frame(actors = c(1, 2, 3, 4, 5),
groups = c("A", "A", "B", "C", "D"))
net <- network(e, directed = TRUE)
x = data.frame(actors = network.vertex.names(net))
x = merge(x, v, by = "actors", sort = FALSE)$groups
net %v% "group" = as.character(x)
y = RColorBrewer::brewer.pal(9, "Set1")[ c(3, 1, 9, 6, 8) ]
names(y) = levels(x)
ggnet2(net, color = "group", palette = y, alpha = 0.75, size = 4, edge.alpha = 0.5, arrow.size = 8, arrow.gap = 0.01)
Is there an easy and fast way to calculate the number of edges from group of nodes (A, B, C, D) to the same group of nodes or to another group of nodes (i.e., from A-A, A-B, A-C, A-D, B-A, etc.)?
There is network.edgecountin the network-Package. But how can I apply it to my question?
The mixingmatrix function from network does the trick. It displays the number of ties within and between groups, getting at homophily and assortive mixing.
> mixingmatrix(net, "group")
To
From A B C D Total
A 3 2 1 1 7
B 3 0 1 0 4
C 1 1 0 0 2
D 0 0 1 0 1
Total 7 3 3 1 14

How to use deepnet for classification in R

When i use code from example:
library(deepnet)
Var1 <- c(rnorm(50, 1, 0.5), rnorm(50, -0.6, 0.2))
Var2 <- c(rnorm(50, -0.8, 0.2), rnorm(50, 2, 1))
x <- matrix(c(Var1, Var2), nrow = 100, ncol = 2)
y <- c(rep(1, 50), rep(0, 50))
nn <- dbn.dnn.train(x, y, hidden = c(5))
it works. But when i use this code:
Var1 <- c(rnorm(50, 1, 0.5), rnorm(50, -0.6, 0.2))
Var2 <- c(rnorm(50, -0.8, 0.2), rnorm(50, 2, 1))
x <- matrix(c(Var1, Var2), nrow = 100, ncol = 2)
**y <- c(rep("1", 50), rep("0", 50))**
nn <- dbn.dnn.train(x, y, hidden = c(5))
i receive error:
Error in batch_y - nn$post[[i]] : non-numeric argument to binary operator
How can i use deepnet package for classification problem?
y1 <- c(rep("1", 50), rep("0", 50))
lead you to character vector which is not acceptable by the package. so that you get error
class(y)
#[1] "character"
The right y should be numeric as follows
y <- c(rep(1, 50), rep(0, 50))
class(y)
#[1] "numeric"
if you see inside your y , you can find that you have 1 or 0 which is a binary values for classification
> table(y)
#y
# 0 1
#50 50
If you want to train as it is mentioned in the manual, you can do the following to train and predict a test set
Var1 <- c(rnorm(50, 1, 0.5), rnorm(50, -0.6, 0.2))
Var2 <- c(rnorm(50, -0.8, 0.2), rnorm(50, 2, 1))
x <- matrix(c(Var1, Var2), nrow = 100, ncol = 2)
y <- c(rep(1, 50), rep(0, 50))
If you now look at your x and y by str just simply write str(x) or str(y) you can see that they are numeric (to make sure, you can check them by class(x) and class(y).
After having your X and y , then you can build your model
dnn <- dbn.dnn.train(x, y, hidden = c(5, 5))
If you have a test set to predict, then you can predict it using for example as is mentioned in the manual
test_Var1 <- c(rnorm(50, 1, 0.5), rnorm(50, -0.6, 0.2))
test_Var2 <- c(rnorm(50, -0.8, 0.2), rnorm(50, 2, 1))
test_x <- matrix(c(test_Var1, test_Var2), nrow = 100, ncol = 2)
nn.test(dnn, test_x, y)
#[1] 0.25
Again your test_x must be numeric. If your problem is that you have the values as character, then you can convert it to numeric by mydata<- as.numeric()

hist3D 2D plot in background in R

Is it possible to add a 2d plot to a 3D plot in R?
I have the following R code that generates a 3d bar plot.
dt = structure(c(1, 1, 1, 3,
0, 2, 2, 1,
1, 2, 1, 3,
2, 6, 3, 1,
1, 2, 3, 0,
1, 0, 2, 1,
1,2,2,2), .Dim = c(4L, 7L), .Dimnames = list(c("0-50",
"51-60", "61-70", "71-80"
), c("0-50", "51-60", "61-70", "71-80", "81-90", "91-100", "101-Inf")))
m <- matrix(rep(seq(4),each=7), ncol=7, nrow=4, byrow = TRUE)
hist3D(x = 1:4, z = dt, scale = T,bty="g", phi=35,theta=30,border="black",space=0.15,col = jet.col(5, alpha = 0.8), add = F, colvar = m, colkey = F, ticktype = "detailed")
The hist3d call only:
hist3D(x = 1:4, z = dt, scale = T,bty="g", phi=35,theta=30, border="black", space=0.15,col = jet.col(5, alpha = 0.8), add = F, colvar = m, colkey = F, ticktype = "detailed")
This generates the following 3d plot:
What I'm looking for is being able to add a plot in the position where the grey grid is. Is it possible?
Thanks!
As far as I know, there isn't a good function to make a barplot in RGL. I suggest a manual method.
dt = structure(c(1, 1, 1, 3,
0, 2, 2, 1,
1, 2, 1, 3,
2, 6, 3, 1,
1, 2, 3, 0,
1, 0, 2, 1,
1,2,2,2), .Dim = c(4L, 7L), .Dimnames = list(c("0-50",
"51-60", "61-70", "71-80"
), c("0-50", "51-60", "61-70", "71-80", "81-90", "91-100", "101-Inf")))
Making 3D barplot in RGL
library(rgl)
# make dt xyz coordinates data
dt2 <- cbind( expand.grid(x = 1:4, y = 1:7), z = c(dt) )
# define each bar's width and depth
bar_w <- 1 * 0.85
bar_d <- 1 * 0.85
# make a base bar (center of undersurface is c(0,0,0), width = bar_w, depth = bar_d, height = 1)
base <- translate3d( scale3d( cube3d(), bar_w/2, bar_d/2, 1/2 ), 0, 0, 1/2 )
# make each bar data and integrate them
bar.list <- shapelist3d(
apply(dt2, 1, function(a) translate3d(scale3d(base, 1, 1, a[3]), a[1], a[2], 0)),
plot=F)
# set colors
for(i in seq_len(nrow(dt2))) bar.list[[i]]$material$col <- rep(jet.col(5)[c(1:3,5)], 7)[i]
open3d()
plot3d(0,0,0, type="n", xlab="x", ylab="y", zlab="z", box=F,
xlim=c(0.5, 4.5), ylim=c(0.5, 7.5), zlim=c(0, 6.2), aspect=T, expand=1)
shade3d(bar.list, alpha=0.8)
wire3d(bar.list, col="black")
light3d(ambient="black", diffuse="gray30", specular="black") # light up a little
Add a 2d plot
# show2d() uses 2d plot function's output as a texture
# If you need the same coordinates of 2d and 3d, plot3d(expand=1) and show2d(expand=1),
# the same xlims, equivalent plot3d(zlim) to 2d plot's ylim, 2d plot(xaxs="i", yaxs="i") are needed.
show2d({
par(mar = c(0,0,0,0))
barplot(c(3,4,5,6), yaxs="i", ylim=c(0, 6.2))
},
expand = 1 , face = "y+", texmipmap = F) # texmipmap=F makes tone clear

Resources