Task: Kronecker product based fractals


C++: #include <cassert>
#include <vector>

#include <QImage>

template <typename scalar_type> class matrix {
public:
    matrix(size_t rows, size_t columns)
        : rows_(rows), columns_(columns), elements_(rows * columns) {}
    matrix(size_t rows, size_t columns,
        const std::initializer_list<std::initializer_list<scalar_type>>& values)
        : rows_(rows), columns_(columns), elements_(rows * columns) {
        assert(values.size() <= rows_);
        size_t i = 0;
        for (const auto& row : values) {
            assert(row.size() <= columns_);
            std::copy(begin(row), end(row), &elements_[i]);
            i += columns_;
        }
    }
    size_t rows() const { return rows_; }
    size_t columns() const { return columns_; }

    const scalar_type& operator()(size_t row, size_t column) const {
        assert(row < rows_);
        assert(column < columns_);
        return elements_[row * columns_ + column];
    }
    scalar_type& operator()(size_t row, size_t column) {
        assert(row < rows_);
        assert(column < columns_);
        return elements_[row * columns_ + column];
    }
private:
    size_t rows_;
    size_t columns_;
    std::vector<scalar_type> elements_;
};


template <typename scalar_type>
matrix<scalar_type> kronecker_product(const matrix<scalar_type>& a,
                                      const matrix<scalar_type>& b) {
    size_t arows = a.rows();
    size_t acolumns = a.columns();
    size_t brows = b.rows();
    size_t bcolumns = b.columns();
    matrix<scalar_type> c(arows * brows, acolumns * bcolumns);
    for (size_t i = 0; i < arows; ++i)
        for (size_t j = 0; j < acolumns; ++j)
            for (size_t k = 0; k < brows; ++k)
                for (size_t l = 0; l < bcolumns; ++l)
                    c(i*brows + k, j*bcolumns + l) = a(i, j) * b(k, l);
    return c;
}

bool kronecker_fractal(const char* fileName, const matrix<unsigned char>& m, int order) {
    matrix<unsigned char> result = m;
    for (int i = 0; i < order; ++i)
        result = kronecker_product(result, m);

    size_t height = result.rows();
    size_t width = result.columns();
    size_t bytesPerLine = 4 * ((width + 3)/4);
    std::vector<uchar> imageData(bytesPerLine * height);

    for (size_t i = 0; i < height; ++i)
        for (size_t j = 0; j < width; ++j)
            imageData[i * bytesPerLine + j] = result(i, j);

    QImage image(&imageData[0], width, height, bytesPerLine, QImage::Format_Indexed8);
    QVector<QRgb> colours(2);
    colours[0] = qRgb(0, 0, 0);
    colours[1] = qRgb(255, 255, 255);
    image.setColorTable(colours);
    return image.save(fileName);
}

int main() {
    matrix<unsigned char> matrix1(3, 3, {{0,1,0}, {1,1,1}, {0,1,0}});
    matrix<unsigned char> matrix2(3, 3, {{1,1,1}, {1,0,1}, {1,1,1}});
    matrix<unsigned char> matrix3(2, 2, {{1,1}, {0,1}});
    kronecker_fractal("vicsek.png", matrix1, 5);
    kronecker_fractal("sierpinski_carpet.png", matrix2, 5);
    kronecker_fractal("sierpinski_triangle.png", matrix3, 8);
    return 0;
}









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