[心得] 可直接使用的快速排序法

看板Fortran作者fragmentwing (片翼碎夢)時間1年前 (2022/11/26 15:49)推噓0(0推 0噓 1→)

留言1則, 1人參與討論串1/2 (看更多)

最近又開始回鍋寫fortran了，總覺得該偶爾產點文章回饋板上免得哪天廢板了 (今年快結束了這還只是板上本年度第四篇嗎!?) 這次帶來的是部分自寫，在快排部分則使用板上前面幾篇提到的副程式的程式文章:[問題] 這支快速排序法的副程式怎麼使用如果是vscode的使用者，生成執行檔(exe)後可以直接拿來給別人用廢話講滿久的了，以下正文其實這個程式我主要是下苦工在讀檔方面只要在雙精度以下的浮點數，並且檔案內容為完整的m*n矩陣就能執行排序 (陣列內東缺西缺的話麻煩自己補值) 藉由write的第一格其實除了能塞代號外還能塞文字變數來改寫的功能來實現自動偵測浮點數格式的功能並且藉由write第二格也能使用文字變數的功能來實現使用被讀取檔格式的功能 (不過還是有一些地方怪怪的，吃進來的數據還是會和原數據在最後面有點不一樣) 然後如果想測試又懶得寫測試檔，我會在下面一併附上測試檔會產生三個檔案:rand1.txt rand2.txt rand3.txt 照著程式運作時的說明輸入檔案名來測試就行了有進一步改寫的需求的人，以下是建議: 1.主程式的real*8，副程式的real*8都要一致 2.第二個容易產生錯誤的地方是把格式寫入forma這個變數的時候寫入的格式不對 (以上都是來自我自己在real和real*8間進行轉換時遇到錯誤的經驗) 另外，格式f08.05能帶來與f8.5一樣的格式化輸出所以這個程式對單精度的數據一樣能成立 program main implicit none character(len=50) :: fname character(len=10) :: forma character(len=1) :: digi character(len=1) :: choice integer :: raws,cols,stat,total,i,j,space,decimal,digits,number real*8 :: r real*8,allocatable :: arr(:) data forma /'(f??.??)'/ 100 write(*,*) "please enter the file name(including file type) for sorting." read(*,*) fname raws=0 open(13,file = fname,status='unknown') do while(.true.) read(13,*,iostat=stat) if(stat.ne.0) exit raws = raws + 1 end do rewind(13) ! read data format, by space, decimal, digits respectly ! space space = 0 do while(.true.) read(13,'(a1)',advance='no') digi if(digi.ne.' ') exit space = space + 1 end do write(*,*) "space=",space ! decimal decimal = space + 1 do while(.true.) read(13,'(a1)',advance='no') digi decimal = decimal + 1 if(digi.eq.'.') exit end do write(*,*) "decimal=",decimal ! digits digits = decimal do while(.true.) read(13,'(a1)',advance='no',iostat=stat) digi if(stat.ne.0) exit if(digi.eq.' ') exit digits = digits + 1 end do write(*,*) "digits=",digits rewind(13) write(forma(3:4),'(i2)') digits write(forma(6:7),'(i2)') digits - decimal write(*,*) "data format: ",forma read(13,forma) r write(*,*) "first data =",r rewind(13) cols=0 do while(.true.) read(13,forma,advance='no',iostat=stat) r if(stat.ne.0) exit cols = cols + 1 end do rewind(13) cols = cols total=cols*raws write(*,*) "This file have",total,"data" write(*,*) "2D-data array =",cols,"x",raws write(*,*) "Initiating quick sort" allocate(arr(total)) ! x data in one line means one line have x + 1 words number = 0 cols = cols + 1 do i = 1,raws do j = 1,cols read(13,forma,advance='no',iostat=stat) r if(stat.ne.0) cycle number = number + 1 arr(number) = r end do end do close(13) call quicksort(arr,1,total) write(*,*) "Sorting complete, write the result in txtfile(y) or show the result on board(other). " read(*,*) choice if(choice.eq.'y')then write(*,*) "Please enter the filename(including file type)." read(*,*) fname open(14,file = fname,status='unknown') do i = 1,total write(14,*) arr(i) end do else do i = 1,total write(*,*) arr(i) end do end if close(14) deallocate(arr) write(*,*) "Press (c) to continue, press other key to end the program." read(*,*) choice if(choice.eq.'c') goto 100 stop end program recursive subroutine quicksort(a, first, last) implicit none real*8 a(*), x, t integer first, last integer i, j x = a( (first+last) / 2 ) i = first j = last do while(.true.) do while (a(i) < x) i=i+1 end do do while (x < a(j)) j=j-1 end do if (i >= j) exit t = a(i); a(i) = a(j); a(j) = t i=i+1 j=j-1 end do if (first < i-1) call quicksort(a, first, i-1) if (j+1 < last) call quicksort(a, j+1, last) end subroutine quicksort 以下是測試生成檔 program main implicit none real :: r(30) real*8 :: rr(40) integer :: i,j,total call random_seed() total = 0 call random_number(r) open(13,file='rand1.txt',status='unknown') do i = 1,3 do j = 1,10 total = total + 1 write(13,'(f14.8)',advance='no') r(total) end do write(13,*) "" end do close(13) call random_number(r) open(14,file='rand2.txt',status='unknown') do i = 1,30 write(14,'(f13.8)') r(i)*100 end do close(14) total = 0 call random_number(rr) open(15,file='rand3.txt',status='unknown') do i = 1,8 do j = 1,5 total = total + 1 write(15,'(f17.14)') rr(total) end do end do stop end program main -- https://i.imgur.com/h4Q0F04.jpg