Class array with different types at each index

Help
1

I have a scenario where want an array of objects where each element has a different type. Consider the following types

module mymod
  implicit none
  
  type, abstract :: Animal
  end type
  
  type, extends(Animal) :: Dog
    character(len=:), allocatable :: fur_color
  end type
  
  type, extends(Animal) :: Fish
    integer :: number_of_fins
    character(len=:), allocatable :: scale_color
  end type

end module

What I want to do is make an array of Animal, where each element can be either a Dog or a Fish. Although, I haven’t managed this. Any array of Animal must have the same type… For example, I can only do

  subroutine test1()
    class(Animal), allocatable :: a(:)

    allocate(Fish::a(3))
  end subroutine

So to accomplish an array of Animal of different type I must make a container type:

  ! ...
  type :: Container
    class(Animal), allocatable :: a
  end type
 ! ...

  subroutine test()
    
    class(Container), allocatable :: c(:)
    integer :: i
    
    allocate(c(2))
    
    allocate(Fish::c(1)%a)
    select type (a => c(1)%a)
    class is (Fish) 
      a%scale_color = "rainbow"
      a%number_of_fins = 7
    end select

    allocate(Dog::c(2)%a)
    select type (a => c(2)%a)
    class is (Dog)
      a%fur_color = "brown"
    end select

  end subroutine

Question 1: Is this Container approach the right way to accomplish an array of classes which can each have a different type?

Question 2: Is the syntax

allocate(Dog::c(2)%a)
select type (a => c(2)%a)
class is (Dog)
  a%fur_color = "brown"
end select

the only way to “dynamic_cast” (as in c++) a base class to a derived type.

Thanks!

1 Like
2

Yes and yes.

1 Like
3

When working with collections of polymorphic entities it can be useful to apply the Visitor Pattern. E.g. to set properties of the concrete animals, instead of defining type-bound setters, you write a subroutine instead. The subroutines below, could be part of a Visitor derived type. (Upon further review, in the classic pattern implementation, the Animal class would have a method which accepts a visitor. I have the feeling in Fortran you’d typically want to accept the visitor at the container level.)

  subroutine set_properties(animals)

    type(Container), intent(inout) :: animals(:)
    integer :: i

    do i = 1, size(animals)
      select type(a => animals(i)%a)
      class is (Dog)
        a%fur_color = "brown"
      class is (Fish) 
        a%scale_color = "rainbow"
        a%number_of_fins = 7
      end select
    end do
 
  end subroutine

  subroutine print_properties(animals)

    type(Container), intent(in) :: animals(:)
    integer :: i

    do i = 1, size(animals)
      select type(a => animals(i)%a)
      class is (Dog)
        print *, "Animal ", i, " is a dog with ", trim(a%fur_color), " fur"
      class is (Fish)
        print *, "Animal ", i, " is a fish with ", a%number_of_fins, &
          " "//trim(a%scale_color), " scales"
      end select
    end do

  end subroutine
1 Like
4

Here is an attempt at re-creating the visitor pattern in Fortran. Since Fortran does not allow forward references, I had to resort to the surrogate pattern. Compared to the C++ version I was following, the Fortran code is twice as long… I’m looking forward to learning any possible simplifications

Nasty details 
module shape_proxy_

   implicit none
   private

   public :: shape_proxy

   ! This stateless type serves only for purposes of extension
   ! by other types. In such a role, it can serve as a substitute for the
   ! child type when that type is inaccessible because of Fortran's
   ! prohibition against circular references

   type, abstract :: shape_proxy
   end type

end module


module visitor

   ! Substitute for shape_type
   use shape_proxy_, only: shape_proxy

   implicit none
   private

   public :: visitor_type, shape_proxy


   type, abstract :: visitor_type
   contains
      procedure(visit_shape), nopass, deferred :: visit
   end type

   abstract interface
      subroutine visit_shape(shape)
         import shape_proxy
         class(shape_proxy), intent(in) :: shape
      end subroutine
   end interface

end module

module shapes_

   use shape_proxy_
   use visitor, only: visitor_type

   implicit none

   type, abstract, extends(shape_proxy) :: shape_type
   contains
      procedure :: accept
   end type

contains

   subroutine accept(this,visitor)
      class(shape_type), intent(in) :: this
      class(visitor_type), intent(in) :: visitor

      call visitor%visit(this)

   end subroutine

end module


module circles

   use shapes_

   implicit none
   private

   public :: circle

   type, extends(shape_type) :: circle
      private
      real :: radius_
   contains
      procedure :: radius
   end type

   interface circle
      module procedure circle_new
   end interface

contains

   type(circle) function circle_new(radius)
      real, intent(in) :: radius
      circle_new%radius_ = radius
   end function

   real function radius(this)
      class(circle), intent(in) :: this
      radius = this%radius_
   end function

end module

module squares

   use shapes_

   implicit none
   private

   public :: square

   type, extends(shape_type) :: square
      private
      real :: side_
   contains
      procedure :: side
   end type

   interface square
      module procedure square_new
   end interface

contains

   type(square) function square_new(side)
      real, intent(in) :: side
      square_new%side_ = side
   end function

   real function side(this)
      class(square), intent(in) :: this
      side = this%side_
   end function

end module

module drawing

   use visitor, only: visitor_type, shape_proxy

   use circles, only: circle
   use squares, only: square

   implicit none

   type, extends(visitor_type) :: draw_visit
   contains
      procedure, nopass :: visit
   end type

contains

   subroutine visit(shape)
      class(shape_proxy), intent(in) :: shape

      select type (s => shape)
         class is (circle)
            print *, "circle: radius = ", s%radius()
         class is (square)
            print *, "square:   side = ", s%side()
      end select

   end subroutine

end module

module shapes

   use shapes_, only: shape_type
   use circles, only: circle
   use squares, only: square

   implicit none
   private

   ! Types
   public :: shape, circle, square

   ! Initializers
   public :: create_circle
   public :: create_square

   ! Methods
   public :: draw


   type :: shape
      class(shape_type), allocatable :: s
   end type

   interface shape
      module procedure shape_from_circle
      module procedure shape_from_square
   end interface

contains

   impure elemental subroutine draw(s)
      use drawing, only: draw_visit
      type(shape), intent(in) :: s

      ! Here we use the shape_proxy
      call s%s%accept(draw_visit())

   end subroutine

   subroutine create_circle(s,radius)
      type(shape), intent(out) :: s
      real, intent(in) :: radius
      s%s = circle(radius)
   end subroutine
   subroutine create_square(s,side)
      type(shape), intent(out) :: s
      real, intent(in) :: side
      s%s = square(side)
   end subroutine


   function shape_from_circle(x) result(s)
      type(shape) :: s
      type(circle), intent(in) :: x
      s%s = x
   end function

   function shape_from_square(x) result(s)
      type(shape) :: s
      type(square), intent(in) :: x
      s%s = x
   end function

end module

Client-level result:

program main
   use shapes
   implicit none

   type(shape), allocatable :: s(:)

   allocate(s(3))

   ! Subroutine constructors
   call create_circle(s(1), radius = 1.0)
   call create_square(s(2), side = 5.0)
   call create_circle(s(3), radius = 2.0)

   call draw(s) ! impure elemental call

   write(*,*)

   ! Or structure constructors
   s(1) = shape(circle(radius=3.0))
   s(2) = shape(circle(radius=4.0))
   s(3) = shape(square(side=1.0))

   call draw(s)

end program

Output:

$ ./main
 circle: radius =    1.00000000    
 square:   side =    5.00000000    
 circle: radius =    2.00000000    

 circle: radius =    3.00000000    
 circle: radius =    4.00000000    
 square:   side =    1.00000000

Edit: a few reflections upon this exercise:

  • The surrogate pattern as a (Fortran-specific) way of circumventing circular dependencies feels kind of complex and error-prone in comparison to forward references. Initially I wasn’t even sure whether it is the shape or visitor that needs the proxy and just made a lucky guess.
  • I was impressed by the fact I didn’t need any loop. Instead an impure elemental procedure can be used to apply the draw method to either an array or a scalar instance.
  • Deciding upon suitable names was irritating (both for modules and types); in the end I needed two abstract types shape_proxy and shape_type, the concrete classes circle and square, and finally the container type shape, just to implement a polymorphic container. Two more types were needed for the visitor. Not to mention also the interfaces.
  • Say I wanted to translate an array of shapes. The current visitor cannot mutate shapes, due to the interface:
      subroutine visit_shape(shape)
     import shape_proxy
     class(shape_proxy), intent(in) :: shape
  end subroutine
    I got the feeling that to implement a visitor which can modify the polymorphic entities, I would need a new abstract mutating_visitor type, wherein the visit procedure has intent(inout) attribute for the proxy shape.
3 Likes
5

It’s easy to get “lost” in the pedantry of patterns by the GoF and descendants, particularly in the context of Fortran where, absent certain further enhancements in the standard to lend Fortran as a general-purpose, multiparadigm language, the kind of needs as in the original post arise mostly during pre and postprocessing of “data” involved in number crunching toward scientific and technical applications. KISS principle applies in such situations as well, perhaps even more so.

Under the circumstances, go with a “collection” derived type which inherits from the same abstract type to facilitate easier consumption of methods which operate on the data. This is so that the need to use SELECT TYPE construct (so-called casting) can be mostly avoided. If at all one wishes to assign a “name” (!!) to this, see it as a simple-minded “inheritance, collection” pattern!!

With this, one often needs a lot less code - a lot of the boiler-plate and scaffolding and such can be avoided.

"Library " code 
module shape_m
   type, abstract :: shape_t
   contains
      procedure(Idraw), deferred :: Draw
   end type
   abstract interface
      impure elemental subroutine Idraw( this )
         import :: shape_t
         class(shape_t), intent(in) :: this
      end subroutine
   end interface 
end module 
module cirle_m
   use shape_m, only : shape_t
   type, extends(shape_t) :: circle_t
      real :: radius = 0.0
   contains
      procedure :: Draw => Draw_circle
   end type
contains
   impure elemental subroutine Draw_circle( this )
      class(circle_t), intent(in) :: this
      print *, "radius = ", this%radius
   end subroutine 
end module 
module square_m
   use shape_m, only : shape_t
   type, extends(shape_t) :: square_t
      real :: side = 0.0
   contains
      procedure :: Draw => Draw_square
   end type
contains
   impure elemental subroutine Draw_square( this )
      class(square_t), intent(in) :: this
      print *, "side = ", this%side
   end subroutine 
end module 
module shapecollection_m
   use shape_m, only : shape_t
   type, extends(shape_t) :: shapecollection_t
      class(shape_t), allocatable :: shape
   contains
      procedure :: Draw => Draw_shapes
   end type
contains
   impure elemental subroutine Draw_shapes( this )
      class(shapecollection_t), intent(in) :: this
      call this%shape%draw()
   end subroutine 
end module

   use shapecollection_m, only : shapecollection_t
   use cirle_m, only : circle_t
   use square_m, only : square_t
   type(shapecollection_t) :: shapes(3)
   shapes(1)%shape = circle_t( radius=2.0 )
   shapes(2)%shape = square_t( side=3.0 )
   shapes(3)%shape = circle_t( radius=4.0 )
   call shapes%draw()
end

C:\temp>ifort /standard-semantics shapes.f90
Intel(R) Fortran Intel(R) 64 Compiler Classic for applications running on Intel(R) 64, Version 2021.5.0 Build 20211109_000000
Copyright (C) 1985-2021 Intel Corporation. All rights reserved.

Microsoft (R) Incremental Linker Version 14.30.30706.0
Copyright (C) Microsoft Corporation. All rights reserved.

-out:shapes.exe
-subsystem:console
-incremental:no
shapes.obj

C:\temp>shapes.exe
radius = 2.000000
side = 3.000000
radius = 4.000000

C:\temp>

2 Likes
6

Thanks FortranFan for your (counter-)example. Having the draw method deferred to the shape type is the canonical object-oriented way of solving this via inheritance.

My visitor example was inspired by a C++ training I recently attended, where we learned how inheritance can fail to model many sub typing relations. Adding a new function will require modifying each of the sub-types. Hence there is a strong coupling between the types and methods. If a new method is added to the abstract shape, all child types need to implement it to conform to the hierarcy.

By using a visitor solution instead, the elements (circle, square) are essentially just “data” containers. The methods we apply to the elements are centralized in the visitor. The coupling is weaker.

Say we wanted to render the shapes with a graphics library. Only the module implementing the draw_visitor is coupled with the graphics library. During development we might have initially used the Intel Graphics Library, but later decided to switch to OpenGL to port our application to a different platform/compiler. Instead of having to modify each shape in our hierarchy, we would just modify the visitor.

7

One way around the circular dependency of shapes_ and visitor is to combine them into a single module. Here’s my take, eliminating the proxy altogether and merging the contents of shapes_ into the visitor module. The circles, squares, and drawing modules are unchanged from yours.

details 
module visitor 
  ! "visitor" is no longer a good name for this module, but I'm not feeling creative
  implicit none

  type, abstract :: shape_type
  contains
    procedure :: accept
  end type

  type, abstract :: visitor_type
  contains
    procedure(visit_shape), nopass, deferred :: visit
  end type

  abstract interface
    subroutine visit_shape(shape)
      import shape_type
      class(shape_type), intent(in) :: shape
    end subroutine
  end interface

contains

  subroutine accept(this, visitor)
    class(shape_type), intent(in) :: this
    class(visitor_type), intent(in) :: visitor
    call visitor%visit(this)
  end subroutine accept

end module visitor


module circles
  use visitor, only: shape_type
  implicit none
  private

  public :: circle

  type, extends(shape_type) :: circle
    private
    real :: radius_
  contains
    procedure :: radius
  end type

  interface circle
    module procedure circle_new
  end interface

contains

  function circle_new(radius) 
    real, intent(in) :: radius
    type(circle) :: circle_new
    circle_new%radius_ = radius
  end function circle_new

  function radius(this)
    class(circle), intent(in) :: this
    real :: radius
    radius = this%radius_ 
  end function radius

end module circles


module squares
  use visitor, only: shape_type
  implicit none
  private

  public :: square

  type, extends(shape_type) :: square
    private
    real :: side_
  contains
    procedure :: side
  end type

  interface square
    module procedure square_new
  end interface

contains

  function square_new(side) 
    real, intent(in) :: side
    type(square) :: square_new
    square_new%side_ = side
  end function square_new

  function side(this)
    class(square), intent(in) :: this
    real :: side
    side = this%side_ 
  end function side

end module squares


module drawing
  use visitor, only: visitor_type, shape_type
  use circles, only: circle
  use squares, only: square
  implicit none

  type, extends(visitor_type) :: draw_visit
  contains
    procedure, nopass :: visit
  end type draw_visit

contains

  subroutine visit(shape)
    class(shape_type), intent(in) :: shape

    select type (s => shape)
    class is (circle)
      write (*, *) "circle: radius = ", s%radius()
    class is (square)
      write (*, *) "square: side = ", s%side()
    end select
  end subroutine visit

end module drawing


module shapes
  use visitor, only: shape_type
  use circles, only: circle
  use squares, only: square
  implicit none
  private
  public :: shape, circle, square
  public :: create_circle, create_square
  public :: draw

  type :: shape
    class(shape_type), allocatable :: s
  end type shape

  interface shape
    module procedure shape_from_circle
    module procedure shape_from_square
  end interface

contains

  impure elemental subroutine draw(s)
    use drawing, only: draw_visit
    type(shape), intent(in) :: s
    call s%s%accept(draw_visit())
  end subroutine draw

  subroutine create_circle(s, radius)
    type(shape), intent(out) :: s
    real, intent(in) :: radius
    s%s = circle(radius)
  end subroutine create_circle

  subroutine create_square(s, side)
    type(shape), intent(out) :: s
    real, intent(in) :: side
    s%s = square(side)
  end subroutine create_square

  function shape_from_circle(x) result(s)
    type(shape) :: s
    type(circle), intent(in) :: x
    s%s = x
  end function shape_from_circle

  function shape_from_square(x) result(s)
    type(shape) :: s
    type(square), intent(in) :: x
    s%s = x
  end function shape_from_square

end module shapes

I don’t know my design patterns very well at all, so maybe this is bad in a way I don’t appreciate. Is there a compelling design reason not to define shape_type and visitor_type in the same module? To me it seems OK, since they’re both abstract anyway. The fact that they’re defined together doesn’t really make it harder to define new shapes or new visitors.

1 Like
8

Right now I can’t see a reason either. The reason I introduced the proxy was simply because the C++ code used a forward reference, which I knew could be worked-around with the surrogate pattern. Typically in Fortran I follow the rule “one module - one type”, but in this case putting the abstract types together makes more sense. It’s actually kind of neat, because the visit procedure is already declared by an abstract interface, so the object accepting the visitor knows everything it needs to know about the visitor already (I’m stating the obvious here).

Compared with the C++ implementation (unfortunately I don’t have the rights to distribute it), one more difference is I implemented accept at the parent level, instead of deferring it to the child classes.

There is a still a gap in the literature on Fortran design patterns, particularly when using OO features of the language. Over time I’ve realized that when adapting a pattern from a different language to Fortran it usually needs to be changed a little bit. It’s similar to how translation works in natural languages.

9

I go through several exercises around this kind of pattern in my course Intermediate Fortran. The code is available here with the different exercises and solutions available on different branches.

My recommendation is to avoid designing inheritance hierarchies that ever need to use select type. Sometimes that requires a rethinking of the approach to the problem. There are occasions where select type really is the right approach, but I find that to be far less frequent, and so my first approach is usually to avoid it.

10

What makes select type the wrong approach?

11

Maintainability. They tend to multiply. You end up in a state where everywhere you want to use class(base) requires that you have a select type block that includes every type in your system that extends from base. Then any time you want to add a new type that extends from base you have to go find every one of those select type blocks. And the compiler can’t warn you if you miss one, leading to the introduction of subtle and difficult to diagnose bugs.

3 Likes
12

Ok ya that makes sense. To catch a bug though you can do

select type(bla)
class is (Type1)
  ! do stuff
class default
  ierr = 1
  return
end select
13

Yes, that is an option. But suppose that procedure didn’t otherwise need an error return. Now you’re forced to introduce one for the sole purpose of performing a select type, when it may have been possible to avoid both.

14

I agree with that. But what do you recommend instead? To always operate on the subclass?

(For my own codes, I go even further and I don’t use classes at all. Much simpler to me.)

1 Like
15

My recommendation is to design the base class in such a way that you don’t ever need to know which subclass you’re using. It takes practice, but is worth the effort. The "computer science"y concept is the Liskov Substitution Principle

5 Likes
16

I can see the benefit. But it will take me a while to get use to it.

17

Ah I see. Yes, that’s cleaner.

18

I have a question which seems similar to the OP’s problem, but my OOP-Fortran skills are incipient and I can’t bridge the gap.

I have an abstract class method, which has many concrete child classes: method_a, method_b, etc. All child classes implement given common procedures (e.g., check), as imposed by the parent abstract class.

module methods_module
  implicit none
  private
  public :: method, method_a, method_b
  
  type, abstract :: method
    contains
    procedure(check_method), deferred :: check
  end type

  interface
    subroutine check_method(self, result)
      import :: method
      class(method), intent(in) :: self
      logical, intent(out) :: result 
    end subroutine
  end interface

  type, extends(method) :: method_a
  contains
    procedure :: check => check_method_a
  end type

  type, extends(method) :: method_b
  contains
    procedure :: check => check_method_b
  end type

  contains

  subroutine check_method_a(self, result)
    class(method_a), intent(in) :: self
    logical, intent(out) :: result 
    result = .true.
  end subroutine

  subroutine check_method_b(self, result)
    class(method_b), intent(in) :: self
    logical, intent(out) :: result 
    result = .true.
  end subroutine

end module methods_module

For each of these child classes, I would like to verify that the corresponding procedure implementations are working well. I can do this in a manual way, like so:

program main
   use methods_module, only: method, method_a, method_b
   implicit none

   type(method_a) :: a
   type(method_b) :: b
   logical :: result
   
   call a%check(result)
   print *, "check a :", result

   call b%check(result)
   print *, "check b :", result

  ! and so on...

end program main

But I would like to make it using a loop, more or less like so (THIS IS INVALID CODE):

program main
   use methods_module, only: method, method_a, method_b
   implicit none

   ?class(method), allocatable :: methods(:)
   ?class(method) :: themethod
   logical :: result
   integer :: i

   methods = [?method_a, ?method_b]

   do i=1, size(methods)
      themethod = methods(i)
      call themethod%check(result)
      print *, i, result
   end do

end program main

What is the correct way to implement this loop/array approach? Thanks.

19

Does this work? It’s not the prettiest syntax but it’s what we got.

program main
   use methods_module, only: method, method_a, method_b
   implicit none

   type :: method_wrapper
     class(method), allocatable :: m
   end type method_wrapper

   type(method_wrapper) :: methods(2)

   type(method_a) :: a
   type(method_b) :: b
   logical :: result
   integer :: i
   
   allocate(methods(1) % m, source=method_a())
   allocate(methods(2) % m, source=method_b())

   do i = 1, size(methods)
     select type (this_method => methods(i) % m)
       class is (method)
         call this_method % check(result)
         print *, i, result
     end select
   end do

end program main
1 Like
20

Thanks, a lot. It works!

At first, when I saw these declarations:

type(method_a) :: a
type(method_b) :: b

I was confused. But then I realized it is just a typo and apparently not required.

To be honest, I still don’t understand how the magic happens, but at least I understand that this is the part I need to read/learn about:

select type (this_method => methods(i) % m)

Thanks again!

1 Like