Perlin noise
The Perlin noise is a kind of gradient noise invented by Ken Perlin around the end of the twentieth century and still currently heavily used in computer graphics, most notably to proceduraly generate textures or heightmaps. The Perlin noise is basically a pseudo-random mapping of into with an integer which can be arbitrary large but which is usually 2, 3 or 4.
Either by using a dedicated library or by implementing the algorithm, show that the Perlin noise (as defined in 2002 in the java implementation below) of the point in 3D-space with coordinates 3.14, 42, 7 is 0.13691995878400012.
Java
The original code from Perlin was originally published in java. <lang java>// JAVA REFERENCE IMPLEMENTATION OF IMPROVED NOISE - COPYRIGHT 2002 KEN PERLIN.
public final class ImprovedNoise {
static public double noise(double x, double y, double z) {
int X = (int)Math.floor(x) & 255, // FIND UNIT CUBE THAT
Y = (int)Math.floor(y) & 255, // CONTAINS POINT.
Z = (int)Math.floor(z) & 255;
x -= Math.floor(x); // FIND RELATIVE X,Y,Z
y -= Math.floor(y); // OF POINT IN CUBE.
z -= Math.floor(z);
double u = fade(x), // COMPUTE FADE CURVES
v = fade(y), // FOR EACH OF X,Y,Z.
w = fade(z);
int A = p[X ]+Y, AA = p[A]+Z, AB = p[A+1]+Z, // HASH COORDINATES OF
B = p[X+1]+Y, BA = p[B]+Z, BB = p[B+1]+Z; // THE 8 CUBE CORNERS,
return lerp(w, lerp(v, lerp(u, grad(p[AA ], x , y , z ), // AND ADD
grad(p[BA ], x-1, y , z )), // BLENDED
lerp(u, grad(p[AB ], x , y-1, z ), // RESULTS
grad(p[BB ], x-1, y-1, z ))),// FROM 8
lerp(v, lerp(u, grad(p[AA+1], x , y , z-1 ), // CORNERS
grad(p[BA+1], x-1, y , z-1 )), // OF CUBE
lerp(u, grad(p[AB+1], x , y-1, z-1 ),
grad(p[BB+1], x-1, y-1, z-1 ))));
}
static double fade(double t) { return t * t * t * (t * (t * 6 - 15) + 10); }
static double lerp(double t, double a, double b) { return a + t * (b - a); }
static double grad(int hash, double x, double y, double z) {
int h = hash & 15; // CONVERT LO 4 BITS OF HASH CODE
double u = h<8 ? x : y, // INTO 12 GRADIENT DIRECTIONS.
v = h<4 ? y : h==12||h==14 ? x : z;
return ((h&1) == 0 ? u : -u) + ((h&2) == 0 ? v : -v);
}
static final int p[] = new int[512], permutation[] = { 151,160,137,91,90,15,
131,13,201,95,96,53,194,233,7,225,140,36,103,30,69,142,8,99,37,240,21,10,23,
190, 6,148,247,120,234,75,0,26,197,62,94,252,219,203,117,35,11,32,57,177,33,
88,237,149,56,87,174,20,125,136,171,168, 68,175,74,165,71,134,139,48,27,166,
77,146,158,231,83,111,229,122,60,211,133,230,220,105,92,41,55,46,245,40,244,
102,143,54, 65,25,63,161, 1,216,80,73,209,76,132,187,208, 89,18,169,200,196,
135,130,116,188,159,86,164,100,109,198,173,186, 3,64,52,217,226,250,124,123,
5,202,38,147,118,126,255,82,85,212,207,206,59,227,47,16,58,17,182,189,28,42,
223,183,170,213,119,248,152, 2,44,154,163, 70,221,153,101,155,167, 43,172,9,
129,22,39,253, 19,98,108,110,79,113,224,232,178,185, 112,104,218,246,97,228,
251,34,242,193,238,210,144,12,191,179,162,241, 81,51,145,235,249,14,239,107,
49,192,214, 31,181,199,106,157,184, 84,204,176,115,121,50,45,127, 4,150,254,
138,236,205,93,222,114,67,29,24,72,243,141,128,195,78,66,215,61,156,180
};
static { for (int i=0; i < 256 ; i++) p[256+i] = p[i] = permutation[i]; }
}</lang>
Perl
<lang perl>use strict; use warnings;
use constant permutation => qw{ 151 160 137 91 90 15 131 13 201 95 96 53 194 233 7 225 140 36 103 30 69 142 8 99 37 240 21 10 23 190 6 148 247 120 234 75 0 26 197 62 94 252 219 203 117 35 11 32 57 177 33 88 237 149 56 87 174 20 125 136 171 168 68 175 74 165 71 134 139 48 27 166 77 146 158 231 83 111 229 122 60 211 133 230 220 105 92 41 55 46 245 40 244 102 143 54 65 25 63 161 1 216 80 73 209 76 132 187 208 89 18 169 200 196 135 130 116 188 159 86 164 100 109 198 173 186 3 64 52 217 226 250 124 123 5 202 38 147 118 126 255 82 85 212 207 206 59 227 47 16 58 17 182 189 28 42 223 183 170 213 119 248 152 2 44 154 163 70 221 153 101 155 167 43 172 9 129 22 39 253 19 98 108 110 79 113 224 232 178 185 112 104 218 246 97 228 251 34 242 193 238 210 144 12 191 179 162 241 81 51 145 235 249 14 239 107 49 192 214 31 181 199 106 157 184 84 204 176 115 121 50 45 127 4 150 254 138 236 205 93 222 114 67 29 24 72 243 141 128 195 78 66 215 61 156 180 }; use constant p => (permutation, permutation);
sub floor {
my $x = shift; my $xi = int($x); return $x < $xi ? $xi - 1 : $xi;
}
sub fade { $_ = shift; $_ * $_ * $_ * ($_ * ($_ * 6 - 15) + 10) } sub lerp { $_[1] + $_[0] * ($_[2] - $_[1]) } sub grad {
my ($h, $x, $y, $z) = @_[0..3]; $h &= 15; my $u = $h < 8 ? $x : $y; my $v = $h < 4 ? $y : $h == 12 || $h == 14 ? $x : $z; return (($h & 1) == 0 ? $u : -$u) + (($h & 2) == 0 ? $v : -$v);
}
sub noise {
my ($X, $Y, $Z) = map { floor($_) & 255 }
my ($x, $y, $z) = @_[0,1,2];
my ($u, $v, $w) = map { fade($_) }
$x -= $X, $y -= $Y, $z -= $Z;
my $A = (p)[$X] + $Y;
my ($AA, $AB) = ( (p)[$A] + $Z, (p)[$A + 1] + $Z );
my $B = (p)[$X + 1] + $Y;
my ($BA, $BB) = ( (p)[$B] + $Z, (p)[$B + 1] + $Z );
lerp($w, lerp($v, lerp($u,
grad( (p)[$AA], $x, $y, $z ), grad( (p)[$BA], $x - 1, $y, $z ) ), lerp($u, grad( (p)[$AB], $x, $y - 1, $z ), grad( (p)[$BB], $x - 1, $y - 1, $z ) ) ), lerp($v, lerp($u, grad((p)[$AA + 1], $x, $y, $z - 1 ), grad((p)[$BA + 1], $x - 1, $y, $z - 1 )), lerp($u, grad((p)[$AB + 1], $x, $y - 1, $z - 1 ), grad((p)[$BB + 1], $x - 1, $y - 1, $z - 1 )) )
);
}
print noise 3.14, 42, 7;</lang>
- Output:
0.136919958784
Perl 6
<lang perl6>constant @permutation = < 151 160 137 91 90 15 131 13 201 95 96 53 194 233 7 225 140 36 103 30 69 142 8 99 37 240 21 10 23 190 6 148 247 120 234 75 0 26 197 62 94 252 219 203 117 35 11 32 57 177 33 88 237 149 56 87 174 20 125 136 171 168 68 175 74 165 71 134 139 48 27 166 77 146 158 231 83 111 229 122 60 211 133 230 220 105 92 41 55 46 245 40 244 102 143 54 65 25 63 161 1 216 80 73 209 76 132 187 208 89 18 169 200 196 135 130 116 188 159 86 164 100 109 198 173 186 3 64 52 217 226 250 124 123 5 202 38 147 118 126 255 82 85 212 207 206 59 227 47 16 58 17 182 189 28 42 223 183 170 213 119 248 152 2 44 154 163 70 221 153 101 155 167 43 172 9 129 22 39 253 19 98 108 110 79 113 224 232 178 185 112 104 218 246 97 228 251 34 242 193 238 210 144 12 191 179 162 241 81 51 145 235 249 14 239 107 49 192 214 31 181 199 106 157 184 84 204 176 115 121 50 45 127 4 150 254 138 236 205 93 222 114 67 29 24 72 243 141 128 195 78 66 215 61 156 180 >; constant @p = flat @permutation xx 2;
sub fade($_) { $_ * $_ * $_ * ($_ * ($_ * 6 - 15) + 10) } sub lerp($t, $a, $b) { $a + $t * ($b - $a) } sub grad($h is copy, $x, $y, $z) {
$h +&= 15; my $u = $h < 8 ?? $x !! $y; my $v = $h < 4 ?? $y !! $h == 12|14 ?? $x !! $z; (($h +& 1) == 0 ?? $u !! -$u) + (($h +& 2) == 0 ?? $v !! -$v);
}
sub noise($x is copy, $y is copy, $z is copy) {
my ($X, $Y, $Z) = ($x, $y, $z)».floor »+&» 255; my ($u, $v, $w) = map &fade, $x -= $X, $y -= $Y, $z -= $Z; my $A = @p[$X] + $Y; my ($AA, $AB) = ( @p[$A] + $Z, @p[$A + 1] + $Z ); my $B = @p[$X + 1] + $Y; my ($BA, $BB) = ( @p[$B] + $Z, @p[$B + 1] + $Z ); lerp($w, lerp($v, lerp($u,
grad( @p[$AA], $x, $y, $z ), grad( @p[$BA], $x - 1, $y, $z ) ), lerp($u, grad( @p[$AB], $x, $y - 1, $z ), grad( @p[$BB], $x - 1, $y - 1, $z ) ) ), lerp($v, lerp($u, grad(@p[$AA + 1], $x, $y, $z - 1 ), grad(@p[$BA + 1], $x - 1, $y, $z - 1 )), lerp($u, grad(@p[$AB + 1], $x, $y - 1, $z - 1 ), grad(@p[$BB + 1], $x - 1, $y - 1, $z - 1 )) )
);
}
say noise 3.14, 42, 7;</lang>
- Output:
0.13691995878