I have a Data.Frame with:
Height <- c(169,176,173,172,176,158,168,162,178)
and another with reference heights and weights.
heights_f <- c(144.8,147.3,149.9,152.4,154.9,157.5,160,162.6,165.1,167.6,170.2,172.7,175.3,177.8,180.3,182.9,185.4,188,190.5,193,195.6)
weights_f <- c(38.6,40.9,43.1,45.4,47.7,49.9,52.2,54.5,56.8,59,61.3,63.6,65.8,68.1,70.4,72.6,74.9,77.2,79.5,81.7,84)
weightfactor_f <- data.frame(heights_f, weights_f)
I now need to match the values of the heights from the first data.frame with the height reference in the second one that's the most fitting and to give me the correspondent reference weight.
I haven't yet had any success, as I haven't been able to find anything about matching values that are not exactly the same.
If I understand your goal, instead of taking the nearest value, consider interpolating through the approx function. For instance:
approx(weightfactor_f$heights_f,weightfactor_f$weights_f,xout=Height)$y
#[1] 60.23846 66.44400 63.85385 62.95600 66.44400 50.36000 59.35385 53.96923
#[9] 68.28400
You could do:
Height<- c(169,176,173,172,176,158,168,162,178)
heights_f<- as.numeric(c(144.8,147.3,149.9,152.4,154.9,157.5,160,162.6,165.1,167.6,170.2,172.7,175.3,177.8,180.3,182.9,185.4,188,190.5,193,195.6))
weights_f<- as.numeric(c(38.6,40.9,43.1,45.4,47.7,49.9,52.2,54.5,56.8,59,61.3,63.6,65.8,68.1,70.4,72.6,74.9,77.2,79.5,81.7,84))
df = data.frame(Height=Height, match_weight=
sapply(Height, function(x) {weights_f[which.min(abs(heights_f-x))]}))
i.e. for each entry in Height, find the corresponding element in the heights_f vector by doing which.min(abs(heights_f-x) and fetch the corresponding entry from the weights_f vector.
Output:
Height match_weight
1 169 61.3
2 176 65.8
3 173 63.6
4 172 63.6
5 176 65.8
6 158 49.9
7 168 59.0
8 162 54.5
9 178 68.1
library(dplyr)
Slightly different structure to reproducible example:
Height <- data.frame(height = as.numeric(c(169,176,173,172,176,158,168,162,178)))
The rest is the same:
heights_f<- as.numeric(c(144.8,147.3,149.9,152.4,154.9,157.5,160,162.6,165.1,167.6,170.2,172.7,175.3,177.8,180.3,182.9,185.4,188,190.5,193,195.6))
weights_f<- as.numeric(c(38.6,40.9,43.1,45.4,47.7,49.9,52.2,54.5,56.8,59,61.3,63.6,65.8,68.1,70.4,72.6,74.9,77.2,79.5,81.7,84))
weightfactor_f<- data.frame(heights_f,weights_f)
Then, round to the nearest whole number:
weightfactor_f$heights_f <- round(weightfactor_f$heights_f, 0)
Then just:
left_join(Height, weightfactor_f, by = c("height" = "heights_f"))
Output:
height weights_f
1 169 NA
2 176 NA
3 173 63.6
4 172 NA
5 176 NA
6 158 49.9
7 168 59.0
8 162 NA
9 178 68.1
z <- vector()
for(i in 1:length(Height)) {
z[i] <- weightfactor_f$weights_f[which.min(abs(Height[i]-weightfactor_f$heights_f))]
}
Related
I have this data set
obs <- data.frame(replicate(8,rnorm(10, 0, 1)))
and this coefficients
coeff <- data.frame(replicate(8,rnorm(2, 0, 1)))
For each column of obs, I need to multiply the first element of first column, and add the second element of the first column too. I need to do the same for the 8 columns. I read somewhere that if someone copy and paste code more than once you are doing something wrong... and that's exactly what I did.
obs.transformed.X1 <-(obs[1]*coeff[1,1])+coeff[2,1]
obs.transformed.X2 <-(obs[2]*coeff[1,2])+coeff[2,2]
.
.
.
.
.
obs.transformed.X8 <-(obs[8]*coeff[1,8])+coeff[2,8]
I know there is a smarter way to do this (loop?), but I just couldn't figure it out. Any help will be appreciated.
This is what I've tried but I am only getting the last column
for (i in 1:length(obs)) {
results=(obs[i]*coeff[1,i])+coeff[2,i]
}
If you coerce to matrix class you can use the sweep function in a sequential fashion first multiplying columns by the first row of coeff and then by adding hte second row, again column-wise:
obs <- data.frame(matrix(1:60, 10)) # I find checking with random numbers difficult
coeff <- data.frame(matrix(1:12,2))
sweep(
sweep(as.matrix(obs), 2, as.matrix(coeff)[1,], "*"), # first operation is "*"
2, as.matrix(coeff)[2,], "+" ) # arguments for the addition
#--------------------------------
X1 X2 X3 X4 X5 X6
[1,] 3 37 111 225 379 573
[2,] 4 40 116 232 388 584
[3,] 5 43 121 239 397 595
[4,] 6 46 126 246 406 606
[5,] 7 49 131 253 415 617
[6,] 8 52 136 260 424 628
[7,] 9 55 141 267 433 639
[8,] 10 58 146 274 442 650
[9,] 11 61 151 281 451 661
[10,] 12 64 156 288 460 672
Decreased number of columns because your original code was too wide for my Rstudio console. But this should be very general. I suspect there's an equivalent matrix operator method but It didn't come to me
I came up with this solution..
results = list()
for (i in 1:length(obs)) {
results[[i]]=(obs[i]*coeff[1,i])+coeff[2,i]
}
results <- as.data.frame(results)
Is there any efficient way to do this?
I used Map
results <- as.data.frame(Map(`+`, Map(`*`, obs, coeff[1,]), coeff[2,]))
This should also give what you are looking for.
I know this question may have been already answered elsewhere and apologies for repeating it if so but I haven't found a workable answer as yet.
I have 17 subjects each with two variables as below:
Time (s) OD
130 41.48
130.5 41.41
131 39.6
131.5 39.18
132 39.41
132.5 37.91
133 37.95
133.5 37.15
134 35.5
134.5 36.01
135 35.01
I would like R to identify the first value in column 2 (OD) of my dataframe and create a new column (OD_adjusted) by adding or subtracting (depending if the first value is +ive or -ive) from all values in column 2 so it would look like this:
Time (s) OD OD_adjusted
130 41.48 0
130.5 41.41 -0.07
131 39.6 -1.88
131.5 39.18 -2.3
132 39.41 -2.07
132.5 37.91 -3.57
133 37.95 -3.53
133.5 37.15 -4.33
134 35.5 -5.98
134.5 36.01 -5.47
135 35.01 -6.47
First value in column 2 is 41.48 therefore I want to subtract this value from all datapoints in column 2 to create a new third column (OD_adjusted).
I can use OD_adjusted <- ((df$OD) - 41.48) however, I would like to automate the process using a function and this is where I am stuck:
AUC_OD <- function(df){
return_value_1 = df %>%
arrange(OD) %>%
filter(OD [1,2) %>%
slice_(1)
colnames(return_value_1)[3] <- "OD_adjusted"
if (nrow(return_value_1) > 0 ) { subtract
(return_value_1 [1,2] #into new row
else add
(return_value_1 [1,2] #into new row
}
We get the first element of 'OD' and subtract from the column
library(dplyr)
df1 %>%
mutate(OD_adjusted = OD- OD[1])
Or using base R
df1$OD_adjusted <- with(df1, OD - OD[1])
I am looking to workout a percentage total over a look back range in R.
I know how to do this in excel with the following formula:
=SUM(B2:B4)/SUM(B2:B4,C2:C4)
This is summing column B over a range of today looking back 3 lines. It then divides this sum buy the total sum of column B + C again looking back 3 lines.
I am looking to achieve the same calculation in R to run across my matrix.
The output would look something like this:
adv dec perct
1 69 376
2 113 293
3 270 150 0.355625492
4 74 371 0.359559402
5 308 96 0.513790386
6 236 173 0.491255962
7 252 134 0.663886572
8 287 129 0.639966969
9 219 187 0.627483444
This is a line of code I could perhaps add the look back range too:
perct <- apply(data.matrix[,c('adv','dec')], 1, function(x) { (x[1] / x[1] + x[2]) } )
If i could get [1] to sum the previous 3 line range and
If i could get [2] to also sum the previous 3 line range.
Still learning how to apply forward and look back periods within R. So any additional learning on the answer would be appreciated!
Here are some approaches. The first 3 use rollsumr and/or rollapplyr in zoo and the last one uses only the base of R.
1) rollsumr Create a matrix with rollsumr whose columns contain the rollling sums, convert that to row proportions and take the "adv" column. Finally assign that to a new column frac in DF. This approach has the shortest code.
library(zoo)
DF$frac <- prop.table(rollsumr(DF, 3, fill = NA), 1)[, "adv"]
giving:
> DF
adv dec frac
1 69 376 NA
2 113 293 NA
3 270 150 0.3556255
4 74 371 0.3595594
5 308 96 0.5137904
6 236 173 0.4912560
7 252 134 0.6638866
8 287 129 0.6399670
9 219 187 0.6274834
1a) This variation is similar except instead of using prop.table we write out the ratio. The code is longer but you may find it clearer.
m <- rollsumr(DF, 3, fill = NA)
DF$frac <- with(as.data.frame(m), adv / (adv + dec))
1b) This is a variation of (1) that is the same except it uses a magrittr pipeline:
library(magrittr)
DF %>% rollsumr(3, fill = NA) %>% prop.table(1) %>% `[`(TRUE, "adv") -> DF$frac
2) rollapplyr We could use rollapplyr with by.column = FALSE like this. The result is the same.
ratio <- function(x) sum(x[, "adv"]) / sum(x)
DF$frac <- rollapplyr(DF, 3, ratio, by.column = FALSE, fill = NA)
3) Yet another variation is to compute the numerator and denominator separately:
DF$frac <- rollsumr(DF$adv, 3, fill = NA) /
rollapplyr(DF, 3, sum, by.column = FALSE, fill = NA)
4) base This uses embed followed by rowSums on each column to get the rolling sums and then uses prop.table as in (1).
DF$frac <- prop.table(sapply(lapply(rbind(NA, NA, DF), embed, 3), rowSums), 1)[, "adv"]
Note: The input used in reproducible form is:
Lines <- "adv dec
1 69 376
2 113 293
3 270 150
4 74 371
5 308 96
6 236 173
7 252 134
8 287 129
9 219 187"
DF <- read.table(text = Lines, header = TRUE)
Consider an sapply that loops through the number of rows in order to index two rows back:
DF$pred <- sapply(seq(nrow(DF)), function(i)
ifelse(i>=3, sum(DF$adv[(i-2):i])/(sum(DF$adv[(i-2):i]) + sum(DF$dec[(i-2):i])), NA))
DF
# adv dec pred
# 1 69 376 NA
# 2 113 293 NA
# 3 270 150 0.3556255
# 4 74 371 0.3595594
# 5 308 96 0.5137904
# 6 236 173 0.4912560
# 7 252 134 0.6638866
# 8 287 129 0.6399670
# 9 219 187 0.6274834
I am trying to get my head around for loops in R and I have what seems to me a very basic example which isn't working.
I have data in a table:
Author ev.ctrl n.ctrl ev.trt n.trt year
1 Cammu 8 56 7 54 1994
2 Eckert 49 137 46 137 2001
3 Kuusela 1 15 1 18 1998
4 Ohlisson 205 625 183 612 2001
5 Rush 259 392 235 393 1996
6 Woodward 7 20 6 40 2004
I want to calculate the sum of the column n.trt I know I could do sum(epidural$n.trt) but want to try and use a for loop.
I have:
for (i in 1:6){
sum(epidural$n.trt[i])
}
This is not giving me anything, not a number nor an error. Any idea what the problem is?
Thanks
Do this instead... we don't need no steenking loops:
> treats <- sum(epidural['n.trt']); treats
[1] 1254
You need to declare sum variable outside of for loop and add values to it. There is no need to call sum function since you have only one value not vector.
s <- 0
for (i in 1:6){
s <- s + epidural$n.trt[i]
}
s
I have a data which has two parameters, they are data/time and flow. The flow data is intermittent flow. Lets say at times there is zero flow and suddenly the flow starts and there will be non-zero values for sometime and then the flow will be zero again. I want to understand when the non-zero values occur and how long does each non-zero flow last. I have attached the sample dataset at this location https://www.dropbox.com/s/ef1411dq4gyg0cm/sampledataflow.csv
The data is 1 minute data.
I was able to import the data into R as follows:
flow <- read.csv("sampledataflow.csv")
summary(flow)
names(flow) <- c("Date","discharge")
flow$Date <- strptime(flow$Date, format="%m/%d/%Y %H:%M")
sapply(flow,class)
plot(flow$Date, flow$discharge,type="l")
I made plot to see the distribution but couldn't get a clue where to start to get the frequency of each non zero values. I would like to see a output table as follows:
Date Duration in Minutes
Please let me know if I am not clear here. Thanks.
Additional Info:
I think we need to check the non-zero value first and then find how many non zero values are there continuously before it reaches zero value again. What I want to understand is the flow release durations. For eg. in one day there might be multiple releases and I want to note at what time did the release start and how long did it continue before coming to value zero. I hope this explain the problem little better.
The first point is that you have too many NA in your data. In case you want to look into it.
If I understand correctly, you require the count of continuous 0's followed by continuous non-zeros, zeros, non-zeros etc.. for each date.
This can be achieved with rle of course, as also mentioned by #mnel under comments. But there are quite a few catches.
First, I'll set up the data with non-NA entries:
flow <- read.csv("~/Downloads/sampledataflow.csv")
names(flow) <- c("Date","discharge")
flow <- flow[1:33119, ] # remove NA entries
# format Date to POSIXct to play nice with data.table
flow$Date <- as.POSIXct(flow$Date, format="%m/%d/%Y %H:%M")
Next, I'll create a Date column:
flow$g1 <- as.Date(flow$Date)
Finally, I prefer using data.table. So here's a solution using it.
# load package, get data as data.table and set key
require(data.table)
flow.dt <- data.table(flow)
# set key to both "Date" and "g1" (even though, just we'll use just g1)
# to make sure that the order of rows are not changed (during sort)
setkey(flow.dt, "Date", "g1")
# group by g1 and set data to TRUE/FALSE by equating to 0 and get rle lengths
out <- flow.dt[, list(duration = rle(discharge == 0)$lengths,
val = rle(discharge == 0)$values + 1), by=g1][val == 2, val := 0]
> out # just to show a few first and last entries
# g1 duration val
# 1: 2010-05-31 120 0
# 2: 2010-06-01 722 0
# 3: 2010-06-01 138 1
# 4: 2010-06-01 32 0
# 5: 2010-06-01 79 1
# ---
# 98: 2010-06-22 291 1
# 99: 2010-06-22 423 0
# 100: 2010-06-23 664 0
# 101: 2010-06-23 278 1
# 102: 2010-06-23 379 0
So, for example, for 2010-06-01, there are 722 0's followed by 138 non-zeros, followed by 32 0's followed by 79 non-zeros and so on...
I looked a a small sample of the first two days
> do.call( cbind, tapply(flow$discharge, as.Date(flow$Date), function(x) table(x > 0) ) )
2010-06-01 2010-06-02
FALSE 1223 911
TRUE 217 529 # these are the cumulative daily durations of positive flow.
You may want this transposed in which case the t() function should succeed. Or you could use rbind.
If you jsut wante the number of flow-postive minutes, this would also work:
tapply(flow$discharge, as.Date(flow$Date), function(x) sum(x > 0, na.rm=TRUE) )
#--------
2010-06-01 2010-06-02 2010-06-03 2010-06-04 2010-06-05 2010-06-06 2010-06-07 2010-06-08
217 529 417 463 0 0 263 220
2010-06-09 2010-06-10 2010-06-11 2010-06-12 2010-06-13 2010-06-14 2010-06-15 2010-06-16
244 219 287 234 31 245 311 324
2010-06-17 2010-06-18 2010-06-19 2010-06-20 2010-06-21 2010-06-22 2010-06-23 2010-06-24
299 305 124 129 295 296 278 0
To get the lengths of intervals with discharge values greater than zero:
tapply(flow$discharge, as.Date(flow$Date), function(x) rle(x>0)$lengths[rle(x>0)$values] )
#--------
$`2010-06-01`
[1] 138 79
$`2010-06-02`
[1] 95 195 239
$`2010-06-03`
[1] 57 360
$`2010-06-04`
[1] 6 457
$`2010-06-05`
integer(0)
$`2010-06-06`
integer(0)
... Snipped output
If you want to look at the distribution of these durations you will need to unlist that result. (And remember that the durations which were split at midnight may have influenced the counts and durations.) If you just wanted durations without dates, then use this:
flowrle <- rle(flow$discharge>0)
flowrle$lengths[!is.na(flowrle$values) & flowrle$values]
#----------
[1] 138 79 95 195 296 360 6 457 263 17 203 79 80 85 30 189 17 270 127 107 31 1
[23] 2 1 241 311 229 13 82 299 305 3 121 129 295 3 2 291 278