User:Ledrug/bits: Difference between revisions

From Rosetta Code
Content added Content deleted
mNo edit summary
No edit summary
 
(5 intermediate revisions by the same user not shown)
Line 2: Line 2:
#include <stdlib.h>
#include <stdlib.h>
#include <stdint.h>
#include <stdint.h>
#include <string.h>
#include <math.h>


#define N 100
typedef uint32_t hash_t;
#define D 6


typedef struct hash_value_t {
typedef float flt;
typedef struct { flt p1, p2; int32_t hold; } strat;
void *data;
char *key;
strat ** prob;
#define P(op, sc, h) (prob[(op) * N + (sc)][h])
struct hash_value_t *chain;
inline flt better(strat * p) {
} hash_value_t;
return p->hold ? p->p1 : p->p2;
}


inline flt p_better(int op, int sc, int h) {
typedef struct hash_table_t {
return better(&P(op, sc, h));
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;
}
}


#define FOR(x, n) for (x = 0; x < n; x++)
htbl hash_new(size_t size)
{
htbl h = calloc(1, sizeof(hash_table_t));
if (!size) size = 4;


void mkarray()
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;
int i, j;
prob = malloc(sizeof(*prob) * N * N);
hash_value_t *p = t->pool;
strat * pp = calloc(sizeof(*pp), N * N * (N + 1) / 2);
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;
}


FOR(i, N) FOR(j, N)
void hash_insert_node(htbl t, hash_value_t *p)
prob[i * N + j] = pp, pp += N - j;
{
size_t idx = hash(p->key) % t->cap;
p->chain = t->v[idx];
t->v[idx] = p;
}
}


int step_array()
void hash_expand(htbl t)
{
{
size_t i, c = t->cap;
int converged = 1;
int i, j, k, r;
hash_value_t *p, *tmp;


FOR(i, N) FOR(j, N) FOR(k, N - j) {
t->v = realloc(t->v, sizeof(hash_value_t*) * c * 2);
strat *p = &P(i, j, k);
memset(t->v + c, 0, c * sizeof(hash_table_t*));


flt p_current = p_better(i, j, k), chance1, chance2;
t->cap *= 2;
for (i = 0; i < c; i++) {
p = t->v[i];
if (!p) continue;


chance1 = 1 - p_better(j + k, i, 0); // if holding
t->v[i] = 0;
while (p) {
tmp = p->chain;
p->chain = 0;
hash_insert_node(t, p);
p = tmp;
}
}
}


chance2 = 1 - p_better(j, i, 0); // if rolling
void hash_insert(htbl t, char *s, void *data)
for (r = 2; r <= D; r++)
{
chance2 += (j + k + r >= N) ? 1 : p_better(i, j, k + r);
hash_value_t *p = hash_get_storage(t);
chance2 /= D;
if (t->n * 5 >= t->cap * 4) hash_expand(t);
p->key = strdup(s);
p->data = data;
hash_insert_node(t, p);
t->n ++;
}


p->p1 = chance1;
void* hash_remove(htbl t, char *s)
p->p2 = chance2;
{
p->hold = k && chance1 > chance2;
size_t idx = hash(s) % t->cap;
hash_value_t *head = 0, *p = t->v[idx];


if (converged && fabs(p_better(i, j, k) - p_current) > 1e-4)
while (p) {
converged = 0;
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;


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


void* hash_lookup(htbl t, char *s)
void write_array()
{
{
int i, j, k;
size_t idx = hash(s) % t->cap;
FOR(i, N) {
hash_value_t *p;
FOR(j, N - i) {
p = t->v[idx];
printf("%2d %2d: ", i, j);
while (p) {
FOR(k, N) {
if (!strcmp(p->key, s)) return p->data;
p = p->chain;
strat *p = &P(k,i,j);
putchar(p->hold ? '.' : 'R');
}
printf("(%.3f %.3f) ", p->p1, p->p2);
return (void*)-1;
}</lang>
<lang c>#include <stdio.h>
#include <string.h>

#define maxn 1000000
#define maxp 1000
int primes[maxp] = {2, 3}, n_primes = 2;

#ifdef KNUTH
char knuth[20000+2];
#endif

int show = 0;
void make_primes()
{
int i, n = 3, p;
while (n_primes < maxp) {
n += 2;
for (i = 0; i < n_primes; i++) {
p = primes[i];
if (n % p == 0) break;
if (p * p >= n) {
primes[n_primes++] = n;
break;
}
}
putchar('\n');
}
}
putchar('\n');
}
}
}
}


int main(void)
int length[maxn + 2] = {0, 0, 1, 2, 2};

int ones_(int n)
{
{
int r = 0;
int i = 0;
while (n) {
mkarray();
if (1 & n) r++;
n >>= 1;
}
return r;
}


while (!step_array())
int lg2(int n)
fprintf(stderr, "iter %d\n", ++i);
{
int r = 0, i = 1;
while (i < n) r++, i *= 2;
return r;
}


write_array();
int lb(int n)
{
int x = lg2(n);
return x - (n != (1 << x));
}


return 0;
int seq_len(int n);
}</lang>


<lang c>#include <ucontext.h>
typedef struct { int out, sum, tail, l, u; } rec;
#include <stdlib.h>
#include <stdio.h>
#include <stdarg.h>
#include <string.h>


struct hist_t {
int iter;
ucontext_t caller, callee;
int seq_insert(rec *x, int len, int p, int pos)
void **in, *out;
{
int j, i, min, max;
int first;
struct hist_t *prev;
i = pos ? pos : seq_len(p);
} *hist;


void backtrack() {
while (i < len && p > x[i].u) i++;
if (!hist) {

puts("backtracking exhausted");
if (i >= len || p < x[i].l) return 0;
abort();
iter++;
if (show) printf("insert %d %d\n", p, pos);

x[i].l = x[i].u = p;
x[i].out ++;
x[i].sum += len;
if (!x[len].tail || x[len].tail > p) x[len].tail = p;

#if 0
for (j = i + 1; j < len; j++) {
if (x[j].u > x[j-1].u * 2) x[j].u = x[j-1].u * 2;
if (x[j].l <= x[j-1].l) x[j].l = x[j-1].l + 1;
}
}
setcontext(&hist->callee);
}


ucontext_t* hpush()
for (j = i - 1; j >= 2; j--) {
{
if (x[j].u >= x[j+1].u) x[j].u = x[j+1].u - 1;
struct hist_t *h = malloc(sizeof(*h));
if (x[j].l < x[j+1].l/2) x[j].l = x[j+1].l / 2;
h->in = 0;
}
h->out = 0;
#endif
min = max = i;
h->prev = hist;
hist = h;
for (j = i; j < len && x[j+1].u > x[j].u * 2; j++)
return &hist->caller;
x[j+1].u = x[j].u * 2;
}
if (max < j) max = j;

for (j = i; j < len && x[j+1].l <= x[j].l; j++)
x[j+1].l = x[j].l;
if (max < j) max = j;

for (j = i; i > 2 && x[j-1].u >= x[j].u; j--)
x[j-1].u = x[j].u - 1;
if (min > j) min = j;

for (j = i; i > 2 && x[j-1].l * 2 < x[j].l; j--)
x[j-1].l = (x[j].l + 1)/2;
if (min > j) min = j;


void hpop() {
if (show) for (i = 0; i <= len; i++)
struct hist_t *s = hist;
printf("(%d,%d)%s", x[i].l, x[i].u, i == len ? "\n": "->");
hist = hist->prev;


if (s->in) free(s->in);
for (j = min; j < max; j++) if (x[j].u < x[j].l) return 0;
free(s->callee.uc_stack.ss_sp);
free(s);


backtrack();
return 1;
}
}


void copy(rec *x, rec *n, int len)
void yield(void *p)
{
{
hist->out = p;
memcpy(x, n, sizeof(rec) * len);
swapcontext(&hist->callee, &hist->caller);
}
}


int seq_recur(rec *in, int len)
void hinit(void **in, void (*func)())
{
{
if (!hist->in) {
rec x[32];
hist->in = in;
int i, p, q, n, r, lim;
getcontext(&hist->callee);

hist->callee.uc_stack.ss_sp = malloc(4096);
if (len < 2) return 1;
hist->callee.uc_stack.ss_size = 4096;
n = in[len].u;
hist->callee.uc_link = &hist->caller;

makecontext(&hist->callee, func, 0);
if (in[len-1].u == in[len-1].l) {
setcontext(&hist->callee);
if (n == in[len-1].u * 2 ||
n == in[len-1].u + 1 ||
n == in[len-1].u + 2)
if (seq_recur(in, len -1)) return 1;
}
}
}


#define amb (getcontext(hpush())+_amb)
if (show) {
void *_amb(int n, ...)
printf("%d|", len);
{
for (i = 0; i <= len; i++)
void iter() {
printf("%d,%d%s", in[i].l, in[i].u, i == len ? "\n": " -> ");
int i;
for (i = 0; hist->in[i]; i++)
yield(hist->in[i]);
hpop();
}
}


int i;
va_list ap;
void **buf = calloc((1 + n), sizeof(buf[0]));


va_start(ap, n);
if (n > in[len-1].u + in[len-2].u) {
if (n & 1) return 0;
for (i = 0; i < n; i++)
buf[i] = va_arg(ap, void*);
if (seq_insert(in, len, n/2, len-1)) {
va_end(ap);
in[len-1].out++;
return seq_recur(in, len-1);
}
return 0;
}


hinit(buf, iter);
//for (p = n/2, q = n - p; p; p--,q++) {
return hist->out;
lim = 0;
if (in[len].out == 1) {
lim = in[in[len].sum].tail;
if (show)
printf("lim %d %d %d\n", len, in[len].sum, lim);
}
if (lim < 1) lim = 1;

//for (p = n/2, q = n - p; p >= lim; p--, q++) {
for (p = lim, q = n - p; p <= q; p++,q--) {
if (seq_len(q) >= len || p != q && seq_len(p) >= len)
continue;

// for (i = 0; i < len; i++) x[i] = in[i];
copy(x, in, 32);

r = len - 1;

if (x[len-1].u == x[len-1].l && x[len-1].u != q) r = 0;
if (show) printf("[%d] need %d %d\n", len, p, q);
if (seq_insert(x, len, q, r) && seq_insert(x, len, p, 0)
&& seq_recur(x, len - 1))
{
for (i = 0; i < len; i++) in[i] = x[i];
return 1;
};
}
return 0;
}
}


int main(void)
int seq(int n, int *in, int len)
{
{
int r, i;
int join(char *a, char *b) {
rec x[32] = {{0}};
return a[strlen(a) - 1] == b[0];
x[0].l = 1; x[1].l = 2; x[len].l = n;
x[0].u = 1; x[1].u = 2; x[len].u = n;

for (i = 2; i < len; i++) {
x[i].l = x[i - 1].l + 1;
x[i].u = x[i - 1].u << 1;
}
for (i = len - 1; i >= 2; i--) {
if (x[i].l * 2 < x[i + 1].l) x[i].l = (x[i + 1].l + 1) / 2;
if (x[i].u >= x[i+1].u) x[i].u = x[i+1].u - 1;
}
}


char *a = amb(3, "the", "that", "a"),
r = seq_recur(x, len);
*b = amb(3, "frog", "elephant", "thing"),
if (r && show) {
*c = amb(3, "walked", "treaded", "grows"),
printf("Success\n");
*d = amb(3, "slowly", "quickly", "deathly");
for (i = 0; i <= len; i++)
printf("%d,%d%s", x[i].l, x[i].u, i == len ? "\n": " -> ");
}
for (i = 0; i <= len; i++) in[i] = x[i].u;


if (join(a, b) && join(b, c) && join(c, d))
return r;
printf("%s %s %s %s\n", a, b, c, d);
}
else
amb(0);


// should put a backtrack barrier here
int seq_len(int n)
{
int r, x[32], lb, l, u, i, j, o, ones[64];


if (length[n] || n <= 2) return length[n];
int s[] = {1, 2, 3, 4};


for (j = n, lb = -1, o = 0; j; j >>= 1, lb++)
int x = *(int*)amb(4, s, s+1, s+2, s+3);
if (j & 1) ones[o++] = lb;
int y = *(int*)amb(3, s, s+1, s+2);
int z = *(int*)amb(3, s, s+1, s+2);


//if (! (x > y && y < z && z < x && (x > 4))) // make "thing grows slowly"
u = lb + o - 1;
if (! (x > y && y < z && z < x && !(x & 1)))
l = lb + lg2(o);
backtrack();


printf("%d %d %d\n", x, y, z);


return 0;
#if 0
}</lang>
for (i = 0; ; i++) {
r = primes[i];
if (r * r > n) break;
if (n % r) continue;
if (u > (j = seq_len(r) + seq_len(n / r))) u = j;
}
#else
for (i = 2; i * i <= n; i++) {
if (n % i) continue;
if (u <= (j = seq_len(i))) continue;
if (u > (j += seq_len(n / i))) u = j;
}
#endif
if (l == u) goto done;


<lang lisp>(defmacro or= (x y) `(setf ,x (logior ,x ,y)))
// if (u > (j = seq_len(n - 1) + 1)) u = j;
(defmacro and= (x y) `(setf ,x (logand ,x ,y)))
// if (l == u) goto done;


(defconstant +N+ 1)
if (o <= 3) l = u;
(defconstant +S+ 2)
else if (o == 4) {
(defconstant +W+ 4)
i = ones[3] - ones[2], j = ones[1] - ones[0];
(defconstant +E+ 8)
if (i == j || i == j + 1 ||
(defconstant +V+ 16)
(j == 1 && (i == 3 || (i == 5 && ones[2] == ones[1] + 1))))
u = lb + 2;
}
else {
iter = 0;
while (l < u) {
if (!seq(n, x, l)) l++;
else {
printf("lower: %d %d %d\n", n, l, u - l);
u = l;
}
}
printf("iter %d %d\n", n, iter);
}
done:
length[n] = u;


(defun show-maze (a)
#ifdef KNUTH
(let ((h (1- (array-dimension a 0)))
if (u != knuth[n])
(w (1- (array-dimension a 1)))
printf("######### disc: %d %d %d\n", n, l, knuth[n]);
(g " │││─┘┐┤─└┌├─┴┬┼"))
#endif
(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)
// printf("%d %d %d\n", n, l, u);
(let* (xs (size (* (1- w) (1- h)))
// fflush(stdout);
(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+))
return u;
(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
void pb(int n)
;(let* ((c (elt xs (random (length xs)))) (c2 (neighbor c)))
{
(let* ((c (rand-element xs 100)) (c2 (neighbor c)))
int x = 1;
;(let* ((c (first xs)) (c2 (neighbor c)))
while (x <= n) {
(cond ((not c2) (setf xs (remove c xs :test #'equal)))
putchar((x & n) ? '#':'-');
(t (connect c c2)
x <<= 1;
(visit (car c2) (cdr c2))
}
(decf size)
putchar('\n');
(push c2 xs)
}
))))


(show-maze walls))))
int yy[] = {1, 2, 4, 8, 16, 32, 64, 128, 129, 257, 340, 514, 771, 1111};
int main()
{
int i, j, t, top, x[32];
make_primes();
int total = 0;


(print (make-maze 42 25))</lang>
#ifdef KNUTH
FILE *fp = fopen("out", "r");
knuth[0] = 32;
fread(knuth + 1, 1, 20000, fp);
fclose(fp);
for (i = 0; i < 20001; i++) knuth[i] -= 32;
#endif

show = 0;
top = 11129;
for (i = 0; i < top; i++) {
seq(i, x, t = seq_len(i));
printf("== %d ==\n", i);
pb(i);
for (j = 0; j <= t; j++) pb(x[j]);
putchar('\n');
total += iter;
}

printf("%d\n", total);
return 0;
}</lang>

Latest revision as of 21:26, 16 September 2012

<lang c>#include <stdio.h>

  1. include <stdlib.h>
  2. include <stdint.h>
  3. include <math.h>
  1. define N 100
  2. define D 6

typedef float flt; typedef struct { flt p1, p2; int32_t hold; } strat; strat ** prob;

  1. define P(op, sc, h) (prob[(op) * N + (sc)][h])

inline flt better(strat * p) { return p->hold ? p->p1 : p->p2; }

inline flt p_better(int op, int sc, int h) { return better(&P(op, sc, h)); }

  1. define FOR(x, n) for (x = 0; x < n; x++)

void mkarray() { int i, j; prob = malloc(sizeof(*prob) * N * N); strat * pp = calloc(sizeof(*pp), N * N * (N + 1) / 2);

FOR(i, N) FOR(j, N) prob[i * N + j] = pp, pp += N - j; }

int step_array() { int converged = 1; int i, j, k, r;

FOR(i, N) FOR(j, N) FOR(k, N - j) { strat *p = &P(i, j, k);

flt p_current = p_better(i, j, k), chance1, chance2;

chance1 = 1 - p_better(j + k, i, 0); // if holding

chance2 = 1 - p_better(j, i, 0); // if rolling for (r = 2; r <= D; r++) chance2 += (j + k + r >= N) ? 1 : p_better(i, j, k + r); chance2 /= D;

p->p1 = chance1; p->p2 = chance2; p->hold = k && chance1 > chance2;

if (converged && fabs(p_better(i, j, k) - p_current) > 1e-4) converged = 0; }

return converged; }

void write_array() { int i, j, k; FOR(i, N) { FOR(j, N - i) { printf("%2d %2d: ", i, j); FOR(k, N) { strat *p = &P(k,i,j); putchar(p->hold ? '.' : 'R'); printf("(%.3f %.3f) ", p->p1, p->p2); } putchar('\n'); } putchar('\n'); } }

int main(void) { int i = 0; mkarray();

while (!step_array()) fprintf(stderr, "iter %d\n", ++i);

write_array();

return 0; }</lang>

<lang c>#include <ucontext.h>

  1. include <stdlib.h>
  2. include <stdio.h>
  3. include <stdarg.h>
  4. include <string.h>

struct hist_t { ucontext_t caller, callee; void **in, *out; int first; struct hist_t *prev; } *hist;

void backtrack() { if (!hist) { puts("backtracking exhausted"); abort(); } setcontext(&hist->callee); }

ucontext_t* hpush() { struct hist_t *h = malloc(sizeof(*h)); h->in = 0; h->out = 0; h->prev = hist; hist = h; return &hist->caller; }

void hpop() { struct hist_t *s = hist; hist = hist->prev;

if (s->in) free(s->in); free(s->callee.uc_stack.ss_sp); free(s);

backtrack(); }

void yield(void *p) { hist->out = p; swapcontext(&hist->callee, &hist->caller); }

void hinit(void **in, void (*func)()) { if (!hist->in) { hist->in = in; getcontext(&hist->callee); hist->callee.uc_stack.ss_sp = malloc(4096); hist->callee.uc_stack.ss_size = 4096; hist->callee.uc_link = &hist->caller; makecontext(&hist->callee, func, 0); setcontext(&hist->callee); } }

  1. define amb (getcontext(hpush())+_amb)

void *_amb(int n, ...) { void iter() { int i; for (i = 0; hist->in[i]; i++) yield(hist->in[i]); hpop(); }

int i; va_list ap; void **buf = calloc((1 + n), sizeof(buf[0]));

va_start(ap, n); for (i = 0; i < n; i++) buf[i] = va_arg(ap, void*); va_end(ap);

hinit(buf, iter); return hist->out; }

int main(void) { int join(char *a, char *b) { return a[strlen(a) - 1] == b[0]; }

char *a = amb(3, "the", "that", "a"), *b = amb(3, "frog", "elephant", "thing"), *c = amb(3, "walked", "treaded", "grows"), *d = amb(3, "slowly", "quickly", "deathly");

if (join(a, b) && join(b, c) && join(c, d)) printf("%s %s %s %s\n", a, b, c, d); else amb(0);

// should put a backtrack barrier here

int s[] = {1, 2, 3, 4};

int x = *(int*)amb(4, s, s+1, s+2, s+3); int y = *(int*)amb(3, s, s+1, s+2); int z = *(int*)amb(3, s, s+1, s+2);

//if (! (x > y && y < z && z < x && (x > 4))) // make "thing grows slowly" if (! (x > y && y < z && z < x && !(x & 1))) backtrack();

printf("%d %d %d\n", x, y, z);

return 0; }</lang>

<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=196670"