Objektově orientované programování v jazyce Fortran
Objektově orientované programování (OOP) je tzv. programátorské paradigna. Stejně jako strukturovaní programování. Strukturované programování a OOP k sobě mají v zásadě celkem blízko. Základní myšlenka je stejná rozdělit kod do malých struktur pro zvýšení přehlednosti, jednoduchosti, znovupoužitelnosti, … Ovšem OOP se dívá na svět jinak. OOP rozeznává objekty, které mají nějaké vlastnosti (proměnné, parametry, …) a metody (funkce, subroutiny). Každý objekt spadá do nějaké třídy, např. všechny kočky spadají do třídy “kočka”. To znamená, že všechno co je kočka můžeme popsat stejnými vlastnostmi (hmotnost, barva, počet nohou = 4) a metodami (zamnoukej(), pred(), …). V numerických aplikacích by třídou objektů mohla být např. mřížka na které počítáme, molekula, atom, …
Další pilíř na kterém OOP stojí je zapouzdření. To se provádí pomocí tzv. privátních vlastností a metod, které již známe. V OOP jde o to, že objekty si zkrývají svůj vlastní stav (tj. proměnné). Navenek máme k těmto datům přístup jen skrze procedury, které objekt implementuje.
Objekty můžeme skládat dohromady (kompozice). Např. Molekulu si můžeme představit jako kompizice atomů a vazeb mezi nimi. Tj. máme objekt molekula, který se skládá z objektů Atom a z objektů Vazba.
Objekty mohou využívat služeb (metod (procedur)) jiných objektů tzv. delegace. Představme si, že máme objekt Zobrazovač, který se nám starý o zobrazování všeho na monitor. Žádný jiný objekt to neumí a pokud nějaký objekt pořebuje něco zobrazit musí použít objekt Zobrazovač a některou z jeho metod pro zobrazování. Další příkladem by mohl být objekt pro čtení … ???Čtenář???. Tento postup je zcela běžný a je v soulasu s principem, že každá část programu se stará jen o jednu věc.
Objekty od sebou mohou dědit vlastnosti a metody. Např. mějme třídu Člověk a ta má nějaké vlastnosti (věk, výška, hmotnost, pohlaví, …) a metody (jez, spi, …) a mějme třídu Programátor. Programátor je určitě člověk takže může zdědit všechny vlastnosti a metody od člověka. Navíc mu můžeme přidat vlastnosti a metoda navíc (programuj, …). To nám umožňuje nepsat kód pro Člověka a Programátora dvakrát.
Posledním důležitým pilířem OOP je polymorfismus. Tj. můžeme k objektům různých tříd přistupovat stejně. Např. je mi jedno jestli objekt je Člověk nebo Programátor. Oba dva můžu uspat pomocí procedury spi.
Ohladně OOP se toho dá napsat mnoho a mnoho a to co jsem napsal je jen základní představa. Proto je tato část spíše pro ty, kteří již nějaké zkušenosti s OOP mají. Pokud to člověk myslí s OOP vážně měl by si přečíst něco UML class diagramech popř. ještě UML sequenc diagramech. OOP není lékem na všechny problémy spojené s návrhem a programování velkých programů. Pokud navrhneme strukturu tříd špatně můžeme získat kód podobající se více špagetovému než kdybychom jej programovali strukturovaně a žádnou z výhod OOP bychom nezískali. Po čase proto vznikly tzv. Návrhové vzory. To jsou jednoduché vzory jak spolu mohou objekty spolupracovat a komunikovat aby z toho nebyl chaos. Každý kdo dělá OOP by na ně měl při navrhu programu myslet.
Skvělý zdroj: Object-Oriented Programming in Fortran 2003 Part 1.
Třídy
Třída je základní jednotkou OOP. V příkladu máme třídu obj
module mod_obj_1
implicit none
private ! vse bude soukrome
public :: obj ! konstruktorova fce i type budou verejne - jsou pretizene
type obj
integer :: a ! vlastnosti obj
real, allocatable :: b(:) ! vlastnosti obj
contains ! metody objektu
procedure :: change_obj
procedure :: del_obj
end type obj
interface obj ! jmeno konstuktorove funkce
module procedure init_obj
end interface
contains
!--------------------------------------------
type(obj) function init_obj(r,i) ! konstruktorova funkce
real,intent(in) :: r(:)
integer,intent(in) :: i
integer :: n
n = size(r)
allocate (init_obj%b(n))
init_obj%a = i
init_obj%b = r
end function init_obj
!--------------------------------------------
subroutine change_obj(this, r, i)
class(obj), intent(inout) :: this ! this je odkaz objektu, pri volani funkce se nezadava
integer, intent(in) :: i
real, intent(in) :: r(:)
deallocate(this%b)
allocate(this%b(size(r)))
this%a = i
this%b = r
end subroutine change_obj
!--------------------------------------------
subroutine del_obj(this) ! this je odkaz objektu, pri volani funkce se nezadava
class(obj) :: this
deallocate(this%b)
end subroutine del_obj
end module mod_obj_1
!================================================
program prog_obj_1
use mod_obj_1
implicit none
type(obj) :: muj_obj
muj_obj = obj([1.,2.,3.],4) ! vytvorime obj
write(*,*) muj_obj%a
write(*,*) muj_obj%b
call muj_obj%change_obj([0.,1.], 2) ! zmenime obj
write(*,*) muj_obj%a
write(*,*) muj_obj%b
call muj_obj%del_obj ! smazeme resp. dealokujeme obj
end program
operace s objekty
U objektů se nám vyplatí přetížit některé základní operátory. To nám umožňuje sčítat, očítat, porovnávat, … uživatelské typy.
module mod_obj_2
implicit none
private
public :: obj
type obj
integer :: a
real, allocatable :: b(:)
contains
procedure :: change_obj
procedure :: del_obj
procedure,private :: plus_obj
procedure,private :: minus_obj
procedure,private :: rovnaSe_obj
generic, public :: operator(+) => plus_obj ! misto plus_obj pouzijeme znamenko +
generic, public :: operator(-) => minus_obj ! misto minus_obj pouzijeme znamenko -
generic, public :: assignment(=) => rovnaSe_obj ! misto rovnaSe_obj pouzijeme znamenko =
end type obj
interface obj
module procedure init_obj
end interface
contains
!--------------------------------------------
type(obj) function init_obj(r,i)
real,intent(in) :: r(:)
integer,intent(in) :: i
allocate (init_obj%b,mold=r)
init_obj%a = i
init_obj%b = r
end function init_obj
!--------------------------------------------
subroutine change_obj(this, r, i)
class(obj), intent(inout) :: this
integer, intent(in) :: i
real, intent(in) :: r(:)
deallocate(this%b)
!allocate(this%b(size(r)))
allocate(this%b, mold=r)
this%a = i
this%b = r
end subroutine change_obj
!--------------------------------------------
subroutine del_obj(this)
class(obj), intent(inout) :: this
deallocate(this%b)
end subroutine del_obj
!--------------------------------------------
type(obj) function plus_obj(obj1,obj2)
class(obj), intent(in) :: obj1, obj2
allocate(plus_obj%b, mold=obj1%b)
plus_obj%a=obj1%a+obj2%a
plus_obj%b=obj1%b+obj2%b
end function plus_obj
!--------------------------------------------
type(obj) function minus_obj(obj1,obj2)
class(obj), intent(in) :: obj1, obj2
allocate(minus_obj%b, mold=obj1%b)
minus_obj%a=obj1%a-obj2%a
minus_obj%b=obj1%b-obj2%b
end function minus_obj
!--------------------------------------------
subroutine rovnaSe_obj(new_obj, old_obj)
class(obj), intent(in) :: old_obj
class(obj), intent(out) :: new_obj
new_obj%a=old_obj%a
new_obj%b=old_obj%b
end subroutine rovnaSe_obj
end module mod_obj_2
!================================================
program prog_obj_2
use mod_obj_2
implicit none
type(obj) :: muj_obj1, muj_obj2
type(obj) :: muj_obj3
muj_obj1 = obj([1.,2.,3.],4)
muj_obj2 = obj([5.,6.,7.],8)
muj_obj3 = muj_obj1 + muj_obj2
write(*,*) muj_obj3%a
write(*,*) muj_obj3%b
write(*,*)
muj_obj3 = muj_obj1 - muj_obj2
write(*,*) muj_obj3%a
write(*,*) muj_obj3%b
write(*,*)
muj_obj1 = muj_obj2
write(*,*) muj_obj1%a
write(*,*) muj_obj2%a
write(*,*) muj_obj1%b
write(*,*) muj_obj2%b
write(*,*)
end program prog_obj_2
Dědičnost
Dedicnost se provadi pomoci extend. Navíc můžeme použít pro inicializaci zděděných hodnot konstruktor předka.
module zvire_class
implicit none
private
integer, parameter :: char_len = 20
public :: zvire
type zvire
private
character(len=char_len), public :: druh
contains
procedure, public, nopass :: mluv !specifikace nopass rika ze objekt neni argumentem funkce mluv
procedure, public :: write_muj_druh
end type zvire
interface zvire
module procedure init_zvire
end interface
contains
!--------------------------------------------
type(zvire) function init_zvire(jake_zvire)
character(len=char_len), intent(in) :: jake_zvire
init_zvire%druh = jake_zvire
end function init_zvire
!--------------------------------------------
subroutine mluv()
write(*,*) 'Nevim co jsem, nevim co mam delat.'
end subroutine mluv
!--------------------------------------------
subroutine write_muj_druh(this)
class(zvire), intent(in) :: this
write(*,*) trim(this%druh)
end subroutine write_muj_druh
end module zvire_class
!================================================
module kocka_class
use zvire_class
implicit none
private
public :: kocka
integer, parameter :: char_len = 20
type, extends(zvire) :: kocka ! kocka dedi od zvirete
private
character(len=char_len) :: rasa
character(len=char_len) :: name
contains
procedure, nopass :: mluv
procedure :: print=>write_me ! subroutinu write_me budeme volat pomoci print
end type kocka
interface kocka
module procedure init_kocka
end interface
contains
!--------------------------------------------
type(kocka) function init_kocka(moje_jmeno,rasa)
character(len=*), intent(in) :: rasa
character(len=*), intent(in) :: moje_jmeno
init_kocka%zvire = zvire('Kocka') !na zdedene vlastnosti se muzeme odkazovat pod nazvem predka
! a pouzit jeho konstruktor
init_kocka%name = moje_jmeno
init_kocka%rasa = rasa
end function init_kocka
!--------------------------------------------
subroutine write_me(this)
class(kocka), intent(in) :: this
write(*,*) 'Ja jsem ',trim(this%name)//", Jsem "// trim(this%rasa)
end subroutine write_me
!--------------------------------------------
subroutine mluv()
write(*,*) 'mnau'
end subroutine mluv
end module kocka_class
!================================================
module pes_class
use zvire_class
implicit none
private
public :: pes
integer, parameter :: char_len = 20
type, extends(zvire) :: pes
private
character(len=char_len) :: rasa
character(len=char_len) :: name
contains
procedure, nopass :: mluv
procedure :: print=>write_me
end type pes
interface pes
module procedure init_pes
end interface
contains
!--------------------------------------------
type(pes) function init_pes(moje_jmeno,rasa)
character(len=*), intent(in) :: rasa
character(len=*), intent(in) :: moje_jmeno
init_pes%zvire = zvire('Pes')
init_pes %name = moje_jmeno
init_pes%rasa = rasa
end function init_pes
!--------------------------------------------
subroutine write_me(this)
class(pes), intent(in) :: this
write(*,*) 'Ja jsem ',trim(this%name)//", Jsem "// trim(this%rasa)
end subroutine write_me
!--------------------------------------------
subroutine mluv()
write(*,*) 'haf'
end subroutine mluv
end module pes_class
!================================================
program prog_obj_3
use kocka_class, only : kocka
use pes_class, only : pes
implicit none
type(kocka) :: Fousek
type(pes) :: Ratafak
Fousek=kocka('Fousek','Bengálská kočka')
Ratafak=pes('Ratafak','Boxer')
call Fousek%mluv()
call Ratafak%mluv()
call Fousek%write_muj_druh()
call Fousek%print()
call Ratafak%print()
end program prog_obj_3
Abstraktní třídy
Abstraktní třída je vzor objektu. Nemůžeme je vytvořit jako objekt (instanci). Pomocí atributu deferre můžeme zařídit, že potomci musí definovat funkce s interfacem, který definujeme ve specifikaci procedure. Specifikace non_overridable říká že proceduru nesmí žádný z potomků měnit.
module zvire_class
implicit none
private
integer, parameter :: char_len = 20
public :: zvire
type, abstract :: zvire
private
character(len=char_len), public :: druh
contains
procedure (zvire_mluv), nopass, deferred :: mluv
procedure (write_me),deferred :: print
procedure, non_overridable :: write_muj_druh
end type zvire
abstract interface
subroutine zvire_mluv()
end subroutine zvire_mluv
subroutine write_me(this)
import :: zvire
class(zvire), intent(in) :: this
end subroutine write_me
end interface
contains
!--------------------------------------------
subroutine write_muj_druh(this)
class(zvire), intent(in) :: this
write(*,*) trim(this%druh)
end subroutine write_muj_druh
end module zvire_class
!================================================
module kocka_class
use zvire_class
implicit none
private
public :: kocka
integer, parameter :: char_len = 20
type, extends(zvire) :: kocka
private
character(len=char_len) :: rasa
character(len=char_len) :: jmeno
contains
procedure, nopass :: mluv
procedure :: print=>write_me
end type kocka
interface kocka
module procedure init_kocka
end interface
contains
!--------------------------------------------
type(kocka) function init_kocka(moje_jmeno,rasa)
character(len=*), intent(in) :: rasa
character(len=*), intent(in) :: moje_jmeno
init_kocka%druh = "Kocka"
init_kocka%jmeno = moje_jmeno
init_kocka%rasa = rasa
end function init_kocka
!--------------------------------------------
subroutine write_me(this)
class(kocka), intent(in) :: this
write(*,*) 'Ja jsem ',trim(this%jmeno)//", Jsem "// trim(this%rasa)
end subroutine write_me
!--------------------------------------------
subroutine mluv()
write(*,*) 'mnau'
end subroutine mluv
end module kocka_class
!================================================
module pes_class
use zvire_class
implicit none
private
public :: pes
integer, parameter :: char_len = 20
type, extends(zvire) :: pes
private
character(len=char_len) :: rasa
character(len=char_len) :: jmeno
contains
procedure, nopass :: mluv
procedure :: print=>write_me
end type pes
interface pes
module procedure init_pes
end interface
contains
!--------------------------------------------
type(pes) function init_pes(moje_jmeno,rasa)
character(len=*), intent(in) :: rasa
character(len=*), intent(in) :: moje_jmeno
init_pes%druh = "Pes"
init_pes %jmeno = moje_jmeno
init_pes%rasa = rasa
end function init_pes
!--------------------------------------------
subroutine write_me(this)
class(pes), intent(in) :: this
write(*,*) 'Ja jsem ',trim(this%jmeno)//", Jsem "// trim(this%rasa)
end subroutine write_me
!--------------------------------------------
subroutine mluv()
write(*,*) 'haf'
end subroutine mluv
end module pes_class
!================================================
program prog_obj_4
use kocka_class
use pes_class
implicit none
type(kocka) :: Fousek
type(pes) :: Ratafak
Fousek=kocka('Fousek','Bengálská kočka')
Ratafak=pes('Ratafak','Boxer')
call Fousek%mluv()
call Ratafak%mluv()
call Fousek%write_muj_druh()
call Fousek%print()
call Ratafak%print()
end program prog_obj_4
příkaz select type
V příkazu používáme type a class. Type odkazuje na konkrétní typ. Class zastupuje celou rodinu tj. všechny potomky.
module zvire_class
implicit none
private
integer, parameter :: char_len = 20
public :: zvire
type, abstract :: zvire
private
character(len=char_len), public :: druh
contains
procedure (zvire_mluv), nopass, deferred :: mluv
procedure (write_me),deferred :: print
procedure, non_overridable :: write_muj_druh
end type zvire
abstract interface
subroutine zvire_mluv()
end subroutine zvire_mluv
subroutine write_me(this)
import :: zvire
class(zvire), intent(in) :: this
end subroutine write_me
end interface
contains
!--------------------------------------------
subroutine write_muj_druh(this)
class(zvire), intent(in) :: this
write(*,*) trim(this%druh)
end subroutine write_muj_druh
end module zvire_class
!================================================
module kocka_class
use zvire_class
implicit none
private
public :: kocka
integer, parameter :: char_len = 20
type, extends(zvire) :: kocka
private
character(len=char_len) :: rasa
character(len=char_len) :: jmeno
contains
procedure, nopass :: mluv
procedure :: print=>write_me
end type kocka
interface kocka
module procedure init_kocka
end interface
contains
!--------------------------------------------
type(kocka) function init_kocka(moje_jmeno,rasa)
character(len=*), intent(in) :: rasa
character(len=*), intent(in) :: moje_jmeno
init_kocka%druh = "Kocka"
init_kocka%jmeno = moje_jmeno
init_kocka%rasa = rasa
end function init_kocka
!--------------------------------------------
subroutine write_me(this)
class(kocka), intent(in) :: this
write(*,*) 'Ja jsem ',trim(this%jmeno)//", Jsem "// trim(this%rasa)
end subroutine write_me
!--------------------------------------------
subroutine mluv()
write(*,*) 'mnau'
end subroutine mluv
end module kocka_class
!================================================
module pes_class
use zvire_class
implicit none
private
public :: pes
integer, parameter :: char_len = 20
type, extends(zvire) :: pes
private
character(len=char_len) :: rasa
character(len=char_len) :: jmeno
contains
procedure, nopass :: mluv
procedure :: print=>write_me
end type pes
interface pes
module procedure init_pes
end interface
contains
!--------------------------------------------
type(pes) function init_pes(moje_jmeno,rasa)
character(len=*), intent(in) :: rasa
character(len=*), intent(in) :: moje_jmeno
init_pes%druh = "Pes"
init_pes %jmeno = moje_jmeno
init_pes%rasa = rasa
end function init_pes
!--------------------------------------------
subroutine write_me(this)
class(pes), intent(in) :: this
write(*,*) 'Ja jsem ',trim(this%jmeno)//", Jsem "// trim(this%rasa)
end subroutine write_me
!--------------------------------------------
subroutine mluv()
write(*,*) 'haf'
end subroutine mluv
end module pes_class
!================================================
module slon_class
use zvire_class
implicit none
private
public :: slon
integer, parameter :: char_len = 20
type, extends(zvire) :: slon
private
character(len=char_len) :: rasa
character(len=char_len) :: jmeno
contains
procedure, nopass :: mluv
procedure :: print=>write_me
end type slon
interface slon
module procedure init_slon
end interface
contains
!--------------------------------------------
type(slon) function init_slon(moje_jmeno,rasa)
character(len=*), intent(in) :: rasa
character(len=*), intent(in) :: moje_jmeno
init_slon%druh = "Slon"
init_slon %jmeno = moje_jmeno
init_slon%rasa = rasa
end function init_slon
!--------------------------------------------
subroutine write_me(this)
class(slon), intent(in) :: this
write(*,*) 'Ja jsem ',trim(this%jmeno)//", Jsem "// trim(this%rasa)
end subroutine write_me
!--------------------------------------------
subroutine mluv()
write(*,*) 'Pawoo'
end subroutine mluv
end module slon_class
!================================================
program prog_obj_5
use kocka_class
use pes_class
use slon_class
use zvire_class
implicit none
type(kocka) :: Fousek
type(pes) :: Ratafak
type(slon) :: Hanno
Fousek=kocka('Fousek','Bengálská kočka')
Ratafak=pes('Ratafak','Boxer')
Hanno=slon('Hanno','Slon indicky')
call coJsem(Fousek)
call coJsem(Ratafak)
call coJsem(Hanno)
contains
!------------------------------------------
subroutine coJsem(obj)
class(*) obj
select type(obj)
class is (zvire)
write(*,*) 'Jsem zvire: '
call obj%write_muj_druh()
class default
write(*,*) 'Nejsem asi nic'
end select
select type(obj)
type is (kocka)
write(*,*) 'Umim mnoukat: '
call obj%mluv()
type is (pes)
write(*,*) 'Umím stekat: '
call obj%mluv()
class is (zvire)
write(*,*) 'Nejsem ani kocka ani pas, umim: '
call obj%mluv()
class default
write(*,*) 'Nejsem asi nic'
end select
end subroutine
end program prog_obj_5