Compiler Explorer

Source code

module kind_mod
  implicit none
  private
  public :: dp
  integer, parameter :: dp = kind(1.0d0)
end module kind_mod

module util_mod
  use kind_mod, only: dp
  implicit none
  private
  public :: default
  interface default
     module procedure default_int, default_real, default_logical, default_character
  end interface default

contains

elemental function default_int(x, xopt) result(y)
    integer, intent(in) :: x
    integer, intent(in), optional :: xopt
    integer :: y
    if (present(xopt)) then
       y = xopt
    else
       y = x
    end if
  end function default_int

elemental function default_real(x, xopt) result(y)
    real(kind=dp), intent(in) :: x
    real(kind=dp), intent(in), optional :: xopt
    real(kind=dp) :: y
    if (present(xopt)) then
       y = xopt
    else
       y = x
    end if
  end function default_real

elemental function default_logical(x, xopt) result(y)
    logical, intent(in) :: x
    logical, intent(in), optional :: xopt
    logical :: y
    if (present(xopt)) then
       y = xopt
    else
       y = x
    end if
  end function default_logical

elemental function default_character(x, xopt) result(y)
    character(len=*), intent(in) :: x
    character(len=*), intent(in), optional :: xopt
    character(len=100) :: y
    if (present(xopt)) then
       y = xopt
    else
       y = x
    end if
  end function default_character

end module util_mod

module dataframe_mod
  use kind_mod, only: dp
  use util_mod, only: default
  use iso_fortran_env, only: output_unit
  implicit none
  private
  public :: DataFrame, nrow, random, display, subset_stride
  integer, parameter :: nlen_columns = 100, nrows_print = 10
  logical, save :: blank_line_before_display = .true.

interface display
     module procedure display_data
  end interface display

type :: DataFrame
     integer, allocatable :: index(:)
     character(len=nlen_columns), allocatable :: columns(:)
     real(kind=dp), allocatable :: values(:,:)
     contains
        procedure :: display => display_data
  end type DataFrame

! Override constructor
  interface DataFrame
     module procedure new_dataframe
  end interface DataFrame

contains

pure type(DataFrame) function new_dataFrame(index,columns,values) result(df)
      integer, optional, intent(in) :: index(:)
      character(*), optional, intent(in) :: columns(:)
      real(dp), optional, intent(in) :: values(:,:)
      integer :: ierr
      if (present(index)) then 
         df%index = index
      else
         deallocate(df%index,stat=ierr)
      endif
      if (present(columns)) then 
         df%columns = columns
      else
         deallocate(df%columns,stat=ierr)
      endif
      if (present(values)) then         
         df%values = values
      else
         deallocate(df%values,stat=ierr)
      endif    
  end function   
 
  elemental function nrow(df) result(num_rows)
    type(DataFrame), intent(in) :: df
    integer :: num_rows
    if (allocated(df%values)) then
       num_rows = size(df%values, 1)
    else
       num_rows = -1
    end if
  end function nrow

subroutine alloc(self, nr, nc)
    type(DataFrame), intent(out) :: self
    integer, intent(in) :: nr, nc
    allocate(self%index(nr), self%values(nr, nc))
  end subroutine alloc

subroutine random(self, nr, nc)
    type(DataFrame), intent(out) :: self
    integer, intent(in) :: nr, nc
    integer :: i
    call alloc(self, nr, nc)
    call random_number(self%values)
    do i = 1, nr
       self%index(i) = i
    end do
    allocate(self%columns(nc))
    do i = 1, nc
       write(self%columns(i), "('C',i0)") i
    end do
  end subroutine random

subroutine display_data(self, print_all, fmt_ir, fmt_header, fmt_trailer, title)
    class(DataFrame), intent(in) :: self
    logical, intent(in), optional :: print_all
    character(len=*), intent(in), optional :: fmt_ir, fmt_header, fmt_trailer, title
    integer :: total, i, n_top, n_bottom
    logical :: print_all_
    character(len=100) :: fmt_ir_, fmt_header_
    fmt_ir_ = default("(i10,*(1x,f10.4))", fmt_ir)
    fmt_header_ = default("(a10,*(1x,a10))", fmt_header)
    print_all_ = default(.false., print_all)
    total = size(self%index)
    if (blank_line_before_display) write(*,*)
    if (present(title)) write(*,"(a)") title
    write(*,fmt_header_) "index", (trim(self%columns(i)), i=1,size(self%columns))
    if (print_all_) then
      print *, 'all'
       do i = 1, total
          write(*,fmt_ir_) self%index(i), self%values(i,:)
       end do
    else
       if (total <= nrows_print) then
       print *, 'rows'
          do i = 1, total
             write(*,fmt_ir_) self%index(i), self%values(i,:)
          end do
       else
          n_top = nrows_print / 2
          n_bottom = nrows_print - n_top
          do i = 1, n_top
             write(*,fmt_ir_) self%index(i), self%values(i,:)
          end do
          write(*,*) "   ... (", total - nrows_print, " rows omitted) ..."
          do i = total - n_bottom + 1, total
             write(*,fmt_ir_) self%index(i), self%values(i,:)
          end do
       end if
    end if
    if (present(fmt_trailer)) write(*,fmt_trailer)
  end subroutine display_data

function subset_stride(df, stride) result(df_new)
    ! return section of df with specified stride of rows
    type(DataFrame), intent(in) :: df
    integer, intent(in) :: stride
    type(DataFrame) :: df_new
    print*,' stride=',stride
    print*,"df%index(1:nrow(df):stride)", df%index(1:nrow(df):stride)
    print*,"df%values(1:nrow(df):stride, :)", df%values(1:nrow(df):stride, :)
    df_new = DataFrame(index   = df%index(1:nrow(df):stride), &
                       columns = df%columns, &
                       values  = df%values(1:nrow(df):stride, :))
  end function subset_stride

end module dataframe_mod

program xxdataframe
  use dataframe_mod, only: DataFrame, random, display, subset_stride
  use kind_mod, only: dp
  implicit none
  type(DataFrame) :: df, df_new
  call random(df, 8, 1)
  call display(df)
  df_new = subset_stride(df, 3)
  print*,"dfnew%index", df_new%index
  call display(df_new)
      print*,"dfnew%index", df_new%index
end program xxdataframe