1# Licensed to the Apache Software Foundation (ASF) under one
2# or more contributor license agreements.  See the NOTICE file
3# distributed with this work for additional information
4# regarding copyright ownership.  The ASF licenses this file
5# to you under the Apache License, Version 2.0 (the
6# "License"); you may not use this file except in compliance
7# with the License.  You may obtain a copy of the License at
8#
9#   http://www.apache.org/licenses/LICENSE-2.0
10#
11# Unless required by applicable law or agreed to in writing,
12# software distributed under the License is distributed on an
13# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
14# KIND, either express or implied.  See the License for the
15# specific language governing permissions and limitations
16# under the License.
17
18skip_if_not_available("dataset")
19
20library(dplyr, warn.conflicts = FALSE)
21library(stringr)
22
23tbl <- example_data
24
25test_that("group_by groupings are recorded", {
26  compare_dplyr_binding(
27    .input %>%
28      group_by(chr) %>%
29      select(int, chr) %>%
30      filter(int > 5) %>%
31      collect(),
32    tbl
33  )
34})
35
36test_that("group_by supports creating/renaming", {
37  compare_dplyr_binding(
38    .input %>%
39      group_by(chr, numbers = int) %>%
40      collect(),
41    tbl
42  )
43  compare_dplyr_binding(
44    .input %>%
45      group_by(chr, numbers = int * 4) %>%
46      collect(),
47    tbl
48  )
49  compare_dplyr_binding(
50    .input %>%
51      group_by(int > 4, lgl, foo = int > 5) %>%
52      collect(),
53    tbl
54  )
55})
56
57test_that("ungroup", {
58  compare_dplyr_binding(
59    .input %>%
60      group_by(chr) %>%
61      select(int, chr) %>%
62      ungroup() %>%
63      filter(int > 5) %>%
64      collect(),
65    tbl
66  )
67
68  # to confirm that the above expectation is actually testing what we think it's
69  # testing, verify that compare_dplyr_binding() distinguishes between grouped and
70  # ungrouped tibbles
71  expect_error(
72    compare_dplyr_binding(
73      .input %>%
74        group_by(chr) %>%
75        select(int, chr) %>%
76        (function(x) if (inherits(x, "tbl_df")) ungroup(x) else x) %>%
77        filter(int > 5) %>%
78        collect(),
79      tbl
80    )
81  )
82})
83
84test_that("group_by then rename", {
85  compare_dplyr_binding(
86    .input %>%
87      group_by(chr) %>%
88      select(string = chr, int) %>%
89      collect(),
90    tbl
91  )
92})
93
94test_that("group_by with .drop", {
95  test_groups <- c("starting_a_fight", "consoling_a_child", "petting_a_dog")
96  compare_dplyr_binding(
97    .input %>%
98      group_by(!!!syms(test_groups), .drop = TRUE) %>%
99      collect(),
100    example_with_logical_factors
101  )
102  compare_dplyr_binding(
103    .input %>%
104      group_by(!!!syms(test_groups), .drop = FALSE) %>%
105      collect(),
106    example_with_logical_factors
107  )
108  expect_equal(
109    example_with_logical_factors %>%
110      group_by(!!!syms(test_groups), .drop = TRUE) %>%
111      collect() %>%
112      n_groups(),
113    4L
114  )
115  expect_equal(
116    example_with_logical_factors %>%
117      group_by(!!!syms(test_groups), .drop = FALSE) %>%
118      collect() %>%
119      n_groups(),
120    8L
121  )
122  expect_equal(
123    example_with_logical_factors %>%
124      group_by(!!!syms(test_groups), .drop = FALSE) %>%
125      group_by_drop_default(),
126    FALSE
127  )
128  expect_equal(
129    example_with_logical_factors %>%
130      group_by(!!!syms(test_groups), .drop = TRUE) %>%
131      group_by_drop_default(),
132    TRUE
133  )
134  compare_dplyr_binding(
135    .input %>%
136      group_by(.drop = FALSE) %>% # no group by vars
137      group_by_drop_default(),
138    example_with_logical_factors
139  )
140  compare_dplyr_binding(
141    .input %>%
142      group_by_drop_default(),
143    example_with_logical_factors
144  )
145  compare_dplyr_binding(
146    .input %>%
147      group_by(!!!syms(test_groups)) %>%
148      group_by_drop_default(),
149    example_with_logical_factors
150  )
151  compare_dplyr_binding(
152    .input %>%
153      group_by(!!!syms(test_groups), .drop = FALSE) %>%
154      ungroup() %>%
155      group_by_drop_default(),
156    example_with_logical_factors
157  )
158})
159