Can't plot the complete Cobweb diagram in Scilab - scilab

I was trying to produce the cobweb diagram of the following equation
xn+1 = xn * e ^ a(1−xn/1000), x0 = 200 and a is a constant
But somehow I couldn't plot the original function and y = (x)
The following is my code in scilab
x0 = 200
n = 20
a = 2
deff("y = F(x)", "y = x*%e^(a*(1-x/1000))")
cw = [x0 0];
x = x0;
for i = 1:n
newx = F(x);
cw = [cw;x newx; newx newx];
x = newx
end
for x = x0;
y1 = x*%e^(a*(1-x/1000))
y2 = x
end
plot2d(cw(:,1),cw(:,2),4)
plot2d(x, y1, 5)
plot2d(x, y2, 6)
title("Cobweb Diagram")
xlabel("x(n)")
ylabel("x(n+1)")

Related

Can't add numbers at a specific index to a double in R

I want create 10 b1's for each value of x1 and x2's in xp and yp lists by optimizing res formula below. However my values are somehow not added to b1.created. I get b1.created = 0 when I check after I run the code.How can I make the code work?
y <- matrix(c(1,2,3,4,2,6,7,8,9,10),ncol = 1)
x1 <- matrix(c(2,4,6,5,10,12,14,16,18,20),ncol =1)
x2 <- matrix(c(1,4,9,16,25,25,48,64,81,99),ncol = 1)
x <- cbind(x1,x2)
created.b1 = 0
normal <- function(b0,y,xp,yp,x1,x2){for (i in xp){
res <- sum((y- (b0 + x1[i]*xp[i] + x2[i]*yp[i]))^2)
optobj <- optimize(normal,c(-10,10),y =y ,xp = xp,yp =yp, x1 = x1,x2 = x2)
created.b1[i] = obtobj$minimum[i]
}
}
I think this does what you want, but please cross-check.
created.b1 <- numeric(length = 10)
for (i in 1:10)
{
opt_obj <- optimise(f = function(b0, y, xp, yp, x1, x2) sum((y - (b0 + (x1 * xp) + (x2 * yp))) ^ 2),
interval = c(-10, 10),
y = y,
xp = xp[i],
yp = yp[i],
x1 = x1,
x2 = x2)
created.b1[i] <- opt_obj$minimum
}
created.b1

How to generate B-spline of degree zero using R

I am currently working with B-splines using R's function bs from the package splines and as a graphic example I would like to provide a figure showing the differences between set of splines with different degrees.
The problem is that bs only supports degrees bigger than 0.
A spline of degree zero, is nothing more than an indicator function for the given region defined by the knots, but I don't really know how to generate it.
This is what I've done so far
x<-seq(0,1,length.out =1000)
par(mfrow=c(3,1))
B1<-bs(x,knots = seq(0,1,length.out = 11)[-c(1,11)],Boundary.knots = c(0,1),intercept = T,degree = 1)
matplot(x,B1,type="l",lty=1,ylim = c(-0.1,1.2),xlab = "",ylab = "")
abline(v=seq(0,1,length.out = 11),lty=2)
legend("top", legend ="B-splines of order 2")
B2<-bs(x,knots = seq(0,1,length.out = 11)[-c(1,11)],Boundary.knots = c(0,1),intercept = T,degree = 2)
matplot(x,B2,type="l",lty=1,ylim = c(-0.1,1.2),xlab = "",ylab = "")
abline(v=seq(0,1,length.out = 11),lty=2)
legend("top", legend ="B-splines of order 3")
B3<-bs(x,knots = seq(0,1,length.out = 11)[-c(1,11)],Boundary.knots = c(0,1),intercept = T,degree = 3)
matplot(x,B3,type="l",lty=1,ylim = c(-0.1,1.2),xlab = "",ylab = "")
abline(v=seq(0,1,length.out = 11),lty=2)
legend("top", legend ="B-splines of order 4")
This image taken from Hastie et.al (2017) is basically what I am missing.
Thanks in advance
As I understand from the comments, you want a function that given an input vector x of n points returns a series of n-1 "splines"; where the ith spline is defined as having the value 1 in the range x[i] < x < x[i+1] or 0 elsewhere.
We can do this so:
x <- seq(0,1,length.out =10)
zero_spline = function(x, xout, n=1000) {
if (missing(xout)) xout = seq(min(x), max(x), length.out = n)
zs = data.frame()
y = numeric(length(xout))
for (i in 1:(length(x)-1L)) {
yi = y
yi[(xout > x[i]) & (xout < x[i+1])] = 1
zs = rbind(zs, data.frame(xout, yi, interval=i))
}
zs
}
zs = zero_spline(x, n=100)
library(ggplot2)
ggplot(zs, aes(xout, yi, color=factor(interval))) +
geom_line()

3D Vector Plot in Julia

I am trying to plot an EM wave (propagating in the z-direction) vector field in Julia. I looked around and it looks like quiver is what I need to use and I have tried that with unsuccessful results. As far as I understand (x, y, z) are the origins of the vectors and (u, v, w) are the vectors themselves originating at the (x, y, z) points. Here is what I have so far but this doesn't seem to produce the correct plot. How can I get this to work? I'm open to try other plotting libs as well. Thanks in advance.
using Plots; gr()
t = 0; n = 100; k = 1; ω = 1; φ = π/4
x = y = w = zeros(n)
z = range(0, stop=10, length=n)
u = #. cos(k*z - ω*t)
v = #. sin(k*z - ω*t)
quiver(x, y, z, quiver=(u, v, w), projection="3d")
I'm not exactly sure this is the result you want but I've managed to make your code work in Julia v1.1 :
using PyPlot
pygui(true)
fig = figure()
ax = fig.gca(projection="3d")
t = 0; n = 100; k = 1; ω = 1; φ = π/4
x = y = w = zeros(n)
z = range(0, stop=10, length=n)
u = cos.(k*z .- ω*t)
v = sin.(k*z .- ω*t)
ax.quiver(x,y,z, u,v,w)
Or, with colors :
using PyPlot
using Random
function main()
pygui(true)
fig = figure()
ax = fig.gca(projection="3d")
t = 0; n = 100; k = 1; ω = 1; φ = π/4
x = y = w = zeros(n)
z = range(0, stop=10, length=n)
u = cos.(k*z .- ω*t)
v = sin.(k*z .- ω*t)
a = ((u[1], 0.8, 0.5), (u[2], 0.8, 0.5))
for i in 3:length(u)-2
a = (a..., (abs(u[i]), 0.8, 0.5))
end
c = ((0.4, 0.5, 0.4), (0.4, 0.9, 0.4), (0.1, 0.1, 0.1))
q = ax.quiver(x,y,z, u,v,w, color = a)
end
main()

R: Converting from Continuous 2D Points to Continuous 2D Vectors

I have a fairly large dataframe (df) with pathing information in the form of continuous x,y coordinates:
df$x
df$y
With these data, I would like to:
1. Calculate a set of continuous vectors
2. Determine the angle between each of these vectors (in degrees)
3. Count the number of angles in the dataframe that meet a certain threshold (i.e. <90°)
Thank you!
Please see the post here for reference
require("ggplot2")
Hypocycloid <- function(num_points) {
r = 1
k = 3
theta = seq(from = 0, to = 2*pi, length.out = num_points)
x = r*(k - 1)*cos(theta) + r*cos((k - 1)*theta)
y = r*(k - 1)*sin(theta) - r*sin((k - 1)*theta)
df = data.frame(x = x, y = y)
gg1 = ggplot(df,
aes(x = x, y = y),
size = 1) +
geom_path()
print(gg1)
return(df)
}
ComputeUnitVectors <- function(points_df) {
npoints = nrow(points_df)
vx = points_df$x[2:npoints] - points_df$x[1:(npoints-1)]
vy = points_df$y[2:npoints] - points_df$y[1:(npoints-1)]
length = sqrt(vx^2 + vy^2)
return(data.frame(vx = vx/length, vy = vy/length))
}
ComputeAngles <- function(vectors_df) {
Angle <- function(v1, v2) {
return(acos(as.numeric(v1) %*% as.numeric(v2))*180/pi)
}
nvectors = nrow(vectors_df)
v1 = vectors_df[1:(nvectors-1),]
v2 = vectors_df[2:nvectors,]
v_df = cbind(v1, v2)
angle = apply(v_df, 1, function(row) {Angle(row[1:2], row[3:4])})
return(data.frame(angle))
}
points.df = Hypocycloid(20)
vectors.df = ComputeUnitVectors(points.df)
print(vectors.df)
angles.df = ComputeAngles(vectors.df)
print(angles.df)

Reproduce Fisher linear discriminant figure

Many books illustrate the idea of Fisher linear discriminant analysis using the following figure (this particular is from Pattern Recognition and Machine Learning, p. 188)
I wonder how to reproduce this figure in R (or in any other language). Pasted below is my initial effort in R. I simulate two groups of data and draw linear discriminant using abline() function. Any suggestions are welcome.
set.seed(2014)
library(MASS)
library(DiscriMiner) # For scatter matrices
# Simulate bivariate normal distribution with 2 classes
mu1 <- c(2, -4)
mu2 <- c(2, 6)
rho <- 0.8
s1 <- 1
s2 <- 3
Sigma <- matrix(c(s1^2, rho * s1 * s2, rho * s1 * s2, s2^2), byrow = TRUE, nrow = 2)
n <- 50
X1 <- mvrnorm(n, mu = mu1, Sigma = Sigma)
X2 <- mvrnorm(n, mu = mu2, Sigma = Sigma)
y <- rep(c(0, 1), each = n)
X <- rbind(x1 = X1, x2 = X2)
X <- scale(X)
# Scatter matrices
B <- betweenCov(variables = X, group = y)
W <- withinCov(variables = X, group = y)
# Eigenvectors
ev <- eigen(solve(W) %*% B)$vectors
slope <- - ev[1,1] / ev[2,1]
intercept <- ev[2,1]
par(pty = "s")
plot(X, col = y + 1, pch = 16)
abline(a = slope, b = intercept, lwd = 2, lty = 2)
MY (UNFINISHED) WORK
I pasted my current solution below. The main question is how to rotate (and move) the density plot according to decision boundary. Any suggestions are still welcome.
require(ggplot2)
library(grid)
library(MASS)
# Simulation parameters
mu1 <- c(5, -9)
mu2 <- c(4, 9)
rho <- 0.5
s1 <- 1
s2 <- 3
Sigma <- matrix(c(s1^2, rho * s1 * s2, rho * s1 * s2, s2^2), byrow = TRUE, nrow = 2)
n <- 50
# Multivariate normal sampling
X1 <- mvrnorm(n, mu = mu1, Sigma = Sigma)
X2 <- mvrnorm(n, mu = mu2, Sigma = Sigma)
# Combine into data frame
y <- rep(c(0, 1), each = n)
X <- rbind(x1 = X1, x2 = X2)
X <- scale(X)
X <- data.frame(X, class = y)
# Apply lda()
m1 <- lda(class ~ X1 + X2, data = X)
m1.pred <- predict(m1)
# Compute intercept and slope for abline
gmean <- m1$prior %*% m1$means
const <- as.numeric(gmean %*% m1$scaling)
z <- as.matrix(X[, 1:2]) %*% m1$scaling - const
slope <- - m1$scaling[1] / m1$scaling[2]
intercept <- const / m1$scaling[2]
# Projected values
LD <- data.frame(predict(m1)$x, class = y)
# Scatterplot
p1 <- ggplot(X, aes(X1, X2, color=as.factor(class))) +
geom_point() +
theme_bw() +
theme(legend.position = "none") +
scale_x_continuous(limits=c(-5, 5)) +
scale_y_continuous(limits=c(-5, 5)) +
geom_abline(intecept = intercept, slope = slope)
# Density plot
p2 <- ggplot(LD, aes(x = LD1)) +
geom_density(aes(fill = as.factor(class), y = ..scaled..)) +
theme_bw() +
theme(legend.position = "none")
grid.newpage()
print(p1)
vp <- viewport(width = .7, height = 0.6, x = 0.5, y = 0.3, just = c("centre"))
pushViewport(vp)
print(p2, vp = vp)
Basically you need to project the data along the direction of the classifier, plot a histogram for each class, and then rotate the histogram so its x axis is parallel to the classifier. Some trial-and-error with scaling the histogram is needed in order to get a nice result. Here's an example of how to do it in Matlab, for the naive classifier (difference of class' means). For the Fisher classifier it is of course similar, you just use a different classifier w. I changed the parameters from your code so the plot is more similar to the one you gave.
rng('default')
n = 1000;
mu1 = [1,3]';
mu2 = [4,1]';
rho = 0.3;
s1 = .8;
s2 = .5;
Sigma = [s1^2,rho*s1*s1;rho*s1*s1, s2^2];
X1 = mvnrnd(mu1,Sigma,n);
X2 = mvnrnd(mu2,Sigma,n);
X = [X1; X2];
Y = [zeros(n,1);ones(n,1)];
scatter(X1(:,1), X1(:,2), [], 'b' );
hold on
scatter(X2(:,1), X2(:,2), [], 'r' );
axis equal
m1 = mean(X(1:n,:))';
m2 = mean(X(n+1:end,:))';
plot(m1(1),m1(2),'bx','markersize',18)
plot(m2(1),m2(2),'rx','markersize',18)
plot([m1(1),m2(1)], [m1(2),m2(2)],'g')
%% classifier taking only means into account
w = m2 - m1;
w = w / norm(w);
% project data onto w
X1_projected = X1 * w;
X2_projected = X2 * w;
% plot histogram and rotate it
angle = 180/pi * atan(w(2)/w(1));
[hy1, hx1] = hist(X1_projected);
[hy2, hx2] = hist(X2_projected);
hy1 = hy1 / sum(hy1); % normalize
hy2 = hy2 / sum(hy2); % normalize
scale = 4; % set manually
h1 = bar(hx1, scale*hy1,'b');
h2 = bar(hx2, scale*hy2,'r');
set([h1, h2],'ShowBaseLine','off')
% rotate around the origin
rotate(get(h1,'children'),[0,0,1], angle, [0,0,0])
rotate(get(h2,'children'),[0,0,1], angle, [0,0,0])

Resources