Related
Remove["Global`*"]
a = 0;
For[z = 0, z < 3, z++, Sol[a] = x /. Solve[z^2 + x == 10, x];
a = a + 1;]
I am new to the mathematica so I'm experimenting with it.Answer of the problem changes at every loop so I stored them inside an array.
I can see the numeric results using Do[Print[Sol[a]], {a, 0, 2}]; but how can I plot the results I tried using Plot[Sol[[a]], {a, 0, 2}] but it didn't work.
Remove["Global`*"]
func = z^2 + x == 10;
sol = Solve[func, x];
Plot[x /. sol, {z, 0, 3}]
Let d1 and d2 be matrices over the integers Z. How can I compute the group quotient ker d1 / im d2 in Sage?
So far I've been able to compute a basis for the kernel and image as follows:
M24 = MatrixSpace(IntegerRing(),2,4)
d1 = M24([-1,1, 1,-1, -1,1, 1,-1])
kerd1 = d1.right_kernel().basis()
M43 = MatrixSpace(IntegerRing(),4,3)
d2 = M43([1,1,-1, 1,-1,-1, 1,-1,1, 1,1,1])
imd2 = d2.column_space().basis()
which gives output:
kerd1 = [
(1, 0, 0, -1),
(0, 1, 0, 1),
(0, 0, 1, 1)
]
imd2 = [
(1, 1, 1, 1),
(0, 2, 0, -2),
(0, 0, 2, 2)
]
I tried to compute the quotient like this:
Z4.<a,b,c,d> = AbelianGroup(4, [0,0,0,0])
G = Z4.subgroup([a/d, b*d, c*d])
H = Z4.subgroup([a*b*c*d, b^2/d^2, c^2*d^2])
G.quotient(H)
But I got a NotImplementedError.
I found two ways to do this:
d1 = matrix(ZZ,4,2, [-1,1, 1,-1, -1,1, 1,-1]).transpose()
d2 = matrix(ZZ,4,3, [1,1,-1, 1,-1,-1, 1,-1,1, 1,1,1])
(d1.right_kernel() / (d2.column_space())).invariants()
# OUTPUT: (2, 2)
ChainComplex([d2, d1]).homology()[1]
# OUTPUT: C2 x C2
I have a set of 3D-Bodies. Each Body is defined by 8 points with three coordinates each. All of the bodies are cubical or approximately cubical. I would like to "fill" the cubes with a systematic point raster. The coordinates are stored in simple data.frames.
I developed the following code that does what I want for cubical bodies:
# libraries
library(rgl)
# define example cube with 8 points
excube <- data.frame(
x = c(1,1,1,1,5,5,5,5),
y = c(1,1,4,4,1,1,4,4),
z = c(4,8,4,8,4,8,4,8)
)
# cubeconst: fill cube (defined by 8 corner points) with a 3D-point-raster
cubeconst <- function(x, y, z, res) {
cube <- data.frame()
xvec = seq(min(x), max(x), res)
yvec = seq(min(y), max(y), res)
zvec = seq(min(z), max(z), res)
for (xpoint in 1:length(xvec)) {
for (ypoint in 1:length(yvec)) {
for (zpoint in 1:length(zvec)) {
cube <- rbind(cube, c(xvec[xpoint], yvec[ypoint], zvec[zpoint]))
}
}
}
colnames(cube) <- c("x", "y", "z")
return(cube)
}
# apply cubeconst to excube
fcube <- cubeconst(x = excube$x, y = excube$y, z = excube$z, res = 0.5)
# plot result
plot3d(
fcube$x,
fcube$y,
fcube$z,
type = "p",
xlab = "x",
ylab = "y",
zlab = "z"
)
Now I'm searching for a solution to "fill" approximately cubical bodies like for example the following body:
# badcube
badcube <- data.frame(
x = c(1,1,1,1,5,5,5,5),
y = c(1,1,4,4,1,1,4,4),
z = c(4,10,4,12,4,8,4,8)
)
# plot badcube
plot3d(
badcube$x,
badcube$y,
badcube$z,
col = "red",
size = 10,
type = "p",
xlab = "x",
ylab = "y",
zlab = "z"
)
Maybe you can point me in the right direction.
You need to transform the hexahedron (wonky cube) to a unit cube. The following image shows what I mean, and gives us a numbering scheme for the vertices of the hexa. Vertex 2 is hidden behind the cube.
The transformation is from real space x,y,z, to a new coordinate system u,v,w, in which the hexa is a unit cube. The typical function used for hexa looks like this.
x = A + B*u + C*v + D*w + E*u*v + F*u*w + G*v*w + H*u*v*w
Transformations for y and z coordinates are of the same form. You have 8 corners to your cube, so you can substitute these in to solve for coefficients A,B,.... The unit coordinates u,v,w are either 0 or 1 at every vertex, so this simplifies things a lot.
x0 = A // everything = zero
x1 = A + B // u = 1, others = zero
x2 = A + C // v = 1, ...
x4 = A + D // w = 1
x3 = A + B + C + E // u = v = 1
x5 = A + B + D + F // u = w = 1
x6 = A + C + D + G // v = w = 1
x7 = A + B + C + D + E + F + G + H // everything = 1
You then have to solve for A,B,.... This is easy because you just forward substitute. A equals x0. B equals x1 - A, etc... You have to do this for y and z also, but if your language supports vector operations, this can probably be done in the same step as for x.
Once you have the coefficients, you can convert a point u,v,w to x,y,z. Now, if you have a point generation scheme which works on a 1x1x1 cube, you can transform the result to the origonal hex. You could retain the same triple-loop structure in your posted code, and vary u,v,w between 0 and 1 to create a grid of points within the hex.
I'm afraid I don't know r, so I can't give you any example code in that language. Here's a quick python3 example, though, just to prove it works.
import matplotlib.pyplot as pp
import numpy as np
from mpl_toolkits.mplot3d import Axes3D
np.random.seed(0)
cube = np.array([
[0.0, 0.0, 0.0], [1.0, 0.0, 0.0], [0.0, 1.0, 0.0], [1.0, 1.0, 0.0],
[0.0, 0.0, 1.0], [1.0, 0.0, 1.0], [0.0, 1.0, 1.0], [1.0, 1.0, 1.0]])
hexa = cube + 0.5*np.random.random(cube.shape)
edges = np.array([
[0, 1], [0, 2], [1, 3], [2, 3],
[0, 4], [1, 5], [2, 6], [3, 7],
[4, 5], [4, 6], [5, 7], [6, 7]])
def cubeToHexa(hexa, u, v, w):
A = hexa[0]
B = hexa[1] - A
C = hexa[2] - A
D = hexa[4] - A
E = hexa[3] - A - B - C
F = hexa[5] - A - B - D
G = hexa[6] - A - C - D
H = hexa[7] - A - B - C - D - E - F - G
xyz = (
A +
B*u[...,np.newaxis] +
C*v[...,np.newaxis] +
D*w[...,np.newaxis] +
E*u[...,np.newaxis]*v[...,np.newaxis] +
F*u[...,np.newaxis]*w[...,np.newaxis] +
G*v[...,np.newaxis]*w[...,np.newaxis] +
H*u[...,np.newaxis]*v[...,np.newaxis]*w[...,np.newaxis])
return xyz[...,0], xyz[...,1], xyz[...,2]
fg = pp.figure()
ax = fg.add_subplot(111, projection='3d')
temp = np.reshape(np.append(hexa[edges], np.nan*np.ones((12,1,3)), axis=1), (36,3))
ax.plot(temp[:,0], temp[:,1], temp[:,2], 'o-')
u, v, w = np.meshgrid(*[np.linspace(0, 1, 6)]*3)
x, y, z = cubeToHexa(hexa, u, v, w)
ax.plot(x.flatten(), y.flatten(), z.flatten(), 'o')
pp.show()
I can't recall the exact justificiation for this form of the transformation. It's certainly easy to solve, and it has no squared terms, so lines in the directions of the u,v,w axes map to straight lines in x,y,z. This means your cube edges and faces are guaranteed to conform, as well as the corners. I lack the maths to prove it, though, and I couldn't find any googleable information either. My knowledge comes from a distant memory of textbooks on Finite Element Methods, where these sort of transformations are common. If you need more information, I suggest you start looking there.
Thanks to Bills explanation and examples I was able to come up with the following solution in R:
# libraries
library(rgl)
# create heavily distorted cube - hexahedron
hexatest <- data.frame(
x = c(0,1,0,4,5,5,5,5),
y = c(1,1,4,4,1,1,4,4),
z = c(4,8,4,9,4,8,4,6)
)
# cubetohexa: Fills hexahedrons with a systematic point raster
cubetohexa <- function(hexa, res){
# create new coordinate system (u,v,w)
resvec <- seq(0, 1, res)
lres <- length(resvec)
u <- c()
for (p1 in 1:lres) {
u2 <- c()
for (p2 in 1:lres) {
u2 <- c(u2, rep(resvec[p2], lres))
}
u <- c(u,u2)
}
v <- c()
for (p1 in 1:lres) {
v <- c(v, rep(resvec[p1], lres^2))
}
w <- rep(resvec, lres^2)
# transformation
A <- as.numeric(hexa[1,])
B <- as.numeric(hexa[2,]) - A
C <- as.numeric(hexa[3,]) - A
D <- as.numeric(hexa[5,]) - A
E <- as.numeric(hexa[4,]) - A - B - C
F <- as.numeric(hexa[6,]) - A - B - D
G <- as.numeric(hexa[7,]) - A - C - D
H <- as.numeric(hexa[8,]) - A - B - C - D - E - F - G
A <- matrix(A, ncol = 3, nrow = lres^3, byrow = TRUE)
B <- matrix(B, ncol = 3, nrow = lres^3, byrow = TRUE)
C <- matrix(C, ncol = 3, nrow = lres^3, byrow = TRUE)
D <- matrix(D, ncol = 3, nrow = lres^3, byrow = TRUE)
E <- matrix(E, ncol = 3, nrow = lres^3, byrow = TRUE)
F <- matrix(F, ncol = 3, nrow = lres^3, byrow = TRUE)
G <- matrix(G, ncol = 3, nrow = lres^3, byrow = TRUE)
H <- matrix(H, ncol = 3, nrow = lres^3, byrow = TRUE)
for (i in 1:(lres^3)) {
B[i,] <- B[i,] * u[i]
C[i,] <- C[i,] * v[i]
D[i,] <- D[i,] * w[i]
E[i,] <- E[i,] * u[i] * v[i]
F[i,] <- F[i,] * u[i] * w[i]
G[i,] <- G[i,] * v[i] * w[i]
H[i,] <- H[i,] * u[i] * v[i] * w[i]
}
m <- data.frame(A+B+C+D+E+F+G+H)
colnames(m) <- c("x", "y", "z")
# output
return(m)
}
# apply cubetohexa to hexatest
cx <- cubetohexa(hexatest, 0.1)
# plot result
plot3d(
cx$x,
cx$y,
cx$z,
type = "p",
xlab = "x",
ylab = "y",
zlab = "z"
)
Edit:
This function is now implemented with Rcpp in my R package recexcavAAR.
Here is an example where the Nelder-Mead derivative-free optimziation algorithm is used. The problem is that I want a solution for integer-valued parameters. Does anybody know a way to do that in R?
library(dfoptim)
fn <- function(x) {
f1 <- x[1] + 6*x[2]
f2 <- 3*(10-x[1]) + 5*(10-x[2])
max(f1, f2)
}
par0 <- c(1, 1)
nmkb(par0, fn, lower = 0, upper = 10)
Following up on my comment, your problem can be rewritten as as Mixed-Integer Linear Programming:
Minimize z (A)
Subject to
z >= x + 6y (B)
z >= 80 - 3x - 5y (C)
x >= 0 (D)
x <= 10 (E)
y >= 0 (F)
y <= 10 (G)
x, y are integer (H)
MILP are solved using a branch-and-bound algorithm that should be faster than a non-linear solver. One such free solver is lpSolve:
library(lpSolve)
res <- lp(direction = "min",
objective.in = c(1, 0, 0), # (A) (weights for {z, x, y})
const.mat = rbind(c(1, -1, -6), # (B)
c(1, +3, +5), # (C)
c(0, 1, 0), # (D)
c(0, 1, 0), # (E)
c(0, 0, 1), # (F)
c(0, 0, 1)), # (G)
const.dir = c(">=", ">=", ">=", "<=", ">=", "<="), # (B through G)
const.rhs = c( 0, 80, 0, 10, 0, 10), # (B through G)
int.vec = c(2, 3)) # (H)
res$solution # optimal values for z, x, y respectively
# [1] 33 9 4
I hope this helps. If not, maybe some will find it interesting nonetheless.
I want to plot a polyhedron, which is described by the following inequalities:
3*x+5*y+9*z<=500
4*x+5*z<=350
2*y+3*z<=150
x,y,z>=0
It is a linear program. The objective function is:
4*x+3*y+6*z
The polyhedron is the feasible region for this program.
I am able to plot the inequalities as planes, which should describe the polyhedron
(Note that this is my first try with rgl, so the code is kinda messy. if you want to improve it, please feel free to do so):
# setup
x <- seq(0,9,length=20)*seq(0,9,length=20)
y <- x
t <- x
f1 <- function(x,y){y=70-0.8*x}
z1 <- outer(x,y,f1)
f2 <- function(x,y){500/9-x/3-(5*y)/9}
z2 <- outer(x,y,f2)
f3 <- function(x,y){t=50-(2*y)/3}
z3 <- outer(x,y,f3)
# plot planes with rgl
uM = matrix(c(0.72428817, 0.03278469, -0.68134511, 0,
-0.6786808, 0.0555667, -0.7267077, 0,
0.01567543, 0.99948466, 0.05903265, 0,
0, 0, 0, 1),
4, 4)
library(rgl)
open3d(userMatrix = uM, windowRect = c(0, 0, 400, 400))
rgl.pop("lights")
light3d(diffuse='white',theta=0,phi=20)
light3d(diffuse="gray10", specular="gray25")
rgl.light(theta = 0, phi = 0, viewpoint.rel = TRUE, ambient = "#FFFFFF",
diffuse = "#FFFFFF", specular = "#FFFFFF", x=30, y=30, z=40)
rgl.light(theta = 0, phi = 0, viewpoint.rel = TRUE, ambient = "#FFFFFF",
diffuse = "#FFFFFF", specular = "#FFFFFF", x=0, y=0, z=0)
bg3d("white")
material3d(col="white")
persp3d(x,y,z3,
xlim=c(0,100), ylim=c(0,100), zlim=c(0,100),
xlab='x', ylab='y', zlab='z',
col='lightblue',
ltheta=100, shade=0, ticktype = "simple")
surface3d(x, y, z2, col='orange', alpha=1)
surface3d(t, y, z1, col='pink', alpha=1, smooth=TRUE)
Now I want to plot the region that is described by the planes with
x,y,z>=0.
But I don't know how to do it. I tried to do it like this:
x <- seq(0,9,length=20)*seq(0,9,length=20)
y <- x
z <- x
f4 <- function(x,y,t){
cond1 <- 3*x+5*y+9*z<=500
cond2 <- 4*x+5*z<=350
cond3 <- 2*y+3*z<=150
ifelse(cond1, 3*x+5*y+9*z,
ifelse(cond2, 4*x+5*z,
ifelse(cond3, 2*y+3*z,0)))
}
f4(x,y,z)
z4 <- outer(x,y,z,f4) # ERROR
But this is the point where I'm stuck. outer() is defined only for 2 variables, but I have three. How can I move on from here?
You can compute the vertices of the polyhedron by intersecting the planes 3 at a time
(some of the intersections are outside the polyhedron, because of other inequalities:
you have to check those as well).
Once you have the vertices, you can try to connect them.
To identify which are on the boundary, you can take the middle of the segment,
and check if any inequality is satisfied as an equality.
# Write the inequalities as: planes %*% c(x,y,z,1) <= 0
planes <- matrix( c(
3, 5, 9, -500,
4, 0, 5, -350,
0, 2, 3, -150,
-1, 0, 0, 0,
0, -1, 0, 0,
0, 0, -1, 0
), nc = 4, byrow = TRUE )
# Compute the vertices
n <- nrow(planes)
vertices <- NULL
for( i in 1:n )
for( j in 1:n)
for( k in 1:n )
if( i < j && j < k ) try( {
# Intersection of the planes i, j, k
vertex <- solve(planes[c(i,j,k),-4], -planes[c(i,j,k),4] )
# Check that it is indeed in the polyhedron
if( all( planes %*% c(vertex,1) <= 1e-6 ) ) {
print(vertex)
vertices <- rbind( vertices, vertex )
}
} )
# For each pair of points, check if the segment is on the boundary, and draw it
library(rgl)
open3d()
m <- nrow(vertices)
for( i in 1:m )
for( j in 1:m )
if( i < j ) {
# Middle of the segment
p <- .5 * vertices[i,] + .5 * vertices[j,]
# Check if it is at the intersection of two planes
if( sum( abs( planes %*% c(p,1) ) < 1e-6 ) >= 2 )
segments3d(vertices[c(i,j),])
}