Print 1 below specific value until meets a higher value - r

I have data where I wish to print 1s when below a certain value until we meet a higher value.
Take this data for example:
data long_entry long_exit
1 80.000000 0 1
2 7.692308 1 0
3 7.692308 1 0
4 8.333333 1 0
5 9.090909 1 0
6 20.000000 1 0
7 27.272727 0 0
8 50.000000 0 0
9 50.000000 0 0
10 21.428571 1 0
11 58.333333 0 0
12 46.666667 0 0
13 78.064516 0 1
14 86.153846 0 1
15 42.857143 0 0
16 44.186047 0 0
17 20.000000 1 0
18 25.000000 0 0
19 40.000000 0 0
20 45.000000 0 0
21 78.000000 0 1
22 55.000000 0 0
My goal is to print 1,s when data column is below 25 and continue to print 1 until we meet a data number over 70 (first instance).
Code used to make long / exit signals:
df$long_entry = ifelse(df$data < 25,1,0 )
df$long_exit = ifelse(df$data >= 70,1,0)
I have tried writing a few for loops using base and dplyr:
df$final.signal[[1]] = ifelse(df$long_entry[[1]] == 1, 1, 0)
for (i in 2:nrow(df)){
df$final.signal[i] = ifelse(df$long_entry[i] ==1, 1, 0,
ifelse(df$long_exit[i] == 1, 0,
df$long_exit[i-1]))
}
df <- df %>%
dplyr::mutate(final.signal = ifelse(long_entry == 1, 1,
ifelse(long_exit ==1, 0, 0)))
This however does not do as intended. The desired output is to be like this:
data desired.output
1 80.000000 0
2 7.692308 1
3 7.692308 1
4 8.333333 1
5 9.090909 1
6 20.000000 1
7 27.272727 1
8 50.000000 1
9 50.000000 1
10 21.428571 1
11 58.333333 1
12 46.666667 1
13 78.064516 1 (1 on first instance over 70)
14 86.153846 0
15 42.857143 0
16 44.186047 0
17 20.000000 1 (back to 1 when under 25)
18 25.000000 1
19 40.000000 1
20 45.000000 1
21 78.000000 1 ( stay 1 until first instance over 70)
22 85.000000 0
We see we print 1 < 25 until we meet the first instance of >70.
Which is the best method to approach this task?

May this could help you :
dataa <- data.frame(abs(rnorm(mean = 30, sd = 40, n= 100)))
names(dataa) <- c("v1")
dataa %>% mutate(v2 = as.numeric( (cumsum(as.numeric(dataa$v1>70)) <= 0) & (cumsum(as.numeric(dataa$v1<25)) >= 1)))

Related

change value of row and subsequent rows depending on row number

I have a dataframe where some rows have values as 0. I want to make a code that makes the next few rows as 0 too.
> head(df$n,n=20)
df$n
1 0
2 9009
3 0
4 0
5 0
6 0
7 0
8 5410
9 0
10 0
11 0
12 0
13 0
14 0
15 32
16 0
17 0
18 1054
19 0
20 0
I want to create a code that converts the next five rows with value 0 as 0.
basically row with 0 is 0 and the next five rows is also 0.
I tried
for(j in 1:nrow(indx)){
for(i in 1:4){
df$n[j+i]<-0
}
}
where indx is dataframe containing all the row number with 0 values.
This works but incorrectly.
How to I get my desired output?
> head(df$n,n=20)
df$n
1 0
2 0
3 0
4 0
5 0
6 0
7 0
8 5410
9 0
10 0
11 0
12 0
13 0
14 0
15 32
16 0
17 0
18 0
19 0
20 0
Edit: sorry for the unclear language. My aim is to convert 5 values after 0 to 0. since it is incorrect data.
Edit2: I think this code worked for me. its a little bit primitive.
for( i in 1:nrow(indx)){
u<-indx[i,]
df[u,]<-0
df[u+1,]<-0
df[u+2,]<-0
df[u+3,]<-0
df[u+4,]<-0
df[u+5,]<-0
}
however it introduces extra rows at end but it works.
If I understand correctly, you want to make sure any run of zeros is at least five rows long, unless it's at the end of the data. Here's a dplyr-based solution:
library(dplyr)
df %>%
group_by(zero_run = cumsum(n == 0 & lag(n, default = 1) != 0)) %>%
mutate(
zeros_consecutive = row_number(),
n_new = ifelse(zero_run == 0 | zeros_consecutive > 5, n, 0)
) %>%
ungroup()
# # A tibble: 20 × 4
# n zero_run zeros_consecutive n_new
# <dbl> <int> <int> <dbl>
# 1 0 1 1 0
# 2 9009 1 2 0
# 3 0 2 1 0
# 4 0 2 2 0
# 5 0 2 3 0
# 6 0 2 4 0
# 7 0 2 5 0
# 8 5410 2 6 5410
# 9 0 3 1 0
# 10 0 3 2 0
# 11 0 3 3 0
# 12 0 3 4 0
# 13 0 3 5 0
# 14 0 3 6 0
# 15 32 3 7 32
# 16 0 4 1 0
# 17 0 4 2 0
# 18 1054 4 3 0
# 19 0 5 1 0
# 20 0 5 2 0
I left in the helper columns to better demonstrate the approach, but you could remove these by using n = ifelse(...) instead of n_new = ifelse(...) and adding select(!zeros_run:zeros_consecutive).

R: table frequencies of letters in string based on Alphabet

I need to compute letter frequencies of a large list of words. For each of the locations in the word (first, second,..), I need to find how many times each letter (a-z) appeared in the list and then table the data according to the word positon.
For example, if my word list is: words <- c("swims", "seems", "gills", "draws", "which", "water")
then the result table should like that:
letter
first position
second position
third position
fourth position
fifth position
a
0
1
1
0
0
b
0
0
0
0
0
c
0
0
0
1
0
d
1
0
0
0
0
e
0
1
1
1
0
f
0
0
0
0
0
...continued until z
...
...
...
...
...
All words are of same length (5).
What I have so far is:
alphabet <- letters[1:26]
words.df <- data.frame("Words" = words)
words.df <- words.df %>% mutate("First_place" = substr(words.df$words,1,1))
words.df <- words.df %>% mutate("Second_place" = substr(words.df$words,2,2))
words.df <- words.df %>% mutate("Third_place" = substr(words.df$words,3,3))
words.df <- words.df %>% mutate("Fourth_place" = substr(words.df$words,4,4))
words.df <- words.df %>% mutate("Fifth_place" = substr(words.df$words,5,5))
x1 <- words.df$First_place
x1 <- table(factor(x1,alphabet))
x2 <- words.df$Second_place
x2 <- table(factor(x2,alphabet))
x3 <- words.df$Third_place
x3 <- table(factor(x3,alphabet))
x4 <- words.df$Fourth_place
x4 <- table(factor(x4,alphabet))
x5 <- words.df$Fifth_place
x5 <- table(factor(x5,alphabet))
My code is not effective and gives tables to each letter position sepretely. All help will be appreicated.
in base R use table:
table(let = unlist(strsplit(words,'')),pos = sequence(nchar(words)))
pos
let 1 2 3 4 5
a 0 1 1 0 0
c 0 0 0 1 0
d 1 0 0 0 0
e 0 1 1 1 0
g 1 0 0 0 0
h 0 1 0 0 1
i 0 1 2 0 0
l 0 0 1 1 0
m 0 0 0 2 0
r 0 1 0 0 1
s 2 0 0 0 4
t 0 0 1 0 0
w 2 1 0 1 0
Note that if you need all the values from a-z then use
table(factor(unlist(strsplit(words,'')), letters), sequence(nchar(words)))
Also to get a dataframe you could do:
d <- table(factor(unlist(strsplit(words,'')), letters), sequence(nchar(words)))
cbind(letters = rownames(d), as.data.frame.matrix(d))
Here is a tidyverse solution using dplyr, purrr, and tidyr:
strsplit(words.df$Words, "") %>%
map_dfr(~setNames(.x, seq_along(.x))) %>%
pivot_longer(everything(),
values_drop_na = T,
names_to = "pos",
values_to = "letter") %>%
count(pos, letter) %>%
pivot_wider(names_from = pos,
names_glue = "pos{pos}",
id_cols = letter,
values_from = n,
values_fill = 0L)
Output
letter pos1 pos2 pos3 pos4 pos5 pos6 pos7 pos8 pos9 pos10 pos11
1 a 65 127 88 38 28 17 14 5 3 0 0
2 b 58 4 7 9 2 4 2 0 1 0 0
3 c 83 14 45 37 20 19 8 3 2 0 0
4 C 2 0 0 0 0 0 0 0 0 0 0
5 d 43 8 33 47 21 22 9 3 1 1 0
6 e 45 156 81 132 114 69 48 23 14 2 2
7 f 54 11 18 10 5 2 1 0 0 0 0
8 g 23 7 27 21 15 8 7 1 0 0 0
9 h 38 56 6 28 21 10 3 3 1 1 0
10 i 25 106 51 58 38 28 8 4 1 0 0
11 j 6 0 2 2 0 0 0 0 0 0 0
12 k 9 1 6 22 12 0 0 0 0 0 0
13 l 45 41 54 54 36 9 7 6 0 2 0
14 m 45 8 31 19 8 8 4 2 0 0 0
15 n 23 42 75 53 34 41 16 16 4 2 0
16 o 28 167 76 41 38 9 11 2 1 0 0
17 p 72 20 34 30 8 3 1 1 1 0 0
18 q 7 2 1 0 0 0 0 0 0 0 0
19 r 46 74 92 59 56 45 12 9 1 1 0
20 s 119 8 67 35 31 22 18 4 1 0 0
21 t 65 30 73 83 57 42 31 9 6 3 1
22 u 12 66 39 36 20 7 7 2 0 0 0
23 v 8 7 20 12 5 5 1 0 0 0 0
24 w 53 8 13 10 2 3 0 1 0 0 0
25 y 6 4 16 15 17 15 10 5 6 1 1
26 x 0 12 5 0 0 0 0 0 0 0 0
27 z 0 0 1 0 0 0 1 1 0 0 0

Create event (dummy) one year before/ after of a dummy variable (or close to)

I am doing an event study in an unbalanced panal data set. The basic structure is that I have a different number of observations (deliveries) for each firm at different points over a period of around 15 years. I am interested in an event (price increase) which is coded as a dummy variable if it occurs and some dummy lead and lags to check if the effect of the price increase on my dependent variable becomes apparent around that event. As an example, for some firms the price increase occurs at 5 deliveries of e.g. 50 over 15 years.
However, now I also want to "simulate" the same event study one year after and before to improve inference. So I want R to duplicate the event dummy for each firm at the delivery closest to one year before and after. The delivery dates occur not daily but on average every 25 days.
So, as code, the data looks something like this:
df <- data.frame(firm_id = c(1,1,1,1,1,2,2,2,3,3,3,3,3,3,3,3,3,3,4,4,4,4),
delivery_id = c(1,2,6,9,15,3,5,18,4,7,8,10,11,13,17,19,22,12,14,16,20,21),
date=c("2004-06-16", "2004-08-12", "2004-11-22", "2005-07-03", "2007-01-04",
"2004-09-07", "2005-02-01", "2006-01-17",
"2004-10-11", "2005-02-01", "2005-04-27", "2005-06-01", "2005-07-01",
"2006-01-03", "2007-01-06", "2007-03-24", "2007-05-03",
"2005-08-03", "2006-02-19", "2006-06-13", "2007-02-04", "2007-04-26"),
price_increase = c(0,0,0,1,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0),
price_increase_year_before = c(1,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0),
price_increase_year_afer = c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0))
Creating
firm_id delivery_id date price_increase price_increase_year_before price_increase_year_after
1 1 1 2004-06-16 0 1 0
2 1 2 2004-08-12 0 0 0
3 1 6 2004-11-22 0 0 0
4 1 9 2005-07-03 1 0 0
5 1 15 2007-01-04 0 0 0
6 2 3 2004-09-07 0 0 0
7 2 5 2005-02-01 0 0 0
8 2 18 2006-01-17 0 0 0
9 3 4 2004-10-11 0 0 0
10 3 7 2005-02-01 0 1 0
11 3 8 2005-04-27 0 0 0
12 3 10 2005-06-01 0 0 0
13 3 11 2005-07-01 0 0 0
14 3 13 2006-01-03 1 0 0
15 3 17 2007-01-06 0 0 1
16 3 19 2007-03-24 0 0 0
17 3 22 2007-05-03 0 0 0
18 3 12 2005-08-03 0 0 0
19 4 14 2006-02-19 0 0 0
20 4 16 2006-06-13 0 0 0
21 4 20 2007-02-04 0 0 0
22 4 21 2007-04-26 0 0 0
Where I want to create the two dummy columns on the right based on the price_increase and the date, for each firm. Although I would start with dyplr's group_by and mutate approach and an if_else function, I have no idea how to create a condition that becomes TRUE when a delivery in one year is +1/-1 month close to the date in the prior or following year and how to select the respective delivery. Do you guys have an idea?
Here is a possible approach using dplyr.
After group_by(firm_id), filter and include groups where there was a price increase.
Then, create your two dummy variables if the date is one year (+/- 30 days) before or after the date where the price_increase was equal to 1. Then, would filter for rows that met these criteria.
Using distinct you can prevent multiples or duplicates for your dummy variable within a group/firm. Otherwise, if your deliveries were 25 days apart, it seemed like a theoretical possibility.
The rest afterwards is joining back to the original data, replacing the NA with zero for dummy columns, and sorting.
library(dplyr)
df$date <- as.Date(df$date)
df %>%
group_by(firm_id) %>%
filter(any(price_increase == 1)) %>%
mutate(
price_increase_year_before = ifelse(
between(date[price_increase == 1] - date, 335, 395), 1, 0),
price_increase_year_after = ifelse(
between(date - date[price_increase == 1], 335, 395), 1, 0),
) %>%
filter(price_increase_year_before == 1 | price_increase_year_after == 1) %>%
distinct(firm_id, price_increase_year_before, price_increase_year_after, .keep_all = TRUE) %>%
right_join(df) %>%
replace_na(list(price_increase_year_before = 0, price_increase_year_after = 0)) %>%
arrange(firm_id, date)
Output
firm_id delivery_id date price_increase price_increase_year_before price_increase_year_after
<dbl> <dbl> <date> <dbl> <dbl> <dbl>
1 1 1 2004-06-16 0 1 0
2 1 2 2004-08-12 0 0 0
3 1 6 2004-11-22 0 0 0
4 1 9 2005-07-03 1 0 0
5 1 15 2007-01-04 0 0 0
6 2 3 2004-09-07 0 0 0
7 2 5 2005-02-01 0 0 0
8 2 18 2006-01-17 0 0 0
9 3 4 2004-10-11 0 0 0
10 3 7 2005-02-01 0 1 0
11 3 8 2005-04-27 0 0 0
12 3 10 2005-06-01 0 0 0
13 3 11 2005-07-01 0 0 0
14 3 12 2005-08-03 0 0 0
15 3 13 2006-01-03 1 0 0
16 3 17 2007-01-06 0 0 1
17 3 19 2007-03-24 0 0 0
18 3 22 2007-05-03 0 0 0
19 4 14 2006-02-19 0 0 0
20 4 16 2006-06-13 0 0 0
21 4 20 2007-02-04 0 0 0
22 4 21 2007-04-26 0 0 0

Get Max Value per Run or Series in Sequence

I am trying to get a a max value per stretch of an indicator, or repeating value.
Here is an example:
A = c(28, 20, 23, 30, 26, 23, 25, 26, 27, 25, 30, 26, 25, 22, 24, 25, 24, 27, 29)
B = c(0, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 0, 0, 1)
df <- as.data.frame(cbind(A, B))
df
A B
28 0
20 1
23 1
30 0
26 0
23 1
25 1
26 1
27 0
25 0
30 1
26 1
25 1
22 0
24 1
25 0
24 0
27 0
29 1
For each group or stretch of 1's in column B I want to find the max in column A. The max column could be an indicator that A it is a max or the actual value in A, and be NA or 0 for other values of B.
The output I am hoping for looks something like this:
A B max
28 0 0
20 1 0
23 1 1
30 0 0
26 0 0
23 1 0
25 1 0
26 1 1
27 0 0
25 0 0
30 1 1
26 1 0
25 1 0
22 0 0
24 1 1
25 0 0
24 0 0
27 0 0
29 1 1
I've tried to generate groups per section of column B that = 1 but I did not get very far because most grouping functions require unique values between groups.
Also, please let me know if there are any improvements to the title for this problem.
One option would be data.table
library(data.table)
setDT(df)[, Max := +((A== max(A)) & B), rleid(B) ]
df
# A B Max
# 1: 28 0 0
# 2: 20 1 0
# 3: 23 1 1
# 4: 30 0 0
# 5: 26 0 0
# 6: 23 1 0
# 7: 25 1 0
# 8: 26 1 1
# 9: 27 0 0
#10: 25 0 0
#11: 30 1 1
#12: 26 1 0
#13: 25 1 0
#14: 22 0 0
#15: 24 1 1
#16: 25 0 0
#17: 24 0 0
#18: 27 0 0
#19: 29 1 1
Or as #Frank mentioned, for better efficiency, we can make use gmax by first assigning column and then replace
DT[, MA := max(A), by=rleid(B)][A == MA & B, Max := 1L][]
Solution using dplyr
library(dplyr)
df %>%
group_by(with(rle(B), rep(seq_along(lengths), lengths))) %>%
mutate(MAX = ifelse(B == 0, 0, as.numeric(A == max(A)))) %>%
.[, c(1, 2, 4)]
A B MAX
<dbl> <dbl> <dbl>
1 28 0 0
2 20 1 0
3 23 1 1
4 30 0 0
5 26 0 0
6 23 1 0
7 25 1 0
8 26 1 1
9 27 0 0
10 25 0 0
11 30 1 1
12 26 1 0
13 25 1 0
14 22 0 0
15 24 1 1
16 25 0 0
17 24 0 0
18 27 0 0
19 29 1 1

assigning new values based on the location in the sequence

Working in R.
The data tracks changes in brain activity over time. Column "mark" contains information when a particular treatment begins and ends. For examples, the first condition (mark==1) begins in row 3 and ends in row 6. The second experimental condition (mark==2) starts in row 9 and ends in 12. Another batch of treatment one is repeated between rows 15 and 18.
ob.id <- c(1:20)
mark <- c(0,0,1,0,0,1,0,0,2,0,0,2,0,0,1,0,0,1,0,0)
condition<-c(0,0,1,1,1,1,0,0,2,2,2,2,0,0,1, 1,1,1,0,0)
start <- data.frame(ob.id,mark)
result<-data.frame(ob.id,mark,condition)
print (start)
> print (start)
ob.id mark
1 1 0
2 2 0
3 3 1
4 4 0
5 5 0
6 6 1
7 7 0
8 8 0
9 9 2
10 10 0
11 11 0
12 12 2
13 13 0
14 14 0
15 15 1
16 16 0
17 17 0
18 18 1
19 19 0
20 20 0
I need to create a column that would have a dummy variable indicating the membership of an observation in corresponding experimental condition, like this:
> print(result)
ob.id mark condition
1 1 0 0
2 2 0 0
3 3 1 1
4 4 0 1
5 5 0 1
6 6 1 1
7 7 0 0
8 8 0 0
9 9 2 2
10 10 0 2
11 11 0 2
12 12 2 2
13 13 0 0
14 14 0 0
15 15 1 1
16 16 0 1
17 17 0 1
18 18 1 1
19 19 0 0
20 20 0 0
Thanks for your help!
This is a fun little problem. The trick I use below is to first calculate the rle of the mark vector, which makes the problem simpler, as the resulting values vector will always have just one 0 that may or may not need to be replaced (depending on the surrounding values).
# example vector with some edge cases
v = c(0,0,1,0,0,0,1,2,0,0,2,0,0,1,0,0,0,0,1,2,0,2)
v.rle = rle(v)
v.rle
#Run Length Encoding
# lengths: int [1:14] 2 1 3 1 1 2 1 2 1 4 ...
# values : num [1:14] 0 1 0 1 2 0 2 0 1 0 ...
vals = rle(v)$values
# find the 0's that need to be replaced and replace by the previous value
idx = which(tail(head(vals,-1),-1) == 0 & (head(vals,-2) == tail(vals,-2)))
vals[idx + 1] <- vals[idx]
# finally go back to the original vector
v.rle$values = vals
inverse.rle(v.rle)
# [1] 0 0 1 1 1 1 1 2 2 2 2 0 0 1 1 1 1 1 1 2 2 2
Probably the least cumbersome thing to do is to put the above in a function and then apply that to your data.frame vector (as opposed to manipulating the vector explicitly).
Another approach, based on #SimonO101's observation, involves constructing the right groups from the starting data (run the by part separately, piece by piece, to see how it works):
library(data.table)
dt = data.table(start)
dt[, result := mark[1],
by = {tmp = rep(0, length(mark));
tmp[which(mark != 0)[c(F,T)]] = 1;
cumsum(mark != 0) - tmp}]
dt
# ob.id mark result
# 1: 1 0 0
# 2: 2 0 0
# 3: 3 1 1
# 4: 4 0 1
# 5: 5 0 1
# 6: 6 1 1
# 7: 7 0 0
# 8: 8 0 0
# 9: 9 2 2
#10: 10 0 2
#11: 11 0 2
#12: 12 2 2
#13: 13 0 0
#14: 14 0 0
#15: 15 1 1
#16: 16 0 1
#17: 17 0 1
#18: 18 1 1
#19: 19 0 0
#20: 20 0 0
The latter approach will probably be more flexible.
Here is one way I could think of doing it:
# Find where experiments stop and start
ind <- which( result$mark != 0 )
[1] 3 6 9 12 15 18
# Make a matrix of the start and stop indices taking odd and even elements of the vector
idx <- cbind( head(ind , -1)[ 1:length(ind) %% 2 == 1 ] ,tail( ind , -1)[ 1:length(ind) %% 2 == 1 ] )
[,1] [,2]
[1,] 3 6
[2,] 9 12
[3,] 15 18
edit
I realised making the above index matrix would be easier with just taking odd and even elements:
idx <- cbind( ind[ 1:length(ind) %% 2 == 1 ] , ind[ 1:length(ind) %% 2 != 1 ] )
# Make vector of row indices to turn to 1's
ones <- as.vector( apply( idx , 1 , function(x) c( x[1]:x[2] ) ) )
# Make your new column and turn appropriate rows to 1
result$condition <- 0
result$condition[ ones ] <- 1
result
# ob.id mark condition
#1 1 0 0
#2 2 0 0
#3 3 1 1
#4 4 1 1
#5 5 1 1
#6 6 1 1
#7 7 0 0
#8 8 0 0
#9 9 1 1
#10 10 1 1
#11 11 1 1
#12 12 1 1
#13 13 0 0
#14 14 0 0
#15 15 1 1
#16 16 1 1
#17 17 1 1
#18 18 1 1
#19 19 0 0
#20 20 0 0
Edit
#eddi pointed out I needed to put the value of the experiment in, not just one. So this is another strategy which uses gasp(!) a for loop. This will only be really detrimental if you have millions thousands of experiments (remember to pre-allocate your results vector):
ind <- matrix( which( start$mark != 0 ) , ncol = 2 , byrow = TRUE )
ind <- cbind( ind , start$mark[ ind[ , 1 ] ] )
# [,1] [,2] [,3]
#[1,] 3 6 1
#[2,] 9 12 2
#[3,] 15 18 1
res <- integer( nrow( start ) )
for( i in 1:nrow(ind) ){
res[ ind[i,1]:ind[i,2] ] <- ind[i,3]
}
[1] 0 0 1 1 1 1 0 0 2 2 2 2 0 0 1 1 1 1 0 0

Resources