自己编写的链表类

weixing1531

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

源代码如下：

[Fortran] 纯文本查看 复制代码

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([3.,4.])
    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

不错，有三个建议：
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

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

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

fcode

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

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

pasuka

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

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

weixing1531

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

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

simba163

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

simba163

将
        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