Merge pull request #55 from rouson/download-mnist.tar.gz

Author: rouson

.gitignore

@@ -1,5 +1,6 @@
+*.gz
 *.o
 *.mod
+*.dat
 build
-data/*/*.dat
 doc

data/mnist/mnist.tar.gz

@@ -2,16 +2,22 @@
 
   implicit none
 
+  integer, parameter :: message_len = 128
+
 contains
 
   module subroutine read_binary_file_1d(filename, dtype, nrec, array)
     character(len=*), intent(in) :: filename
     integer(ik), intent(in) :: dtype, nrec
     real(rk), allocatable, intent(in out) :: array(:)
     integer(ik) :: fileunit
+    character(len=message_len) :: io_message
+    integer :: io_status
+    io_status = 0
+    open(newunit=fileunit, file=filename, access='direct', action='read', &
+      recl=dtype * nrec, status='old', iostat=io_status, iomsg=io_message)
+    if (io_status /= 0) error stop trim(io_message)
     allocate(array(nrec))
-    open(newunit=fileunit, file=filename, access='direct',&
-         action='read', recl=dtype * nrec, status='old')
     read(fileunit, rec=1) array
     close(fileunit)
   end subroutine read_binary_file_1d
@@ -21,9 +27,13 @@ module subroutine read_binary_file_2d(filename, dtype, dsize, nrec, array)
     integer(ik), intent(in) :: dtype, dsize, nrec
     real(rk), allocatable, intent(in out) :: array(:,:)
     integer(ik) :: fileunit, i
+    character(len=message_len) :: io_message
+    integer :: io_status
+    io_status = 0
+    open(newunit=fileunit, file=filename, access='direct', action='read', &
+      recl=dtype * dsize, status='old', iostat=io_status, iomsg=io_message)
+    if (io_status /= 0) error stop trim(io_message)
     allocate(array(dsize, nrec))
-    open(newunit=fileunit, file=filename, access='direct',&
-         action='read', recl=dtype * dsize, status='old')
     do i = 1, nrec
       read(fileunit, rec=i) array(:,i)
     end do

src/mod_io_submodule.f90

@@ -10,8 +10,41 @@
 
   implicit none
 
+  integer, parameter :: message_len = 128
+
 contains
 
+  subroutine download_and_uncompress()
+    character(len=*), parameter :: download_mechanism = 'curl -LO '
+    character(len=*), parameter :: base_url='https://github.com/modern-fortran/neural-fortran/files/8498876/'
+    character(len=*), parameter :: download_filename = 'mnist.tar.gz'
+    character(len=*), parameter :: download_command = download_mechanism // base_url // download_filename
+    character(len=*), parameter :: uncompress_file = 'tar xvzf ' // download_filename
+    character(len=message_len) :: command_message
+    character(len=:), allocatable :: error_message
+    integer :: exit_status, command_status
+
+    exit_status=0
+    call execute_command_line(command=download_command, wait=.true., &
+      exitstat=exit_status, cmdstat=command_status, cmdmsg=command_message)
+
+    if (any([exit_status, command_status] /= 0)) then
+      error_message = 'command "' // download_command // '" failed'
+      if (command_status /= 0) error_message = error_message // " with message " // trim(command_message)
+      error stop error_message
+    end if
+
+    call execute_command_line(command=uncompress_file, wait=.true., &
+      exitstat=exit_status, cmdstat=command_status, cmdmsg=command_message)
+
+    if (any([exit_status, command_status] /= 0)) then
+      error_message = 'command "' // uncompress_file // '" failed'
+      if (command_status /= 0) error_message = error_message // " with message " // trim(command_message)
+      error stop  error_message
+    end if
+
+  end subroutine download_and_uncompress
+
   pure module function label_digits(labels) result(res)
     real(rk), intent(in) :: labels(:)
     real(rk) :: res(10, size(labels))
@@ -42,21 +75,26 @@ module subroutine load_mnist(tr_images, tr_labels, te_images,&
     integer(ik), parameter :: tr_nimages = 50000
     integer(ik), parameter :: te_nimages = 10000
     integer(ik), parameter :: va_nimages = 10000
+    logical :: file_exists
+
+    ! Check if MNIST data is present and download it if not.
+    inquire(file='mnist_training_images.dat', exist=file_exists)
+    if (.not. file_exists) call download_and_uncompress()
 
-    call read_binary_file('data/mnist/mnist_training_images.dat',&
+    call read_binary_file('mnist_training_images.dat',&
                           dtype, image_size, tr_nimages, tr_images)
-    call read_binary_file('data/mnist/mnist_training_labels.dat',&
+    call read_binary_file('mnist_training_labels.dat',&
                           dtype, tr_nimages, tr_labels)
 
-    call read_binary_file('data/mnist/mnist_testing_images.dat',&
+    call read_binary_file('mnist_testing_images.dat',&
                           dtype, image_size, te_nimages, te_images)
-    call read_binary_file('data/mnist/mnist_testing_labels.dat',&
+    call read_binary_file('mnist_testing_labels.dat',&
                           dtype, te_nimages, te_labels)
 
     if (present(va_images) .and. present(va_labels)) then
-      call read_binary_file('data/mnist/mnist_validation_images.dat',&
+      call read_binary_file('mnist_validation_images.dat',&
                             dtype, image_size, va_nimages, va_images)
-      call read_binary_file('data/mnist/mnist_validation_labels.dat',&
+      call read_binary_file('mnist_validation_labels.dat',&
                             dtype, va_nimages, va_labels)
     end if