Task: Kronecker product based fractals







Python: import os
from PIL import Image


def imgsave(path, arr):
    w, h = len(arr), len(arr[0])
    img = Image.new('1', (w, h))
    for x in range(w):
        for y in range(h):
            img.putpixel((x, y), arr[x][y])
    img.save(path)


def get_shape(mat):
    return len(mat), len(mat[0])


def kron(matrix1, matrix2):
    
    final_list = []

    count = len(matrix2)

    for elem1 in matrix1:
        for i in range(count):
            sub_list = []
            for num1 in elem1:
                for num2 in matrix2[i]:
                    sub_list.append(num1 * num2)
            final_list.append(sub_list)

    return final_list


def kronpow(mat):
    
    matrix = mat
    while True:
        yield matrix
        matrix = kron(mat, matrix)


def fractal(name, mat, order=6):
    
    path = os.path.join('fractals', name)
    os.makedirs(path, exist_ok=True)

    fgen = kronpow(mat)
    print(name)
    for i in range(order):
        p = os.path.join(path, f'{i}.jpg')
        print('Calculating n =', i, end='\t', flush=True)

        mat = next(fgen)
        imgsave(p, mat)

        x, y = get_shape(mat)
        print('Saved as', x, 'x', y, 'image', p)


test1 = [
    [0, 1, 0],
    [1, 1, 1],
    [0, 1, 0]
]

test2 = [
    [1, 1, 1],
    [1, 0, 1],
    [1, 1, 1]
]

test3 = [
    [1, 0, 1],
    [0, 1, 0],
    [1, 0, 1]
]

fractal('test1', test1)
fractal('test2', test2)
fractal('test3', test3)




Fortran: program Kron_frac
  implicit none

  interface
    function matkronpow(M, n) result(Mpowern)
      integer, dimension(:,:), intent(in) :: M
      integer, intent(in) :: n
      integer, dimension(size(M, 1)**n, size(M,2)**n) :: Mpowern
    end function matkronpow

    function kron(A, B) result(M)
      integer, dimension(:,:), intent(in) :: A, B
      integer, dimension(size(A,1)*size(B,1), size(A,2)*size(B,2)) :: M
    end function kron

    subroutine write2file(M, filename)
      integer, dimension(:,:), intent(in) :: M
      character(*), intent(in) :: filename
    end subroutine write2file
  end interface

  integer, parameter :: n = 4
  integer, dimension(3,3) :: Vicsek, Sierpinski
  integer, dimension(4,4) :: Hadamard
  integer, dimension(3**n, 3**n) :: fracV, fracS
  integer, dimension(4**n, 4**n) :: fracH

  Vicsek = reshape( (/0, 1, 0,&
                      1, 1, 1,&
                      0, 1, 0/),&
                    (/3,3/) )

  Sierpinski = reshape( (/1, 1, 1,&
                          1, 0, 1,&
                          1, 1, 1/),&
                          (/3,3/) )

  Hadamard = transpose(reshape( (/ 1, 0, 1, 0,&
                         1, 0, 0, 1,&
                         1, 1, 0, 0,&
                         1, 1, 1, 1/),&
                         (/4,4/) ))

  fracV = matkronpow(Vicsek, n)
  fracS = matkronpow(Sierpinski, n)
  fracH = matkronpow(Hadamard, n)

  call write2file(fracV, 'Viczek.txt')
  call write2file(fracS, 'Sierpinski.txt')
  call write2file(fracH, 'Hadamard.txt')

end program

function matkronpow(M, n) result(Mpowern)
interface
function kron(A, B) result(M)
  integer, dimension(:,:), intent(in) :: A, B
  integer, dimension(size(A,1)*size(B,1), size(A,2)*size(B,2)) :: M
  end function kron
end interface

  integer, dimension(:,:), intent(in) :: M
  integer, intent(in) :: n
  integer, dimension(size(M, 1)**n, size(M,2)**n) :: Mpowern
  integer, dimension(:,:), allocatable :: work1, work2
  integer :: icount

  if (n <= 1) then
     Mpowern = M
  else
    allocate(work1(size(M,1), size(M,2)))
    work1 = M
    do icount = 2,n
      allocate(work2(size(M,1)**icount, size(M,2)**icount))
      work2 = kron(work1, M)
      deallocate(work1)
      allocate(work1(size(M,1)**icount, size(M,2)**icount))
      work1 = work2
      deallocate(work2)
    end do
    Mpowern = work1
    deallocate(work1)
  end if

end function matkronpow

function kron(A, B) result(M)
  integer, dimension(:,:), intent(in) :: A, B
  integer, dimension(size(A,1)*size(B,1), size(A,2)*size(B,2)) :: M
  integer :: ia, ja, ib, jb, im, jm

  do ja = 1, size(A, 2)
    do ia = 1, size(A, 1)
      do jb = 1, size(B, 2)
        do ib = 1, size(B, 1)
          im = (ia - 1)*size(B, 1) + ib
          jm = (ja - 1)*size(B, 2) + jb
          M(im, jm) = A(ia, ja) * B(ib, jb)
        end do
      end do
    end do
  end do

end function kron

subroutine write2file(M, filename)
  integer, dimension(:,:), intent(in) :: M
  character(*), intent(in) :: filename
  integer :: ii, jj
  integer, parameter :: fi = 10

  open(fi, file=filename, status='replace')

  do ii = 1,size(M, 1)
    do jj = 1,size(M,2)
      if (M(ii,jj) == 0) then
        write(fi, '(A)', advance='no') ' '
      else
        write(fi, '(A)', advance='no') '*'
      end if
    end do
    write(fi, '(A)') ' '
  end do

  close(fi)

end subroutine write2file