Select first occurrence of a decimal value in R - r

Ok, I have been trying to get an answer for this but I cant find it anywhere, but it seems like an easy task (which is bugging me even more!)
I have a dataframe with a series of numbers in a column which I want to filter to get the first occurrence of a number....for example, if i have 1.01, 1.08, 1.15, I want to filter the rows to get the row with the value 1.01 in that column.
An examples is:
x<- c(2.04, 2.25, 3.99, 3.20, 2.60, 1.85, 3.57, 3.37, 2.59, 1.60, 3.93, 1.33, 1.08, 4.64, 2.09, 4.53, 3.04, 3.85, 3.15, 3.97)
y<- c(2.62, 2.48, 1.40, 2.27, 3.71, 1.86, 3.56, 2.08, 2.36, 3.23, 1.65, 3.43, 1.57, 4.49, 2.29, 3.32, 2.12, 4.45, 1.57, 4.70)
z <- data.frame(x, y)
z <- z[order(z$x, decreasing = FALSE), ]
And the filtered results should be:
x y
1.08 1.57
2.04 2.62
3.04 2.12
4.53 3.32
Any help would be apprreciated


z %>%
arrange(x) %>%
group_by(int = floor(x)) %>%
slice(1) %>%
ungroup()
# A tibble: 4 × 3
x y int
<dbl> <dbl> <dbl>
1 1.08 1.57 1
2 2.04 2.62 2
3 3.04 2.12 3
4 4.53 3.32 4
or
z %>%
arrange(x) %>%
filter(floor(x) != lag(floor(x), default = 0))
x y
1 1.08 1.57
2 2.04 2.62
3 3.04 2.12
4 4.53 3.32


You can also try this:
z1 <- z %>%
group_by(floor(z$x)) %>%
arrange(z$x) %>%
filter(row_number()==1)
z1
# A tibble: 4 × 3
# Groups: floor(z$x) [4]
x y `floor(z$x)`
<dbl> <dbl> <dbl>
1 1.08 1.57 1
2 2.04 2.62 2
3 3.04 2.12 3
4 4.53 3.32 4

Related

remove duplicate coordinates from X and Y column

Based on the data below how can I remove the rows with duplicate X and Y coordinates? In the example below, you will notice that one of X coordinate is -1.52 which is repeated twice but it's not a duplicate since it's corresponding Y coordiantes are different.
I don't know if it matters but please note that the orginal dataset has more than 2 decimal places for the X and Y values.
Sample data:
structure(list(id = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), X = c(-1.01,
-1.11, -1.11, -2.13, -2.13, -1.52, -1.52, -1.98, -3.69, -4.79),
Y = c(2.11, 3.33, 3.33, 6.66, 6.66, 7.77, 8.88, 9.99, 1.11,
6.68)), class = "data.frame", row.names = c(NA, -10L))
Desired data:
id X Y
1 -1.01 2.11
2 -1.11 3.33
4 -2.13 6.66
6 -1.52 7.77
7 -1.52 8.88
8 -1.98 9.99
9 -3.69 1.11
19 -4.79 6.68

Use duplicated
subset(df1, !duplicated(df1[-1]))
-output
id X Y
1 1 -1.01 2.11
2 2 -1.11 3.33
4 4 -2.13 6.66
6 6 -1.52 7.77
7 7 -1.52 8.88
8 8 -1.98 9.99
9 9 -3.69 1.11
10 10 -4.79 6.68
Or with distinct
library(dplyr)
df1 %>%
distinct(X, Y, .keep_all = TRUE)

R split by group and create new columns

I'm trying to split a data frame from long to wide format by converting selected rows to columns. Here is the current general long-format structure:
data_long <- data.frame(
id = c("kelp","kelp","fish","fish","beach","beach","kelp","kelp","fish","fish","beach","beach"),
desig = c("mpa","reference","mpa","reference","mpa","reference","mpa","reference","mpa","reference","mpa","reference"),
indicator = c("density","density","density","density","density","density","biomass","biomass","biomass","biomass","biomass","biomass"),
n = c(1118,1118,1118,1118,1118,1118,1118,1118,1118,1118,1118,1118),
m = c(0.35, 4.28, 1.16, 106.35, 13.44,0.63,0.35, 4.28, 1.16, 106.35, 13.44,0.63),
sd = c(1.19, 8.48, 4.25, 118, 31.77,2.79,1.19, 8.48, 4.25, 118, 31.77,2.79)
)
data_long
I want to keep id and indicator, split by "desig",and move "n", "m", and "sd" into new columns. The final data frame structure I'm trying to obtain is:
data_wide <- data.frame(
id = c("kelp","fish","beach","kelp","fish","beach"),
indicator = c("density","density","density","biomass","biomass","biomass"),
mpa.n = c(1118,1118,1118,1118,1118,1118),
mpa.m = c(0.35, 4.28, 1.16, 106.35, 13.44,0.63),
mpa.sd = c(1.19, 8.48, 4.25, 118, 31.77,2.79),
reference.n = c(1118,1118,1118,1118,1118,1118),
reference.m = c(0.35, 4.28, 1.16, 106.35, 13.44,0.63),
reference.sd = c(1.19, 8.48, 4.25, 118, 31.77,2.79)
)
data_wide
I can't seem to get this right using reshape2. Any suggestions?

We may use pivot_wider
library(tidyr)
library(dplyr)
pivot_wider(data_long, names_from = desig,
values_from = c(n, m, sd), names_glue = "{desig}.{.value}") %>%
select(id, indicator, starts_with("mpa"), starts_with('reference'))
-output
# A tibble: 6 × 8
id indicator mpa.n mpa.m mpa.sd reference.n reference.m reference.sd
<chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 kelp density 1118 0.35 1.19 1118 4.28 8.48
2 fish density 1118 1.16 4.25 1118 106. 118
3 beach density 1118 13.4 31.8 1118 0.63 2.79
4 kelp biomass 1118 0.35 1.19 1118 4.28 8.48
5 fish biomass 1118 1.16 4.25 1118 106. 118
6 beach biomass 1118 13.4 31.8 1118 0.63 2.79

Translating loop syntax from Stata to R

I need to write a for loop to calculate the product of year variables (e.g. var1874) * price variables (e.g. num1874), creating a new variable for each year and its corresponding price value (e.g. newvar1874).
Here's my data in R
A tibble: 4 x 7
cty var1874 var1875 var1876 num1874 num1875 num1876
<dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 1 0.78 0.83 0.99 2.64 2.8 3.1
2 2 0.69 0.69 0.89 2.3 2.3 2.58
3 3 0.42 0.48 0.59 2.28 2.44 2.64
4 4 0.82 0.94 1.09 2.28 2.36 3
I've been able to do this using the 'foreach' loop in Stata:
local vn 1874 1875 1876
foreach v of local vn {
gen newvar'v' = var'v'*num'v'
Does anyone know how I would do this same type of command using the for loop in R? I know there may be simpler ways to do this without the for loop, but I need to know how to do this using the for loop.

Using a for loop you could do:
vn <- 1874:1876
for (v in vn) d[[paste0("newvar", v)]] <- d[[paste0("var", v)]] * d[[paste0("num", v)]]
d
#> cty var1874 var1875 var1876 num1874 num1875 num1876 newvar1874 newvar1875
#> 1 1 0.78 0.83 0.99 2.64 2.80 3.10 2.0592 2.3240
#> 2 2 0.69 0.69 0.89 2.30 2.30 2.58 1.5870 1.5870
#> 3 3 0.42 0.48 0.59 2.28 2.44 2.64 0.9576 1.1712
#> 4 4 0.82 0.94 1.09 2.28 2.36 3.00 1.8696 2.2184
#> newvar1876
#> 1 3.0690
#> 2 2.2962
#> 3 1.5576
#> 4 3.2700
Or using lapply you could do:
d[, paste0("newvar", vn)] <- lapply(vn, function(v) d[[paste0("var", v)]] * d[[paste0("num", v)]])
DATA
d <- structure(list(
cty = 1:4, var1874 = c(0.78, 0.69, 0.42, 0.82),
var1875 = c(0.83, 0.69, 0.48, 0.94), var1876 = c(
0.99, 0.89,
0.59, 1.09
), num1874 = c(2.64, 2.3, 2.28, 2.28), num1875 = c(
2.8,
2.3, 2.44, 2.36
), num1876 = c(3.1, 2.58, 2.64, 3)
), class = "data.frame", row.names = c(
"1",
"2", "3", "4"
))

Pass argument from user provided function to aggregate (stats)

I am looking to create a function that aggregates sale data by many different variables. I am running into a snag with aggregate(by =). Here is my function thus far:
func <- function(x, x2, statfunc) {
PT <- c(1,5,3,5,4,8,3,1,5,6,1,5,5,6,1,2,3,1,5,1)
SH <- c(7,7,3,1,1,1,1,4,4,6,6,7,7,1,1,1,3,2,1,3)
SaleRatio <- c(0.85, 0.92, 0.89, 0.88, 0.86, 1.08, 1.15, 1.03, 0.95, 1.01, 1.36, 0.96, 1.03, 0.95, 0.90, 1.01, 0.96, 0.95, 0.81, 1.29)
study <- data.frame(PT, SH, SaleRatio)
study <- select(study, x2, SaleRatio)
study <- aggregate(study,
by = list(x),
FUN = statfunc)
print(study)
}
When I attempt to run my formula with:
func(x = "study$PT", x2 = "PT", statfunc = median)
I get the error:
Error in aggregate.data.frame(study, by = list(x), FUN = statfunc) :
arguments must have same length
I am expecting this:
Group.1 PT SaleRatio
1 1 1 0.990
2 2 2 1.010
3 3 3 0.960
4 4 4 0.860
5 5 5 0.935
6 6 6 0.980
7 8 8 1.080
The results above are from the exact same formula, only by manually entering the arguments instead of letting the function pass them.
This user provided function will eventually be applied with many different variables and aggregate functions, and on a much larger data set.
Can someone assist?

We can try with tidyverse
library(dplyr)
func <- function(x, x2, statfunc) {
PT <- c(1,5,3,5,4,8,3,1,5,6,1,5,5,6,1,2,3,1,5,1)
SH <- c(7,7,3,1,1,1,1,4,4,6,6,7,7,1,1,1,3,2,1,3)
SaleRatio <- c(0.85, 0.92, 0.89, 0.88, 0.86, 1.08, 1.15, 1.03, 0.95,
1.01, 1.36, 0.96, 1.03, 0.95, 0.90, 1.01, 0.96, 0.95, 0.81, 1.29)
study <- data.frame(PT, SH, SaleRatio)
study %>%
select(x2, SaleRatio) %>%
group_by_at(x) %>%
summarise_all(statfunc)
}
func("PT", "PT", median)
# A tibble: 7 x 2
# PT SaleRatio
# <dbl> <dbl>
#1 1 0.99
#2 2 1.01
#3 3 0.96
#4 4 0.86
#5 5 0.935
#6 6 0.98
#7 8 1.08

Apply a function to a subset of many columns in R

How do I apply a function to many columns of grouped rows? For example;
library(tidyverse)
data <- tribble(
~Date, ~Seq1, ~Component, ~Seq2, ~X1, ~X2, ~X3,
"01/01/18", 1, "Smooth", NA, 3.98, 2.75, 1.82,
"01/01/18", 2, "Smooth", NA, 1.02, 0.02, -0.04,
"01/01/18", 3, "Smooth", NA, 3.48, 3.06, 1.25,
"01/01/18", 3, "Bounce", 1, 2.01, -0.43, -0.52,
"01/01/18", 3, "Bounce", 2, 1.94, 1.53, 1.92) %>%
mutate_at(vars(Date, Seq1, Component, Seq2), funs(factor))
Each column of X values (many more columns, truncated here for clarity) is grouped into Date, Seq1, Component, and Seq2. While Component "Smooth" and Seq1 "NA" are constant, within Component "Bounce" level there are multiple Seq2 levels e.g. "1", "2", etc.
How do I sum each X column, always the constant "NA" with each level of Seq2?
The desired results is:
expected <- tribble(
~Date, ~Seq1, ~Component, ~Seq2, ~X1, ~X2, ~X3,
"01/01/18", 1, "Smooth", NA, 3.98, 2.75, 1.82,
"01/01/18", 2, "Smooth", NA, 1.02, 0.02, -0.04,
"01/01/18", 3, "Smooth", NA, 3.48, 3.06, 1.25,
"01/01/18", 3, "Bounce", 1, 5.49, 3.49, 1.77,
"01/01/18", 3, "Bounce", 2, 5.42, 4.59, 3.17)
The following example only adds each Seq1 level.
data %>%
group_by(Date, Seq1) %>%
mutate_at(vars(starts_with("X")), funs(sum(.)))
#> # A tibble: 5 x 7
#> # Groups: Date, Seq1 [3]
#> Date Seq1 Component Seq2 X1 X2 X3
#> <fct> <fct> <fct> <fct> <dbl> <dbl> <dbl>
#> 1 01/01/18 1 Smooth <NA> 3.98 2.75 1.82
#> 2 01/01/18 2 Smooth <NA> 1.02 0.02 -0.04
#> 3 01/01/18 3 Smooth <NA> 7.43 4.16 2.65
#> 4 01/01/18 3 Bounce 1 7.43 4.16 2.65
#> 5 01/01/18 3 Bounce 2 7.43 4.16 2.65
I am certain there is solution within the purrr or apply function family, however, I have been unsuccessful (for days) in solving this example. The actual data has about 180 X columns, with hundreds of Date and Seq1 combinations, and multiple Seq2 levels.
A similar example could be Summing Multiple Groups of Columns, How to apply a function to a subset of columns in r?, or even perhaps https://github.com/jennybc/row-oriented-workflows.
Created on 2018-10-23 by the reprex package (v0.2.1)

Here's my solution. This problem is not really a purrr task, because there is nothing really that you want to map a single function to. Instead, what I understand the problem to be is that you want to match each X value in a Bounce row with the corresponding Smooth row X values of the same Date and Seq1 (and there is only one such row). This means that it is really a merging or joining problem, and then the approach is to set up the join so that you can match the right values and do the sum. So I go as follows:
Split the data into the Smooth rows and the Bounce rows and gather so that all the X values are in one column
Join the smooths onto the bounces with a left_join, so each original Bounce row now has its corresponding Smooth.
mutate the sum into a new column and select/rename the columns to be as in the original
bind_rows to join the newly summed bounces and spread to return to the original layout.
This should be robust to any number of Date, Seq1, Seq2 and X values.
library(tidyverse)
data <- tribble(
~Date, ~Seq1, ~Component, ~Seq2, ~X1, ~X2, ~X3,
"01/01/18", 1, "Smooth", NA, 3.98, 2.75, 1.82,
"01/01/18", 2, "Smooth", NA, 1.02, 0.02, -0.04,
"01/01/18", 3, "Smooth", NA, 3.48, 3.06, 1.25,
"01/01/18", 3, "Bounce", 1, 2.01, -0.43, -0.52,
"01/01/18", 3, "Bounce", 2, 1.94, 1.53, 1.92)
smooths <- data %>%
filter(Component == "Smooth") %>%
gather(X, val, starts_with("X"))
bounces <- data %>%
filter(Component == "Bounce") %>%
gather(X, val, starts_with("X")) %>%
left_join(smooths, by = c("Date", "Seq1", "X")) %>%
mutate(val = val.x + val.y) %>%
select(Date, Seq1, Component = Component.x, Seq2 = Seq2.x, X, val)
bounces %>%
bind_rows(smooths) %>%
spread(X, val)
#> # A tibble: 5 x 7
#> Date Seq1 Component Seq2 X1 X2 X3
#> <chr> <dbl> <chr> <dbl> <dbl> <dbl> <dbl>
#> 1 01/01/18 1 Smooth NA 3.98 2.75 1.82
#> 2 01/01/18 2 Smooth NA 1.02 0.02 -0.04
#> 3 01/01/18 3 Bounce 1 5.49 2.63 0.73
#> 4 01/01/18 3 Bounce 2 5.42 4.59 3.17
#> 5 01/01/18 3 Smooth NA 3.48 3.06 1.25
Created on 2018-10-31 by the reprex package (v0.2.1)

Resources