@@ -59,102 +59,117 @@ ScalesList <- ggproto("ScalesList", NULL,
5959 scale <- self $ scales [self $ find(output )]
6060 if (length(scale ) == 0 ) return ()
6161 scale [[1 ]]
62- }
63- )
64-
65- # Train scale from a data frame
66- scales_train_df <- function (scales , df , drop = FALSE ) {
67- if (empty(df ) || length(scales $ scales ) == 0 ) return ()
68-
69- lapply(scales $ scales , function (scale ) scale $ train_df(df = df ))
70- }
71-
72- # Map values from a data.frame. Returns data.frame
73- scales_map_df <- function (scales , df ) {
74- if (empty(df ) || length(scales $ scales ) == 0 ) return (df )
75-
76- mapped <- unlist(lapply(scales $ scales , function (scale ) scale $ map_df(df = df )), recursive = FALSE )
77-
78- data_frame0(!!! mapped , df [setdiff(names(df ), names(mapped ))])
79- }
80-
81- # Transform values to cardinal representation
82- scales_transform_df <- function (scales , df ) {
83- if (empty(df )) return (df )
62+ },
8463
85- # if the scale contains no trans or the trans is of identity, it doesn't need
86- # to be transformed.
87- idx_skip <- vapply(scales $ scales , function (x ) {
88- has_default_transform(x ) &&
89- (is.null(x $ trans ) || identical(x $ trans $ transform , identity ))
90- }, logical (1L ))
91- scale_list <- scales $ scales [! idx_skip ]
64+ train_df = function (self , df , drop = FALSE ) {
65+ if (empty(df ) || length(self $ scales ) == 0 ) {
66+ return ()
67+ }
68+ lapply(self $ scales , function (scale ) scale $ train_df(df = df ))
69+ },
9270
93- if (length(scale_list ) == 0L ) return (df )
71+ map_df = function (self , df ) {
72+ if (empty(df ) || length(self $ scales ) == 0 ) {
73+ return (df )
74+ }
9475
95- transformed <- unlist(lapply(scale_list , function (s ) s $ transform_df(df = df )),
96- recursive = FALSE )
97- untransformed <- df [setdiff(names(df ), names(transformed ))]
98- data_frame0(!!! transformed , untransformed )
99- }
76+ mapped <- unlist(lapply(
77+ self $ scales ,
78+ function (scale ) scale $ map_df(df = df )
79+ ), recursive = FALSE )
10080
101- scales_backtransform_df <- function (scales , df ) {
102- # NOTE: no need to check empty(data) because it should be already checked
103- # before this function is called.
81+ data_frame0(!!! mapped , df [setdiff(names(df ), names(mapped ))])
82+ },
10483
105- # if the scale contains no trans or the trans is of identity, it doesn't need
106- # to be backtransformed.
107- idx_skip <- vapply(scales $ scales , function (x ) {
108- is.null(x $ trans ) ||
109- identical(x $ trans $ inverse , identity )
110- }, logical (1L ))
111- scale_list <- scales $ scales [! idx_skip ]
84+ transform_df = function (self , df ) {
85+ if (empty(df )) {
86+ return (df )
87+ }
11288
113- if (length(scale_list ) == 0L ) return (df )
89+ # If the scale contains to trans or trans is identity, there is no need
90+ # to transform anything
91+ idx_skip <- vapply(self $ scales , function (x ) {
92+ has_default_transform(x ) &&
93+ (is.null(x $ trans ) || identical(x $ trans $ transform , identity ))
94+ }, logical (1L ))
95+ scales <- self $ scales [! idx_skip ]
11496
115- backtransformed <- unlist(lapply(scale_list , function (scale ) {
116- aesthetics <- intersect(scale $ aesthetics , names(df ))
97+ if (length(scales ) == 0 ) {
98+ return (df )
99+ }
117100
118- if (length(aesthetics ) == 0 ) return ()
101+ transformed <- unlist(lapply(
102+ scales ,
103+ function (scale ) scale $ transform_df(df = df )
104+ ), recursive = FALSE )
119105
120- lapply( df [aesthetics ], scale $ trans $ inverse )
121- }), recursive = FALSE )
106+ data_frame0( !!! transformed , df [setdiff(names( df ), names( transformed ))] )
107+ },
122108
123- new_data_frame(c(backtransformed , df [setdiff(names(df ), names(backtransformed ))]))
124- }
109+ backtransform_df = function (self , df ) {
110+ # NOTE: no need to check empty(df) because it should be already checked
111+ # before this method is called.
125112
126- # @param aesthetics A list of aesthetic-variable mappings. The name of each
127- # item is the aesthetic, and the value of each item is the variable in data.
128- scales_add_defaults <- function (scales , data , aesthetics , env ) {
129- if (is.null(aesthetics )) return ()
130- names(aesthetics ) <- unlist(lapply(names(aesthetics ), aes_to_scale ))
113+ # If the scale contains to trans or trans is identity, there is no need
114+ # to transform anything
115+ idx_skip <- vapply(self $ scales , function (x ) {
116+ has_default_transform(x ) &&
117+ (is.null(x $ trans ) || identical(x $ trans $ transform , identity ))
118+ }, logical (1 ))
119+ scales <- self $ scales [! idx_skip ]
131120
132- new_aesthetics <- setdiff(names( aesthetics ), scales $ input())
133- # No new aesthetics, so no new scales to add
134- if (is.null( new_aesthetics )) return ()
121+ if (length( scales ) == 0 ) {
122+ return ( df )
123+ }
135124
136- datacols <- lapply(aesthetics [new_aesthetics ], eval_tidy , data = data )
137- datacols <- compact(datacols )
125+ backtransformed <- unlist(lapply(
126+ scales ,
127+ function (scale ) {
128+ aesthetics <- intersect(scale $ aesthetics , names(df ))
129+ if (length(aesthetics ) == 0 ) {
130+ return ()
131+ }
132+ lapply(df [aesthetics ], scale $ trans $ inverse )
133+ }
134+ ), recursive = FALSE )
135+
136+ data_frame0(
137+ !!! backtransformed ,
138+ df [setdiff(names(df ), names(backtransformed ))]
139+ )
140+ },
138141
139- for (aes in names(datacols )) {
140- scales $ add(find_scale(aes , datacols [[aes ]], env ))
141- }
142+ # `aesthetics` is a list of aesthetic-variable mappings. The name of each
143+ # item is the aesthetic, and the value of each item is the variable in data.
144+ add_defaults = function (self , data , aesthetics , env ) {
145+ if (is.null(aesthetics )) {
146+ return ()
147+ }
148+ names(aesthetics ) <- unlist(lapply(names(aesthetics ), aes_to_scale ))
142149
143- }
150+ new_aesthetics <- setdiff(names(aesthetics ), self $ input())
151+ # No new aesthetics, so no new scales to add
152+ if (is.null(new_aesthetics )) {
153+ return ()
154+ }
144155
145- # Add missing but required scales.
146- # @param aesthetics A character vector of aesthetics. Typically c("x", "y").
147- scales_add_missing <- function (plot , aesthetics , env ) {
156+ data_cols <- lapply(aesthetics [new_aesthetics ], eval_tidy , data = data )
157+ data_cols <- compact(data_cols )
148158
149- # Keep only aesthetics that aren't already in plot$scales
150- aesthetics <- setdiff(aesthetics , plot $ scales $ input())
159+ for (aes in names(data_cols )) {
160+ self $ add(find_scale(aes , data_cols [[aes ]], env ))
161+ }
162+ },
151163
152- for (aes in aesthetics ) {
153- scale_name <- paste(" scale" aes , " continuous" sep = " _"
164+ # Add missing but required scales
165+ # `aesthetics` is a character vector of aesthetics. Typically c("x", "y")
166+ add_missing = function (self , aesthetics , env ) {
167+ aesthetics <- setdiff(aesthetics , self $ input())
154168
155- scale_f <- find_global(scale_name , env , mode = " function"
156- plot $ scales $ add(scale_f())
169+ for (aes in aesthetics ) {
170+ scale_name <- paste(" scale" aes , " continuous" sep = " _"
171+ self $ add(find_global(scale_name , env , mode = " function"
172+ }
157173 }
158- }
159-
174+ )
160175
0 commit comments