新しく発言する EXIT インデックスへ

日数計算

　　日数計算 しばっち 2008/03/30 19:32:26 
　　└続き しばっち 2008/03/30 19:33:05 
　　　└西暦1年1月1日からの日数から西暦年月日に変... 山中和義 2008/04/01 12:02:19  (修正1回)
　　　　├!経過年月日の計算 山中和義 2008/04/01 16:09:28  (修正2回)
　　　　└!日付関連のサブルーチン 山中和義 2008/04/02 15:36:28 
　　　　　└つづき（使用例、カレンダー） 山中和義 2008/04/02 15:38:11 

　　日数計算 しばっち 2008/03/30 19:32:26   ツリーへ
日数計算 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/03/30 19:32:26
LET MODE=0
SELECT CASE MODE
CASE 0
INPUT PROMPT "西暦　年、月、日 ": Y, M, N !' 1900<=Y<=2100 1<=M<=12 1<=N<=31
INPUT PROMPT "何日後=":Z
LET L=NISSUU(Y,M,N)+Z
LET YY=YEAR(L)
LET MM=MONTH(L)
LET DD=DAY(L)
PRINT Y;"年";M;"月";N;"日(";WEEK$(Y,M,N);"曜日)"
IF Z>0 THEN PRINT Z;"日後は" ELSE PRINT -Z;"日前は"
PRINT YY;"年";MM;"月";DD;"日 ";WEEK$(YY,MM,DD);"曜日です"
CASE 1
INPUT PROMPT "(1)西暦　年、月、日 ": Y1, M1, N1
INPUT PROMPT "(2)西暦　年、月、日 ": Y2, M2, N2
PRINT Y1;"年";M1;"月";N1;"日(";WEEK$(Y1,M1,N1);"曜日)から"
PRINT Y2;"年";M2;"月";N2;"日(";WEEK$(Y2,M2,N2);"曜日)までの"
PRINT "日数は";NISSUU(Y2,M2,N2)-NISSUU(Y1,M1,N1);"日です"
END SELECT
END

EXTERNAL FUNCTION NISSUU(Y,M,N)
DIM D(12), DD(12)
FOR I=1 TO 12
READ D(I)
NEXT I
DATA 0,31,59,90,120,151,181,212,243,273,304,334
FOR I=1 TO 12
READ DD(I)
NEXT I
DATA 31,28,31,30,31,30,31,31,30,31,30,31
LET YL = Y - 1
LET Z = 365 * YL + D(M) + N + INT(YL / 4) + INT(YL / 400) - INT(YL / 100)
IF MOD(Y , 4) = 0 THEN
IF MOD(Y , 100) <> 0 THEN
IF M > 2 THEN
LET Z = Z + 1
END IF
END IF
END IF
IF MOD(Y , 400) = 0 THEN
IF M > 2 THEN
LET Z = Z + 1
END IF
END IF
LET NISSUU=Z
END FUNCTION

EXTERNAL FUNCTION YEAR(ZZ)
LET YA = 1900 !'1900年から
LET YB = 2100 !'2100年まで
DO
LET YY = INT((YA + YB) / 2)
LET YL = YY - 1
LET Z = 365 * YL + INT(YL / 4) + INT(YL / 400) - INT(YL / 100) + 1
IF ZZ - Z >= 0 AND ZZ - Z <= 365 THEN EXIT DO
IF Z - ZZ < 0 THEN LET YA = YY ELSE LET YB = YY
IF YA + 1 = YB THEN LET YA = YB
LOOP UNTIL YA=YB
LET YEAR=YY
END FUNCTION

EXTERNAL FUNCTION MONTH(ZZ)
DIM D(12), DD(12)
FOR I=1 TO 12
READ D(I)
NEXT I
DATA 0,31,59,90,120,151,181,212,243,273,304,334
FOR I=1 TO 12
READ DD(I)
NEXT I
DATA 31,28,31,30,31,30,31,31,30,31,30,31
LET YY=YEAR(ZZ)
LET YL = YY - 1
LET Z = 365 * YL + INT(YL / 4) + INT(YL / 400) - INT(YL / 100) + 1
FOR MM = 1 TO 12
IF FLAG = 0 THEN
IF MOD(YY , 4) = 0 AND MOD(YY , 100) <> 0 THEN
LET DD(2) = 29
IF MM > 2 THEN
LET Z = Z + 1
LET FLAG = 1
END IF
END IF
IF MOD(YY , 400) = 0 THEN
LET DD(2) = 29
IF MM > 2 THEN
LET Z = Z + 1
LET FLAG = 1
END IF
END IF
END IF
IF ZZ - (Z + D(MM)) < DD(MM) THEN
LET MONTH=MM
EXIT FUNCTION
END IF
NEXT MM
STOP !' ERROR
END FUNCTION
 
　　└続き しばっち 2008/03/30 19:33:05   ツリーへ
Re: 日数計算 返事を書く ノートメニュー
しばっち <dihjvcfsyu> 2008/03/30 19:33:05
続き


EXTERNAL FUNCTION DAY(ZZ)
DIM D(12), DD(12)
FOR I=1 TO 12
READ D(I)
NEXT I
DATA 0,31,59,90,120,151,181,212,243,273,304,334
FOR I=1 TO 12
READ DD(I)
NEXT I
DATA 31,28,31,30,31,30,31,31,30,31,30,31
LET YY=YEAR(ZZ)
LET MM=MONTH(ZZ)
LET YL = YY - 1
LET Z = 365 * YL + INT(YL / 4) + INT(YL / 400) - INT(YL / 100) + 1
IF MOD(YY , 4) = 0 AND MOD(YY , 100) <> 0 THEN
LET DD(2) = 29
IF MM > 2 THEN LET Z = Z + 1
END IF
IF MOD(YY , 400) = 0 THEN
LET DD(2) = 29
IF MM > 2 THEN LET Z = Z + 1
END IF
LET DAY = ZZ - (Z + D(MM)) + 1
END FUNCTION

EXTERNAL FUNCTION WEEK$(Y,M,D)
IF M<3 THEN
LET YY=Y-1
LET MM=M+12
ELSE
LET YY=Y
LET MM=M
END IF
LET ZELLER=MOD(YY+INT(YY/4)-INT(YY/100)+INT(YY/400)+INT((13*MM+8)/5)+D,7) !'ツェラーの公式
LET WEEK$=MID$("日月火水木金土",ZELLER+1,1)
END FUNCTION
 
　　　└西暦1年1月1日からの日数から西暦年月日に変... 山中和義 2008/04/01 12:02:19  (修正1回)  ツリーへ
Re: 続き 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/04/01 12:02:19 ** この記事は1回修正されてます
西暦1年1月1日からの日数から西暦年月日に変換する部分を修正してみました。

２分探索による挟み込みで該当年月を絞り込みます。

関数DateFrom111は、関数NISSUUに相当します。



FUNCTION IsLeapYear(y) !うるう年の判定
LET IsLeapYear=0
IF (MOD(y,4)=0 AND MOD(y,100)<>0) OR MOD(y,400)=0 THEN LET IsLeapYear=1 !うるう年
END FUNCTION


LET MaxLevel=10000 !最大年数

FUNCTION Year(n) !（西暦1年1月1日からの）日数から西暦の年を得る
LET ya=1 !下限
LET yb=MaxLevel !上限
DO UNTIL ya>yb
LET y=INT((ya+yb)/2) !中央
IF DateFrom111(y,1,1)<=n THEN !西暦y年1月1日での日数を得る
LET ya=y+1 !下限の更新（上半分）
ELSE
LET yb=y-1 !上限の更新（下半分）
END IF
LOOP
IF DateFrom111(y,1,1)>n THEN LET y=y-1 !超えていたら戻す

LET Year=y
END FUNCTION

FUNCTION Month(n) !（西暦1年1月1日からの）日数から西暦の月を得る
LET y=Year(n) !年

LET ma=1 !２分探索
LET mb=12
DO UNTIL ma>mb
LET m=INT((ma+mb)/2)
IF DateFrom111(y,m,1)<=n THEN
LET ma=m+1
ELSE
LET mb=m-1
END IF
LOOP
IF DateFrom111(y,m,1)>n THEN LET m=m-1

LET Month=m
END FUNCTION

FUNCTION Day(n) !（西暦1年1月1日からの）日数から西暦の月を得る
LET Day=n-DateFrom111(Year(n),Month(n),1)+1
END FUNCTION


FUNCTION DateFrom111(y,m,d) !西暦1年1月1日からの日数を得る
LET yy=y-1 !年
LET a=yy*365+INT(yy/4)-INT(yy/100)+INT(yy/400)

FOR i=1 TO m-1 !月
LET a=a+EOMonth(i)
NEXT i
IF m>2 THEN LET a=a+IsLeapYear(y) !うるう年の補正

LET a=a+d !日

LET DateFrom111=a
END FUNCTION


DATA 31,28,31,30,31,30,31,31,30,31,30,31 !各月の日数
DIM EOMonth(12)
MAT READ EOMonth
!------------------------------ ここまでがサブルーチン


LET n=DateFrom111(2008,1,1) + 365 !n日後
PRINT Year(n)
PRINT Month(n)
PRINT Day(n)

LET n=DateFrom111(2008,3,1) - 1 !n日前
PRINT Year(n)
PRINT Month(n)
PRINT Day(n)

END
 
　　　　├!経過年月日の計算 山中和義 2008/04/01 16:09:28  (修正2回)  ツリーへ
Re: 西暦1年1月1日からの日数から西暦年月日に変... 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/04/01 16:09:28 ** この記事は2回修正されてます
!経過年月日の計算

SUB DateDiffYMD(y1,m1,d1, y2,m2,d2, y,m,d) !西暦y1年m1月d1日から基準日（西暦y2年m2月d2日）までの経過年月日を得る
LET y=y2 !被減数と減数の大きさを考慮する
LET m=m2
LET d=d2

IF d<d1 THEN !引けなければ、月から借りる
LET m=m-1
IF m=0 THEN !その月の日数に換算する
LET d=d+DayOfMonth(y,12)
ELSE
LET d=d+DayOfMonth(y,m)
END IF
END IF

IF m<m1 THEN !引けなければ、年から借りる
LET y=y-1
LET m=m+12 !その年の月数に換算する
END IF

LET y=y-y1 !実際に減算する
LET m=m-m1
LET d=d-d1
END SUB


FUNCTION DayOfMonth(y,m) !西暦y年m月の日数を得る
LET a=EOMonth(m) !平年
IF m=2 THEN LET a=a+IsLeapYear(y) !うるう年の補正
LET DayOfMonth=a
END FUNCTION


!下位ルーチン
FUNCTION IsLeapYear(y) !うるう年の判定
LET IsLeapYear=0
IF (MOD(y,4)=0 AND MOD(y,100)<>0) OR MOD(y,400)=0 THEN LET IsLeapYear=1 !うるう年
END FUNCTION


!定数
DATA 31,28,31,30,31,30,31,31,30,31,30,31 !各月の日数（平年）
DIM EOMonth(12)
MAT READ EOMonth
!------------------------------ ここまでがサブルーチン


LET y1=2000
LET m1=2
LET d1=29

LET y2=2008 !Today
LET m2=4
LET d2=1

CALL DateDiffYMD(y1,m1,d1, y2,m2,d2, y,m,d) !経過年月日
PRINT y;"年"; m;"ヶ月"; d;"日"



!別解
LET a=( (y2*100+m2)*100+d2 ) - ( (y1*100+m1)*100+d1 ) !yyyymmdd形式
LET y=INT(a/10000) !yyyy.mmdd
PRINT y;"年"


END


!年齢計算に使用できるが、誕生日に加算されるため法律上の年齢にはなりません。
!基準日の＋１などの工夫が必要です。
 
　　　　└!日付関連のサブルーチン 山中和義 2008/04/02 15:36:28   ツリーへ
Re: 西暦1年1月1日からの日数から西暦年月日に変... 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/04/02 15:36:28
!日付関連のサブルーチン

!注意　1582年10月15日以降の現行のグレゴリオ暦に対応する。

FUNCTION WeekInYear(y) !西暦y年の週の数を得る　※52,53
LET WeekInYear=WeekNumber(y,12,31)
END FUNCTION

FUNCTION WeekNumber(y,m,d) !西暦y年m月d日は1月1日から第何週目にあるか計算する　※0,1〜52,53、前年の週の最後にある場合は、0
LET WeekNumber=Week(y,1,DayOfYear(y,m,d)) !※西暦y年1月の1日〜365,366日と解釈する
END FUNCTION

FUNCTION Week(y,m,d) !西暦y年m月の第何週目にあるか計算する　※週の始めは月曜日。前月の週の最後にある場合は、0
LET Week=INT((d+DayOfWeek(y,m,1)-2)/7)+1
END FUNCTION

FUNCTION DayOfYear(y,m,d) !西暦y年の1月1日からの日数を得る　※1〜365,366
LET DayOfYear=DateFrom111(y,m,d)-DateFrom111(y,1,1)+1
END FUNCTION

FUNCTION DayInYear(y) !西暦y年の日数を得る　※365,366
LET DayInYear=365+IsLeapYear(y)
END FUNCTION

FUNCTION DayOfMonth(y,m) !西暦y年m月の日数を得る
LET a=EOMonth(m)
IF m=2 THEN LET a=a+IsLeapYear(y) !うるう年の補正
LET DayOfMonth=a
END FUNCTION

FUNCTION DayOfWeek(y,m,d) !西暦y年m月d日の曜日を得る　※0なら日曜日、1なら月曜日、2なら火曜日、……、6なら土曜日
LET DayOfWeek=MOD(DateFrom111(y,m,d),7) !西暦1年1月1日を日曜日とする
END FUNCTION

FUNCTION DateDiff(y1,m1,d1, y2,m2,d2) !西暦y1/m1/d1〜y2/m2/d2間の日数を得る
LET DateDiff=DateFrom111(y2,m2,d2)-DateFrom111(y1,m1,d1)
END FUNCTION


!下位ルーチン
FUNCTION IsLeapYear(y) !うるう年の判定
LET IsLeapYear=0
IF (MOD(y,4)=0 AND MOD(y,100)<>0) OR MOD(y,400)=0 THEN LET IsLeapYear=1 !うるう年
END FUNCTION


FUNCTION DateFrom111(y,m,d) !西暦1年1月1日からの日数を得る　※グレゴリオ暦を線形的に拡張したものである。
LET yy=y-1 !年
LET a=yy*365+INT(yy/4)-INT(yy/100)+INT(yy/400)

FOR i=1 TO m-1 !月
LET a=a+EOMonth(i)
NEXT i
IF m>2 THEN LET a=a+IsLeapYear(y) !うるう年の補正

LET a=a+d !日

LET DateFrom111=a
END FUNCTION


!定数
DATA 31,28,31,30,31,30,31,31,30,31,30,31 !各月の日数（平年）
DIM EOMonth(12)
MAT READ EOMonth
!------------------------------ ここまでがサブルーチン

 
　　　　　└つづき（使用例、カレンダー） 山中和義 2008/04/02 15:38:11   ツリーへ
Re: !日付関連のサブルーチン 返事を書く ノートメニュー
山中和義 <drdlxujciw> 2008/04/02 15:38:11
つづき（使用例、カレンダー）


INPUT PROMPT "西暦を入力して下さい。": y1


PRINT
PRINT "西暦";y1;"は、"; DayInYear(y1);"日。"; WeekInYear(y1);"週です。"

FOR m1=1 TO 12
FOR d1=1 TO DayOfMonth(y1,m1)

IF d1=1 THEN !月が変わったら
PRINT
PRINT USING "　　　####月":m1 !ヘッダー
PRINT " 月 火 水 木 金 土 日"

LET a=DayOfWeek(y1,m1,d1)-1 !月曜日を0とした曜日、日曜日は6
IF a<0 THEN LET a=a+7
PRINT REPEAT$(" ",a*3); !表の先頭を空ける
END IF

PRINT USING "###": d1;

IF DayOfWeek(y1,m1,d1)=0 THEN !7日単位
PRINT ,Week(y1,m1,d1);WeekNumber(y1,m1,d1) !フッター
ELSE
IF d1=DayOfMonth(y1,m1) THEN !月末なら
PRINT ,Week(y1,m1,d1);WeekNumber(y1,m1,d1)
END IF
END IF

NEXT d1
NEXT m1


END

インデックスへ EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。