I just spent last week learning R, and now I am playing with it, but I can't find the answer for this problem
I have utility function written like this
u(x,y)=min(3x,9y)
and the goal is to plot a contour graph of this function.
I tried quite a lot of solutions, until now I came to this
x<-seq(0,30,3)
y<-seq(0,90,9)
n<-1:11
table<-c(
pmin(x,y[1]),
pmin(x,y[2]),
pmin(x,y[3]),
pmin(x,y[4]),
pmin(x,y[5]),
pmin(x,y[6]),
pmin(x,y[7]),
pmin(x,y[8]),
pmin(x,y[9]),
pmin(x,y[10]),
pmin(x,y[11]))
mat<-matrix(table, ncol=11, nrow=11)
contour(x,y,mat)
and obviously, the contour graph is not very precise.
I would like to now, what can I use so I do not have to write the table by hand like this.
I wanted to use the sapply function somehow, but I have two values and I was kind of lost how to put them there.
and I would be very thankful, if someone showed me, how to plot this contour graph as most efficiently as possible.
You can use outer for this:
n <- 11
foo <- outer(X=seq_len(n), Y=seq_len(n), function(x, y) pmin(3*x, 9*y))
outer applies the specified function to all combinations of elements of the vectors passed to arguments X and Y. In this case, we're applying the function pmin(3*x, 9*y) to all pairs of elements of the two vectors, each of which are the numbers 1 to n.
foo
## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11]
## [1,] 3 3 3 3 3 3 3 3 3 3 3
## [2,] 6 6 6 6 6 6 6 6 6 6 6
## [3,] 9 9 9 9 9 9 9 9 9 9 9
## [4,] 9 12 12 12 12 12 12 12 12 12 12
## [5,] 9 15 15 15 15 15 15 15 15 15 15
## [6,] 9 18 18 18 18 18 18 18 18 18 18
## [7,] 9 18 21 21 21 21 21 21 21 21 21
## [8,] 9 18 24 24 24 24 24 24 24 24 24
## [9,] 9 18 27 27 27 27 27 27 27 27 27
## [10,] 9 18 27 30 30 30 30 30 30 30 30
## [11,] 9 18 27 33 33 33 33 33 33 33 33
contour(foo)
To increase the number of points at which the function is evaluated, just pass finer-resolution vectors:
foo2 <- outer(seq(1, 11, 0.01), seq(1, 11, 0.01), function(x, y) pmin(3*x, 9*y))
contour(foo2)
Now it is evaluated at 0.01 increments from 1 through 11.
Related
In R, I want to make a for loop in which I want to select the n lowest values, then the n lowest values excluding lowest value, then the n lowest values excluding the 2 lowest values etc.
Here's an example to clarify:
set.seed(1)
x <- round(rnorm(10,20,15))
n <- 4
I want to get:
7 8 11 15
8 11 15 23
11 15 23 25
15 23 25 27
23 25 27 29
25 27 29 31
27 29 31 44
I tried the following code, but then I do not get the last row (does not include last/highest value). I could get this by adding another code line in the for loop, but was wondering whether this could be done more efficient.
y <- matrix(data=NA, nrow=length(x)+1-n, ncol=n)
for (i in 1:(length(x)-n)) {y[i,] <- sort(x)[i:(i+n-1)]}
Thanks
set.seed(1)
x <- round(rnorm(10,20,15))
n <- 4
Get the pattern:
rbind(sort(x)[1:4], sort(x)[2:5], sort(x)[3:6], sort(x)[4:7], sort(x)[5:8], sort(x)[6:9], sort(x)[6:9], sort(x)[7:10])
Now, use dynamic programming in R to finish (in the general case):
matrix(c( sapply(1:(length(x)+1-n), function(i) sort(x)[i:(i+3)] )),nrow=length(x)+1-n, byrow=TRUE)
[,1] [,2] [,3] [,4]
[1,] 7 8 11 15
[2,] 8 11 15 23
[3,] 11 15 23 25
[4,] 15 23 25 27
[5,] 23 25 27 29
[6,] 25 27 29 31
[7,] 27 29 31 44
The most perfect one:
t(sapply(1:(length(x)+1-n), function(i) sort(x)[i:(i+3)] ))
[,1] [,2] [,3] [,4]
[1,] 7 8 11 15
[2,] 8 11 15 23
[3,] 11 15 23 25
[4,] 15 23 25 27
[5,] 23 25 27 29
[6,] 25 27 29 31
[7,] 27 29 31 44
Note that sapply provides columnwise outputs, hence a transpose finished the inconvinience.
Note to Rob: Apply family (apply, mapply, sapply, tapply etc.) overrides for. Hence, you should use this family as long as possible.
In R, what is the fastest way(shortest code) to print multiplication table?
The functions seq rep and the bind functions help, but I'm looking for the shortest line(s) of code to do this.
rbind("1\'s"=1:12, "2\'s"=seq(2,24,2), "3\'s"=seq(3,36,3),
"4\'s"=seq(4,48,4), "5\'s"=seq(5,60,5), "6\'s"=seq(6,72,6))
Prints the 1's through 6's going across (horizontally). Anyone know how to perform this in a more compact way?
tbl <- outer(1:6, 1:12, "*")
rownames(tbl) <- paste(1:6, "'s", sep="")
tbl
You could make slightly more compact by using paste0(1:6, "'s")
This seems a slight improvement:
> v<-setNames(1:6, paste0(1:6, "\'s"))
> v %o% v
1's 2's 3's 4's 5's 6's
1's 1 2 3 4 5 6
2's 2 4 6 8 10 12
3's 3 6 9 12 15 18
4's 4 8 12 16 20 24
5's 5 10 15 20 25 30
6's 6 12 18 24 30 36
A shortcut for outer(1:6, 1:12, "*"):
> 1:6 %o% 1:12
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,] 1 2 3 4 5 6 7 8 9 10 11 12
[2,] 2 4 6 8 10 12 14 16 18 20 22 24
[3,] 3 6 9 12 15 18 21 24 27 30 33 36
[4,] 4 8 12 16 20 24 28 32 36 40 44 48
[5,] 5 10 15 20 25 30 35 40 45 50 55 60
[6,] 6 12 18 24 30 36 42 48 54 60 66 72
I have a 60 column matrix, and I want to reverse the some of its rows.
I came across the following two ways to do this:
#rtr is an integer vectors with the indices of the rows I want to reverse
matrix[rtr,]<-matrix[rtr,(ncol(matrix):1]
and
matrix[rtr,]<-rev(mat[rtr,])
Are these two implementations expected to produce the same result, or
are there some differences between them?
Thanks in advance
This seems to be a pretty easy thing to test
mm <- matrix(1:(6*7), ncol=6)
m2 <- m1 <- mm
rtr<-c(1,6,7)
m1[rtr,]<-m1[rtr, ncol(m1):1]
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 36 29 22 15 8 1
# [2,] 2 9 16 23 30 37
# [3,] 3 10 17 24 31 38
# [4,] 4 11 18 25 32 39
# [5,] 5 12 19 26 33 40
# [6,] 41 34 27 20 13 6
# [7,] 42 35 28 21 14 7
m2[rtr,]<-rev(m2[rtr,])
# [,1] [,2] [,3] [,4] [,5] [,6]
# [1,] 42 35 28 21 14 7
# [2,] 2 9 16 23 30 37
# [3,] 3 10 17 24 31 38
# [4,] 4 11 18 25 32 39
# [5,] 5 12 19 26 33 40
# [6,] 41 34 27 20 13 6
# [7,] 36 29 22 15 8 1
We can see they produce different output. The latter changes the order of the rows as well rather than just reversing them "in place"
I am a new user to R and for loop. I am trying to take sampling from data and check to see if there is a colinear column. I want to record in that iteration that the colinear column exists and record it in the vector (baditr). Also, I would like to print a line indicating that "colinearity is at iteration i". Then I would like the code to jump to the second iteration and continue running. For each iteration, I would like the code to save the sum of the columns in the corresponding row of the matrix.
My problem is that I am getting an NA for the bad iterations. My intent is for bad iterations to not be included in my matrix at all. Here is my code:
a0=rep(1,40)
a=rep(0:1,20)
b=c(rep(1,20),rep(0,20))
c0=c(rep(0,12),rep(1,28))
c1=c(rep(1,5),rep(0,35))
c2=c(rep(1,8),rep(0,32))
c3=c(rep(1,23),rep(0,17))
da=matrix(cbind(a0,a,b,c0,c1,c2,c3),nrow=40,ncol=7)
sing <- function(nrw){
sm <- matrix(NA,nrow=nrw,ncol=ncol(da))
baditr <- NULL
for(i in 1:nrw){
ind <- sample(1:nrow(da), nrow(da),replace =TRUE)
smdat <- da[ind,]
evals <- eigen(crossprod(smdat))$values
if(any(abs(evals) < 1e-7)){
baditr <- c(baditr,i)
cat("singularity occurs at", paste(i),"\n")
next
}
sm[i,] <- apply(smdat,2,sum)
}
return(sm)
}
sing(20)
I will get the following output:
singularity occurs at 9
singularity occurs at 13
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 40 23 22 25 5 8 26
[2,] 40 20 18 30 4 7 22
[3,] 40 19 24 28 6 7 25
[4,] 40 19 22 30 6 9 26
[5,] 40 12 26 26 8 13 30
[6,] 40 17 16 27 7 10 19
[7,] 40 20 17 33 3 5 19
[8,] 40 22 19 28 4 9 23
[9,] NA NA NA NA NA NA NA
[10,] 40 21 24 28 3 6 27
[11,] 40 21 16 31 2 4 22
[12,] 40 21 21 26 3 6 23
[13,] NA NA NA NA NA NA NA
[14,] 40 18 16 29 2 7 22
[15,] 40 24 18 30 6 9 21
[16,] 40 23 18 29 4 8 21
[17,] 40 17 25 25 3 8 29
[18,] 40 22 28 23 9 14 30
[19,] 40 25 23 25 7 11 30
[20,] 40 20 23 27 7 10 26
I would like my matrix to look like this:
singularity occurs at 9
singularity occurs at 13
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 40 23 22 25 5 8 26
[2,] 40 20 18 30 4 7 22
[3,] 40 19 24 28 6 7 25
[4,] 40 19 22 30 6 9 26
[5,] 40 12 26 26 8 13 30
[6,] 40 17 16 27 7 10 19
[7,] 40 20 17 33 3 5 19
[8,] 40 22 19 28 4 9 23
[10,] 40 21 24 28 3 6 27
[11,] 40 21 16 31 2 4 22
[12,] 40 21 21 26 3 6 23
[14,] 40 18 16 29 2 7 22
[15,] 40 24 18 30 6 9 21
[16,] 40 23 18 29 4 8 21
[17,] 40 17 25 25 3 8 29
[18,] 40 22 28 23 9 14 30
[19,] 40 25 23 25 7 11 30
[20,] 40 20 23 27 7 10 26
As a fail safe, I would also appreciate any information you may have on saving a certain number of iterations to a file (for example, 50 iterations), which I can override once the next number of iterations is produced. Meaning, I save the first 50 iterations to a file and then once the second round of 50 iterations is produced, they override the first round and as a result, my file now has 100 iterations.
Sorry for the long post. But thanks in advance.
Before you return sm, you can filter out the rows with NA values by using complete.cases(). It would look something like sm[complete.cases(sm),]. The function returns a logical vector of TRUE/FALSE values, which forces R to not return those values with FALSE.
Also, it doesn't look like you are doing anything with baditers after defining it.I can comment out all lines referring to baditers and your function seems to work just fine...maybe it's a legacy from an older iteration of your code?
Update
Here's your updated function using complete.cases(). Note I also commented out everything related to baditr to illustrate that it's not doing anything currently in your code.
sing <- function(nrw){
sm <- matrix(NA,nrow=nrw,ncol=ncol(da))
#baditr <- NULL
for(i in 1:nrw){
ind <- sample(1:nrow(da), nrow(da),replace =TRUE)
smdat <- da[ind,]
evals <- eigen(crossprod(smdat))$values
if(any(abs(evals) < 1e-7)){
#baditr <- c(baditr,i)
cat("singularity occurs at", paste(i),"\n")
next
}
sm[i,] <- apply(smdat,2,sum)
}
return(sm[complete.cases(sm),])
}
Now let's run the function, I'm wrapping dim() around the function call which will tell us the #rows and #columns of the resulting object:
> dim(sing(20))
singularity occurs at 6
[1] 19 7
So one singularity and a matrix of 19 rows and 7 columns, am I missing something?
As to your other question about writing things out, are you aware of the append parameter to write.table() and friends? The help page tells us that If TRUE, the output is appended to the file. If FALSE, any existing file of the name is destroyed.
Update 2
Here's an example using append = TRUE in write.table()
#Matrix 1 definition and write to file
x <- matrix(1:9, ncol = 3)
write.table(x, "out.txt", sep = "\t", col.names = TRUE, row.names = FALSE)
#Matrix 2 definition and write to same file with append = TRUE
x2 <- matrix(10:18, ncol = 3)
write.table(x2, "out.txt", sep = "\t", col.names = FALSE, row.names = FALSE, append = TRUE)
#read consolidated data back in to check if it's right
x3 <- read.table("out.txt", header = TRUE)
Results in
V1 V2 V3
1 1 4 7
2 2 5 8
3 3 6 9
4 10 13 16
5 11 14 17
6 12 15 18
In R, what is the fastest way(shortest code) to print multiplication table?
The functions seq rep and the bind functions help, but I'm looking for the shortest line(s) of code to do this.
rbind("1\'s"=1:12, "2\'s"=seq(2,24,2), "3\'s"=seq(3,36,3),
"4\'s"=seq(4,48,4), "5\'s"=seq(5,60,5), "6\'s"=seq(6,72,6))
Prints the 1's through 6's going across (horizontally). Anyone know how to perform this in a more compact way?
tbl <- outer(1:6, 1:12, "*")
rownames(tbl) <- paste(1:6, "'s", sep="")
tbl
You could make slightly more compact by using paste0(1:6, "'s")
This seems a slight improvement:
> v<-setNames(1:6, paste0(1:6, "\'s"))
> v %o% v
1's 2's 3's 4's 5's 6's
1's 1 2 3 4 5 6
2's 2 4 6 8 10 12
3's 3 6 9 12 15 18
4's 4 8 12 16 20 24
5's 5 10 15 20 25 30
6's 6 12 18 24 30 36
A shortcut for outer(1:6, 1:12, "*"):
> 1:6 %o% 1:12
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12]
[1,] 1 2 3 4 5 6 7 8 9 10 11 12
[2,] 2 4 6 8 10 12 14 16 18 20 22 24
[3,] 3 6 9 12 15 18 21 24 27 30 33 36
[4,] 4 8 12 16 20 24 28 32 36 40 44 48
[5,] 5 10 15 20 25 30 35 40 45 50 55 60
[6,] 6 12 18 24 30 36 42 48 54 60 66 72