r-statistics-fanの日記

統計好きの現場の臨床医の覚書のようなもの

同窓会で5年後に全員生存している確率は~H27の日本人完全生命表で計算する

#追記
ここをクリックでブラウザで各自計算できます


昔の記事で日本人の生存曲線を扱ったが、H27の国勢調査のデータによる完全生命表が出ているのでアップデートすることにした。

http://www.mhlw.go.jp/toukei/saikin/hw/life/22th/
ここのデータを引っ張ってくる。
pdfを読む関数を使ってみたが、マルチバイト文字のエラーとか色々で余計時間かかるわってなって断念。
pdf-excel変換ソフトを使ったらあっさり行けた。

というか、pdfでの公開はやめて欲しい。csvがベスト、せめてエクセルでお願いしたいものだ。

せっかくデーターを得たので何か計算しよう。

先日母校の同窓会にでたりしたが、自分たちも恩師も明らかに年をとってきており、次回5年後に全員生きている可能性はどんなものか気になった。

アップデートされたデータで計算してみる。

とりあえずフィクションの例を提示する
生徒は40才で男女35人ずつ、先生が75男性、70男性、65女性とする。
この合計73人が全員5,10,15,20年後に生存している率を日本人の生命表を元に計算する。

その他たとえば、家族全員のデータを入れても興味深いだろう。
生命保険に入るかどうかとか、起業した場合のリスクとか、相続の可能性とか色々参考に出来るだろう。

calc_all_alive(
      target_age = c(40, 40, 75, 70, 65),  #対象の年齢
      target_sex = c(0, 1, 1, 1, 0),       #対象の性男1女0
      target_N = c(35, 35, 1, 1, 1),     #対象の人数
      target_year = c(5, 10, 15, 20),      #計算する年数
      plot_year = 30                      #plotする年数
)

f:id:r-statistics-fan:20170830223844j:plain

           平均余命 余命中央値 5年後の生存率 10年後の生存率 15年後の生存率 20年後の生存率
40才女性       47.7       49.9     0.9962918      0.9905526     0.98178217    0.969697582
40才男性       41.8       44.0     0.9937605      0.9837753     0.96786605    0.943009822
75才男性       12.0       11.9     0.8392625      0.6055661     0.33302515    0.115608795
70才男性       15.6       15.9     0.8994071      0.7548386     0.54465039    0.299525175
65才女性       24.2       25.4     0.9727091      0.9300539     0.85822970    0.729128645
全員生存率       NA         NA     0.5178770      0.1720260     0.02607728    0.001102978

このばあい、5年後に全員生きている可能性は五分五分の51.7%
10年後だと17%しかない。基本誰かが死んでしまうということ。
リアルな結果に戦慄した。

以下計算するプログラム。

dat<-structure(list(x=c(0,1,2,3,4,5,6,7,8,9,10,11,12,
13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,
29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,
45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,
61,62,63,64,65,66,67,68,69,70,71,72,73,74,75,76,
77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,
93,94,95,96,97,98,99,100,101,102,103,104,105,106,
107,108,109,110,111,112,113,114,115,0,1,2,3,4,5,
6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,
23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,
39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,
55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,
71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,
87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,
102,103,104,105,106,107,108,109,110,111,112),lx=c(1e+05,
99822,99790,99770,99758,99749,99742,99734,99726,99718,
99712,99705,99698,99691,99684,99676,99666,99654,99641,
99626,99610,99593,99575,99554,99533,99510,99486,99461,
99434,99405,99375,99345,99313,99279,99243,99204,99163,
99121,99075,99025,98969,98907,98839,98766,98687,98602,
98509,98405,98291,98167,98034,97889,97730,97557,97368,
97166,96951,96726,96489,96239,95970,95679,95361,95015,
94643,94244,93811,93340,92829,92275,91672,91010,90281,
89480,88606,87652,86599,85419,84087,82582,80883,78974,
76831,74422,71720,68716,65407,61784,57847,53594,49063,
44306,39389,34364,29340,24464,19866,15734,12140,9115,
6652,4711,3234,2149,1380,855,510,293,162,85,43,21,
10,4,2,1,1e+05,99798,99765,99741,99725,99714,99704,
99694,99684,99676,99668,99661,99653,99645,99635,99621,
99604,99583,99557,99524,99486,99441,99392,99341,99288,
99234,99179,99124,99070,99016,98961,98903,98844,98783,
98718,98649,98576,98501,98423,98338,98245,98142,98029,
97907,97776,97632,97473,97297,97102,96887,96651,96394,
96111,95801,95461,95088,94677,94227,93739,93214,92646,
92026,91338,90573,89734,88825,87830,86749,85582,84326,
82978,81528,79966,78291,76515,74631,72610,70426,68048,
65454,62635,59589,56311,52807,49094,45194,41150,37034,
32907,28827,24854,21044,17465,14163,11195,8628,6506,
4788,3435,2401,1633,1080,693,431,260,151,85,46,24,
12,6,3,1),ndx=c(178,32,20,12,8,8,8,8,7,7,7,7,
7,7,8,10,12,13,15,16,17,19,20,22,23,24,25,27,
28,30,31,32,34,36,39,41,42,45,50,56,62,68,73,79,
85,94,104,114,124,134,145,159,174,189,202,215,226,
237,250,268,291,318,346,372,399,433,471,511,554,603,
662,729,802,874,954,1053,1180,1332,1505,1699,1909,
2143,2409,2701,3004,3310,3622,3938,4253,4531,4757,4918,
5025,5024,4876,4598,4132,3594,3025,2464,1941,1477,1085,
769,525,345,217,132,76,42,22,11,5,2,1,0,202,34,
24,16,11,10,10,10,9,8,7,7,8,11,13,17,21,26,32,
39,45,49,51,53,55,55,54,54,54,56,57,59,61,65,69,
73,75,78,84,93,103,113,122,131,144,159,176,195,215,
236,257,283,310,340,373,411,450,488,525,568,620,688,
764,839,910,994,1081,1166,1256,1349,1450,1561,1675,
1776,1885,2021,2185,2377,2594,2819,3046,3279,3504,3714,
3900,4043,4116,4127,4080,3973,3810,3580,3302,2967,2567,
2123,1718,1352,1034,768,554,387,262,171,108,66,39,
22,12,6,3,2,1),npx=c(0.99822,0.99968,0.9998,0.99988,
0.99992,0.99992,0.99992,0.99992,0.99993,0.99993,0.99993,
0.99993,0.99993,0.99993,0.99992,0.9999,0.99988,0.99987,
0.99985,0.99984,0.99983,0.99981,0.9998,0.99978,0.99977,
0.99976,0.99975,0.99973,0.99971,0.9997,0.99969,0.99968,
0.99966,0.99963,0.99961,0.99959,0.99957,0.99954,0.9995,
0.99943,0.99937,0.99931,0.99926,0.9992,0.99913,0.99905,
0.99895,0.99884,0.99874,0.99864,0.99852,0.99838,0.99822,
0.99807,0.99792,0.99779,0.99767,0.99755,0.99741,0.99721,
0.99696,0.99667,0.99638,0.99609,0.99578,0.9954,0.99498,
0.99453,0.99403,0.99346,0.99278,0.992,0.99112,0.99023,
0.98923,0.98798,0.98637,0.98441,0.98211,0.97943,0.97639,
0.97286,0.96864,0.9637,0.95812,0.95184,0.94462,0.93627,
0.92648,0.91546,0.90305,0.889,0.87243,0.85381,0.8338,0.81204,
0.79202,0.77161,0.75083,0.7297,0.70825,0.68649,0.66446,
0.64217,0.61967,0.59699,0.57415,0.55121,0.52821,0.50518,
0.48217,0.45924,0.43642,0.41378,0.39136,0.36921,0.99798,
0.99966,0.99976,0.99984,0.99988,0.9999,0.9999,0.9999,0.99991,
0.99992,0.99993,0.99993,0.99992,0.99989,0.99987,0.99983,
0.99979,0.99974,0.99968,0.99961,0.99955,0.99951,0.99949,
0.99946,0.99945,0.99945,0.99945,0.99946,0.99945,0.99944,
0.99942,0.9994,0.99938,0.99934,0.9993,0.99926,0.99924,
0.9992,0.99915,0.99905,0.99895,0.99885,0.99876,0.99866,
0.99853,0.99837,0.99819,0.998,0.99778,0.99757,0.99734,
0.99707,0.99677,0.99645,0.99609,0.99568,0.99525,0.99482,
0.9944,0.99391,0.99331,0.99252,0.99163,0.99074,0.98986,
0.98881,0.98769,0.98655,0.98532,0.98401,0.98253,0.98085,
0.97905,0.97732,0.97537,0.97293,0.96991,0.96624,0.96188,
0.95693,0.95138,0.94498,0.93778,0.92968,0.92055,0.91053,
0.89998,0.88856,0.87601,0.86217,0.84671,0.8299,0.81095,
0.79047,0.77068,0.75399,0.73592,0.71757,0.69896,0.68011,
0.66104,0.64176,0.62229,0.60267,0.58291,0.56303,0.54307,
0.52305,0.50301,0.48296,0.46295,0.44302,0.42318),nqx=c(0.00178,
0.00032,2e-04,0.00012,8e-05,8e-05,8e-05,8e-05,7e-05,7e-05,
7e-05,7e-05,7e-05,7e-05,8e-05,1e-04,0.00012,0.00013,0.00015,
0.00016,0.00017,0.00019,2e-04,0.00022,0.00023,0.00024,
0.00025,0.00027,0.00029,3e-04,0.00031,0.00032,0.00034,
0.00037,0.00039,0.00041,0.00043,0.00046,5e-04,0.00057,
0.00063,0.00069,0.00074,8e-04,0.00087,0.00095,0.00105,
0.00116,0.00126,0.00136,0.00148,0.00162,0.00178,0.00193,
0.00208,0.00221,0.00233,0.00245,0.00259,0.00279,0.00304,
0.00333,0.00362,0.00391,0.00422,0.0046,0.00502,0.00547,
0.00597,0.00654,0.00722,0.008,0.00888,0.00977,0.01077,
0.01202,0.01363,0.01559,0.01789,0.02057,0.02361,0.02714,
0.03136,0.0363,0.04188,0.04816,0.05538,0.06373,0.07352,
0.08454,0.09695,0.111,0.12757,0.14619,0.1662,0.18796,0.20798,
0.22839,0.24917,0.2703,0.29175,0.31351,0.33554,0.35783,
0.38033,0.40301,0.42585,0.44879,0.47179,0.49482,0.51783,
0.54076,0.56358,0.58622,0.60864,0.63079,0.00202,0.00034,
0.00024,0.00016,0.00012,1e-04,1e-04,1e-04,9e-05,8e-05,
7e-05,7e-05,8e-05,0.00011,0.00013,0.00017,0.00021,0.00026,
0.00032,0.00039,0.00045,0.00049,0.00051,0.00054,0.00055,
0.00055,0.00055,0.00054,0.00055,0.00056,0.00058,6e-04,
0.00062,0.00066,7e-04,0.00074,0.00076,8e-04,0.00085,0.00095,
0.00105,0.00115,0.00124,0.00134,0.00147,0.00163,0.00181,
0.002,0.00222,0.00243,0.00266,0.00293,0.00323,0.00355,
0.00391,0.00432,0.00475,0.00518,0.0056,0.00609,0.00669,
0.00748,0.00837,0.00926,0.01014,0.01119,0.01231,0.01345,
0.01468,0.01599,0.01747,0.01915,0.02095,0.02268,0.02463,
0.02707,0.03009,0.03376,0.03812,0.04307,0.04862,0.05502,
0.06222,0.07032,0.07945,0.08947,0.10002,0.11144,0.12399,
0.13783,0.15329,0.1701,0.18905,0.20953,0.22932,0.24601,
0.26408,0.28243,0.30104,0.31989,0.33896,0.35824,0.37771,
0.39733,0.41709,0.43697,0.45693,0.47695,0.49699,0.51704,
0.53705,0.55698,0.57682),mux=c(0.05782,4e-04,0.00023,
0.00016,1e-04,8e-05,8e-05,8e-05,8e-05,7e-05,7e-05,7e-05,
7e-05,7e-05,8e-05,9e-05,0.00011,0.00013,0.00014,0.00015,
0.00016,0.00018,2e-04,0.00021,0.00023,0.00024,0.00025,
0.00026,0.00028,0.00029,0.00031,0.00032,0.00033,0.00035,
0.00038,4e-04,0.00042,0.00044,0.00048,0.00053,6e-04,0.00066,
0.00071,0.00077,0.00083,9e-04,0.001,0.00111,0.00121,0.00131,
0.00142,0.00155,0.0017,0.00186,0.00201,0.00215,0.00227,
0.00239,0.00252,0.00269,0.00291,0.00318,0.00348,0.00378,
0.00406,0.00441,0.00482,0.00526,0.00573,0.00626,0.00688,
0.00762,0.00847,0.00936,0.01029,0.0114,0.01284,0.01466,
0.01682,0.01936,0.02227,0.0256,0.02956,0.03429,0.03976,
0.04593,0.05298,0.06118,0.07085,0.08208,0.09485,0.1094,
0.12656,0.14682,0.16949,0.19609,0.22051,0.24603,0.27272,
0.30063,0.32981,0.36033,0.39223,0.42559,0.46047,0.49694,
0.53507,0.57494,0.61663,0.66022,0.7058,0.75346,0.80329,
0.85539,0.90987,0.96683,0.06764,0.00038,0.00024,0.00019,
0.00013,1e-04,1e-04,1e-04,9e-05,8e-05,7e-05,7e-05,8e-05,
9e-05,0.00012,0.00015,0.00019,0.00024,0.00029,0.00036,
0.00042,0.00047,5e-04,0.00053,0.00054,0.00055,0.00055,
0.00055,0.00054,0.00055,0.00057,0.00059,0.00061,0.00064,
0.00068,0.00072,0.00075,0.00078,0.00082,9e-04,0.001,0.0011,
0.0012,0.00129,0.0014,0.00155,0.00171,0.0019,0.00211,0.00233,
0.00255,0.0028,0.00308,0.00339,0.00373,0.00412,0.00454,
0.00498,0.0054,0.00585,0.00639,0.00709,0.00795,0.00886,
0.00973,0.0107,0.01182,0.01295,0.01415,0.01543,0.01684,
0.01846,0.02025,0.02205,0.02388,0.0261,0.02889,0.03233,
0.03649,0.04134,0.0468,0.05307,0.06025,0.06839,0.07766,
0.0881,0.09941,0.11156,0.125,0.14002,0.15698,0.17602,0.19751,
0.22205,0.24801,0.27055,0.29434,0.3191,0.34485,0.37165,
0.39954,0.42855,0.45874,0.49015,0.52284,0.55684,0.59223,
0.62905,0.66736,0.70722,0.74869,0.79185,0.83675),nLx=c(99861,
99806,99780,99763,99753,99746,99738,99730,99722,99715,
99708,99701,99695,99688,99680,99671,99660,99647,99633,
99618,99602,99584,99565,99544,99521,99498,99473,99447,
99420,99391,99360,99329,99296,99261,99223,99184,99142,
99098,99051,98998,98939,98873,98803,98727,98645,98556,
98458,98349,98230,98101,97962,97811,97645,97463,97268,
97060,96839,96608,96365,96106,95827,95522,95190,94832,
94446,94031,93579,93088,92556,91978,91346,90651,89887,
89049,88136,87135,86020,84766,83350,81750,79947,77923,
75649,73096,70244,67087,63622,59842,55745,51350,46701,
41859,36881,31846,26884,22135,17756,13890,10580,7838,
5640,3937,2662,1741,1100,670,393,222,120,62,31,15,
7,3,1,0,99843,99783,99753,99732,99719,99709,99699,
99689,99680,99672,99664,99657,99649,99640,99628,99613,
99594,99570,99541,99506,99464,99417,99367,99315,99261,
99206,99151,99097,99043,98989,98932,98874,98814,98751,
98684,98613,98539,98462,98381,98293,98195,98086,97969,
97842,97705,97554,97386,97201,96996,96771,96524,96255,
95958,95634,95277,94886,94455,93986,93480,92934,92341,
91688,90962,90160,89286,88335,87297,86173,84962,83660,
82262,80757,79138,77411,75583,73633,71533,69254,66770,
64063,61131,57970,54577,50967,47158,43181,39096,34969,
30861,26829,22933,19233,15788,12649,9876,7530,5614,4083,
2894,1997,1340,874,553,339,201,116,64,34,18,9,4,
2,1),Tx=c(8698726,8598865,8499059,8399279,8299516,8199762,
8100017,8000279,7900550,7800828,7701113,7601405,7501703,
7402008,7302321,7202641,7102970,7003311,6903663,6804030,
6704411,6604809,6505225,6405661,6306117,6206596,6107098,
6007625,5908177,5808758,5709367,5610007,5510678,5411383,
5312122,5212898,5113715,5014573,4915474,4816424,4717426,
4618487,4519614,4420811,4322084,4223438,4124882,4026425,
3928076,3829846,3731745,3633783,3535972,3438327,3340864,
3243596,3146536,3049697,2953088,2856723,2760617,2664790,
2569268,2474078,2379246,2284800,2190769,2097190,2004102,
1911547,1819569,1728223,1637572,1547685,1458636,1370500,
1283365,1197345,1112579,1029229,947479,867532,789609,713959,
640864,570620,503533,439911,380069,324323,272974,226273,
184414,147533,115686,88802,66667,48911,35021,24441,16603,
10963,7026,4364,2623,1523,853,460,238,118,56,26,11,
5,2,1,8075244,7975401,7875618,7775866,7676133,7576414,
7476706,7377007,7277318,7177638,7077966,6978302,6878645,
6778995,6679355,6579727,6480114,6380520,6280950,6181409,
6081903,5982440,5883023,5783656,5684341,5585080,5485874,
5386722,5287625,5188582,5089593,4990661,4891787,4792973,
4694222,4595538,4496925,4398387,4299925,4201543,4103251,
4005056,3906970,3809001,3711159,3613454,3515900,3418514,
3321313,3224317,3127546,3031022,2934767,2838809,2743175,
2647898,2553012,2458557,2364571,2271091,2178157,2085816,
1994129,1903167,1813007,1723721,1635386,1548089,1461916,
1376954,1293294,1211033,1130276,1051138,973727,898144,
824511,752979,683725,616955,552891,491760,433791,379213,
328246,281088,237907,198811,163842,132982,106153,83220,
63987,48199,35550,25674,18144,12529,8447,5553,3556,2215,
1341,788,449,247,132,68,34,16,7,3,1),ex=c(86.99,
86.14,85.17,84.19,83.2,82.2,81.21,80.22,79.22,78.23,
77.23,76.24,75.24,74.25,73.25,72.26,71.27,70.28,69.29,
68.3,67.31,66.32,65.33,64.34,63.36,62.37,61.39,60.4,
59.42,58.44,57.45,56.47,55.49,54.51,53.53,52.55,51.57,
50.59,49.61,48.64,47.67,46.7,45.73,44.76,43.8,42.83,
41.87,40.92,39.96,39.01,38.07,37.12,36.18,35.24,34.31,
33.38,32.45,31.53,30.61,29.68,28.77,27.85,26.94,26.04,
25.14,24.24,23.35,22.47,21.59,20.72,19.85,18.99,18.14,
17.3,16.46,15.64,14.82,14.02,13.23,12.46,11.71,10.99,
10.28,9.59,8.94,8.3,7.7,7.12,6.57,6.05,5.56,5.11,4.68,
4.29,3.94,3.63,3.36,3.11,2.88,2.68,2.5,2.33,2.17,2.03,
1.9,1.78,1.67,1.57,1.48,1.39,1.31,1.23,1.16,1.1,1.04,
0.98,80.75,79.92,78.94,77.96,76.97,75.98,74.99,74,73,
72.01,71.02,70.02,69.03,68.03,67.04,66.05,65.06,64.07,
63.09,62.11,61.13,60.16,59.19,58.22,57.25,56.28,55.31,
54.34,53.37,52.4,51.43,50.46,49.49,48.52,47.55,46.58,
45.62,44.65,43.69,42.73,41.77,40.81,39.86,38.9,37.96,
37.01,36.07,35.13,34.2,33.28,32.36,31.44,30.54,29.63,
28.74,27.85,26.97,26.09,25.23,24.36,23.51,22.67,21.83,
21.01,20.2,19.41,18.62,17.85,17.08,16.33,15.59,14.85,
14.13,13.43,12.73,12.03,11.36,10.69,10.05,9.43,8.83,
8.25,7.7,7.18,6.69,6.22,5.78,5.37,4.98,4.61,4.27,3.95,
3.66,3.4,3.18,2.98,2.79,2.62,2.46,2.31,2.18,2.05,1.94,
1.83,1.73,1.63,1.55,1.46,1.39,1.32,1.25,1.19,1.13),
sexM1=c(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,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,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,
1,1,1,1)),.Names=c("x","lx","ndx","npx","nqx",
"mux","nLx","Tx","ex","sexM1"),class="data.frame",row.names=c(NA,
-229L))

calc_all_alive <- function(
target_age = c(45, 45, 75, 70, 65),  #対象の年齢
target_sex = c(0, 1, 1, 1, 1),       #対象の性男1女0
target_N = c(100, 100, 1, 1, 1),     #対象の人数
target_year = c(5, 10, 15, 20),      #計算する年数
plot_year = 30                      #plotする年数
){      
if(length(target_age) != length(target_sex) | length(target_age) != length(target_N)){
      cat("入力データエラー。データの長さが異なります")
      return(NA)
}else{
      plot(NULL, type = "n", xlim = c(0, plot_year), ylim = c(0,1), labels = NULL, ylab = "survival rate", xlab = "years", lab = NULL)
      
      col_1 <- rainbow(length(target_age))
      
      for(i in 1:length(target_age)){      
      temp2 <- subset(dat, sexM1 == target_sex[i]) 
      lines(seq_len(length(temp2$lx[temp2$x >= target_age[i]])) - 1, 
            temp2$lx[temp2$x >= target_age[i]]/temp2$lx[temp2$x == target_age[i]], 
            ann=F, type = "l", col = col_1[i], lty = i) #年齢別生存確率
      }
      tsex_temp <- chartr(c("01"), c("女男"), target_sex)
      legend_1 <- paste0(target_age, "才", tsex_temp, "性")
      
      legend("bottomleft", legend = legend_1, col = col_1, lty = 1:length(target_age),
             text.col = col_1, bty = "n")
 
      abline(v = c(0, target_year), lty = 3)     
      abline(h = c(0, 0.2, 0.4, 0.6, 0.8, 1), lty = 3)    
      
      result <- matrix(0, nrow = length(target_age), ncol = 2 + length(target_year))
      row.names(result) <- legend_1
      colnames(result) <- c("平均余命", "余命中央値", paste0(target_year, "年後の生存率"))

      ave.yomei <- function(age = 80, M1F0 = 1){
            temp <- subset(dat, sexM1 == M1F0)
            temp$ex[temp$x == age]
      }
      
      cal.median <- function(y, b){  #age = y #sex=b(F0M1) 以降でのmedian生存期間
            ssp <- smooth.spline(dat$lx[dat$sexM1 == b]/100000, dat$x[dat$sexM1 ==b])
            temp <- dat$lx[dat$sexM1 == b & dat$x == y]/100000
            return(predict(ssp, x = temp / 2)$y - y)      
      }
      
      result[,1] <- round(Vectorize(ave.yomei)(age = target_age, M1F0 = target_sex), digits = 1)
      result[,2] <- round(Vectorize(cal.median)(y = target_age, b = target_sex), digits = 1)

      for(i in 1:length(target_age)){    
      temp2 <- subset(dat, sexM1 == target_sex[i]) 
      for(j in 1:length(target_year)){
      result[i, 2 + j] <- temp2$lx[temp2$x == (target_age[i] + target_year[j])]/temp2$lx[temp2$x == target_age[i]] #年齢別生存確率
      
      }
      }
      temp_alive <- result[,3:(2+length(target_year))] ^ target_N
      alive_all <- c(NA, NA, apply(temp_alive, 2, function(x){Reduce("*", x)}))
result <- rbind(result, alive_all)
row.names(result) <- c(legend_1, "全員生存率")
return(result)

}      
}