HOME/Articles/

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

Article Outline

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

Hits

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

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

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

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

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

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

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

  • PCR検査実施人数 国内事例 5月12日: 188646 5月13日: 188031 5月12日の方が多い!
  • PCR検査実施人数 国内事例 5月14日: 196816 5月15日: 194323 5月14日の方が多い!

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

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

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

pcr04

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

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

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

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

pcr04_2

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

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

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

pcr05

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

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

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

pcr06

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

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

pcr06_2

韓国のPCR検査の結果(日別)

pcr08

日本と韓国の検査陽性者数(日別)

pcr07

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

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

pcr07_2

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

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

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

pcr07_3

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

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

pcr08_2

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

pcr08_3

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

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

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

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

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

日本

Japan

韓国

KoreaSouth

オーストラリア(南半球)

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

Australia

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

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
  • 日本の死亡者数1000人突破(2020-07-29)
  • 日本:検査陽性者数及び(報告された)死亡者数で韓国を追い抜いた。
  • シンガポール:(報告された)感染者が人口(約557万人)に対して非常に多い。
  • シンガポールの致死率は非常に小さいが、検査感染者数が多く、人口も少ないため100万人あたりの死亡者数は4人を超えている。
  • 台湾の感染者の数は圧倒的に少ない。

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

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

DperMil01

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

pcr11

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

Coronavirus01_1_2

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

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

CdeathsA01

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

CdeathsA02

「人口あたりの死者数」で評価した「日本モデル」より優秀なモデル 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="* 韓国の人口は日本の約41%",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="日本の6月18日の検査人数が極端に多いのは\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()