自己编写的链表类

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

weixing1531

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

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

weixing1531

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

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