2013-03-13 4 views
5

Кто-нибудь знает, как создать симуляторный растровый набор данных высоты - т. Е. 2d-матрицу реалистичных значений высоты - в R? R's jitter не подходит. В Java/Обработка функции noise() достигает этого с Perlin noise алгоритм например .:Реалистичные симулированные данные о высоте в шумах R/Perlin

size(200, 200); 
float ns = 0.03; // for scaling 
for (float i=0; i<200; i++) { 
    for (float j=0; j<200; j++) { 
    stroke(noise(i*ns, j*ns) * 255); 
    point(i, j); 
    } 
} 

enter image description here

Но я не нашел никаких упоминаний Перлин шума в R литературе. Заранее спасибо.

+1

см либо пакет 'RandomFields' (методы для моделирования широкого разнообразие гауссовских побегов dom) или, возможно, фрактальная поверхность: http://www.oceanographerschoice.com/2010/10/fractal-landscapes-in-r-part-two/ (для этого у меня есть старый код) –

+0

Быстрый поиск [ выдает код C++] (http://www.dreamincode.net/forums/topic/66480-perlin-noise/), который не следует слишком сложно настроить. Вы можете использовать 'Rcpp', чтобы использовать его напрямую или перевести его на R. – Roland

+0

Спасибо, Бен, Роланд. Блог Oceanograherschoice, как полезная вещь, чтобы попробовать в какой-то момент, когда у меня есть время, а также изучение C++. – geotheory

ответ

10

Вот реализация в R, следующие объяснения в http://webstaff.itn.liu.se/~stegu/TNM022-2005/perlinnoiselinks/perlin-noise-math-faq.html

perlin_noise <- function( 
    n = 5, m = 7, # Size of the grid for the vector field 
    N = 100, M = 100 # Dimension of the image 
) { 
    # For each point on this n*m grid, choose a unit 1 vector 
    vector_field <- apply(
    array(rnorm(2 * n * m), dim = c(2,n,m)), 
    2:3, 
    function(u) u/sqrt(sum(u^2)) 
) 
    f <- function(x,y) { 
    # Find the grid cell in which the point (x,y) is 
    i <- floor(x) 
    j <- floor(y) 
    stopifnot(i >= 1 || j >= 1 || i < n || j < m) 
    # The 4 vectors, from the vector field, at the vertices of the square 
    v1 <- vector_field[,i,j] 
    v2 <- vector_field[,i+1,j] 
    v3 <- vector_field[,i,j+1] 
    v4 <- vector_field[,i+1,j+1] 
    # Vectors from the point to the vertices 
    u1 <- c(x,y) - c(i,j) 
    u2 <- c(x,y) - c(i+1,j) 
    u3 <- c(x,y) - c(i,j+1) 
    u4 <- c(x,y) - c(i+1,j+1) 
    # Scalar products 
    a1 <- sum(v1 * u1) 
    a2 <- sum(v2 * u2) 
    a3 <- sum(v3 * u3) 
    a4 <- sum(v4 * u4) 
    # Weighted average of the scalar products 
    s <- function(p) 3 * p^2 - 2 * p^3 
    p <- s(x - i) 
    q <- s(y - j) 
    b1 <- (1-p)*a1 + p*a2 
    b2 <- (1-p)*a3 + p*a4 
    (1-q) * b1 + q * b2 
    } 
    xs <- seq(from = 1, to = n, length = N+1)[-(N+1)] 
    ys <- seq(from = 1, to = m, length = M+1)[-(M+1)] 
    outer(xs, ys, Vectorize(f)) 
} 

image(perlin_noise()) 

Perlin noise

Вы можете иметь более фрактальную структуру, добавляя эти матрицы, с различными размерами сетки.

a <- .6 
k <- 8 
m <- perlin_noise(2,2,2^k,2^k) 
for(i in 2:k) 
    m <- m + a^i * perlin_noise(2^i,2^i,2^k,2^k) 
image(m) 
m[] <- rank(m) # Histogram equalization 
image(m) 

Perlin noise, Sum with different grid sizes

+0

Spot on Vincent :) Я провел пару часов, пробираясь через другие реализации - этот код намного более изящный, чем у меня получилось! Вы знаете, кто заслуживает приписывания при необходимости? – geotheory

+0

Спасибо также за редактирование. Я заинтригован повторяющимися бликами, где «высокие» и «крайние точки» соседствуют друг с другом. Модель кажется идеальной в стороне от этих точек. – geotheory

+2

Этот артефакт был вызван отсутствием 'sqrt' при нормализации векторов; Я исправил его и обновил графики соответственно. –

0

Альтернативный метод:

require(geoR) 
sim <- grf(441, grid="reg", cov.pars=c(1, .25)) 
image(sim, col=gray(seq(1, .1, l=30))) 

enter image description here

Может извлекать данные объекта с cbind(sim[[1]], z = sim[[2]])