韓国と日本のPCR検査実施人数等比較 (新型コロナウイルス：Coronavirus)

(使用するデータ)
日本 : PCR検査実施人数は、厚生労働省の報道発表資料から抜き出した。
韓国 : KCDC「News Room」「Press Release」
人口は世界の人口 （世銀）直近データ2018年を使う。日本：126,529,000、韓国：51,635,000（日本の約４１％）

(注意)
新型コロナウイルス感染症の現在の状況と厚生労働省の対応について（令和２年４月21日版）

• 都道府県から公表された死亡者数の合計は244（+21）名であるが、うち58名については個々の陽性者との突合作業中のため、計上するに至っていない。

新型コロナウイルス感染症の現在の状況と厚生労働省の対応について（令和２年４月22日版）

• 退院した者のうち616名、死亡者のうち74名については、個々の陽性者との突合作業中。従って、入退院等の状況の合計とPCR検査陽性者数は一致しない。

※３：日本のPCR検査実施人数は、一部自治体について件数を計上しているため、実際の人数より過大である。
また、人数を公表していない自治体の数は計上しておらず、更新がなかった自治体については、前日の数値を使用している。

また、ありえないデータ(日本)

• PCR検査実施人数　国内事例 ５月１２日: 188646 ５月１３日: 188031 ５月１２日の方が多い！
• PCR検査実施人数　国内事例 ５月１４日: 196816 ５月１５日: 194323 ５月１４日の方が多い！

※６：東京都は、医療機関による保険適用での検査人数等を除いた検査人数をウェブサイトに掲載していたが、 6月15日以降、医療機関等が行った検査を含む検査人数を過去に遡って計上しているため、検査実施人数が大幅に（4万人以上）増加している。

日本と韓国の新型コロナウイルスに関する情報開示の比較 「データの信頼性」という観点からみてみると、(参考)COVID-19

新型コロナウイルスのPCR検査実施人数と感染状況(韓国)「累計」

(注)日本の６月１８日の検査人数の上昇は以下の理由によるものです。

• 東京都は、医療機関による保険適用での検査人数等を除いた検査人数をウェブサイトに掲載していたが、 6月15日以降、医療機関等が行った検査を含む検査人数を過去に遡って計上しているため、検査実施人数が大幅に（4万人以上）増加している。

<span style="color: red; ">６月９日に韓国のPCR検査の結果判明数が１００万人超えました。</span>
(注意)日本のPCR検査実施人数は、一部自治体について件数を計上しているため、実際の人数より過大である。

日本と韓国の新型コロナウイルスによる死亡者数推移(累計で計算)

日本の新型コロナウイルスによる死亡者数はもっと多いのではないか。
根拠：日本法医病理学会HP:法医解剖、検案からの検体に対する新型コロナウイルス検査状況(pdf) 2020/04/26
法医解剖、検案からの検体に対する新型コロナウイルス検査状況
○ 回答機関: 26 機関

• 実施件数
  • 保健所: 9 件 他の検査機関: 2 件
• 拒否件数
  • 保健所: 12 件 他の検査機関: 0 件

日本と韓国のPCR検査の陽性率(%)「累計」

(注)日本の６月１８日のPCR検査の陽性率の下降は以下の理由によるものです。

• 東京都は、医療機関による保険適用での検査人数等を除いた検査人数をウェブサイトに掲載していたが、 6月15日以降、医療機関等が行った検査を含む検査人数を過去に遡って計上しているため、検査実施人数が大幅に（4万人以上）増加している。

日本と韓国のPCR検査の暫定致死率(%)「累計」

ここからは差分をとって、日別のデータをグラフにした。

週単位の陽性者増加比(日本、韓国)

韓国のPCR検査の結果（日別）

日本と韓国の検査陽性者数（日別）

• 検査の数が少ないと陽性者数も少なくなるので下の「日本と韓国の検査者数」及び「検査陽性率(%)」の図も見てください。

日本と韓国の検査者数（韓国の場合は「結果が判明した数」）（日別）

日本のデータでありえない箇所（検査者数がマイナス!）がある。

日本と韓国のPCR検査の検査陽性率(%)の推移(日別)

厚生労働省のデータは差分をとると、検査者数がマイナスだったり、検査人数より陽性者が多かったりするのでy軸の範囲を0%から12%にしています。

韓国の(報告された)陽性者数 対数表示（日別）

対数表示にして結果判明した数に対する陽性者数の増減をわかりやすくしてみた。

日本の(報告された)感染者数 対数表示（日別）

(注)日本の６月１８日の検査人数の上昇は以下の理由によるものです。

• 東京都は、医療機関による保険適用での検査人数等を除いた検査人数をウェブサイトに掲載していたが、 6月15日以降、医療機関等が行った検査を含む検査人数を過去に遡って計上しているため、検査実施人数が大幅に（4万人以上）増加している。

データの信頼性(データのとり方の一貫性)が劣るのでおかしな箇所(検査人数より陽性者が多い!)が見受けられます。

回復された方、亡くなった方、療養中(入院、隔離、自宅療養)の方の推移

Rコードは、記事「東アジアの感染者の状況(新型コロナウイルス：Coronavirus)」にのせています。

日本

韓国

オーストラリア（南半球）

日本がこの状態のまま冬を迎えたらかなりひどい状況になることを示唆しています。(韓国ですらヤバイ)

日本、韓国、台湾、シンガポール、香港の面積、人口、人口密度

country	area	pop	Population.density
Japan	377,915	127,103,388	336
Korea, South	99,720	49,039,986	492
Taiwan	35,980	23,359,928	649
Hong Kong	1,104	7,112,688	6,443
Singapore	697	5,567,301	7,988

Confirmed、 Deaths、Deaths/Confirmed (%)の表（米ジョンズ・ホプキンス大学のデータを使った。）

人口100万人あたりの死亡者数を計算して表に入れた。

	Confirmed	Deaths	Deaths/Confirmed (%)	Deaths/millionpeople
Japan	51,288	1066	2.08	8.39
Korea, South	14,770	305	2.06	6.22
Taiwan	481	7	1.46	0.30
Hong Kong	4,243	63	1.48	8.86
Singapore	55,395	27	0.05	4.85

• 日本の死亡者数１０００人突破（2020-07-29）
• 日本：検査陽性者数及び（報告された）死亡者数で韓国を追い抜いた。
• シンガポール：（報告された）感染者が人口（約５５７万人）に対して非常に多い。
• シンガポールの致死率は非常に小さいが、検査感染者数が多く、人口も少ないため100万人あたりの死亡者数は４人を超えている。
• 台湾の感染者の数は圧倒的に少ない。

(関連ニュース)
台湾、コロナ封じ込め成功　新規感染者ゼロも引き締め2020年04月16日07時07分

日本、韓国、台湾、シンガポール、香港の人口100万人あたりの新型コロナウイルスによる死者数

日本、韓国、台湾、シンガポール、香港のReported Confirmed

日本、韓国、台湾、シンガポール、香港のPCR検査の暫定致死率(%)

新型コロナウイルスによる死者数 in アジア

（注意）日本語名は手打ちしているのでもしかしたら間違いがあるかもしれません。

新型コロナウイルスによる人口100万人あたりの死者数 in アジア

「人口あたりの死者数」で評価した「日本モデル」より優秀なモデル in アジア

[1] "ブータン モデル" "カンボジア モデル" "ラオス モデル"
[4] "モンゴル モデル" "東ティモール モデル" "ベトナム モデル"
[7] "台湾 モデル" "スリランカ モデル" "タイ モデル"
[10] "ヨルダン モデル" "シリア モデル" "ネパール モデル"
[13] "中国 モデル" "マレーシア モデル" "グルジア モデル"
[16] "シンガポール モデル" "韓国 モデル" "ウズベキスタン モデル" [19] "タジキスタン モデル" "ブルネイ モデル"

陽性率、暫定致死率を計算し、表を作成(韓国のPCR検査実施人数とその結果）

Row.names	検査を受けた人	感染者数	死者	陰性	検査中	結果判明	陽性率(%)	暫定致死率(%)
2020-02-01	371	12	0	289	70	301	3.99	0.000
2020-02-02	429	15	0	327	87	342	4.39	0.000
2020-02-03	429	15	0	414	0	429	3.50	0.000
2020-02-04	607	16	0	462	129	478	3.35	0.000
2020-02-05	714	18	0	522	174	540	3.33	0.000
2020-02-06	885	23	0	693	169	716	3.21	0.000
2020-02-07	1130	24	0	842	264	866	2.77	0.000
2020-02-08	1701	24	0	1057	620	1081	2.22	0.000
2020-02-09	2340	25	0	1355	960	1380	1.81	0.000
2020-02-10	2776	27	0	1940	809	1967	1.37	0.000
2020-02-11	3629	28	0	2736	865	2764	1.01	0.000
2020-02-12	5074	28	0	4054	992	4082	0.69	0.000
2020-02-13	5797	28	0	5099	670	5127	0.55	0.000
2020-02-14	6854	28	0	6134	692	6162	0.45	0.000
2020-02-15	7519	28	0	6853	638	6881	0.41	0.000
2020-02-16	7919	29	0	7313	577	7342	0.39	0.000
2020-02-17	8171	30	0	7733	408	7763	0.39	0.000
2020-02-18	9265	31	0	8277	957	8308	0.37	0.000
2020-02-19	10411	46	0	9335	1030	9381	0.49	0.000
2020-02-20	12161	82	0	10446	1633	10528	0.78	0.000
2020-02-21	14816	156	1	11953	2707	12109	1.29	0.641
2020-02-22	19621	346	2	13794	5481	14140	2.45	0.578
2020-02-23	22633	556	4	16038	6039	16594	3.35	0.719
2020-02-24	28615	763	7	19127	8725	19890	3.84	0.917
2020-02-25	36716	893	8	22550	13273	23443	3.81	0.896
2020-02-26	46127	1146	11	28247	16734	29393	3.90	0.960
2020-02-27	57990	1595	12	35298	21097	36893	4.32	0.752
2020-02-28	70940	2022	13	44167	24751	46189	4.38	0.643
2020-02-29	85693	2931	16	53608	29154	56539	5.18	0.546
2020-03-01	96985	3526	17	61037	32422	64563	5.46	0.482
2020-03-02	109591	4212	22	71580	33799	75792	5.56	0.522
2020-03-03	125851	4812	28	85484	35555	90296	5.33	0.582
2020-03-04	136707	5328	32	102965	28414	108293	4.92	0.601
2020-03-05	146541	5766	35	118965	21810	124731	4.62	0.607
2020-03-06	164740	6284	42	136624	21832	142908	4.40	0.668
2020-03-07	178189	6767	44	151802	19620	158569	4.27	0.650
2020-03-08	188518	7134	50	162008	19376	169142	4.22	0.701
2020-03-09	196618	7382	51	171778	17458	179160	4.12	0.691
2020-03-10	210144	7513	54	184179	18452	191692	3.92	0.719
2020-03-11	222395	7755	60	196100	18540	203855	3.80	0.774
2020-03-12	234998	7869	66	209402	17727	217271	3.62	0.839
2020-03-13	248647	7979	67	222728	17940	230707	3.46	0.840
2020-03-14	261335	8086	72	235615	17634	243701	3.32	0.890
2020-03-15	268212	8162	75	243778	16272	251940	3.24	0.919
2020-03-16	274504	8236	75	251297	14971	259533	3.17	0.911
2020-03-17	286716	8320	81	261105	17291	269425	3.09	0.974
2020-03-18	295647	8413	84	270888	16346	279301	3.01	0.998
2020-03-19	307024	8565	91	282555	15904	291120	2.94	1.062
2020-03-20	316664	8652	94	292487	15525	301139	2.87	1.086
2020-03-21	327509	8799	102	303006	15704	311805	2.82	1.159
2020-03-22	331780	8897	104	308343	14540	317240	2.80	1.169
2020-03-23	338036	8961	111	315447	13628	324408	2.76	1.239
2020-03-24	348582	9037	120	324105	15440	333142	2.71	1.328
2020-03-25	357896	9137	126	334481	14278	343618	2.66	1.379
2020-03-26	364942	9241	131	341332	14369	350573	2.64	1.418
2020-03-27	376961	9332	139	352410	15219	361742	2.58	1.489
2020-03-28	387925	9478	144	361883	16564	371361	2.55	1.519
2020-03-29	394141	9583	152	369530	15028	379113	2.53	1.586
2020-03-30	395194	9661	158	372002	13531	381663	2.53	1.635
2020-03-31	410564	9786	162	383886	16892	393672	2.49	1.655
2020-04-01	421547	9887	165	395075	16585	404962	2.44	1.669
2020-04-02	431743	9976	169	403882	17885	413858	2.41	1.694
2020-04-03	443273	10062	174	414303	18908	424365	2.37	1.729
2020-04-04	455032	10156	177	424732	20144	434888	2.34	1.743
2020-04-05	461233	10237	183	431425	19571	441662	2.32	1.788
2020-04-06	466804	10284	186	437225	19295	447509	2.30	1.809
2020-04-07	477304	10331	192	446323	20650	456654	2.26	1.858
2020-04-08	486003	10384	200	457761	17858	468145	2.22	1.926
2020-04-09	494711	10423	204	468779	15509	479202	2.18	1.957
2020-04-10	503051	10450	208	477303	15298	487753	2.14	1.990
2020-04-11	510479	10480	211	485929	14070	496409	2.11	2.013
2020-04-12	514621	10512	214	490321	13788	500833	2.10	2.036
2020-04-13	518743	10537	217	494815	13391	505352	2.09	2.059
2020-04-14	527438	10564	222	502223	14651	512787	2.06	2.101
2020-04-15	534552	10591	225	508935	15026	519526	2.04	2.124
2020-04-16	538775	10613	229	513894	14268	524507	2.02	2.158
2020-04-17	546463	10635	230	521642	14186	532277	2.00	2.163
2020-04-18	554834	10653	232	530631	13550	541284	1.97	2.178
2020-04-19	559109	10661	234	536205	12243	546866	1.95	2.195
2020-04-20	563035	10674	236	540380	11981	551054	1.94	2.211
2020-04-21	571014	10683	237	547610	12721	558293	1.91	2.218
2020-04-22	577959	10694	238	555144	12121	565838	1.89	2.226
2020-04-23	583971	10702	240	563130	10139	573832	1.87	2.243
2020-04-24	589520	10708	240	569212	9600	579920	1.85	2.241
2020-04-25	595161	10718	240	575184	9259	585902	1.83	2.239
2020-04-26	598285	10728	242	578558	8999	589286	1.82	2.256
2020-04-27	601660	10738	243	582027	8895	592765	1.81	2.263
2020-04-28	608514	10752	244	588559	9203	599311	1.79	2.269
2020-04-29	614197	10761	246	595129	8307	605890	1.78	2.286
2020-04-30	619881	10765	247	600482	8634	611247	1.76	2.294
2020-05-01	623069	10774	248	603610	8685	614384	1.75	2.302
2020-05-02	627562	10780	250	608286	8496	619066	1.74	2.319
2020-05-03	630973	10793	250	611592	8588	622385	1.73	2.316
2020-05-04	633921	10801	252	614944	8176	625745	1.73	2.333
2020-05-05	640237	10804	254	620575	8858	631379	1.71	2.351
2020-05-06	643095	10806	255	624280	8009	635086	1.70	2.360
2020-05-07	649388	10810	256	630149	8429	640959	1.69	2.368
2020-05-08	654863	10822	256	635174	8867	645996	1.68	2.366
2020-05-09	660030	10840	256	640037	9153	650877	1.67	2.362
2020-05-10	663886	10874	256	642884	10128	653758	1.66	2.354
2020-05-11	668492	10909	256	646661	10922	657570	1.66	2.347
2020-05-12	680890	10936	258	653624	16330	664560	1.65	2.359
2020-05-13	695920	10962	259	665379	19579	676341	1.62	2.363
2020-05-14	711484	10991	260	679771	20722	690762	1.59	2.366
2020-05-15	726747	11018	260	695854	19875	706872	1.56	2.360
2020-05-16	740645	11037	262	711265	18343	722302	1.53	2.374
2020-05-17	747653	11050	262	718943	17660	729993	1.51	2.371
2020-05-18	753211	11065	263	726053	16093	737118	1.50	2.377
2020-05-19	765574	11078	263	737571	16925	748649	1.48	2.374
2020-05-20	776433	11110	263	748972	16351	760082	1.46	2.367
2020-05-21	788684	11122	264	759473	18089	770595	1.44	2.374
2020-05-22	802418	11142	264	770990	20286	782132	1.42	2.369
2020-05-23	814420	11165	266	781686	21569	792851	1.41	2.382
2020-05-24	820289	11190	266	788766	20333	799956	1.40	2.377
2020-05-25	826437	11206	267	796142	19089	807348	1.39	2.383
2020-05-26	839475	11225	269	806206	22044	817431	1.37	2.396
2020-05-27	852876	11265	269	820550	21061	831815	1.35	2.388
2020-05-28	868666	11344	269	834952	22370	846296	1.34	2.371
2020-05-29	885120	11402	269	849161	24557	860563	1.32	2.359
2020-05-30	902901	11441	269	865162	26298	876603	1.31	2.351
2020-05-31	910822	11468	270	876060	23294	887528	1.29	2.354
2020-06-01	921391	11503	271	885830	24058	897333	1.28	2.356
2020-06-02	939851	11541	272	899388	28922	910929	1.27	2.357
2020-06-03	956852	11590	273	917397	27865	928987	1.25	2.355
2020-06-04	973858	11629	273	934030	28199	945659	1.23	2.348
2020-06-05	990960	11668	273	950526	28766	962194	1.21	2.340
2020-06-06	1005305	11719	273	965632	27954	977351	1.20	2.330
2020-06-07	1012769	11776	273	974512	26481	986288	1.19	2.318
2020-06-08	1018214	11814	273	982026	24374	993840	1.19	2.311
2020-06-09	1035997	11852	274	996686	27459	1008538	1.18	2.312
2020-06-10	1051972	11902	276	1013847	26223	1025749	1.16	2.319
2020-06-11	1066888	11947	276	1029447	25494	1041394	1.15	2.310
2020-06-12	1081486	12002	277	1045240	24244	1057242	1.14	2.308
2020-06-13	1094704	12051	277	1059301	23352	1071352	1.12	2.299
2020-06-14	1100327	12084	277	1066887	21356	1078971	1.12	2.292
2020-06-15	1105719	12121	277	1072805	20793	1084926	1.12	2.285
2020-06-16	1119767	12155	278	1084980	22632	1097135	1.11	2.287
2020-06-17	1132823	12198	279	1099136	21489	1111334	1.10	2.287
2020-06-18	1145712	12257	280	1111741	21714	1123998	1.09	2.284
2020-06-19	1158063	12306	280	1124567	21190	1136873	1.08	2.275
2020-06-20	1170901	12373	280	1137058	21470	1149431	1.08	2.263
2020-06-21	1176463	12421	280	1143971	20071	1156392	1.07	2.254
2020-06-22	1182066	12438	280	1150225	19403	1162663	1.07	2.251
2020-06-23	1196012	12484	281	1161250	22278	1173734	1.06	2.251
2020-06-24	1208597	12535	281	1175817	20245	1188352	1.05	2.242
2020-06-25	1220478	12563	282	1189015	18900	1201578	1.05	2.245
2020-06-26	1232315	12602	282	1200885	18828	1213487	1.04	2.238
2020-06-27	1243780	12653	282	1211261	19866	1223914	1.03	2.229
2020-06-28	1251695	12715	282	1219975	19005	1232690	1.03	2.218
2020-06-29	1259954	12757	282	1228698	18499	1241455	1.03	2.211
2020-06-30	1273766	12799	282	1240157	20810	1252956	1.02	2.203
2020-07-01	1285231	12850	282	1252855	19526	1265705	1.02	2.195
2020-07-02	1295962	12904	282	1263276	19782	1276180	1.01	2.185
2020-07-03	1307761	12967	282	1273234	21560	1286201	1.01	2.175
2020-07-04	1319523	13030	283	1284172	22321	1297202	1.00	2.172
2020-07-05	1326055	13089	283	1291315	21651	1304404	1.00	2.162
2020-07-06	1331796	13137	284	1297367	21292	1310504	1.00	2.162
2020-07-07	1346194	13181	285	1309338	23675	1322519	1.00	2.162
2020-07-08	1359735	13243	285	1322479	24013	1335722	0.99	2.152
2020-07-09	1371771	13293	287	1334566	23912	1347859	0.99	2.159
2020-07-10	1384890	13338	288	1348025	23527	1361363	0.98	2.159
2020-07-11	1396941	13373	288	1360618	22950	1373991	0.97	2.154
2020-07-12	1402144	13417	289	1366897	21830	1380314	0.97	2.154
2020-07-13	1408312	13479	289	1372988	21845	1386467	0.97	2.144
2020-07-14	1420616	13512	289	1382815	24289	1396327	0.97	2.139
2020-07-15	1431316	13551	289	1394468	23297	1408019	0.96	2.133
2020-07-16	1441348	13612	291	1404332	23404	1417944	0.96	2.138
2020-07-17	1451017	13672	293	1414235	23110	1427907	0.96	2.143
2020-07-18	1460204	13711	294	1423570	22923	1437281	0.95	2.144
2020-07-19	1465299	13745	295	1429601	21953	1443346	0.95	2.146
2020-07-20	1470193	13771	296	1435120	21302	1448891	0.95	2.149
2020-07-21	1482390	13816	296	1444710	23864	1458526	0.95	2.142
2020-07-22	1492071	13879	297	1456441	21751	1470320	0.94	2.140
2020-07-23	1500854	13938	297	1465498	21418	1479436	0.94	2.131
2020-07-24	1510327	13979	298	1475789	20559	1489768	0.94	2.132
2020-07-25	1518634	14092	298	1484861	19681	1498953	0.94	2.115
2020-07-26	1522926	14150	298	1489562	19214	1503712	0.94	2.106
2020-07-27	1526974	14175	299	1494029	18770	1508204	0.94	2.109
2020-07-28	1537704	14203	300	1503057	20444	1517260	0.94	2.112
2020-07-29	1547307	14251	300	1513730	19326	1527981	0.93	2.105
2020-07-30	1556215	14269	300	1522928	19018	1537197	0.93	2.102
2020-07-31	1563796	14305	301	1531161	18330	1545466	0.93	2.104
2020-08-01	1571830	14336	301	1539216	18278	1553552	0.92	2.100
2020-08-02	1576246	14366	301	1544112	17768	1558478	0.92	2.095
2020-08-03	1579757	14389	301	1547967	17401	1562356	0.92	2.092
2020-08-04	1589780	14423	301	1556633	18724	1571056	0.92	2.087
2020-08-05	1598187	14456	302	1565241	18490	1579697	0.92	2.089
2020-08-06	1606487	14499	302	1573957	18031	1588456	0.91	2.083
2020-08-07	1613652	14519	303	1582065	17068	1596584	0.91	2.087
2020-08-08	1620514	14562	304	1589847	16105	1604409	0.91	2.088
2020-08-09	1624650	14598	305	1593249	16803	1607847	0.91	2.089
2020-08-10	1628303	14626	305	1597281	16396	1611907	0.91	2.085
2020-08-11	1637844	14660	305	1605695	17489	1620355	0.90	2.080
2020-08-12	1646652	14714	305	1614563	17375	1629277	0.90	2.073
2020-08-13	1654898	14770	305	1622330	17798	1637100	0.90	2.065

Rコード

データから検査陽性率、暫定致死率を計算し、表を作成

library(knitr)
date<- seq(as.Date("2020-02-01"), as.Date("2020-08-13"), by = "day")
検査を受けた人<-c(371,429,429,607,714,885,1130,1701,2340,2776,3629,5074,5797,6854,7519,7919,8171,
    9265,10411,12161,14816,19621,22633,28615,36716,46127,57990,70940,85693,96985,109591,125851,
    136707,146541,164740,178189,188518,196618,210144,222395,234998,    248647,261335,268212,274504,
    286716,295647,307024,316664,327509,331780,338036,348582,357896,364942,376961,387925,394141,
    395194,410564,421547,431743,443273,455032,461233,466804,477304,486003,494711,503051,510479,
    514621,518743,527438,534552,538775,546463,554834,559109,563035,571014,577959,583971,589520,
    595161,598285,601660,608514,614197,619881,623069,627562,630973,633921,640237,643095,649388,
    654863,660030,663886,668492,680890,695920,711484,726747,740645,747653,753211,765574,776433,
    788684,802418,814420,820289,826437,839475,852876,868666,885120,902901,910822,921391,939851,
    956852,973858,990960,1005305,1012769,1018214,1035997,1051972,1066888,1081486,1094704,1100327,
    1105719,1119767,1132823,1145712,1158063,1170901,1176463,1182066,1196012,1208597,1220478,1232315,
    1243780,1251695,1259954,1273766,1285231,1295962,1307761,1319523,1326055,1331796,1346194,1359735,
    1371771,1384890,1396941,1402144,1408312,1420616,1431316,1441348,1451017,1460204,1465299,1470193,
    1482390,1492071,1500854,1510327,1518634,1522926,1526974,1537704,1547307,1556215,1563796,1571830,
    1576246,1579757,1589780,1598187,1606487,1613652,1620514,1624650,1628303,1637844,1646652,1654898)
感染者数<-c(12,15,15,16,18,23,24,24,25,27,28,28,28,28,28,29,30,31,46,82,156,346,556,763,893,1146,
    1595,2022,2931,3526,4212,4812,5328,5766,6284,6767,7134,7382,7513,7755,7869,7979,8086,8162,
    8236,8320,8413,8565,8652,8799,8897,8961,9037,9137,9241,9332,9478,9583,9661,9786,9887,9976,
    10062,10156,10237,10284,10331,10384,10423,10450,10480,10512,10537,10564,10591,10613,10635,
    10653,10661,10674,10683,10694,10702,10708,10718,10728,10738,10752,10761,10765,10774,10780,
    10793,10801,10804,10806,10810,10822,10840,10874,10909,10936,10962,10991,11018,11037,11050,
    11065,11078,11110,11122,11142,11165,11190,11206,11225,11265,11344,11402,11441,11468,11503,
    11541,11590,11629,11668,11719,11776,11814,11852,11902,11947,12002,12051,12084,12121,12155,
    12198,12257,12306,12373,12421,12438,12484,12535,12563,12602,12653,12715,12757,12799,12850,
    12904,12967,13030,13089,13137,13181,13243,13293,13338,13373,13417,13479,13512,13551,13612,
    13672,13711,13745,13771,13816,13879,13938,13979,14092,14150,14175,14203,14251,14269,14305,
    14336,14366,14389,14423,14456,14499,14519,14562,14598,14626,14660,14714,14770)
死者<-c(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,2,4,7,8,11,12,13,16,17,22,28,32,35,42,44,50,51,
    54,60,66,67,72,75,75,81,84,91,94,102,104,111,120,126,131,139,144,152,158,162,165,169,174,
    177,183,186,192,200,204,208,211,214,217,222,225,229,230,232,234,236,237,238,240,240,240,242,
    243,244,246,247,248,250,250,252,254,255,256,256,256,256,256,258,259,260,260,262,262,263,263,
    263,264,264,266,266,267,269,269,269,269,269,270,271,272,273,273,273,273,273,273,274,276,276,
    277,277,277,277,278,279,280,280,280,280,280,281,281,282,282,282,282,282,282,282,282,282,283,
    283,284,285,285,287,288,288,289,289,289,289,291,293,294,295,296,296,297,297,298,298,298,299,
    300,300,300,301,301,301,301,301,302,302,303,304,305,305,305,305,305)
陰性<-c(289,327,414,462,522,693,842,1057,1355,1940,2736,4054,5099,6134,6853,7313,7733,8277,9335,10446,
    11953,13794,16038,19127,22550,28247,35298,44167,53608,61037,71580,85484,102965,118965,136624,
    151802,162008,171778,184179,196100,209402,222728,235615,243778,251297,261105,270888,282555,
    292487,303006,308343,315447,324105,334481,341332,352410,361883,369530,372002,383886,395075,
    403882,414303,424732,431425,437225,446323,457761,468779,477303,485929,490321,494815,502223,
    508935,513894,521642,530631,536205,540380,547610,555144,563130,569212,575184,578558,582027,
    588559,595129,600482,603610,608286,611592,614944,620575,624280,630149,635174,640037,642884,
    646661,653624,665379,679771,695854,711265,718943,726053,737571,748972,759473,770990,781686,
    788766,796142,806206,820550,834952,849161,865162,876060,885830,899388,917397,934030,950526,
    965632,974512,982026,996686,1013847,1029447,1045240,1059301,1066887,1072805,1084980,1099136,
    1111741,1124567,1137058,1143971,1150225,1161250,1175817,1189015,1200885,1211261,1219975,1228698,
    1240157,1252855,1263276,1273234,1284172,1291315,1297367,1309338,1322479,1334566,1348025,1360618,
    1366897,1372988,1382815,1394468,1404332,1414235,1423570,1429601,1435120,1444710,1456441,1465498,
    1475789,1484861,1489562,1494029,1503057,1513730,1522928,1531161,1539216,1544112,1547967,1556633,
    1565241,1573957,1582065,1589847,1593249,1597281,1605695,1614563,1622330)
検査中<- 検査を受けた人- (陰性+感染者数)
#df<- data.frame(date,感染者数,死者,検査を受けた人_感染者除く,陰性,検査中)
#kable(df,row.names=F)
df<- data.frame(検査を受けた人,感染者数,死者,陰性,検査中)
rownames(df)<- date
#
# 陽性率、暫定致死率を計算
結果判明 <- 感染者数 + 陰性
陽性率 <- round(感染者数/結果判明*100,2)
暫定致死率 <- round(死者/感染者数*100,3)
#
df2 <- data.frame(結果判明,感染者数,陰性,陽性率,死者,暫定致死率)
colnames(df2)<- c("結果判明","感染者数","陰性","陽性率(%)","死者","暫定致死率(%)")
rownames(df2)<- date
#kable(df2)
kable(merge(df,df2[,c(1,4,6)],by=0))

新型コロナウイルスのPCR検査実施人数と感染状況(韓国)

#日本のPCR検査実施人数と結果（結果判明した数）
Jpcr1<- c(rep(NA,6),151,NA,NA,174,NA,190,200,214,NA,NA,487,523,532)+c(rep(NA,6),566,NA,NA,764,NA,764,764,764,NA,NA,764,764,764)
# 3/19 : PCR検査実施人数が減少したのは、千葉県が人数でなく件数でカウントしていたことが判明したため、千葉県の件数を引いたことによる
Jpcr2<- c(603,693,778,874,913,1017,1061,1229,1380,1510,1688,1784,1855,5690,5948,6647,7200,7347,7457,8771,9195,9376,11231,
    12090,12197,12239,14322,14525,14072,18015,18134,18226+1173,18322+1189,22184+1417,21266+1426,22858+1484,24663+1513,
    26105+1530,26401+1530,26607+1530,30088+1580,32002+1677,32002+1679,36687+1930,39992+2061,40263+3547,40481+4862,48357+6125,
    52901+7768,54284+9274,57125+10817,61991+12071,63132+13420,63132+14741,72801+15921,76425+16982,81825+18049,86800+18743,
    91050+19446,91695+20292,94826+21070,101818+21903,107430+22328,112108+23046,117367+23404,122700+23925,123633+24612,
    124456+25407,133578+26139,136695+26731,137338+27442,145243+28078,152029+28669,153047+29375,153581+30176,154646+30868,156866+31232,
    157563+31638,169546+31638,179043+32125,180478+32949,183845+33530,188646+34174,188031+34807,196816+35499,194323+35730,
    203284+36255,206790+36833,211832+37490,216624+38222,218744+38704,221397+39346,224972+39701,227445+40203,229669+40703,
    230562+41297,233399+41942,235422+42391,237367+43097,240334+43600,242734+44191,244824+44783,246100+45640,248662+46892,
    251808+47640,254229+48575,257330+49303,260551+50067,262642+51012,263962+52057,267069+53155,269976+53870,273204+54697,
    276032+55346,279184+56148,280720+57209,281697+58392,284092+59605,286739+60483,334250+61354,340426+62125,345249+62944,
    347723+64117,351850+65272,357226+66712,360948+67704,365927+68739,370382+69528,375140+70620,378673+72270,380186+73594,
    385696+74921,390347+76268,396911+77568,402371+78677,408968+80490,412102+82233,414720+84349,422948+86216,430047+87334,
    438166+88551,449671+89911,459538+91291,464900+92893,466738+94538,477290+96313,488444+97433,499787+98623,516470+99750,
    524327+100993,531493+102675,534755+104237,550714+105992,562828+106962,579185+108022,587495+109188,593190+110381,
    602720+111734,606505+113167,630687+114713,648773+115744,667442+116953,687129+118109,704483+119436,714089+121486,
    724688+123598,750482+125823,769222+127289,808945+128965,830960+130126,853658+131614,867334+133118,880670+134698,
    887110+136296,920049+137286,945831+138662)+829
Jpcr<- c(Jpcr1,Jpcr2)
Confirmed<- c(rep(NA,6),25,NA,NA,26,NA,28,29,33,NA,NA,59,66,73,84,93,105,132,144,156,164,186,210,230,239,254,268,284,317,348,
    407,454,487,513,567,619,674,714,777,809,824,868,907,943,996,1046,1089,1128,1193,1291,1387,1499,1693,1866,1953,2178,
    2381,2617,2935,3271,3654,3906,4257,4768,5347,6005,6748,7255,7645,8100,8582,9167,9795,10361,10751,11119,11496,11919,
    12388,12829,13182,13385,13576,13852,14088,14281,14544,14839,15057,15231,15354,15463,15547,15649,15747,15798,15874,16024,
    16079,16193,16237,16285,16305,16365,16385,16424,16513,16536,16550,16581,16623,16651,16683,16719,16804,16851,16884,16930,
    16986,17018,17064,17103,17141,17174,17210,17251,17292,17332,17382,17429,17502,17587,17628,17668,17740,17799,17864,17916,
    17968,18024,18110,18197,18297,18390,18476,18593,18723,18874,19068,19282,19522,19775,19981,20174,20371,20719,21129,21502,
    21868,22220,22508,22890,23473,24132,24642,25096,25736,26303,27029,27956,28786,29382,29989,30961,31901,33049,34372,35836,
    36689,38687,39858,41129,42263,43815,45439,46783,47990,48928,50210,51147)
Deaths<- c(rep(NA,6),0,NA,NA,0,NA,0,0,1,NA,NA,1,1,1,1,1,1,1,1,1,1,3,4,5,5,6,6,6,6,6,6,6,7,9,12,15,19,21,22,24,28,29,31,33,35,36,
    41,42,43,45,46,49,52,54,56,57,60,63,69,70,73,80,81,85,88,94,98,102,109,119,136,148,154,161,171,186,277,287,317,334,348,
    351,376,389,415,432,458,492,510,521,543,551,557,600,613,621,643,668,687,710,725,744,749,763,771,777,796,808,820,830,846,
    858,867,874,886,891,892,894,900,903,907,914,916,916,916,919,920,922,924,925,925,927,931,935,935,952,953,953,955,963,968,
    969,971,971,972,972,974,975,976,977,977,977,978,980,981,982,982,982,982,982,984,985,985,985,985,985,988,989,990,992,993,
    996,996,998,1001,1004,1006,1011,1011,1012,1016,1022,1026,1033,1039,1040,1047,1052,1059,1063)
Jdf<- data.frame(Tested=Jpcr,Confirmed,Deaths)
kj<-paste0(round(結果判明[length(結果判明)]/max(Jpcr,na.rm=T),1),"倍")
#
Jpop<- 127103388
Kpop<- 49039986
#
jp<- round(max(Jpcr2,na.rm=T)*1000000/Jpop,0)
kr<- round(max(結果判明,na.rm=T)*1000000/Kpop,0)
#
# 指数表示を抑制
options(scipen=2) 
#png("pcr04.png",width=800,height=600)
par(mar=c(4,6,4,2),family="serif")
b<- barplot(t(df[,c(2,4,5)]),names.arg=gsub("2020-","",rownames(df)),col=c("red","lightblue","gray80"),
    ylim= c(0,max(検査を受けた人)*1.1),yaxt ="n",
    legend=T,args.legend = list(x="topleft",inset=c(0.03,0.03)))
# Add comma separator to axis labels
axis(side=2, at=axTicks(2), labels=formatC(axTicks(2), format="d", big.mark=','),las=1)  
#text(x=b,y=検査を受けた人,labels= 検査を受けた人,pos=3,col="blue")
points(x=b,y=Jpcr,pch=16)
lines(x=b,y=Jpcr,pch=16,lwd=2)
legend(x="topleft",inset=c(0.03,0.2),bty="n",legend="日本のPCR検査実施人数(データ：厚生労働省HP)\n(注意)一部自治体について件数を計上しているため、実際の人数より過大である。",pch=16,lwd=2)
legend(x="topleft",inset=c(0.01,0.28),bty="n",legend="* 韓国の人口は日本の約４１％",cex=1.2)
legend(x="topleft",inset=c(0.01,0.33),bty="n",legend=paste("* PCR検査で結果判明した数は日本の",kj),cex=1.2)
legend(x="topleft",inset=c(0.01,0.38),bty="n",legend="（日本：チャーター便帰国者及び空港検疫も含む）",cex=1.2)
legend("topleft",inset=c(0.27,-0.05),cex=1.5,bty="n",
    legend=paste("PCR検査数(人口100万あたり)\n　・日本： ",jp,"人\n　・韓国：",kr,"人(結果判明した数)"),text.col="blue")
title("韓国と日本のPCR検査実施人数の推移",cex.main=2)
#dev.off()

日本と韓国の新型コロナウイルスによる死亡者数推移(累計で計算)

# 日本、韓国の人口
# DataComputingパッケージの"CountryData"より
Jpop<- 127103388
Kpop<- 49039986
#
date2<- sub("-","/",sub("-0","-",sub("^0","",sub("2020-","",date))))
Jpos <- Deaths
#
jp<- round(max(Jpos,na.rm=T)*1000000/Jpop,2)
kr<- round(max(死者,na.rm=T)*1000000/Kpop,2)
#
ylim<- c(0,max(c(Jpos,死者),na.rm=T)*1.1)
#png("pcr04_2.png",width=800,height=600)
par(mar=c(5,6,4,2),family="serif")
plot(死者,type="o",pch=16,col="blue",lwd=2,xaxt="n",xlab="",ylab="死亡者数(人)",las=1,ylim=ylim,bty="n")
box(bty="l",lwd=2)
lines(Jpos,col="red",lwd=2)
points(Jpos,col="red",pch=16)
#表示するx軸ラベルを指定
axis(1,at=1:length(date2),labels =NA,tck= -0.01)
labels<- date2
labelpos<- paste0(rep(1:12,each=3),"/",c(1,10,20))
axis(1,at=1,labels =labels[1],tick=F)
for (i in labelpos){
    at<- match(i,labels)
    if (!is.na(at)){ axis(1,at=at,labels = i,tck= -0.02)}
    }
legend("topleft",inset=0.03,pch=16,lwd=2,cex=1.5,col=c("red","blue"),legend=c("日本","韓国"),bty="n")
legend("topleft",inset=c(0,0.15),cex=1.5,bty="n",
    legend=paste("新型コロナウイルスによる死亡者数(人口100万あたり)\n　・日本：",jp,"(5/14 韓国を追い抜く)\n　・韓国：",kr))
title("日本と韓国の新型コロナウイルスによる死亡者数推移","Data : 日本(厚生労働省の報道発表資料) 韓国(KCDC)",cex.main=2)
#dev.off()

日本と韓国のPCR検査の検査陽性率(%)推移(累計で計算)

date2<- sub("-","/",sub("-0","-",sub("^0","",sub("2020-","",date))))
Jpos <- round(Confirmed/Jpcr*100,2)
ylim<- c(0,max(c(Jpos,df2$"陽性率(%)"),na.rm=T)*1.1)
#png("pcr05.png",width=800,height=600)
par(mar=c(5,6,4,2),family="serif")
plot(df2$"陽性率(%)",type="o",pch=16,col="blue",lwd=2,xaxt="n",xlab="",ylab="陽性率(%)",las=1,ylim=ylim,bty="n")
box(bty="l",lwd=2)
lines(Jpos,col="red",lwd=2)
points(Jpos,col="red",pch=16)
#表示するx軸ラベルを指定
axis(1,at=1:length(date2),labels =NA,tck= -0.01)
labels<- date2
labelpos<- paste0(rep(1:12,each=3),"/",c(1,10,20))
axis(1,at=1,labels =labels[1],tick=F)
for (i in labelpos){
    at<- match(i,labels)
    if (!is.na(at)){ axis(1,at=at,labels = i,tck= -0.02)}
    }
legend("topleft",inset=0.03,pch=16,lwd=2,cex=1.5,col=c("red","blue"),legend=c("日本","韓国"),bty="n")
title("日本と韓国のPCR検査の検査陽性率(%)の推移","Data : 日本(厚生労働省の報道発表資料) 韓国(KCDC)",cex.main=2)
#dev.off()

日本と韓国のPCR検査の暫定致死率(%)推移(累計で計算)

date2<- sub("-","/",sub("-0","-",sub("^0","",sub("2020-","",date))))
Jpos <- round(Deaths/Confirmed*100,2)
ylim<- c(0,max(c(Jpos,df2$"暫定致死率(%)"),na.rm=T)*1.1)
#png("pcr06.png",width=800,height=600)
par(mar=c(5,6,4,2),family="serif")
plot(df2$"暫定致死率(%)",type="o",pch=16,col="blue",lwd=2,xaxt="n",xlab="",ylab="暫定致死率(%)",las=1,ylim=ylim,bty="n")
box(bty="l",lwd=2)
lines(Jpos,col="red",lwd=2)
points(Jpos,col="red",pch=16)
#表示するx軸ラベルを指定
axis(1,at=1:length(date2),labels =NA,tck= -0.01)
labels<- date2
labelpos<- paste0(rep(1:12,each=3),"/",c(1,10,20))
axis(1,at=1,labels =labels[1],tick=F)
for (i in labelpos){
    at<- match(i,labels)
    if (!is.na(at)){ axis(1,at=at,labels = i,tck= -0.02)}
    }
legend("topleft",inset=0.03,pch=16,lwd=2,cex=1.5,col=c("red","blue"),legend=c("日本","韓国"),bty="n")
title("日本と韓国の暫定致死率(%)の推移","Data : 日本(厚生労働省の報道発表資料) 韓国(KCDC)",cex.main=2)
#dev.off()

週単位の陽性者増加比(日本、韓国)

library(TTR)
jpkr<- data.frame(Japan=Confirmed,"South_Korea"=感染者数)
rownames(jpkr)<- sub("-","/",sub("-0","-",sub("^0","",sub("2020-","",date))))
#（日本のデータ）欠損値が多い箇所は外す
jpkr<- jpkr[17:nrow(jpkr),]
#
#grep("TRUE",is.na(jpkr$Japan))
#jpkr$Japan[grep("TRUE",is.na(jpkr$Japan))]<- (jpkr$Japan[grep("TRUE",is.na(jpkr$Japan))-1]+jpkr$Japan[grep("TRUE",is.na(jpkr$Japan))+1])/2
#
x<- apply(jpkr,2,diff)
fun<- function(x){round(runSum(x,n=7)/(runSum(x,n=14) -runSum(x,n=7)),2)}
jpkr2<- apply(x,2,fun)
# InfにNAを入れる
#jpkr2[jpkr2==Inf]<- NA
jpkr2<- data.frame(jpkr2)
rownames(jpkr2)<- rownames(jpkr)[-1]
#
pdat<- jpkr2[14:nrow(jpkr2),]
#png("pcr06_2.png",width=800,height=600)
par(mar=c(5,6,4,7),family="serif")
matplot(pdat,type="l",lwd=2,las=1,lty=1,ylim=c(0,5),col=c("red","blue"),xlab="",ylab="",xaxt="n",bty="n")
box(bty="l",lwd=2.5)
abline(h=1,lty=2,col="darkgreen",lwd=1.5)
labels<-gsub("^.*/","",rownames(pdat))
pos<-gsub("/.*$","",rownames(pdat))
axis(1,at=1:nrow(pdat),labels =NA)
#月の区切り
#axis(1,at=cumsum(as.vector(table(pos)))+0.5, labels =NA,tck=-0.1,lty=2 ,lwd=1)
for (i in c("1","10","20")){
    at<- grep("TRUE",is.element(labels,i))
    axis(1,at=at,labels = rep(i,length(at)))
    }
#Month<-c("January","February","March","April","May","June","July","August","September","October","November","December")
Month<-c("Jan.","Feb.","Mar.","Apr.","May","Jun.","Jul.","Aug.","Sep.","Oct.","Nov.","Dec.")
#cut(1:12,breaks = seq(0,12),right=T, labels =Month)
mon<-cut(as.numeric(names(table(pos))),breaks = seq(0,12),right=T, labels =Month)
# 月の中央
#mtext(text=mon,at=cumsum(as.vector(table(pos)))-as.vector(table(pos)/2),side=1,line=2) 
# 月のはじめ
mtext(text=mon,at=1+cumsum(as.vector(table(pos)))-as.vector(table(pos)),side=1,line=2) 
text(x=par("usr")[2],y=pdat[nrow(pdat),],labels=colnames(pdat),xpd=T,pos=1)
arrows(par("usr")[2]*1.08, 1.1,par("usr")[2]*1.08,1.68,length = 0.2,lwd=2.5,xpd=T)
text(x=par("usr")[2]*1.08,y=1.9,labels="増加\n傾向",xpd=T)
arrows(par("usr")[2]*1.08, 0.9,par("usr")[2]*1.08,0.32,length = 0.2,lwd=2.5,xpd=T)
text(x=par("usr")[2]*1.08,y=0.1,labels="減少\n傾向",xpd=T)
title("週単位の陽性者増加比(日本、韓国)",cex.main=1.5)
dev.off()

韓国のPCR検査の結果（日別）

dat<-rbind(diff(df2$感染者数),diff(df2$陰性))
rownames(dat)<- c("陽性","陰性")
colnames(dat)<- gsub("2020-","",rownames(df2[-1,]))
#png("pcr08.png",width=800,height=600)
par(mar=c(4,6,4,2),family="serif")
barplot(dat,names=gsub("2020-","",rownames(df[-1,])),col=c("red","lightblue"),las=1,legend=T,
    args.legend=list(x="topleft",inset=c(0.03,0.03)))
title("韓国のPCR検査の結果（日別）",cex.main=2)
#dev.off()

日本と韓国の検査陽性者数（日別）

date2<- sub("-","/",sub("-0","-",sub("^0","",sub("2020-","",date[-1]))))
ylim<- max(max(diff(Jdf$Confirmed),na.rm=T),max(diff(df$感染者数),na.rm=T))*1.2
#png("pcr07.png",width=800,height=600)
par(mar=c(4,6,4,2),family="serif")
barplot(diff(Jdf$Confirmed),col=rgb(1,0,0,alpha=0.5),axes=F,ylim=c(0,ylim))
barplot(diff(df$感染者数),names=date2,col=rgb(0,1,0,alpha=0.5),las=1,add=T,ylim=c(0,ylim))
legend("topleft",inset=c(0.03,0.08),pch=15,col=c(rgb(1,0,0,alpha=0.5),rgb(0,1,0,alpha=0.5)),legend=c("日本","韓国"),bty="n",cex=1.5)
title("日本と韓国の検査陽性者数（日別）",cex.main=1.5)
#dev.off()

日本と韓国の検査者数（韓国の場合は「結果が判明した数」）（日別）

date2<- sub("-","/",sub("-0","-",sub("^0","",sub("2020-","",date[-1]))))
kdf<- diff(結果判明)
jdf<- diff(Jpcr)
ymin<- min(min(kdf,na.rm=T),min(jdf,na.rm=T))
ymax<- max(max(kdf,na.rm=T),max(jdf,na.rm=T))
#png("pcr07_2.png",width=800,height=600)
par(mar=c(4,6,4,2),family="serif")
plot(jdf,type="o",pch=16,cex=1,lwd=2,col="red",xlab="",ylab="",xaxt="n",yaxt="n",bty="n",ylim=c(ymin,ymax),
    panel.first=grid(NA,NULL,lty=2,col="darkgray"))
box(bty="l",lwd=2)
lines(kdf,lwd=2,col="blue")
points(kdf,pch=16,cex=1,col="blue")
axis(side=2, at=axTicks(2), labels=formatC(axTicks(2), format="d", big.mark=','),las=1) 
#表示するx軸ラベルを指定
axis(1,at=1:length(date2),labels =NA,tck= -0.01)
labels<- date2
labelpos<- paste0(rep(1:12,each=3),"/",c(1,10,20))
axis(1,at=1,labels =labels[1],tick=F)
for (i in labelpos){
    at<- match(i,labels)
    if (!is.na(at)){ axis(1,at=at,labels = i,tck= -0.02)}
    }
for(i in 1:(length(jdf)-1)){
    polygon(c(i,i,i+1,i+1), c(0,jdf[i],jdf[i+1], 0), col = rgb(1,0,0,alpha=0.5), lty=0)
}
for(i in 1:(length(kdf)-1)){
    polygon(c(i,i,i+1,i+1), c(0,kdf[i],kdf[i+1], 0), col = rgb(0,0,1,alpha=0.5), lty=0)
}
legend("topleft",inset=0.03,pch=16,lwd=2,cex=1.5,col=c("red","blue"),legend=c("日本","韓国"),bty="n")
legend("topleft",inset=c(0.03,0.15),cex=1.2,
    legend="日本の６月１８日の検査人数が極端に多いのは\n東京都が医療機関等の行った検査の検査人数を過去に遡って計上しているため",bty="n")
title("日本と韓国の検査者数（韓国の場合は「結果が判明した数」）（日別）",cex.main=1.5)
#dev.off()

日本と韓国のPCR検査の検査陽性率(%)の推移(日別)

date2<- sub("-","/",sub("-0","-",sub("^0","",sub("2020-","",date[-1]))))
Jpos <- (diff(Confirmed)/diff(Jpcr))*100
Kpos <- (diff(感染者数)/diff(感染者数+陰性))*100
#ylim<- c(0,max(c(Jpos,df2$"陽性率(%)"),na.rm=T)*1.1)
#png("pcr07_3.png",width=800,height=600)
par(mar=c(5,6,4,2),family="serif")
plot(Jpos,type="o",pch=16,col="red",lwd=2,xaxt="n",xlab="",ylab="陽性率(%)",las=1,bty="n",ylim=c(0,12))
box(bty="l",lwd=2)
lines(Kpos,col="blue",lwd=2)
points(Kpos,col="blue",pch=16)
#表示するx軸ラベルを指定
axis(1,at=1:length(date2),labels =NA,tck= -0.01)
labels<- date2
labelpos<- paste0(rep(1:12,each=3),"/",c(1,10,20))
axis(1,at=1,labels =labels[1],tick=F)
for (i in labelpos){
    at<- match(i,labels)
    if (!is.na(at)){ axis(1,at=at,labels = i,tck= -0.02)}
    }
legend("topleft",inset=0.03,pch=16,lwd=2,cex=1.5,col=c("red","blue"),legend=c("日本","韓国"),bty="n")
title("日本と韓国のPCR検査の検査陽性率(%)の推移(日別)","Data : 日本(厚生労働省の報道発表資料) 韓国(KCDC)",cex.main=2)
#dev.off()

韓国の(報告された)感染者数 対数表示（日別）

date2<- sub("-","/",sub("-0","-",sub("^0","",sub("2020-","",date[-1]))))
dat<- diff(df2$感染者数)
dat[dat==0]<- NA
dat2<- diff(df2$結果判明)
ylim<- c(0.9,max(dat2,na.rm=T)*1.5)
#png("pcr08_2.png",width=800,height=600)
par(mar=c(4,5,4,2),family="serif")
b<- barplot(rep(NA,length(dat)),names=date2,las=1,log="y",ylim=ylim)
abline(h=10^(0:4),col="darkgray",lwd=1.2,lty=3)
for (i in 1:9){
    abline(h=i*10^(0:4),col="darkgray",lwd=0.8,lty=3)
}
barplot(dat,col="red",las=1,log="y",ylim=ylim,axes=F,add=T)
lines(x=b,y=dat2,lwd=2,col="darkgreen")
points(x=b,y=dat2,pch=16,col="darkgreen")
#text(x=par("usr")[2],y=dat2[length(dat2)],labels="結果判明",col="darkgreen",xpd=T)
legend("topleft",inset=0.03,bty="n",legend="PCR検査結果判明\nConfirmed+Tested negative",lwd=2,lty=1,pch=16,col="darkgreen")
title("韓国の検査陽性者数 対数表示（日別）",cex.main=1.5)
#dev.off()

日本の(報告された)感染者数 対数表示（日別）

date2<- sub("-","/",sub("-0","-",sub("^0","",sub("2020-","",date[-1]))))
dat<- diff(Jdf$Confirmed)
dat[dat==0]<- NA
dat2<- diff(Jdf$Tested)
# 韓国のグラフにyの範囲を揃える
ylim<- c(0.9,max(diff(df2$結果判明),na.rm=T)*1.5)
#png("pcr08_3.png",width=800,height=600)
par(mar=c(4,5,4,),family="serif")
b<- barplot(rep(NA,length(dat)),names=date2,las=1,log="y",ylim=ylim)
abline(h=10^(0:4),col="darkgray",lwd=1.2,lty=3)
for (i in 1:9){
    abline(h=i*10^(0:4),col="darkgray",lwd=0.8,lty=3)
}
barplot(dat,col="red",las=1,log="y",ylim=ylim,axes=F,add=T)
lines(x=b,y=dat2,lwd=2,col="darkgreen")
points(x=b,y=dat2,pch=16,col="darkgreen")
legend("topleft",inset=0.03,bty="n",legend="PCR検査実施人数",lwd=2,lty=1,pch=16,col="darkgreen")
title("日本の検査陽性者数 対数表示（日別）",cex.main=1.5)
#dev.off()

日本、韓国、台湾、シンガポール、香港のReported Confirmed(報告された感染者)を計算、プロット

# read.csvの際には、check.names=Fをつける
url<- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_confirmed_global.csv"
Confirmed<- read.csv(url,check.names=F)
# Country/Regionごとに集計
#Confirmed
Ctl<- aggregate(Confirmed[,5:ncol(Confirmed)], sum, by=list(Confirmed$"Country/Region"))
rownames(Ctl)<-Ctl[,1]
Ctl<- Ctl[,-1]
#Japan,South Korea,Taiwan,Singapore
datC<-Ctl[grep("(Japan|Korea, South|Taiwan*|Singapore)",rownames(Ctl)),] 
#Hong Kong
HK<- Confirmed[Confirmed$"Province/State"=="Hong Kong",5:ncol(Confirmed)]
rownames(HK)<- "Hong Kong"
datC<- rbind(datC,HK)
datC[datC<0]<- NA
#png("pcr11.png",width=800,height=600)
par(mar=c(4,5,4,10),family="serif")
matplot(t(datC),type="l",lty=1,lwd=3,xaxt="n",yaxt="n",bty="n",ylab="",xaxs="i")
box(bty="l",lwd=2)
#y軸ラベル
axis(side=2, at=axTicks(2), labels=formatC(axTicks(2), format="d", big.mark=','),las=1) 
#表示するx軸ラベルを指定
labels<- sub("/20","",colnames(datC))
#日
labels<-gsub("^.*/","",labels)
#月
pos<-gsub("/.*$","",sub("/20","",colnames(datC)))
axis(1,at=1:ncol(datC), labels =NA,tck= -0.01)
for (i in c("1","10","20")){
    at<- grep("TRUE",is.element(labels,i))
    axis(1,at=at,labels = rep(i,length(at)))
    }
Month<-c("Jan.","Feb.","Mar.","Apr.","May","Jun.","Jul.","Aug.","Sep.","Oct.","Nov.","Dec.")
mon<-cut(as.numeric(names(table(pos))),breaks = seq(0,12),right=T, labels =Month)
# 月の中央
#mtext(text=mon,at=cumsum(as.vector(table(pos)))-as.vector(table(pos)/2),side=1,line=2) 
# 月のはじめ
mtext(text=mon,at=1+cumsum(as.vector(table(pos)))-as.vector(table(pos)),side=1,line=2) 
text(x=par("usr")[2],y=apply(datC,1,max,na.rm=T),labels=paste(rownames(datC),":",formatC(apply(datC,1,max,na.rm=T), format="d", big.mark=',')),pos=4,xpd=T)
title("Reported Confirmed : Japan , South Korea , Taiwan , Singapore , Hong Kong")
#dev.off()

日本、韓国、台湾、シンガポール、香港の致死率を計算、プロット

url<- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_global.csv"
Deaths<- read.csv(url,check.names=F)
#Deaths
Dtl<- aggregate(Deaths[,5:ncol(Deaths)], sum, by=list(Deaths$"Country/Region"))
rownames(Dtl)<-Dtl[,1]
Dtl<- Dtl[,-1]
#
datD<-Dtl[grep("(Japan|Korea, South|Taiwan*|Singapore)",rownames(Dtl)),] 
#Hong Kong
HK<- Deaths[Deaths$"Province/State"=="Hong Kong",5:ncol(Deaths)]
rownames(HK)<- "Hong Kong"
datD<- rbind(datD,HK)
datD[datD<0]<- NA
datD<- datD[order(apply(datD,1,max,na.rm=T),decreasing=T),]
# 亡くなった人の数
knitr::kable(apply(datD,1,max,na.rm=T))
#
# 致死率(%)計算
#DpC<- matrix(NA,nrow=nrow(datD),ncol=ncol(datD))
DpC<- NULL
for (i in rownames(datD)){
    temp<- round(datD[rownames(datD)== i,] / datC[rownames(datC)== i,]*100,2)
    DpC<- rbind(DpC,temp)
}
#
DpC<- DpC[order(DpC[,ncol(DpC)],decreasing=T),]
n<-nrow(DpC)
col<- rainbow(n)
#pch<-rep(c(0,1,2,4,5,6,15,16,17,18),3)
#png("Coronavirus01_1_2.png",width=800,height=600)
par(mar=c(3,5,4,10),family="serif")
#40日めから
matplot(t(DpC)[40:ncol(DpC),],type="l",lty=1,lwd=3,las=1,col=col,ylab="Reported Deaths/Reported Confirmed(%)",xaxt="n",bty="n")
box(bty="l",lwd=2)
axis(1,at=1:nrow(t(DpC)[40:ncol(DpC),]),labels=sub("/20","",rownames(t(DpC)[40:ncol(DpC),])))
legend(x=par("usr")[2],y=par("usr")[4],legend=rownames(DpC),lty=1,lwd=3,col=col,bty="n",title="Country/Region",xpd=T)
title("Reported Deaths / Reported Confirmed (%) ")
#dev.off()

日本、韓国、台湾、シンガポール、香港の面積、人口、人口密度

library(DataComputing)
library(knitr)
data("CountryData")
adata<- CountryData[grep("(Japan|Korea, South|Taiwan|Singapore|Hong Kong)",CountryData$country),1:3]
# 人口密度計算
adata$"Population density"<- round(adata$pop/adata$area,0)
#人口で並べ替える(降順)
adata<- adata[order(adata$pop,decreasing=T),]
kable(data.frame(lapply(adata,function(x)formatC(x, format="f", big.mark=",",digits=0))),
    row.names=F,align=c("c",rep("r",3)))

表

library(knitr)
x<- as.data.frame(apply(datC,1,max,na.rm=T))
colnames(x)<- "Confirmed"
y<- as.data.frame(apply(datD,1,max,na.rm=T))
colnames(y)<- "Deaths"
x<- merge(x,y,by =0)
rownames(x)<- x[,1]
x<- x[,-1]
x$"Deaths/Confirmed (%)"<- round(x[,2]/x[,1]*100,2)
rownames(x)<- sub("\\*","",rownames(x))
x<- merge(x,adata[,c(1,3)],by.x=0,by.y="country")
x$"Deaths/millionpeople"<- round(x$Deaths/x$pop*1000000,2)
x[,1]<-factor(x[,1],levels=c("Japan","Korea, South","Taiwan" ,"Hong Kong", "Singapore"))
x<- x[order(x[,1],decreasing=F),]
kable(data.frame(Confirmed=formatC(x[,2], format="f", big.mark=",",digits=0),x[,c(3:4,6)],check.names=F,row.names=x[,1]),
    row.names=T,align=rep("r",3))

日本、韓国、台湾、シンガポール、香港の100万人あたりの新型コロナウイルスによる死者数

# Deaths/millionpeopleで並べ替え
dat<- x[order(x[,"Deaths/millionpeople"]),]
#png("DperMil01.png",width=800,height=600)
par(mar=c(7,7,3,2),family="serif")
b<- barplot(dat[,"Deaths/millionpeople"],horiz=T,col="pink",xaxt="n",names=dat[,1],xlim=c(0,max(dat[,"Deaths/millionpeople"])*1.2),las=1)
axis(side=1, at=axTicks(1), labels=formatC(axTicks(1), format="d", big.mark=','))
text(x=dat[,"Deaths/millionpeople"],y=b,labels= dat[,"Deaths/millionpeople"],pos=4)
title("日本、韓国、台湾、シンガポール、香港の人口100万人あたりの新型コロナウイルスによる死者数")
#dev.off()

新型コロナウイルスによる死者数 in アジア

アジアの国のデータ：How many Countries in Asia?:https://www.worldometers.info/geography/how-many-countries-in-asia/ に台湾のデータを加えた。
（注意）日本語名は手打ちしているのでもしかしたら間違いがあるかもしれません。

text<- "country,Population(2020),Subregion,Jname
Turkey,84339067,Western Asia,トルコ
Iraq,40222493,Western Asia,イラク
Saudi Arabia,34813871,Western Asia,サウジアラビア
Yemen,29825964,Western Asia,イエメン
Syria,17500658,Western Asia,シリア
Jordan,10203134,Western Asia,ヨルダン
Azerbaijan,10139177,Western Asia,アゼルバイジャン
United Arab Emirates,9890402,Western Asia,アラブ首長国連邦
Israel,8655535,Western Asia,イスラエル
Lebanon,6825445,Western Asia,レバノン
Oman,5106626,Western Asia,オマーン
State of Palestine,5101414,Western Asia,パレスチナ
Kuwait,4270571,Western Asia,クエート
Georgia,3989167,Western Asia,グルジア
Armenia,2963243,Western Asia,アルメニア
Qatar,2881053,Western Asia,カタール
Bahrain,1701575,Western Asia,バーレーン
Cyprus,1207359,Western Asia,キプロス
India,1380004385,Southern Asia,インド
Pakistan,220892340,Southern Asia,パキスタン
Bangladesh,164689383,Southern Asia,バングラデシュ
Iran,83992949,Southern Asia,イラン
Afghanistan,38928346,Southern Asia,アフガニスタン
Nepal,29136808,Southern Asia,ネパール
Sri Lanka,21413249,Southern Asia,スリランカ
Bhutan,771608,Southern Asia,ブータン
Maldives,540544,Southern Asia,モルジブ
Indonesia,273523615,South-Eastern Asia,インドネシア
Philippines,109581078,South-Eastern Asia,フィリピン
Vietnam,97338579,South-Eastern Asia,ベトナム
Thailand,69799978,South-Eastern Asia,タイ
Myanmar,54409800,South-Eastern Asia,ミャンマー
Malaysia,32365999,South-Eastern Asia,マレーシア
Cambodia,16718965,South-Eastern Asia,カンボジア
Laos,7275560,South-Eastern Asia,ラオス
Singapore,5850342,South-Eastern Asia,シンガポール
Timor-Leste,1318445,South-Eastern Asia,東ティモール
Brunei,437479,South-Eastern Asia,ブルネイ
China,1439323776,Eastern Asia,中国
Japan,126476461,Eastern Asia,日本
South Korea,51269185,Eastern Asia,韓国
North Korea,25778816,Eastern Asia,北朝鮮
Mongolia,3278290,Eastern Asia,モンゴル
Uzbekistan,33469203,Central Asia,ウズベキスタン
Kazakhstan,18776707,Central Asia,カザクスタン
Tajikistan,9537645,Central Asia,タジキスタン
Kyrgyzstan,6524195,Central Asia,キルギスタン
Turkmenistan,6031200,Central Asia,トルクメニスタン
Taiwan,23816775,Eastern Asia,台湾"
#
asia<- read.csv(text=text,check.names=F)
# 米ジョンズ・ホプキンス大学のデータは、「Taiwan*」 , 「Korea, South」となっているので上のデータと一致させる。
rownames(Dtl)<- gsub("\\*","",rownames(Dtl))
rownames(Dtl)<- gsub("Korea, South","South Korea",rownames(Dtl))
asia$country[!is.element(asia$country,rownames(Dtl))]
#[1] State of Palestine Myanmar            North Korea        Turkmenistan
#
dat<-Dtl[is.element(rownames(Dtl),asia$country),] 
#
# 一番新しい日のデータのみ取り出す。
df<- dat[,ncol(dat),drop=F]
names(df)<- "Deaths"
nrow(df)
df<- merge(df,asia,by.x=0,by.y="country")
nrow(df)
df<- df[order(df$Deaths,decreasing=F),]
knitr::kable(df,row.names=F)
df$Subregion<- factor(df$Subregion,
    levels=c("Central Asia","Eastern Asia","South-Eastern Asia","Southern Asia","Western Asia"))

新型コロナウイルスによる死者数 in アジア

# 東アジアの国の名前を赤
col<- ifelse(is.element(df$Subregion,c("Eastern Asia")),"red","black")
#png("CdeathsA01.png",width=800,height=800)
par(mar=c(3,8,4,2),family="serif")
b<- barplot(df$Deaths,las=1,col=as.numeric(unclass(df$Subregion)),horiz=T,xlim=c(0,max(df$Deaths,na.rm=T)*1.2),xaxt="n")
axis(side=1, at=axTicks(1), labels=formatC(axTicks(1), format="d", big.mark=','))
axis(2, at = b,labels=NA,tck= -0.008)
text(x=par("usr")[1],y=b, labels = df$Jname, col=col,pos=2,xpd=T,font=3)
title("新型コロナウイルスによる死者数 in アジア\n(データのない国 : Myanmar,North Korea,Turkmenistan,State of Palestine)",
    cex.main=1.5)
legend("bottomright",inset=c(0.15,0.05),legend=c("Central Asia","Eastern Asia","South-Eastern Asia","Southern Asia","Western Asia"),
    pch=15,col=1:5,cex=1.5,bty="n",title="Subregion")
#dev.off()

新型コロナウイルスによる人口100万人あたりの死者数 in アジア

df$DpP <- round(1000000*df$Deaths/df$"Population(2020)",2)
df<- df[order(df$DpP,decreasing=F),]
#
# 東アジアの国の名前を赤
col<- ifelse(is.element(df$Subregion,c("Eastern Asia")),"red","black")
#png("CdeathsA02.png",width=800,height=800)
par(mar=c(3,8,4,2),family="serif")
b<- barplot(df$DpP,las=1,col=as.numeric(unclass(df$Subregion)),horiz=T,xlim=c(0,max(df$DpP,na.rm=T)*1.2))
axis(2, at = b,labels=NA,tck= -0.008)
text(x=par("usr")[1],y=b,labels = df$Jname,col=col,pos=2,xpd=T,font=3)
title("新型コロナウイルスによる人口100万人あたりの死者数 in アジア\n(データのない国 : Myanmar,North Korea,Turkmenistan,State of Palestine)",
    cex.main=1.5)
legend("bottomright",inset=c(0.15,0.05),legend=c("Central Asia","Eastern Asia","South-Eastern Asia","Southern Asia","Western Asia"),
    pch=15,col=1:5,cex=1.5,bty="n",title="Subregion")
#dev.off()

「人口あたりの死者数」で評価した「日本モデル」より優秀なモデル in アジア

jdeath<- df$DpP[is.element(df$Row.names,c("Japan"))]
paste(df$Jname[df$DpP< jdeath],"モデル")

日本、韓国、台湾、シンガポール、香港のTotal Tests for COVID-19

library("rvest")
# "COVID-19 testing"のデータ取得
html <- read_html("https://en.wikipedia.org/wiki/COVID-19_testing")
tbl<- html_table(html,fill = T)
# "covid19-testing"のtableが何番目か見つける
nodes<- html_nodes(html, "table")
class<-html_attr(nodes,"class")
#num<-grep("plainrowheaders",class)
num<- 3
#
Wtest<- tbl[[num]][,c(1:3,5:8)]
str(Wtest)
#
for (i in c(3:7)){
    Wtest[,i]<- as.numeric(gsub(",","",Wtest[,i]))
}
str(Wtest)
save("Wtest",file="Wtest.Rdata")
#load("Wtest.Rdata")
#asia5<- Wtest[grep("(Japan|South Korea|Singapore|Taiwan|Hong Kong)",Wtest[,1]),]

(注)国と地域の表が別になっていた

num<- 5
#
Wtest2<- tbl[[num]][,1:8]
str(Wtest2)
#
for (i in 4:8){
    Wtest2[,i]<- as.numeric(gsub(",","",Wtest2[,i]))
}
str(Wtest2)
save("Wtest2",file="Wtest2.Rdata")
(asia5<- Wtest[grep("(Japan|South Korea|Singapore|Taiwan)",Wtest[,1]),])
colnames(asia5)[1]<- "Country or Subdivision"
colnames(asia5)[2]<- "Date"
colnames(asia5)[3]<- "Tested"
colnames(asia5)[6]<- "Tested /millionpeople"
(asia5 <- asia5[!is.na(asia5[,4]),])
temp<- Wtest2[grep("(Taiwan|Hong Kong)",Wtest2[,"Subdivision"]),]
(temp <- temp[!is.na(temp[,4]),2:8])
colnames(temp)[1]<- "Country or Subdivision"
colnames(temp)[2]<- "Date"
( asia5<- rbind(asia5,temp) )

日本、韓国、台湾、シンガポール、香港のTotal Tests for COVID-19

# Testedで並べ替え
dat<- asia5[order(asia5[,"Tested"]),]
#png("pcr09.png",width=800,height=600)
par(mar=c(7,7,3,2),family="serif")
b<- barplot(dat[,"Tested"],horiz=T,col="pink",xaxt="n",names=dat[,1],xlim=c(0,max(dat[,"Tested"])*1.2),las=1)
axis(side=1, at=axTicks(1), labels=formatC(axTicks(1), format="d", big.mark=','))
text(x=dat[,"Tested"],y=b,labels= paste("As of",dat[,"Date"],"\n",formatC(dat[,"Tested"],format="d",big.mark=',')),pos=4)
title("Total Tests for COVID-19(Japan,South Korea,Singapore,Taiwan,Hong Kong)",
    "Data : [Wikipedia:COVID-19 testing](https://en.wikipedia.org/wiki/COVID-19_testing)")
#dev.off()

日本、韓国、台湾、シンガポール、香港の検査陽性率(%) Positive/Tests*100

# %で並べ替え
dat<- asia5[order(asia5[,"%"]),]
#png("pcr12.png",width=800,height=600)
par(mar=c(7,7,3,2),family="serif")
b<- barplot(dat[,"%"],horiz=T,col="pink",xaxt="n",names=dat[,1],xlim=c(0,max(dat[,"%"])*1.2),las=1)
axis(side=1, at=axTicks(1), labels=axTicks(1))
text(x=dat[,"%"],y=b,labels= paste("As of",dat[,"Date"],"\n",dat[,"%"],"%"),pos=4)
title("Positive/Tests*100 for COVID-19(Japan,South Korea,Singapore,Taiwan,Hong Kong)",
    "Data : [Wikipedia:COVID-19 testing](https://en.wikipedia.org/wiki/COVID-19_testing)")
#dev.off()

日本、韓国、台湾、シンガポール、香港のTests /million people for COVID-19

# 人口100万人あたり
# Tested /millionpeopleで並べ替え
dat<- asia5[order(asia5[,"Tested /millionpeople"]),]
#png("pcr10.png",width=800,height=600)
par(mar=c(7,7,3,2),family="serif")
b<- barplot(dat[,"Tested /millionpeople"],horiz=T,col="pink",xaxt="n",names=dat[,1],xlim=c(0,max(dat[,"Tested /millionpeople"])*1.2),las=1)
axis(side=1, at=axTicks(1), labels=formatC(axTicks(1), format="d", big.mark=','))
text(x=dat[,"Tested /millionpeople"],y=b,labels= paste("As of",dat[,"Date"],"\n",formatC(dat[,"Tested /millionpeople"],format="d",big.mark=',')),pos=4)
title("Tested /million people for COVID-19(Japan,South Korea,Singapore,Taiwan,Hong Kong)",
    "Data : [Wikipedia:COVID-19 testing](https://en.wikipedia.org/wiki/COVID-19_testing)")
#dev.off()