Please can anyone tell me how to rotate it along the x-axis .
Rotate curve C1(u) about X-axis to generate the set of curves at a step size of pi/100 given by
theta=0:%pi/100:%pi/2.
ABC = [0 0 1;1 1 1;1/4 1/2 1] \ [0 0 0;1 0 0;1/2 1/2 0];
A = ABC(1,:);
B = ABC(2,:);
C = ABC(3,:);
u = linspace(0,1,100);
C1 = A'*u.^2+B'*u+C'*ones(u);
param3d(C1(1,:),C1(2,:),C1(3,:));
This will do the job:
ABC = [0 0 1;1 1 1;1/4 1/2 1] \ [0 0 0;1 0 0;1/2 1/2 0];
A = ABC(1,:);
B = ABC(2,:);
C = ABC(3,:);
u = linspace(0,1,100);
C1 = A'*u.^2+B'*u+C'*ones(u);
param3d(C1(1,:),C1(2,:),C1(3,:));
theta = %pi/100;
R = [1 0 0
0 cos(theta) -sin(theta)
0 sin(theta) cos(theta)];
for i=1:50
C1 = R*C1;
param3d(C1(1,:),C1(2,:),C1(3,:));
end
clc;clear;
theta=0:%pi/100:%pi/2;
n=length(theta);
for i=1:n
x=sin(theta(i));
y=cos(theta(i));
r=[1 0 0;0 y -x;0 x y];
ABCD = [0 0 1;1 1 1;1/4 1/2 1] \ [0 0 0;1 0 0;1/2 1/2 0];
ABC = ABCD*r';
A = ABC(1,:);
B = ABC(2,:);
C = ABC(3,:);
u = linspace(0,1,100);
C1 = A'*u.^2+B'*u+C'*ones(u);
param3d(C1(1,:),C1(2,:),C1(3,:));
end
Related
I have been trying to do Gauss jordan method in matrices in octave, and I have found diferent ways to call the function, but none works. How can I do that?
A=[1 -2 -1; -1 1 1; 1 1 5]
B=[1; 4; -3]
#format rat
#Transposta = transpose(A) #Transposta
#Inversa = inv(A) #Inversa
#Adjunta = det(A)*inv(A) #Adjunta se A tiver inversa
determinante = det(A) #Determinante.
Resultado = Gaussian(A)
Use the rref function...
A = [1 -2 -1; -1 1 1; 1 1 5]
B = [1; 4; -3]
C = [A, B]
[a, b] = rref(C)
Result
a = 1.0000 0 0 -7.1667
0 1.0000 0 -5.0000
0 0 1.0000 1.8333
More Info: https://docs.octave.org/v7.3.0/Basic-Matrix-Functions.html
I have a function f(x) which I intend to minimize. "x" is a vector containing 50 parameters. This function has several constraints: first is that all parameters in x should be binary, so that x = (1,1,0,1,...); second is that the sum of "x" should be exactly 25, so that sum(x) = 25. The question can be illustrated as:
min f(x)
s.t. sum(x) = 25,
x = 0 or 1
However when I try to solve this problem in R, I met some problems. Prevalent packages such as "optim","constrOptim" from "stats" can only input coefficients of the target function (in my case, the function is bit complex and cannot be simply illustrated using coefficient matrix), "donlp2" from "Rdonlp" does not support setting parameters to be binary. I'm wondering whether anyone has any idea of how to set binary constraints for this case?
Expanding my comment, here is an example of a Local Search, as implemented in package NMOF. (I borrow Stéphane's objective function).
library("NMOF")
library("neighbours")
## Stéphane's objective function
f <- function(x)
sum(1:20 * x)
nb <- neighbourfun(type = "logical", kmin = 10, kmax = 10)
x0 <- c(rep(FALSE, 10), rep(TRUE, 10))
sol <- LSopt(f, list(x0 = x0, neighbour = nb, nI = 1000))
## initial solution
as.numeric(x0)
## [1] 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1
## final solution
as.numeric(sol$xbest)
## [1] 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0
(Disclosure: I am the maintainer of packages NMOF and neighbours.)
You can try the amazing package rgenoud. Below is an example.
I take 20 binary variables instead of your 50 for easier reading. I take f(x) = sum(1:20 * x), this is a weighted sum with increasing weights so clearly the best solution (restricted to sum(x)=10) is 1, 1, ..., 1, 0, 0, ..., 0. And rgenoud brilliantly finds it.
library(rgenoud)
f <- function(x) { # the function to be minimized
sum(1:20 * x)
}
g <- function(x){
c(
ifelse(sum(x) == 10, 0, 1), # set the constraint (here sum(x)=10) in this way
f(x) # the objective function (to minimize/maximize)
)
}
solution <- genoud(
g,
pop.size = 3000,
lexical = 2, # see ?genoud for explanations
nvars = 20, # number of x_i's
starting.values = c(rep(0, 10), rep(1, 10)),
Domains = cbind(rep(0, 20), rep(1, 20)), # lower and upper bounds
data.type.int = TRUE # x_i's are integer
)
solution$par # the values of x
## [1] 1 1 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 0 0
solution$value
## [1] 0 55 ; 0 is the value of ifelse(sum(x)=10,0,1) and 55 is the value of f(x)
Given a 0/1 vector and a k value
x <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1)
k <- 3
I need to define a function f so that
f(x, k)
[1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
That is: if any value of x = 1 set the next k = 3 values of x to zero
I have solved the problem with this terrible solution
f <- function(x, k){
.f <- function(x, i, k){
s <- seq(i+1, i+k)
if (x[[i]] == 1) x[s] <- 0
x
}
n <- length(x)
for ( i in seq(1, n-1)) {
#for ( i in seq(1, n-k-1)) {
x <- .f(x, i , k)
}
length(x) <- n
x
}
Can anyone provide a more elegant (functional) solution ?
Thanks for any help
This takes some steps out:
foo <- function(x, k) {
n <- length(x)
for (i in seq_along(x)) {
if (x[i] == 1) x[seq(i+1L, min(i+k, n))] <- 0
}
x
}
foo(x, k)
# [1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
This takes bigger steps when it encounters a 1, should be more efficient at least for big k.
foo2 <- function(x, k) {
n <- length(x)
i <- 1L
while (i < n) {
if (x[i] == 1) {
x[seq(i+1L, min(i+k, n))] <- 0
i <- i+k
} else {
i <- i+1L
}
}
x
}
A simple counter will also do the job :
fnew <- function(x, k){
counter <- 0L
for (i in 1:length(x)){
if (x[i] & !counter) {
counter <- k
next
}
if (!!counter) {
x[i] <- 0
counter <- counter - 1L
}
}
x
}
fnew(x,3)
[1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
Advantage of a simple loop is that it can easily be converted to C++:
Rcpp::cppFunction('
NumericVector fcpp(NumericVector x, int k) {
int n = x.size();
int i;
int counter = 0;
NumericVector xout(n);
xout = x;
for (i = 0;i<n;i++){
if ((x[i]==1) & (counter==0)) {
counter = k;
} else
if (counter > 0) {
xout[i] = 0;
counter += -1;
}
}
return xout;
}')
I found interesting to compare performance of the different options proposed until now, which shows that a simple loop still has its word to say :
x <- rnorm(1e3)>0
microbenchmark::microbenchmark(f(x,3),gen_vec(x,3),foo(x,3),onePeriodic(x,3),fnew(x,3),fA5C1(x,3),fcpp(x,3))
Unit: microseconds
expr min lq mean median uq max neval cld
f(x, 3) 7783.375 8205.9390 9340.76417 8559.7845 8868.092 33439.139 100 e
gen_vec(x, 3) 2821.330 3086.5605 3683.71671 3176.2015 3490.867 25794.430 100 d
foo(x, 3) 1396.922 1495.1775 1689.60223 1532.5110 1640.818 5901.121 100 c
onePeriodic(x, 3) 879.178 994.0510 1090.42763 1049.4345 1103.793 2109.536 100 bc
fnew(x, 3) 413.538 452.7175 492.22530 473.6405 494.564 1142.563 100 ab
fA5C1(x, 3) 160.000 178.4620 274.42453 188.7180 213.949 7361.222 100 a
fcpp(x, 3) 6.154 16.4100 21.46069 20.5130 24.206 94.359 100 a
Waldi's fcpp function is great, but if you want to stick with base R, you can try this for loop.
f <- function(x, y) {
l <- length(x)
x <- as.integer(x)
ind <- which(as.logical(x))
for (i in seq_along(ind)) {
if (x[ind[i]] == 1L) {
x[ind[i] + seq.int(y)] <- 0L
}
}
x[1:l]
}
f(x, 3)
# [1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
Here is another base R option:
onePeriodic <- function(x, k) {
w <- which(x==1L)
idx <- unlist(lapply(split(w, c(0L, cumsum(diff(w) > k+1L))), function(v) {
seq(v[1L], v[length(v)], by=k+1L)
}))
replace(integer(length(x)), idx, 1L)
}
k <- 3
(x <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1))
(o <- onePeriodic(x, k))
output:
x: [1] 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 0 1 1
o: [1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1
I don't know why you are specifically looking for a functional programming solution, but, without claiming anything regarding the quality of the solution, this does the job:
x <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1)
gen_vec <- function(x,k){
x2 <- x
purrr::walk(1:length(x2), function(n,k){
ifelse(x2[n]==1, x2[(n+1):min(n+k, length(x2))] <<- 0, x2[n])
}, k=k)
x2
}
Output
> gen_vec(x, 3)
[1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
Original x is unmodified:
> x
[1] 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1
I'm trying to implement the floyd warshall algorithm but it won't work correctly.
What I want is the shortest path distances from one vertex to another written in a matrix d and the predecessors in a matrix pred. The input is an adjacency matrix which contains all of the edge weights.
function FloWa(C)
N = size(C)
n = min(C[1],C[2])
pred = -1*ones(C[1],C[2])
d = C
for k in 1:n
for i in 1:n
for j in 1:n
if d[i,j] > d[i,k] + d[k,j]
if pred[i,k] == -1
pred[i,j] = k
else
pred[i,j] = pred[k,j]
end
d[i,j] = d[i,k] + d[k,j]
end
if i == j && d[i,i] < 0
println("negative Dicycle")
end
end
end
end
return d, pred
end
When i am running my code with the matrix
A = [0 2 1 4 5 1; 1 0 4 2 3 4; 2 1 0 1 2 4; 3 5 2 0 3 3; 2 4 3 4 0 1; 3 4 7 3 1 0]
i don't get the right results.
For d i get the same matrix as A and pred is printed as an Array{Float64}(0,1).
I have not checked the implementation of the algorithm, but you seem to initialize pred and d incorrectly. Here is a way to do it that is I assume you indented:
n = size(C, 1) # get number of rows in C
#assert n == size(C, 2) # make sure that C is square or throw an error
pred = fill(-1, size(C)) # fill pred with -1 and make it have the same size as C
d = copy(C) # d is a copy of C
My goal is to generate a unique list of combinations when we know that there may exist a similar combination of variables since part of the set being operated upon has duplicate values. So, the problem I am trying to solve is obtaining all combinations without replacement on non distinct items. The solution needs to be general (i.e. works for any set of N elements with M values of distinct items. So, the solution should work with N = 4, M = 2 with (Var1 = Var2, Var3=Var4) or (Var1 = Var2 = Var3, Var4) etc.). As a simple example that I am trying to do, take three variables: X,Y,Z
Classic Combinations are:
X Y Z
Y Z
X Z
Z
X Y
Y
X
If we let X = Y, then we have:
X X Z
X Z
X Z
Z
X X
X
X
Thus, we have two combinations that are not "unique": (X) and (X Z).
So, the list that I would want is:
X X Z
X Z
Z
X X
X
Edit: Added case for when N=4 as recommended by #Sam Thomas
If we expand this to N=4, we have: W,X,Y,Z
W X Y Z
X Y Z
W Y Z
Y Z
W X Z
X Z
W Z
Z
W X Y
X Y
W Y
Y
W X
X
W
Here, we can have M=2 distinct elements in forms of either: (W=X, Y=Z), (X=Z,W=Y), (X=Y,W=Z), (W = X = Y, Z), (W = Z = Y, X), (W = Z = X, Y), or (X = Y = Z, W).
In the case of (W=X, Y=Z), we have:
W W Y Y
W Y Y
W Y Y
Y Y
W W Y
W Y
W Y
Y
W W Y
W Y
W Y
Y
W W
W
W
The output should be:
W W Y Y
W Y Y
Y Y
W W Y
W Y
Y
W W
W
In the case of, (W = X = Y, Z) the matrix would initially look like:
W W W Z
W W Z
W W Z
W Z
W W Z
W Z
W Z
Z
W W W
W W
W W
W
W W
W
W
The desired output would be:
W W W Z
W W Z
W Z
Z
W W W
W W
W
End Edit
Using R, I already have a way to generate a list of all possible combinations in binary matrix form:
comb.mat = function(n){
c = rep(list(1:0), n)
expand.grid(c)
}
comb.mat(3)
This gives:
Var1 Var2 Var3
1 1 1 1
2 0 1 1
3 1 0 1
4 0 0 1
5 1 1 0
6 0 1 0
7 1 0 0
8 0 0 0
If we consider Var1 = Var2, this structure would have redundancies. e.g. lines (2,3) and then (6,7) would represent the same object. Thus, the redundancy free version would be:
Var1 Var2 Var3
1 1 1 1
2 0 1 1
4 0 0 1
5 1 1 0
6 0 1 0
8 0 0 0
To add "variable" values similar to the initial structure, I use:
nvars = ncol(m)
for(i in 1:nvars){
m[m[,i]==1,i] = LETTERS[22+i]
}
To modify it so that Var1 = Var2, I just use:
m[m[,i]=="Y",i] = "X"
Any suggestions on how I could move from the initial matrix to the later matrix?
Especially if we have more variables that are paired?
E.g. comb.mat(4), with: (Var1 = Var2, Var3 = Var4) or (Var1=Var2=Var3, Var4)
This has all of the combinations, I believe.
m <- comb.mat(3)
res <- lapply(split(m, m$Var3), function(x, vars=c("Var1", "Var2")) {
x[Reduce(`==`, x[vars]) | cumsum(Reduce(xor, x[vars])) == 1, ]
})
do.call(rbind, res)
Var1 Var2 Var3
0.5 1 1 0
0.6 0 1 0
0.8 0 0 0
1.1 1 1 1
1.2 0 1 1
1.4 0 0 1
Edit: Think this works for multiple equivalent variables- couldn't figure out a method without a for loop. I'm sure there's a way with Reduce somehow.
And I think this gives the right combination of results, but if not let me know as it's late in the day and I'm a bit tired.
remove_dups <- function(m, vars) {
for (k in 1:length(vars)) {
res <- lapply(split(m, m[, !names(m) %in% vars[[k]]]), function(x, vn=vars[[k]]) {
x[Reduce(`==`, x[vn]) | cumsum(Reduce(xor, x[vn])) == 1, ]
})
m <- do.call(rbind, res)
}
m
}
m <- comb.mat(4)
remove_dups(m, list(vars=c("Var1", "Var2"), vars=c("Var3", "Var4")))
Var1 Var2 Var3 Var4
0.0.0.0.16 0 0 0 0
0.0.1.0.12 0 0 1 0
0.0.1.1.4 0 0 1 1
0.1.0.0.14 0 1 0 0
0.1.1.0.10 0 1 1 0
0.1.1.1.2 0 1 1 1
1.1.0.0.13 1 1 0 0
1.1.1.0.9 1 1 1 0
1.1.1.1.1 1 1 1 1