When trying to run this code Julia keeps giving me the error message "KeyError: key 18=>63 not found" anytime I try to access demand[i]. It seems that this error happens every time the element in dem is larger than 50.
using JuMP, Clp
hours = 1:24
dem = [43 40 36 36 35 38 41 46 49 48 47 47 48 46 45 47 50 63 75 75 72 66 57 50]
demand = Dict(zip(hours, dem))
m = Model(solver=ClpSolver())
#variable(m, x[demand] >= 0)
#variable(m, y[demand] >= 0)
for i in demand
if demand[i] > 50
#constraint(m, y[i] == demand[i])
else
#constraint(m, x[i] == demand[i])
end
end
Not sure how to solve this issue.
You are using a Python-style for x in dict. In Julia, this iterates over the key-value pairs of the dictionary, not the keys. Try
for i in keys(demand)
if demand[i] > 50
#constraint(m, y[i] == demand[i])
else
#constraint(m, x[i] == demand[i])
end
end
or
for (h, d) in demand
if d > 50
#constraint(m, y[h] == d)
else
#constraint(m, x[h] == d)
end
end
This worked for me, using Julia 1.0
using JuMP, Clp
hours = 1:24
dem = [43 40 36 36 35 38 41 46 49 48 47 47 48 46 45 47 50 63 75 75 72 66 57 50]
demand = Dict(zip(hours, dem))
m = Model()
setsolver(m, ClpSolver())
#variable(m, x[keys(demand)] >= 0)
#variable(m, y[keys(demand)] >= 0)
for (h, d) in demand
if d > 50
#constraint(m, y[h] == d)
else
#constraint(m, x[h] == d)
end
end
status = solve(m)
println("Objective value: ", getobjectivevalue(m))
println("x = ", getvalue(x))
println("y = ", getvalue(y))
REF:
Reply of #Fengyang Wang
Comment of #Wikunia at https://stackoverflow.com/a/51910619/1096140
https://jump.readthedocs.io/en/latest/quickstart.html
Related
I am creating a variable called indexPoints that contains a subset of index values that passed certain conditions -
set.seed(1)
x = abs(rnorm(100,1))
y = abs(rnorm(100,1))
threshFC = 0.5
indexPoints=c()
seqVec = seq(1, length(x))
for (i in seq_along(seqVec)){
fract = x[i]/y[I]
fract[1] = NaN
if (!is.nan(fract)){
if(fract > (threshFC + 1) || fract < (1/(threshFC+1))){
indexPoints = c(indexPoints, i)
}
}
}
I am trying to recreate indexPoints using a more efficient method like apply methods (any except sapply). I started the process as shown below -
set.seed(1)
x = abs(rnorm(100,1))
y = abs(rnorm(100,1))
threshFC = 0.5
seqVec <- seq_along(x)
fract = x[seqVec]/y[seqVec]
fract[1] = NaN
vapply(fract, function(i){
if (!is.nan(fract)){ if(fract > (threshFC + 1) || fract < (1/(threshFC+1))){ i}}
}, character(1))
However, this attempt causes an ERROR:
Error in vapply(fract, function(i) { : values must be length 1,
but FUN(X[[1]]) result is length 0
How can I continue to modify the code to make it in an apply format. Note: sometimes, the fract variable contains NaN values, which I mimicked for the minimum examples above by using "fract[1] = NaN".
There are several problems with your code:
You tell vapply that you expect the internal code to return a character, yet the only thing you ever return is i which is numeric;
You only explicitly return something when all conditions are met, which means if the conditions are not all good, you do not return anything ... this is the same as return(NULL) which is also not character (try vapply(1:2, function(a) return(NULL), character(1)));
You explicitly set fract[1] = NaN and then test !is.nan(fract), so you will never get anything; and
(Likely a typo) You reference y[I] (capital "i") which is an error unless I is defined somewhere (which is no longer a syntax error but is now a logical error).
If I fix the code (remove NaN assignment) in your for loop, I get
indexPoints
# [1] 3 4 5 6 10 11 12 13 14 15 16 18 20 21 25 26 28 29 30 31 32 34 35 38 39
# [26] 40 42 43 44 45 47 48 49 50 52 53 54 55 56 57 58 59 60 61 64 66 68 70 71 72
# [51] 74 75 77 78 79 80 81 82 83 86 88 89 90 91 92 93 95 96 97 98 99
If we really want to do this one at a time (I recommend against it, read below), then there are a few methods:
Use Filter to only return the indices where the condition is true:
indexPoints2 <- Filter(function(i) {
fract <- x[i] / y[i]
!is.nan(fract) && (fract > (threshFC+1) | fract < (1/(threshFC+1)))
}, seq_along(seqVec))
identical(indexPoints, indexPoints2)
# [1] TRUE
Use vapply correctly, returning an integer either way:
indexPoints3 <- vapply(seq_along(seqVec), function(i) {
fract <- x[i] / y[i]
if (!is.nan(fract) && (fract > (threshFC+1) | fract < (1/(threshFC+1)))) i else NA_integer_
}, integer(1))
str(indexPoints3)
# int [1:100] NA NA 3 4 5 6 NA NA NA 10 ...
indexPoints3 <- indexPoints3[!is.na(indexPoints3)]
identical(indexPoints, indexPoints3)
# [1] TRUE
(Notice the explicit return of a specific type of NA, that is NA_integer_, so that vapply is happy.)
We can instead just return the logical if the index matches the conditions:
logicalPoints4 <- vapply(seq_along(seqVec), function(i) {
fract <- x[i] / y[i]
!is.nan(fract) && (fract > (threshFC+1) | fract < (1/(threshFC+1)))
}, logical(1))
head(logicalPoints4)
# [1] FALSE FALSE TRUE TRUE TRUE TRUE
identical(indexPoints, which(logicalPoints4))
# [1] TRUE
But really, there is absolutely no need to use vapply or any of the apply functions, since this can be easily (and much more efficiently) checked as a vector:
fract <- x/y # all at once
indexPoints5 <- which(!is.nan(fract) & (fract > (threshFC+1) | fract < (1/(threshFC+1))))
identical(indexPoints, indexPoints5)
# [1] TRUE
(If you don't use which, you'll see that it gives you a logical vector indicating if the conditions are met, similar to bullet 3 above with logicalPoints4.)
Say I have a matrix with 1000 columns. I want to create a new matrix with every other n columns from the original matrix, starting from column i.
So let say that n=3 and i=5, then the columns I need from the old matrix are 5,6,7,11,12,13,17,18,19 and so on.
Using two seq()s to create the start and stop bounds, then using a mapply() on those to build your true column index intervals. Then just normal bracket notation to extract from your matrix.
set.seed(1)
# using 67342343's test case
M <- matrix(runif(100^2), ncol = 100)
n <- 3
i <- 5
starts <- seq(i, ncol(M), n*2)
stops <- seq(i+(n-1), ncol(M), n*2)
col_index <- c(mapply(seq, starts, stops)) # thanks Jaap and Sotos
col_index
[1] 5 6 7 11 12 13 17 18 19 23 24 25 29 30 31 35 36 37 41 42 43 47 48 49 53 54 55 59 60 61 65 66 67 71 72 73 77 78
[39] 79 83 84 85 89 90 91 95 96 97
M[, col_index]
Another solution is based on the fact that R uses index recycling:
i <- 5; n <- 3
M <- matrix(runif(100^2), ncol = 100)
id <- seq(i, ncol(M), by = 1)[rep(c(TRUE, FALSE), each = n)]
M_sub <- M[, id]
I would write a function that determines the indices of the columns you want, and then call that function as needed.
col_indexes <- function(mat, start = 1, by = 1){
n <- ncol(mat)
inx <- seq(start, n, by = 2*by)
inx <- c(sapply(inx, function(i) i:(i + by -1)))
inx[inx <= n]
}
m <- matrix(0, nrow = 1, ncol = 20)
icol <- col_indexes(m, 5, 3)
icol
[1] 5 6 7 11 12 13 17 18 19
Here is a method using outer.
c(outer(5:7, seq(0L, 95L, 6L), "+"))
[1] 5 6 7 11 12 13 17 18 19 23 24 25 29 30 31 35 36 37 41 42 43 47 48 49 53
[26] 54 55 59 60 61 65 66 67 71 72 73 77 78 79 83 84 85 89 90 91 95 96 97
To generalize this, you could do
idx <- c(outer(seq(i, i + n), seq(0L, ncol(M) - i, 2 * n), "+"))
The idea is to construct the initial set of columns (5:7 or seq(i, i + n)), calculate the starting points for every subsequent set (seq(0L, 95L, 6L) or seq(0L, ncol(M) - i, 2 * n)) then use outer to calculate the sum of every combination of these two vectors.
you can subset the matrix using [ like M[, idx].
This question already has answers here:
R: How to use ifelse statement for a vector of characters
(2 answers)
Closed 6 years ago.
My friend gave me a brain teaser that I wanted to try on R.
Imagine 100 coins in a row, with heads facing up for all coins. Now every 2nd coin is flipped (thus becoming tails). Then every 3rd coin is flipped. How many coins are now showing heads?
To create the vector, I started with:
flips <- rep('h', 100)
levels(flips) <- c("h", "t")
Not sure how to proceed from here. Any help would be appreciated.
Try this:
coins <- rep(1, 100) # 1 = Head, 0 = Tail
n = 3 # run till the time when you flip every 3rd coin
invisible(sapply(2:n function(i) {indices <- seq(i, 100, i); coins[indices] <<- (coins[indices] + 1) %% 2}) )
which(coins == 1)
# [1] 1 5 6 7 11 12 13 17 18 19 23 24 25 29 30 31 35 36 37 41 42 43 47 48 49 53 54 55 59 60 61 65 66 67 71 72 73 77 78 79 83 84 85 89 90 91 95 96 97
sum(coins==1)
#[1] 49
If you run till n = 100, only the coins at the positions which are perfect squares will be showing heads.
coins <- rep(1, 100) # 1 = Head, 0 = Tail
n <- 100
invisible(sapply(2:n, function(i) {indices <- seq(i, 100, i); coins[indices] <<- (coins[indices] + 1) %% 2}) )
which(coins == 1)
# [1] 1 4 9 16 25 36 49 64 81 100
sum(coins==1)
# [1] 10
I'm trying to create a function to find a "maxima" and "minima". I have the following data:
y
157
144
80
106
124
46
207
188
190
208
143
170
162
178
155
163
162
149
135
160
149
147
133
146
126
120
151
74
122
145
160
155
173
126
172
93
I have tried this function to find "maxima"
localMaxima <- function(x) {
# Use -Inf instead if x is numeric (non-integer)
y <- diff(c(-.Machine$integer.max, x)) > 0L
rle(y)$lengths
y <- cumsum(rle(y)$lengths)
y <- y[seq.int(1L, length(y), 2L)]
if (x[[1]] == x[[2]]) {
y <- y[-1]
}
y
}
maks <- localMaxima(x)
And funtion to find "minima"
localMinima <- function(x) {
# Use -Inf instead if x is numeric (non-integer)
y <- diff(c(.Machine$integer.max, x)) > 0L
rle(y)$lengths
y <- cumsum(rle(y)$lengths)
y <- y[seq.int(1L, length(y), 2L)]
if (x[[1]] == x[[2]]) {
y <- y[-1]
}
y
}
mins <- localMinima(x)
And the result is not 100% right
maks = 1 5 7 10 12 14 16 20 24 27 31 33 35
mins = 3 6 8 11 13 15 19 23 26 28 32 34 36
The result should
maks = 5 7 10 12 14 16 20 24 27 31 33 35
mins = 3 6 8 11 13 15 19 23 26 28 32 34
Finding local maxima and minima in R comes close, but doesn't quite fit.
How can I fix this?
Thanks you very much
You could define two functions like the below which produce the vectors you need:
library(data.table)
#shift lags or leads a vector by a certain amount defined as the second argument
#the default is to lag a vector.
#The rationale behind the below code is that each local minimum's adjucent
#values will be greater than itself. The opposite is true for a local
#maximum. I think this is what you are trying to achieve and one way to do
#it is the following code
maximums <- function(x) which(x - shift(x, 1) > 0 & x - shift(x, 1, type='lead') > 0)
minimums <- function(x) which(x - shift(x, 1) < 0 & x - shift(x, 1, type='lead') < 0)
Output:
> maximums(y)
[1] 5 7 10 12 14 16 20 24 27 31 33 35
> minimums(y)
[1] 3 6 8 11 13 15 19 23 26 28 32 34
this is a function i wrote a while back (and it's more general than you need). it finds peaks in sequential data x, where i define a peak as a local maxima with m points either side of it having lower value than it (so bigger m leads to more stringent criteria for peak finding):
find_peaks <- function (x, m = 3){
shape <- diff(sign(diff(x, na.pad = FALSE)))
pks <- sapply(which(shape < 0), FUN = function(i){
z <- i - m + 1
z <- ifelse(z > 0, z, 1)
w <- i + m + 1
w <- ifelse(w < length(x), w, length(x))
if(all(x[c(z : i, (i + 2) : w)] <= x[i + 1])) return(i + 1) else return(numeric(0))
})
pks <- unlist(pks)
pks
}
so for your case m = 1:
find_peaks(x, m = 1)
#[1] 5 7 10 12 14 16 20 24 27 31 33 35
and for the minima:
find_peaks(-x, m = 1)
#[1] 3 6 8 11 13 15 19 23 26 28 32 34
Hi I never edited a question of mine but I'll give it a try. It's not soo extremely important what the code means actually. For me only saving the vectors "liste" in a new list is relevant :D
test <- list()
test <- replicate(5, sample(1:100, 50), simplify = FALSE) # Creates a list of 5 vectors
> test[[1]]
[1] 90 96 20 86 32 77 83 33 64 29 88 97 78 81 40 60 89 19 31 59 26 38 34 71 5 80 85
[28] 3 70 87 41 50 6 18 37 58 9 76 91 62 12 30 42 94 72 95 100 10 68 82
S <- test[[1]]
x <- diff(S) # following algorythm creates "liste" (vector) for test [[1]]
trendtest <- list()
k <- NULL
d <- NULL
t <- vector("list",length(x))
A <- vector("list",length(x))
z <- vector("list",length(x)-2)
za <- vector("list",length(x)-2)
liste <- NULL
dreisum <- sapply(1:(length(x)-2), function(i) sum(x[c(i,(i+1))]))
dreisumi <- lapply(1:(length(x)-2), function(i) dreisum[i:(length(x)-2)])
zdreisumi<- lapply(1:(length(x)-4), function(i) dreisumi[[i]] [3:length(dreisumi[[i]])]<0)
zadreisumi<- lapply(1:(length(S)-4), function(i) dreisumi[[i]][3:length(dreisumi[[i]])]>0)
Si <- lapply(1:(length(x)-2), function(i) S[i:(length(x))])
i <- 1
h <- 1
while(i<(length(x)-3) & h!=Inf){
k <- c(k,k <- (S[i]-S[i+2])/(-2))
d <- c(d,d <- (S[i+2]*i-S[i]*(i+2))/(-2))
t[[i]] <- i:(length(x))
A[[i]] <- k[length(liste)+1]*t[[i]]+d[length(liste)+1]
A[[i]][3] <- S[i+2]
z[[i]] <- Si[[i]][3:length(Si[[i]])]<A[[i]][3:length(A[[i]])]
za[[i]] <- Si[[i]][3:length(Si[[i]])]>A[[i]][3:length(A[[i]])]
if(k[length(liste)+1]>0 & S[i+3]>A[[i]][4] & is.element(TRUE,z[[i]])){h <- (min(which(z[[i]]!=FALSE))+1)}else{
if(k[length(liste)+1]>0 & S[i+3]<A[[i]][4] & is.element(TRUE,za[[i]])){h <- (min(which(za[[i]]!=FALSE))+1)}else{
if(k[length(liste)+1]<0 & S[i+3]>A[[i]][4] & is.element(TRUE,z[[i]])){h <- (min(which(z[[i]]!=FALSE))+1)}else{
if(k[length(liste)+1]<0 & S[i+3]<A[[i]][4] & is.element(TRUE,za[[i]])){h <- (min(which(za[[i]]!=FALSE))+1)}else{
if(k[length(liste)+1]>0 & S[i+3]>A[[i]][4] & (all(z[[i]]==FALSE))){h <- (min(which(zdreisumi[[i]]!=FALSE))+2)}else{
if(k[length(liste)+1]>0 & S[i+3]<A[[i]][4] & (all(za[[i]]==FALSE))){h <- (min(which(zdreisumi[[i]]!=FALSE))+2)}else{
if(k[length(liste)+1]<0 & S[i+3]>A[[i]][4] & (all(z[[i]]==FALSE))){h <- (min(which(zadreisumi[[i]]!=FALSE))+2)}else{
if(k[length(liste)+1]<0 & S[i+3]<A[[i]][4] & (all(za[[i]]==FALSE))){h <- (min(which(zadreisumi[[i]]!=FALSE))+2)}}}}}}}}
liste <- c(liste,i)
i <- i+h-1
if((length(x)-3)<=i & i<=length(x)){liste <- c(liste,i)}}
> liste
[1] 1 3 7 10 12 16 18 20 24 27 30 33 36 39 41 46
Actually the whole code is not so interesting for my problem because it works! I made the example for test[[1]] now. BUT I want that a for-loop (or whatever) takes ALL vectors in "test" and saves ALL 5 vectors "liste" in a new list (lets call it "trendtest" ... whatever :D)
The following will do what you ask for:
Delete the line trendtest <- list().
Take the code from x <- diff(S) to last line (except the very last line that only prints liste) and insert it at the position indicated by the placeholder __CODE_HERE__.
trendtest <- lapply(test, FUN = function(S) {
__CODE_HERE__
return(liste)
})
This is the "R way" of doing what you want. Alternatively, you could do the following (which is closer to your initial approach, but less the "R way"):
trendtest <- vector("list", length(test))
for (u in 1:length(test)) { # better: u in seq_along(test)
S <- test[[u]]
__CODE_HERE__
trendtest[[u]] <- liste
}
Note that there will be an error message which is due to the sample data (which doesn't fit the algorithm provided) and is unrelated to saving liste in trendtest.