いずれも koenderks/aRtsy からの抜粋
だって私たちは、これから、どこにだって行けるはず！
As the tidyverse becomes more mature, the places where the tidyverse team spends our innovation energy have started to change. Our mission is broad and we’re willing to go wherever this takes us, even if it’s into new areas that we know little about.1
Rcppを使ってシェーダー風のプログラムを書くことによって、Rのグラフィックデバイスで表示できる画像を生成する
#00ddeeffのようなRGBA値を32ビット符号なし整数に詰め込み、それらの配列によって1枚の画像を表現しているもの## 色（カラーコード）に対応する整数表現への変換はcolorfastやfarverでできる
colorfast::col_to_int(c("navy", "transparent", "#00ddeeff", "#fff"))
#> [1] -8388608 16777215 -1123072 -1
## `-8388608L`は"navy"なので、この値で埋めると、全てのピクセルが"navy"になる
rast <- rep_len(-8388608L, 360 * 640)
dim(rast) <- c(360, 640) # height, width
class(rast) <- "nativeRaster"
grid::grid.newpage()
grid::grid.raster(rast, interpolate = FALSE)
## nativeRasterを返すRcppの関数は
## nativeshadrを使うと、たとえば次のように書ける
Rcpp::sourceCpp(code = R"{
// [[Rcpp::depends(RcppParallel, nativeshadr)]]
#include <nativeshadr.h>
uint32_t gradient(int2 wh, RMatrix<int> nr, const vvd& uniforms) {
float2 uv = float2(wh) / float2(nr.ncol(), nr.nrow());
float4 col = float4(uv.x, uv.y, .6, 1);
return int4_to_icol(clamp(col * 255, 0, 255));
}
// [[Rcpp::export]]
Rcpp::IntegerVector test_gradient(Rcpp::IntegerMatrix nr) {
const vvd uniforms;
return vectorize_shader(gradient)(nr, uniforms);
}
}")GLSLの書き方は環境によって異なるが、ここではglsl-canvasを想定している
uniform）を受け取って、それらに応じて正規化されたRGBA値を返すような関数
vec4みたいなベクトル型の定義と、ベクトルの要素に便利にアクセスするためのswizzleと呼ばれる記法をそなえている/**
* 次の記事で書かれているHLSLシェーダーを元に作成した
* <https://sayachang-bot.hateblo.jp/entry/2019/12/11/231351>
*/
// [[Rcpp::depends(RcppParallel, nativeshadr)]]
#include <nativeshadr.h>
float2 barrel(float2 uv) {
float s1 = .99, s2 = .125;
float2 centre = 2. * uv - 1.;
float barrel = min(1.0 - length(centre) * s1, float1(1.0)) * s2;
return uv - centre * barrel;
}
float2 CRT(float2 uv) {
float2 nu = uv * 2. - 1.;
float2 offset = abs(nu.yx) / float2(6., 4.);
nu += nu * offset * offset;
return nu;
}
float Scanline(float2 uv, double iTime) {
float scanline =
clamp(0.95 + 0.05 * cos(3.14 * (uv.y + 0.008 * floor(iTime * 15.) / 15.) *
240.0 * 1.0),
0.0, 1.0);
float grille =
0.85 + 0.15 * clamp(1.5 * cos(3.14 * uv.x * 640.0 * 1.0), 0.0, 1.0);
return scanline * grille * 1.2;
}
float4 frag(int2 wh, RMatrix<int> nr, const vvd& uniforms) {
const std::vector<double>& iTime = uniforms[0];
float2 i = float2(wh) / float2(nr.ncol(), nr.nrow());
// barrel distortion
float2 p = barrel(i.xy);
float4 col = float4(texture_eval(nr, wh)) / 255.0;
// color grading
col.rgb *= float3(1.25, 0.95, 0.7);
col.rgb = clamp(col.rgb, 0.0, 1.0);
col.rgb = col.rgb * col.rgb * (3.0 - 2.0 * col.rgb);
col.rgb = 0.5 + 0.5 * col.rgb;
// scanline
col.rgb *= Scanline(i.xy, iTime[0]);
// crt monitor
float2 crt = CRT(i.xy);
crt = abs(crt);
crt = pow(crt, 15.);
col.rgb = lerp(col.rgb, float1(.0).xxx, (crt.x + crt.y).xxx);
// gammma correction
col.rgb = pow(col.rgb, float1(.4545).xxx);
return col;
}
uint32_t shader(int2 wh, RMatrix<int> nr, const vvd& uniforms) {
return int4_to_icol(frag(wh, nr, uniforms) * 255.0);
}
// [[Rcpp::export]]
Rcpp::IntegerVector test_retro(Rcpp::IntegerMatrix nr, Rcpp::List uni) {
const std::vector<double>& iTime = uni["iTime"];
const vvd uniforms = {iTime};
return vectorize_shader(shader)(nr, uniforms);
}## nativeRasterのブレンドをするのに paithiov909/aznyan を使っている
library(ggplot2)
cap <- ragg::agg_capture(width = 480, height = 360)
gp <-
ggplot(mtcars, aes(x = wt, y = mpg, colour = cyl)) +
geom_point(size = 8) +
theme_dark() +
scale_color_viridis_c(option = "viridis")
print(gp)
rast <- cap(native = TRUE)
dev.off()
Rcpp::sourceCpp("shader/retro.cpp")
gifski::save_gif(
{
for (time in seq_len(200)) {
fd <- test_retro(rast, list(iTime = time))
grid::grid.newpage()
grid::grid.raster(aznyan::blend_hardlight(fd, rast), interpolate = FALSE)
}
},
gif_file = "anim-retro-ggplot.gif",
width = 480,
height = 360,
delay = 1 / 25,
progress = TRUE
)/**
* Based on <https://github.com/prontopablo/FIP/blob/main/data/ripple.glsl>
*/
// [[Rcpp::depends(RcppParallel, nativeshadr)]]
#include <nativeshadr.h>
float4 frag(int2 wh, RMatrix<int> nr, float freq, float amp, float2 offset) {
float2 iResolution = float2(nr.ncol(), nr.nrow());
float2 uv = float2(wh) / iResolution;
// Center coordinates of the screen with offset
float2 center = (iResolution / 2.0 + offset) / iResolution;
// Calculate the distance from the current pixel to the center
float distance = length(uv - center);
// Calculate the ripple effect using sine function with parameters
float ripple = sin(distance * freq) * amp;
// Offset the texture coordinate based on the ripple effect
float2 tc = (uv + ripple) * iResolution;
if (tc.x > iResolution.x || tc.y > iResolution.y || tc.x < 0.0 || tc.y < 0.0) {
return float4(0.0, 0.0, 0.0, 0.0);
}
float4 color = float4(texture_eval(nr, tc)) / 255.0;
return color;
}
uint32_t shader(int2 wh, RMatrix<int> nr, const vvd& uniforms) {
return int4_to_icol(frag(wh, nr, uniforms[0][0], uniforms[1][0], float2(uniforms[2][0], uniforms[2][1])) * 255.0);
}
// [[Rcpp::export]]
Rcpp::IntegerVector test_ripple(Rcpp::IntegerMatrix nr, Rcpp::List uni) {
const std::vector<double>& freq = uni["freq"];
const std::vector<double>& amp = uni["amp"];
const std::vector<double>& offset = uni["offset"];
const vvd uniforms = {freq, amp, offset};
return vectorize_shader(shader)(nr, uniforms);
}library(ggplot2)
library(ggfx)
Rcpp::sourceCpp("shader/ripple.cpp")
ripple <- \(x, freq = 64.0, amp = .01, offset = c(0, 0)) {
vp <- get_viewport_area(x)
vp <- test_ripple(vp, list(freq = freq, amp = amp, offset = offset))
set_viewport_area(x, vp)
}
ggplot(mtcars, aes(x = factor(gear), y = disp)) +
with_custom(
geom_boxplot(aes(fill = as.factor(gear))),
filter = ripple
) +
labs(title = "ggfxでレイヤーにエフェクトをかけたグラフ")
/**
* 次のGLSLSandboxからの移植
* <https://glslsandbox.com/e#109628.0>
*/
// [[Rcpp::depends(RcppParallel, nativeshadr)]]
#include <nativeshadr.h>
static const int iterations = 14;
static const float formuparam2 = 0.79;
static const int volsteps = 5;
static const float stepsize = 0.390;
static const float zoom = 0.900;
static const float tile = 0.850;
static const float speed2 = 0.0;
static const float brightness = 0.003;
static const float darkmatter = 0.400;
static const float distfading = 0.560;
static const float saturation = 0.800;
static const float transverseSpeed = zoom * 2.0;
static const float cloud = 0.11;
float triangle(float x, float a) {
float output2 = 2.0 * abs(2.0 * ((x / a) - floor((x / a) + 0.5))) - 1.0;
return output2;
}
float field(float3 p, float time) {
float strength = 7. + .03 * log(1.e-6 + frac(sin(time) * float1(4373.11)));
float accum = 0.;
float prev = 0.;
float tw = 0.;
// for (int i = 0; i < 1; ++i) {
float mag = dot(p, p);
p = abs(p) / mag + float3(-.5, -.8 + 0.1 * sin(time * 0.7 + 2.0),
-1.1 + 0.3 * cos(time * 0.3));
float w = exp(-float(0) / 7.);
accum += w * exp(-strength * pow(abs(mag - prev), 2.3));
tw += w;
prev = mag;
// }
return max(0., 5. * accum / tw - .7);
}
float4 traverse(int2 wh, RMatrix<int> nr, const vvd& uniforms) {
float2 uv2 = 2. * float2(wh) / float2(512) - 1.;
float2 uvs = uv2 * float2(512) / 512.;
const std::vector<double>& iTime = uniforms[0];
float time = iTime[0];
float time2 = time;
float speed = speed2;
speed = .01 * cos(time2 * 0.02 + 3.1415926 / 4.0);
float formuparam = formuparam2;
float2 uv = uvs;
float a_xz = 0.9;
float a_yz = -.6;
float a_xy = 0.9 + time * 0.08;
float2x2 rot_xz = float2x2(cos(a_xz), sin(a_xz), -sin(a_xz), cos(a_xz));
float2x2 rot_yz = float2x2(cos(a_yz), sin(a_yz), -sin(a_yz), cos(a_yz));
float2x2 rot_xy = float2x2(cos(a_xy), sin(a_xy), -sin(a_xy), cos(a_xy));
float v2 = 1.0;
float2 mouse = float2(sin(time) / 48., cos(time) / 48.);
float3 dir = float3(uv * zoom, 1.);
float3 from = float3(0.0, 0.0, 0.0);
from.x -= 5.0 * (mouse.x - 0.5);
from.y -= 5.0 * (mouse.y - 0.5);
float3 forward = float3(0., 0., 1.);
from.x += transverseSpeed * (1.0) * cos(0.01 * time) + 0.001 * time;
from.y += transverseSpeed * (1.0) * sin(0.01 * time) + 0.001 * time;
from.z += 0.003 * time;
dir.xy = mul(dir.xy, rot_xy); // dir.xy *= rot_xy;
forward.xy = mul(forward.xy, rot_xy); // forward.xy *= rot_xy;
dir.xz = mul(dir.xz, rot_xz); // dir.xz *= rot_xz;
forward.xz = mul(forward.xz, rot_xz); // forward.xz *= rot_xz;
dir.yz = mul(dir.yz, rot_yz); // dir.yz *= rot_yz;
forward.yz = mul(forward.yz, rot_yz); // forward.yz *= rot_yz;
from.xy = mul(from.xy, -rot_xy); // from.xy *= -rot_xy;
from.xz = mul(from.xz, rot_xz); // from.xz *= rot_xz;
from.yz = mul(from.yz, rot_yz); // from.yz *= rot_yz;
float zooom = (time2 - 3311.) * speed;
from += forward * zooom;
float sampleShift = fmod(zooom, stepsize);
float zoffset = -sampleShift;
sampleShift /= stepsize;
float s = 0.24;
float s3 = s + stepsize / 2.0;
float3 v = float3(0.);
float t3 = 0.0;
float3 backCol2 = float3(0.);
for (int r = 0; r < volsteps; r++) {
float3 p2 = from + (s + zoffset) * dir;
float3 p3 = from + (s3 + zoffset) * dir;
p2 = abs(float3(tile) - fmod(p2, float3(tile * 2.)));
p3 = abs(float3(tile) - fmod(p3, float3(tile * 2.)));
// #ifdef cloud
t3 = field(p3, time);
// #endif
float pa, a = pa = 0.;
for (int i = 0; i < iterations; i++) {
p2 = abs(p2) / dot(p2, p2) - formuparam;
float D = abs(length(p2) - pa);
a += i > 7 ? min(12., D) : D;
pa = length(p2);
}
a *= a * a;
float s1 = s + zoffset;
float fade = pow(distfading, max(0., float(r) - sampleShift));
v += fade;
if (r == 0) {
fade *= (1. - (sampleShift));
}
if (r == volsteps - 1) {
fade *= sampleShift;
}
v += float3(s1, s1 * s1, s1 * s1 * s1 * s1) * a * brightness * fade;
backCol2 += lerp(float1(.11), float1(1.), v2) *
float3(1.8 * t3 * t3 * t3, 1.4 * t3 * t3, t3) * fade;
s += stepsize;
s3 += stepsize;
}
v = lerp(float3(length(v)), v, saturation);
float4 forCol2 = float4(v * .01, 1.);
// #ifdef cloud
backCol2 *= cloud;
// #endif
backCol2.b *= 1.8;
backCol2.r *= 0.05;
backCol2.b = 0.5 * lerp(backCol2.g, backCol2.b, 0.8);
backCol2.g = 0.0;
backCol2.bg = lerp(backCol2.gb, backCol2.bg, 0.5 * (cos(time * 0.01) + 1.0));
forCol2 + float4(backCol2, 1.0);
return forCol2;
}
uint32_t shader(int2 wh, RMatrix<int> nr, const vvd& uniforms) {
float4 col = clamp(traverse(wh, nr, uniforms), 0.0, 1.0);
return int4_to_icol(col * 255.0);
}
// [[Rcpp::export]]
Rcpp::IntegerVector test_traverse(Rcpp::IntegerMatrix nr, Rcpp::List uni) {
const std::vector<double>& iTime = uni["iTime"];
const vvd uniforms = {iTime};
return vectorize_shader(shader)(nr, uniforms);
}library(nativeshadr)
Rcpp::sourceCpp("shader/traverse.cpp")
gifski::save_gif(
{
for (time in seq(3 * pi, 8 * pi, by = .0314)) {
img <- test_traverse(nr_new(640, 360, "white"), list(iTime = time))
grid::grid.newpage()
grid::grid.raster(img, interpolate = FALSE)
}
},
gif_file = "anim-traverse.gif",
width = 640,
height = 360,
delay = 1 / 30,
progress = TRUE
)