Fortran Coder

查看: 185|回复: 6

[通用算法] 自己编写的链表类

[复制链接]

18

帖子

5

主题

0

精华

熟手

F 币
187 元
贡献
126 点
发表于 2018-9-1 03:50:14 | 显示全部楼层 |阅读模式
本帖最后由 weixing1531 于 2018-9-1 11:48 编辑

最近在学习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





评分

参与人数 1F 币 +12 贡献 +12 收起 理由
fcode + 12 + 12 很给力!

查看全部评分

回复

使用道具 举报

1314

帖子

12

主题

5

精华

论坛跑堂

Fcode跑堂伙计

F 币
156 元
贡献
219 点

新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

发表于 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

18

帖子

5

主题

0

精华

熟手

F 币
187 元
贡献
126 点
 楼主| 发表于 2018-9-1 09:25:27 | 显示全部楼层
fcode 发表于 2018-9-1 08:13
不错,有三个建议:
1. 为什么 ToArray 不使用 people%ToArray(a) 的形式?
2. 对于封装类的 Module 来说, ...

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

1314

帖子

12

主题

5

精华

论坛跑堂

Fcode跑堂伙计

F 币
156 元
贡献
219 点

新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

发表于 2018-9-1 09:32:19 | 显示全部楼层
今年手边有个项目挺急的。做完会有一些时间。

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

465

帖子

3

主题

0

精华

大宗师

F 币
3150 元
贡献
1867 点

水王勋章元老勋章热心勋章

发表于 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%

1314

帖子

12

主题

5

精华

论坛跑堂

Fcode跑堂伙计

F 币
156 元
贡献
219 点

新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

发表于 2018-9-1 23:16:31 | 显示全部楼层
楼上给出的模板类还是不错的,适合多种数据类型。值得借鉴

18

帖子

5

主题

0

精华

熟手

F 币
187 元
贡献
126 点
 楼主| 发表于 2018-9-3 20:10:10 | 显示全部楼层
pasuka 发表于 2018-9-1 18:17
1、面向对象不是必须,C写的链表,总共不到1k行
https://github.com/troydhanson/uthash/blob/master/src/u ...

先求己后求人
自己写写有利于理解
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

QQ|捐赠本站|Archiver|关于我们 About Us|群聊|Fcode

GMT+8, 2018-11-16 22:26

Powered by Discuz! X3.2

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表