自己编写的链表类-Fortran算法研究-专业Fortran论坛

weixing1531 发表于 2018-9-1 03:50:14

自己编写的链表类

本帖最后由 weixing1531 于 2018-9-1 11:48 编辑

最近在学习FORTRAN2003面向对象
尝试自己编写了一个简单的链表类

源代码如下：
module list_class !链表类
implicit none
private

type,private::node
   private
   real::datas
   type(node),pointer::next
end type node

type,public::list
   private
   type(node),pointer::head
contains
   procedure,public,pass::Create,ToArray,Lenth,Search,Output,Cut,Insert,Get
   final::Destroy !析构函数
end type list
contains
subroutine Create(this,a) !构造函数可由一维数组初始化链表
   class(list)::this
   real,optional,intent(in)::a(:)
   integer::i

   allocate(this%head)
   nullify(this%head)

   if(present(a))then
         do i=1,size(a)
            call Insert(this,i-1,a(i)) ! 第i-1个元素后插入a(i)
         end do
   end if
end subroutine Create

subroutine ToArray(this,a) !链表转换成一维数组
   class(list)::this
   real,allocatable,intent(out)::a(:)
   integer::i,len

   len=Lenth(this)
   allocate(a(len))

   do i=1,len
         a(i)=Get(this,i)
   end do
end subroutine ToArray

integer function Lenth(this) result(len) !取得链表长度
   class(list)::this
   type(node),pointer::p

   len=0
   p=>this%head

   do while(associated(p))
         len=len+1
         p=>p%next
   end do
end function Lenth

integer function Search(this,x) result(index) !返回搜索值的索引
   class(list)::this
   real,intent(in)::x
   type(node),pointer::p

   index=1
   p=>this%head

   do while(associated(p).and.abs(p%datas-x)>0.0001)
         p=>p%next
         index=index+1
   end do

   if(.not.associated(p))index=0 !若返回0代表没有找到
end function Search

subroutine OutPut(this) !输出链表
   class(list)::this
   type(node),pointer::p

   p=>this%head
   write(*,*)"List:"

   do while(associated(p))
         write(*,*)p%datas
         p=>p%next
   end do
end subroutine OutPut

subroutine Cut(this,k) !删除指定索引的元素
   class(list)::this
   integer,intent(in)::k
   integer::index
   type(node),pointer::p,q

   p=>this%head
   q=>p
   index=1

   if(k<1.or.(.not.associated(p)))then
         write(*,*)'out of bound'
         stop
   end if

   if(k==1)then
         this%head=>p%next
   else
         do while(index<k-1.and.associated(q))
            q=q%next
            index=index+1
         end do

         if(.not.associated(q).or.(.not.associated(q%next)))then
            write(*,*)'out of bound'
            stop
         end if

         p=>q%next
         q%next=>p%next
   end if

   deallocate(p)
end subroutine Cut

subroutine Insert(this,k,x) !在指定索引后面插入数据(若k=0则代表插入的数据将作为第1个元素)
   class(list)::this
   integer,intent(in)::k
   real,intent(in)::x
   type(node),pointer::p,q
   integer::index

   if(k<0)then
         write(*,*)'out of bound'
         stop
   end if

   p=>this%head
   index=1

   do while(index<k.and.associated(p))
         p=>p%next
         index=index+1
   end do

   if(k>0.and.(.not.associated(p)))then
         write(*,*)'out of bound'
         stop
   end if

   allocate(q)
   q%datas=x
   nullify(q%next)

   if(k>0)then
         q%next=>p%next
         p%next=>q
   else
         q%next=>this%head
         this%head=>q
   end if
end subroutine Insert

real function Get(this,k) result(x) !获得指定索引的元素值
   class(list)::this
   integer,intent(in)::k
   integer::index
   type(node),pointer::p

   index=1
   p=>this%head

   if(k<1.or.(.not.associated(p)))then
         write(*,*)'out of bound'
         stop
   end if

   do while(associated(p).and.index<k)
         p=>p%next
         index=index+1
   end do

   if(.not.associated(p))then
         write(*,*)'out of bound'
         stop
   end if

   x=p%datas
end function Get

subroutine Destroy(this) !析构函数
   type(list),intent(in out)::this !注意不能为class(list)
   type(node),pointer::p

   do while(associated(this%head))
         p=>this%head%next
         deallocate(this%head)
         this%head=>p
   end do
end subroutine Destroy
end module list_class

program main
use list_class
implicit none

type(list),allocatable::people
real,allocatable::a(:)

allocate(people)
call people%Create()
call people%Insert(0,1.)
call people%Insert(1,2.)
write(*,*)"Lenth of the List:",people%Lenth()
write(*,*)people%Search(1.)
write(*,*)people%Get(2)
call people%OutPut()
call people%ToArray(a)
write(*,*)"Array:",a(size(a):1:-1) !反向输出数组元素

call people%Cut(1)
write(*,*)"Lenth of the List:",people%Lenth()
call people%OutPut()
call people%ToArray(a)
write(*,*)"Array:",a(size(a):1:-1) !反向输出数组元素
deallocate(a)
deallocate(people)
end program main

fcode 发表于 2018-9-1 08:13:59

不错，有三个建议：
1. 为什么 ToArray 不使用 people%ToArray(a) 的形式？
2. 对于封装类的 Module 来说，最好是 private 的。所以建议第3 行，加一个 private。
这样多个类里，就可以同时有 destory、Create 函数而互不影响。

3. 作为 final 的函数，不应该显示调用它，而应该让编译器自动调用。
你只需要
type(list),allocatable::people
Allocate(people)
当 Deallocate(people) 时，就会自动 final 而调用 Destory

weixing1531 发表于 2018-9-1 09:25:27

fcode 发表于 2018-9-1 08:13
不错，有三个建议：
1. 为什么 ToArray 不使用 people%ToArray(a) 的形式？
2. 对于封装类的 Module 来说， ...

上述三个建议，已经按照要求修改
Fortran现在学习资料太少
有时看教科书、看规范也一知半懂
望版主制作的学习视频面向对象部分尽快完成

fcode 发表于 2018-9-1 09:32:19

今年手边有个项目挺急的。做完会有一些时间。

资料的话可以看《modern fortran explained》

pasuka 发表于 2018-9-1 18:17:07

1、面向对象不是必须，C写的链表，总共不到1k行
https://github.com/troydhanson/uthash/blob/master/src/utlist.h
2、上次给的Fortran模板库就有链表，为啥不看看呢？也不到1k行
https://github.com/robertrueger/ ... tlList.F90_template
btw，Fortran学习资料少不是挺好嘛，专心翻阅消化我之前贴过的那几个面向对象Fortran开源项目就行
lz若能啃下其中任何一个，那么Fortran编程能力完全可以跻身东北亚地区在职的Fortran编程人员前25%

fcode 发表于 2018-9-1 23:16:31

楼上给出的模板类还是不错的，适合多种数据类型。值得借鉴

weixing1531 发表于 2018-9-3 20:10:10

pasuka 发表于 2018-9-1 18:17
1、面向对象不是必须，C写的链表，总共不到1k行
https://github.com/troydhanson/uthash/blob/master/src/u ...

先求己后求人
自己写写有利于理解

simba163 发表于 2019-6-14 09:41:57

编译报错是啥原因呢？
error #8259: The type bound procedure definition statement must contains only one binding name.

simba163 发表于 2019-6-14 09:44:47

将
   procedure,public,pass::Create,ToArray,Lenth,Search,Output,Cut,Insert,Get
改成下面形式就对了，感觉不解。
   procedure,public,pass::Create
   procedure,public,pass::ToArray
   procedure,public,pass::Lenth
   procedure,public,pass::Search
   procedure,public,pass::Output
   procedure,public,pass::Cut
   procedure,public,pass::Insert
   procedure,public,pass::Get

页: [1]

Fortran Coder's Archiver

自己编写的链表类