值日分配安排问题的逻辑

306908677

先试求出次数，使用递归程序试了好多种，最后发现都有逻辑错误＝＝ 还没办法改，请大牛指点一下这个程序的逻辑该怎么写－－＃

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

program main
implicit none
integer r,k,m
integer n
logical :: pe(7,7) = reshape( ((/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0&
,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)==1) , (/7,7/) )
logical :: lg(7,7) = reshape( ((/0,1,0,0,1,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0,1,0,1&
,0,0,1,0,0,1,0,1,0,0,1,0,0,0,1/)==1) , (/7,7/) )
n=7
m=0
k=1
call sub1(k,n,m)
print *,m

contains 
recursive subroutine sub1(k,n,m)
implicit none
integer n,k,i,r,q,m
        if (lg(k,1).and.k<8)        then
        lg(k,1)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,2).and.k<8)        then
        lg(k,2)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,3).and.k<8)        then
        lg(k,3)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,4).and.k<8)        then
        lg(k,4)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,5).and.k<8)        then
        lg(k,5)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,6).and.k<8)        then
        lg(k,6)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if
        if (lg(k,7).and.k<8)        then
        lg(k,7)=.false.
        k=k+1
                if(k==7)then
                m=m+1
                end if
        call sub1(k,n,m)
        end if

end subroutine
end program main

	周一	周二	周三	周四	周五	周六	周日
同学1	×	√	×	√	×	×	×
同学2	√	×	×	×	×	√	×
同学3	×	×	√	×	×	×	√
同学4	×	×	×	×	√	×	×
同学5	√	×	×	√	×	√	×
同学6	×	√	×	×	√	×	×
同学7	×	×	√	×	×	√	√

为保证每名同学一周之内必须值日一天，请编写程序计算所有合理的安排方案的个数，并将所有的安排方案打印在屏幕上。   

百事可乐

我愣是没看懂楼主的需求？要实现什么呢？建议楼主再详细描述一下。

PS：楼主那七段 if  if  call  完全可以用 do  循环实现的。

306908677

3. 有7个同学轮流值日，为了和其他任务不冲突，各人将有空的天数罗列成表：

        周一        周二        周三        周四        周五        周六        周日
同学1        ×        √        ×        √        ×        ×        ×
同学2        √        ×        ×        ×        ×        √        ×
同学3        ×        ×        √        ×        ×        ×        √
同学4        ×        ×        ×        ×        √        ×        ×
同学5        √        ×        ×        √        ×        √        ×
同学6        ×        √        ×        ×        √        ×        ×
同学7        ×        ×        √        ×        ×        √        √
为保证每名同学一周之内必须值日一天，请编写程序计算所有合理的安排方案的个数，并将所有的安排方案打印在屏幕上。（共15分）（本题记分，请找老师检查）

我先试着写算出安排方案＝＝
用了do循环＝＝还是不对诶

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

program main
implicit none
integer r,k,m
integer n
logical :: pe(7,7) = reshape( ((/0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0&
,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0/)==1) , (/7,7/) )
logical :: lg(7,7) = reshape( ((/0,1,0,0,1,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0,1,0,1&
,0,0,1,0,0,1,0,1,0,0,1,0,0,0,1/)==1) , (/7,7/) )
n=7
m=0
k=1
call sub1(k,n,m)
print *,m

contains 
recursive subroutine sub1(k,n,m)
implicit none
integer n,k,i,r,q,m
do i=1,n
	if (lg(k,i).and.k<8)	then
	lg(k,i)=.false.
	k=k+1
		if(k==7)then
		m=m+1
		write(*,"(7l1//7l1//7l1//7l1)") ((lg(r,q),q=1,7),r=1,7)
		k=1
		else
		call sub1(k,n,m)
		end if
	end if
end do
end subroutine
end program main

306908677

百事可乐 发表于 2014-11-29 10:36
我愣是没看懂楼主的需求？要实现什么呢？建议楼主再详细描述一下。

PS：楼主那七段 if  if  call  完全可 ...

＝＝修改了一下＝＝

百事可乐

我觉得吧,你不应该对 lg 数组进行修改.这是原始数据啊....输出的时候，也不应该输出 lg

下面的代码不知道是不是你想要的意思？

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

program main
  implicit none
  Integer , parameter :: NDay = 7 ! 7 天
  Integer , parameter :: NMan = 7 ! 7 个人
  logical :: bIdle(NMan,NDay) = reshape( ((/0,1,0,0,1,0,0,1,0,0,0,0,1,0,0,0,1,0,0,0,1,1,0,0,0,1,0,0,0,0,0,1,0,1&
  ,0,0,1,0,0,1,0,1,0,0,1,0,0,0,1/)==1) , (/NMan,NDay/) )
  integer :: arrange(NDay) , nArrg = 0  ! 当前的安排，有效的安排个数
  arrange(:) = 0
  call sub1( arrange , 1 ) ! 安排第一天
  print * , nArrg
contains 
  recursive subroutine sub1( arr , iDay )
    implicit none
    integer , intent( IN ) :: iDay
    integer , intent( INOUT ) :: arr(:)
    integer :: i
    Do i = 1 , NMan
     if ( bIdle(i,iDay) .and. & ! 如果该人该天有空 
        ( all(arr(1:iDay)/=i) ) & ! 且以前没安排过该人
        ) then
        arr(iDay) = i ! 当天安排该人
        If ( iDay < NDay ) then  ! 如果没安排完
          call sub1( arr , iDay+1) ! 安排下一天
        Else ! 否则安排完了
          write(*,"(7i2)") arr(:) ! 输出
          nArrg = nArrg + 1 ! 合理安排个数 + 1
        End If
        arr(iDay) = 0 ! 取消该天安排，以便列举安排其他人的情况
      end if
    End Do
  end subroutine
  
end program main

输出 4 种安排，每一行表示一种安排，7个数字代表7天，每个数字表示该天由几号学生值日。
2 6 3 1 4 5 7
2 6 7 1 4 5 3
5 6 3 1 4 2 7
5 6 7 1 4 2 3
           4

306908677

百事可乐 发表于 2014-11-29 11:56
我觉得吧,你不应该对 lg 数组进行修改.这是原始数据啊....输出的时候，也不应该输出 lg

下面的代码不知道 ...

实在太感谢你了！
看完发现原来可以用all来判断一行（19 ( all(arr(1:iDay)/=i) ) & ! 且以前没安排过该人）
一直在找其他复杂的写法替代。。。
还有看完你的代码发现代码真的是有美丑之分的，真是学习了！！＝＝
再次感谢～