I have the following problem: I want to be able to add the income(random 1-100) into intervals, and group them by sex( showing how many cases in each interval for each sex ), plus I wanna know the proporcion and percentage:
ingresos <- sample (0:100, 30, replace = T)
sexo <- sample (1:2, 30, replace = T)
base<-tibble(Ingresos=ingresos<-case_when(
ingresos>=0 & ingresos<20 ~ "(0, 19]",
ingresos>=20 & ingresos<50 ~ "(20, 49]",
ingresos>=50 & ingresos<70 ~ "(50, 69]",
ingresos>=70 ~ "(70 ó +)"
) , Sexo=sexo, Proporción=ingresos/sum(ingresos), Porcentaje=Proporción*100)
I ended up with:
> show(base)
# A tibble: 30 x 4
Ingresos Sexo Proporción Porcentaje
<chr> <int> <dbl> <dbl>
1 (0, 19] 2 0.00583 0.583
2 (50, 69] 1 0.0343 3.43
3 (20, 49] 2 0.0233 2.33
4 (20, 49] 1 0.0188 1.88
5 (20, 49] 2 0.0311 3.11
6 (50, 69] 2 0.0369 3.69
7 (20, 49] 1 0.0278 2.78
8 (20, 49] 1 0.0142 1.42
9 (70 ó +) 1 0.0628 6.28
10 (20, 49] 1 0.0130 1.30
# … with 20 more rows
And I'm Looking for somwthing like:
Ingresos Sexo Cases Proporción Porcentaje
(0,19] 1 12 .xxx x.xxx
(0,19] 2 20 .xxx x.xxx
(20,49] 1 17 .xxx x.xxx
(20,49] 2 30 .xxx x.xxx
Cutting up the ingresos vector into ranges can be done with cut(). And the frequencies can be derived with dplyr::count(). Proportions and percentage can be added with dplyr::mutate(). Like this:
ingresos <- sample(0:100, 30, replace = T)
sexo <- sample(1:2, 30, replace = T)
library(dplyr)
tibble(ingresos, sexo) %>%
mutate(ingresos = cut(ingresos, c(0, 20, 50, 70, 100))) %>%
count(ingresos, sexo) %>%
mutate(Proporción=n/sum(n), Porcentaje=Proporción*100)
#> # A tibble: 8 x 5
#> ingresos sexo n Proporción Porcentaje
#> <fct> <int> <int> <dbl> <dbl>
#> 1 (0,20] 1 3 0.1 10
#> 2 (0,20] 2 4 0.133 13.3
#> 3 (20,50] 1 2 0.0667 6.67
#> 4 (20,50] 2 5 0.167 16.7
#> 5 (50,70] 1 3 0.1 10
#> 6 (50,70] 2 1 0.0333 3.33
#> 7 (70,100] 1 4 0.133 13.3
#> 8 (70,100] 2 8 0.267 26.7
Related
I would like to calculate a rolling average for a fixed interval in my dataset.
start end value value_per_unit
4 20 20 1.25
21 33 40 3.33
34 45 30 2.73
46 60 10 0.71
I would like to obtain the value for a fixed interval of 10 as follows:
start end value_per_unit
4 13 1.25
14 23 1.874
24 33 3.33
.
.
Where:
for the interval c(4, 14): (1.25*10)/10 = 1.25
for the interval c(15, 25): (1.25*7 + 3.33*3)/10 = 1.874
for the interval c(26,36): (10*3.33)/10 = 3.33
Is it possible to achieve this in R?
There seems to be some confusion in your question, however this approach gives the desired output:
library(dplyr, warn.conflicts = FALSE)
# Create the test data
df <- tribble(
~start, ~end, ~value, ~value_per_unit,
4 , 20, 20, 1.25,
21 , 33, 40, 3.33,
34 , 45, 30, 2.73,
46 , 60, 10, 0.71
)
# Some data prep to apply the transformation
df1 <- df %>%
rowwise() %>%
mutate(row = list(seq(from = start, to = end))) %>%
ungroup() %>%
tidyr::unnest(row) %>%
mutate(group = (row - 4) %/% 10)
# This hopefully illustrates what's happening here:
print(df1, n = 20)
#> # A tibble: 57 x 6
#> start end value value_per_unit row group
#> <dbl> <dbl> <dbl> <dbl> <int> <dbl>
#> 1 4 20 20 1.25 4 0
#> 2 4 20 20 1.25 5 0
#> 3 4 20 20 1.25 6 0
#> 4 4 20 20 1.25 7 0
#> 5 4 20 20 1.25 8 0
#> 6 4 20 20 1.25 9 0
#> 7 4 20 20 1.25 10 0
#> 8 4 20 20 1.25 11 0
#> 9 4 20 20 1.25 12 0
#> 10 4 20 20 1.25 13 0
#> 11 4 20 20 1.25 14 1
#> 12 4 20 20 1.25 15 1
#> 13 4 20 20 1.25 16 1
#> 14 4 20 20 1.25 17 1
#> 15 4 20 20 1.25 18 1
#> 16 4 20 20 1.25 19 1
#> 17 4 20 20 1.25 20 1
#> 18 21 33 40 3.33 21 1
#> 19 21 33 40 3.33 22 1
#> 20 21 33 40 3.33 23 1
#> # ... with 37 more rows
# Summarise to create new values of start, end and value_per_unit
df1 %>%
group_by(group) %>%
summarise(
start = min(row),
end = max(row),
value_per_unit = mean(value_per_unit),
.groups = "drop"
) %>%
select(-group)
#> # A tibble: 6 x 3
#> start end value_per_unit
#> <int> <int> <dbl>
#> 1 4 13 1.25
#> 2 14 23 1.87
#> 3 24 33 3.33
#> 4 34 43 2.73
#> 5 44 53 1.11
#> 6 54 60 0.71
Created on 2021-10-12 by the reprex package (v2.0.0)
Here is another solution:
library(tidyverse)
seq(4, 60, 10) %>%
enframe(value = "start") %>%
mutate(end = pmin(start + 9, max(df$end))) %>%
{map2(.$start, .$end, ~ c(.x:.y))} %>%
map_dfc(~ df %>%
rowwise() %>%
mutate(cnt = length(intersect(.x, seq(start, end, 1)))) %>%
pull(cnt)) %>%
bind_cols(as_tibble(df$value_per_unit)) %>%
summarise(across(matches("\\d+"), ~ sum(.x * value) / 10)) %>%
pivot_longer(everything(), names_to = "name",
values_to = "weighted_avg",
names_pattern = ".*(\\d+)")
# A tibble: 6 x 2
name weighted_avg
<chr> <dbl>
1 1 1.25
2 2 1.87
3 3 3.33
4 4 2.73
5 5 1.11
6 6 0.497
I have recently come across an interesting question of calculating a vector values using its penultimate value as .init argument plus an additional vector's current value. Here is the sample data set:
set.seed(13)
dt <- data.frame(id = rep(letters[1:2], each = 5), time = rep(1:5, 2), ret = rnorm(10)/100)
dt$ind <- if_else(dt$time == 1, 120, if_else(dt$time == 2, 125, as.numeric(NA)))
id time ret ind
1 a 1 0.005543269 120
2 a 2 -0.002802719 125
3 a 3 0.017751634 NA
4 a 4 0.001873201 NA
5 a 5 0.011425261 NA
6 b 1 0.004155261 120
7 b 2 0.012295066 125
8 b 3 0.002366797 NA
9 b 4 -0.003653828 NA
10 b 5 0.011051443 NA
What I would like to calculate is:
ind_{t} = ind_{t-2}*(1+ret_{t})
I tried the following code. Since .init is of no use here I tried the nullify the original .init and created a virtual .init but unfortunately it won't drag the newly created values (from third row downward) into calculation:
dt %>%
group_by(id) %>%
mutate(ind = c(120, accumulate(3:n(), .init = 125,
~ .x * 1/.x * ind[.y - 2] * (1 + ret[.y]))))
# A tibble: 10 x 4
# Groups: id [2]
id time ret ind
<chr> <int> <dbl> <dbl>
1 a 1 0.00554 120
2 a 2 -0.00280 125
3 a 3 0.0178 122.
4 a 4 0.00187 125.
5 a 5 0.0114 NA
6 b 1 0.00416 120
7 b 2 0.0123 125
8 b 3 0.00237 120.
9 b 4 -0.00365 125.
10 b 5 0.0111 NA
I was wondering if there was a tweak I could make to this code and make it work completely.
I would appreciate your help greatly in advance
Use a state vector consisting of the current value of ind and the prior value of ind. That way the prior state contains the second prior value of ind. We encode that into complex values with the real part equal to ind and the imaginary part equal to the prior value of ind. At the end we take the real part.
library(dplyr)
library(purrr)
dt %>%
group_by(id) %>%
mutate(result = c(ind[1],
Re(accumulate(.x = tail(ret, -2),
.f = ~ Im(.x) * (1 + .y) + Re(.x) * 1i,
.init = ind[2] + ind[1] * 1i)))) %>%
ungroup
giving:
# A tibble: 10 x 5
id time ret ind result
<chr> <int> <dbl> <dbl> <dbl>
1 a 1 0.00554 120 120
2 a 2 -0.00280 125 125
3 a 3 0.0178 NA 122.
4 a 4 0.00187 NA 125.
5 a 5 0.0114 NA 124.
6 b 1 0.00416 120 120
7 b 2 0.0123 125 125
8 b 3 0.00237 NA 120.
9 b 4 -0.00365 NA 125.
10 b 5 0.0111 NA 122.
Variation
This variation eliminates the complex numbers and uses a vector of 2 elements in place of each complex number with the first number corresponding to the real part in the prior solution and the second number of each pair corresponding to the imaginary part. This could be extended to cases where we need more than 2 numbers per state and where the dependence involves all of the last N values but for the question here there is the downside of the extra line of code to extract the result from the list of pairs of numbers which is more involved than using Re in the prior solution.
dt %>%
group_by(id) %>%
mutate(result = c(ind[1],
accumulate(.x = tail(ret, -2),
.f = ~ c(.x[2] * (1 + .y), .x[1]),
.init = ind[2:1])),
result = map_dbl(result, first)) %>%
ungroup
Check
We check that the results above are correct. Alternately this could be used as a straight forward solution.
calc <- function(ind, ret) {
for(i in seq(3, length(ret))) ind[i] <- ind[i-2] * (1 + ret[i])
ind
}
dt %>%
group_by(id) %>%
mutate(result = calc(ind, ret)) %>%
ungroup
giving:
# A tibble: 10 x 5
id time ret ind result
<chr> <int> <dbl> <dbl> <dbl>
1 a 1 0.00554 120 120
2 a 2 -0.00280 125 125
3 a 3 0.0178 NA 122.
4 a 4 0.00187 NA 125.
5 a 5 0.0114 NA 124.
6 b 1 0.00416 120 120
7 b 2 0.0123 125 125
8 b 3 0.00237 NA 120.
9 b 4 -0.00365 NA 125.
10 b 5 0.0111 NA 122.
I would have done it by creating dummy groups for each sequence, so that it can be done for any number of 'N'. Demonstrating it on a new elaborated data
df <- data.frame(
stringsAsFactors = FALSE,
grp = c("a","a","a","a",
"a","a","a","a","a","b","b","b","b","b",
"b","b","b","b"),
rate = c(0.082322056,
0.098491104,0.07294593,0.08741672,0.030179747,
0.061389031,0.011232314,0.08553277,0.091272669,
0.031577847,0.024039791,0.091719552,0.032540636,
0.020411727,0.094521716,0.081729178,0.066429708,
0.04985793),
ind = c(11000L,12000L,
13000L,NA,NA,NA,NA,NA,NA,10000L,13000L,12000L,
NA,NA,NA,NA,NA,NA)
)
df
#> grp rate ind
#> 1 a 0.08232206 11000
#> 2 a 0.09849110 12000
#> 3 a 0.07294593 13000
#> 4 a 0.08741672 NA
#> 5 a 0.03017975 NA
#> 6 a 0.06138903 NA
#> 7 a 0.01123231 NA
#> 8 a 0.08553277 NA
#> 9 a 0.09127267 NA
#> 10 b 0.03157785 10000
#> 11 b 0.02403979 13000
#> 12 b 0.09171955 12000
#> 13 b 0.03254064 NA
#> 14 b 0.02041173 NA
#> 15 b 0.09452172 NA
#> 16 b 0.08172918 NA
#> 17 b 0.06642971 NA
#> 18 b 0.04985793 NA
library(tidyverse)
N = 3
df %>% group_by(grp) %>%
group_by(d = row_number() %% N, .add = TRUE) %>%
mutate(ind = accumulate(rate[-1] + 1, .init = ind[1], ~ .x * .y))
#> # A tibble: 18 x 4
#> # Groups: grp, d [6]
#> grp rate ind d
#> <chr> <dbl> <dbl> <dbl>
#> 1 a 0.0823 11000 1
#> 2 a 0.0985 12000 2
#> 3 a 0.0729 13000 0
#> 4 a 0.0874 11962. 1
#> 5 a 0.0302 12362. 2
#> 6 a 0.0614 13798. 0
#> 7 a 0.0112 12096. 1
#> 8 a 0.0855 13420. 2
#> 9 a 0.0913 15057. 0
#> 10 b 0.0316 10000 1
#> 11 b 0.0240 13000 2
#> 12 b 0.0917 12000 0
#> 13 b 0.0325 10325. 1
#> 14 b 0.0204 13265. 2
#> 15 b 0.0945 13134. 0
#> 16 b 0.0817 11169. 1
#> 17 b 0.0664 14147. 2
#> 18 b 0.0499 13789. 0
Alternate answer in dplyr (using your own data modified a bit only)
set.seed(13)
dt <- data.frame(id = rep(letters[1:2], each = 5), time = rep(1:5, 2), ret = rnorm(10)/100)
dt$ind <- ifelse(dt$time == 1, 12000, ifelse(dt$time == 2, 12500, as.numeric(NA)))
library(dplyr, warn.conflicts = F)
dt %>% group_by(id) %>%
group_by(d= row_number() %% 2, .add = TRUE) %>%
mutate(ind = cumprod(1 + duplicated(id) * ret)* ind[1])
#> # A tibble: 10 x 5
#> # Groups: id, d [4]
#> id time ret ind d
#> <chr> <int> <dbl> <dbl> <dbl>
#> 1 a 1 0.00554 12000 1
#> 2 a 2 -0.00280 12500 0
#> 3 a 3 0.0178 12213. 1
#> 4 a 4 0.00187 12523. 0
#> 5 a 5 0.0114 12353. 1
#> 6 b 1 0.00416 12000 0
#> 7 b 2 0.0123 12500 1
#> 8 b 3 0.00237 12028. 0
#> 9 b 4 -0.00365 12454. 1
#> 10 b 5 0.0111 12161. 0
Goal: I would like to generate grouped percentiles for each group (hrzn)
I have the following data
# A tibble: 3,500 x 3
hrzn parameter density
<dbl> <dbl> <dbl>
1 1 0.0183 0.00914
2 1 0.0185 0.00905
3 1 0.0187 0.00897
4 1 0.0189 0.00888
5 1 0.0191 0.00880
6 1 0.0193 0.00872
7 1 0.0194 0.00864
8 1 0.0196 0.00855
9 1 0.0198 0.00847
10 1 0.0200 0.00839
The hrzn is the group, the parameter is a grid of parameter space, and the density is the density for the value in the parameter column.
I would like to generate summary the statistics percentiles 10 to 90 by 10 by hrzn. I am trying to keep this computationally efficient. I know I could sample the parameter with the density as weights, but I am curious is there is a faster way to generate the percentiles from the density without doing a sample.
The data may be obtained with the following
df <- readr::read_csv("https://raw.githubusercontent.com/alexhallam/density_data/master/data.csv")
When I load the data from your csv, each of the 5 groups have identical values for parameter and density:
df
#># A tibble: 3,500 x 3
#> hrzn parameter density
#> <int> <dbl> <dbl>
#> 1 1 0.0183 0.00914
#> 2 1 0.0185 0.00905
#> 3 1 0.0187 0.00897
#> 4 1 0.0189 0.00888
#> 5 1 0.0191 0.00880
#> 6 1 0.0193 0.00872
#> 7 1 0.0194 0.00864
#> 8 1 0.0196 0.00855
#> 9 1 0.0198 0.00847
#>10 1 0.0200 0.00839
#># ... with 3,490 more rows
sapply(1:5, function(x) all(df$parameter[df$hrzn == x] == df$parameter[df$hrzn == 1]))
# [1] TRUE TRUE TRUE TRUE TRUE
sapply(1:5, function(x) all(df$density[df$hrzn == x] == df$density[df$hrzn == 1]))
# [1] TRUE TRUE TRUE TRUE TRUE
I'm not sure if this is a mistake or not, but clearly if you're worried about computation, anything you want to do on all the groups can be done 5 times faster by only doing it on a single group.
Anyway, to get the 10th and 90th centiles for each hrzn, you just need to see which parameter is adjacent to 0.1 and 0.9 on the cumulative distribution function. Let's generalize to working it out for all the groups in case there's an issue with the data or you want to repeat it with different data:
library(dplyr)
df %>%
mutate(hrzn = factor(hrzn)) %>%
group_by(hrzn) %>%
summarise(centile_10 = parameter[which(cumsum(density) > .1)[1]],
centile_90 = parameter[which(cumsum(density) > .9)[1]] )
#># A tibble: 5 x 3
#> hrzn centile_10 centile_90
#> <fct> <dbl> <dbl>
#>1 1 0.0204 0.200
#>2 2 0.0204 0.200
#>3 3 0.0204 0.200
#>4 4 0.0204 0.200
#>5 5 0.0204 0.200
Of course, they're all the same for the reasons mentioned above.
If you're worried about computation time (even though the above only takes a few milliseconds), and you don't mind opaque code, you could take advantage of the ordering to cut the cumsum of your entire density column between 0 and 5 in steps of 0.1, to get all the 10th centiles, like this:
summary <- df[which((diff(as.numeric(cut(cumsum(df$density), seq(0,5,.1))) - 1) != 0)) + 1,]
summary <- summary[-(1:5)*10,]
summary$centile <- rep(1:9*10, 5)
summary
#> # A tibble: 45 x 4
#> hrzn parameter density centile
#> <int> <dbl> <dbl> <dbl>
#> 1 1 0.0204 0.00824 10
#> 2 1 0.0233 0.00729 20
#> 3 1 0.0271 0.00634 30
#> 4 1 0.0321 0.00542 40
#> 5 1 0.0392 0.00453 50
#> 6 1 0.0498 0.00366 60
#> 7 1 0.0679 0.00281 70
#> 8 1 0.103 0.00199 80
#> 9 1 0.200 0.00114 90
#> 10 2 0.0204 0.00824 10
#> # ... with 35 more rows
Perhaps I have misunderstood you and you are actually working in a 5-dimensional parameter space and want to know the parameter values at the 10th and 90th centiles of 5d density. In that case, you can take advantage of the fact that all groups are the same to calculate the 10th and 90th centiles for the 5-d density by simply taking the 5th root of these two centiles:
df %>%
mutate(hrzn = factor(hrzn)) %>%
group_by(hrzn) %>%
summarise(centile_10 = parameter[which(cumsum(density) > .1^.2)[1]],
centile_90 = parameter[which(cumsum(density) > .9^.2)[1]] )
#> # A tibble: 5 x 3
#> hrzn centile_10 centile_90
#> <fct> <dbl> <dbl>
#> 1 1 0.0545 0.664
#> 2 2 0.0545 0.664
#> 3 3 0.0545 0.664
#> 4 4 0.0545 0.664
#> 5 5 0.0545 0.664
I want to get the confidence intervals for proportions within my tibble. Is there a way of doing this?
library(tidyverse)
library(Hmisc)
library(broom)
df <- tibble(id = c(1, 2, 3, 4, 5, 6),
count = c(4, 1, 22, 4545, 33, 23),
n = c(22, 65, 34, 6323, 35, 45))
Which looks like this:
# A tibble: 6 x 3
id count n
<dbl> <dbl> <dbl>
1 1 4 22
2 2 1 65
3 3 22 34
4 4 4545 6323
5 5 33 35
6 6 23 45
Using binconf from Hmisc and tidy from broom the solution could be from any package:
The intervals for the first row:
tidy(binconf(4, 22))
# A tibble: 1 x 4
.rownames PointEst Lower Upper
<chr> <dbl> <dbl> <dbl>
1 "" 0.182 0.0731 0.385
I have tried using map in purrr but get errors:
map(df, tidy(binconf(count, n)))
Error in x[i] : object of type 'closure' is not subsettable
I could just calculate them using dplyr but I get values below zero (e.g. row 2) or above one (e.g row 5), which I don't want. e.g.
df %>%
mutate(prop = count / n) %>%
mutate(se = (sqrt(prop * (1-prop)/n))) %>%
mutate(lower = prop - (se*1.96)) %>%
mutate(upper = prop + (se*1.96))
# A tibble: 6 x 7
id count n prop se lower upper
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 4 22 0.182 0.0822 0.0206 0.343
2 2 1 65 0.0154 0.0153 -0.0145 0.0453
3 3 22 34 0.647 0.0820 0.486 0.808
4 4 4545 6323 0.719 0.00565 0.708 0.730
5 5 33 35 0.943 0.0392 0.866 1.02
6 6 23 45 0.511 0.0745 0.365 0.657
Is there a good way of doing this? I did have a look at the confint_tidy() function, but could not get that to work. Any ideas?
It may not be tidy but
> as.tibble(cbind(df, binconf(df$count, df$n)))
# A tibble: 6 x 6
id count n PointEst Lower Upper
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 4 22 0.182 0.0731 0.385
2 2 1 65 0.0154 0.000789 0.0821
3 3 22 34 0.647 0.479 0.785
4 4 4545 6323 0.719 0.708 0.730
5 5 33 35 0.943 0.814 0.984
6 6 23 45 0.511 0.370 0.650
seems to work
Attempting to plot aggregate data from the following data.
Person Time Period Value SMA2 SMA3 SMA4
<chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 A 1 1 14 NA NA NA
2 A 2 1 8 11 NA NA
3 A 3 1 13 10.5 11.7 NA
4 A 4 1 12 12.5 11 11.8
5 A 5 1 19 15.5 14.7 13
6 A 6 1 9 14 13.3 13.2
7 A 7 2 14 NA NA NA
8 A 8 2 7 10.5 NA NA
9 A 9 2 11 9 10.7 NA
10 A 10 2 14 12.5 10.7 11.5
# ... with 26 more rows
I have used aggregate(DataSet[,c(4,5,6,7)], by=list(DataSet$Person), na.rm = TRUE, max) to get the following:
Group.1 Value SMA2 SMA3 SMA4
1 A 20 18.0 16.66667 15.25
2 B 20 17.0 16.66667 15.00
3 C 19 18.5 14.33333 14.50
I'd like to plot the maxes for each SMA for Person A, B, and C on the same plot.
I would also like to be able to plot the mean of these maxes for each SMA column.
Any help is appreciated.
Like so? Or are you looking for something different?
df <- data.frame("Group.1"=c("A","B","C"), "Value"=c(20,20,20),
"SMA2"=c(18.0, 17.0, 18.5), "SMA3" =c(16.667, 16.667, 14.333),
"SMA4"=c(15.25, 15.00, 14.50))
library(ggplot2)
library(tidyr)
df.g <- df %>%
gather(SMA, Value, -Group.1)
df.g$SMA <- factor(df.g$SMA, levels=c("Value", "SMA2", "SMA3", "SMA4"))
means <- df.g %>%
group_by(SMA) %>%
summarise(m=mean(Value))
ggplot(df.g, aes(x=SMA, y=Value, group=Group.1, colour=Group.1)) +
geom_line() +
geom_point(data=means, aes(x=SMA, y=m), inherit.aes = F)