Initial data commit

Task/Modular-arithmetic/Fortran/modular-arithmetic-1.f

@@ -0,0 +1,95 @@
+module modular_arithmetic
+  implicit none
+
+  type :: modular
+     integer :: val
+     integer :: modulus
+  end type modular
+
+  interface operator(+)
+     module procedure modular_modular_add
+     module procedure modular_integer_add
+  end interface operator(+)
+
+  interface operator(**)
+     module procedure modular_integer_pow
+  end interface operator(**)
+
+contains
+
+  function modular_modular_add (a, b) result (c)
+    type(modular), intent(in) :: a
+    type(modular), intent(in) :: b
+    type(modular) :: c
+
+    if (a%modulus /= b%modulus) error stop
+    c%val = modulo (a%val + b%val, a%modulus)
+    c%modulus = a%modulus
+  end function modular_modular_add
+
+  function modular_integer_add (a, i) result (c)
+    type(modular), intent(in) :: a
+    integer, intent(in) :: i
+    type(modular) :: c
+
+    c%val = modulo (a%val + i, a%modulus)
+    c%modulus = a%modulus
+  end function modular_integer_add
+
+  function modular_integer_pow (a, i) result (c)
+    type(modular), intent(in) :: a
+    integer, intent(in) :: i
+    type(modular) :: c
+
+    ! One cannot simply use the integer ** operator and then compute
+    ! the least residue, because the integers will overflow. Let us
+    ! instead use the right-to-left binary method:
+    ! https://en.wikipedia.org/w/index.php?title=Modular_exponentiation&oldid=1136216610#Right-to-left_binary_method
+
+    integer :: modulus
+    integer :: base
+    integer :: exponent
+
+    modulus = a%modulus
+    exponent = i
+
+    if (modulus < 1) error stop
+    if (exponent < 0) error stop
+
+    c%modulus = modulus
+    if (modulus == 1) then
+       c%val = 0
+    else
+       c%val = 1
+       base = modulo (a%val, modulus)
+       do while (exponent > 0)
+          if (modulo (exponent, 2) /= 0) then
+             c%val = modulo (c%val * base, modulus)
+          end if
+          exponent = exponent / 2
+          base = modulo (base * base, modulus)
+       end do
+    end if
+  end function modular_integer_pow
+
+end module modular_arithmetic
+
+! If one uses the extension .F90 instead of .f90, then gfortran will
+! pass the program through the C preprocessor. Thus one can write f(x)
+! without considering the type of the argument
+#define f(x) ((x)**100 + (x) + 1)
+
+program modular_arithmetic_task
+  use, intrinsic :: iso_fortran_env
+  use, non_intrinsic :: modular_arithmetic
+  implicit none
+
+  type(modular) :: x, y
+
+  x = modular(10, 13)
+  y = f(x)
+
+  write (*, '("    modulus 13:  ", I0)') y%val
+  write (*, '("floating point:  ", E55.50)') f(10.0_real64)
+
+end program modular_arithmetic_task

Task/Modular-arithmetic/Fortran/modular-arithmetic-2.f

@@ -0,0 +1,167 @@
+module modular_arithmetic
+  implicit none
+
+  type :: modular_integer
+     integer :: val
+     integer :: modulus
+  end type modular_integer
+
+  interface operator(+)
+     module procedure add
+  end interface operator(+)
+
+  interface operator(*)
+     module procedure mul
+  end interface operator(*)
+
+  interface operator(**)
+     module procedure npow
+  end interface operator(**)
+
+contains
+
+  function modular (val, modulus) result (modint)
+    integer, intent(in) :: val, modulus
+    type(modular_integer) :: modint
+
+    modint%val = modulo (val, modulus)
+    modint%modulus = modulus
+  end function modular
+
+  subroutine write_number (x)
+    class(*), intent(in) :: x
+
+    select type (x)
+    class is (modular_integer)
+       write (*, '(I0)', advance = 'no') x%val
+    type is (integer)
+       write (*, '(I0)', advance = 'no') x
+    class default
+       error stop
+    end select
+  end subroutine write_number
+
+  function add (a, b) result (c)
+    class(*), intent(in) :: a, b
+    class(*), allocatable :: c
+
+    select type (a)
+    class is (modular_integer)
+       select type (b)
+       class is (modular_integer)
+          if (a%modulus /= b%modulus) error stop
+          allocate (c, source = modular (a%val + b%val, a%modulus))
+       type is (integer)
+          allocate (c, source = modular (a%val + b, a%modulus))
+       class default
+          error stop
+       end select
+    type is (integer)
+       select type (b)
+       class is (modular_integer)
+          allocate (c, source = modular (a + b%val, b%modulus))
+       type is (integer)
+          allocate (c, source = a + b)
+       class default
+          error stop
+       end select
+    class default
+       error stop
+    end select
+  end function add
+
+  function mul (a, b) result (c)
+    class(*), intent(in) :: a, b
+    class(*), allocatable :: c
+
+    select type (a)
+    class is (modular_integer)
+       select type (b)
+       class is (modular_integer)
+          if (a%modulus /= b%modulus) error stop
+          allocate (c, source = modular (a%val * b%val, a%modulus))
+       type is (integer)
+          allocate (c, source = modular (a%val * b, a%modulus))
+       class default
+          error stop
+       end select
+    type is (integer)
+       select type (b)
+       class is (modular_integer)
+          allocate (c, source = modular (a * b%val, b%modulus))
+       type is (integer)
+          allocate (c, source = a * b)
+       class default
+          error stop
+       end select
+    class default
+       error stop
+    end select
+  end function mul
+
+  function npow (a, i) result (c)
+    class(*), intent(in) :: a
+    integer, intent(in) :: i
+    class(*), allocatable :: c
+
+    class(*), allocatable :: base
+    integer :: exponent, exponent_halved
+
+    if (i < 0) error stop
+
+    select type (a)
+    class is (modular_integer)
+       allocate (c, source = modular (1, a%modulus))
+    class default
+       c = 1
+    end select
+
+    allocate (base, source = a)
+
+    exponent = i
+    do while (exponent /= 0)
+       exponent_halved = exponent / 2
+       if (2 * exponent_halved /= exponent) c = base * c
+       base = base * base
+       exponent = exponent_halved
+    end do
+  end function npow
+
+end module modular_arithmetic
+
+program modular_arithmetic_task
+  use, non_intrinsic :: modular_arithmetic
+  implicit none
+
+  write (*, '("f(10) ≅ ")', advance = 'no')
+  call write_number (f (modular (10, 13)))
+  write (*, '("   (mod 13)")')
+
+  write (*, '()')
+  write (*, '("f applied to a regular integer would overflow, so, in what")')
+  write (*, '("follows, instead we use g(x) = x**2 + x + 1")')
+  write (*, '()')
+
+  write (*, '("g(10) = ")', advance = 'no')
+  call write_number (g (10))
+  write (*, '()')
+  write (*, '("g(10) ≅ ")', advance = 'no')
+  call write_number (g (modular (10, 13)))
+  write (*, '("   (mod 13)")')
+contains
+
+  function f(x) result (y)
+    class(*), intent(in) :: x
+    class(*), allocatable :: y
+
+    y = x**100 + x + 1
+  end function f
+
+  function g(x) result (y)
+    class(*), intent(in) :: x
+    class(*), allocatable :: y
+
+    y = x**2 + x + 1
+  end function g
+
+end program modular_arithmetic_task