Jump to content

Wave function collapse

From Rosetta Code
Wave function collapse is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.
This task has been flagged for clarification. Code on this page in its current state may be flagged incorrect once this task has been clarified. See this page's Talk page for discussion.

The Wave Function Collapse algorithm is a heuristic for generating tiled images.

The algorithm begins with a collection of equal sized image blocks and randomly places them, one at a time, within a grid subject to the tiling constraint and an entropy constraint, and it wraps (the top row of blocks in the grid is treated as adjacent to the bottom row of blocks, and similarly the left and right columns of blocks are treated as adjacent to each other).

The blocks are tiled within the grid. Tiled means they are placed with a one pixel overlap and the tiling constraint requires that the pixels overlapping border between two adjacent blocks match.

Entropy, here, means the number of blocks eligible to be placed in an unassigned grid location. The entropy constraint here is that each block is placed in a grid location with minimum entropy. (Placing a block may constrain the entropy of its four nearest neighbors -- up, down, left, right.)

For this task, we start with five blocks of 3x3 pixels and place them in an 8x8 grid to form a 17x17 tile. A tile is a block which may be tiled with itself. Here, we show these five blocks adjacent but not tiled:

   
   
   
   
   
   
   
   
   
   
   
   
   
   
   


Note that this algorithm sometimes does not succeed. If an unassigned grid location has an entropy of 0, the algorithm fails and returns an empty or null result. We'll ignore those failure cases for this task.

Reference WFC explained and another WFC explained

BASIC

FreeBASIC

Translation of: Wren
Randomize Timer

Function CreateFilledArray(size As Integer, value As Integer) As Integer Ptr
    Dim As Integer Ptr arr = Allocate(size * Sizeof(Integer))
    For i As Integer = 0 To size - 1
        arr[i] = value
    Next
    Return arr
End Function

Function CopyArray(arr As Integer Ptr, size As Integer) As Integer Ptr
    Dim As Integer Ptr newArr = Allocate(size * Sizeof(Integer))
    For i As Integer = 0 To size - 1
        newArr[i] = arr[i]
    Next
    Return newArr
End Function

Function WFC(blocks As Integer Ptr, tdim As Integer Ptr, target As Integer Ptr) As Integer Ptr
    Dim As Integer i, j, k
    Dim As Integer N = target[0] * target[1]
    Dim As Integer t0 = target[0], t1 = target[1]
    Dim As Integer Ptr adj = CreateFilledArray(4 * N, 0)
    
    For i = 0 To t0 - 1
        For j = 0 To t1 - 1
            Dim As Integer k = j + t1 * i
            Dim As Integer m = 4 * k
            adj[m    ] = j + t1 * ((t0 + i - 1) Mod t0)  ' above (1)
            adj[m + 1] = (t1 + j - 1) Mod t1 + t1 * i    ' left  (3)
            adj[m + 2] = (j + 1) Mod t1 + t1 * i         ' right (5)
            adj[m + 3] = j + t1 * ((i + 1) Mod t0)       ' below (7)
        Next
    Next
    
    Dim As Integer td0 = tdim[0], td1 = tdim[1], td2 = tdim[2]
    Dim As Integer Ptr horz = CreateFilledArray(td0 * td0, 0)
    Dim As Integer Ptr vert = CreateFilledArray(td0 * td0, 0)
    
    For i = 0 To td0 - 1
        For j = 0 To td0 - 1
            horz[j + i * td0] = 1
            vert[j + i * td0] = 1
            For k = 0 To td1 - 1
                If blocks[0 + td2 * (k + td1 * i)] <> blocks[(td2 - 1) + td2 * (k + td1 * j)] Then
                    horz[j + i * td0] = 0
                    Exit For
                End If
            Next
            For k = 0 To td2 - 1
                If blocks[k + td2 * (0 + td1 * i)] <> blocks[k + td2 * ((td2 - 1) + td1 * j)] Then
                    vert[j + i * td0] = 0
                    Exit For
                End If
            Next
        Next
    Next
    
    Dim As Integer stride = (td0 + 1) * td0
    Dim As Integer Ptr allow = CreateFilledArray(4 * stride, 1)
    
    For i = 0 To td0 - 1
        For j = 0 To td0 - 1
            allow[               (i * td0) + j] = vert[(j * td0) + i] ' above (north)
            allow[     stride  + (i * td0) + j] = horz[(j * td0) + i] ' left (west)
            allow[(2 * stride) + (i * td0) + j] = horz[(i * td0) + j] ' right (east)
            allow[(3 * stride) + (i * td0) + j] = vert[(i * td0) + j] ' below (south)
        Next
    Next
    
    Dim As Integer Ptr R = CreateFilledArray(N, td0)
    Dim As Integer Ptr todo = CreateFilledArray(N, 0)
    Dim As Integer Ptr wave = CreateFilledArray(N * td0, 0)
    Dim As Integer Ptr entropy = CreateFilledArray(N, 0)
    Dim As Integer Ptr indices = CreateFilledArray(N, 0)
    Dim As Integer min = 0
    Dim As Integer Ptr possible = CreateFilledArray(td0, 0)
    
    Do
        Dim As Integer c = 0
        For i = 0 To N - 1
            If td0 = R[i] Then
                todo[c] = i
                c += 1
            End If
        Next
        
        If c = 0 Then Exit Do
        
        min = td0
        For i = 0 To c - 1
            entropy[i] = 0
            For j = 0 To td0 - 1
                Dim As Integer K = 4 * todo[i]
                wave[i * td0 + j] = allow[               td0 * R[adj[K    ]] + j] And _
                allow[    stride  + td0 * R[adj[K + 1]] + j] And _
                allow[(2 * stride) + td0 * R[adj[K + 2]] + j] And _
                allow[(3 * stride) + td0 * R[adj[K + 3]] + j]
                entropy[i] += wave[i * td0 + j]
            Next
            If entropy[i] < min Then min = entropy[i]
        Next
        
        If min = 0 Then
            Deallocate(R)
            R = 0
            Exit Do
        End If
        
        Dim As Integer d = 0
        For i = 0 To c - 1
            If min = entropy[i] Then
                indices[d] = i
                d += 1
            End If
        Next
        
        Dim As Integer ndx = indices[Int(Rnd * d)]
        Dim As Integer ind = ndx * td0
        d = 0
        For i = 0 To td0 - 1
            If wave[ind + i] <> 0 Then
                possible[d] = i
                d += 1
            End If
        Next
        
        R[todo[ndx]] = possible[Int(Rnd * d)]
    Loop
    
    If R = 0 Then Return 0
    
    Dim As Integer tileSize = (1 + t0 * (td1 - 1)) * (1 + t1 * (td2 - 1))
    Dim As Integer Ptr tile = CreateFilledArray(tileSize, 0)
    
    For i0 As Integer = 0 To t0 - 1
        For i1 As Integer = 0 To td1 - 1
            For j0 As Integer = 0 To t1 - 1
                For j1 As Integer = 0 To td2 - 1
                    Dim As Integer t = j1 + (td2 - 1) * j0 + (1 + t1 * (td2 - 1)) * (i1 + (td1 - 1) * i0)
                    tile[t] = blocks[j1 + td2 * (i1 + td1 * R[j0 + t1 * i0])]
                Next
            Next
        Next
    Next
    
    Deallocate(adj)
    Deallocate(horz)
    Deallocate(vert)
    Deallocate(allow)
    Deallocate(R)
    Deallocate(todo)
    Deallocate(wave)
    Deallocate(entropy)
    Deallocate(indices)
    Deallocate(possible)
    
    Return tile
End Function

' Main program
Dim As Integer blocks(45) = { _
0, 0, 0, _
0, 0, 0, _
0, 0, 0, _
0, 0, 0, _
1, 1, 1, _
0, 1, 0, _
0, 1, 0, _
0, 1, 1, _
0, 1, 0, _
0, 1, 0, _
1, 1, 1, _
0, 0, 0, _
0, 1, 0, _
1, 1, 0, _
0, 1, 0  }

Dim As Integer tdims(3) = {5, 3, 3}
Dim As Integer size(2) = {8, 8}
Dim As Integer i, j
Dim As Integer Ptr tile = WFC(@blocks(0), @tdims(0), @size(0))

If tile = 0 Then
    Print "Failed to generate tile."
Else
    For i = 0 To 16
        For j = 0 To 16
            Print Iif(tile[j + i * 17] = 0, " ", "#");
        Next
        Print
    Next    
    Deallocate(tile)
End If

Sleep
Output:
 # # # # #   # #
 ### ### #######
 # # # # # #   #
## ##############
 # #         #
####         ####
   #         # #
   #############
   # # # # #   #
   ### ### #####
   # # # # # # #
#### ##### ######
 # # #   # #
 ### #######
 # # # #   #
## ### ##########
 # # # # #   # #

QBasic

The QB64 solution works without any changes.

QB64

Translation of: FreeBASIC
DECLARE FUNCTION WFC! (blocks() AS INTEGER, tdim() AS INTEGER, target() AS INTEGER, tile() AS INTEGER)

Randomize Timer

' Main program
Dim i As Integer, j As Integer
Dim blocks(44) As Integer
Data 0,0,0,0,0,0,0,0,0,0,0,0,1,1,1,0,1,0,0,1,0,0,1,1,0,1,0,0,1,0,1,1,1,0,0,0,0,1,0,1,1,0,0,1,0
For i = 0 To 44: Read blocks(i): Next

Dim tdims(2) As Integer
tdims(0) = 5: tdims(1) = 3: tdims(2) = 3
Dim size(1) As Integer
size(0) = 8: size(1) = 8

Dim tileSize As Integer
tileSize = (1 + size(0) * (tdims(1) - 1)) * (1 + size(1) * (tdims(2) - 1))
Dim tile(tileSize - 1) As Integer

If WFC(blocks(), tdims(), size(), tile()) = 0 Then
    Print "Failed to generate tile."
Else
    For i = 0 To 16
        For j = 0 To 16
            If tile(j + i * 17) = 0 Then Print " "; Else Print "#";
        Next
        Print
    Next
End If
End

Sub CreateFilledArray (arr() As Integer, size As Integer, value As Integer)
    Dim i As Integer
    ReDim arr(size - 1)
    For i = 0 To size - 1
        arr(i) = value
    Next
End Sub

Function WFC (blocks() As Integer, tdim() As Integer, target() As Integer, tile() As Integer)
    Dim i As Integer, j As Integer, K As Integer, N As Integer, m As Integer
    Dim t0 As Integer, t1 As Integer

    N = target(0) * target(1)
    t0 = target(0)
    t1 = target(1)
    Dim adj(4 * N - 1) As Integer

    For i = 0 To t0 - 1
        For j = 0 To t1 - 1
            K = j + t1 * i
            m = 4 * K
            adj(m) = j + t1 * ((t0 + i - 1) Mod t0) ' above (1)
            adj(m + 1) = (t1 + j - 1) Mod t1 + t1 * i ' left (3)
            adj(m + 2) = (j + 1) Mod t1 + t1 * i ' right (5)
            adj(m + 3) = j + t1 * ((i + 1) Mod t0) ' below (7)
        Next
    Next

    Dim td0 As Integer, td1 As Integer, td2 As Integer
    td0 = tdim(0): td1 = tdim(1): td2 = tdim(2)
    Dim horz(td0 * td0 - 1) As Integer, vert(td0 * td0 - 1) As Integer

    For i = 0 To td0 - 1
        For j = 0 To td0 - 1
            horz(j + i * td0) = 1
            vert(j + i * td0) = 1
            For K = 0 To td1 - 1
                If blocks(0 + td2 * (K + td1 * i)) <> blocks((td2 - 1) + td2 * (K + td1 * j)) Then
                    horz(j + i * td0) = 0
                    Exit For
                End If
            Next
            For K = 0 To td2 - 1
                If blocks(K + td2 * (0 + td1 * i)) <> blocks(K + td2 * ((td2 - 1) + td1 * j)) Then
                    vert(j + i * td0) = 0
                    Exit For
                End If
            Next
        Next
    Next

    Dim stride As Integer
    stride = (td0 + 1) * td0
    Dim allow(4 * stride - 1) As Integer
    For i = 0 To 4 * stride - 1
        allow(i) = 1
    Next

    For i = 0 To td0 - 1
        For j = 0 To td0 - 1
            allow((i * td0) + j) = vert((j * td0) + i) ' above (north)
            allow(stride + (i * td0) + j) = horz((j * td0) + i) ' left (west)
            allow(2 * stride + (i * td0) + j) = horz((i * td0) + j) ' right (east)
            allow(3 * stride + (i * td0) + j) = vert((i * td0) + j) ' below (south)
        Next
    Next

    Dim R(N - 1) As Integer
    For i = 0 To N - 1
        R(i) = td0
    Next
    Dim todo(N - 1) As Integer
    Dim wave(N * td0 - 1) As Integer
    Dim entropy(N - 1) As Integer
    Dim indices(N - 1)
    Dim min As Integer
    min = 0
    Dim possible(td0 - 1) As Integer
    Dim c As Integer, d As Integer

    Do
        c = 0
        For i = 0 To N - 1
            If td0 = R(i) Then
                todo(c) = i
                c = c + 1
            End If
        Next

        If c = 0 Then Exit Do

        min = td0
        For i = 0 To c - 1
            entropy(i) = 0
            For j = 0 To td0 - 1
                K = 4 * todo(i)
                wave(i * td0 + j) = allow(td0 * R(adj(K)) + j) And allow(stride + td0 * R(adj(K + 1)) + j) And allow((2 * stride) + td0 * R(adj(K + 2)) + j) And allow((3 * stride) + td0 * R(adj(K + 3)) + j)
                entropy(i) = entropy(i) + wave(i * td0 + j)
            Next
            If entropy(i) < min Then min = entropy(i)
        Next

        If min = 0 Then
            WFC = 0
        End If

        d = 0
        For i = 0 To c - 1
            If min = entropy(i) Then
                indices(d) = i
                d = d + 1
            End If
        Next

        Dim ndx As Integer, ind As Integer
        ndx = indices(Int(Rnd * d))
        ind = ndx * td0
        d = 0
        For i = 0 To td0 - 1
            If wave(ind + i) <> 0 Then
                possible(d) = i
                d = d + 1
            End If
        Next

        R(todo(ndx)) = possible(Int(Rnd * d))
    Loop

    Dim tileSize As Integer
    tileSize = (1 + t0 * (td1 - 1)) * (1 + t1 * (td2 - 1))
    ReDim tile(tileSize - 1)

    Dim i0 As Integer, i1 As Integer, j0 As Integer, j1 As Integer, t As Integer
    For i0 = 0 To t0 - 1
        For i1 = 0 To td1 - 1
            For j0 = 0 To t1 - 1
                For j1 = 0 To td2 - 1
                    t = j1 + (td2 - 1) * j0 + (1 + t1 * (td2 - 1)) * (i1 + (td1 - 1) * i0)
                    tile(t) = blocks(j1 + td2 * (i1 + td1 * R(j0 + t1 * i0)))
                Next
            Next
        Next
    Next

    WFC = 1
End Function
Output:
Same as FreeBASIC entry.

C

Translation of: J
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <time.h>
 
#define XY(row, col, width) ((col)+(row)*(width))
#define XYZ(page, row, col, height, width) XY(XY(page, row, height), col, width)
 
char blocks[5][3][3]= {
    {
        {0, 0, 0},
        {0, 0, 0},
        {0, 0, 0}
    },{
        {0, 0, 0},
        {1, 1, 1},
        {0, 1, 0}
    },{
        {0, 1, 0},
        {0, 1, 1},
        {0, 1, 0}
    },{
        {0, 1, 0},
        {1, 1, 1},
        {0, 0, 0}
    },{
        {0, 1, 0},
        {1, 1, 0},
        {0, 1, 0}
    }
};
 
/* avoid problems with slightly negative numbers and C's X%Y */
#define MOD(X,Y) ((Y)+(X))%(Y)
 
char *wfc(char *blocks, int *bdim /* 5,3,3 */, int *tdim /* 8,8 */) {
    int N= tdim[0]*tdim[1], td0= tdim[0], td1= tdim[1];
    int *adj= calloc(N*4, sizeof (int)); /* indices in R of the four adjacent blocks */
    for (int i= 0; i<td0; i++) {
        for (int j=0; j<td1; j++) {
            adj[XYZ(i,j,0,td1,4)]= XY(MOD(i-1, td0), MOD(j,   td1), td1); /* above (index 1 in a 3x3 grid) */
            adj[XYZ(i,j,1,td1,4)]= XY(MOD(i,   td0), MOD(j-1, td1), td1); /* left  (index 3 in a 3x3 grid) */
            adj[XYZ(i,j,2,td1,4)]= XY(MOD(i,   td0), MOD(j+1, td1), td1); /* right (index 5 in a 3x3 grid) */
            adj[XYZ(i,j,3,td1,4)]= XY(MOD(i+1, td0), MOD(j,   td1), td1); /* below (index 7 in a 3x3 grid) */
        }
    }
    int bd0= bdim[0], bd1= bdim[1], bd2= bdim[2];
    char *horz= malloc(bd0*bd0); /* blocks which can sit next to each other horizontally */
    for (int i= 0; i<bd0; i++) {
        for (int j= 0; j<bd0; j++) {
            horz[XY(i,j,bd0)]= 1;
            for (int k= 0; k<bd1; k++) {
                if (blocks[XYZ(i, k, 0, bd1, bd2)] != blocks[XYZ(j, k, bd2-1, bd1, bd2)]) {
                    horz[XY(i, j, bd0)]= 0;
                }
            }
        }
    }
    char *vert= malloc(bd0*bd0); /* blocks which can sit next to each other vertically */
    for (int i= 0; i<bd0; i++) {
        for (int j= 0; j<bd0; j++) {
            vert[XY(i,j,bd0)]= 1;
            for (int k= 0; k<bd2; k++) {
                if (blocks[XYZ(i, 0, k, bd1, bd2)] != blocks[XYZ(j, bd1-1, k, bd1, bd2)]) {
                    vert[XY(i, j, bd0)]= 0;
                    break;
                }
            }
        }
    }
    char *allow= malloc(4*(bd0+1)*bd0); /* all block constraints, based on neighbors */
    memset(allow, 1, 4*(bd0+1)*bd0);
    for (int i= 0; i<bd0; i++) {
        for (int j= 0; j<bd0; j++) {
            allow[XYZ(0, i, j, bd0+1, bd0)]= vert[XY(j, i, bd0)]; /* above (north) */ 
            allow[XYZ(1, i, j, bd0+1, bd0)]= horz[XY(j, i, bd0)]; /* left (west) */ 
            allow[XYZ(2, i, j, bd0+1, bd0)]= horz[XY(i, j, bd0)]; /* right (east) */ 
            allow[XYZ(3, i, j, bd0+1, bd0)]= vert[XY(i, j, bd0)]; /* below (south) */ 
        }
    }
    free(horz);
    free(vert);
    int *todo= calloc(N, sizeof (int));
    char *wave= malloc(N*bd0);
    int *entropy= calloc(N, sizeof (int));
    int *indices= calloc(N, sizeof (int));
    int min;
    int *possible= calloc(bd0, sizeof (int));
    int *R= calloc(N, sizeof (int)); /* tile expressed as list of block indices */
    for (int i= 0; i<N; i++) R[i]= bd0;
    while (1) {
        int c= 0;
        for (int i= 0; i<N; i++)
            if (bd0==R[i])
                todo[c++]= i;
        if (!c) break;
        min= bd0;
        for (int i= 0; i<c; i++) {
            entropy[i]= 0;
            for (int j= 0; j<bd0; j++) {
                int K= 4*todo[i];
                entropy[i]+=
                    wave[XY(i, j, bd0)]=
                        allow[XYZ(0, R[adj[XY(todo[i],0,4)]], j, bd0+1, bd0)] &
                        allow[XYZ(1, R[adj[XY(todo[i],1,4)]], j, bd0+1, bd0)] &
                        allow[XYZ(2, R[adj[XY(todo[i],2,4)]], j, bd0+1, bd0)] &
                        allow[XYZ(3, R[adj[XY(todo[i],3,4)]], j, bd0+1, bd0)];
            }
            if (entropy[i] < min) min= entropy[i];
        }
        if (!min) {
            free(R);
            R= NULL;
            break;
        }
        int d= 0;
        for (int i= 0; i<c; i++) {
            if (min==entropy[i]) indices[d++]= i;
        }
        int ndx= indices[random()%d];
        int ind= ndx*bd0;
        d= 0;
        for (int i= 0; i<bd0; i++) {
            if (wave[ind+i]) possible[d++]= i;
        }
        R[todo[ndx]]= possible[random()%d];
    }
    free(adj);
    free(allow);
    free(todo);
    free(wave);
    free(entropy);
    free(indices);
    free(possible);
    if (!R) return NULL;
    char *tile= malloc((1+td0*(bd1-1))*(1+td1*(bd2-1)));
    for (int i0= 0; i0<td0; i0++)
        for (int i1= 0; i1<bd1; i1++)
            for (int j0= 0; j0<td1; j0++)
                for (int j1= 0; j1<bd2; j1++)
                    tile[XY(XY(j0, j1, bd2-1), XY(i0, i1, bd1-1), 1+td1*(bd2-1))]= 
                        blocks[XYZ(R[XY(i0, j0, td1)], i1, j1, bd1, bd2)];
    free(R);
    return tile;
}
 
int main() {
    int bdims[3]= {5,3,3};
    int size[2]= {8,8};
    time_t t;
    srandom((unsigned) time(&t));
    char *tile= wfc((char*)blocks, bdims, size);
    if (!tile) exit(0);
    for (int i= 0; i<17; i++) {
        for (int j= 0; j<17; j++) {
            printf("%c ", " #"[tile[XY(i, j, 17)]]);
        }
        printf("\n");
    }
    free(tile);
    exit(0);
}

Note: here we use R where J used i, because we use i as an index/loop counter (other than m, y and i), the comments on the j implementation should be directly relevant here. Also, when assembling the result at the end, it was convenient to treat the block overlap issue during indexing.

For simplicity, we use char as our pixel datatype (and for truth values), and int for indices (C offers a variety of similar datatypes but nothing we are doing here is big enough for that to be a concern).

Output:
      #               #   #   #
# # # #               # # # # # #
  #   #               #
# # # #               # # # # # #
      #               #   #   #
# # # # # # # # # # # #   # # # #
  #       #   #   #   #   #
# # # # # # # # # #   # # # # # #
      #           #   #       #
      # # # # # # #   # # # # #
      #   #   #   #   #   #   #
      # # # # #   # # #   # # #
      #       #   #   #   #   #
# # # # # # # #   # # # # #   # #
  #       #   #   #       #   #
# # # # # # # # # # # # # #   # #
      #               #   #   #

J

Implementation:

blocks=: 0,(|.@|:)^:(i.4)0,1 1 1,:0 1 0
wfc=: {{
  adj=: y#.y|"1(y#:,i.y)+"1/<:3 3#:1 3 5 7
  horz=: ({."1 -:"1/ {:"1) m NB. horizontal tile pairs
  vert=: ({."2 -:"1/ {:"2) m NB. vertical tile pairs
  north=: 1,~|:vert  NB. adj 1 constraint
  south=: 1,~vert    NB. adj 7 constraint
  west=:  1,~|:horz  NB. adj 3 constrint
  east=:  1,~horz    NB. adj 5 constraint 
  allow=: north,west,east,:south
  i=: ,y$_1
  while. #todo=: I._1=i do.
    wave=: */"2 ((todo{adj){i){"0 2"1 3 allow
    entropy=: +/"1 wave
    min=: <./ entropy
    if. 0=min do. EMPTY return. end.
    ndx=: ({~ ?@#) I.min=entropy
    i=: (({~?@#)I.ndx{wave) (ndx{todo)} i
  end.
  lap=. {{ y#~(+0=i.@#)-.;m$<n{.1 }}
  ({:y)lap({:$m)"1 ({.y)lap({:$m),/"2,/0 2 1 3|:(y$i){m
}}

We work with the 3x3 partial tiles, and the larger 17x17 tile which we are randomly generating. (17x17 because every 3x3 block contributes 2x2 pixels to the result and along a horizontal and vertical edge row and column of the tile, the 3x3 blocks contribute an additional row and column of pixels.)

Here, m is the list of argument blocks (which are the 3x3 blocks in this example), and i represents an 8x8 list of indexes into that list (or, conceptually, whatever dimensions were specified by y, the right argument to wfc -- but for this task y will always be 8 8), with _1 being a placeholder for the case where the index hasn't been choosen -- initially, we pick a random location in i and assign an arbitrarily picked tile to that location.

adj indexes into i -- for each item in i, adj selects that item, the item "above" it, the item to the "left" of it, the item to the "right" of it and the item "below" it (with scare quotes because the constructed tile represented by i "wraps around" on all sides). And allow lists the allowable blocks corresponding to each of those adj constraints (there's no particular order to the items in allow -- it must include all four directions, but it does not matter which direction we look at "first").

To build allow we first matched the left side of each block with the right side of each block (cartesian product) forming horz and similarly matched the tops and bottoms of the tiles forming vert. Then we build north which limits tiles based on the tile above it, and similarly for west, east, and south (when the adjacent tile is a _1 tile, no limit is imposed).

Once we're set up, we drop into a loop: todo selects the unchosen block locations, wavelists each of the unchosen block locations (for each todo value in i we select the tiles allowed by each of its adjacent locations and find the set intersection of all of those), entropy counts how many tiles are eligible for each of those location, and min is the smallest value in entropy. ndx is a randomly picked index into todo with minimal entropy and for that location we randomly pick one of the options and update i with it. (When there's only one option remaining, "randomly pick" here means we pick that option.)

Once we've assigned a block to every location in i, we use those indices to assemble the result (the 3x3 blocks overlap at their borders so we introduce a mechanism to discard the redundant pixels).

For task purposes, we will use space to represent a white pixel and "#" to represent a black pixel. Also, because characters are narrow, we will insert a space between each of these "pixels" to better approximate a square aspect ratio.

Task example: the initial blocks and three runs of wave function collapse (three, to illustrate randomness):

   (<"2) 1j1#"1 ' #'{~ blocks
┌──────┬──────┬──────┬──────┬──────┐
              #     #     #   
      # # #   # # # # # # #   
        #     #           #   
└──────┴──────┴──────┴──────┴──────┘

   task=: {{ 1j1#"1 ' #'{~ blocks wfc 8 8}}
   task&.>0 0 0
┌──────────────────────────────────┬──────────────────────────────────┬──────────────────────────────────┐
          #   #       #   #         #   #   #           #   #   #     #   #           #       #   #   
# # # # # # # #       # # # # # #   # # # # # # # # # # #   # # #     # # # # # # # # #       # # #   
  #   #       #       #       #     #           #   #   #   #   #     #       #   #   #       #   #   
  # # # # # # #       # # # # #     # # # # # # # # # # #   # # #   # # # # # # # #   # # # # #   # # 
  #       #   #       #   #   #     #   #   #           #   #   #         #       #   #   #   #   #   
# # # # # #   # # # # #   # # # # # #   # # #           # # # # # # # # # # # # # #   # # # # #   # # 
      #   #   #   #   #   #         #   #   #           #             #       #   #   #       #   #   
# # # #   # # # # # # #   # # # #   # # # # # # # # # # #             # # # # #   # # #       # # #   
  #   #   #           #   #   #     #           #   #   #             #   #   #   #   #       #   #   
# #   # # # # # # # # # # #   # # # #           # # #   # # # # # # # #   # # # # # # #       # # # # 
  #   #       #   #       #   #     #           #   #   #   #   #     #   #           #       #       
  # # #       # # # # # # # # #   # #           # # #   # # #   # #   # # #           # # # # #       
  #   #       #       #       #     #           #   #   #   #   #     #   #           #   #   #       
# # # # # # # #       # # # # # # # # # # # # # #   # # # # #   # # # # # #           # # #   # # # # 
          #   #       #   #             #   #   #   #       #   #         #           #   #   #   #   
          # # #       # # #       # # # #   # # # # # # # # #   # # # # # #           # # # # #   # # 
          #   #       #   #         #   #   #           #   #   #     #   #           #       #   #   
└──────────────────────────────────┴──────────────────────────────────┴──────────────────────────────────┘

Nim

Translation of: C
import std/[algorithm, math, random]

template XY(row, col, width: int): int =
  col + row * width

template XYZ(page, row, col, height, width: int): int =
  XY(XY(page, row, height), col, width)

const Blocks = @[byte 0, 0, 0,
                      0, 0, 0,
                      0, 0, 0,
                      0, 0, 0,
                      1, 1, 1,
                      0, 1, 0,
                      0, 1, 0,
                      0, 1, 1,
                      0, 1, 0,
                      0, 1, 0,
                      1, 1, 1,
                      0, 0, 0,
                      0, 1, 0,
                      1, 1, 0,
                      0, 1, 0]


proc wfc(blocks: seq[byte]; bdim: (int, int, int); tdim: (int, int); ): seq[byte] =
  let (td0, td1) = tdim
  let n = td0 * td1
  var adj = newSeq[int](n * 4)    # Indices in R of the four adjacent blocks.

  for i in 0..<td0:
    for j in 0..<td1:
      adj[XYZ(i, j, 0, td1, 4)]= XY(floorMod(i-1, td0), floorMod(j, td1), td1)
      adj[XYZ(i, j, 1, td1, 4)]= XY(floorMod(i, td0), floorMod(j-1, td1), td1)
      adj[XYZ(i, j, 2, td1, 4)]= XY(floorMod(i, td0), floorMod(j+1, td1), td1)
      adj[XYZ(i, j, 3, td1, 4)]= XY(floorMod(i+1, td0), floorMod(j, td1), td1)

  let (bd0, bd1, bd2) = bdim

  var horz = newSeq[byte](bd0 * bd0)
  for i in 0..<bd0:
    for j in 0..<bd0:
      horz[XY(i, j, bd0)]= 1
      for k in 0..<bd1:
        if blocks[XYZ(i, k, 0, bd1, bd2)] != blocks[XYZ(j, k, bd2-1, bd1, bd2)]:
          horz[XY(i, j, bd0)]= 0

  var vert = newSeq[byte](bd0 * bd0)
  for i in 0..<bd0:
    for j in 0..<bd0:
      vert[XY(i, j, bd0)]= 1
      for k in 0..<bd2:
        if blocks[XYZ(i, 0, k, bd1, bd2)] != blocks[XYZ(j, bd1-1, k, bd1, bd2)]:
          vert[XY(i, j, bd0)]= 0
          break

  var allow = newSeq[byte](4 * (bd0 + 1) * bd0)
  allow.fill(1)
  for i in 0..<bd0:
    for j in 0..<bd0:
      allow[XYZ(0, i, j, bd0+1, bd0)] = vert[XY(j, i, bd0)]
      allow[XYZ(1, i, j, bd0+1, bd0)] = horz[XY(j, i, bd0)]
      allow[XYZ(2, i, j, bd0+1, bd0)] = horz[XY(i, j, bd0)]
      allow[XYZ(3, i, j, bd0+1, bd0)] = vert[XY(i, j, bd0)]

  var
    todo = newSeq[int](n)
    wave = newSeq[byte](n * bd0)
    entropy = newSeq[int](n)
    indices = newSeq[int](n)
    possible = newSeq[int](bd0)
  var r = newSeq[int](n)
  r.fill(bd0)
  while true:
    var c = 0
    for i in 0..<n:
      if bd0 == r[i]:
        todo[c]= i
        inc c
    if c == 0: break
    var min = bd0
    for i in 0..<c:
      entropy[i] = 0
      for j in 0..<bd0:
        let val = allow[XYZ(0, r[adj[XY(todo[i],0,4)]], j, bd0+1, bd0)] and
                  allow[XYZ(1, r[adj[XY(todo[i],1,4)]], j, bd0+1, bd0)] and
                  allow[XYZ(2, r[adj[XY(todo[i],2,4)]], j, bd0+1, bd0)] and
                  allow[XYZ(3, r[adj[XY(todo[i],3,4)]], j, bd0+1, bd0)]
        wave[XY(i, j, bd0)] = val
        entropy[i] += val.int
      if entropy[i] < min: min = entropy[i]
    if min == 0:
      r.setLen(0)
      break
    var d = 0
    for i in 0..<c:
      if min == entropy[i]:
        indices[d] = i
        inc d
    var ndx = indices[rand(d - 1)]
    let ind = ndx * bd0
    d = 0
    for i in 0..<bd0:
      if wave[ind + i] != 0:
        possible[d] = i
        inc d
    r[todo[ndx]] = possible[rand(d - 1)];

  if r.len == 0: return @[]
  result = newSeq[byte]((1 + td0 * (bd1 - 1)) * (1 + td1 * (bd2 - 1)))
  for i0 in 0..<td0:
    for i1 in 0..<bd1:
      for j0 in 0..<td1:
        for j1 in 0..<bd2:
          result[XY(XY(j0, j1, bd2-1), XY(i0, i1, bd1-1), 1+td1*(bd2-1))] =
                        blocks[XYZ(r[XY(i0, j0, td1)], i1, j1, bd1, bd2)]

const BDims = (5, 3, 3)
const Size = (8, 8)
randomize()
let tile = wfc(Blocks, BDims, Size)
if tile.len == 0: quit QuitSuccess
for i in 0..16:
  for j in 0..16:
    stdout.write " #"[tile[XY(i, j, 17)]], ' '
  echo()
Output:
          #   #           #   #   
# # # # # # # #           # # # # 
  #   #       #           #       
# #   # # # # # # # # # # # # # # 
  #   #   #       #   #       #   
  # # #   # # # # #   # # # # #   
  #   #   #   #   #   #   #   #   
# # # #   # # # # #   # # #   # # 
      #   #       #   #   #   #   
# # # #   # # # # # # # # #   # # 
  #   #   #   #           #   #   
# #   # # # # # # # # # # #   # # 
  #   #           #   #   #   #   
  # # #           # # #   # # #   
  #   #           #   #   #   #   
# # # # # # # # # # # # # #   # # 
          #   #           #   #   

Perl

Translation of: Raku
use v5.36;
use experimental 'for_list';

my @Blocks = ( [ <0 0 0>, <0 0 0>, <0 0 0> ],
               [ <0 0 0>, <1 1 1>, <0 1 0> ],
               [ <0 1 0>, <0 1 1>, <0 1 0> ],
               [ <0 1 0>, <1 1 1>, <0 0 0> ],
               [ <0 1 0>, <1 1 0>, <0 1 0> ],
             );

sub X($a,$b) { my @c; for my $aa (0..$a-1) { map { push @c, $aa, $_ } 0..$b-1 } @c }

sub  XY(       $row, $col, $width)          { $col + $row * $width }
sub XYZ($page, $row, $col, $height, $width) { XY( XY($page, $row, $height), $col, $width) }

sub wfc($B, $bdim, $tdim) {
   my ($td0,$td1) = @$tdim;
   my $N = $td0 * $td1;
   my @blocks = map @$_, @$B; # flatten

   my @adj; # indices in R of the four adjacent blocks
   for my($i,$j) (X $td0, $td1) {
      $adj[XYZ($i, $j, 0, $td1, 4)] = XY(($i-1)%$td0,  $j   %$td1, $td1); # above (index 1)
      $adj[XYZ($i, $j, 1, $td1, 4)] = XY( $i   %$td0, ($j-1)%$td1, $td1); # left  (index 3)
      $adj[XYZ($i, $j, 2, $td1, 4)] = XY( $i   %$td0, ($j+1)%$td1, $td1); # right (index 5)
      $adj[XYZ($i, $j, 3, $td1, 4)] = XY(($i+1)%$td0,  $j   %$td1, $td1); # below (index 7)
   }

   my ($bd0,$bd1,$bd2) = @$bdim;
   my @horz; # blocks which can sit next to each other horizontally
   for my($i,$j) (X $bd0, $bd0) {
      @horz[XY($i,$j,$bd0)] = 1;
      for my $k (0..$bd1-1) {
         $horz[XY($i, $j, $bd0)]= 0 if $blocks[XYZ($i, $k,      0, $bd1, $bd2)]
                                    != $blocks[XYZ($j, $k, $bd2-1, $bd1, $bd2)]
      }
   }

   my @vert; # blocks which can sit next to each other vertically */
   for my($i,$j) (X $bd0, $bd0) {
      $vert[XY($i,$j,$bd0)] = 1;
      for my $k (0..$bd2-1) {
         if ($blocks[XYZ($i, 0, $k, $bd1, $bd2)] != $blocks[XYZ($j, $bd1-1, $k, $bd1, $bd2)]) {
            $vert[XY($i, $j, $bd0)] = 0;
            last
         }
      }
   }

   my @allow = (1) x (4*($bd0+1)*$bd0); # all block constraints, based on neighbors
   for my($i,$j) (X $bd0, $bd0) {
      $allow[XYZ(0, $i, $j, $bd0+1, $bd0)] = $vert[XY($j, $i, $bd0)]; # above (north)
      $allow[XYZ(1, $i, $j, $bd0+1, $bd0)] = $horz[XY($j, $i, $bd0)]; # left  (west)
      $allow[XYZ(2, $i, $j, $bd0+1, $bd0)] = $horz[XY($i, $j, $bd0)]; # right (east)
      $allow[XYZ(3, $i, $j, $bd0+1, $bd0)] = $vert[XY($i, $j, $bd0)]; # below (south)
   }

   my @R = ($bd0) x $N;
   my (@todo, @wave, @entropy, @indices, $min, @possible);

   while () {
      my $c;
      for (0..$N-1) { $todo[$c++] = $_ if $bd0 == $R[$_] }
      last unless $c;
      $min = $bd0;
      for my $i (0..$c-1) {
         $entropy[$i] = 0;
         for my $j (0..$bd0-1) {
            $entropy[$i] +=
               $wave[XY($i, $j, $bd0)] =
                  $allow[XYZ(0, $R[ $adj[XY($todo[$i],0,4)] ], $j, $bd0+1, $bd0)] &
                  $allow[XYZ(1, $R[ $adj[XY($todo[$i],1,4)] ], $j, $bd0+1, $bd0)] &
                  $allow[XYZ(2, $R[ $adj[XY($todo[$i],2,4)] ], $j, $bd0+1, $bd0)] &
                  $allow[XYZ(3, $R[ $adj[XY($todo[$i],3,4)] ], $j, $bd0+1, $bd0)]
         }
         $min = $entropy[$i] if $entropy[$i] < $min
      }

      @R=[] and last unless $min;

      my $d = 0;
      for (0..$c-1) { $indices[$d++] = $_ if $min == $entropy[$_] }
      my $ind = $bd0 * (my $ndx = $indices[ int rand $d ]);
      $d = 0;
      for (0..$bd0-1) { $possible[$d++] = $_ if $wave[$ind+$_]  }
      $R[$todo[$ndx]] = $possible[ int rand $d ];
   }

   return "DOES NOT COMPUTE" unless @R > 1;

   my @tile;
   for my($i0,$i1)(X $td0, $bd1) {
       for my($j0,$j1) (X $td1, $bd2) {
           $tile[XY(XY($j0, $j1, $bd2-1), XY($i0, $i1, $bd1-1), 1+$td1*($bd2-1))] =
                (' ','#')[ $blocks[XYZ($R[XY($i0, $j0, $td1)], $i1, $j1, $bd1, $bd2)] ]
       }
   }
   my $width = 2 * sqrt scalar @tile;
   join(' ', @tile) =~ s/.{$width}\K(?=.)/\n/gr;
}

my @bdims = (5,3,3);
my @size  = (8,8);
say wfc(\@Blocks, \@bdims, \@size);
Output:
      #               #   #   #
# # # #               # # # # # #
  #   #               #
# # # #               # # # # # #
      #               #   #   #
      # # # # # # # # #   # # #
      #   #   #   #   #   #   #
      # # # # # # # # # # # # #
      #                       #
      # # # # # # # # # # # # #
      #   #   #   #   #   #   #
# # # # # #   # # #   # # #   # #
  #       #   #   #   #   #   #
# #       # # #   # # # # # # # #
  #       #   #   #
# # # # # # # # # # # # # # # # #
      #               #   #   #

Phix

Library: Phix/pGUI
Library: Phix/online

You can run this online here.

--
-- demo\rosetta\WaveFunctionCollapse.exw
-- =====================================
--
with javascript_semantics
requires("1.0.2") -- (do until, and a switch <atom> bugfix)
include pGUI.e
Ihandle dlg, canvas
cdCanvas cddbuffer

bool bOverlap = true, -- (debug aids)
     bSpat = false -- (show space as '@')

integer N = 8 -- board size (nb must be even)
constant title = "Wave Function Collapse", 
         help_text = """
Press 'o' to toggle overlap (see note below).
Press '@' to toggle display spaces as '@'.
Press '-' to decrease board size (min 2x2).
Press '+' to increase board size (max 40x40).
Press ' ' to start afresh.

Note that it is not really possible to visually verify 
that a pattern is correct unless overlap is turned off.
"""
                -- space,     T,    -|,    iT,    |-    
constant tilem = {0b0000,0b0111,0b1011,0b1101,0b1110},
                --       L,      R,      U,      D
         valid = {{0b00101,0b10001,0b01001,0b00011},
                  {0b11010,0b01110,0b01001,0b11100},
                  {0b11010,0b10001,0b10110,0b11100},
                  {0b11010,0b01110,0b10110,0b00011},
                  {0b00101,0b01110,0b10110,0b11100}}
-- eg valid[1=space][4=D] means space or T can go below it,
--    with bits of each valid[][] being read right-to-left.

sequence grid,      -- -1 if unknown, else one of tilem
         allowed,   -- initially 0b11111 (all possible) -> 1 bit set
         entropy    -- count matching allowed (speedwise/simplicity)

integer left    -- N*N..0, with 0=finished, -1=FAIL, -2=REDO

function lowest_entropy()
    -- returns a random tile from those with the lowest entropy
    integer row, col, me = 5, count = 0
    for r=1 to N do
        for c=1 to N do
            if grid[r][c]=-1 then -- ignoring any already done
                integer e = entropy[r][c]
                if e<=me then
                    if e<me then
                        me = e
                        count = 0
                    end if
                    count += 1
                    if rand(count)=1 then
                        {row,col} = {r,c}
                    end if
                end if
            end if
        end for
    end for
    return {row,col}
end function

function pop_count(integer p)
    -- Kernigans bit counter:
    integer e = 0
    while p do
        p &&= p-1
        e += 1
    end while
    return e
end function

function permitted(integer p, d)
    --
    -- Given p, 0b00001..0b11111, a 1-5 bitmask,
    -- calculate the permitted tiles in direction
    -- d (1..4 for LRUD), eg a T(2) can have 2|3|4
    -- on the right, and a 3 can have 1|5, so if
    -- p is 0b01100 the result is 0b11111 (all),
    -- that is, when d is 2 (ie right).
    --
    integer nm = 0
    for i=1 to 5 do
        integer m = power(2,i-1)
        if and_bits(p,m) then
            nm = or_bits(nm,valid[i][d])
        end if
    end for
    return nm
end function

function propagate(integer r,c,p)
    --
    -- Propagate the permitted tiles, given that only
    -- those in p (0b00001..0b11111, a 1..5 bitmask)
    -- are now allowed at [r][c]. Note this can fail,
    -- especially for some ~2x3 enclosed spaces, and
    -- in that case you want to undo everything, and
    -- clear some initial permitted bit setting.
    --
    for j,d in {{0,-1},{0,1},{-1,0},{1,0}} do --LRUD
        integer {dr,dc} = d,
                 nr = r+dr,
                 nc = c+dc
        if nr>=1 and nr<=N and nc>=1 and nc<=N then
            integer nm = permitted(p,j),
                    op = allowed[nr][nc],
                    np = and_bits(op,nm)
            if np=0 then return false end if
            if op!=np then
                allowed[nr][nc] = np
                entropy[nr][nc] = pop_count(np)
                if not propagate(nr,nc,np) then return false end if
            end if
        end if
    end for
    return true
end function

procedure wfc(object f=0)
    --
    -- wave function collapse: (iterative/one cell at a time, because
    --      this was once on a timer, but now wfc_init() just loops.)
    --
    -- There is, I guess, around a 1 in 8000 chance of this failing,
    -- which means 1 in 10 40x40 boards fail, presumbably because it
    -- has surrounded an area and none of the edges will work out.
    -- Setting left to -2 triggers the outer retry in wfc_init().
    --
    integer {r,c} = lowest_entropy(),
            g = grid[r][c],
            p = allowed[r][c]
    assert(g=-1)
    assert(p!=0)
    -- pick a random but valid tile:
    for i in shuffle(tagset(5)) do
        integer m = power(2,i-1)
        if and_bits(p,m) then
            -- in case propagation fails, make a backup
            sequence saveae = deep_copy({allowed,entropy})
            grid[r][c] = tilem[i]
            allowed[r][c] = m
            entropy[r][c] = 1
            left -= 1
            if not propagate(r,c,m) then
                grid[r][c] = g
                {allowed,entropy} = saveae
                saveae = {} -- kill refcounts
                p -= m -- don't try this again!
                if p=0 then
--                  printf(1,"panic: allowed[%d][%d] := 0!\n",{r,c})
                    left = -2   -- trigger a restart
                    return
                end if
                integer e = pop_count(p)
                assert(p!=0 and e!=0 and e==entropy[r][c]-1)
                allowed[r][c] = p
                entropy[r][c] = e
                left += 1
            end if
            return
        end if
    end for
end procedure

procedure wfc_init() 
    do
        grid = repeat(repeat(-1,N),N)
        allowed = repeat(repeat(0b11111,N),N)
        entropy = repeat(repeat(5,N),N)
        left = N*N
        do
            wfc()
        until left<=0
    until left!=-2
end procedure

-- (the rest of this is all fairly standard code)

function redraw_cb(Ihandle ih)
    integer {cw,ch} = IupGetIntInt(ih, "DRAWSIZE"),
            N2 = N/2,   -- (nb forces N to be even)
            N3 = N2+1,
            d = floor(min(cw,ch)/N),
            d9 = floor(min(cw,ch)/(2*N+1)),
            d2 = floor(d/2), d4 = N2*d
    cw = floor(cw/2)
    ch = floor(ch/2)

    cdCanvasActivate(cddbuffer)
    cdCanvasClear(cddbuffer)
    cdCanvasSetForeground(cddbuffer,CD_BLUE)
    cdCanvasSetLineWidth(cddbuffer,3)
    for row=1 to N do
        integer ry = iff(bOverlap?ch-(row*2-N-1)*d9
                                 :ch-(row-N3)*d-d2)
        for col=1 to N do
            integer rx = iff(bOverlap?cw+(col*2-N-1)*d9
                                     :cw+(col-N3)*d+d2)
            integer g = grid[row][col],
                    e = entropy[row][col]
            if g=0b1111 then
                cdCanvasSetForeground(cddbuffer,CD_RED)
                cdCanvasSetTextAlignment(cddbuffer, CD_CENTER) 
                cdCanvasText(cddbuffer,rx,ry,"?")
                cdCanvasSetForeground(cddbuffer,CD_BLUE)
            elsif bSpat and g=0b0000 then
                cdCanvasSetTextAlignment(cddbuffer, CD_CENTER) 
                cdCanvasText(cddbuffer,rx,ry,"@")
            elsif g!=-1 then
                assert(e=1)
                for i,dxy in {{0,-1},{-1,0},{0,1},{1,0}} do -- LURD
                    if and_bits(g,power(2,i-1)) then
                        integer {dr,dc} = sq_mul(dxy,iff(bOverlap?d9*2:d2))
                        cdCanvasLine(cddbuffer,rx,ry,rx+dc,ry+dr)
                    end if
                end for
            end if
        end for
    end for
    cdCanvasFlush(cddbuffer)
    string o = iff(bOverlap?"":" (no overlap)"),
           f = iff(left!=-1?"":" FAIL")
    IupSetStrAttribute(dlg,"TITLE","%s [%dx%d] %s%s",{title,N,N,o,f})
    return IUP_DEFAULT
end function

function map_cb(Ihandle ih)
    cdCanvas cdcanvas = cdCreateCanvas(CD_IUP, ih)
    cddbuffer = cdCreateCanvas(CD_DBUFFER, cdcanvas)
    return IUP_DEFAULT
end function

function help_cb(Ihandln /*ih*/)
    IupMessage(title,help_text,bWrap:=false)
    return IUP_IGNORE -- (don't open browser help!)
end function

function key_cb(Ihandle /*dlg*/, atom c)
    if c=K_ESC then return IUP_CLOSE end if -- (standard practice for me)
    if c=K_F5 then return IUP_DEFAULT end if -- (let browser reload work)
    if c=K_F1 then return help_cb(NULL) end if
    switch lower(c)
        case 'c': wfc() 
        case 'o': bOverlap = not bOverlap
        case '-': N = max(N-4,0)
                  fallthrough
        case '+': N = min(N+2,40)
                  fallthrough
        case ' ': wfc_init()
        case '@': bSpat = not bSpat
    end switch
    IupUpdate(canvas)
    return IUP_IGNORE
end function

procedure main()
    IupOpen()
    canvas = IupGLCanvas("RASTERSIZE=440x440")
    dlg = IupDialog(canvas,`TITLE="%s"`,{title})
    IupSetCallbacks(canvas,{"MAP_CB",Icallback("map_cb"),
                            "ACTION",Icallback("redraw_cb")})
    IupSetCallback(dlg, "KEY_CB", Icallback("key_cb"))
    IupSetAttributeHandle(NULL,"PARENTDIALOG",dlg)
    wfc_init()
    IupShow(dlg)
    IupSetAttribute(canvas,"RASTERSIZE",NULL)
    if platform()!=JS then
        IupMainLoop()
        IupClose()
    end if
end procedure
 
main()

trivial ditty

Translation of the Python ditty on the talk page:
This trivial solution works because we're only ever adding left to right,
and therefore only verifying L/U vs R/D, and it is not possible to have
any two R/D for which no tile is valid. Were this to fill in each row/line
more randomly, it would soon fail with no tile matching >=3 neighbours.
(lowest entropy would also fail b/c it'd favour 2 no conn over 3 with)

with javascript_semantics
include builtins/unicode_console.e
{} = unicode_console()

with trace
procedure make_rows(integer w)
    sequence conn = split("0000.1101.1110.0111.1011","."), -- RULD flags
            tiles = split("  ... ╠...═╩...═╣...═╦","..."), --[...aligned]
              res = {},
                r = {}, p, t
    for n=1 to w do
        {p, r} = {r, {}}
        for i=1 to w do
            t = {}
            for x=1 to 5 do
                if  (length(r)=0 or conn[x][3]=conn[r[$]][1])       -- L=R
                and (length(p)=0 or conn[x][2]=conn[p[i]][4]) then  -- U=D
                    t &= x
                end if
            end for
            r &= t[rand(length(t))] 
        end for
        res = append(res,join(extract(tiles,r),""))
    end for
    puts(1,join(res,"\n"))
    wait_key()
end procedure

make_rows(20)

Raku

Translation of: C
# 20220728 Raku programming solution

my @Blocks = ( [   <0 0 0>,  
                   <0 0 0>,  
		   <0 0 0>    ],
               [   <0 0 0>,  
	           <1 1 1>,  
		   <0 1 0>    ],
               [   <0 1 0>, 
	           <0 1 1>,
	       	   <0 1 0>    ],
               [   <0 1 0>,
	           <1 1 1>,
	       	   <0 0 0>    ],
               [   <0 1 0>,
	           <1 1 0>,
	       	   <0 1 0>    ], );

sub XY(\row, \col, \width) { col+row*width }
sub XYZ(\page, \row, \col, \height, \width) {
   XY( XY(page, row, height), col, width)
}

sub wfc(@blocks, @bdim, @tdim) {

   my \N  = [*] my (\td0,\td1) = @tdim[0,1]; 
   my @adj; # indices in R of the four adjacent blocks
   for ^td0 X ^td1 -> (\i,\j) {                        # in a 3x3 grid
      @adj[XYZ(i,j,0,td1,4)]= XY((i-1)%td0,j%td1,td1); # above (index 1) 
      @adj[XYZ(i,j,1,td1,4)]= XY(i%td0,(j-1)%td1,td1); # left  (index 3) 
      @adj[XYZ(i,j,2,td1,4)]= XY(i%td0,(j+1)%td1,td1); # right (index 5) 
      @adj[XYZ(i,j,3,td1,4)]= XY((i+1)%td0,j%td1,td1); # below (index 7) 
   }

   my (\bd0,\bd1,\bd2) = @bdim[0..2];
   my @horz; # blocks which can sit next to each other horizontally 
   for ^bd0 X ^bd0 -> (\i,\j) {
      @horz[XY(i,j,bd0)] = 1;
      for ^bd1 -> \k {
         @horz[XY(i, j, bd0)]= 0 if @blocks[XYZ(i, k,     0, bd1, bd2)] !=
	                            @blocks[XYZ(j, k, bd2-1, bd1, bd2)]
      }
   }
   
   my @vert; # blocks which can sit next to each other vertically */
   for  ^bd0 X ^bd0 -> (\i,\j) {
      @vert[XY(i,j,bd0)] = 1;
      for ^bd2 -> \k {
         if @blocks[XYZ(i,     0, k, bd1, bd2)] != 
	    @blocks[XYZ(j, bd1-1, k, bd1, bd2)] {
	    @vert[XY(i, j, bd0)]= 0 andthen last;
	 }
      }
   }

   my @allow = 1 xx 4*(bd0+1)*bd0; # all block constraints, based on neighbors
   for  ^bd0 X ^bd0 -> (\i,\j) {
      @allow[XYZ(0, i, j, bd0+1, bd0)] = @vert[XY(j, i, bd0)]; # above (north)
      @allow[XYZ(1, i, j, bd0+1, bd0)] = @horz[XY(j, i, bd0)]; # left  (west) 
      @allow[XYZ(2, i, j, bd0+1, bd0)] = @horz[XY(i, j, bd0)]; # right (east) 
      @allow[XYZ(3, i, j, bd0+1, bd0)] = @vert[XY(i, j, bd0)]; # below (south) 
   }

   my (@R, @todo, @wave, @entropy, @indices, $min, @possible) = bd0 xx N;
   loop {
      my $c = 0;
      for ^N { @todo[$c++] = $_ if bd0 == @R[$_] }   
      last unless $c;
      $min = bd0;
      for ^$c -> \i {
         @entropy[i]= 0;
         for ^bd0 -> \j {
            @entropy[i] += 
               @wave[XY(i, j, bd0)] =
                  @allow[XYZ(0, @R[@adj[XY(@todo[i],0,4)]], j, bd0+1, bd0)] +& 
                  @allow[XYZ(1, @R[@adj[XY(@todo[i],1,4)]], j, bd0+1, bd0)] +&
                  @allow[XYZ(2, @R[@adj[XY(@todo[i],2,4)]], j, bd0+1, bd0)] +&
                  @allow[XYZ(3, @R[@adj[XY(@todo[i],3,4)]], j, bd0+1, bd0)]
         }
	 $min = @entropy[i] if @entropy[i] < $min
      }
      
      unless $min { @R=[] andthen last } # original behaviour 
      #unless $min { @R = bd0 xx N andthen redo } # if failure is not an option

      my $d = 0;
      for ^$c { @indices[$d++] = $_ if $min == @entropy[$_] }
      my \ind = bd0 * my \ndx = @indices[ ^$d .roll ];
      $d = 0;
      for ^bd0 { @possible[$d++] = $_ if @wave[ind+$_]  }
      @R[@todo[ndx]] = @possible[ ^$d .roll ];
   }

   exit unless @R.Bool;

   my @tile;
   for ^td0 X ^bd1 X ^td1 X ^bd2 -> (\i0,\i1,\j0,\j1) {
      @tile[XY(XY(j0, j1, bd2-1), XY(i0, i1, bd1-1), 1+td1*(bd2-1))] =
         @blocks[XYZ(@R[XY(i0, j0, td1)], i1, j1, bd1, bd2)]
   }

   return @tile
}

my (@bdims,@size) := (5,3,3), (8,8);

my @tile = wfc @Blocks».List.flat, @bdims, @size  ;

say .join.trans( [ '0', '1' ] => [ '  ', '# ' ] ) for @tile.rotor(17)
Output:
          #           #   #
# # # # # # # # # # # # # # # # #
  #   #       #   #           #
  # # # # # # #   # # # # # # #
  #       #   #   #   #   #   #
  # # # # #   # # #   # # # # #
  #   #   #   #   #   #       #
# #   # # # # #   # # #       # #
  #   #       #   #   #       #
# #   # # # # # # # # #       # #
  #   #   #           #       #
# #   # # #           # # # # # #
  #   #   #           #   #
# #   # # #           # # # # # #
  #   #   #           #       #
# # # # # #           # # # # # #
          #           #   #


Wren

Translation of: C

The following is a translation of the C version before macros were added. Wren doesn't support macros and, whilst I could use functions instead, I decided on efficiency grounds to leave it as it is.

import "random" for Random

var rand = Random.new()

var blocks = [
    0, 0, 0,
    0, 0, 0,
    0, 0, 0,
    0, 0, 0,
    1, 1, 1,
    0, 1, 0,
    0, 1, 0,
    0, 1, 1,
    0, 1, 0,
    0, 1, 0,
    1, 1, 1,
    0, 0, 0,
    0, 1, 0,
    1, 1, 0,
    0, 1, 0
]

var wfc = Fn.new { |blocks, tdim, target|
    var N   = target[0] * target[1]
    var t0  = target[0]
    var t1  = target[1]
    var adj = List.filled(4*N, 0)
    for (i in 0...t0) {
        for (j in 0...t1) {
            var k = j + t1*i
            var m = 4 * k
            adj[m  ] =     j       + t1*((t0+i-1)%t0)  /* above (1) */
            adj[m+1] = (t1+j-1)%t1 + t1*     i         /* left  (3) */
            adj[m+2] = (   j+1)%t1 + t1*     i         /* right (5) */
            adj[m+3] =     j       + t1*((   i+1)%t0)  /* below (7) */
        }
    }
    var td0 = tdim[0]
    var td1 = tdim[1]
    var td2 = tdim[2]
    var horz = List.filled(td0*td0, 0)
    for (i in 0...td0) {
        for (j in 0...td0) {
            horz[j+i*td0] = 1
            for (k in 0...td1) {
                if (blocks[0+td2*(k+td1*i)] != blocks[(td2-1)+td2*(k+td1*j)]) {
                    horz[j+i*td0] = 0
                    break
                }
            }
        }
    }
    var vert = List.filled(td0*td0, 0)
    for (i in 0...td0) {
        for (j in 0...td0) {
            vert[j+i*td0]= 1
            for (k in 0...td2) {
                if (blocks[k+td2*(0+td1*i)] != blocks[k+td2*((td2-1)+td1*j)]) {
                    vert[j+i*td0]= 0
                    break
                }
            }
        }
    }
    var stride = (td0+1) * td0
    var allow  = List.filled(4 * stride, 1)
    for (i in 0...td0) {
        for (j in 0...td0) {
            allow[           (i*td0)+j] = vert[(j*td0)+i] /* above (north) */
            allow[   stride +(i*td0)+j] = horz[(j*td0)+i] /* left  (west)  */
            allow[(2*stride)+(i*td0)+j] = horz[(i*td0)+j] /* right (east)  */
            allow[(3*stride)+(i*td0)+j] = vert[(i*td0)+j] /* below (south) */
        }
    }
    var R        = List.filled(N, td0)
    var todo     = List.filled(N, 0)
    var wave     = List.filled(N*td0, 0)
    var entropy  = List.filled(N, 0)
    var indices  = List.filled(N, 0)
    var min      = 0
    var possible = List.filled(td0, 0)
    while (true) {
        var c = 0
        for (i in 0...N) {
            if (td0 == R[i]) {
                todo[c] = i
                c = c + 1
            }
        }
        if (c == 0) break
        min = td0
        for (i in 0...c) {
            entropy[i] = 0
            for (j in 0...td0) {
                var K = 4*todo[i]
                wave[i*td0 + j] = allow[           td0*R[adj[K  ]]+j] &  /* above */
                                  allow[   stride +td0*R[adj[K+1]]+j] &  /* left  */
                                  allow[(2*stride)+td0*R[adj[K+2]]+j] &  /* right */
                                  allow[(3*stride)+td0*R[adj[K+3]]+j]    /* below */
                entropy[i] = entropy[i] + wave[i*td0 + j]
            }
            if (entropy[i] < min) min = entropy[i]
        }
        if (min == 0) {
            R = null
            break
        }
        var d = 0
        for (i in 0...c) {
            if (min == entropy[i]) {
                indices[d] = i
                d = d + 1
            }
        }
        var ndx = indices[rand.int(0, d)]
        var ind = ndx * td0
        d = 0
        for (i in 0...td0) {
            if (wave[ind+i] != 0) {
                possible[d] = i
                d = d + 1
            }
        }
        R[todo[ndx]] = possible[rand.int(0, d)]
    }
    if (!R) return null
    var tile = List.filled((1+t0*(td1-1))*(1+t1*(td2-1)), 0)
    for (i0 in 0...t0) {
        for (i1 in 0...td1) {
            for (j0 in 0...t1) {
                for (j1 in 0...td2) {
                    var t = j1 + (td2-1)*j0 + (1+t1*(td2-1))*(i1 + (td1-1)*i0)
                    tile[t] = blocks[j1 + td2*(i1 + td1*R[j0+t1*i0])]
                }
            }
        }
    }
    return tile
}

var tdims = [5, 3, 3]
var size = [8, 8]
var tile = wfc.call(blocks, tdims, size)
if (!tile) return
for (i in 0..16) {
    for (j in 0..16) {
        System.write("%(" #"[tile[j+i*17]]) ")
    }
    System.print()
}
Output:

Sample output:

  #       #       #   #       #   
# # # # # #       # # #       # # 
      #   #       #   #       #   
# # # # # #       # # # # # # # # 
  #       #       #       #       
  # # # # #       # # # # #       
  #   #   #       #   #   #       
# # # # # #       # # #   # # # # 
          #       #   #   #   #   
# # # # # # # # # # # #   # # # # 
  #   #       #       #   #       
  # # # # # # # # # # # # #       
  #       #       #       #       
# # # # # #       # # # # # # # # 
      #   #       #   #       #   
# # # # # #       # # #       # # 
  #       #       #   #       #   
Cookies help us deliver our services. By using our services, you agree to our use of cookies.