diff --git a/Sonderuebung/SoSe2024/SU_2024_06_26/sorting.f95 b/Sonderuebung/SoSe2024/SU_2024_06_26/sorting.f95 new file mode 100644 index 0000000000000000000000000000000000000000..75db99a029241cda0974a5eae5194491308f73b6 --- /dev/null +++ b/Sonderuebung/SoSe2024/SU_2024_06_26/sorting.f95 @@ -0,0 +1,262 @@ +module sort_mod + implicit none + + private + public :: get, put, selection, bubblesort, insertionsort, quicksword + + interface get + module procedure get_vec + end interface + + interface put + module procedure put_vec + end interface + + contains + + subroutine swap (A, i, j) + ! tauscht die Einträger des Vektors A an den Stellen i und j + + integer, dimension(:), intent(inout) :: A + integer, intent(in) :: i, j + integer :: help + + help = A(i) + A(i) = A(j) + A(j) = help + end subroutine swap + + subroutine get_vec (A) + integer, dimension(:), allocatable, intent(out) :: A + integer :: n + + write(*,*) " Wie viele Einträge?" + read(*,*) n + + allocate (A(n)) + + write(*,*) "Gebe Eintragsweise die Elemente ein. (INTEGERS)" + read(*,*) A + + end subroutine get_vec + + + subroutine put_vec (A) + integer, dimension(:), intent(in) :: A + + write(*,*) A + end subroutine put_vec + + + + subroutine selection(list) + integer, dimension(:), intent(inout) :: list + integer :: n, max, i, j, maxin + + n=size(list) + do j = 0, n-2 ! Makroschritt + max = list(1) + maxin = 1 + do i = 2, n-j ! Mikroschritt -> suche das Max im unsortierten Bereich + if (list(i)>max) then + maxin = i + max = list(i) + end if + end do + call swap(list, maxin, n-j) ! Tausche das Max an das Ende des unsortierten Bereichs + end do + + end subroutine + + + subroutine bubblesort(list) + + integer, dimension(:), intent(inout) :: list + integer :: i, j + + do i = size(list), 2, -1 ! Makroschritt + do j = 1, i-1 ! Microschritt -> Max Wert "steigt" bis zum Ende des unsortierten Bereichs auf + if (list(j) > list(j+1)) call swap(list, j, j+1) + end do + end do + + end subroutine + + + subroutine insertionsort (A) + integer, dimension(:), intent(inout) :: A + integer :: i, j, pos + + do i = size(A,1) - 1, 1, -1 ! i ist das letzte Element des unsortierten Bereichs + + pos = size(A,1) ! Falls A(i) > A(size(A,1)) + + do j = i + 1 , size(A,1) ! Mikroschritt -> suche die Richtige Position im Sortierten Bereich + + if (A(i) <= A(j)) then ! A(j-1) < A(i) <= A(j) + pos = j - 1 + exit + end if + end do + + j = A(i) ! Zwischenspeicher + A(i:pos - 1) = A(i + 1:pos) ! alle Werte vor der Position eins nach links schieben + A(pos) = j + + end do + + end subroutine insertionsort + + + recursive subroutine recsword(list, left, right) + integer, dimension(:), intent(inout) :: list + integer, intent(in) :: left, right + integer :: i, j, pivot + + i = left + j = right + pivot = list((left+right)/2) + + do + do while (list(i) < pivot); i = i + 1; end do + do while (list(j) > pivot); j = j - 1; end do + if (i <= j) then + call swap(list, i, j) + i = i + 1 + j = j - 1 + end if + if (i > j) exit + end do + + if (left < j) call recsword(list, left, j) + if (right > i) call recsword(list, i, right) + end subroutine + + subroutine quicksword(list) + integer, dimension(:), intent(inout) :: list + call recsword(list, 1, size(list)) + end subroutine + + + + function merge_s(l_r, l_l) + integer, dimension(:), intent(in) :: l_r, l_l + integer, dimension(size(l_r, 1) + size(l_l, 1)) :: merge_s + integer :: c, l, r, i, n, m + + ! Länge der rechten und linken Liste + n = size(l_r, 1) + m = size(l_l, 1) + + ! Zählvariablen Position in den Listen + c = 1 + l = 1 + r = 1 + + ! Kleineres Element wird in neue Liste geschrieben + do while (n >= r .and. m >= l) + if (l_r(r) > l_l(l)) then + merge_s(c) = l_l(l) + c = c + 1 + l = l + 1 + else + merge_s(c) = l_r(r) + c = c + 1 + r = r + 1 + end if + end do + + ! Übrigen Elemente werden angehangen (ist vorsortiert) + do i=l, m + merge_s(c) = l_l(i) + c = c + 1 + end do + + do i=r, n + merge_s(c) = l_r(i) + c = c + 1 + end do + + end function merge_s + + + recursive subroutine merge_sort(list) + integer, dimension(:), intent(inout) :: list + integer, dimension(:), allocatable :: l_r, l_l + integer :: i, j, n + + n = size(list, 1) + + ! Wenn Liste leer, dann gibts nichts zu sortieren + if (n <= 1) then + return + ! Sonst aufspalten in zwei Teillisten + else + i = n/2 + j = n-i + allocate(l_r(i)) + allocate(l_l(j)) + l_r = list(1:i) + l_l = list(i+1:n) + call merge_sort(l_r) + call merge_sort(l_l) + ! Fügen Teillisten wieder zusammen + list = merge_s(l_r, l_l) + end if + + end subroutine merge_sort + + + + + subroutine buildheap(list) !ursprungsliste zu heap machen + integer, dimension(:), intent(inout) :: list + integer :: n, i + + n = size(list,1) + do i = n/2, 1, -1 + call heapify(list, i, 0) + end do + end subroutine + + recursive subroutine heapify(list, i, b) !rekursive knoten sinken lassen + integer, dimension(:), intent(inout) :: list + integer, intent(in) :: i, b !b als trennung zur schon sortieren liste + integer :: maxin + maxin = i + + if (2*i <= size(list,1)-b .and. list(2*i)>list(i)) maxin = 2*i + if (2*i+1 <= size(list,1)-b .and. list(2*i+1)>list(maxin)) maxin = 2*i+1 + if (maxin /= i) then + call swap(list, i, maxin) + call heapify(list, maxin, b) + end if + end subroutine + + subroutine heap(list) + integer, dimension(:), intent(inout) :: list + integer :: i, n + + n = size(list) + call buildheap(list) + call put_vec(list) + do i = 0, n-2 + call swap(list, 1, n-i) + call heapify(list, 1, i+1) + end do + end subroutine + + +end module sort_mod + +program main + use sort_mod + implicit none + + integer, dimension(:), allocatable :: A + + call get(A) + ! sortieralgorithmus aufrufen + call put(A) + +end program main \ No newline at end of file