exercism / fortran

Exercism exercises in Fortran.
https://exercism.org/tracks/fortran
MIT License
23 stars 30 forks source link

Building a training set of tags for fortran #236

Closed ErikSchierboom closed 9 months ago

ErikSchierboom commented 10 months ago

Hello lovely maintainers :wave:

We've recently added "tags" to student's solutions. These express the constructs, paradigms and techniques that a solution uses. We are going to be using these tags for lots of things including filtering, pointing a student to alternative approaches, and much more.

In order to do this, we've built out a full AST-based tagger in C#, which has allowed us to do things like detect recursion or bit shifting. We've set things up so other tracks can do the same for their languages, but its a lot of work, and we've determined that actually it may be unnecessary. Instead we think that we can use machine learning to achieve tagging with good enough results. We've fine-tuned a model that can determine the correct tags for C# from the examples with a high success rate. It's also doing reasonably well in an untrained state for other languages. We think that with only a few examples per language, we can potentially get some quite good results, and that we can then refine things further as we go.

I released a new video on the Insiders page that talks through this in more detail.

We're going to be adding a fully-fledged UI in the coming weeks that allow maintainers and mentors to tag solutions and create training sets for the neural networks, but to start with, we're hoping you would be willing to manually tag 20 solutions for this track. In this post we'll add 20 comments, each with a student's solution, and the tags our model has generated. Your mission (should you choose to accept it) is to edit the tags on each issue, removing any incorrect ones, and add any that are missing. In order to build one model that performs well across languages, it's best if you stick as closely as possible to the C# tags as you can. Those are listed here. If you want to add extra tags, that's totally fine, but please don't arbitrarily reword existing tags, even if you don't like what Erik's chosen, as it'll just make it less likely that your language gets the correct tags assigned by the neural network.


To summarise - there are two paths forward for this issue:

  1. You're up for helping: Add a comment saying you're up for helping. Update the tags some time in the next few days. Add a comment when you're done. We'll then add them to our training set and move forward.
  2. You not up for helping: No problem! Just please add a comment letting us know :)

If you tell us you're not able/wanting to help or there's no comment added, we'll automatically crowd-source this in a week or so.

Finally, if you have questions or want to discuss things, it would be best done on the forum, so the knowledge can be shared across all maintainers in all tracks.

Thanks for your help! :blue_heart:


Note: Meta discussion on the forum

ErikSchierboom commented 10 months ago

Exercise: hello-world

Code

module hello_world
  implicit none
  private
  public :: hello

contains

  function hello() result(greeting)
    character(:), allocatable :: greeting
    greeting = "Hello World"
  end function hello

end module hello_world

Tags:

construct:allocate
construct:assignment
construct:character
construct:contains
construct:function
construct:implicit-visibility
construct:module
construct:parameterized-type
construct:public
construct:result
construct:string
construct:variable-visibility
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:writing-modules
ErikSchierboom commented 10 months ago

Exercise: hello-world

Code

!! Exercise 'Hello, World!'
!! Return the string 'Hello World'
  pure character(len=11) function hello()
    implicit none

    hello = 'Hello World'
  end function hello

Tags:

construct:assignment
construct:character
construct:function
construct:implicit-assignment
construct:implicit-none
construct:parameter
construct:pure-function
construct:return
construct:string
construct:variable-shadowing
construct:visibility
paradigm:functional
paradigm:imperative
paradigm:object-oriented
ErikSchierboom commented 10 months ago

Exercise: hello-world

Code

program helloworld
print *, 'Hello, World!'
end program helloworld

Tags:

construct:assignment
construct:character
construct:do-loop
construct:end
construct:implicit-assignment
construct:implicit-conversion
construct:input
construct:int
construct:integral-number
construct:print
construct:program
construct:string
construct:variable
construct:visibility
paradigm:imperative
paradigm:looping
ErikSchierboom commented 10 months ago

Exercise: bob

Code

program Bob

  character(100) :: str
  character :: chr
  logical :: uppercase, shout, question, blank
  integer :: length, trimlen, i

  read(*,'(A)') str
  trimlen = len_trim(str)

  uppercase = .FALSE.
  question = .FALSE.
  shout = .FALSE.
  blank = .TRUE.

  do i = 1,trimlen
      chr = str(i:i)
      if (chr >= 'a' .AND. chr <= 'z') then
          uppercase = .FALSE.
          exit
      else if (chr >= 'A' .AND. chr <= 'Z' .OR. chr .EQ. '') then
          uppercase = .TRUE.
      end if 
  end do

  chr = str(len_trim(str):len_trim(str))

  if (uppercase .AND. chr .EQ. '!') then

    shout = .TRUE.

  end if

  if (chr .EQ. '?') then

    question = .TRUE.

  end if

  do i = 1,trimlen
      if ( str(i:i) .NE. ' ' ) then
        blank = .FALSE.
      end if
  end do

  if (uppercase .OR. shout) then
      write(*,*) 'Whoa chill out!'
    else if (question) then
      write(*,*) 'Sure.'
    else if (blank) then
      write(*,*) 'Fine. Be that way!'
    else
      write(*,*) 'Whatever.'
  end if

end program Bob

Tags:

construct:assignment
construct:character
construct:do-loop
construct:exit
construct:if-then-else
construct:implicit-loop
construct:logical
construct:read
construct:string
construct:variable
construct:write
paradigm:imperative
paradigm:declarative
ErikSchierboom commented 10 months ago

Exercise: hamming

Code

program hamming

  implicit none
  character (100) :: gen1, gen2
  integer :: len1, len2, i, hdist

  write(*, *) 'Type a DNA strand:'
  read (*, '(A)') gen1
  len1 = len_trim(gen1)
  write(*, *) 'Write another DNA strand of lenght ', len1, ':'
  read (*, '(A)') gen2
  len2 = len_trim(gen2)

  if (len2 .EQ. len1) then

    hdist = 0

    do i=1,len2

      if (gen1(i:i) .NE. gen2(i:i)) then

        hdist = hdist + 1

      end if

    end do

    write(*, *) 'Hamming distance of DNA strand 1 and 2 is', hdist

  else

    write(*, *) 'DNA strands have different length! Not comparable.'
    return

  end if

end program hamming

Tags:

construct:assignment
construct:character
construct:do-loop
construct:implicit-none
construct:if-then-else
construct:integer
construct:interval
construct:invocation
construct:parameter
construct:program
construct:string
construct:variable
construct:write
paradigm:imperative
paradigm:procedural
technique:looping
ErikSchierboom commented 10 months ago

Exercise: rna-transcription

Code

program rna_trans

  implicit none
  integer :: i, len
  character(100) :: dna, rna
  character :: chr

  write(*,*) 'Type an DNA to get the corresponding RNA:'
  read(*, '(A)') dna
  len=len_trim(dna)

  do i=1,len

    if (dna(i:i) .EQ. 'G') then
      rna(i:i) = 'C'
    else if (dna(i:i) .EQ. 'C') then
      rna(i:i) = 'G'
    else if (dna(i:i) .EQ. 'T') then
      rna(i:i) = 'A'
    else if (dna(i:i) .EQ. 'A') then
      rna(i:i) = 'U'
    else
      write(*,*) 'Your DNA has some curios nucleotides!'
      return
    end if

  end do

  write(*,*) 'RNA Transcription completed!'
  write(*,*) 'DNA:', dna
  write(*,*) 'RNA:', rna

end program rna_trans

Tags:

construct:assignment
construct:character
construct:do-loop
construct:if-then-else
construct:implicit-none
construct:indexed
construct:integral-number
construct:invocation
construct:parameter
construct:program
construct:read
construct:return
construct:string
construct:variable-visibility
construct:write
paradigm:imperative
paradigm:procedural
ErikSchierboom commented 10 months ago

Exercise: rna-transcription

Code

module rna_transcription
  implicit none
contains

  function to_rna(dna)
      character(*) :: dna
      character(len(dna)) :: to_rna

      integer :: i

      do i=1,len(dna)
        if (dna(i:i) == 'A') then
            to_rna(i:i) = 'U'
        else if (dna(i:i) == 'C') then
            to_rna(i:i) = 'G'
        else if (dna(i:i) == 'G') then
            to_rna(i:i) = 'C'
        else if (dna(i:i) == 'T') then
            to_rna(i:i) = 'A'
        end if
      end do
  end function to_rna

end module rna_transcription

Tags:

construct:assignment
construct:character
construct:do-loop
construct:elseif
construct:equality
construct:function
construct:if
construct:implicit-none
construct:module
construct:parameter
construct:string
construct:then
construct:variable-shadowing
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:looping
ErikSchierboom commented 10 months ago

Exercise: rna-transcription

Code

module rna_transcription
  implicit none
contains

  function to_rna(dna)
      character(*) :: dna
      character(len(dna)) :: to_rna
      integer :: i
      do i = 1, len(dna)
          select case (dna(i:i))

             case ('A') 
                 to_rna(i:i) = 'U'

             case ('T')
                 to_rna(i:i) = 'A'

             case ('C') 
                 to_rna(i:i)= 'G'

             case ('G')
                 to_rna(i:i) = 'C'

             case default
                 to_rna = ' '
           end select
       end do

  end function to_rna

end module rna_transcription

Tags:

construct:assignment
construct:character
construct:do-loop
construct:implicit-none
construct:module
construct:parameterized-type
construct:select-case
construct:string
construct:variable-shadowing
paradigm:imperative
paradigm:object-oriented
technique:looping
ErikSchierboom commented 10 months ago

Exercise: raindrops

Code

program raindrops

  implicit none
  integer :: i, num, len
  logical :: factorial
  character (16) :: output

  factorial = .FALSE.

  output = ''

  write(*,*) 'Type a number:'
  read(*,*) num

  if (mod(num,3) .EQ. 0) then

    output= 'Pling'
    factorial = .TRUE.

  end if

  if (mod(num,5) .EQ. 0) then

    output= trim(output)//'Plang'
    factorial = .TRUE.

  end if

  if (mod(num,7) .EQ. 0) then

    output = trim(output)//'Plong'
    factorial = .TRUE.

  end if

  if (factorial) then

    write(*,*) output

  else  

    write(*,*) num

  end if

end program raindrops

Tags:

construct:assignment
construct:boolean
construct:character
construct:comment
construct:if-then-else
construct:implicit-none
construct:integer
construct:invocation
construct:logical
construct:number
construct:parameter
construct:program
construct:string
construct:variable-visibility
paradigm:imperative
paradigm:procedural
technique:conditionals
ErikSchierboom commented 10 months ago

Exercise: raindrops

Code

module raindrops
  implicit none
contains

  function convert(i)
    integer :: i
    character(20) :: convert
    convert = ''
    if (mod(i,3) == 0) then
        convert = trim(adjustl(trim(convert)))//'Pling'
    end if
    if (mod(i,5) == 0) then
        convert = trim(adjustl(trim(convert)))//'Plang'
    end if
    if (mod(i,7) == 0) then
        convert = trim(adjustl(trim(convert)))//'Plong'
    end if
    if ((mod(i,3) /= 0) .and. (mod(i,5) /= 0) .and. (mod(i,7) /= 0)) then
        write(convert,*) i
        convert = trim(adjustl(trim(convert)))
        !adjustl是左对齐,空格放右边,trim是删除右边空格
    end if

  end function convert

end module raindrops

Tags:

construct:assignment
construct:character
construct:comment
construct:contains
construct:double_slash
construct:equivalence
construct:explicit-conversion
construct:function
construct:if-then-else
construct:implicit-conversion
construct:implicit-none
construct:integer
construct:integral-number
construct:invocation
construct:logical-and
construct:module
construct:number
construct:parameter
construct:string
construct:then
construct:trim
construct:write
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:boolean-logic
technique:type-conversion
ErikSchierboom commented 10 months ago

Exercise: difference-of-squares

Code

program diff_squares

  implicit none
  integer :: i, num, sum, sqos, sosq, diff

  write(*,*) 'Type in a number'
  read (*,*) num

  do i=1,num

    sum=sum+i
    sosq=sosq + i**2

  end do
  sqos = sum**2
  diff = sqos - sosq

  write(*,*) 'Sum of sqares:', sosq
  write(*,*) 'Square of sums:', sqos
  write(*,*) 'Difference:', diff

end program diff_squares

Tags:

construct:assignment
construct:do-loop
construct:implicit-none
construct:integer
construct:power
construct:program
construct:read
construct:subtract
construct:variable
construct:write
paradigm:imperative
paradigm:procedural
technique:looping
ErikSchierboom commented 10 months ago

Exercise: difference-of-squares

Code

module difference_of_squares
  implicit none
contains

  integer function square_of_sum(n)
    integer n, i

    square_of_sum = 0
    do i=1,n
        square_of_sum = square_of_sum + i
    end do
    square_of_sum = square_of_sum ** 2
  end function

  integer function sum_of_squares(n)
    integer n, i

    sum_of_squares = 0
    do i=1,n
        sum_of_squares = sum_of_squares + i ** 2
    end do
  end function

  integer function difference(n)
    integer :: n

    difference = square_of_sum(n) - sum_of_squares(n)
  end function difference

end module difference_of_squares

Tags:

construct:assignment
construct:contains
construct:do-loop
construct:implicit-none
construct:integer
construct:invocation
construct:module
construct:parameter
construct:return
construct:subtract
construct:variable-shadowing
construct:visibility-modifier
paradigm:imperative
paradigm:object-oriented
technique:looping
ErikSchierboom commented 10 months ago

Exercise: difference-of-squares

Code

module difference_of_squares
  implicit none
contains

  integer function square_of_sum(n)
    integer :: i, n
    integer :: sum
    sum = 0
    do i = 1,n
        sum = i + sum
    end do
    square_of_sum = sum ** 2
  end function square_of_sum

 !integer function sum_of_squares(n)
 !    ! function 有integer, 成员变量就不需要再定义为integer了
 !  integer :: i, n
 !  !integer :: sum_of_squares
 !  sum_of_squares = 0
 !  do i = 1,n
 !      sum_of_squares = i ** 2 + sum_of_squares
 !  end do
 !end function sum_of_squares
 !换一种写法
  integer function sum_of_squares(n) result (sos)
      ! function 有integer, 成员变量就不需要再定义为integer了
    integer :: i, n
    sos = 0
    ! 此时sum_of_squares不再能赋值
    !sum_of_squares = 0
    do i = 1,n
        sos = i ** 2 + sos
    end do
  end function sum_of_squares

  integer function difference(n)
    integer :: n
    difference = square_of_sum(n) - sum_of_squares(n)
  end function difference
end module difference_of_squares

Tags:

construct:add
construct:assignment
construct:comment
construct:do-loop
construct:exponentiation
construct:function
construct:implicit-none
construct:integer
construct:invocation
construct:module
construct:number
construct:parameter
construct:result
construct:subtract
construct:variable
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:looping
ErikSchierboom commented 10 months ago

Exercise: pangram

Code

module pangram
  implicit none
contains
  logical function is_char(tmp)
    character :: tmp
    if ((tmp >= "a" .and. tmp<="z" ) .or. (tmp >= "A" .and. tmp<="Z" ) )then
        is_char = .true.
    else
        is_char = .false.
    end if
  end function is_char

  logical function is_pangram(sentance)
    character(*) :: sentance
    character(52) :: alphabet
    character :: tmp
    integer :: i, j
    integer :: pos_in_sen, pos_in_alp

    j = 1
    do i = 65, 90
        alphabet(j:j) = char(i)
        j = j+1
        alphabet(j:j) = char(i+32)
        j = j+1
    end do
    !print *, alphabet

    pos_in_sen = 1
    do while (pos_in_sen <= len(sentance))
        tmp = sentance(pos_in_sen:pos_in_sen)
        if (is_char(tmp)) then
            pos_in_alp = scan(alphabet, tmp)
            if (tmp >= "a" .and. tmp<="z" ) then 
                alphabet(pos_in_alp-1:pos_in_alp) = ''
            else if (tmp >= "A" .and. tmp<="Z" ) then 
                alphabet(pos_in_alp:pos_in_alp+1) = ''
            else
            end if
            pos_in_sen = pos_in_sen + 1
        else
            pos_in_sen = pos_in_sen + 1
        end if
    end do

    if (alphabet /= '')     then
        is_pangram = .false.
    else 
        is_pangram = .true.
    end if

   end function is_pangram

end module pangram

Tags:

construct:add
construct:assignment
construct:char
construct:comment
construct:do-loop
construct:elseif
construct:function
construct:if
construct:implicit-none
construct:integer
construct:interval
construct:invocation
construct:logical
construct:logical-and
construct:logical-or
construct:module
construct:parameter
construct:return
construct:string
construct:subtract
construct:then
construct:variable-assignment
construct:visibility-modifiers
construct:while-loop
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:boolean-logic
technique:looping
ErikSchierboom commented 10 months ago

Exercise: matrix

Code


MODULE matrix
  IMPLICIT NONE

CONTAINS

  FUNCTION row(m, m_dim, i) RESULT(r)
    INTEGER, INTENT(in) :: m_dim(2)
    CHARACTER(*), INTENT(in) :: m(m_dim(1))
    INTEGER, INTENT(in) :: i
    INTEGER, DIMENSION(m_dim(1)) :: r
    INTEGER :: A(m_dim(2), m_dim(1))
    INTEGER :: j, k, l, n, p, q
    CHARACTER(:), ALLOCATABLE :: line
    INTEGER, DIMENSION(m_dim(1) - 1) :: stops
    DO j = 1, m_dim(2)
       line = TRIM(m(j))
       q = 1
       DO p = 1, m_dim(1) - 1
          IF (p == 1) THEN
             stops(p) = INDEX(line(q:), ', ')
          ELSE
             stops(p) = INDEX(line(q:), ', ') + stops(p - 1)
          END IF
          q = stops(p) + 2
       END DO
       DO k = 1, m_dim(1)
          IF (k == 1) THEN
             l = stops(k)
             READ (line(1:l), *) A(j, k)
          ELSE IF (k == m_dim(1)) THEN
             l = stops(k - 1) + 2
             READ (line(l:), *) A(j, k)
          ELSE
             l = stops(k - 1) + 2
             n = stops(k)
             READ (line(l:n), *) A(j, k)
          END IF
       END DO
    END DO

    r(:) = A(i, :)
  END FUNCTION row

  FUNCTION column(m, m_dim, i) RESULT(c)
    INTEGER, INTENT(in) :: m_dim(2)
    CHARACTER(*), INTENT(in) :: m(m_dim(1))
    INTEGER, INTENT(in) :: i
    INTEGER, DIMENSION(m_dim(2)) :: c
    INTEGER :: A(m_dim(2), m_dim(1))
    INTEGER :: j, k, l, n, p, q, r
    CHARACTER(:), ALLOCATABLE :: line
    INTEGER, DIMENSION(m_dim(1) - 1) :: stops
    DO j = 1, m_dim(2)
       line = TRIM(m(j))
       q = 1
       DO p = 1, m_dim(1) - 1
          IF (p == 1) THEN
             stops(p) = INDEX(line(q:), ', ')
          ELSE
             stops(p) = INDEX(line(q:), ', ') + stops(p - 1)
          END IF
          q = stops(p) + 2
       END DO
       DO k = 1, m_dim(1)
          IF (k == 1) THEN
             l = stops(k)
             READ (line(1:l), *) A(j, k)
          ELSE IF (k == m_dim(1)) THEN
             l = stops(k - 1) + 2
             READ (line(l:), *) A(j, k)
          ELSE
             l = stops(k - 1) + 2
             n = stops(k)
             READ (line(l:n), *) A(j, k)
          END IF
       END DO
    END DO

    DO r = 1, m_dim(2)
       c(r) = A(r, i)
    END DO
  END FUNCTION column

END MODULE matrix

Tags:

No tags generated

ErikSchierboom commented 10 months ago

Exercise: nth-prime

Code

module nth_prime
  implicit none
contains

  logical function not_divisible(try_number, smaller_primes)
    integer :: try_number, smaller_primes(:), i
    not_divisible = .true.
    do i = 1, size(smaller_primes)
      if (mod(try_number, smaller_primes(i)) == 0) then
        not_divisible = .false.
        return
      end if
    end do

  end function not_divisible

  ! get nth prime
  integer function prime(n)
    integer, intent(in) :: n
    integer, allocatable :: smaller_primes(:)
    integer :: found_primes, i

    if (n <= 0) then
      prime = -1
      return
    end if

    found_primes = 0
    i = 2
    allocate(smaller_primes(n))

    do while (found_primes < n)

      if (not_divisible(i, smaller_primes(1:found_primes))) then
        found_primes = found_primes + 1
        smaller_primes(found_primes) = i
      end if
      i = i + 1

    end do

    prime = smaller_primes(n)

  end function

end module

Tags:

construct:add
construct:allocate
construct:assignment
construct:boolean
construct:comment
construct:do-loop
construct:explicit-integer-size
construct:function
construct:if
construct:implicit-loop
construct:implicit-none
construct:indexed
construct:integer
construct:intent
construct:invocation
construct:logical
construct:module
construct:number
construct:parameter
construct:return
construct:subtract
construct:then
construct:variable
construct:visibility
construct:while-loop
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:looping
ErikSchierboom commented 10 months ago

Exercise: high-scores

Code


module high_scores
  implicit none
contains

integer function latest(score_list)
  integer, dimension(:) :: score_list
  integer :: places

  places = size(score_list, dim=1)
  latest = score_list(places)
end function

function scores(score_list)
  integer, dimension(:) :: score_list
  integer, allocatable :: scores(:)
  allocate(scores(size(score_list, dim=1)))
  scores = score_list
end function

integer function personalBest(score_list)
  integer, dimension(:) :: score_list
  integer :: i
  personalBest = score_list(1)
  do i = 1, size(score_list, dim=1)
    if (score_list(i) > personalBest) then
      personalBest = score_list(i)
    end if
  end do
end function

function personalTopThree(score_list) result(tops)
  integer, dimension(:) :: score_list
  integer, dimension(3) :: tops
  integer :: i
  tops = 0
  if (size(score_list, dim=1) == 1) then
    tops(1) = score_list(1)
    return
  end if
  if (size(score_list, dim=1) == 2) then
    if (score_list(1) > score_list(2)) then
      tops(1) = score_list(1)
      tops(2) = score_list(2)
    else
      tops(1) = score_list(2)
      tops(2) = score_list(1)
    end if
    return
  end if

  tops = sortSmallList(score_list(1:3))

  do i = 4, size(score_list, dim=1)
    if (score_list(i) > tops(1)) then
      tops(3) = tops(2)
      tops(2) = tops(1)
      tops(1) = score_list(i)
    else if (score_list(i) > tops(2)) then
      tops(3) = tops(2)
      tops(2) = score_list(i)
    else if (score_list(i) > tops(3)) then
      tops(3) = score_list(i)
    end if
  end do
end function

function sortSmallList(score_list) result(sort)
  integer, dimension(3) :: score_list
  integer, dimension(3) :: sort

  if (score_list(3) >= score_list(2) .AND. score_list(3) >= score_list(1)) then
    ! Posicao 3 eh o maior de todos
    if (score_list(2) > score_list(1)) then
      ! Posicao 2 eh o segundo maior
      sort(1) = score_list(3)
      sort(2) = score_list(2)
      sort(3) = score_list(1)
    else
      ! Posicao 1 eh o segundo maior
      sort(1) = score_list(3)
      sort(2) = score_list(1)
      sort(3) = score_list(2)
    end if
  else if (score_list(2) >= score_list(1) .AND. score_list(2) >= score_list(3)) then
    ! Posicao 2 eh o maior de todos
    if (score_list(3) > score_list(1)) then
      ! Posicao 3 eh o segundo maior
      sort(1) = score_list(2)
      sort(2) = score_list(3)
      sort(3) = score_list(1)
    else
      ! Posicao 1 eh o segundo maior
      sort(1) = score_list(2)
      sort(2) = score_list(1)
      sort(3) = score_list(3)
    end if
  else
    ! Posicao 1 eh o maior de todos
    if (score_list(3) > score_list(2)) then
      ! Posicao 3 eh o segundo maior
      sort(1) = score_list(1)
      sort(2) = score_list(3)
      sort(3) = score_list(1)
    else
      ! Posicao 2 eh o segundo maior
      sort(1) = score_list(1)
      sort(2) = score_list(2)
      sort(3) = score_list(3)
    end if
  end if
end function

end module

Tags:

construct:allocate
construct:assignment
construct:boolean
construct:comment
construct:contains
construct:do-loop
construct:elseif
construct:end-function
construct:end-if
construct:end-module
construct:if-then-else
construct:implicit-assignment
construct:implicit-none
construct:integer
construct:invocation
construct:logical-constant
construct:module
construct:named-argument
construct:return
construct:sort
construct:variable
construct:visibility
paradigm:imperative
paradigm:declarative
paradigm:functional
technique:sorting
uses:sortSmallList
ErikSchierboom commented 10 months ago

Exercise: perfect-numbers

Code


module perfect_numbers
  implicit none

contains

  character(len=9) function classify(num)
    integer, intent(in) :: num
    integer, allocatable :: divs(:)
    integer :: total_sum, atempt

    if (num <= 0 ) then
      classify = "ERROR"
      return
    end if

    total_sum = 0
    do atempt = 1, num-1
      if (mod(num, atempt) == 0) then
        total_sum = total_sum + atempt
      end if
    end do

    if (total_sum == num) then
      classify = "perfect  "
    else if (total_sum > num) then
      classify = "abundant "
    else
      classify = "deficient"
    end if
  end function

end module

Tags:

construct:allocate
construct:assignment
construct:character
construct:do-loop
construct:elseif
construct:if-then-else
construct:implicit-none
construct:intent
construct:integer
construct:module
construct:parameter
construct:return
construct:string
construct:subtract
construct:variable
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:looping
ErikSchierboom commented 10 months ago

Exercise: isogram

Code

module isogram
   implicit none

contains

   function isIsogram(phrase) result(no_repeats)
      character(len=*), intent(in) :: phrase
      logical :: no_repeats
      logical :: mark(26)
      integer, parameter :: a_code = iachar("a")
      integer, parameter :: z_code = iachar("z")
      integer, parameter :: offset = (iachar("a") - 1)
      integer, parameter :: upper_a_code = iachar("A")
      integer, parameter :: upper_z_code = iachar("Z")
      integer, parameter :: upper_offset = (iachar("A") - 1)
      integer :: idx, code

      no_repeats = .true.

      if (len(phrase) == 0) then
         return
      end if

      mark = [(.false., idx=1, 26)]

      do idx = 1, len(phrase)
         code = iachar(phrase(idx:idx))
         select case (code)
         case (a_code:z_code)
            if (mark(code - offset)) then
               no_repeats = .false.
               return
            end if
            mark(code - offset) = .true.
         case (upper_a_code:upper_z_code)
            if (mark(code - upper_offset)) then
               no_repeats = .false.
               return
            end if
            mark(code - upper_offset) = .true.
         case default
            cycle
         end select
      end do

   end function isIsogram

end module isogram

Tags:

construct:assignment
construct:boolean
construct:character
construct:do-loop
construct:if-then-else
construct:implicit-none
construct:indexed-assignment
construct:integer
construct:intrinsics
construct:logical
construct:module
construct:parameter
construct:return
construct:select-case
construct:string
construct:subtract
construct:variable-assignment
construct:visibility-modifiers
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:looping
ErikSchierboom commented 10 months ago

Exercise: isogram

Code

module isogram
  implicit none
contains

  function isIsogram(phrase) result(no_repeats)
    character(len=*), intent(in) :: phrase
    logical :: no_repeats
    logical, dimension(26) :: has_occured 
    character :: c 
    integer ::  lt_no
    integer :: i
    no_repeats = .true.
    has_occured = (/(.false., I=1,26 )/)
    do i=1,len(phrase)
      c = phrase(i:i)
      if ((c>='a').and.(c<='z')) then
        lt_no = ichar(c) - ichar('a') + 1
        no_repeats = (no_repeats.and.(.not.(has_occured(lt_no))))
        has_occured(lt_no) = .true.
      else if ((c>='A').and.(c<='Z')) then
        lt_no = ichar(c) - ichar('A') + 1
        no_repeats = (no_repeats.and.(.not.(has_occured(lt_no))))
        has_occured(lt_no) = .true.
      end if
    end do
   end function isIsogram

end module isogram

Tags:

construct:assignment
construct:character
construct:do-loop
construct:if-then-else
construct:implicit-none
construct:indexed-assignment
construct:integer
construct:intrinsics
construct:logical
construct:module
construct:parameter
construct:rank
construct:result
construct:subtract
construct:variable-assignment
construct:visibility
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:boolean-logic
technique:looping
ErikSchierboom commented 9 months ago

This is an automated comment

Hello :wave: Next week we're going to start using the tagging work people are doing on these. If you've already completed the work, thank you! If you've not, but intend to this week, that's great! If you're not going to get round to doing it, and you've not yet posted a comment letting us know, could you please do so, so that we can find other people to do it. Thanks!