R looping: to display numbers in an interval - r

I have a dataset and I want to display the numbers for each row between col1 and col2 counted by col3 using R:
dataset=data.frame(col1=c(3,9,15), col2=c(4,11,16), col3=c(2,3,2))
My result should look like:
3
3
4
4
9
9
9
10
10
10
11
11
11
15
15
16
16
Seems trivial but I cannot get a for loop work. Thanks.

Or this can be done with apply
unlist(apply(dataset, 1, function(x) rep(x[1]:x[2],
each=x[3])))
#[1] 3 3 4 4 9 9 9 10 10 10 11 11 11 15 15 16 16

Try this:
col1=c(3,9,15)
col2=c(4,11,16)
col3=c(2,3,2)
res = NULL
for (k in 1:length(col1)){
res = c(res, sort(rep(col1[k]:col2[k],col3[k])))
}
Result:
> res
[1] 3 3 4 4 9 9 9 10 10 10 11 11 11 15 15 16 16

Related

R Script to rearrange the elements of a vector by interleaving it

How to write an R-script to initialize a vector with integers, rearrange the elements by interleaving the
first half elements with the second half elements and store in the same vector without using pre-defined function and display the updated vector.
This sounds like a homework question, and it would be nice to see some effort on your own part, but it's pretty straightforward to do this in R.
Suppose your vector looks like this:
vec <- 1:20
vec
#> [1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
Then you can just do:
c(t(cbind(vec[1:10], vec[11:20])))
#> [1] 1 11 2 12 3 13 4 14 5 15 6 16 7 17 8 18 9 19 10 20
This works by joining the two vectors into a 10 x 2 matrix, then transposing that matrix and turning it into a vector.
We may use matrix directly and concatenate
c(matrix(vec, nrow = 2, byrow = TRUE))
-output
[1] 1 11 2 12 3 13 4 14 5 15 6 16 7 17 8 18 9 19 10 20
data
vec <- 1:20
Or using mapply:
vec <- 1:20
c(mapply(\(x,y) c(x,y), vec[1:10], vec[11:20]))
#> [1] 1 11 2 12 3 13 4 14 5 15 6 16 7 17 8 18 9 19 10 20
We can try this using order + %%
> vec[order((seq_along(vec) - 1) %% (length(vec) / 2))]
[1] 1 11 2 12 3 13 4 14 5 15 6 16 7 17 8 18 9 19 10 20
Another way is to use rbind on the 2 halves of the vector, which creates a matrix with two rows. Then, we can then turn the matrix into a vector, which will go through column by column (i.e., 1, 11, 2, 12...). However, this will only work for even vectors.
vec <- 1:20
c(rbind(vec[1:10], vec[11:20]))
# [1] 1 11 2 12 3 13 4 14 5 15 6 16 7 17 8 18 9 19 10 20
So, for uneven vectors, we can use order, which will return the indices of the numbers in the two seq_along vectors.
vec2 <- 1:21
order(c(seq_along(vec2[1:10]),seq_along(vec2[11:21])))
# [1] 1 11 2 12 3 13 4 14 5 15 6 16 7 17 8 18 9 19 10 20 21

R: take 2 random non-overlapping samples (for same indexes) of length n out of vector of length n as well

Say I have a vector named all_combinations with numbers from 1 to 20.
I need to extract 2 vectors (coding_1 and coding_2) of length equal to number_of_peptide_clusters, which happens to be 20 as well in my current case.
The 2 new vectors should be randomly sampled from all_combinations, so that are not overlapping at each index position.
I do the following:
set.seed(3)
all_combinations=1:20
number_of_peptide_clusters=20
coding_1 <- sample(all_combinations, number_of_peptide_clusters, replace = FALSE)
coding_1
[1] 5 12 7 4 10 8 11 15 17 16 18 13 9 20 2 14 19 1 3 6
coding_2 <- sample(all_combinations, number_of_peptide_clusters, replace = FALSE)
coding_2
[1] 5 9 19 16 18 12 8 6 15 3 13 14 7 2 11 20 10 4 17 1
This is the example that gives me trouble, cause only one number is overlapping at the same index (5 at position 1).
What I would do in these cases is spot the overlapping numbers and resample them out of the list of all overlapping numbers...
Imagine coding_1 and coding_2 were:
coding_1
[1] 5 9 7 4 10 8 11 15 17 16 18 13 12 20 2 14 19 1 3 6
coding_2
[1] 5 9 19 16 18 12 8 6 15 3 13 14 7 2 11 20 10 4 17 1
In this case I would have 5 and 9 overlapping in the same position, so I would resample them in coding_2 out of the full list of overlapping ones [resample index 1 from c(5,9) so that isn't equal to 5, and index 2 so it isn't equal to 9]. So coding_2 would be:
coding_2
[1] 9 5 19 16 18 12 8 6 15 3 13 14 7 2 11 20 10 4 17 1
However, in the particular case above, I cannot use such approach... So what would be the best way to obtain 2 samples of length 20 from a vector of length 20 as well, so that the samples aren't overlapping at the same index positions?
It would be great that I could obtain the second sample coding_2 already knowing coding_1... Otherwise obtaining the 2 at the same time would also be acceptable if it makes things easier. Thanks!
I think the best solution is simply to use a rejection strategy:
set.seed(3)
all_combinations <- 1:20
number_of_peptide_clusters <- 20
count <- 0
repeat {
count <- count + 1
message("Try number ", count)
coding_1 <- sample(all_combinations, number_of_peptide_clusters, replace = FALSE)
coding_2 <- sample(all_combinations, number_of_peptide_clusters, replace = FALSE)
if (!any(coding_1 == coding_2))
break
}
#> Try number 1
#> Try number 2
#> Try number 3
#> Try number 4
#> Try number 5
#> Try number 6
#> Try number 7
#> Try number 8
#> Try number 9
coding_1
#> [1] 18 16 17 12 13 8 6 15 3 5 20 9 11 4 19 2 14 7 1 10
coding_2
#> [1] 5 20 14 2 11 6 7 10 19 8 4 1 15 9 13 17 18 16 12 3
Created on 2020-11-04 by the reprex package (v0.3.0)

How to delete this [] from column?

I've downloaded a table from wikipedia and in some columns there are links next to numbers. Is this possible to delete it ?
In column in Rstudio it looks like this:
402[38]
[38] - this is what I don't want.
We can do this easily in base R with Regex:
a <- data.frame(V1 = paste0(1:20, sprintf("[%s]", 50:70))
a$V2 <- gsub("\\[.*?\\]","", a$V1)
V1 V2
1 1[50] 1
2 2[51] 2
3 3[52] 3
4 4[53] 4
5 5[54] 5
6 6[55] 6
7 7[56] 7
8 8[57] 8
9 9[58] 9
10 10[59] 10
11 11[60] 11
12 12[61] 12
13 13[62] 13
14 14[63] 14
15 15[64] 15
16 16[65] 16
17 17[66] 17
18 18[67] 18
19 19[68] 19
20 20[69] 20
21 1[70] 1
And this conveniently works for the case of multiple references as well:
a <- data.frame(V1 = paste0(1:20, sprintf("[%s][%s]", 50:70, 80:100)))

loop in R to subset from list object ( extract multiple tables from excel sheets)

I need to extract separate tables from each excel sheet and have them as a list object. I have two lists : "allsheets" contains 38 sheets and each of sheets includes at least 2 tables, and "dataRowMeta" contains information about which rows are relevant for each table. For example,
a1 <- data.frame(y1=c(1:15),y2=c(6:20))
a2 <- data.frame(y1=c(3:18),y2=c(2:17))
allsheets <- list(a1, a2)
d1<- data.frame(starthead=c(1,9),endhead=c(2,10),startdata =c(3,11),
enddata = c(7,14),footer = c(8,15))
d2<- data.frame(starthead=c(1,10),endhead=c(2,11),startdata =c(3,12),
enddata = c(8,15),footer = c(9,16))
dataRowMeta <- list(d1,d2)
[[1]]
y1 y2
1 1 6
2 2 7
3 3 8
4 4 9
5 5 10
6 6 11
7 7 12
8 8 13
9 9 14
10 10 15
11 11 16
12 12 17
13 13 18
14 14 19
15 15 20
[[2]]
y1 y2
1 3 2
2 4 3
3 5 4
4 6 5
5 7 6
6 8 7
7 9 8
8 10 9
9 11 10
10 12 11
11 13 12
12 14 13
13 15 14
14 16 15
15 17 16
16 18 17
and here is dataRowMeta :
[[1]]
starthead endhead startdata enddata footer
1 1 2 3 7 8
2 9 10 11 14 15
[[2]]
starthead endhead startdata enddata footer
1 1 2 3 8 9
2 10 11 12 15 16
I've tried to write a loop function which would subset each sheet according to dataRowMeta, but failed to get a desired output.
I am getting an error
Error in sheet[[a[m]:b[m], ]] : incorrect number of subscripts
I guess that's because I am iterating over list, not matrices...but how to tell R to subset list in this case?
So I need 1st and 4th columns of dataRowMeta(starthead and enddata) as "start" and "end" id rows of future tables.
tables <- function(allsheets,dataRowMeta){
for(i in 1 : length(dataRowMeta)){
for (j in 1 : nrow(dataRowMeta[[i]])){
a <-""
b <- ""
a <- dataRowMeta[[i]][j:j,1]
b <- dataRowMeta[[i]][j:j,4]
for (k in 1 : length(allsheets)){
sheet <- allsheets[k]
for ( m in 1 : length(a)){
tbl <- sheet[[a[m]:b[m],]]
}
}
}
}}
Desired output : I have this for the first element of the first list(sheet1):
sheet1 <- allsheets[[1]]
tmp1 <- sheet1[dataRowMeta[[1]][1:1,1] :dataRowMeta[[1]][1:1,4] ,]
> tmp1
y1 y2
1 1 6
2 2 7
3 3 8
4 4 9
5 5 10
6 6 11
7 7 12
And need a loop which would do it for all sheets. Please help me to figure out how to get it. Thank you!

stratified 10 fold cross validation

I have made a start to create some training and test sets using 10 fold crossvalidation for an artificial dataset:
rows <- 1000
X1<- sort(runif(n = rows, min = -1, max =1))
occ.prob <- 1/(1+exp(-(0.0 + 3.0*X1)))
true.presence <- rbinom(n = rows, size = 1, prob = occ.prob)
# combine data as data frame and save
data <- data.frame(X1, true.presence)
id <- sample(1:10,nrow(data),replace=TRUE)
ListX <- split(data,id)
fold1 <- data[id==1,]
fold2 <- data[id==2,]
fold3 <- data[id==3,]
fold4 <- data[id==4,]
fold5 <- data[id==5,]
fold6 <- data[id==6,]
fold7 <- data[id==7,]
fold8 <- data[id==8,]
fold9 <- data[id==9,]
fold10 <- data[id==10,]
trainingset <- subset(data, id %in% c(2,3,4,5,6,7,8,9,10))
testset <- subset(data, id %in% c(1))
I am just wondering whether there are easier ways to achieve this and how I could perform stratified crossvalidation which ensures that the class priors (true.presence) are roughly the same in all folds?
createFolds method of caret package performs a stratified partitioning. Here is a paragraph from the help page:
... The random sampling is done within the levels of y (=outcomes) when y is a factor in an attempt to balance the class distributions within the splits.
Here is the answer of your problem:
library(caret)
folds <- createFolds(factor(data$true.presence), k = 10, list = FALSE)
and the proportions:
> library(plyr)
> data$fold <- folds
> ddply(data, 'fold', summarise, prop=mean(true.presence))
fold prop
1 1 0.5000000
2 2 0.5050505
3 3 0.5000000
4 4 0.5000000
5 5 0.5000000
6 6 0.5049505
7 7 0.5000000
8 8 0.5049505
9 9 0.5000000
10 10 0.5050505
I'm sure that (a) there's a more efficient way to code this, and (b) there's almost certainly a function somewhere in a package that will just return the folds, but here's some simple code that gives you an idea of how one might do this:
rows <- 1000
X1<- sort(runif(n = rows, min = -1, max =1))
occ.prob <- 1/(1+exp(-(0.0 + 3.0*X1)))
true.presence <- rbinom(n = rows, size = 1, prob = occ.prob)
# combine data as data frame and save
dat <- data.frame(X1, true.presence)
require(plyr)
createFolds <- function(x,k){
n <- nrow(x)
x$folds <- rep(1:k,length.out = n)[sample(n,n)]
x
}
folds <- ddply(dat,.(true.presence),createFolds,k = 10)
#Proportion of true.presence in each fold:
ddply(folds,.(folds),summarise,prop = sum(true.presence)/length(true.presence))
folds prop
1 1 0.5049505
2 2 0.5049505
3 3 0.5100000
4 4 0.5100000
5 5 0.5100000
6 6 0.5100000
7 7 0.5100000
8 8 0.5100000
9 9 0.5050505
10 10 0.5050505
#joran is right (regarding his assumption (b)). dismo::kfold() is what you are looking for.
So using data from the initial question:
require(dismo)
folds <- kfold(data, k=10, by=data$true.presence)
gives a vector of length nrow(data) containing the fold association of each row of data.
Hence, data[fold==1,] returns the 1st fold and data[fold!=1,] can be used for validation.
edit 6/2018: I strongly support using the caret package as recommended by #gkcn. It is better integrated in the tidyverse workflow and more actively developed. Go with that!
I found splitTools is pretty useful, hope the vignette https://cran.r-project.org/web/packages/splitTools/vignettes/splitTools.html can help anyone interested in this topic.
> y <- rep(c(letters[1:4]), each = 5)
> y
[1] "a" "a" "a" "a" "a" "b" "b" "b" "b" "b" "c" "c" "c" "c" "c" "d" "d" "d" "d" "d"
> create_folds(y)
$Fold1
[1] 1 2 3 5 6 7 8 10 12 13 14 15 17 18 19 20
$Fold2
[1] 1 2 4 5 6 8 9 10 11 12 13 14 16 17 19 20
$Fold3
[1] 2 3 4 5 6 7 9 10 11 12 13 15 16 17 18 20
$Fold4
[1] 1 2 3 4 7 8 9 10 11 13 14 15 16 18 19 20
$Fold5
[1] 1 3 4 5 6 7 8 9 11 12 14 15 16 17 18 19
> create_folds(y, m_rep = 3)
$Fold1.Rep1
[1] 1 2 4 5 6 7 8 10 11 12 13 15 16 17 19 20
$Fold2.Rep1
[1] 2 3 4 5 6 8 9 10 11 12 13 14 16 17 18 20
$Fold3.Rep1
[1] 1 2 3 5 7 8 9 10 11 12 14 15 17 18 19 20
$Fold4.Rep1
[1] 1 2 3 4 6 7 9 10 11 13 14 15 16 18 19 20
$Fold5.Rep1
[1] 1 3 4 5 6 7 8 9 12 13 14 15 16 17 18 19
$Fold1.Rep2
[1] 1 2 3 5 6 8 9 10 11 12 13 14 16 17 18 19
$Fold2.Rep2
[1] 1 2 3 4 6 7 8 10 11 12 14 15 17 18 19 20
$Fold3.Rep2
[1] 2 3 4 5 6 7 8 9 12 13 14 15 16 17 19 20
$Fold4.Rep2
[1] 1 3 4 5 7 8 9 10 11 13 14 15 16 17 18 20
$Fold5.Rep2
[1] 1 2 4 5 6 7 9 10 11 12 13 15 16 18 19 20
$Fold1.Rep3
[1] 1 2 3 4 6 7 9 10 11 12 13 15 16 18 19 20
$Fold2.Rep3
[1] 2 3 4 5 6 8 9 10 11 12 13 14 16 17 18 19
$Fold3.Rep3
[1] 1 2 4 5 6 7 8 9 11 12 14 15 16 17 19 20
$Fold4.Rep3
[1] 1 2 3 5 7 8 9 10 12 13 14 15 17 18 19 20
$Fold5.Rep3
[1] 1 3 4 5 6 7 8 10 11 13 14 15 16 17 18 20

Resources