統計解析R たぶんpart3くらい

統計解析R たぶんpart3くらい (587ﾚｽ)
上下前次1-新
通常表示 512ﾊﾞｲﾄ分割ﾚｽ栞
抽出解除ﾚｽ栞

279: デフォルトの名無しさん [] 2019/06/09(日) 01:59:10.30 ID:wNZZZJ2C

青の分布を赤の分布に連続的に変形させる [so-2]{#so-2}

``` {r}
big_data = with (c (big_data, nx = 2e+3, nt = 1e+3, alim = 2, blim = 4), {
vec = function (x, t) { (Pa (x) - Pb (x)) / ((1 - t) * pa (x) + t * pb (x));
}; t = seq (0, 1, len = nt); dt = diff (t) %>% mean; x = ra (nx); x = x0 =
x [which (abs (x) <= alim)]; x = purrr::map (t, function (t) { x <<- x +
dt * vec (x, t); }) %>% do.call (what = rbind); draw = function (t, x,
nbin = 20 , vector = null) { xlim = range (x, na.rm = true); plot ( xlim,
range (t), type = 'n', main = 'trajectories', xlab = 'x', ylab = 't');
purrr::map ( sample (1 : ncol (x), 50), function (j) { x = x [, j]; if (
all ( is.finite (x))) { lines (x, t); } else { points (x, t); }; }); if (
is.function (vector)) { no_plot (); }; doit = function (ind) { t = t [ind];
x = x [ind, ]; if (is.null (nbin)) { nbin = 'scott'; }; msg = sprintf (
'at the time %.1e', t); msg = c (msg, sprintf ('%d / %d', sum ( xlim [1] <=
abs (x) & abs (x) <= xlim [2], na.rm = true), size (x))); hist (x, breaks =
nbin, freq = false, xlim = xlim, main = msg); x = seq ( xlim [1], xlim [2],
len = 1e+3);
# lines (x, pa (x), col = 'blue');
lines (x, pb (x), col = 'red'); if (is.function (vector)) { x = seq (min (
xlim), max (xlim), len = 1e+5); plot (x, vector (t, x) %>% abs (), type =
'l', log = 'y', main = msg); }; }; for (i in c (1, size (t) / 2, size (
t))) { doit (i); } }; x = rbind (x0, x [- nrow (x), ]); x [which (blim <
abs (x))] = na; fix_bin = function (x, lim) { max (sum (abs (x [nrow (x)
, ]) <= lim , na.rm = true) / 50, 10) %>% as.integer (); }; draw (t, x
, nbin = fix_bin (x, blim), vector = vec); add (big_data, x0 = x0, t = t
, dt = dt , nt = nt, nx = nx, vec = vec, draw = draw, fix_bin = fix_bin
, alim = alim, blim = blim);});
```

http://mevius.5ch.net/test/read.cgi/tech/1340339592/279

284: デフォルトの名無しさん [] 2019/06/30(日) 21:38:18.30 ID:6iFXy6Q7

DFT行列のチェックのバグ修正+testthat+lenses

``` {r}
with (c (big_data, n = 17, N = 1e+3, get = lenses::view, set = lenses::set), {
`%.%` = function (f, g) function (x) f (g (x));
values_l = lenses::index ('values');
square = function (a) (t %.% Conj) (a) %*% a;
out = outer (1 : n, 1 : n, function (i, j) {
ij = (i * j) %% n;
k = pracma::gcd (ij, n);
angle = 2 * pi * (ij %/% k) / (n %/% k);
complex (re = cos (angle), im = sin (angle));
});
testthat::test_that ('dft', {
# testthat::expect_equal (square (out), n * pracma::eye (n));
testthat::expect_equal ((Re %.% square) (out), n * pracma::eye (n));
testthat::expect_equal ((Im %.% square) (out), pracma::zeros (n));
});
k = (n - 2) : 2;
out = purrr::map (k, function (k) {
purrr::map (1 : N, function (.) {
out = out [sample.int (n, k), sample.int (n, k)];
out = eigen (out, only = true) %>% get (values_l);
(sum %.% log) (out) - 1 / 2 * log (k);
}) %>% get (lenses::unlist_l);
}) %>% set (lenses::names_l, k);
testthat::test_that ('det', purrr::map (out, function (out) {
testthat::expect_true ((all %.% is.finite) (out));
}));
purrr::map (out, Re) %>% ggwaterfall::waterfall_ft (show.labels = true);
});
```

http://mevius.5ch.net/test/read.cgi/tech/1340339592/284

上下前次1-新書関写板覧索設栞歴

ｽﾚ情報赤ﾚｽ抽出画像ﾚｽ抽出歴の未読ｽﾚ AAｻﾑﾈｲﾙ

ぬこの手ぬこTOP 0.021s