| Title: | Create Datasets with Hidden Images in Residual Plots |
|---|---|
| Description: | Implements the "Residual (Sur)Realism" algorithm described by Stefanski (2007) <doi:10.1198/000313007X190079> to generate datasets that reveal hidden images or messages in their residual plots. It offers both predefined datasets and tools to embed custom text or images into residual structures. Allowing users to create intriguing visual demonstrations for teaching model diagnostics. |
| Authors: | James Joseph Balamuta [aut, cre, cph] (ORCID: <https://orcid.org/0000-0003-2826-8458>) |
| Maintainer: | James Joseph Balamuta <[email protected]> |
| License: | GPL (>= 3) |
| Version: | 0.0.3.9000 |
| Built: | 2026-10-09 21:10:05 UTC |
| Source: | https://github.com/coatless-rpkg/surreal |
This function transforms the input data by adding points around the original data to create a frame. It uses an optimization process to find the best alpha parameter for point distribution, which helps in making the fitted values and residuals orthogonal.
border_augmentation(x, y, n_add_points = 40, verbose = FALSE)border_augmentation(x, y, n_add_points = 40, verbose = FALSE)
x |
Numeric vector of x coordinates. |
y |
Numeric vector of y coordinates. |
n_add_points |
Integer. Number of points to add on each side of the frame. Default is |
verbose |
Logical. If |
A matrix with two columns representing the transformed x and y coordinates.
# Simulate data x <- rnorm(100) y <- rnorm(100) # Append border to data transformed_data <- border_augmentation(x, y) # Modify par settings for plotting side-by-side oldpar <- par(mfrow = c(1, 2)) # Graph original and transformed data plot(x, y, pch = 16, main = "Original data") plot( transformed_data[, 1], transformed_data[, 2], pch = 16, main = "Transformed data", xlab = 'x', ylab = 'y' ) # Restore original par settings par(oldpar)# Simulate data x <- rnorm(100) y <- rnorm(100) # Append border to data transformed_data <- border_augmentation(x, y) # Modify par settings for plotting side-by-side oldpar <- par(mfrow = c(1, 2)) # Graph original and transformed data plot(x, y, pch = 16, main = "Original data") plot( transformed_data[, 1], transformed_data[, 2], pch = 16, main = "Transformed data", xlab = 'x', ylab = 'y' ) # Restore original par settings par(oldpar)
Data set containing a hidden image of a Jack-o'-Lantern lurking in the residual plot of a full model being fit.
jackolantern_surreal_datajackolantern_surreal_data
A data frame with 5,395 observations and 7 variables.
y: Response variable
x1: Predictor variable 1
x2: Predictor variable 2
x3: Predictor variable 3
x4: Predictor variable 4
x5: Predictor variable 5
x6: Predictor variable 6
Stefanski, L.A. (2013). Hidden Images in the Helen Barton Lecture Series. Retrieved from https://www4.stat.ncsu.edu/~stefansk/NSF_Supported/Hidden_Images/UNCG_Helen_Barton_Lecture_Nov_2013/pumpkin_1_data_yx1x6.txt
# Load the Jack-o'-Lantern data data <- jackolantern_surreal_data # Fit a linear model to the surreal Jack-o'-Lantern data model <- lm(y ~ ., data = data) # Plot the residuals to reveal the hidden image plot(model$fitted, model$resid, type = "n", main = "Residual plot from transformed data") points(model$fitted, model$resid, pch = 16)# Load the Jack-o'-Lantern data data <- jackolantern_surreal_data # Fit a linear model to the surreal Jack-o'-Lantern data model <- lm(y ~ ., data = data) # Plot the residuals to reveal the hidden image plot(model$fitted, model$resid, type = "n", main = "Residual plot from transformed data") points(model$fitted, model$resid, pch = 16)
Draws one step of a selection recorded by surreal_path(), as a row of
panels: the share each step explained, the criterion along the path, and
the residual plot of the model at the step.
## S3 method for class 'surreal_path' plot(x, step = x$best, panels = c("explained", "criterion", "residuals"), ...)## S3 method for class 'surreal_path' plot(x, step = x$best, panels = c("explained", "criterion", "residuals"), ...)
x |
A |
step |
Integer. The step to draw, from 0 to the number of predictors. Default is the best step. |
panels |
Character. The panels to draw, in order, from |
... |
Further arguments passed to |
The panels are:
"explained": a bar for each step, on a log scale, for the share of the
variation left before the step that its predictor explained. A dotted
line marks the criterion's charge for a predictor: the least a step has
to explain for the criterion to fall. The bars above it are the steps
that improved the model.
"coefficients": the coefficient of every predictor along the path.
"criterion": the criterion along the path.
"residuals": the residual plot of the model at the step.
A solid violet line marks the step that is drawn, and a dashed green line the best step. A predictor is blue once it is in the model at the step, and gray until then. A decoy in the model is orange, when the path knows its decoys.
x, invisibly. Called for the plot it draws.
set.seed(114) hidden <- surreal(r_logo_image_data) path <- surreal_path(surreal_decoys(hidden, n = 20)) plot(path) plot(path, step = 25) # The coefficient paths, with the criterion beside them plot(path, panels = c("coefficients", "criterion"))set.seed(114) hidden <- surreal(r_logo_image_data) path <- surreal_path(surreal_decoys(hidden, n = 20)) plot(path) plot(path, step = 25) # The coefficient paths, with the criterion beside them plot(path, panels = c("coefficients", "criterion"))
Draws the picture as it stood at one iteration of a search recorded by
surreal_trace(), or the path the search took.
## S3 method for class 'surreal_trace' plot(x, iteration = nrow(x$iterations), type = c("picture", "trace"), ...)## S3 method for class 'surreal_trace' plot(x, iteration = nrow(x$iterations), type = c("picture", "trace"), ...)
x |
A |
iteration |
Integer. The iteration to draw, or to mark on the path. Default is the last one. |
type |
Character. |
... |
Further arguments passed to |
x, invisibly. Called for the plot it draws.
set.seed(114) trace <- surreal_trace(r_logo_image_data) plot(trace, iteration = 2) plot(trace, type = "trace")set.seed(114) trace <- surreal_trace(r_logo_image_data) plot(trace, iteration = 2) plot(trace, type = "trace")
2D data set with the shape of the R Logo in x and y coordinate pairings.
r_logo_image_datar_logo_image_data
A data frame with 2,000 observations and 2 variables describing the x and y coordinates of the R logo.
Staudenmayer, J. (2007). Hidden Images in R. Retrieved from https://www4.stat.ncsu.edu/~stefansk/NSF_Supported/Hidden_Images/000_R_Programs/John_Staudenmayer/logo.txt
# Load the R logo data data("r_logo_image_data", package = "surreal") # Plot the R logo plot(r_logo_image_data$x, r_logo_image_data$y, pch = 16, main = "R Logo", xlab = '', ylab = '')# Load the R logo data data("r_logo_image_data", package = "surreal") # Plot the R logo plot(r_logo_image_data$x, r_logo_image_data$y, pch = 16, main = "R Logo", xlab = '', ylab = '')
This function implements the Residual (Sur)Realism algorithm as described by Leonard A. Stefanski (2007). It finds a matrix X and vector y such that the fitted values and residuals of lm(y ~ X) are similar to the inputs y_hat and R_0.
surreal( data, y_hat = data[, 1], R_0 = data[, 2], R_squared = 0.3, p = 5, n_add_points = 40, max_iter = 100, tolerance = 0.01, verbose = FALSE )surreal( data, y_hat = data[, 1], R_0 = data[, 2], R_squared = 0.3, p = 5, n_add_points = 40, max_iter = 100, tolerance = 0.01, verbose = FALSE )
data |
A data frame or matrix with two columns representing the |
y_hat |
Numeric vector of desired fitted values (only used if |
R_0 |
Numeric vector of desired residuals (only used if |
R_squared |
Numeric. Desired R-squared value. Default is 0.3. |
p |
Integer. Desired number of columns for matrix X. Default is 5. |
n_add_points |
Integer. Number of points to add in border transformation. Default is 40. |
max_iter |
Integer. Maximum number of iterations for convergence. Default is 100. |
tolerance |
Numeric. Criteria for detecting convergence and stopping optimization early. Default is 0.01. |
verbose |
Logical. If TRUE, prints progress information. Default is FALSE. |
To disable the border augmentation, set n_add_points = 0.
A data frame containing the generated X matrix and y vector.
Stefanski, L. A. (2007). Residual (Sur)Realism. The American Statistician, 61(2), 163-177.
# Generate a 2D data set data <- cbind(y_hat = rnorm(100), R_0 = rnorm(100)) # Display original data plot(data, pch = 16, main = "Original data") # Apply the surreal method result <- surreal(data) # View the expanded data after transformation pairs(y ~ ., data = result, main = "Data after transformation") # Fit a linear model to the transformed data model <- lm(y ~ ., data = result) # Plot the residuals plot(model$fitted, model$resid, type = "n", main = "Residual plot from transformed data") points(model$fitted, model$resid, pch = 16)# Generate a 2D data set data <- cbind(y_hat = rnorm(100), R_0 = rnorm(100)) # Display original data plot(data, pch = 16, main = "Original data") # Apply the surreal method result <- surreal(data) # View the expanded data after transformation pairs(y ~ ., data = result, main = "Data after transformation") # Fit a linear model to the transformed data model <- lm(y ~ ., data = result) # Plot the residuals plot(model$fitted, model$resid, type = "n", main = "Residual plot from transformed data") points(model$fitted, model$resid, pch = 16)
Opens an interactive Shiny application for exploring the surreal algorithm. The app allows you to generate datasets with hidden images in residual plots using demo data, custom text, or uploaded images.
surreal_app(launch.browser = TRUE, port = NULL, host = "127.0.0.1")surreal_app(launch.browser = TRUE, port = NULL, host = "127.0.0.1")
launch.browser |
Logical. If |
port |
Integer. The port to run the app on. If |
host |
Character. The host address. Default is |
The app provides:
Demo datasets (Jack-o-Lantern, R Logo)
Custom text input to embed messages in residual plots
Image upload support (PNG, JPEG, BMP, TIFF, SVG)
Interactive controls for R², predictors, and image processing settings
Dark/light mode toggle
Data export to CSV
A Search tab that plays back the search that makes the data, one iteration at a time
A Selection tab that hides the image among decoy predictors and selects the real ones one step at a time
This function is called for its side effect of launching the Shiny app. It does not return a value.
The app requires the shiny and bslib packages to be installed. For image uploads, additional packages may be needed depending on the format:
JPEG: jpeg
BMP: bmp
TIFF: tiff
SVG: rsvg
surreal() for the core algorithm.
surreal_text() for embedding text programmatically.
surreal_image() for processing images programmatically.
surreal_trace() and surreal_path() for the functions behind the Search
and Selection tabs.
## Not run: # Launch the app in the default browser surreal_app() # Launch on a specific port surreal_app(port = 3838) # Get the app without launching browser surreal_app(launch.browser = FALSE) ## End(Not run)## Not run: # Launch the app in the default browser surreal_app() # Launch on a specific port surreal_app(port = 3838) # Get the app without launching browser surreal_app(launch.browser = FALSE) ## End(Not run)
This function adds predictors of pure noise to a dataset made by
surreal(). The hidden image then shows only in the residuals of the
model with the real predictors: leave some out and it is not there yet,
and let decoys in and it blurs. Finding it becomes a variable selection
problem, which surreal_path() works through step by step.
surreal_decoys(data, n = 30, sd = NULL, shuffle = TRUE)surreal_decoys(data, n = 30, sd = NULL, shuffle = TRUE)
data |
A data frame from |
n |
Integer. Number of decoy predictors to add. Default is 30. |
sd |
Numeric or |
shuffle |
Logical. If |
The data frame with n more columns. The names of the decoys are kept in
its "decoys" attribute, which is the answer key. The attribute is not
written out by write.csv().
surreal_path() to select the predictors one step at a time.
set.seed(114) hidden <- surreal(r_logo_image_data) # Mix in 30 decoys decoyed <- surreal_decoys(hidden) names(decoyed) # The answer key attr(decoyed, "decoys") # The model with every predictor no longer shows a clean image model <- lm(y ~ ., data = decoyed) plot(model$fitted, model$resid, pch = 16)set.seed(114) hidden <- surreal(r_logo_image_data) # Mix in 30 decoys decoyed <- surreal_decoys(hidden) names(decoyed) # The answer key attr(decoyed, "decoys") # The model with every predictor no longer shows a clean image model <- lm(y ~ ., data = decoyed) plot(model$fitted, model$resid, pch = 16)
This function loads an image file, extracts pixel coordinates based on a brightness threshold, and applies the surreal method to create a dataset where the image appears in the residual plot.
surreal_image( image_path, mode = "auto", threshold = NULL, max_points = NULL, invert_y = TRUE, R_squared = 0.3, p = 5, n_add_points = 40, max_iter = 100, tolerance = 0.01, verbose = FALSE )surreal_image( image_path, mode = "auto", threshold = NULL, max_points = NULL, invert_y = TRUE, R_squared = 0.3, p = 5, n_add_points = 40, max_iter = 100, tolerance = 0.01, verbose = FALSE )
image_path |
Character. Path to an image file or a URL (PNG, JPEG, BMP, TIFF, or SVG). |
mode |
Character. Either |
threshold |
Numeric or |
max_points |
Integer or |
invert_y |
Logical. If |
R_squared |
Numeric. Desired R-squared value. Default is 0.3. |
p |
Integer. Desired number of columns for matrix X. Default is 5. |
n_add_points |
Integer. Number of points to add in border transformation. Default is 40. |
max_iter |
Integer. Maximum number of iterations for convergence. Default is 100. |
tolerance |
Numeric. Criteria for detecting convergence and stopping optimization early. Default is 0.01. |
verbose |
Logical. If TRUE, prints progress information. Default is FALSE. |
By default, all parameters are automatically detected:
mode: Detected from image histogram (dark subject on light background or vice versa)
threshold: Calculated using Otsu's method to optimally separate foreground/background
max_points: Estimated based on image dimensions (2000-5000 points)
You can override any of these by specifying explicit values.
Input Support:
Local file paths
URLs (http:// or https://) - images are downloaded to a temporary file
Format Support:
PNG: Supported via the png package (included)
JPEG: Requires the jpeg package
BMP: Requires the bmp package
TIFF: Requires the tiff package
SVG: Requires the rsvg package (renders vector graphics to bitmap)
A data.frame containing the results of the surreal method
application with columns y, X1, X2, ..., Xp.
surreal() for details on the surreal method parameters.
surreal_text() for embedding text instead of images.
surreal_image_points() for the points of the image on their own.
## Not run: # Simplest usage - everything auto-detected result <- surreal_image("https://www.r-project.org/logo/Rlogo.png") model <- lm(y ~ ., data = result) plot(model$fitted, model$residuals, pch = 16) # Override specific parameters result <- surreal_image("image.png", mode = "dark", threshold = 0.3) # Use all points (no downsampling) result <- surreal_image("image.png", max_points = Inf) ## End(Not run)## Not run: # Simplest usage - everything auto-detected result <- surreal_image("https://www.r-project.org/logo/Rlogo.png") model <- lm(y ~ ., data = result) plot(model$fitted, model$residuals, pch = 16) # Override specific parameters result <- surreal_image("image.png", mode = "dark", threshold = 0.3) # Use all points (no downsampling) result <- surreal_image("image.png", max_points = Inf) ## End(Not run)
This function loads an image file and returns the position of every pixel
that passes a brightness threshold. These are the points that
surreal_image() hides. Getting them first lets you look at them, change
them, or combine them with other points before handing them to
surreal().
surreal_image_points( image_path, mode = "auto", threshold = NULL, max_points = NULL, invert_y = TRUE, verbose = FALSE )surreal_image_points( image_path, mode = "auto", threshold = NULL, max_points = NULL, invert_y = TRUE, verbose = FALSE )
image_path |
Character. Path to an image file or a URL (PNG, JPEG, BMP, TIFF, or SVG). |
mode |
Character. Either |
threshold |
Numeric or |
max_points |
Integer or |
invert_y |
Logical. If |
verbose |
Logical. If TRUE, prints progress information. Default is FALSE. |
The mode, the threshold and the number of points are chosen automatically
unless you set them, as described for surreal_image().
A data.frame with one row for each point of the image and two columns,
x and y.
surreal_image() to go from an image to a dataset in one step.
surreal_text_points() for the points of a text message.
## Not run: # The points of the R logo points <- surreal_image_points("https://www.r-project.org/logo/Rlogo.png") plot(points, pch = 16, asp = 1) # Hide them in a dataset, as surreal_image() does result <- surreal(points) ## End(Not run)## Not run: # The points of the R logo points <- surreal_image_points("https://www.r-project.org/logo/Rlogo.png") plot(points, pch = 16, asp = 1) # Hide them in a dataset, as surreal_image() does result <- surreal(points) ## End(Not run)
This function runs forward selection on a dataset made by surreal() and
keeps the model that stood at every step, so the selection can be plotted
or played back. It starts with no predictors and adds, at each step, the
one that explains most of what is left.
surreal_path(data, criterion = c("BIC", "AIC"))surreal_path(data, criterion = c("BIC", "AIC"))
data |
A data frame from |
criterion |
Character. The score that picks the best step, |
On data straight from surreal() every predictor is real, so the
criterion falls at each step and the hidden image appears at the last one.
With decoys from surreal_decoys() the criterion is lowest at the model
of the real predictors, where the image is clear, and rises as decoys
enter and blur it.
The criterion is computed as BIC() and
AIC() compute it for a linear model.
An object of class surreal_path, a list with:
A data frame with a row for each step, from 0 (no
predictors) to the number of predictors: the predictor that entered,
the criterion of the model and its r_squared.
A matrix with a row of coefficients for each step. A predictor that has not entered yet has a coefficient of 0.
Matrices with a column for each step.
The criterion that was used.
The step with the lowest criterion.
The names of the decoy predictors, when data came from
surreal_decoys().
The rows of coefficients and the columns of fitted and residuals are
named by step, so path$residuals[, "5"] holds the residuals at step 5.
surreal_decoys() to add the decoys that make this a real search.
set.seed(114) hidden <- surreal(r_logo_image_data) decoyed <- surreal_decoys(hidden, n = 20) path <- surreal_path(decoyed) path # The coefficient paths, the criterion and the residuals at the best step plot(path) # One step too early plot(path, step = path$best - 1)set.seed(114) hidden <- surreal(r_logo_image_data) decoyed <- surreal_decoys(hidden, n = 20) path <- surreal_path(decoyed) path # The coefficient paths, the criterion and the residuals at the best step plot(path) # One step too early plot(path, step = path$best - 1)
This function applies the surreal method to a text string. It first finds
the points that draw the text with surreal_text_points(), and then
applies the surreal method to them.
surreal_text( text = "hello world", cex = 4, R_squared = 0.3, p = 5, n_add_points = 40, max_iter = 100, tolerance = 0.01, verbose = FALSE )surreal_text( text = "hello world", cex = 4, R_squared = 0.3, p = 5, n_add_points = 40, max_iter = 100, tolerance = 0.01, verbose = FALSE )
text |
Character. A plain text message to be plotted. Default is "hello world". |
cex |
Numeric. A value specifying the relative size of the text. Default is 4. |
R_squared |
Numeric. Desired R-squared value. Default is 0.3. |
p |
Integer. Desired number of columns for matrix X. Default is 5. |
n_add_points |
Integer. Number of points to add in border transformation. Default is 40. |
max_iter |
Integer. Maximum number of iterations for convergence. Default is 100. |
tolerance |
Numeric. Criteria for detecting convergence and stopping optimization early. Default is 0.01. |
verbose |
Logical. If TRUE, prints progress information. Default is FALSE. |
A data.frame containing the results of the surreal method application.
surreal() for details on the surreal method parameters.
surreal_text_points() for the points of the text on their own.
# Create a surreal plot of the text "R is fun" appearing on one line r_is_fun_result <- surreal_text("R is fun", verbose = TRUE) # Create a surreal plot of the text "Statistics Rocks" by using an escape # character to create a second line between "Statistics" and "Rocks" stat_rocks_result <- surreal_text("Statistics\nRocks", verbose = TRUE)# Create a surreal plot of the text "R is fun" appearing on one line r_is_fun_result <- surreal_text("R is fun", verbose = TRUE) # Create a surreal plot of the text "Statistics Rocks" by using an escape # character to create a second line between "Statistics" and "Rocks" stat_rocks_result <- surreal_text("Statistics\nRocks", verbose = TRUE)
This function draws the text on a temporary bitmap and returns the position
of every pixel the text covers. These are the points that surreal_text()
hides. Getting them first lets you look at them, change them, or combine
them with other points before handing them to surreal().
surreal_text_points(text = "hello world", cex = 4)surreal_text_points(text = "hello world", cex = 4)
text |
Character. A plain text message to be plotted. Default is "hello world". |
cex |
Numeric. A value specifying the relative size of the text. Default is 4. |
A data.frame with one row for each point of the text and two columns,
x and y.
surreal_text() to go from text to a dataset in one step.
surreal_image_points() for the points of an image.
# The points that draw "R is fun" points <- surreal_text_points("R is fun") plot(points, pch = 16, asp = 1) # Hide them in a dataset, as surreal_text() does result <- surreal(points)# The points that draw "R is fun" points <- surreal_text_points("R is fun") plot(points, pch = 16, asp = 1) # Hide them in a dataset, as surreal_text() does result <- surreal(points)
This function runs the same search as surreal() and keeps what it had at
every iteration, so the search can be plotted or played back. The data it
ends on is the data surreal() returns for the same seed.
surreal_trace( data, y_hat = data[, 1], R_0 = data[, 2], R_squared = 0.3, p = 5, n_add_points = 40, max_iter = 100, tolerance = 0.01, step = 1 )surreal_trace( data, y_hat = data[, 1], R_0 = data[, 2], R_squared = 0.3, p = 5, n_add_points = 40, max_iter = 100, tolerance = 0.01, step = 1 )
data |
A data frame or matrix with two columns representing the |
y_hat |
Numeric vector of desired fitted values (only used if |
R_0 |
Numeric vector of desired residuals (only used if |
R_squared |
Numeric. Desired R-squared value. Default is 0.3. |
p |
Integer. Desired number of columns for matrix X. Default is 5. |
n_add_points |
Integer. Number of points to add in border transformation. Default is 40. |
max_iter |
Integer. Maximum number of iterations for convergence. Default is 100. |
tolerance |
Numeric. Criteria for detecting convergence and stopping optimization early. Default is 0.01. |
step |
Numeric. The fraction of its proposed update that each
iteration takes, from above 0 to 1. The default of 1 is the step
|
The search starts from random predictors. The picture's vertical positions, the residuals, are exact from the first iteration: the predictors are built to be unrelated to them. The search moves the fitted values, the picture's horizontal positions. Each iteration rebuilds one predictor so that the fitted values land on their targets, which shifts the model slightly, so the next iteration corrects again. With the default step this settles in a handful of iterations.
Plotting the fitted values of an iteration against the residuals shows the
picture as it stood then, which plot() does.
An object of class surreal_trace, a list with:
The data frame the search ended on.
A data frame with a row for each iteration: its number,
the change it proposed (what tolerance is compared with) and the
distance of the fitted values from their targets.
A matrix with a column of fitted values for each iteration.
The residuals, which are the same at every iteration.
The fitted values the search is aiming for.
The step that was used.
Whether the search stopped because the change fell below
tolerance, rather than running out of iterations.
surreal() for the method itself.
set.seed(114) trace <- surreal_trace(r_logo_image_data) trace # The picture at the first iteration, and where the search ended oldpar <- par(mfrow = c(1, 2)) plot(trace, iteration = 1) plot(trace) par(oldpar) # The distance of the fitted values from their targets, by iteration plot(trace, type = "trace") # A smaller step gives a longer search to watch set.seed(114) slow <- surreal_trace(r_logo_image_data, step = 0.25) nrow(slow$iterations)set.seed(114) trace <- surreal_trace(r_logo_image_data) trace # The picture at the first iteration, and where the search ended oldpar <- par(mfrow = c(1, 2)) plot(trace, iteration = 1) plot(trace) par(oldpar) # The distance of the fitted values from their targets, by iteration plot(trace, type = "trace") # A smaller step gives a longer search to watch set.seed(114) slow <- surreal_trace(r_logo_image_data, step = 0.25) nrow(slow$iterations)