User:Ledrug/bits: Difference between revisions

From Rosetta Code
Content added Content deleted
mNo edit summary
mNo edit summary
Line 1: Line 1:
<lang lisp>(defmacro or= (x y) `(setf ,x (logior ,x ,y)))
<lang c>#include <stdio.h>
(defmacro and= (x y) `(setf ,x (logand ,x ,y)))
#include <stdlib.h>
#include <math.h>


(defconstant +N+ 1)
#define MAXD 8
(defconstant +S+ 2)
/* Perlin-like noise */
(defconstant +W+ 4)
inline double
(defconstant +E+ 8)
hashed(int *data, int len) {
(defconstant +V+ 16)
# define rot(a, d) ((a << (d)) | (a >> (32 - d)))
unsigned int *d = (void*)data, h = 0x123456, tmp;


(defun show-maze (a)
while (len--) {
(let ((h (1- (array-dimension a 0)))
tmp = *d++;
(w (1- (array-dimension a 1)))
h += rot(h, 16) ^ (rot(tmp, 5) ^ h);
(g " │││─┘┐┤─└┌├─┴┬┼"))
}
(write-line "")
(loop for y from 0 to h do
(loop for x from 0 to w do
(format t "~c" (char g (logand (aref a y x) (lognot +V+)))))
(format t "~%"))))


(defun make-maze (w h)
h ^= rot(h, 7);
(let* (xs (size (* (1- w) (1- h)))
h += rot(h, 11);
(w2 (* 2 w)) (h2 (* 2 h))
h ^= rot(h, 17);
(walls (make-array (list (1+ h2) (1+ w2))
h += rot(h, 25);
:element-type 'integer :initial-element 0)))
# undef rot
return (double)(int)h / (1U << 31);
}


(flet ((visit (y x) (or= (aref walls y x) +V+))
double scale[MAXD], scale_u[MAXD];
(rand-element (list r)
void noise_init()
(loop for x in list with c = 1 with sel do
{
(if (zerop (random c)) (setf sel x))
int i;
for (i = 1; i < MAXD; i++) {
(incf c r)
scale[i] = 1 / (1 + sqrt(i + 1));
finally (return sel)))
(connect (c1 c2)
scale_u[i] = scale[i] / sqrt(i + 1);
(let ((y1 (car c1)) (y2 (car c2))
}
(x1 (cdr c1)) (x2 (cdr c2)))
}
(if (= x1 x2)
(progn (or= (aref walls (min y1 y2) x1) +S+)
(or= (aref walls (1+ (min y1 y2)) x1) +S+)
(or= (aref walls (1+ (min y1 y2)) x1) +N+)
(or= (aref walls (max y1 y2) x1) +N+))
(progn (or= (aref walls y1 (min x1 x2)) +E+)
(or= (aref walls y1 (1+ (min x1 x2))) +E+)
(or= (aref walls y1 (1+ (min x1 x2))) +W+)
(or= (aref walls y1 (max x1 x2)) +W+)))))
(neighbor (cell)
(loop with cnt = 0 with next-cell
for (dy dx) in '((-2 0) (2 0) (0 2) (0 -2)) do
(let ((y (+ (car cell) dy)) (x (+ (cdr cell) dx)))
(if (and (array-in-bounds-p walls y x)
(not (logtest (aref walls y x) +V+))
(zerop (random (incf cnt))))
(setf next-cell (cons y x))))
finally (return next-cell))))
(setf xs (append
(loop for y from 0 to h
collect (cons (* 2 y) 0) collect (cons (* 2 y) w2)
do (let ((y2 (* 2 y)))
(visit y2 0) (visit y2 w2)
(when (< y2 h2)
(connect (cons y2 0) (cons (+ 2 y2) 0))
(connect (cons y2 w2) (cons (+ 2 y2) w2)))))
(loop for x from 0 to w
collect (cons 0 (* 2 x)) collect (cons h2 (* 2 x))
do (let ((x2 (* 2 x)))
(visit 0 x2) (visit h2 x2)
(when (< x2 w2)
(connect (cons 0 x2) (cons 0 (+ 2 x2)))
(connect (cons h2 x2) (cons h2 (+ 2 x2))))))))


(loop while xs do
double noise(double *x, int d)
;(let* ((c (elt xs (random (length xs)))) (c2 (neighbor c)))
{
(let* ((c (rand-element xs 100)) (c2 (neighbor c)))
# define sum(s, x) for (s = 0, j = 0; j < d; j++) s += x
;(let* ((c (first xs)) (c2 (neighbor c)))
register int i, j;
(cond ((not c2) (setf xs (remove c xs :test #'equal)))
int n[MAXD], o[MAXD], tmp;
(t (connect c c2)
double s, r, t, ret, w;
(visit (car c2) (cdr c2))
double u[MAXD], sk[MAXD];
(decf size)
(push c2 xs)
))))


(show-maze walls))))
sum(s, x[j]);
s *= scale[d];


(print (make-maze 42 25))</lang>
for (i = 0; i < d; i++) {
// sk[i] = x[i] + s;
t = x[i] + s;
u[i] = t - (n[i] = floor(t));
o[i] = i;
}

for (i = 0; i < d - 1; i++)
for (j = i; j < d; j++)
if (u[o[i]] < u[o[j]])
tmp = o[i], o[i] = o[j], o[j] = tmp;

ret = 0, r = 1, w = 1;

for (i = 0; i < d; i++) {
s = u[o[i]] / w;
t = s * s * (3 - 2 * s);
ret += hashed(n, d) * (1 - t) * r;
w *= s;
if (!w) return ret;

r *= t;
n[o[i]]++;
}
return ret + hashed(n, d) * r;
}

double get_noise2(double x, double y)
{
int i, ws;
double r = 0, v[2];

for (i = 1, ws = 0; i <= 256; i <<= 1) {
v[0] = x * i, v[1] = y * i;
r += noise(v, 2);
ws ++;
}
r /= ws;
return r;
}

double get_noise3(double x, double y, double z)
{
int i, ws;
double r = 0, v[3], w;

for (i = 1, ws = 0; i <= 128; i <<= 1) {
v[0] = x * i, v[1] = y * i, v[2] = z * i;
w = 1./sqrt(i);
r += noise(v, 3) * w;
ws += w;
}
return r / ws;
}


int main()
{
unsigned char pix[256 * 256], *p;
int i, j;
double x, y, z, w;
FILE *fp;

noise_init();

for (p = pix, i = 0; i < 256 * 256; i++) *p++ = 0;

get_noise2(0, .0001);
for (p = pix, i = 0; i < 256; i++) {
y = (i - 128) / 125.;
for (j = 0; j < 256; j++, p++) {
x = (j - 128) / 125.;
*p = (get_noise2(i/256., j/256.) + 1) / 6 * i;
//*p = (get_noise2(i/256., j/256.) + 1) / 2 * 255;

z = 1- x*x - y*y;
if (z < 0) continue;

z = sqrt(z);
w = get_noise3(x, y, z + 1);
w = (w + 1) / 2;
w = w * (.5 + x - y + z) / 3;
if (w < 0) w = 0;

*p = w * 255;
}
}

fp = fopen("out.pgm", "w+");
fprintf(fp, "P5\n256 256\n255\n");
fwrite(pix, 1, 256 * 256, fp);
fclose(fp);

return 0;
}</lang>
<lang c>#include <stdio.h>
#include <stdlib.h>
#include <stdint.h>
#include <string.h>

typedef uint32_t hash_t;

typedef struct hash_value_t {
void *data;
char *key;
struct hash_value_t *chain;
} hash_value_t;

typedef struct hash_table_t {
hash_value_t **v, *pool;
size_t n, cap;
} hash_table_t, *htbl;

inline hash_t hash(char *s)
{
hash_t hash;
for (hash = 0; *s; s++) {
hash += *s;
hash += (hash << 10);
hash ^= (hash >> 6);
}
hash += hash << 3;
hash ^= hash >> 11;
hash += hash << 15;
return hash;
}

htbl hash_new(size_t size)
{
htbl h = calloc(1, sizeof(hash_table_t));
if (!size) size = 4;

for (h->cap = 1; h->cap < size; h->cap <<= 1);

h->v = calloc(h->cap, sizeof(hash_value_t*));
h->pool = 0;
return h;
}

hash_value_t *hash_get_storage(htbl t)
{
size_t len;
hash_value_t *p = t->pool;
if (!p) {
len = 1024;
if (len > t->cap) len = t->cap;
t->pool = calloc(len, sizeof(hash_value_t));
for (p = t->pool; len > 1; len --)
p->chain = p + 1;
p = t->pool;
}
t->pool = p->chain;
return p;
}

void hash_insert_node(htbl t, hash_value_t *p)
{
size_t idx = hash(p->key) % t->cap;
p->chain = t->v[idx];
t->v[idx] = p;
}

void hash_expand(htbl t)
{
size_t i, c = t->cap;
hash_value_t *p, *tmp;

t->v = realloc(t->v, sizeof(hash_value_t*) * c * 2);
memset(t->v + c, 0, c * sizeof(hash_table_t*));

t->cap *= 2;
for (i = 0; i < c; i++) {
p = t->v[i];
if (!p) continue;

t->v[i] = 0;
while (p) {
tmp = p->chain;
p->chain = 0;
hash_insert_node(t, p);
p = tmp;
}
}
}

void hash_insert(htbl t, char *s, void *data)
{
hash_value_t *p = hash_get_storage(t);
if (t->n * 5 >= t->cap * 4) hash_expand(t);
p->key = strdup(s);
p->data = data;
hash_insert_node(t, p);
t->n ++;
}

void* hash_remove(htbl t, char *s)
{
size_t idx = hash(s) % t->cap;
hash_value_t *head = 0, *p = t->v[idx];

while (p) {
if (!strcmp(p->key, s)) break;
head = p;
p = p->chain;
}
if (!p) return 0;

free(p->key);

if (head) head->chain = p->chain;
else t->v[idx] = p->chain;

p->chain = t->pool;
t->pool = p;
t->n--;
return p->data;
}

void* hash_lookup(htbl t, char *s)
{
size_t idx = hash(s) % t->cap;
hash_value_t *p;
p = t->v[idx];
while (p) {
if (!strcmp(p->key, s)) return p->data;
p = p->chain;
}
return (void*)-1;
}</lang>

Revision as of 03:44, 19 October 2011

<lang lisp>(defmacro or= (x y) `(setf ,x (logior ,x ,y))) (defmacro and= (x y) `(setf ,x (logand ,x ,y)))

(defconstant +N+ 1) (defconstant +S+ 2) (defconstant +W+ 4) (defconstant +E+ 8) (defconstant +V+ 16)

(defun show-maze (a) 

 (let ((h (1- (array-dimension a 0)))

(w (1- (array-dimension a 1))) (g " │││─┘┐┤─└┌├─┴┬┼")) 

   (write-line "")
   (loop for y from 0 to h do

(loop for x from 0 to w do (format t "~c" (char g (logand (aref a y x) (lognot +V+))))) (format t "~%"))))

(defun make-maze (w h) 

 (let* (xs (size (* (1- w) (1- h)))

(w2 (* 2 w)) (h2 (* 2 h)) (walls (make-array (list (1+ h2) (1+ w2)) :element-type 'integer :initial-element 0))) 

   (flet ((visit (y x) (or= (aref walls y x) +V+))

(rand-element (list r) (loop for x in list with c = 1 with sel do (if (zerop (random c)) (setf sel x)) (incf c r) finally (return sel))) (connect (c1 c2) (let ((y1 (car c1)) (y2 (car c2)) (x1 (cdr c1)) (x2 (cdr c2))) (if (= x1 x2) (progn (or= (aref walls (min y1 y2) x1) +S+) (or= (aref walls (1+ (min y1 y2)) x1) +S+) (or= (aref walls (1+ (min y1 y2)) x1) +N+) (or= (aref walls (max y1 y2) x1) +N+)) (progn (or= (aref walls y1 (min x1 x2)) +E+) (or= (aref walls y1 (1+ (min x1 x2))) +E+) (or= (aref walls y1 (1+ (min x1 x2))) +W+) (or= (aref walls y1 (max x1 x2)) +W+))))) (neighbor (cell) (loop with cnt = 0 with next-cell for (dy dx) in '((-2 0) (2 0) (0 2) (0 -2)) do (let ((y (+ (car cell) dy)) (x (+ (cdr cell) dx))) (if (and (array-in-bounds-p walls y x) (not (logtest (aref walls y x) +V+)) (zerop (random (incf cnt)))) (setf next-cell (cons y x)))) finally (return next-cell)))) 

     (setf xs (append

(loop for y from 0 to h collect (cons (* 2 y) 0) collect (cons (* 2 y) w2) do (let ((y2 (* 2 y))) (visit y2 0) (visit y2 w2) (when (< y2 h2) (connect (cons y2 0) (cons (+ 2 y2) 0)) (connect (cons y2 w2) (cons (+ 2 y2) w2))))) (loop for x from 0 to w collect (cons 0 (* 2 x)) collect (cons h2 (* 2 x)) do (let ((x2 (* 2 x))) (visit 0 x2) (visit h2 x2) (when (< x2 w2) (connect (cons 0 x2) (cons 0 (+ 2 x2))) (connect (cons h2 x2) (cons h2 (+ 2 x2)))))))) 

     (loop while xs do

 ;(let* ((c (elt xs (random (length xs)))) (c2 (neighbor c))) (let* ((c (rand-element xs 100)) (c2 (neighbor c)))  ;(let* ((c (first xs)) (c2 (neighbor c))) (cond ((not c2) (setf xs (remove c xs :test #'equal))) (t (connect c c2) (visit (car c2) (cdr c2)) (decf size) (push c2 xs) )))) 

     (show-maze walls))))

(print (make-maze 42 25))</lang>

Retrieved from "https://rosettacode.org/wiki/User:Ledrug/bits?oldid=196668"