From 9b98af91a88a5e18e8e954dc01649ae3a6496cff Mon Sep 17 00:00:00 2001 From: paul-corbalan Date: Mon, 21 Aug 2023 17:04:37 +0200 Subject: [PATCH] Import --- Fortran For Beginners/.gitignore | 2 + .../entreprise_hello.f90 | 16 ++ .../Section 1 - Introduction/hello.f90 | 3 + .../Section 2 - The Basics/Fibonacci.f90 | 30 +++ .../uninitialized_example.f90 | 7 + .../variables_example.f90 | 28 +++ .../Section 3 - Interactivity/Makefile | 25 +++ .../Section 3 - Interactivity/take_notes.f90 | 18 ++ .../to_the_power.f90 | 23 +++ .../Section 3 - Interactivity/todo.f90 | 10 + .../Section 3 - Interactivity/todo_m.f90 | 124 ++++++++++++ .../Section 3 - Interactivity/todo_m.mod | Bin 0 -> 1418 bytes .../todo_routines_m.f90 | 116 +++++++++++ .../todo_routines_m.mod | Bin 0 -> 677 bytes .../Makefile | 17 ++ .../todo.f90 | 10 + .../todo_m.f90 | 124 ++++++++++++ Intermediate Fortran/.gitignore | 3 + .../abstract_type_reduce.f90 | 57 ++++++ .../fibonaci.f90 | 17 ++ .../procedure_argument_reduce.f90 | 46 +++++ .../pure_and_elemental.f90 | 14 ++ .../pure_and_elemental_exercise.f90 | 30 +++ .../pure_and_elemental_solution.f90 | 39 ++++ .../recursive_sum_exercise.f90 | 27 +++ .../recursive_sum_solution.f90 | 37 ++++ .../sum_with_reduce_exercise.f90 | 56 ++++++ .../sum_with_reduce_solution.f90 | 56 ++++++ .../binary_tree-calculate_total/app/main.f90 | 27 +++ .../binary_tree-calculate_total/fpm.toml | 10 + .../src/leaf_m.f90 | 43 ++++ .../src/node_m.f90 | 162 +++++++++++++++ .../src/tree_m.f90 | 34 ++++ .../binary_tree-make_n-ary/app/main.f90 | 32 +++ .../binary_tree-make_n-ary/fpm.toml | 10 + .../binary_tree-make_n-ary/src/leaf_m.f90 | 35 ++++ .../binary_tree-make_n-ary/src/node_m.f90 | 155 +++++++++++++++ .../src/tree_item_m.f90 | 34 ++++ .../binary_tree-make_n-ary/src/tree_m.f90 | 24 +++ .../app/main.f90 | 42 ++++ .../heterogeneous_list-add_rectangle/fpm.toml | 10 + .../src/circle_m.f90 | 39 ++++ .../src/rectangle_m.f90 | 43 ++++ .../src/shape_item_m.f90 | 39 ++++ .../src/shape_list_m.f90 | 41 ++++ .../src/shape_m.f90 | 24 +++ .../src/square_m.f90 | 39 ++++ .../src/triangle_m.f90 | 43 ++++ .../app/main.f90 | 37 ++++ .../fpm.toml | 10 + .../src/circle_m.f90 | 47 +++++ .../src/shape_item_m.f90 | 47 +++++ .../src/shape_list_m.f90 | 49 +++++ .../src/shape_m.f90 | 34 ++++ .../src/square_m.f90 | 47 +++++ .../src/triangle_m.f90 | 51 +++++ .../linked_list_example.f90 | 120 +++++++++++ .../linked_list_exercise.f90 | 146 ++++++++++++++ .../linked_list_solution.f90 | 147 ++++++++++++++ .../app/main.f90 | 40 ++++ .../heterogeneous_list-concat_lists/fpm.toml | 10 + .../src/circle_m.f90 | 39 ++++ .../src/shape_item_m.f90 | 39 ++++ .../src/shape_list_m.f90 | 51 +++++ .../src/shape_m.f90 | 24 +++ .../src/square_m.f90 | 39 ++++ .../src/triangle_m.f90 | 43 ++++ .../app/main.f90 | 49 +++++ .../fpm.toml | 10 + .../src/circle_m.f90 | 64 ++++++ .../src/filter_out_area_greater_than_m.f90 | 35 ++++ .../src/filter_out_curves_m.f90 | 22 ++ .../src/shape_filterer_m.f90 | 25 +++ .../src/shape_item_m.f90 | 67 +++++++ .../src/shape_list_m.f90 | 79 ++++++++ .../src/shape_m.f90 | 56 ++++++ .../src/square_m.f90 | 64 ++++++ .../src/triangle_m.f90 | 68 +++++++ .../app/main.f90 | 48 +++++ .../fpm.toml | 10 + .../src/circle_m.f90 | 64 ++++++ .../src/filter_out_curves_m.f90 | 22 ++ .../src/shape_filterer_m.f90 | 25 +++ .../src/shape_item_m.f90 | 67 +++++++ .../src/shape_list_m.f90 | 79 ++++++++ .../src/shape_m.f90 | 56 ++++++ .../src/square_m.f90 | 64 ++++++ .../src/triangle_m.f90 | 68 +++++++ .../app/main.f90 | 40 ++++ .../heterogeneous_list-scale_shapes/fpm.toml | 10 + .../src/circle_m.f90 | 48 +++++ .../src/shape_item_m.f90 | 49 +++++ .../src/shape_list_m.f90 | 61 ++++++ .../src/shape_m.f90 | 36 ++++ .../src/square_m.f90 | 48 +++++ .../src/triangle_m.f90 | 52 +++++ .../stack_example-main/fpm.toml | 11 + .../src/fallible_integer_m.f90 | 58 ++++++ .../stack_example-main/src/stack_m.f90 | 151 ++++++++++++++ .../stack_example-main/test/main.f90 | 22 ++ .../stack_example-main/test/stack_input_m.f90 | 34 ++++ .../stack_example-main/test/stack_test.f90 | 188 ++++++++++++++++++ README.md | 4 + 103 files changed, 4695 insertions(+) create mode 100644 Fortran For Beginners/.gitignore create mode 100644 Fortran For Beginners/Section 1 - Introduction/entreprise_hello.f90 create mode 100644 Fortran For Beginners/Section 1 - Introduction/hello.f90 create mode 100644 Fortran For Beginners/Section 2 - The Basics/Fibonacci.f90 create mode 100644 Fortran For Beginners/Section 2 - The Basics/uninitialized_example.f90 create mode 100644 Fortran For Beginners/Section 2 - The Basics/variables_example.f90 create mode 100644 Fortran For Beginners/Section 3 - Interactivity/Makefile create mode 100644 Fortran For Beginners/Section 3 - Interactivity/take_notes.f90 create mode 100644 Fortran For Beginners/Section 3 - Interactivity/to_the_power.f90 create mode 100644 Fortran For Beginners/Section 3 - Interactivity/todo.f90 create mode 100644 Fortran For Beginners/Section 3 - Interactivity/todo_m.f90 create mode 100644 Fortran For Beginners/Section 3 - Interactivity/todo_m.mod create mode 100644 Fortran For Beginners/Section 3 - Interactivity/todo_routines_m.f90 create mode 100644 Fortran For Beginners/Section 3 - Interactivity/todo_routines_m.mod create mode 100644 Fortran For Beginners/Section 4 - A Touch of the More Advanced/Makefile create mode 100644 Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo.f90 create mode 100644 Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo_m.f90 create mode 100644 Intermediate Fortran/.gitignore create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/abstract_type_reduce.f90 create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/fibonaci.f90 create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/procedure_argument_reduce.f90 create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental.f90 create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_exercise.f90 create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_solution.f90 create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_exercise.f90 create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_solution.f90 create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_exercise.f90 create mode 100644 Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_solution.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/app/main.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/fpm.toml create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/leaf_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/node_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/tree_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/app/main.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/fpm.toml create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/leaf_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/node_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_item_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/app/main.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/fpm.toml create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/circle_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/rectangle_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_item_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_list_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/square_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/triangle_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/app/main.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/fpm.toml create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/circle_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_item_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_list_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/square_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/triangle_m.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/linked_list_example.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/linked_list_exercise.f90 create mode 100644 Intermediate Fortran/Section 3 - Data Structures/linked_list_solution.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/app/main.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/fpm.toml create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/circle_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_item_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_list_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/square_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/triangle_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/app/main.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/fpm.toml create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/circle_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_area_greater_than_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_curves_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_filterer_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_item_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_list_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/square_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/triangle_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/app/main.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/fpm.toml create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/circle_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/filter_out_curves_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_filterer_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_item_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_list_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/square_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/triangle_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/app/main.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/fpm.toml create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/circle_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_item_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_list_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/square_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/triangle_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/fpm.toml create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/fallible_integer_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/stack_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/main.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/stack_input_m.f90 create mode 100644 Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/stack_test.f90 create mode 100644 README.md diff --git a/Fortran For Beginners/.gitignore b/Fortran For Beginners/.gitignore new file mode 100644 index 0000000..774f008 --- /dev/null +++ b/Fortran For Beginners/.gitignore @@ -0,0 +1,2 @@ +*.exe +*.o diff --git a/Fortran For Beginners/Section 1 - Introduction/entreprise_hello.f90 b/Fortran For Beginners/Section 1 - Introduction/entreprise_hello.f90 new file mode 100644 index 0000000..8aed0a5 --- /dev/null +++ b/Fortran For Beginners/Section 1 - Introduction/entreprise_hello.f90 @@ -0,0 +1,16 @@ +program entreprise_hello + implicit none + + character(len=*), parameter :: PERSON = "World" + character(len=:), allocatable :: greeting + + greeting = greet(PERSON) + print '(A)', greeting + contains + pure function greet(person_) result(greeting_) + character(len=*), intent(in) :: person_ + character(len=:), allocatable :: greeting_ + + greeting_ = "Hello, " // person_ // "!" + end function greet +end program entreprise_hello \ No newline at end of file diff --git a/Fortran For Beginners/Section 1 - Introduction/hello.f90 b/Fortran For Beginners/Section 1 - Introduction/hello.f90 new file mode 100644 index 0000000..969710d --- /dev/null +++ b/Fortran For Beginners/Section 1 - Introduction/hello.f90 @@ -0,0 +1,3 @@ +program hello + print *, "Hello, world !" +end program hello \ No newline at end of file diff --git a/Fortran For Beginners/Section 2 - The Basics/Fibonacci.f90 b/Fortran For Beginners/Section 2 - The Basics/Fibonacci.f90 new file mode 100644 index 0000000..28b4da1 --- /dev/null +++ b/Fortran For Beginners/Section 2 - The Basics/Fibonacci.f90 @@ -0,0 +1,30 @@ +program Fibonacci + implicit none + + integer :: i + integer, dimension(10) :: fib_nb + + fib_nb(1) = 1 + fib_nb(2) = 1 + + do i = 3, 10 + fib_nb(i) = fib_nb(i-1) + fib_nb(i-2) + end do + + do i = 1, 10 + print *, fib_nb(i) + end do +contains + recursive function fib(n) result(fib_) + integer, intent(in) :: n + integer :: fib_ + + if (n == 1) then + fib_ = 1 + else if (n == 1) then + fib_ = 1 + else + fib_ = fib(n-1) + fib(n-2) + end if + end function fib +end program Fibonacci \ No newline at end of file diff --git a/Fortran For Beginners/Section 2 - The Basics/uninitialized_example.f90 b/Fortran For Beginners/Section 2 - The Basics/uninitialized_example.f90 new file mode 100644 index 0000000..00d2bcf --- /dev/null +++ b/Fortran For Beginners/Section 2 - The Basics/uninitialized_example.f90 @@ -0,0 +1,7 @@ +program uninitialized_example + implicit none + + character(len=10) :: something + + print *, something +end program uninitialized_example \ No newline at end of file diff --git a/Fortran For Beginners/Section 2 - The Basics/variables_example.f90 b/Fortran For Beginners/Section 2 - The Basics/variables_example.f90 new file mode 100644 index 0000000..2eac1b8 --- /dev/null +++ b/Fortran For Beginners/Section 2 - The Basics/variables_example.f90 @@ -0,0 +1,28 @@ +program variables_example + implicit none + + integer :: x + integer :: y + integer :: z + integer, parameter :: inches_per_foot = 12 + + print *, "x = ", x, "y = ", y, "z = ", z + print *, "inches_per_foot = ", inches_per_foot + + x = 3 + + print *, "x = ", x, "y = ", y, "z = ", z + + y = 4 + + print *, "x = ", x, "y = ", y, "z = ", z + + z = x + y + + print *, "x = ", x, "y = ", y, "z = ", z + + x = 1 + + print *, "x = ", x, "y = ", y, "z = ", z + +end program variables_example \ No newline at end of file diff --git a/Fortran For Beginners/Section 3 - Interactivity/Makefile b/Fortran For Beginners/Section 3 - Interactivity/Makefile new file mode 100644 index 0000000..5f4d4c2 --- /dev/null +++ b/Fortran For Beginners/Section 3 - Interactivity/Makefile @@ -0,0 +1,25 @@ +# From https://github.com/llamm-de/VSCode_Fortran_Tutorial +# variables +RM = del /Q /F + +FC=gfortran +CFLAGS=-c -g -Og -Wall +FILE=take_notes + +# linking +a.exe: $(FILE).o + $(FC) $(FILE).o + +# compiling +$(FILE).o: $(FILE).f90 + $(FC) $(CFLAGS) $(FILE).f90 + + +# cleanup +clean: + -$(RM) $(FILE).o a.exe + +# run +run: + make + ./a.exe diff --git a/Fortran For Beginners/Section 3 - Interactivity/take_notes.f90 b/Fortran For Beginners/Section 3 - Interactivity/take_notes.f90 new file mode 100644 index 0000000..66b776f --- /dev/null +++ b/Fortran For Beginners/Section 3 - Interactivity/take_notes.f90 @@ -0,0 +1,18 @@ +program take_notes + implicit none + + character(len=*), parameter :: NOTES_FILE = "notes.txt" + character(len=100) :: note + integer :: unit + + open(newunit = unit, file = NOTES_FILE, position = 'APPEND') + + do + print *, "Enter some notes. Enter 'DONE' to quit." + read(*, '(A)') note + if (trim(note) == "DONE") exit + write(unit, '(A)') trim(note) + end do + + close(unit) +end program take_notes diff --git a/Fortran For Beginners/Section 3 - Interactivity/to_the_power.f90 b/Fortran For Beginners/Section 3 - Interactivity/to_the_power.f90 new file mode 100644 index 0000000..9a55214 --- /dev/null +++ b/Fortran For Beginners/Section 3 - Interactivity/to_the_power.f90 @@ -0,0 +1,23 @@ +program to_the_power + implicit none + + integer :: base + integer :: power + integer :: status + + do + print *, "What’s the base number?" + read(*, *, iostat=status) base + if (status == 0) exit + print *, "Sorry, I didn’t understand that." + end do + + do + print *, "To what power?" + read(*, *, iostat=status) power + if (status == 0) exit + print *, "Sorry, I didn’t understand that." + end do + + print *, base, "**", power, " is ", base**power +end program to_the_power \ No newline at end of file diff --git a/Fortran For Beginners/Section 3 - Interactivity/todo.f90 b/Fortran For Beginners/Section 3 - Interactivity/todo.f90 new file mode 100644 index 0000000..a8b57e9 --- /dev/null +++ b/Fortran For Beginners/Section 3 - Interactivity/todo.f90 @@ -0,0 +1,10 @@ +program todo + use todo_m, only: Todo_t + + implicit none + + type(Todo_t) :: todo_list + + call todo_list%readPreviousTasks() + call todo_list%interact() +end program todo diff --git a/Fortran For Beginners/Section 3 - Interactivity/todo_m.f90 b/Fortran For Beginners/Section 3 - Interactivity/todo_m.f90 new file mode 100644 index 0000000..e2ec024 --- /dev/null +++ b/Fortran For Beginners/Section 3 - Interactivity/todo_m.f90 @@ -0,0 +1,124 @@ +module todo_m + implicit none + private + + integer, parameter :: MAX_TASKS = 99 + integer, parameter :: TASK_LENGTH = 100 + character(len=*), parameter :: TODO_FILE = "todo.txt" + + type, public :: Todo_t + private + character(len=TASK_LENGTH) :: tasks(MAX_TASKS) + integer :: num_tasks + contains + private + procedure, public :: readPreviousTasks + procedure, public :: interact + procedure :: add + procedure :: delete + procedure :: save + end type Todo_t +contains + subroutine readPreviousTasks(self) + class(Todo_t), intent(out) :: self + + integer :: i + integer :: status + integer :: unit + + open(newunit=unit, file=TODO_FILE) + + do i = 1, MAX_TASKS + read(unit, '(A)', iostat=status) self%tasks(i) + if (status /= 0) then + self%num_tasks = i - 1 + exit + else + self%num_tasks = i + end if + end do + + close(unit) + end subroutine readPreviousTasks + + subroutine interact(self) + class(Todo_t), intent(inout) :: self + + integer :: i + character(len=1) :: response + + do + print *, "Here are your current tasks" + do i = 1, self%num_tasks + print '(I3,") ",A)', i, trim(self%tasks(i)) + end do + + print *, "What would you like to do? (a)dd, (d)elete, (q)uit" + read(*, '(A1)') response + + select case (response) + case ('a') + call self%add() + case ('d') + call self%delete() + case ('q') + exit + case default + print *, "Sorry, I didn't understand that." + end select + + call self%save() + end do + end subroutine interact + + subroutine add(self) + class(Todo_t), intent(inout) :: self + + print *, "What's the task?" + self%num_tasks = self%num_tasks + 1 + read(*, '(A)') self%tasks(self%num_tasks) + end subroutine add + + subroutine delete(self) + class(Todo_t), intent(inout) :: self + + integer :: i + integer :: status + integer :: task + + do + print *, "Which one would you like to delete?" + read(*, *, iostat=status) task + if (status == 0) then + if (task < 1) then + print *, "Task number must be > 1" + else if (task > self%num_tasks) then + print *, "Task number must be <= ", self%num_tasks + else + do i = task, self%num_tasks + self%tasks(i) = self%tasks(i+1) + end do + self%num_tasks = self%num_tasks - 1 + exit + end if + else + print *, "Sorry, I didn't understand that." + end if + end do + end subroutine delete + + subroutine save(self) + class(Todo_t), intent(in) :: self + + integer :: i + integer :: unit + + open(newunit=unit, file=TODO_FILE, status='REPLACE') + + do i = 1, self%num_tasks + write(unit, '(A)') trim(self%tasks(i)) + end do + + close(unit) + end subroutine save +end module todo_m diff --git a/Fortran For Beginners/Section 3 - Interactivity/todo_m.mod b/Fortran For Beginners/Section 3 - Interactivity/todo_m.mod new file mode 100644 index 0000000000000000000000000000000000000000..8179626550d4991db092e30b986cb27e8521390d GIT binary patch literal 1418 zcmV;51$Fu#iwFP!000003e}lObE7yEfbaShx`7Wp#pdluK=DwG!Nub4oG3ab)vj^k zluf55^XunHEEZ;U;$)`FNd?6Seedb5VsYzwfu}q8aliSsOYlo_IBxe(Sdhm8zCR>! znr!gHVgHEJ{bnCM{_!xEkSLDuHGWWWF+y+&zoNiaNd=r;JPKGTzbt+gEClCw2?Ca} zD4N8x*2Ki2^VM;`IbSR%AWl#YSDtGW1C;;85`0!LO%F(9xXTsrh$=ieKK^wSuxR|L zd%6)24;GNv=ky;@M2745fevekbgc#aQ_F8F#vmPx1X+>AaOlwIT-*TN%d9Q95#P>5K4GT}d9-~5Qs7n&D zp9eK<8PC&1F)H@4d@$1q{S@O&FH*if{G}J75N|dBUCegZ#Pcjuzp)8k>AsKr6)~(^ z%fOBstyV^6ZDT5lut|1FnsiLY#bm@!p0LT=r!+al_bHto-her@&ps`UWIScF!8te2 zhva3u|8*?%KKwCQMl<%9WBf9Rzasp+G^)ansa9vQs!XKWWQ1fez9`xx57G8%n?{+N zMs04p);)_YIK&97W#%|ve0@#Wvbq;gKufoApnD4vWN1Y&P;wh6#x)xlm6sBb%ar^j zjemSFb%u)9fqqlvm6gnA&_G}%1Acu@`iPsuW3R6PasTBgqi$bgy}6eD$+n4&uTPI zl=1H=3Z#a-QMkqckyJ4mKw!+B@X9X^}tGQ=t~ zWs2+lY+j1BZE96`lNfd-qTYs%5kM1$7sP?|ZB+7PHy}DM9LKp&4MtnKW@wWZveRz# zGbz+8L}gy;4RKhLQ{ei1GL@-Il^e;Xe1^C-8zgg2zl&f%yvQUg;+VuS?i!I%1zBOp zYGZRS!%Yr4lpUS3w`Ag8y&_d(kmE+kc@Yu+gZ-W`u4&_bLv0G36)jo28Y^|yrNNpz zw^hu83)X=yugQm&=jnx zSku_;%K2U?)QFPZ14D-&WyW{tmIJEot*4P0E|GKiP zGX&-H5yoc-8jmmp0A~Q`tpL+AfJs#cAHF`d#KV2L{OrQz5$8PIR&;gmZAHikY2fRd zW7-BY$R4iB16@{pIK;07ktV;Bs5q9!hU)~@B6LH4FlJs7v54jS;gXn 1" + else if (task > num_tasks_) then + print *, "Task number must be <= ", num_tasks_ + else + do i = task, num_tasks_ + tasks_(i) = tasks_(i+1) + end do + num_tasks_ = num_tasks_ - 1 + exit + end if + else + print *, "Sorry, I didn't understand that." + end if + end do + end subroutine delete + + subroutine save(tasks_, num_tasks_) + character(len=TASK_LENGTH), intent(in) :: tasks_(MAX_TASKS) + integer, intent(in) :: num_tasks_ + + integer :: i + integer :: unit + + open(newunit=unit, file=TODO_FILE, status='REPLACE') + + do i = 1, num_tasks_ + write(unit, '(A)') trim(tasks_(i)) + end do + + close(unit) + end subroutine save +end module todo_routines_m diff --git a/Fortran For Beginners/Section 3 - Interactivity/todo_routines_m.mod b/Fortran For Beginners/Section 3 - Interactivity/todo_routines_m.mod new file mode 100644 index 0000000000000000000000000000000000000000..84924811dbac231e43646f899376252f53a18ec9 GIT binary patch literal 677 zcmV;W0$TkaiwFP!000003hkHQZ=ygD$KUs_n77pj8x}#~kt)|CC(t0YcTdI?yfdeA z0c`r`->^VM++wR<`%a&U}W=&fOQ+^F70XbsTP25j;mpx{NnKnM&a)iRM`p z!Xk;+ki}sJ5;v(DU4l))BLkg>AqCn{fg=$ zUTLQu-|LbA&@fs>S@fwAhq*)zbfH8h0bOpgD49QHC#WPfm2i$q!dNbo$-w%hx`t2% z=z9J#%jW6tv`wku8Mf)0UQ=n+RDYWY6LZwpL z$aSW^fuP#n#vavm%9{xqpvgz%dMgX<`gI&~*O%xfv~U z1~LO#=9@%Qq})e!7|Piy+WgFZ{a4w-BuS7ir0`2AJy|SQtpqON)#xj(GRhZWrP9|C z+~MEtkH)>>?PerMiwX3i_(&_D$sP}`0OgG#0>;i$?g{xhQ^lE-ziPpq7yy82GPZ!}kDRAfF!!t#LA7fX5 zM**_Fh~URVhdR$kI6Oc&sOz`_6amzP08a?qx%lv;*1(4+xV<#G(mRNmETVTp+|GrU z7urRcErGl%XeAibD@O_PO0rg<;ebL!#SKoVRSkh{y>V1WBmKQoE)L*A2ZuQvR=eac LnBfw!sSp4F%8gPX literal 0 HcmV?d00001 diff --git a/Fortran For Beginners/Section 4 - A Touch of the More Advanced/Makefile b/Fortran For Beginners/Section 4 - A Touch of the More Advanced/Makefile new file mode 100644 index 0000000..e6728a1 --- /dev/null +++ b/Fortran For Beginners/Section 4 - A Touch of the More Advanced/Makefile @@ -0,0 +1,17 @@ +RM = del /Q /F + +todo: todo_m.o todo.o + gfortran todo_m.o todo.o -o todo + +todo.o: todo.f90 todo_m.mod + gfortran -c todo.f90 -o todo.o + +todo_m.o todo_m.mod: todo_m.f90 + gfortran -c todo_m.f90 -o todo_m.o + +# .PHONY: clean +clean: + -$(RM) todo todo.o todo_m.o todo_m.mod +clean_exe: + make clean + -$(RM) todo.exe diff --git a/Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo.f90 b/Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo.f90 new file mode 100644 index 0000000..a8b57e9 --- /dev/null +++ b/Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo.f90 @@ -0,0 +1,10 @@ +program todo + use todo_m, only: Todo_t + + implicit none + + type(Todo_t) :: todo_list + + call todo_list%readPreviousTasks() + call todo_list%interact() +end program todo diff --git a/Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo_m.f90 b/Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo_m.f90 new file mode 100644 index 0000000..e2ec024 --- /dev/null +++ b/Fortran For Beginners/Section 4 - A Touch of the More Advanced/todo_m.f90 @@ -0,0 +1,124 @@ +module todo_m + implicit none + private + + integer, parameter :: MAX_TASKS = 99 + integer, parameter :: TASK_LENGTH = 100 + character(len=*), parameter :: TODO_FILE = "todo.txt" + + type, public :: Todo_t + private + character(len=TASK_LENGTH) :: tasks(MAX_TASKS) + integer :: num_tasks + contains + private + procedure, public :: readPreviousTasks + procedure, public :: interact + procedure :: add + procedure :: delete + procedure :: save + end type Todo_t +contains + subroutine readPreviousTasks(self) + class(Todo_t), intent(out) :: self + + integer :: i + integer :: status + integer :: unit + + open(newunit=unit, file=TODO_FILE) + + do i = 1, MAX_TASKS + read(unit, '(A)', iostat=status) self%tasks(i) + if (status /= 0) then + self%num_tasks = i - 1 + exit + else + self%num_tasks = i + end if + end do + + close(unit) + end subroutine readPreviousTasks + + subroutine interact(self) + class(Todo_t), intent(inout) :: self + + integer :: i + character(len=1) :: response + + do + print *, "Here are your current tasks" + do i = 1, self%num_tasks + print '(I3,") ",A)', i, trim(self%tasks(i)) + end do + + print *, "What would you like to do? (a)dd, (d)elete, (q)uit" + read(*, '(A1)') response + + select case (response) + case ('a') + call self%add() + case ('d') + call self%delete() + case ('q') + exit + case default + print *, "Sorry, I didn't understand that." + end select + + call self%save() + end do + end subroutine interact + + subroutine add(self) + class(Todo_t), intent(inout) :: self + + print *, "What's the task?" + self%num_tasks = self%num_tasks + 1 + read(*, '(A)') self%tasks(self%num_tasks) + end subroutine add + + subroutine delete(self) + class(Todo_t), intent(inout) :: self + + integer :: i + integer :: status + integer :: task + + do + print *, "Which one would you like to delete?" + read(*, *, iostat=status) task + if (status == 0) then + if (task < 1) then + print *, "Task number must be > 1" + else if (task > self%num_tasks) then + print *, "Task number must be <= ", self%num_tasks + else + do i = task, self%num_tasks + self%tasks(i) = self%tasks(i+1) + end do + self%num_tasks = self%num_tasks - 1 + exit + end if + else + print *, "Sorry, I didn't understand that." + end if + end do + end subroutine delete + + subroutine save(self) + class(Todo_t), intent(in) :: self + + integer :: i + integer :: unit + + open(newunit=unit, file=TODO_FILE, status='REPLACE') + + do i = 1, self%num_tasks + write(unit, '(A)') trim(self%tasks(i)) + end do + + close(unit) + end subroutine save +end module todo_m diff --git a/Intermediate Fortran/.gitignore b/Intermediate Fortran/.gitignore new file mode 100644 index 0000000..ae3b20f --- /dev/null +++ b/Intermediate Fortran/.gitignore @@ -0,0 +1,3 @@ +*.exe +*.mod +*.o diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/abstract_type_reduce.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/abstract_type_reduce.f90 new file mode 100644 index 0000000..5e20090 --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/abstract_type_reduce.f90 @@ -0,0 +1,57 @@ +module reduce_m + implicit none + + type, abstract :: accumulator_t + contains + procedure(combiner), deferred, nopass :: combine + end type + + abstract interface + pure function combiner(x, y) result(z) + integer, intent(in) :: x + integer, intent(in) :: y + integer :: z + end function + end interface +contains + pure recursive function reduce(vals, accumulator, init) result(combined) + integer, intent(in) :: vals(:) + class(accumulator_t), intent(in) :: accumulator + integer, intent(in) :: init + integer :: combined + + if (size(vals) == 1) then + combined = accumulator%combine(init, vals(1)) + else + combined = reduce(vals(2:), accumulator, accumulator%combine(init, vals(1))) + end if + end function +end module + +module multiplier_m + use reduce_m, only: accumulator_t + + implicit none + + type, extends(accumulator_t) :: multiplier_t + contains + procedure, nopass :: combine => multiply + end type +contains + pure function multiply(x, y) result(z) + integer, intent(in) :: x + integer, intent(in) :: y + integer :: z + + z = x * y + end function +end module + +program main + use multiplier_m, only: multiplier_t + use reduce_m, only: reduce + + implicit none + + print *, reduce([1, 2, 3, 4], multiplier_t(), 1) +end program diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/fibonaci.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/fibonaci.f90 new file mode 100644 index 0000000..4130ebe --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/fibonaci.f90 @@ -0,0 +1,17 @@ +program fibonaci_test + implicit none + + print *, fibonaci(6) +contains + recursive function fibonaci(number) result(fibonaci_number) + integer, intent(in) :: number + integer :: fibonaci_number + + if (number <= 2) then + fibonaci_number = 1 + else + fibonaci_number = fibonaci(number - 1) + fibonaci(number - 2) + end if + print *, "result:", fibonaci_number + end function +end program diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/procedure_argument_reduce.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/procedure_argument_reduce.f90 new file mode 100644 index 0000000..c279090 --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/procedure_argument_reduce.f90 @@ -0,0 +1,46 @@ +module reduce_m + implicit none + + abstract interface + pure function combiner(x, y) result(z) + integer, intent(in) :: x + integer, intent(in) :: y + integer :: z + end function + end interface +contains + pure recursive function reduce(vals, accumulator, init) result(combined) + integer, intent(in) :: vals(:) + procedure(combiner) :: accumulator + integer, intent(in) :: init + integer :: combined + + if (size(vals) == 1) then + combined = accumulator(init, vals(1)) + else + combined = reduce(vals(2:), accumulator, accumulator(init, vals(1))) + end if + end function +end module + +module multiplier_m + implicit none + +contains + pure function multiply(x, y) result(z) + integer, intent(in) :: x + integer, intent(in) :: y + integer :: z + + z = x * y + end function +end module + +program main + use multiplier_m, only: multiply + use reduce_m, only: reduce + + implicit none + + print *, reduce([1, 2, 3, 4], multiply, 1) +end program diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental.f90 new file mode 100644 index 0000000..0bad73c --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental.f90 @@ -0,0 +1,14 @@ +program pure_and_elemental + implicit none + + integer, parameter :: numbers(*) = [2, 3, 5, 7, 11] + + print *, multiply_by_three(numbers) +contains + elemental function multiply_by_three(number) result(multiplied_by_three) + integer, intent(in) :: number + integer :: multiplied_by_three + + multiplied_by_three = number * 3 + end function +end program diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_exercise.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_exercise.f90 new file mode 100644 index 0000000..e488047 --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_exercise.f90 @@ -0,0 +1,30 @@ +program pure_and_elemental_exercise + implicit none + + integer, parameter :: PRIMES(*) = [2, 3, 5, 7, 11] + integer, parameter :: REAL_ANSWER = 1872 + integer :: answer + + ! Replace '42' with an expression using elemental functions + ! that calculates the equivalent of the following: + ! answer = 0 + ! do i = 1, size(PRIMES) + ! answer = answer + (primes(i) * 3)**2 + ! end do + answer = sum(function_(primes)) + + if (answer == REAL_ANSWER) then + print *, "You got it! :)" + else + print *, answer + print *, "Not passing yet :(" + end if +contains + ! put your functions down here + elemental function function_(primes_) result(resu) + integer, intent(in) :: primes_ + integer :: resu + + resu = (primes_ * 3)**2 + end function +end program diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_solution.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_solution.f90 new file mode 100644 index 0000000..4ecf2ed --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/pure_and_elemental_solution.f90 @@ -0,0 +1,39 @@ +program pure_and_elemental_exercise + implicit none + + integer, parameter :: PRIMES(*) = [2, 3, 5, 7, 11] + integer, parameter :: REAL_ANSWER = 1872 + integer :: answer + + ! Replace '42' with an expression using elemental functions + ! that calculates the equivalent of the following: + ! answer = 0 + ! do i = 1, size(PRIMES) + ! answer = answer + (primes(i) * 3)**2 + ! end do + answer = sum(square(multiply_by_three(PRIMES))) + ! Note: intrinsic operators are already elemental, so the following works too + ! answer = sum((PRIMES * 3)**2) + + if (answer == REAL_ANSWER) then + print *, "You got it! :)" + else + print *, answer + print *, "Not passing yet :(" + end if +contains + ! put your functions down here + elemental function multiply_by_three(number) result(multiplied_by_three) + integer, intent(in) :: number + integer :: multiplied_by_three + + multiplied_by_three = number * 3 + end function + + elemental function square(number) result(squared) + integer, intent(in) :: number + integer :: squared + + squared = number ** 2 + end function +end program diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_exercise.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_exercise.f90 new file mode 100644 index 0000000..4059192 --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_exercise.f90 @@ -0,0 +1,27 @@ +program recursive_sum_exercise + implicit none + + integer, parameter :: THE_NUMBERS(*) = [2, 3, 5, 7, 11] + integer :: answer + + answer = sum_(THE_NUMBERS) + + if (answer == 28) then + print *, "You got it! :)" + else + print *, answer + print *, "Not quite right yet. :(" + end if +contains + recursive function sum_(numbers) result(total) + integer, intent(in) :: numbers(:) + integer :: total + + total = 0 + if (size(numbers)==1) then + total = numbers(1) + else + total = numbers(1) + sum_(numbers(2:)) + end if + end function +end program diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_solution.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_solution.f90 new file mode 100644 index 0000000..410d50e --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/recursive_sum_solution.f90 @@ -0,0 +1,37 @@ +program recursive_sum_exercise + implicit none + + integer, parameter :: THE_NUMBERS(*) = [2, 3, 5, 7, 11] + integer :: answer + + answer = sum2(THE_NUMBERS) + + if (answer == 28) then + print *, "You got it! :)" + else + print *, answer + print *, "Not quite right yet. :(" + end if +contains + recursive function sum_(numbers) result(total) + integer, intent(in) :: numbers(:) + integer :: total + + if (size(numbers) == 1) then + total = numbers(1) + else + total = sum_(numbers(1:size(numbers)/2)) + sum_(numbers(size(numbers)/2+1:)) + end if + end function + + recursive function sum2(numbers) result(total) + integer, intent(in) :: numbers(:) + integer :: total + + if (size(numbers) == 1) then + total = numbers(1) + else + total = numbers(1) + sum2(numbers(2:)) + end if + end function +end program diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_exercise.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_exercise.f90 new file mode 100644 index 0000000..f9384e1 --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_exercise.f90 @@ -0,0 +1,56 @@ +module reduce_m + implicit none + + abstract interface + pure function combiner(x, y) result(z) + integer, intent(in) :: x + integer, intent(in) :: y + integer :: z + end function + end interface +contains + pure recursive function reduce(vals, accumulator, init) result(combined) + integer, intent(in) :: vals(:) + procedure(combiner) :: accumulator + integer, intent(in) :: init + integer :: combined + + if (size(vals) == 1) then + combined = accumulator(init, vals(1)) + else + combined = reduce(vals(2:), accumulator, accumulator(init, vals(1))) + end if + end function +end module + +program main + use reduce_m, only: reduce + + implicit none + + integer :: answer + + answer = sum_([1, 2, 3, 4]) + + if (answer == 10) then + print *, "You got it! :)" + else + print *, answer + print *, "Not quite right yet. :(" + end if +contains + pure function sum_(numbers) result(total) + integer, intent(in) :: numbers(:) + integer :: total + + total = reduce(numbers, add, 0) + end function + + pure function add(x, y) result(z) + integer, intent(in) :: x + integer, intent(in) :: y + integer :: z + + z = x + y + end function +end program diff --git a/Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_solution.f90 b/Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_solution.f90 new file mode 100644 index 0000000..f9384e1 --- /dev/null +++ b/Intermediate Fortran/Section 2 - Procedure Attributes/sum_with_reduce_solution.f90 @@ -0,0 +1,56 @@ +module reduce_m + implicit none + + abstract interface + pure function combiner(x, y) result(z) + integer, intent(in) :: x + integer, intent(in) :: y + integer :: z + end function + end interface +contains + pure recursive function reduce(vals, accumulator, init) result(combined) + integer, intent(in) :: vals(:) + procedure(combiner) :: accumulator + integer, intent(in) :: init + integer :: combined + + if (size(vals) == 1) then + combined = accumulator(init, vals(1)) + else + combined = reduce(vals(2:), accumulator, accumulator(init, vals(1))) + end if + end function +end module + +program main + use reduce_m, only: reduce + + implicit none + + integer :: answer + + answer = sum_([1, 2, 3, 4]) + + if (answer == 10) then + print *, "You got it! :)" + else + print *, answer + print *, "Not quite right yet. :(" + end if +contains + pure function sum_(numbers) result(total) + integer, intent(in) :: numbers(:) + integer :: total + + total = reduce(numbers, add, 0) + end function + + pure function add(x, y) result(z) + integer, intent(in) :: x + integer, intent(in) :: y + integer :: z + + z = x + y + end function +end program diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/app/main.f90 b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/app/main.f90 new file mode 100644 index 0000000..f76280a --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/app/main.f90 @@ -0,0 +1,27 @@ +program main + use iso_varying_string, only: put_line + use leaf_m, only: leaf_t + use node_m, only: node_t + use strff, only: to_string + + implicit none + + type(node_t) :: tree + + tree = node_t( & + node_t( & + node_t( & + node_t( & + leaf_t(1), & + leaf_t(23)), & + leaf_t(4)), & + leaf_t(567)), & + node_t( & + leaf_t(89), & + node_t( & + leaf_t(1234), & + leaf_t(56)))) + + call put_line(tree%to_string()) + call put_line(to_string(tree%total())) +end program diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/fpm.toml b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/fpm.toml new file mode 100644 index 0000000..cda15e1 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/fpm.toml @@ -0,0 +1,10 @@ +name = "binary_tree" +version = "0.1.0" +license = "MIT" +author = "Brad Richardson" +maintainer = "everythingfunctional@protonmail.com" +copyright = "2021 Brad Richardson" + +[dependencies] + iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" } + strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" } diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/leaf_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/leaf_m.f90 new file mode 100644 index 0000000..c2dc2b0 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/leaf_m.f90 @@ -0,0 +1,43 @@ +module leaf_m + use iso_varying_string, only: varying_string + use strff, only: to_string + use tree_m, only: tree_t + + implicit none + private + public :: leaf_t + + type, extends(tree_t) :: leaf_t + private + integer :: value_ + contains + private + procedure, public :: to_string => leaf_to_string + procedure, public :: total + end type + + interface leaf_t + module procedure constructor + end interface +contains + pure function constructor(value_) result(leaf) + integer, intent(in) :: value_ + type(leaf_t) :: leaf + + leaf%value_ = value_ + end function + + pure function leaf_to_string(self) result(string) + class(leaf_t), intent(in) :: self + type(varying_string) :: string + + string = to_string(self%value_) + end function + + pure function total(self) + class(leaf_t), intent(in) :: self + integer :: total + + total = self%value_ + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/node_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/node_m.f90 new file mode 100644 index 0000000..6685990 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/node_m.f90 @@ -0,0 +1,162 @@ +module node_m + use iso_varying_string, only: & + varying_string, assignment(=), operator(//), len, trim, var_str + use strff, only: join, split_at, NEWLINE + use tree_m, only: tree_t + + implicit none + private + public :: node_t + + type, extends(tree_t) :: node_t + private + class(tree_t), allocatable :: left, right + contains + private + procedure, public :: to_string + procedure, public :: total + end type + + interface node_t + module procedure constructor + end interface +contains + function constructor(left, right) result(node) + class(tree_t), intent(in) :: left, right + type(node_t) :: node + + allocate(node%left, source = left) + allocate(node%right, source = right) + end function + + pure recursive function to_string(self) result(string) + class(node_t), intent(in) :: self + type(varying_string) :: string + + type(varying_string) :: blocked + type(varying_string), allocatable :: child_strings(:) + type(varying_string) :: dashed_line + integer :: height_ + type(varying_string), allocatable :: padded_strings(:) + type(varying_string) :: pipes + integer, allocatable :: widths(:) + + allocate(child_strings, source = [self%left%to_string(), self%right%to_string()]) + allocate(widths, source = max_width(child_strings)+1) + height_ = maxval(height(child_strings)) + dashed_line = make_dashes(widths) + pipes = join(make_pipe(widths), "") + allocate(padded_strings, source = pad_to(child_strings, widths, height_)) + blocked = join( & + [ dashed_line& + , pipes & + , concat_lines(padded_strings) & + ], & + NEWLINE) + string = strip_trailing_space(blocked) + end function + + pure recursive function total(self) + class(node_t), intent(in) :: self + integer :: total + + total = self%left%total() + self%right%total() + end function + + elemental function max_width(tree_string) result(width) + type(varying_string), intent(in) :: tree_string + integer :: width + + width = maxval(len(split_at(tree_string, NEWLINE))) + end function + + elemental function height(tree_string) + type(varying_string), intent(in) :: tree_string + integer :: height + + height = size(split_at(tree_string, NEWLINE)) + end function + + elemental function pad_to(string, width, num_lines) result(padded) + type(varying_string), intent(in) :: string + integer, intent(in) :: width, num_lines + type(varying_string) :: padded + + integer :: i + + associate(lines => split_at(string, NEWLINE)) + associate(padded_lines => pad_line(lines, width)) + padded = join([padded_lines, [(var_str(repeat(" ", width)), i = 1, num_lines - size(lines))]], NEWLINE) + end associate + end associate + contains + elemental function pad_line(line, width) result(padded_line) + type(varying_string), intent(in) :: line + integer, intent(in) :: width + type(varying_string) :: padded_line + + padded_line = line // repeat(" ", width - len(line)) + end function + end function + + pure function make_dashes(widths) result(dashes) + integer, intent(in) :: widths(:) + type(varying_string) :: dashes + + if (size(widths) == 1) then + dashes = make_pipe(widths(1)) + else + associate( & + leading_spaces => widths(1)/2 - 1, & + trailing_spaces => widths(size(widths)) - widths(size(widths))/2, & + total_width => sum(widths)) + associate(dash_width => total_width - leading_spaces - trailing_spaces) + dashes = repeat(" ", leading_spaces) // repeat("-", dash_width) // repeat(" ", trailing_spaces) + end associate + end associate + end if + end function + + elemental function make_pipe(width) result(pipe) + integer, intent(in) :: width + type(varying_string) :: pipe + + pipe = center_in(var_str("|"), width) + end function + + pure function center_in(string, width) result(centered) + type(varying_string), intent(in) :: string + integer, intent(in) :: width + type(varying_string) :: centered + + associate(leading_spaces => width/2 - len(string)/2 - 1) + associate(trailing_spaces => width - leading_spaces - len(string)) + centered = repeat(" ", leading_spaces) // string // repeat(" ", trailing_spaces) + end associate + end associate + end function + + pure function concat_lines(strings) result(joined) + type(varying_string), intent(in) :: strings(:) + type(varying_string) :: joined + + integer :: i, j + + associate(lines => [(split_at(strings(i), NEWLINE), i = 1, size(strings))]) + associate(num_lines => size(lines) / size(strings)) + joined = join( & + [(join( & + [(lines(i), i = j, num_lines*size(strings), num_lines)] & + , ""), j = 1, num_lines)], & + NEWLINE) + end associate + end associate + end function + + pure function strip_trailing_space(string) result(stripped) + type(varying_string), intent(in) :: string + type(varying_string) :: stripped + + stripped = join(trim(split_at(string, NEWLINE)), NEWLINE) + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/tree_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/tree_m.f90 new file mode 100644 index 0000000..cb06a2e --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-calculate_total/src/tree_m.f90 @@ -0,0 +1,34 @@ +module tree_m + use iso_varying_string, only: varying_string + + implicit none + private + public :: tree_t + + type, abstract :: tree_t + contains + private + procedure(to_string_i), public, deferred :: to_string + procedure(total_i), public, deferred :: total + end type + + abstract interface + pure function to_string_i(self) result(string) + import :: tree_t, varying_string + + implicit none + + class(tree_t), intent(in) :: self + type(varying_string) :: string + end function + + pure function total_i(self) result(total) + import :: tree_t + + implicit none + + class(tree_t), intent(in) :: self + integer :: total + end function + end interface +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/app/main.f90 b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/app/main.f90 new file mode 100644 index 0000000..a5c7e00 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/app/main.f90 @@ -0,0 +1,32 @@ +program main + use iso_varying_string, only: put_line + use leaf_m, only: leaf_t + use node_m, only: node_t + use tree_item_m, only: tree_item_t + + implicit none + + type(node_t) :: tree + + tree = node_t( & + [ tree_item_t(node_t( & + [ tree_item_t(node_t( & + [ tree_item_t(leaf_t(1)) & + , tree_item_t(leaf_t(23)) & + , tree_item_t(leaf_t(4)) & + ])) & + , tree_item_t(leaf_t(567)) & + ])) & + , tree_item_t(node_t( & + [ tree_item_t(node_t( & + [ tree_item_t(leaf_t(89)) & + ])) & + , tree_item_t(node_t( & + [ tree_item_t(leaf_t(1234)) & + , tree_item_t(leaf_t(56)) & + ])) & + ])) & + ]) + + call put_line(tree%to_string()) +end program diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/fpm.toml b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/fpm.toml new file mode 100644 index 0000000..cda15e1 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/fpm.toml @@ -0,0 +1,10 @@ +name = "binary_tree" +version = "0.1.0" +license = "MIT" +author = "Brad Richardson" +maintainer = "everythingfunctional@protonmail.com" +copyright = "2021 Brad Richardson" + +[dependencies] + iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" } + strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" } diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/leaf_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/leaf_m.f90 new file mode 100644 index 0000000..9b99d71 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/leaf_m.f90 @@ -0,0 +1,35 @@ +module leaf_m + use iso_varying_string, only: varying_string + use strff, only: to_string + use tree_m, only: tree_t + + implicit none + private + public :: leaf_t + + type, extends(tree_t) :: leaf_t + private + integer :: value_ + contains + private + procedure, public :: to_string => leaf_to_string + end type + + interface leaf_t + module procedure constructor + end interface +contains + pure function constructor(value_) result(leaf) + integer, intent(in) :: value_ + type(leaf_t) :: leaf + + leaf%value_ = value_ + end function + + pure function leaf_to_string(self) result(string) + class(leaf_t), intent(in) :: self + type(varying_string) :: string + + string = to_string(self%value_) + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/node_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/node_m.f90 new file mode 100644 index 0000000..44ddbab --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/node_m.f90 @@ -0,0 +1,155 @@ +module node_m + use iso_varying_string, only: & + varying_string, assignment(=), operator(//), len, trim, var_str + use strff, only: join, split_at, NEWLINE + use tree_m, only: tree_t + use tree_item_m, only: tree_item_t + + implicit none + private + public :: node_t + + type, extends(tree_t) :: node_t + private + type(tree_item_t), allocatable :: children(:) + contains + private + procedure, public :: to_string + end type + + interface node_t + module procedure constructor + end interface +contains + function constructor(children) result(node) + type(tree_item_t), intent(in) :: children(:) + type(node_t) :: node + + allocate(node%children, source = children) + end function + + pure recursive function to_string(self) result(string) + class(node_t), intent(in) :: self + type(varying_string) :: string + + type(varying_string) :: blocked + type(varying_string), allocatable :: child_strings(:) + type(varying_string) :: dashed_line + integer :: height_ + integer :: i + type(varying_string), allocatable :: padded_strings(:) + type(varying_string) :: pipes + integer, allocatable :: widths(:) + + allocate(child_strings, source = [(self%children(i)%to_string(), i = 1, size(self%children))]) + allocate(widths, source = max_width(child_strings)+1) + height_ = maxval(height(child_strings)) + dashed_line = make_dashes(widths) + pipes = join(make_pipe(widths), "") + allocate(padded_strings, source = pad_to(child_strings, widths, height_)) + blocked = join( & + [ dashed_line& + , pipes & + , concat_lines(padded_strings) & + ], & + NEWLINE) + string = strip_trailing_space(blocked) + end function + + elemental function max_width(tree_string) result(width) + type(varying_string), intent(in) :: tree_string + integer :: width + + width = maxval(len(split_at(tree_string, NEWLINE))) + end function + + elemental function height(tree_string) + type(varying_string), intent(in) :: tree_string + integer :: height + + height = size(split_at(tree_string, NEWLINE)) + end function + + elemental function pad_to(string, width, num_lines) result(padded) + type(varying_string), intent(in) :: string + integer, intent(in) :: width, num_lines + type(varying_string) :: padded + + integer :: i + + associate(lines => split_at(string, NEWLINE)) + associate(padded_lines => pad_line(lines, width)) + padded = join([padded_lines, [(var_str(repeat(" ", width)), i = 1, num_lines - size(lines))]], NEWLINE) + end associate + end associate + contains + elemental function pad_line(line, width) result(padded_line) + type(varying_string), intent(in) :: line + integer, intent(in) :: width + type(varying_string) :: padded_line + + padded_line = line // repeat(" ", width - len(line)) + end function + end function + + pure function make_dashes(widths) result(dashes) + integer, intent(in) :: widths(:) + type(varying_string) :: dashes + + if (size(widths) == 1) then + dashes = make_pipe(widths(1)) + else + associate( & + leading_spaces => widths(1)/2 - 1, & + trailing_spaces => widths(size(widths)) - widths(size(widths))/2, & + total_width => sum(widths)) + associate(dash_width => total_width - leading_spaces - trailing_spaces) + dashes = repeat(" ", leading_spaces) // repeat("-", dash_width) // repeat(" ", trailing_spaces) + end associate + end associate + end if + end function + + elemental function make_pipe(width) result(pipe) + integer, intent(in) :: width + type(varying_string) :: pipe + + pipe = center_in(var_str("|"), width) + end function + + pure function center_in(string, width) result(centered) + type(varying_string), intent(in) :: string + integer, intent(in) :: width + type(varying_string) :: centered + + associate(leading_spaces => width/2 - len(string)/2 - 1) + associate(trailing_spaces => width - leading_spaces - len(string)) + centered = repeat(" ", leading_spaces) // string // repeat(" ", trailing_spaces) + end associate + end associate + end function + + pure function concat_lines(strings) result(joined) + type(varying_string), intent(in) :: strings(:) + type(varying_string) :: joined + + integer :: i, j + + associate(lines => [(split_at(strings(i), NEWLINE), i = 1, size(strings))]) + associate(num_lines => size(lines) / size(strings)) + joined = join( & + [(join( & + [(lines(i), i = j, num_lines*size(strings), num_lines)] & + , ""), j = 1, num_lines)], & + NEWLINE) + end associate + end associate + end function + + pure function strip_trailing_space(string) result(stripped) + type(varying_string), intent(in) :: string + type(varying_string) :: stripped + + stripped = join(trim(split_at(string, NEWLINE)), NEWLINE) + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_item_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_item_m.f90 new file mode 100644 index 0000000..5faae96 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_item_m.f90 @@ -0,0 +1,34 @@ +module tree_item_m + use iso_varying_string, only: varying_string + use tree_m, only: tree_t + + implicit none + private + public :: tree_item_t + + type :: tree_item_t + private + class(tree_t), allocatable :: tree + contains + private + procedure, public :: to_string + end type + + interface tree_item_t + module procedure constructor + end interface +contains + function constructor(tree) result(tree_item) + class(tree_t), intent(in) :: tree + type(tree_item_t) :: tree_item + + allocate(tree_item%tree, source = tree) + end function + + pure recursive function to_string(self) result(string) + class(tree_item_t), intent(in) :: self + type(varying_string) :: string + + string = self%tree%to_string() + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_m.f90 new file mode 100644 index 0000000..fb3261f --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/binary_tree-make_n-ary/src/tree_m.f90 @@ -0,0 +1,24 @@ +module tree_m + use iso_varying_string, only: varying_string + + implicit none + private + public :: tree_t + + type, abstract :: tree_t + contains + private + procedure(to_string_i), public, deferred :: to_string + end type + + abstract interface + pure function to_string_i(self) result(string) + import :: tree_t, varying_string + + implicit none + + class(tree_t), intent(in) :: self + type(varying_string) :: string + end function + end interface +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/app/main.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/app/main.f90 new file mode 100644 index 0000000..95b6254 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/app/main.f90 @@ -0,0 +1,42 @@ +program main + use circle_m, only: circle_t + use iso_varying_string, only: put_line + use rectangle_m, only: rectangle_t + use shape_list_m, only: shape_list_t + use shape_item_m, only: shape_item_t + use square_m, only: square_t + use triangle_m, only: triangle_t + + implicit none + + type(shape_list_t) :: list + + list = shape_list_t( & + shapes = [ & + shape_item_t( & + shape = square_t( & + width = 2.0 & + ) & + ), & + shape_item_t( & + shape = circle_t( & + radius = 3.0 & + ) & + ), & + shape_item_t( & + shape = triangle_t( & + base = 4.0, & + height = 5.0 & + ) & + ), & + shape_item_t( & + shape = rectangle_t( & + height = 2.0, & + width = 3.0 & + ) & + ) & + ] & + ) + + call put_line(list%to_string()) +end program diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/fpm.toml b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/fpm.toml new file mode 100644 index 0000000..ee7195c --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/fpm.toml @@ -0,0 +1,10 @@ +name = "heterogeneous_list" +version = "0.1.0" +license = "MIT" +author = "Brad Richardson" +maintainer = "everythingfunctional@protonmail.com" +copyright = "2020 Brad Richardson" + +[dependencies] + iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" } + strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" } diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/circle_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/circle_m.f90 new file mode 100644 index 0000000..ad4140c --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/circle_m.f90 @@ -0,0 +1,39 @@ +module circle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: circle_t + + type, extends(shape_t) :: circle_t + private + real :: radius + contains + private + procedure, public :: to_string => circle_to_string + end type + + interface circle_t + module procedure constructor + end interface +contains + pure function constructor(radius) result(circle) + real, intent(in) :: radius + type(circle_t) :: circle + + circle%radius = radius + end function + + pure function circle_to_string(self) result(string) + class(circle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "circle_t(" // NEWLINE & + // "radius = " // to_string(self%radius), & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/rectangle_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/rectangle_m.f90 new file mode 100644 index 0000000..f8e7b03 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/rectangle_m.f90 @@ -0,0 +1,43 @@ +module rectangle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: rectangle_t + + type, extends(shape_t) :: rectangle_t + private + real :: height + real :: width + contains + private + procedure, public :: to_string => rectangle_to_string + end type + + interface rectangle_t + module procedure constructor + end interface +contains + pure function constructor(height, width) result(rectangle) + real, intent(in) :: height + real, intent(in) :: width + type(rectangle_t) :: rectangle + + rectangle%height = height + rectangle%width = width + end function + + pure function rectangle_to_string(self) result(string) + class(rectangle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "rectangle_t(" // NEWLINE & + // "height = " // to_string(self%height) // "," // NEWLINE & + // "width = " // to_string(self%width), & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_item_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_item_m.f90 new file mode 100644 index 0000000..1795749 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_item_m.f90 @@ -0,0 +1,39 @@ +module shape_item_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, NEWLINE + + implicit none + private + public :: shape_item_t + + type :: shape_item_t + private + class(shape_t), allocatable :: shape + contains + private + procedure, public :: to_string + end type + + interface shape_item_t + module procedure constructor + end interface +contains + function constructor(shape) result(shape_item) + class(shape_t), intent(in) :: shape + type(shape_item_t) :: shape_item + + shape_item%shape = shape + end function + + elemental function to_string(self) result(string) + class(shape_item_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_item_t(" // NEWLINE & + // "shape = " // self%shape%to_string(), & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_list_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_list_m.f90 new file mode 100644 index 0000000..040bf3d --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_list_m.f90 @@ -0,0 +1,41 @@ +module shape_list_m + use iso_varying_string, only: varying_string, operator(//) + use shape_item_m, only: shape_item_t + use strff, only: hanging_indent, indent, join, NEWLINE + + implicit none + private + public :: shape_list_t + + type :: shape_list_t + private + type(shape_item_t), allocatable :: shapes(:) + contains + private + procedure, public :: to_string + end type + + interface shape_list_t + module procedure constructor + end interface +contains + function constructor(shapes) result(shape_list) + type(shape_item_t), intent(in) :: shapes(:) + type(shape_list_t) :: shape_list + + allocate(shape_list%shapes, source = shapes) + end function + + pure function to_string(self) result(string) + class(shape_list_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_list_t(" // NEWLINE & + // "shapes = [" // NEWLINE & + // indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE & + // "]", & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_m.f90 new file mode 100644 index 0000000..dc89939 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/shape_m.f90 @@ -0,0 +1,24 @@ +module shape_m + use iso_varying_string, only: varying_string + + implicit none + private + public :: shape_t + + type, abstract :: shape_t + contains + private + procedure(to_string_i), deferred, public :: to_string + end type + + abstract interface + pure function to_string_i(self) result(string) + import :: shape_t, varying_string + + implicit none + + class(shape_t), intent(in) :: self + type(varying_string) :: string + end function + end interface +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/square_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/square_m.f90 new file mode 100644 index 0000000..d964ffc --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/square_m.f90 @@ -0,0 +1,39 @@ +module square_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: square_t + + type, extends(shape_t) :: square_t + private + real :: width + contains + private + procedure, public :: to_string => square_to_string + end type + + interface square_t + module procedure constructor + end interface +contains + pure function constructor(width) result(square) + real, intent(in) :: width + type(square_t) :: square + + square%width = width + end function + + pure function square_to_string(self) result(string) + class(square_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "square_t(" // NEWLINE & + // "width = " // to_string(self%width), & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/triangle_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/triangle_m.f90 new file mode 100644 index 0000000..797fd59 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-add_rectangle/src/triangle_m.f90 @@ -0,0 +1,43 @@ +module triangle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: triangle_t + + type, extends(shape_t) :: triangle_t + private + real :: base + real :: height + contains + private + procedure, public :: to_string => triangle_to_string + end type + + interface triangle_t + module procedure constructor + end interface +contains + pure function constructor(base, height) result(triangle) + real, intent(in) :: base + real, intent(in) :: height + type(triangle_t) :: triangle + + triangle%base = base + triangle%height = height + end function + + pure function triangle_to_string(self) result(string) + class(triangle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "triangle_t(" // NEWLINE & + // "base = " // to_string(self%base) // "," // NEWLINE & + // "height = " // to_string(self%height), & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/app/main.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/app/main.f90 new file mode 100644 index 0000000..95a20b8 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/app/main.f90 @@ -0,0 +1,37 @@ +program main + use circle_m, only: circle_t + use iso_varying_string, only: put_line + use shape_list_m, only: shape_list_t + use shape_item_m, only: shape_item_t + use square_m, only: square_t + use strff, only: to_string + use triangle_m, only: triangle_t + + implicit none + + type(shape_list_t) :: list + + list = shape_list_t( & + shapes = [ & + shape_item_t( & + shape = square_t( & + width = 2.0 & + ) & + ), & + shape_item_t( & + shape = circle_t( & + radius = 3.0 & + ) & + ), & + shape_item_t( & + shape = triangle_t( & + base = 4.0, & + height = 5.0 & + ) & + ) & + ] & + ) + + call put_line(list%to_string()) + call put_line(to_string(list%total_area())) +end program diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/fpm.toml b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/fpm.toml new file mode 100644 index 0000000..ee7195c --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/fpm.toml @@ -0,0 +1,10 @@ +name = "heterogeneous_list" +version = "0.1.0" +license = "MIT" +author = "Brad Richardson" +maintainer = "everythingfunctional@protonmail.com" +copyright = "2020 Brad Richardson" + +[dependencies] + iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" } + strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" } diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/circle_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/circle_m.f90 new file mode 100644 index 0000000..6533712 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/circle_m.f90 @@ -0,0 +1,47 @@ +module circle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: circle_t + + type, extends(shape_t) :: circle_t + private + real :: radius + contains + private + procedure, public :: to_string => circle_to_string + procedure, public :: area + end type + + interface circle_t + module procedure constructor + end interface +contains + pure function constructor(radius) result(circle) + real, intent(in) :: radius + type(circle_t) :: circle + + circle%radius = radius + end function + + pure function circle_to_string(self) result(string) + class(circle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "circle_t(" // NEWLINE & + // "radius = " // to_string(self%radius), & + 4) // NEWLINE & + // ")" + end function + + pure function area(self) + class(circle_t), intent(in) :: self + real :: area + + area = 3.1415 * self%radius**2 + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_item_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_item_m.f90 new file mode 100644 index 0000000..b04ac27 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_item_m.f90 @@ -0,0 +1,47 @@ +module shape_item_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, NEWLINE + + implicit none + private + public :: shape_item_t + + type :: shape_item_t + private + class(shape_t), allocatable :: shape + contains + private + procedure, public :: to_string + procedure, public :: area + end type + + interface shape_item_t + module procedure constructor + end interface +contains + function constructor(shape) result(shape_item) + class(shape_t), intent(in) :: shape + type(shape_item_t) :: shape_item + + shape_item%shape = shape + end function + + elemental function to_string(self) result(string) + class(shape_item_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_item_t(" // NEWLINE & + // "shape = " // self%shape%to_string(), & + 4) // NEWLINE & + // ")" + end function + + elemental function area(self) + class(shape_item_t), intent(in) :: self + real :: area + + area = self%shape%area() + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_list_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_list_m.f90 new file mode 100644 index 0000000..bdb80f5 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_list_m.f90 @@ -0,0 +1,49 @@ +module shape_list_m + use iso_varying_string, only: varying_string, operator(//) + use shape_item_m, only: shape_item_t + use strff, only: hanging_indent, indent, join, NEWLINE + + implicit none + private + public :: shape_list_t + + type :: shape_list_t + private + type(shape_item_t), allocatable :: shapes(:) + contains + private + procedure, public :: to_string + procedure, public :: total_area + end type + + interface shape_list_t + module procedure constructor + end interface +contains + function constructor(shapes) result(shape_list) + type(shape_item_t), intent(in) :: shapes(:) + type(shape_list_t) :: shape_list + + allocate(shape_list%shapes, source = shapes) + end function + + pure function to_string(self) result(string) + class(shape_list_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_list_t(" // NEWLINE & + // "shapes = [" // NEWLINE & + // indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE & + // "]", & + 4) // NEWLINE & + // ")" + end function + + pure function total_area(self) + class(shape_list_t), intent(in) :: self + real :: total_area + + total_area = sum(self%shapes%area()) + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_m.f90 new file mode 100644 index 0000000..3a3f007 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/shape_m.f90 @@ -0,0 +1,34 @@ +module shape_m + use iso_varying_string, only: varying_string + + implicit none + private + public :: shape_t + + type, abstract :: shape_t + contains + private + procedure(to_string_i), deferred, public :: to_string + procedure(area_i), deferred, public :: area + end type + + abstract interface + pure function to_string_i(self) result(string) + import :: shape_t, varying_string + + implicit none + + class(shape_t), intent(in) :: self + type(varying_string) :: string + end function + + pure function area_i(self) result(area) + import :: shape_t + + implicit none + + class(shape_t), intent(in) :: self + real :: area + end function + end interface +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/square_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/square_m.f90 new file mode 100644 index 0000000..8ea8495 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/square_m.f90 @@ -0,0 +1,47 @@ +module square_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: square_t + + type, extends(shape_t) :: square_t + private + real :: width + contains + private + procedure, public :: to_string => square_to_string + procedure, public :: area + end type + + interface square_t + module procedure constructor + end interface +contains + pure function constructor(width) result(square) + real, intent(in) :: width + type(square_t) :: square + + square%width = width + end function + + pure function square_to_string(self) result(string) + class(square_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "square_t(" // NEWLINE & + // "width = " // to_string(self%width), & + 4) // NEWLINE & + // ")" + end function + + pure function area(self) + class(square_t), intent(in) :: self + real :: area + + area = self%width**2 + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/triangle_m.f90 b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/triangle_m.f90 new file mode 100644 index 0000000..88a95de --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/heterogeneous_list-calculate_area/src/triangle_m.f90 @@ -0,0 +1,51 @@ +module triangle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: triangle_t + + type, extends(shape_t) :: triangle_t + private + real :: base + real :: height + contains + private + procedure, public :: to_string => triangle_to_string + procedure, public :: area + end type + + interface triangle_t + module procedure constructor + end interface +contains + pure function constructor(base, height) result(triangle) + real, intent(in) :: base + real, intent(in) :: height + type(triangle_t) :: triangle + + triangle%base = base + triangle%height = height + end function + + pure function triangle_to_string(self) result(string) + class(triangle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "triangle_t(" // NEWLINE & + // "base = " // to_string(self%base) // "," // NEWLINE & + // "height = " // to_string(self%height), & + 4) // NEWLINE & + // ")" + end function + + pure function area(self) + class(triangle_t), intent(in) :: self + real :: area + + area = (self%base * self%height) / 2.0 + end function +end module diff --git a/Intermediate Fortran/Section 3 - Data Structures/linked_list_example.f90 b/Intermediate Fortran/Section 3 - Data Structures/linked_list_example.f90 new file mode 100644 index 0000000..047c270 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/linked_list_example.f90 @@ -0,0 +1,120 @@ +module integer_list_m + implicit none + private + public :: integer_list_t, visitor_t + + type :: list_node_t + private + integer :: val + type(list_node_t), pointer :: next => null() + end type + + type :: integer_list_t + private + type(list_node_t), pointer :: head => null() + contains + private + procedure, public :: prepend + procedure, public :: foreach + end type + + type, abstract :: visitor_t + contains + private + procedure(visit_i), deferred, public :: visit + end type + + abstract interface + subroutine visit_i(self, item) + import visitor_t + implicit none + class(visitor_t), intent(inout) :: self + integer, intent(inout) :: item + end subroutine + end interface +contains + subroutine prepend(self, item) + class(integer_list_t), intent(inout) :: self + integer, intent(in) :: item + + type(list_node_t), pointer :: new + + if (associated(self%head)) then + allocate(new) + new%val = item + new%next => self%head + self%head => new + else + allocate(self%head) + self%head%val = item + end if + end subroutine + + subroutine foreach(self, visitor) + class(integer_list_t), intent(inout) :: self + class(visitor_t), intent(inout) :: visitor + + type(list_node_t), pointer :: cursor + + cursor => self%head + do while (associated(cursor)) + call visitor%visit(cursor%val) + cursor => cursor%next + end do + end subroutine +end module + +module list_operator_m + use integer_list_m, only: visitor_t + + implicit none + private + public :: printer_t, squarer_t + + type, extends(visitor_t) :: printer_t + contains + private + procedure, public :: visit => printer_visit + end type + + type, extends(visitor_t) :: squarer_t + contains + private + procedure, public :: visit => squarer_visit + end type +contains + subroutine printer_visit(self, item) + class(printer_t), intent(inout) :: self + integer, intent(inout) :: item + + print *, item + end subroutine + + subroutine squarer_visit(self, item) + class(squarer_t), intent(inout) :: self + integer, intent(inout) :: item + + item = item*item + end subroutine +end module + +program main + use integer_list_m, only: integer_list_t + use list_operator_m, only: printer_t, squarer_t + + implicit none + + type(integer_list_t) :: list + type(printer_t) :: printer + type(squarer_t) :: squarer + + call list%prepend(2) + call list%prepend(3) + call list%prepend(5) + + call list%foreach(printer) + + call list%foreach(squarer) + + call list%foreach(printer) +end program diff --git a/Intermediate Fortran/Section 3 - Data Structures/linked_list_exercise.f90 b/Intermediate Fortran/Section 3 - Data Structures/linked_list_exercise.f90 new file mode 100644 index 0000000..47e0acd --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/linked_list_exercise.f90 @@ -0,0 +1,146 @@ +module integer_list_m + implicit none + private + public :: integer_list_t, visitor_t + + type :: list_node_t + private + integer :: val + type(list_node_t), pointer :: next => null() + end type + + type :: integer_list_t + private + type(list_node_t), pointer :: head => null() + contains + private + procedure, public :: prepend + procedure, public :: foreach + end type + + type, abstract :: visitor_t + contains + private + procedure(visit_i), deferred, public :: visit + end type + + abstract interface + subroutine visit_i(self, item) + import visitor_t + implicit none + class(visitor_t), intent(inout) :: self + integer, intent(inout) :: item + end subroutine + end interface +contains + subroutine prepend(self, item) + class(integer_list_t), intent(inout) :: self + integer, intent(in) :: item + + type(list_node_t), pointer :: new + + if (associated(self%head)) then + allocate(new) + new%val = item + new%next => self%head + self%head => new + else + allocate(self%head) + self%head%val = item + end if + end subroutine + + subroutine foreach(self, visitor) + class(integer_list_t), intent(inout) :: self + class(visitor_t), intent(inout) :: visitor + + type(list_node_t), pointer :: cursor + + cursor => self%head + do while (associated(cursor)) + call visitor%visit(cursor%val) + cursor => cursor%next + end do + end subroutine +end module + +module list_operator_m + use integer_list_m, only: visitor_t + + implicit none + private + public :: printer_t, squarer_t, summer_t + + type, extends(visitor_t) :: printer_t + contains + private + procedure, public :: visit => printer_visit + end type + + type, extends(visitor_t) :: squarer_t + contains + private + procedure, public :: visit => squarer_visit + end type + + type, extends(visitor_t) :: summer_t + private + integer :: total = 0 + contains + private + procedure, public :: visit => summer_visit + procedure, public :: get_sum + end type +contains + subroutine printer_visit(self, item) + class(printer_t), intent(inout) :: self + integer, intent(inout) :: item + + print *, item + end subroutine + + subroutine squarer_visit(self, item) + class(squarer_t), intent(inout) :: self + integer, intent(inout) :: item + + item = item*item + end subroutine + + subroutine summer_visit(self, item) + class(summer_t), intent(inout) :: self + integer, intent(inout) :: item + + self%total = self%total + item + end subroutine + + pure integer function get_sum(self) + class(summer_t), intent(in) :: self + + get_sum = self%total + end function +end module + +program main + use integer_list_m, only: integer_list_t + use list_operator_m, only: printer_t, squarer_t, summer_t + + implicit none + + type(integer_list_t) :: list + type(printer_t) :: printer + type(squarer_t) :: squarer + type(summer_t) :: summer + + call list%prepend(2) + call list%prepend(3) + call list%prepend(5) + + call list%foreach(printer) + + call list%foreach(squarer) + + call list%foreach(printer) + + call list%foreach(summer) + print *, summer%get_sum() +end program diff --git a/Intermediate Fortran/Section 3 - Data Structures/linked_list_solution.f90 b/Intermediate Fortran/Section 3 - Data Structures/linked_list_solution.f90 new file mode 100644 index 0000000..1f1b578 --- /dev/null +++ b/Intermediate Fortran/Section 3 - Data Structures/linked_list_solution.f90 @@ -0,0 +1,147 @@ +module integer_list_m + implicit none + private + public :: integer_list_t, visitor_t + + type :: list_node_t + private + integer :: val + type(list_node_t), pointer :: next => null() + end type + + type :: integer_list_t + private + type(list_node_t), pointer :: head => null() + contains + private + procedure, public :: prepend + procedure, public :: foreach + end type + + type, abstract :: visitor_t + contains + private + procedure(visit_i), deferred, public :: visit + end type + + abstract interface + subroutine visit_i(self, item) + import visitor_t + implicit none + class(visitor_t), intent(inout) :: self + integer, intent(inout) :: item + end subroutine + end interface +contains + subroutine prepend(self, item) + class(integer_list_t), intent(inout) :: self + integer, intent(in) :: item + + type(list_node_t), pointer :: new + + if (associated(self%head)) then + allocate(new) + new%val = item + new%next => self%head + self%head => new + else + allocate(self%head) + self%head%val = item + end if + end subroutine + + subroutine foreach(self, visitor) + class(integer_list_t), intent(inout) :: self + class(visitor_t), intent(inout) :: visitor + + type(list_node_t), pointer :: cursor + + cursor => self%head + do while (associated(cursor)) + call visitor%visit(cursor%val) + cursor => cursor%next + end do + end subroutine +end module + +module list_operator_m + use integer_list_m, only: visitor_t + + implicit none + private + public :: printer_t, squarer_t, summer_t + + type, extends(visitor_t) :: printer_t + contains + private + procedure, public :: visit => printer_visit + end type + + type, extends(visitor_t) :: squarer_t + contains + private + procedure, public :: visit => squarer_visit + end type + + type, extends(visitor_t) :: summer_t + private + integer :: total = 0 + contains + private + procedure, public :: visit => summer_visit + procedure, public :: get_sum + end type +contains + subroutine printer_visit(self, item) + class(printer_t), intent(inout) :: self + integer, intent(inout) :: item + + print *, item + end subroutine + + subroutine squarer_visit(self, item) + class(squarer_t), intent(inout) :: self + integer, intent(inout) :: item + + item = item*item + end subroutine + + subroutine summer_visit(self, item) + class(summer_t), intent(inout) :: self + integer, intent(inout) :: item + + self%total = self%total + item + end subroutine + + pure function get_sum(self) result(total) + class(summer_t), intent(in) :: self + integer :: total + + total = self%total + end function +end module + +program main + use integer_list_m, only: integer_list_t + use list_operator_m, only: printer_t, squarer_t, summer_t + + implicit none + + type(integer_list_t) :: list + type(printer_t) :: printer + type(squarer_t) :: squarer + type(summer_t) :: summer + + call list%prepend(2) + call list%prepend(3) + call list%prepend(5) + + call list%foreach(printer) + + call list%foreach(squarer) + + call list%foreach(printer) + + call list%foreach(summer) + print *, summer%get_sum() +end program diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/app/main.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/app/main.f90 new file mode 100644 index 0000000..aa1377c --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/app/main.f90 @@ -0,0 +1,40 @@ +program main + use circle_m, only: circle_t + use iso_varying_string, only: put_line + use shape_list_m, only: shape_list_t + use shape_item_m, only: shape_item_t + use square_m, only: square_t + use triangle_m, only: triangle_t + + implicit none + + type(shape_list_t) :: list + type(shape_list_t) :: duplicated_list + + list = shape_list_t( & + shapes = [ & + shape_item_t( & + shape = square_t( & + width = 2.0 & + ) & + ), & + shape_item_t( & + shape = circle_t( & + radius = 3.0 & + ) & + ), & + shape_item_t( & + shape = triangle_t( & + base = 4.0, & + height = 5.0 & + ) & + ) & + ] & + ) + + call put_line(list%to_string()) + + duplicated_list = list // list + + call put_line(duplicated_list%to_string()) +end program diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/fpm.toml b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/fpm.toml new file mode 100644 index 0000000..ee7195c --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/fpm.toml @@ -0,0 +1,10 @@ +name = "heterogeneous_list" +version = "0.1.0" +license = "MIT" +author = "Brad Richardson" +maintainer = "everythingfunctional@protonmail.com" +copyright = "2020 Brad Richardson" + +[dependencies] + iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" } + strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" } diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/circle_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/circle_m.f90 new file mode 100644 index 0000000..ad4140c --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/circle_m.f90 @@ -0,0 +1,39 @@ +module circle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: circle_t + + type, extends(shape_t) :: circle_t + private + real :: radius + contains + private + procedure, public :: to_string => circle_to_string + end type + + interface circle_t + module procedure constructor + end interface +contains + pure function constructor(radius) result(circle) + real, intent(in) :: radius + type(circle_t) :: circle + + circle%radius = radius + end function + + pure function circle_to_string(self) result(string) + class(circle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "circle_t(" // NEWLINE & + // "radius = " // to_string(self%radius), & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_item_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_item_m.f90 new file mode 100644 index 0000000..1795749 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_item_m.f90 @@ -0,0 +1,39 @@ +module shape_item_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, NEWLINE + + implicit none + private + public :: shape_item_t + + type :: shape_item_t + private + class(shape_t), allocatable :: shape + contains + private + procedure, public :: to_string + end type + + interface shape_item_t + module procedure constructor + end interface +contains + function constructor(shape) result(shape_item) + class(shape_t), intent(in) :: shape + type(shape_item_t) :: shape_item + + shape_item%shape = shape + end function + + elemental function to_string(self) result(string) + class(shape_item_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_item_t(" // NEWLINE & + // "shape = " // self%shape%to_string(), & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_list_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_list_m.f90 new file mode 100644 index 0000000..a0737bf --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_list_m.f90 @@ -0,0 +1,51 @@ +module shape_list_m + use iso_varying_string, only: varying_string, operator(//) + use shape_item_m, only: shape_item_t + use strff, only: hanging_indent, indent, join, NEWLINE + + implicit none + private + public :: shape_list_t + + type :: shape_list_t + private + type(shape_item_t), allocatable :: shapes(:) + contains + private + procedure, public :: to_string + procedure :: concat + generic, public :: operator(//) => concat + end type + + interface shape_list_t + module procedure constructor + end interface +contains + function constructor(shapes) result(shape_list) + type(shape_item_t), intent(in) :: shapes(:) + type(shape_list_t) :: shape_list + + allocate(shape_list%shapes, source = shapes) + end function + + pure function to_string(self) result(string) + class(shape_list_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_list_t(" // NEWLINE & + // "shapes = [" // NEWLINE & + // indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE & + // "]", & + 4) // NEWLINE & + // ")" + end function + + function concat(lhs, rhs) result(combined) + class(shape_list_t), intent(in) :: lhs + type(shape_list_t), intent(in) :: rhs + type(shape_list_t) :: combined + + allocate(combined%shapes, source = [lhs%shapes, rhs%shapes]) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_m.f90 new file mode 100644 index 0000000..dc89939 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/shape_m.f90 @@ -0,0 +1,24 @@ +module shape_m + use iso_varying_string, only: varying_string + + implicit none + private + public :: shape_t + + type, abstract :: shape_t + contains + private + procedure(to_string_i), deferred, public :: to_string + end type + + abstract interface + pure function to_string_i(self) result(string) + import :: shape_t, varying_string + + implicit none + + class(shape_t), intent(in) :: self + type(varying_string) :: string + end function + end interface +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/square_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/square_m.f90 new file mode 100644 index 0000000..d964ffc --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/square_m.f90 @@ -0,0 +1,39 @@ +module square_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: square_t + + type, extends(shape_t) :: square_t + private + real :: width + contains + private + procedure, public :: to_string => square_to_string + end type + + interface square_t + module procedure constructor + end interface +contains + pure function constructor(width) result(square) + real, intent(in) :: width + type(square_t) :: square + + square%width = width + end function + + pure function square_to_string(self) result(string) + class(square_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "square_t(" // NEWLINE & + // "width = " // to_string(self%width), & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/triangle_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/triangle_m.f90 new file mode 100644 index 0000000..797fd59 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-concat_lists/src/triangle_m.f90 @@ -0,0 +1,43 @@ +module triangle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: triangle_t + + type, extends(shape_t) :: triangle_t + private + real :: base + real :: height + contains + private + procedure, public :: to_string => triangle_to_string + end type + + interface triangle_t + module procedure constructor + end interface +contains + pure function constructor(base, height) result(triangle) + real, intent(in) :: base + real, intent(in) :: height + type(triangle_t) :: triangle + + triangle%base = base + triangle%height = height + end function + + pure function triangle_to_string(self) result(string) + class(triangle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "triangle_t(" // NEWLINE & + // "base = " // to_string(self%base) // "," // NEWLINE & + // "height = " // to_string(self%height), & + 4) // NEWLINE & + // ")" + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/app/main.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/app/main.f90 new file mode 100644 index 0000000..d5d1577 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/app/main.f90 @@ -0,0 +1,49 @@ +program main + use circle_m, only: circle_t + use filter_out_area_greater_than_m, only: filter_out_area_greater_than_t + use filter_out_curves_m, only: filter_out_curves_t + use iso_varying_string, only: put_line + use shape_list_m, only: shape_list_t + use shape_item_m, only: shape_item_t + use square_m, only: square_t + use strff, only: to_string + use triangle_m, only: triangle_t + + implicit none + + type(shape_list_t) :: list + type(shape_list_t) :: duplicated_list + type(shape_list_t) :: filtered + + list = shape_list_t( & + shapes = [ & + shape_item_t( & + shape = square_t( & + width = 2.0 & + ) & + ), & + shape_item_t( & + shape = circle_t( & + radius = 3.0 & + ) & + ), & + shape_item_t( & + shape = triangle_t( & + base = 4.0, & + height = 5.0 & + ) & + ) & + ] & + ) + + call put_line(list%to_string()) + call put_line(to_string(list%total_area())) + + duplicated_list = (list*2.0) // (list*0.3) + + call put_line(duplicated_list%to_string()) + + filtered = duplicated_list%filtered_by(filter_out_area_greater_than_t(2.0)) + + call put_line(filtered%to_string()) +end program diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/fpm.toml b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/fpm.toml new file mode 100644 index 0000000..ee7195c --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/fpm.toml @@ -0,0 +1,10 @@ +name = "heterogeneous_list" +version = "0.1.0" +license = "MIT" +author = "Brad Richardson" +maintainer = "everythingfunctional@protonmail.com" +copyright = "2020 Brad Richardson" + +[dependencies] + iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" } + strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" } diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/circle_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/circle_m.f90 new file mode 100644 index 0000000..6e31054 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/circle_m.f90 @@ -0,0 +1,64 @@ +module circle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: circle_t + + type, extends(shape_t) :: circle_t + private + real :: radius + contains + private + procedure, public :: to_string => circle_to_string + procedure, public :: scale + procedure, public :: area + procedure, public :: has_curves + end type + + interface circle_t + module procedure constructor + end interface +contains + pure function constructor(radius) result(circle) + real, intent(in) :: radius + type(circle_t) :: circle + + circle%radius = radius + end function + + pure function circle_to_string(self) result(string) + class(circle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "circle_t(" // NEWLINE & + // "radius = " // to_string(self%radius), & + 4) // NEWLINE & + // ")" + end function + + function scale(self, factor) result(scaled) + class(circle_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + + allocate(scaled, source = circle_t(radius = self%radius * factor)) + end function + + pure function area(self) + class(circle_t), intent(in) :: self + real :: area + + area = 3.1415 * self%radius**2 + end function + + pure function has_curves(self) + class(circle_t), intent(in) :: self + logical :: has_curves + + has_curves = .true. + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_area_greater_than_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_area_greater_than_m.f90 new file mode 100644 index 0000000..a3b51f1 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_area_greater_than_m.f90 @@ -0,0 +1,35 @@ +module filter_out_area_greater_than_m + use shape_m, only: shape_t + use shape_filterer_m, only: shape_filterer_t + + implicit none + private + public :: filter_out_area_greater_than_t + + type, extends(shape_filterer_t) :: filter_out_area_greater_than_t + private + real :: limit + contains + private + procedure, public :: matches + end type + + interface filter_out_area_greater_than_t + module procedure constructor + end interface +contains + pure function constructor(limit) result(filter) + real, intent(in) :: limit + type(filter_out_area_greater_than_t) :: filter + + filter%limit = limit + end function + + pure function matches(self, shape) + class(filter_out_area_greater_than_t), intent(in) :: self + class(shape_t), intent(in) :: shape + logical :: matches + + matches = shape%area() < self%limit + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_curves_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_curves_m.f90 new file mode 100644 index 0000000..c9b2567 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/filter_out_curves_m.f90 @@ -0,0 +1,22 @@ +module filter_out_curves_m + use shape_m, only: shape_t + use shape_filterer_m, only: shape_filterer_t + + implicit none + private + public :: filter_out_curves_t + + type, extends(shape_filterer_t) :: filter_out_curves_t + contains + private + procedure, public :: matches + end type +contains + pure function matches(self, shape) + class(filter_out_curves_t), intent(in) :: self + class(shape_t), intent(in) :: shape + logical :: matches + + matches = .not. shape%has_curves() + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_filterer_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_filterer_m.f90 new file mode 100644 index 0000000..1dc9ab5 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_filterer_m.f90 @@ -0,0 +1,25 @@ +module shape_filterer_m + use shape_m, only: shape_t + + implicit none + private + public :: shape_filterer_t + + type, abstract :: shape_filterer_t + contains + private + procedure(matches_i), deferred, public :: matches + end type + + abstract interface + pure function matches_i(self, shape) result(matches) + import :: shape_t, shape_filterer_t + + implicit none + + class(shape_filterer_t), intent(in) :: self + class(shape_t), intent(in) :: shape + logical :: matches + end function + end interface +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_item_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_item_m.f90 new file mode 100644 index 0000000..8f26f3c --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_item_m.f90 @@ -0,0 +1,67 @@ +module shape_item_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use shape_filterer_m, only: shape_filterer_t + use strff, only: hanging_indent, NEWLINE + + implicit none + private + public :: shape_item_t + + type :: shape_item_t + private + class(shape_t), allocatable :: shape + contains + private + procedure, public :: to_string + procedure :: scale + generic, public :: operator(*) => scale + procedure, public :: area + procedure, public :: satisfies + end type + + interface shape_item_t + module procedure constructor + end interface +contains + function constructor(shape) result(shape_item) + class(shape_t), intent(in) :: shape + type(shape_item_t) :: shape_item + + allocate(shape_item%shape, source = shape) + end function + + elemental function to_string(self) result(string) + class(shape_item_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_item_t(" // NEWLINE & + // "shape = " // self%shape%to_string(), & + 4) // NEWLINE & + // ")" + end function + + impure elemental function scale(self, factor) result(scaled) + class(shape_item_t), intent(in) :: self + real, intent(in) :: factor + type(shape_item_t) :: scaled + + allocate(scaled%shape, source = self%shape * factor) + end function + + elemental function area(self) + class(shape_item_t), intent(in) :: self + real :: area + + area = self%shape%area() + end function + + elemental function satisfies(self, filterer) + class(shape_item_t), intent(in) :: self + class(shape_filterer_t), intent(in) :: filterer + logical :: satisfies + + satisfies = filterer%matches(self%shape) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_list_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_list_m.f90 new file mode 100644 index 0000000..0925835 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_list_m.f90 @@ -0,0 +1,79 @@ +module shape_list_m + use iso_varying_string, only: varying_string, operator(//) + use shape_filterer_m, only: shape_filterer_t + use shape_item_m, only: shape_item_t + use strff, only: hanging_indent, indent, join, NEWLINE + + implicit none + private + public :: shape_list_t + + type :: shape_list_t + private + type(shape_item_t), allocatable :: shapes(:) + contains + private + procedure, public :: to_string + procedure :: concat + generic, public :: operator(//) => concat + procedure :: scale + generic, public :: operator(*) => scale + procedure, public :: total_area + procedure, public :: filtered_by + end type + + interface shape_list_t + module procedure constructor + end interface +contains + function constructor(shapes) result(shape_list) + type(shape_item_t), intent(in) :: shapes(:) + type(shape_list_t) :: shape_list + + allocate(shape_list%shapes, source = shapes) + end function + + pure function to_string(self) result(string) + class(shape_list_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_list_t(" // NEWLINE & + // "shapes = [" // NEWLINE & + // indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE & + // "]", & + 4) // NEWLINE & + // ")" + end function + + function concat(lhs, rhs) result(combined) + class(shape_list_t), intent(in) :: lhs + type(shape_list_t), intent(in) :: rhs + type(shape_list_t) :: combined + + allocate(combined%shapes, source = [lhs%shapes, rhs%shapes]) + end function + + function scale(self, factor) result(scaled) + class(shape_list_t), intent(in) :: self + real, intent(in) :: factor + type(shape_list_t) :: scaled + + allocate(scaled%shapes, source = self%shapes * factor) + end function + + pure function total_area(self) + class(shape_list_t), intent(in) :: self + real :: total_area + + total_area = sum(self%shapes%area()) + end function + + function filtered_by(self, filterer) result(filtered) + class(shape_list_t), intent(in) :: self + class(shape_filterer_t), intent(in) :: filterer + type(shape_list_t) :: filtered + + allocate(filtered%shapes, source = pack(self%shapes, mask = self%shapes%satisfies(filterer))) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_m.f90 new file mode 100644 index 0000000..ee9c0b2 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/shape_m.f90 @@ -0,0 +1,56 @@ +module shape_m + use iso_varying_string, only: varying_string + + implicit none + private + public :: shape_t + + type, abstract :: shape_t + contains + private + procedure(to_string_i), deferred, public :: to_string + procedure(scale_i), deferred, public :: scale + generic, public :: operator(*) => scale + procedure(area_i), deferred, public :: area + procedure(has_curves_i), deferred, public :: has_curves + end type + + abstract interface + pure function to_string_i(self) result(string) + import :: shape_t, varying_string + + implicit none + + class(shape_t), intent(in) :: self + type(varying_string) :: string + end function + + function scale_i(self, factor) result(scaled) + import :: shape_t + + implicit none + + class(shape_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + end function + + pure function area_i(self) result(area) + import :: shape_t + + implicit none + + class(shape_t), intent(in) :: self + real :: area + end function + + pure function has_curves_i(self) result(has_curves) + import :: shape_t + + implicit none + + class(shape_t), intent(in) :: self + logical :: has_curves + end function + end interface +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/square_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/square_m.f90 new file mode 100644 index 0000000..f326532 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/square_m.f90 @@ -0,0 +1,64 @@ +module square_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: square_t + + type, extends(shape_t) :: square_t + private + real :: width + contains + private + procedure, public :: to_string => square_to_string + procedure, public :: scale + procedure, public :: area + procedure, public :: has_curves + end type + + interface square_t + module procedure constructor + end interface +contains + pure function constructor(width) result(square) + real, intent(in) :: width + type(square_t) :: square + + square%width = width + end function + + pure function square_to_string(self) result(string) + class(square_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "square_t(" // NEWLINE & + // "width = " // to_string(self%width), & + 4) // NEWLINE & + // ")" + end function + + function scale(self, factor) result(scaled) + class(square_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + + allocate(scaled, source = square_t(width = self%width * factor)) + end function + + pure function area(self) + class(square_t), intent(in) :: self + real :: area + + area = self%width**2 + end function + + pure function has_curves(self) + class(square_t), intent(in) :: self + logical :: has_curves + + has_curves = .false. + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/triangle_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/triangle_m.f90 new file mode 100644 index 0000000..d0fe25d --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_area/src/triangle_m.f90 @@ -0,0 +1,68 @@ +module triangle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: triangle_t + + type, extends(shape_t) :: triangle_t + private + real :: base + real :: height + contains + private + procedure, public :: to_string => triangle_to_string + procedure, public :: scale + procedure, public :: area + procedure, public :: has_curves + end type + + interface triangle_t + module procedure constructor + end interface +contains + pure function constructor(base, height) result(triangle) + real, intent(in) :: base + real, intent(in) :: height + type(triangle_t) :: triangle + + triangle%base = base + triangle%height = height + end function + + pure function triangle_to_string(self) result(string) + class(triangle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "triangle_t(" // NEWLINE & + // "base = " // to_string(self%base) // "," // NEWLINE & + // "height = " // to_string(self%height), & + 4) // NEWLINE & + // ")" + end function + + function scale(self, factor) result(scaled) + class(triangle_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + + allocate(scaled, source = triangle_t(base = self%base * factor, height = self%height * factor)) + end function + + pure function area(self) + class(triangle_t), intent(in) :: self + real :: area + + area = (self%base * self%height) / 2.0 + end function + + pure function has_curves(self) + class(triangle_t), intent(in) :: self + logical :: has_curves + + has_curves = .false. + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/app/main.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/app/main.f90 new file mode 100644 index 0000000..afef2de --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/app/main.f90 @@ -0,0 +1,48 @@ +program main + use circle_m, only: circle_t + use filter_out_curves_m, only: filter_out_curves_t + use iso_varying_string, only: put_line + use shape_list_m, only: shape_list_t + use shape_item_m, only: shape_item_t + use square_m, only: square_t + use strff, only: to_string + use triangle_m, only: triangle_t + + implicit none + + type(shape_list_t) :: list + type(shape_list_t) :: duplicated_list + type(shape_list_t) :: filtered + + list = shape_list_t( & + shapes = [ & + shape_item_t( & + shape = square_t( & + width = 2.0 & + ) & + ), & + shape_item_t( & + shape = circle_t( & + radius = 3.0 & + ) & + ), & + shape_item_t( & + shape = triangle_t( & + base = 4.0, & + height = 5.0 & + ) & + ) & + ] & + ) + + call put_line(list%to_string()) + call put_line(to_string(list%total_area())) + + duplicated_list = (list*2.0) // (list*0.3) + + call put_line(duplicated_list%to_string()) + + filtered = duplicated_list%filtered_by(filter_out_curves_t()) + + call put_line(filtered%to_string()) +end program diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/fpm.toml b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/fpm.toml new file mode 100644 index 0000000..ee7195c --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/fpm.toml @@ -0,0 +1,10 @@ +name = "heterogeneous_list" +version = "0.1.0" +license = "MIT" +author = "Brad Richardson" +maintainer = "everythingfunctional@protonmail.com" +copyright = "2020 Brad Richardson" + +[dependencies] + iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" } + strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" } diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/circle_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/circle_m.f90 new file mode 100644 index 0000000..6e31054 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/circle_m.f90 @@ -0,0 +1,64 @@ +module circle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: circle_t + + type, extends(shape_t) :: circle_t + private + real :: radius + contains + private + procedure, public :: to_string => circle_to_string + procedure, public :: scale + procedure, public :: area + procedure, public :: has_curves + end type + + interface circle_t + module procedure constructor + end interface +contains + pure function constructor(radius) result(circle) + real, intent(in) :: radius + type(circle_t) :: circle + + circle%radius = radius + end function + + pure function circle_to_string(self) result(string) + class(circle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "circle_t(" // NEWLINE & + // "radius = " // to_string(self%radius), & + 4) // NEWLINE & + // ")" + end function + + function scale(self, factor) result(scaled) + class(circle_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + + allocate(scaled, source = circle_t(radius = self%radius * factor)) + end function + + pure function area(self) + class(circle_t), intent(in) :: self + real :: area + + area = 3.1415 * self%radius**2 + end function + + pure function has_curves(self) + class(circle_t), intent(in) :: self + logical :: has_curves + + has_curves = .true. + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/filter_out_curves_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/filter_out_curves_m.f90 new file mode 100644 index 0000000..c9b2567 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/filter_out_curves_m.f90 @@ -0,0 +1,22 @@ +module filter_out_curves_m + use shape_m, only: shape_t + use shape_filterer_m, only: shape_filterer_t + + implicit none + private + public :: filter_out_curves_t + + type, extends(shape_filterer_t) :: filter_out_curves_t + contains + private + procedure, public :: matches + end type +contains + pure function matches(self, shape) + class(filter_out_curves_t), intent(in) :: self + class(shape_t), intent(in) :: shape + logical :: matches + + matches = .not. shape%has_curves() + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_filterer_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_filterer_m.f90 new file mode 100644 index 0000000..1dc9ab5 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_filterer_m.f90 @@ -0,0 +1,25 @@ +module shape_filterer_m + use shape_m, only: shape_t + + implicit none + private + public :: shape_filterer_t + + type, abstract :: shape_filterer_t + contains + private + procedure(matches_i), deferred, public :: matches + end type + + abstract interface + pure function matches_i(self, shape) result(matches) + import :: shape_t, shape_filterer_t + + implicit none + + class(shape_filterer_t), intent(in) :: self + class(shape_t), intent(in) :: shape + logical :: matches + end function + end interface +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_item_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_item_m.f90 new file mode 100644 index 0000000..8f26f3c --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_item_m.f90 @@ -0,0 +1,67 @@ +module shape_item_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use shape_filterer_m, only: shape_filterer_t + use strff, only: hanging_indent, NEWLINE + + implicit none + private + public :: shape_item_t + + type :: shape_item_t + private + class(shape_t), allocatable :: shape + contains + private + procedure, public :: to_string + procedure :: scale + generic, public :: operator(*) => scale + procedure, public :: area + procedure, public :: satisfies + end type + + interface shape_item_t + module procedure constructor + end interface +contains + function constructor(shape) result(shape_item) + class(shape_t), intent(in) :: shape + type(shape_item_t) :: shape_item + + allocate(shape_item%shape, source = shape) + end function + + elemental function to_string(self) result(string) + class(shape_item_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_item_t(" // NEWLINE & + // "shape = " // self%shape%to_string(), & + 4) // NEWLINE & + // ")" + end function + + impure elemental function scale(self, factor) result(scaled) + class(shape_item_t), intent(in) :: self + real, intent(in) :: factor + type(shape_item_t) :: scaled + + allocate(scaled%shape, source = self%shape * factor) + end function + + elemental function area(self) + class(shape_item_t), intent(in) :: self + real :: area + + area = self%shape%area() + end function + + elemental function satisfies(self, filterer) + class(shape_item_t), intent(in) :: self + class(shape_filterer_t), intent(in) :: filterer + logical :: satisfies + + satisfies = filterer%matches(self%shape) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_list_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_list_m.f90 new file mode 100644 index 0000000..0925835 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_list_m.f90 @@ -0,0 +1,79 @@ +module shape_list_m + use iso_varying_string, only: varying_string, operator(//) + use shape_filterer_m, only: shape_filterer_t + use shape_item_m, only: shape_item_t + use strff, only: hanging_indent, indent, join, NEWLINE + + implicit none + private + public :: shape_list_t + + type :: shape_list_t + private + type(shape_item_t), allocatable :: shapes(:) + contains + private + procedure, public :: to_string + procedure :: concat + generic, public :: operator(//) => concat + procedure :: scale + generic, public :: operator(*) => scale + procedure, public :: total_area + procedure, public :: filtered_by + end type + + interface shape_list_t + module procedure constructor + end interface +contains + function constructor(shapes) result(shape_list) + type(shape_item_t), intent(in) :: shapes(:) + type(shape_list_t) :: shape_list + + allocate(shape_list%shapes, source = shapes) + end function + + pure function to_string(self) result(string) + class(shape_list_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_list_t(" // NEWLINE & + // "shapes = [" // NEWLINE & + // indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE & + // "]", & + 4) // NEWLINE & + // ")" + end function + + function concat(lhs, rhs) result(combined) + class(shape_list_t), intent(in) :: lhs + type(shape_list_t), intent(in) :: rhs + type(shape_list_t) :: combined + + allocate(combined%shapes, source = [lhs%shapes, rhs%shapes]) + end function + + function scale(self, factor) result(scaled) + class(shape_list_t), intent(in) :: self + real, intent(in) :: factor + type(shape_list_t) :: scaled + + allocate(scaled%shapes, source = self%shapes * factor) + end function + + pure function total_area(self) + class(shape_list_t), intent(in) :: self + real :: total_area + + total_area = sum(self%shapes%area()) + end function + + function filtered_by(self, filterer) result(filtered) + class(shape_list_t), intent(in) :: self + class(shape_filterer_t), intent(in) :: filterer + type(shape_list_t) :: filtered + + allocate(filtered%shapes, source = pack(self%shapes, mask = self%shapes%satisfies(filterer))) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_m.f90 new file mode 100644 index 0000000..ee9c0b2 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/shape_m.f90 @@ -0,0 +1,56 @@ +module shape_m + use iso_varying_string, only: varying_string + + implicit none + private + public :: shape_t + + type, abstract :: shape_t + contains + private + procedure(to_string_i), deferred, public :: to_string + procedure(scale_i), deferred, public :: scale + generic, public :: operator(*) => scale + procedure(area_i), deferred, public :: area + procedure(has_curves_i), deferred, public :: has_curves + end type + + abstract interface + pure function to_string_i(self) result(string) + import :: shape_t, varying_string + + implicit none + + class(shape_t), intent(in) :: self + type(varying_string) :: string + end function + + function scale_i(self, factor) result(scaled) + import :: shape_t + + implicit none + + class(shape_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + end function + + pure function area_i(self) result(area) + import :: shape_t + + implicit none + + class(shape_t), intent(in) :: self + real :: area + end function + + pure function has_curves_i(self) result(has_curves) + import :: shape_t + + implicit none + + class(shape_t), intent(in) :: self + logical :: has_curves + end function + end interface +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/square_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/square_m.f90 new file mode 100644 index 0000000..f326532 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/square_m.f90 @@ -0,0 +1,64 @@ +module square_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: square_t + + type, extends(shape_t) :: square_t + private + real :: width + contains + private + procedure, public :: to_string => square_to_string + procedure, public :: scale + procedure, public :: area + procedure, public :: has_curves + end type + + interface square_t + module procedure constructor + end interface +contains + pure function constructor(width) result(square) + real, intent(in) :: width + type(square_t) :: square + + square%width = width + end function + + pure function square_to_string(self) result(string) + class(square_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "square_t(" // NEWLINE & + // "width = " // to_string(self%width), & + 4) // NEWLINE & + // ")" + end function + + function scale(self, factor) result(scaled) + class(square_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + + allocate(scaled, source = square_t(width = self%width * factor)) + end function + + pure function area(self) + class(square_t), intent(in) :: self + real :: area + + area = self%width**2 + end function + + pure function has_curves(self) + class(square_t), intent(in) :: self + logical :: has_curves + + has_curves = .false. + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/triangle_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/triangle_m.f90 new file mode 100644 index 0000000..d0fe25d --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-filter_by_shape/src/triangle_m.f90 @@ -0,0 +1,68 @@ +module triangle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: triangle_t + + type, extends(shape_t) :: triangle_t + private + real :: base + real :: height + contains + private + procedure, public :: to_string => triangle_to_string + procedure, public :: scale + procedure, public :: area + procedure, public :: has_curves + end type + + interface triangle_t + module procedure constructor + end interface +contains + pure function constructor(base, height) result(triangle) + real, intent(in) :: base + real, intent(in) :: height + type(triangle_t) :: triangle + + triangle%base = base + triangle%height = height + end function + + pure function triangle_to_string(self) result(string) + class(triangle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "triangle_t(" // NEWLINE & + // "base = " // to_string(self%base) // "," // NEWLINE & + // "height = " // to_string(self%height), & + 4) // NEWLINE & + // ")" + end function + + function scale(self, factor) result(scaled) + class(triangle_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + + allocate(scaled, source = triangle_t(base = self%base * factor, height = self%height * factor)) + end function + + pure function area(self) + class(triangle_t), intent(in) :: self + real :: area + + area = (self%base * self%height) / 2.0 + end function + + pure function has_curves(self) + class(triangle_t), intent(in) :: self + logical :: has_curves + + has_curves = .false. + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/app/main.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/app/main.f90 new file mode 100644 index 0000000..e1834c5 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/app/main.f90 @@ -0,0 +1,40 @@ +program main + use circle_m, only: circle_t + use iso_varying_string, only: put_line + use shape_list_m, only: shape_list_t + use shape_item_m, only: shape_item_t + use square_m, only: square_t + use triangle_m, only: triangle_t + + implicit none + + type(shape_list_t) :: list + type(shape_list_t) :: duplicated_list + + list = shape_list_t( & + shapes = [ & + shape_item_t( & + shape = square_t( & + width = 2.0 & + ) & + ), & + shape_item_t( & + shape = circle_t( & + radius = 3.0 & + ) & + ), & + shape_item_t( & + shape = triangle_t( & + base = 4.0, & + height = 5.0 & + ) & + ) & + ] & + ) + + call put_line(list%to_string()) + + duplicated_list = (list*2.0) // (list*0.3) + + call put_line(duplicated_list%to_string()) +end program diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/fpm.toml b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/fpm.toml new file mode 100644 index 0000000..ee7195c --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/fpm.toml @@ -0,0 +1,10 @@ +name = "heterogeneous_list" +version = "0.1.0" +license = "MIT" +author = "Brad Richardson" +maintainer = "everythingfunctional@protonmail.com" +copyright = "2020 Brad Richardson" + +[dependencies] + iso_varying_string = { git = "https://gitlab.com/everythingfunctional/iso_varying_string.git", tag = "v2.0.0" } + strff = { git = "https://gitlab.com/everythingfunctional/strff.git", tag = "v2.0.1" } diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/circle_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/circle_m.f90 new file mode 100644 index 0000000..79381a1 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/circle_m.f90 @@ -0,0 +1,48 @@ +module circle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: circle_t + + type, extends(shape_t) :: circle_t + private + real :: radius + contains + private + procedure, public :: to_string => circle_to_string + procedure, public :: scale + end type + + interface circle_t + module procedure constructor + end interface +contains + pure function constructor(radius) result(circle) + real, intent(in) :: radius + type(circle_t) :: circle + + circle%radius = radius + end function + + pure function circle_to_string(self) result(string) + class(circle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "circle_t(" // NEWLINE & + // "radius = " // to_string(self%radius), & + 4) // NEWLINE & + // ")" + end function + + function scale(self, factor) result(scaled) + class(circle_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + + allocate(scaled, source = circle_t(radius = self%radius * factor)) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_item_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_item_m.f90 new file mode 100644 index 0000000..50016ec --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_item_m.f90 @@ -0,0 +1,49 @@ +module shape_item_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, NEWLINE + + implicit none + private + public :: shape_item_t + + type :: shape_item_t + private + class(shape_t), allocatable :: shape + contains + private + procedure, public :: to_string + procedure :: scale + generic, public :: operator(*) => scale + end type + + interface shape_item_t + module procedure constructor + end interface +contains + function constructor(shape) result(shape_item) + class(shape_t), intent(in) :: shape + type(shape_item_t) :: shape_item + + allocate(shape_item%shape, source = shape) + end function + + elemental function to_string(self) result(string) + class(shape_item_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_item_t(" // NEWLINE & + // "shape = " // self%shape%to_string(), & + 4) // NEWLINE & + // ")" + end function + + impure elemental function scale(self, factor) result(scaled) + class(shape_item_t), intent(in) :: self + real, intent(in) :: factor + type(shape_item_t) :: scaled + + allocate(scaled%shape, source = self%shape * factor) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_list_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_list_m.f90 new file mode 100644 index 0000000..d0c7725 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_list_m.f90 @@ -0,0 +1,61 @@ +module shape_list_m + use iso_varying_string, only: varying_string, operator(//) + use shape_item_m, only: shape_item_t + use strff, only: hanging_indent, indent, join, NEWLINE + + implicit none + private + public :: shape_list_t + + type :: shape_list_t + private + type(shape_item_t), allocatable :: shapes(:) + contains + private + procedure, public :: to_string + procedure :: concat + generic, public :: operator(//) => concat + procedure :: scale + generic, public :: operator(*) => scale + end type + + interface shape_list_t + module procedure constructor + end interface +contains + function constructor(shapes) result(shape_list) + type(shape_item_t), intent(in) :: shapes(:) + type(shape_list_t) :: shape_list + + allocate(shape_list%shapes, source = shapes) + end function + + pure function to_string(self) result(string) + class(shape_list_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "shape_list_t(" // NEWLINE & + // "shapes = [" // NEWLINE & + // indent(join(self%shapes%to_string(), "," // NEWLINE), 4) // NEWLINE & + // "]", & + 4) // NEWLINE & + // ")" + end function + + function concat(lhs, rhs) result(combined) + class(shape_list_t), intent(in) :: lhs + type(shape_list_t), intent(in) :: rhs + type(shape_list_t) :: combined + + allocate(combined%shapes, source = [lhs%shapes, rhs%shapes]) + end function + + function scale(self, factor) result(scaled) + class(shape_list_t), intent(in) :: self + real, intent(in) :: factor + type(shape_list_t) :: scaled + + allocate(scaled%shapes, source = self%shapes * factor) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_m.f90 new file mode 100644 index 0000000..5a0a150 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/shape_m.f90 @@ -0,0 +1,36 @@ +module shape_m + use iso_varying_string, only: varying_string + + implicit none + private + public :: shape_t + + type, abstract :: shape_t + contains + private + procedure(to_string_i), deferred, public :: to_string + procedure(scale_i), deferred, public :: scale + generic, public :: operator(*) => scale + end type + + abstract interface + pure function to_string_i(self) result(string) + import :: shape_t, varying_string + + implicit none + + class(shape_t), intent(in) :: self + type(varying_string) :: string + end function + + function scale_i(self, factor) result(scaled) + import :: shape_t + + implicit none + + class(shape_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + end function + end interface +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/square_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/square_m.f90 new file mode 100644 index 0000000..5dfebe4 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/square_m.f90 @@ -0,0 +1,48 @@ +module square_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: square_t + + type, extends(shape_t) :: square_t + private + real :: width + contains + private + procedure, public :: to_string => square_to_string + procedure, public :: scale + end type + + interface square_t + module procedure constructor + end interface +contains + pure function constructor(width) result(square) + real, intent(in) :: width + type(square_t) :: square + + square%width = width + end function + + pure function square_to_string(self) result(string) + class(square_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "square_t(" // NEWLINE & + // "width = " // to_string(self%width), & + 4) // NEWLINE & + // ")" + end function + + function scale(self, factor) result(scaled) + class(square_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + + allocate(scaled, source = square_t(width = self%width * factor)) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/triangle_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/triangle_m.f90 new file mode 100644 index 0000000..af38c13 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/heterogeneous_list-scale_shapes/src/triangle_m.f90 @@ -0,0 +1,52 @@ +module triangle_m + use iso_varying_string, only: varying_string, operator(//) + use shape_m, only: shape_t + use strff, only: hanging_indent, to_string, NEWLINE + + implicit none + private + public :: triangle_t + + type, extends(shape_t) :: triangle_t + private + real :: base + real :: height + contains + private + procedure, public :: to_string => triangle_to_string + procedure, public :: scale + end type + + interface triangle_t + module procedure constructor + end interface +contains + pure function constructor(base, height) result(triangle) + real, intent(in) :: base + real, intent(in) :: height + type(triangle_t) :: triangle + + triangle%base = base + triangle%height = height + end function + + pure function triangle_to_string(self) result(string) + class(triangle_t), intent(in) :: self + type(varying_string) :: string + + string = hanging_indent( & + "triangle_t(" // NEWLINE & + // "base = " // to_string(self%base) // "," // NEWLINE & + // "height = " // to_string(self%height), & + 4) // NEWLINE & + // ")" + end function + + function scale(self, factor) result(scaled) + class(triangle_t), intent(in) :: self + real, intent(in) :: factor + class(shape_t), allocatable :: scaled + + allocate(scaled, source = triangle_t(base = self%base * factor, height = self%height * factor)) + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/fpm.toml b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/fpm.toml new file mode 100644 index 0000000..bac6cc2 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/fpm.toml @@ -0,0 +1,11 @@ +name = "stack_example" +license = "MIT" +author = "Brad Richardson" +maintainer = "everythingfunctional@protonmail.com" +copyright = "2021 Brad Richardson" + +[dependencies] +erloff = { git = "https://gitlab.com/everythingfunctional/erloff.git", tag = "v2.0.0" } + +[dev-dependencies] +vegetables = { git = "https://gitlab.com/everythingfunctional/vegetables", tag = "v7.0.2" } diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/fallible_integer_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/fallible_integer_m.f90 new file mode 100644 index 0000000..8dcf1bb --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/fallible_integer_m.f90 @@ -0,0 +1,58 @@ +module fallible_integer_m + use erloff, only: error_list_t + + implicit none + private + public :: fallible_integer_t + + type :: fallible_integer_t + private + integer :: value__ + type(error_list_t) :: errors_ + contains + private + procedure, public :: failed + procedure, public :: value_ + procedure, public :: errors + end type + + interface fallible_integer_t + module procedure from_value + module procedure from_errors + end interface +contains + function from_value(value_) result(fallible_integer) + integer, intent(in) :: value_ + type(fallible_integer_t) :: fallible_integer + + fallible_integer%value__ = value_ + end function + + function from_errors(errors) result(fallible_integer) + type(error_list_t), intent(in) :: errors + type(fallible_integer_t) :: fallible_integer + + fallible_integer%errors_ = errors + end function + + function failed(self) + class(fallible_integer_t), intent(in) :: self + logical :: failed + + failed = self%errors_%has_any() + end function + + function value_(self) + class(fallible_integer_t), intent(in) :: self + integer :: value_ + + value_ = self%value__ + end function + + function errors(self) + class(fallible_integer_t), intent(in) :: self + type(error_list_t) :: errors + + errors = self%errors_ + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/stack_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/stack_m.f90 new file mode 100644 index 0000000..26ecb08 --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/src/stack_m.f90 @@ -0,0 +1,151 @@ +module stack_m + use erloff, only: error_list_t, fatal_t, module_t, procedure_t, NOT_FOUND + use fallible_integer_m, only: fallible_integer_t + + implicit none + private + public :: fallible_stack_t, stack_t + + type :: stack_t + private + integer, allocatable :: items(:) + contains + private + procedure, public :: empty + procedure, public :: top + procedure, public :: pop + procedure, public :: push + procedure, public :: depth + end type + + type :: fallible_stack_t + private + type(stack_t) :: stack_ + type(error_list_t) :: errors_ + contains + private + procedure, public :: failed + procedure, public :: stack + procedure, public :: errors + end type + + interface stack_t + module procedure constructor + end interface + + interface fallible_stack_t + module procedure from_stack + module procedure from_errors + end interface + + character(len=*), parameter :: MODULE_NAME = "stack_m" +contains + function constructor() result(empty_stack) + type(stack_t) :: empty_stack + + allocate(empty_stack%items, source = [integer::]) + end function + + function empty(self) + class(stack_t), intent(in) :: self + logical :: empty + + empty = self%depth() == 0 + end function + + function top(self) + class(stack_t), intent(in) :: self + type(fallible_integer_t) :: top + + if (self%empty()) then + top = fallible_integer_t(error_list_t(fatal_t( & + NOT_FOUND, & + module_t(MODULE_NAME), & + procedure_t("top"), & + "Asked for top of an empty stack."))) + else + top = fallible_integer_t(self%items(1)) + end if + end function + + function pop(self) result(popped) + class(stack_t), intent(in) :: self + type(fallible_stack_t) :: popped + + if (self%empty()) then + popped = fallible_stack_t(error_list_t(fatal_t( & + module_t(MODULE_NAME), & + procedure_t("pop"), & + "Attempted to pop an empty stack."))) + else + if (self%depth() > 1) then + block + type(stack_t) :: new_stack + + new_stack%items = self%items(2:) + popped = fallible_stack_t(new_stack) + end block + else + popped = fallible_stack_t(stack_t()) + end if + end if + end function + + function push(self, top) result(pushed) + class(stack_t), intent(in) :: self + integer, intent(in) :: top + type(stack_t) :: pushed + + if (self%empty()) then + allocate(pushed%items, source = [top]) + else + allocate(pushed%items, source = [top, self%items]) + end if + end function + + function depth(self) + class(stack_t), intent(in) :: self + integer :: depth + + if (allocated(self%items)) then + depth = size(self%items) + else + depth = 0 + end if + end function + + function from_stack(stack) result(fallible_stack) + type(stack_t), intent(in) :: stack + type(fallible_stack_t) :: fallible_stack + + fallible_stack%stack_ = stack + end function + + function from_errors(errors) result(fallible_stack) + type(error_list_t), intent(in) :: errors + type(fallible_stack_t) :: fallible_stack + + fallible_stack%errors_ = errors + end function + + function failed(self) + class(fallible_stack_t), intent(in) :: self + logical :: failed + + failed = self%errors_%has_any() + end function + + function stack(self) + class(fallible_stack_t), intent(in) :: self + type(stack_t) :: stack + + stack = self%stack_ + end function + + function errors(self) + class(fallible_stack_t), intent(in) :: self + type(error_list_t) :: errors + + errors = self%errors_ + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/main.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/main.f90 new file mode 100644 index 0000000..b0d116f --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/main.f90 @@ -0,0 +1,22 @@ +! Generated by make_vegetable_driver. DO NOT EDIT +program main + implicit none + + call run() +contains + subroutine run() + use stack_test, only: & + stack_new_stack => test_new_stack, & + stack_non_empty_stack => test_non_empty_stack + use vegetables, only: test_item_t, test_that, run_tests + + type(test_item_t) :: tests + type(test_item_t) :: individual_tests(2) + + individual_tests(1) = stack_new_stack() + individual_tests(2) = stack_non_empty_stack() + tests = test_that(individual_tests) + + call run_tests(tests) + end subroutine +end program diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/stack_input_m.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/stack_input_m.f90 new file mode 100644 index 0000000..ddb682c --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/stack_input_m.f90 @@ -0,0 +1,34 @@ +module stack_input_m + use stack_m, only: stack_t + use vegetables, only: input_t + + implicit none + private + public :: stack_input_t + + type, extends(input_t) :: stack_input_t + private + type(stack_t) :: stack_ + contains + private + procedure, public :: stack + end type + + interface stack_input_t + module procedure constructor + end interface +contains + function constructor(stack) result(stack_input) + type(stack_t), intent(in) :: stack + type(stack_input_t) :: stack_input + + stack_input%stack_ = stack + end function + + function stack(self) + class(stack_input_t), intent(in) :: self + type(stack_t) :: stack + + stack = self%stack_ + end function +end module diff --git a/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/stack_test.f90 b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/stack_test.f90 new file mode 100644 index 0000000..0af11ff --- /dev/null +++ b/Intermediate Fortran/Section 4 - Patterns and Principles/stack_example-main/test/stack_test.f90 @@ -0,0 +1,188 @@ +module stack_test + use erloff, only: error_list_t + use fallible_integer_m, only: fallible_integer_t + use stack_m, only: fallible_stack_t, stack_t + use stack_input_m, only: stack_input_t + use vegetables, only: & + input_t, & + result_t, & + test_item_t, & + assert_equals, & + assert_not, & + assert_that, & + fail, & + given, & + it_ + + implicit none + private + public :: test_new_stack, test_non_empty_stack + + integer, parameter :: STACK_ITEMS(*) = [2, 3, 5, 7, 11] +contains + function test_new_stack() result(tests) + type(test_item_t) :: tests + + tests = & + given("a new stack", stack_input_t(stack_t()), & + [ it_("it is empty", check_empty) & + , it_("it returns an error when queried for its top item", check_empty_top) & + , it_("it returns an error when popped", check_empty_pop) & + , it_("it acquires depth by retaining a pushed item as its top", check_empty_push) & + ]) + end function + + function test_non_empty_stack() result(tests) + type(test_item_t) :: tests + + integer :: i + type(stack_t) :: stack + + do i = 1, size(STACK_ITEMS) + stack = stack%push(stack_items(i)) + end do + + tests = & + given("a non-empty stack", stack_input_t(stack), & + [ it_("it becomes deeper by retaining a pushed item as its top", check_non_empty_push) & + , it_("on popping reveals tops in reverse order of pushing", check_popping) & + ]) + end function + + function check_empty(input) result(result_) + class(input_t), intent(in) :: input + type(result_t) :: result_ + + type(stack_t) :: stack + + select type (input) + type is (stack_input_t) + stack = input%stack() + result_ = assert_that(stack%empty()) + class default + result_ = fail("expected to get a stack_input_t") + end select + end function + + function check_empty_top(input) result(result_) + class(input_t), intent(in) :: input + type(result_t) :: result_ + + type(error_list_t) :: errors + type(fallible_integer_t) :: fallible_integer + type(stack_t) :: stack + + select type (input) + type is (stack_input_t) + stack = input%stack() + fallible_integer = stack%top() + errors = fallible_integer%errors() + result_ = assert_that(fallible_integer%failed(), errors%to_string()) + class default + result_ = fail("expected to get a stack_input_t") + end select + end function + + function check_empty_pop(input) result(result_) + class(input_t), intent(in) :: input + type(result_t) :: result_ + + type(error_list_t) :: errors + type(fallible_stack_t) :: fallible_stack + type(stack_t) :: stack + + select type (input) + type is (stack_input_t) + stack = input%stack() + fallible_stack = stack%pop() + errors = fallible_stack%errors() + result_ = assert_that(fallible_stack%failed(), errors%to_string()) + class default + result_ = fail("expected to get a stack_input_t") + end select + end function + + function check_empty_push(input) result(result_) + class(input_t), intent(in) :: input + type(result_t) :: result_ + + integer, parameter :: PUSHED_ITEM = 42 + type(error_list_t) :: errors + type(fallible_integer_t) :: fallible_integer + type(stack_t) :: stack + + select type (input) + type is (stack_input_t) + stack = input%stack() + stack = stack%push(PUSHED_ITEM) + fallible_integer = stack%top() + errors = fallible_integer%errors() + result_ = & + assert_that(.not.fallible_integer%failed(), "stack%top() didn't fail", errors%to_string()) & + .and. assert_equals(1, stack%depth(), "stack%depth()") & + .and. assert_equals(PUSHED_ITEM, fallible_integer%value_(), "stack%top()%value()") + class default + result_ = fail("expected to get a stack_input_t") + end select + end function + + function check_non_empty_push(input) result(result_) + class(input_t), intent(in) :: input + type(result_t) :: result_ + + integer, parameter :: PUSHED_ITEM = 42 + type(error_list_t) :: errors + type(fallible_integer_t) :: fallible_integer + integer :: initial_depth + type(stack_t) :: stack + + select type (input) + type is (stack_input_t) + stack = input%stack() + initial_depth = stack%depth() + stack = stack%push(PUSHED_ITEM) + fallible_integer = stack%top() + errors = fallible_integer%errors() + result_ = & + assert_that(.not.fallible_integer%failed(), "stack%top() didn't fail", errors%to_string()) & + .and. assert_equals(initial_depth+1, stack%depth(), "stack%depth()") & + .and. assert_equals(PUSHED_ITEM, fallible_integer%value_(), "stack%top()%value()") + class default + result_ = fail("expected to get a stack_input_t") + end select + end function + + function check_popping(input) result(result_) + class(input_t), intent(in) :: input + type(result_t) :: result_ + + type(error_list_t) :: errors + type(fallible_integer_t) :: fallible_integer + type(fallible_stack_t) :: fallible_stack + integer :: i + type(stack_t) :: stack + + select type (input) + type is (stack_input_t) + stack = input%stack() + do i = size(STACK_ITEMS), 1, -1 + fallible_integer = stack%top() + errors = fallible_integer%errors() + result_ = & + result_ & + .and. assert_that(.not.fallible_integer%failed(), "stack%top() didn't fail", errors%to_string()) & + .and. assert_equals(STACK_ITEMS(i), fallible_integer%value_(), "stack%top()%value()") + fallible_stack = stack%pop() + errors = fallible_stack%errors() + result_ = result_ .and. assert_that(.not.fallible_stack%failed(), "stack%pop() didn't fail", errors%to_string()) + if (result_%passed()) then + stack = fallible_stack%stack() + else + return + end if + end do + class default + result_ = fail("expected to get a stack_input_t") + end select + end function +end module diff --git a/README.md b/README.md new file mode 100644 index 0000000..509e879 --- /dev/null +++ b/README.md @@ -0,0 +1,4 @@ +# Fortran +The codes are from the following courses: +- [Fortran For Beginners | Udemy](https://www.udemy.com/course/fortran-for-beginners/) : [GitLab](https://gitlab.com/everythingfunctional) +- [Intermediate Fortran | Udemy](https://www.udemy.com/course/intermediate-fortran/) : [GitLab](https://gitlab.com/everythingfunctional)