QuickSort και χρονομέτρηση (Αγγλικές εντολές)

Επισκόπηση προηγούμενης Θ.Ενότητας Επισκόπηση επόμενης Θ.Ενότητας Πήγαινε κάτω

QuickSort και χρονομέτρηση (Αγγλικές εντολές)

Δημοσίευση από m2000 Την / Το Τρι Ιουν 21, 2016 8:29 pm

\\ Quick Sort - M2000 code
\\ using local calls
Module QuickSort {
      \\ A(), M and N are visible with call local
      Function QuickSort {
             Read New p,r
             Local q
             if p < r Then {
                  Call local partition(p, r, &q)
                  Call local Quicksort(p, q - 1)
                  Call local Quicksort(q + 1, r)
                }
      }
      Function partition {
             Read New p, r, &q
             local x, i, j
               x = A(r)
               i = p-1
               for j=p to r-1 {
                   i++
                   select case compare(A(j) ,x)
                   case N
                              i--
                   case M
                           Swap A(i),A(j)
                    end select
                   }
            Swap A(i+1),A(r)
            q=i+1
      }
     way$="Up"
     Read &A()
     If match("S") then Read way$
     way$=ucase$(way$)
      If way$="UP" then {
            N=1
      } else.if way$="DOWN" then {
            N=-1
      } else {
            Error "not known option"
      }
      M=-N
      Call Local QuickSort(0, dimension(A(),1)-1)
}
Form 80,50
Dim arr(10), old()
arr(0)=23,21,1,4,2,3,102,54,26,9
old()=arr()
Profiler
      Quicksort &arr()
Print str$(timecount,"0")
Profiler
      Quicksort &arr()
Print str$(timecount,"0") , " time to sort already sorted array"
For i=0 to 9
      Print arr(i), old(i)
next i
old()=arr()
Profiler
      Quicksort &arr(), "down"
Print str$(timecount,"0")
Profiler
      Quicksort &arr(), "down"
Print str$(timecount,"0") , " time to sort already sorted array"
For i=0 to 9
      Print arr(i), old(i)
next i
Dim arr(10)=1
old()=arr()
Profiler
      Quicksort &arr(), "down"
Print str$(timecount,"0") , " time to sort all items equal"
For i=0 to 9
      Print arr(i), old(i)
next i
avatar
m2000
Admin

Posts : 26
Join date : 10/06/2016
Age : 50
Location : Kanallaki Greece

http://m2000.forumgreek.com

Επιστροφή στην κορυφή Πήγαινε κάτω

Επισκόπηση προηγούμενης Θ.Ενότητας Επισκόπηση επόμενης Θ.Ενότητας Επιστροφή στην κορυφή


 
Δικαιώματα σας στην κατηγορία αυτή
Δεν μπορείτε να απαντήσετε στα Θέματα αυτής της Δ.Συζήτησης