I have this data set in R:
first_variable = rexp(100,100)
second_variable = rexp(100,100)
n_obs = 1:100
question_data = data.frame(n_obs, first_variable, second_variable)
I want to make this dataset so that:
The rows 1-10 has id:1,2,3,4,5,6,7,8,9,10
The rows 11-20 has id: 1,2,3,4,5,6,7,8,9,10
The rows 21-30 has id : 1,2,,3,4,5,6,7,8,9,10
etc
In other words, the id's 1-10 repeat for each sets of 10 rows.
I found this code that I thought would work:
# here, n = 10 (a set of n = 10 rows)
bloc_len <- 10
question_data$id <-
rep(seq(1, 1 + nrow(question_data) %/% bloc_len), each = bloc_len, length.out = nrow(question_data))
But this is not working, and is making each set of 10 rows as the same ID:
n_obs first_variable second_variable id
1 1 0.006223412 0.0258968583 1
2 2 0.004473815 0.0065543554 1
3 3 0.011745754 0.0005061101 1
4 4 0.005620351 0.0033549525 1
5 5 0.045860202 0.0132625822 1
6 6 0.002477348 0.0068517981 1
I would have wanted something like this:
n_obs first_variable second_variable id
1 1 0.0062234115 0.0258968583 1
2 2 0.0044738150 0.0065543554 2
3 3 0.0117457544 0.0005061101 3
4 4 0.0056203508 0.0033549525 4
5 5 0.0458602019 0.0132625822 5
6 6 0.0024773478 0.0068517981 6
7 7 0.0049527013 0.0047461094 7
8 8 0.0058581805 0.0108604478 8
9 9 0.0041171801 0.0002445268 9
10 10 0.0090667287 0.0019289691 10
11 11 0.0039002449 0.0135441919 1
12 12 0.0064558661 0.0230979415 2
13 13 0.0104993267 0.0005609776 3
14 14 0.0153162705 0.0038364012 4
15 15 0.0107109676 0.0183818539 5
16 16 0.0131620151 0.0029710189 6
17 17 0.0244441763 0.0095645480 7
18 18 0.0058112355 0.0125754349 8
19 19 0.0005022588 0.0156614272 9
20 20 0.0007572985 0.0049964333 10
21 21 0.0276024376 0.0024303513 1
Is this possible?
Thank you!
Instead of each, try using times:
question_data$id <-
rep(seq(bloc_len), times = nrow(question_data) %/% bloc_len, length.out = nrow(question_data))
Like the example shared, if the number of rows in the data (100) is completely divisible by the number of id's (10) then we can use R's recycling property to repeat the id's.
bloc_len <- 10
question_data$id <- seq_len(bloc_len)
If they are not completely divisible we can use rep -
question_data$id <- rep(seq_len(bloc_len), length.out = nrow(question_data))
Related
I am trying to fit a difference of Gamma functions to some fMRI data. Here is the function I am trying to fit:
# Difference of Gamma distributions to model HRF
DiffGammas <- function(x, w, ww, a, aa, b, bb) {
y1 = w*((b^a*x^(a-1)*exp(-x*b))/gamma(a))
y2 = (1-ww)*((bb^aa*x^(aa-1)*exp(-x*bb))/gamma(aa))
y = y1-y2;
return(y)
}
Here the data:
Run t y
1 0 0.032003192
1 1 0.035247903
1 2 0.075404794
1 3 0.246668665
1 4 0.43784297
1 5 0.48204744
1 6 0.306346753
1 7 0.143187816
1 8 0.057954844
1 9 0.013958918
1 10 0.022630042
1 11 -0.00735287
1 12 -0.055431955
1 13 -0.11563044
1 14 -0.155657944
1 15 -0.146548568
1 16 -0.086195647
1 17 -0.048550909
1 18 0.016424371
1 19 0.049021839
1 20 0.012366969
1 21 -0.03851945
1 22 -0.071969113
1 23 -0.044332852
2 0 0.08518882
2 1 0.110297941
2 2 0.185532434
2 3 0.352716178
2 4 0.53645537
2 5 0.599135887
2 6 0.443617796
2 7 0.275094048
2 8 0.179031458
2 9 0.118620937
2 10 0.111958314
2 11 0.072388446
2 12 -0.004448448
2 13 -0.058529647
2 14 -0.086651798
2 15 -0.085788373
2 16 -0.032654685
2 17 0.020878978
2 18 0.104788051
2 19 0.169295268
2 20 0.101337921
2 21 0.021178963
2 22 -0.025350047
2 23 -0.053233691
3 0 0.058608233
3 1 0.096408759
3 2 0.194452044
3 3 0.374613189
3 4 0.570983267
3 5 0.572352346
3 6 0.417996955
3 7 0.257623921
3 8 0.16186917
3 9 0.116943452
3 10 0.119766292
3 11 0.064198058
3 12 -0.013711493
3 13 -0.095039932
3 14 -0.105732843
3 15 -0.085641436
3 16 -0.041355324
3 17 0.001644888
3 18 0.037273866
3 19 0.03784796
3 20 0.004481299
3 21 -0.0216824
3 22 -0.020064194
3 23 -0.039836136
4 0 0.068518121
4 1 0.08325848
4 2 0.13751084
4 3 0.276952687
4 4 0.473697571
4 5 0.49691874
4 6 0.37607162
4 7 0.243455766
4 8 0.161476939
4 9 0.132455191
4 10 0.154391828
4 11 0.138457915
4 12 0.120507831
4 13 0.049945217
4 14 0.002031973
4 15 -0.009507957
4 16 0.052133462
4 17 0.107326776
4 18 0.153646926
4 19 0.15333057
4 20 0.107420992
4 21 0.038419348
4 22 0.009900797
4 23 -0.026444602
Where 'Run' is the type of stimulus, 't' is the time and 'y' is the BOLD signal. I want to compare a model in which Run 1-4 each has a separate set of parameters (model14) with a global model in which Runs 1-4 have the same parameters (model0).
model0 converges and works fine:
## Global fit (one curve for all data sets)
fo <- y ~ DiffGammas(t, w, ww, a, aa, b, bb)
model0 <- NULL
model0 <- nlsLM(fo,
data = mydata,
subset = Run %in% 1:4,
start = as.data.frame(rbind(coef(m1))),
trace = T)
summary(model0)
'start' in this case is:
w ww a aa b bb
1 1.769255 0.3870352 10.67308 92.03272 2.163427 6.408473
parameters have been estimated with an individual fit (m1) to Run 1 with the same 'DiffGammas' function.
However, when I try to fit a model with a different set of paramters for each Run:
model14 <- NULL
model14 <- nlsLM(y ~ DiffGammas(t, w[Run], ww[Run], a[Run], aa[Run], b[Run], bb[Run]),
data = mydata,
subset = Run %in% 1:4,
start = as.data.frame(rbind(coef(m1), coef(m2), coef(m3), coef(m4))),
trace = T)
summary(model14)
start in this case is:
w ww a aa b bb
1 1.769255 0.3870352 10.673081 92.03272 2.1634274 6.408473
2 2.857442 1.4833173 6.072707 139.16018 1.1338433 7.297339
3 2.868868 0.6270769 5.665530 132.47579 1.0744604 9.449620
4 2.721601 1.6320522 4.703770 138.55078 0.8022566 7.463612
with parameters been estimated with separate fits to Runs 1-4 with the same 'DiffGammas' function.
Running this last bit of code I get the following errors and I am not sure how to deal with them:
Error in dimnames(x) <- dn :
length of 'dimnames' [2] not equal to array extent
In addition: Warning message:
In matrix(out$hessian, nrow = length(unlist(par))) :
data length [36] is not a sub-multiple or multiple of the number of rows [24]
Any help is appreciated.
Best,
Andrea
With the rest of the data as they were,
start2 <- read.table(text=
" w ww a aa b bb
1 1.769255 0.3870352 10.673081 92.03272 2.1634274 6.408473
2 2.857442 1.4833173 6.072707 139.16018 1.1338433 7.297339
3 2.868868 0.6270769 5.665530 132.47579 1.0744604 9.449620
4 2.721601 1.6320522 4.703770 138.55078 0.8022566 7.463612
", header=TRUE )
models14 <- lapply( 1:nrow(start2), function(i) {
try( nlsLM( fo, data=mydata, start=start2[i,], subset = Run == i, trace=TRUE ) )
})
You will probably see, like me, that start parameter set 2 and 4 fails to produce a model.
This question already has answers here:
Multiplying elements of a column in skipping an element after each iteration
(3 answers)
Closed 3 years ago.
x <- as.data.frame(1:5)
with the above data frame I want to create a new column which has a running product, i.e. the first element should be
1*2*3*4*5 = 120 then
2*3*4*5 = 120 then
3*4*5 = 60
and so on.
How can I do this in R?
result should be
> x[,"result"] <- c(120,120,60,20,5)
> x
1:5 result
1 1 120
2 2 120
3 3 60
4 4 20
5 5 5
We can use cumprod
rev(cumprod(rev(x[[1]])))
#[1] 120 120 60 20 5
Or
rev(Reduce(`*`, rev(x[[1]]), accumulate = TRUE))
Also, there is a convenient wrapper in accumulate
library(tidyverse)
x %>%
mutate(result = accumulate(`1:5`, `*`, .dir = "backward"))
# 1:5 result
#1 1 120
#2 2 120
#3 3 60
#4 4 20
#5 5 5
To do so while simply adding a new column to your data:
data <- data.frame(list(x = 1:5))
data
x
1 1
2 2
3 3
4 4
5 5
data$prod <- apply(data,1,function(x) prod(x:5))
data
x prod
1 1 120
2 2 120
3 3 60
4 4 20
5 5 5
I need to create 10 bins with the most approximate frequency each; for this,
I am using the function "ClassInvervals" from the library (ClassInt) with the style
'quantile' for binning some data. This is working for must columns; but, when I have a column that has 1 number repeated too many times, it appears an error that says that some brackets are not unique, which makes sense assuming the last +30% of the column data is the same number so the function doesn't know how to split the bins.
What I would like to do is that if a number is greater than the 10% of the length of the column, then treat it as a different bin, and if not, then use the function as it is.
For example, let's assume we have this DF:
df <- read.table(text="
X
1 5
2 29
3 4
4 26
5 4
6 17
7 4
8 4
9 4
10 25
11 4
12 4
13 5
14 14
15 18
16 13
17 29
18 4
19 13
20 6
21 26
22 11
23 2
24 23
25 4
26 21
27 7
28 4
29 18
30 4",h=T,strin=F)
So in this case the 10% of the length would be 3, so if we create a table containing the frequency of each number, it would appear something like this:
2 1
4 11
5 2
6 1
7 1
11 1
13 2
14 1
17 1
18 2
21 1
23 1
25 1
26 2
29 2
With this info, first we should treat "4" as a unique bin.
So we have a final output more or less like this:
X Bins
1 5 [2,6)
2 29 [27,30)
3 4 [4]
4 26 [26,27)
5 4 [4]
6 17 [15,19)
7 4 [4]
8 4 [4]
9 4 [4]
10 25 [19,26)
11 4 [4]
12 4 [4]
13 5 [2,6)
14 14 [12,15)
15 18 [15,19)
16 13 [12,15)
17 29 [27,30)
18 4 [4]
19 13 [12,15)
20 6 [6,12)
21 26 [26,27)
22 11 [6,12)
23 2 [2,6)
24 23 [19,26)
25 4 [4]
26 21 [19,26)
27 7 [6,12)
28 4 [4]
29 18 [15,19)
30 4 [4]
Until now, my approach has been something like this:
Moda <- function(x) {
ux <- unique(x)
ux[which.max(tabulate(match(x, ux)))]
}
Binner <- function(df) {
library(classInt)
#Input is a matrix that wants to be binned
for (c in 1:ncol(df)) {
if (sapply(df,class)[c]=="numeric") {
VectorTest <- df[,c]
# Here I get the 10% of the values
TenPer <- floor(length(VectorTest)/10)
while((sum(VectorTest == Moda(VectorTest)))>=TenPer) {
# in this loop I manage to remove the values that
# are repeated more than 10% but I still don't know how to add it as a special bin
VectorTest <- VectorTest[VectorTest!=Moda(VectorTest)]
Counter <- Counter +1
}
binsTest <- classIntervals(VectorTest_Fixed, 10- Counter, style = 'quantile')
binsBrakets <- cut(VectorTest, breaks = binsTest$brks)
df[ , paste0("Binned_", colnames(df)[c])] <- binsBrakets
}
}
return (df)
}
Can someone help me?
You could use cutr::smart_cut:
# devtools::install_github("moodymudskipper/cutr")
library(cutr)
df$Bins <- smart_cut(df$X,list(10,"balanced"),"g",simplify = F)
table(df$Bins)
#
# [2,4) [4,5) [5,6) [6,11) [11,14) [14,18) [18,21) [21,25) [25,29) [29,29]
# 1 11 2 2 3 2 2 2 3 2
more on cutr and smart_cut
you can create two different dataframes: one with the 10% bins and the rest with the cut created bins. Then bind them together (make sure the bins are strings).
library(magrittr)
#lets find the numbers that appear more than 10% of the time
large <- table(df$X) %>%
.[. >= length(df$X)/10] %>%
names()
#these numbers appear less than 10% of the time
left_over <- df$X[!df$X %in% large]
#we want a total of 10 bins, so we'll cut the data into 10 - the number of 10%
left_over_bins <- cut(left_over, 10 - length(large))
#Let's combine the information into a single data frame
numbers_bins <- rbind(
data.frame(
n = left_over,
bins = left_over_bins %>% as.character,
stringsAsFactors = F
),
data.frame(
n = df$X[df$X %in% large],
bins = df$X[df$X %in% large] %>% as.character,
stringsAsFactors = F
)
)
If you table the information you'll get something like this
table(numbers_bins$bins) %>% sort(T)
4 (1.97,5] (11,14] (23,26] (17,20]
11 3 3 3 2
(20,23] (26,29] (5,8] (14,17] (8,11]
2 2 2 1 1
Seems simple but I can't figure it out.
I have a bunch of animal location data (217 individuals) as a single dataframe. I'm trying to randomly select X locations per individual for further analysis with the caveat that X is within the range of 6-156.
So I'm trying to set up a loop that first randomly selects a value within the range of 6-156 then use that value (say 56) to randomly extract 56 locations from the first individual animal and so on.
for(i in unique(ANIMALS$ID)){
sub<-sample(6:156,1)
sub2<-i([sample(nrow(i),sub),])
}
This approach didn't seem to work so I tried tweaking it...
for(i in unique(ANIMALS$ID)){
sub<-sample(6:156,1)
rand<-i[sample(1:nrow(i),sub,replace=FALSE),]
}
This did not work either.. Any suggestions or previous postings would be helpful!
Head of the datafile...ANIMALS is the name of the df, ID indicates unique individuals
> FID X Y MONTH DAY YEAR HOUR MINUTE SECOND ELKYR SOURCE ID animalid
1 0 510313 4813290 9 5 2008 22 30 0 342008 FG 1 1
2 1 510382 4813296 9 6 2008 1 30 0 342008 FG 1 1
3 2 510385 4813311 9 6 2008 2 0 0 342008 FG 1 1
4 3 510385 4813394 9 6 2008 3 30 0 342008 FG 1 1
5 4 510386 4813292 9 6 2008 2 30 0 342008 FG 1 1
6 5 510386 4813431 9 6 2008 4 1 0 342008 FG 1 1
Here's one way using mapply. This function takes two lists (or something that can be coerced into a list) and applies function FUN to corresponding elements.
# simulate some data
xy <- data.frame(animal = rep(1:10, each = 10), loc = runif(100))
# calculate number of samples for individual animal
num.samples.per.animal <- sample(3:6, length(unique(xy$animal)), replace = TRUE)
num.samples.per.animal
[1] 6 3 4 4 6 3 3 6 3 5
# subset random x number of rows from each animal
result <- do.call("rbind",
mapply(num.samples.per.animal, split(xy, f = xy$animal), FUN = function(x, y) {
y[sample(1:nrow(y), x),]
}, SIMPLIFY = FALSE)
)
result
animal loc
7 1 0.99483999
1 1 0.50951321
10 1 0.36505294
6 1 0.34058842
8 1 0.26489107
9 1 0.47418823
13 2 0.27213396
12 2 0.28087775
15 2 0.22130069
23 3 0.33646632
21 3 0.02395097
28 3 0.53079981
29 3 0.85287600
35 4 0.84534073
33 4 0.87370167
31 4 0.85646813
34 4 0.11642335
46 5 0.59624723
48 5 0.15379729
45 5 0.57046122
42 5 0.88799675
44 5 0.62171858
49 5 0.75014593
60 6 0.86915983
54 6 0.03152932
56 6 0.66128549
64 7 0.85420774
70 7 0.89262455
68 7 0.40829671
78 8 0.19073661
72 8 0.20648832
80 8 0.71778913
73 8 0.77883677
75 8 0.37647108
74 8 0.65339300
82 9 0.39957202
85 9 0.31188471
88 9 0.10900795
100 10 0.55282999
95 10 0.10145296
96 10 0.09713218
93 10 0.64900866
94 10 0.76099256
EDIT
Here is another (more straightforward) approach that also handles cases when number of rows is less than the number of samples that should be allocated.
set.seed(357)
result <- do.call("rbind",
by(xy, INDICES = xy$animal, FUN = function(x) {
avail.obs <- nrow(x)
num.rows <- sample(3:15, 1)
while (num.rows > avail.obs) {
message("Sample to be larger than available data points, repeating sampling.")
num.rows <- sample(3:15, 1)
}
x[sample(1:avail.obs, num.rows), ]
}))
result
I like Stackoverflow because I learn so much. #RomanLustrik provided a simple solution; mine is straight-froward as well:
# simulate some data
xy <- data.frame(animal = rep(1:10, each = 10), loc = runif(100))
newVec <- NULL #Create a blank dataFrame
for(i in unique(xy$animal)){
#Sample a number between 1 and 10 (or 6 and 156, if you need)
samp <- sample(1:10, 1)
#Determine which rows of dataFrame xy correspond with unique(xy$animal)[i]
rows <- which(xy$animal == unique(xy$animal)[i])
#From xy, sample samp times from the rows associated with unique(xy$animal)[i]
newVec1 <- xy[sample(rows, samp, replace = TRUE), ]
#append everything to the same new dataFrame
newVec <- rbind(newVec, newVec1)
}
Apologies for the seemingly simple question, but I can't seem to find a solution to the following re-arrangement problem.
I'm used to using read.csv to read in files with a header row, but I have an excel spreadsheet with two 'header' rows - cell identifier (a, b, c ... g) and three sets of measurements (x, y and z; 1000s each) for each cell:
a b
x y z x y z
10 1 5 22 1 6
12 2 6 21 3 5
12 2 7 11 3 7
13 1 4 33 2 8
12 2 5 44 1 9
csv file below:
a,,,b,,
x,y,z,x,y,z
10,1,5,22,1,6
12,2,6,21,3,5
12,2,7,11,3,7
13,1,4,33,2,8
12,2,5,44,1,9
How can I get to a data.frame in R as shown below?
cell x y z
a 10 1 5
a 12 2 6
a 12 2 7
a 13 1 4
a 12 2 5
b 22 1 6
b 21 3 5
b 11 3 7
b 33 2 8
b 44 1 9
Use base R reshape():
temp = read.delim(text="a,,,b,,
x,y,z,x,y,z
10,1,5,22,1,6
12,2,6,21,3,5
12,2,7,11,3,7
13,1,4,33,2,8
12,2,5,44,1,9", header=TRUE, skip=1, sep=",")
names(temp)[1:3] = paste0(names(temp[1:3]), ".0")
OUT = reshape(temp, direction="long", ids=rownames(temp), varying=1:ncol(temp))
OUT
# time x y z id
# 1.0 0 10 1 5 1
# 2.0 0 12 2 6 2
# 3.0 0 12 2 7 3
# 4.0 0 13 1 4 4
# 5.0 0 12 2 5 5
# 1.1 1 22 1 6 1
# 2.1 1 21 3 5 2
# 3.1 1 11 3 7 3
# 4.1 1 33 2 8 4
# 5.1 1 44 1 9 5
Basically, you should just skip the first row, where there are the letters a-g every third column. Since the sub-column names are all the same, R will automatically append a grouping number after all of the columns after the third column; so we need to add a grouping number to the first three columns.
You can either then create an "id" variable, or, as I've done here, just use the row names for the IDs.
You can change the "time" variable to your "cell" variable as follows:
# Change the following to the number of levels you actually have
OUT$cell = factor(OUT$time, labels=letters[1:2])
Then, drop the "time" column:
OUT$time = NULL
Update
To answer a question in the comments below, if the first label was something other than a letter, this should still pose no problem. The sequence I would take would be as follows:
temp = read.csv("path/to/file.csv", skip=1, stringsAsFactors = FALSE)
GROUPS = read.csv("path/to/file.csv", header=FALSE,
nrows=1, stringsAsFactors = FALSE)
GROUPS = GROUPS[!is.na(GROUPS)]
names(temp)[1:3] = paste0(names(temp[1:3]), ".0")
OUT = reshape(temp, direction="long", ids=rownames(temp), varying=1:ncol(temp))
OUT$cell = factor(temp$time, labels=GROUPS)
OUT$time = NULL