对于离散变量，可以用频数、比例、百分数的条形图表现单个离散变量分布，可以用热力图表现两个离散变量的分布。对于连续型变量，可以用直方图、密度估计图表现单个变量分布，可以对多个变量同时做密度估计图，可以用正态 QQ 图、盒形图、经验分布函数图等。[br][br] （一）单变量可视化分布[br][br] 案例数据集为泰坦尼克号乘客的数据集。泰坦尼克号上大约有 1 300 名乘客（不包括船员），数据集提供了其中 756 人的年龄。我们想知道泰坦尼克号上有多少不同年龄阶段的乘客，即有多少儿童、年轻人、中年人、老年人等。[br][br] 乘客不同年龄分组的相对比例称为乘客的年龄分布。将所有乘客根据年龄分到相应的组中，然后计算每个组的乘客数量与总体占比即可求得乘客数量与年龄分布。[br][br] 本案例演示所需工具包在“_common.R”文件中，直接加载即可。[br][br] # run setup script [br][br] source("_common.R") [br][br] age_hist <- cbind(age_hist, age = (1:15) * 5 - 2.5) [br][br] h1 <- ggplot(age_hist, aes(x = age, y = count)) + [br][br] geom_col(width = 4.7, fill = "#56B4E9") + [br][br] scale_y_continuous(expand = c(0, 0), breaks = 25 * (0:5)) + [br][br] scale_x_continuous( name = "Age",limits = c(0, 75), expand = c(0, 0)) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid() + [br][br] theme( [br][br] axis.line.x = element_blank(), [br][br] plot.margin = margin(3, 7, 3, 1.5) [br][br] ) [br][br] h1 [br][br] 输出的乘客年龄分组结果如表 6-2-2 所示。[br][br] 表 6-2-2 乘客年龄分组[br][img]data:image/png;base64,iVBORw0KGgoAAAANSUhEUgAAAw4AAADZCAYAAACJkWdHAAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAAEnQAABJ0Ad5mH3gAAEZqSURBVHhe7d0JXBR1/wfwD6yAAp4oKOKFF+YBeKVi3uHxeJT6lPmo+aTlkdphF11Pdj3ZaZZm179DS800fUzF8kZTgczyRhQF5ZLDRJBlWX7/nWXABYFdkF1mdj/v57Wvdmb2gZHvdz47v52ZHSdhACIiIiIiogo4y/8lIiIiIiIqFwcORERERERkFgcORERERERkFgcORERERERkVvHF0U5OTsYZREREREREEtPvUeIRByIiIiIiMuuWIw5nzpwx/pccU8eOHdkDDkyqvxQJUh6wDxwXc8CxMQdIwhwgqQckFR5xqFu3rvyMiIgcFU9fJSIXFxf5GTkaV1dX+VlJPFWJiIiIiIjM4sCBiIiIiIjM4sCBiIiIiIjM4sCBiIycnRkHRI6OOUDlndtOjqOiHGBCEBERERGRWRw4EBERERGRWYobOOjTzuFcil6eIrKUHtcSjuPwnu0I/2U3Dh2/jCy9HilxcchkO6kOc4CqhjlgT5gDVDXMAWtS2MAhDzEb38BrG04ZnhFZ5kbcTnzy3Dy8+PVhJKMBmjTS4Erk53jin6Mw+YXNiMuXX2hjeXns4qphDlDlMQfsDXOAKo85YH3KGjhcj8L/NkXiSHg4/siR5xFVIC/uf3ht/ps41nk+3nppBsYNuhM9eg7AmIdewfsv3oOWN67jeoH8Ylu6/hu+WRWFG/IkVQJzgCqJOWCHmANUScwB21DQwEGP5N3bEOvVDR7nfkH4oavyfKJy6BOw5eP3sbXOODw88Q64y7OL1Os+BTMGeuKGzYMiB6d+/BbhyTwmWnnMAaok5oAdYg5QJTEHbMZJGBifODkZZyQmJiIrK8v43KZ0Z/HNs9+gwZz+iJr9FPb1+C/W/XcMfDTy8iK6FBzZvB674nIhcnNRu11v9GxdDxqXRmgb2A5e0uvzLuPQpq34/VIyLqfVRpfR/8LEvr4o7wvGchL/wJ7t23HEZQBGukVgzcFc9Pr307ivqxsyT4Tjx+2nkS1ykX7VFQEjJuOfIc2NP6v4/+c6Ao/ddQ3rV23GH2l1ETzhEfwrpCmMN2q3wvpaU8eOHXHmzBl5StnyTn+OmZM+wvUH/w+rn+gJN3m+Ke3ZE7jQvDM6FqfIdZzbvRG/HLuCq2mZcGozABP/OQztPLMRd3A79v6ZArQPxb+GtoXL9VhEbNuH42m1DHV/AIPbuJivue4idq5YjMWf70RW4CT8q19LtBsyFSM6Kv/r7aSvX2vfvj2kSJDyoEb6wNIckJjbtvTMgaqSciAmJsbYC0rHHKhezAEr5oCkmtfXGqSvY5VOrZFy4Pz589DpdPIS5areHJCWmc+CO92O23UO1KpVC23atDFOm74XKOaIQ84fWxDdbCSGtu+PEcNa4eq+cOy+XLpZsxC14in893gHTFnwJJ6cEwrnrWFY8PEeXL6ajTxpJKlPxPbFb2Jn/X/gkScWYkrbM1hqeO2n0dcLf8QtbiAjLR6/b1qJTetWY9cNf3Tr0Bx1XZ2gu/gTXpm3FmLkPDy+8DnM6ZGCz541jGiNI0ctMtMuInrjKvwasRmfrj6O2l1C0M35MN59eTn2Zko/2xrrS4X0yDj2F05oXeDXslWZISFxa28aEjk49s2zeO2AL+599AmEPTkePodfxYyFX+OvbA+06RkMp8hlWHXwMoynQXq2w51d8rF/2RocTpbmWFBzF1/0+/ezmN7fA54dBmLytEkY6K/8kFAKy3JAYmbb0jEHHANzwB7ZZw5Iqnt9qVB154C03FwWZDtsDihj4KBPw76tFxA4uhc8Df/rNXw4OuYcRPiv50teFJXzB37ZfBZtuvdBU8PwXdMoGPeM6AWRooNXn0A0M8zTHluPryKboGuzqzh78gIKWnZAC+0xbNoWbWiTstSBX+feaO/rAs+gcZgz7Z+YOnsmRnasA+QLeHTsjjv8pDbUwKtdOzS/Ho8E45uHG5ob/n8dfDUQDbrjwafmYtLYezB12j/QOe0ETlzQWml9qZAemVevGjZmDdzrFCdBhXQXNuGTT9PQa0x/NJU+uWoQhMmz/wmf/cuwYvNF6JzrwM2t5CahcXdHneJZFtQcLqhTxw0aJ8BJUwt1PDxQp/ijJqqQpTkgMbNtNTrNHHAMzAG7Y685IKn29aVCVsgB6UUVZoHj5kDJv0gN0cX/gvCMzgh0ScC5c+dwybMb7gzIx5HwXwwjSPlFEo0HPOrmIzU1sbCohiZxdXOBc4N6qGc8hKlHyskTiBXZSIk5jdOnTyPmWjs88MprmDe4heHV5XGCdKZWLVfXEq9xaftPvLniUQTEh+Obj5bgk60n8XdBPvKNQ0+JM5ycneBWty485f+jxrAu9Z1yoc0tsOL6kvS39HD3gKZAjxs3LIlUPdIO78dv1xujicnxbjfDG0Fwi2uIjPoTln2mY6bmVGUW54Ckwm2LOeA4mAP2xm5zwDjDGutL0t+ROWA7Chg43MDxLQfg3N4T56KjEBVleBxJhk/XQLieCkd4pEn53IJw39z7od+6HN/uOYEzf4Zj5fYMjJlxLzobj03pkZOdgwJdQ3QcOR7jx9983NO/rWF8WEm6BOz84Cm88asz+v/7cTw6PhhNzP7FDIljYDwbzNbr61A08OnQAa3ctDh/LtbQRebo8fe1a9AVaEtu0BovNG5cy3gOZ3H+V5pJzamKKpEDkgq3LeaA42AO2Bc7zgGJLdfXoTAHbKnmBw4ZB/BzTFdMf+QBTJo0qfgx+eGJGNzwInZsP4B0+aVSc3g28UffUYPRIusU/ogVCHluGV4a7idfeOQKryaN4Xr5APYezjDOMdInYfeOaAuayZQeV8I/wqt7WuKBWaFoa7xYprJsub6Oxy1wOEYF10bcru04cKXsbyzQxv2F48YbCLmiqZ8fGupicTY2t3ChUR50+S7o2LEd6ms00Dg74dbrQbkrYHWVygFJRdsWc8CRMAfsiF3ngMRW6+t4qj0HpElmQZlqeOCgw/ltm5Daczg6lRpOa5oOwLCBTZCy4ydsP194UA/aP7HyrVWIdza83brVQ6O6Gvwdexh7ouNwVe6TRn0GY5D3Bax74wUs/+U4EpIvIGrd1zia52dolYoVFBSYtEMBrl5JRWZmIi6nG36/Ph0nIo/hcr5hJJp/AxkZ0icfhtcbBqslm0qaKJxv7fV1eK6dMemJueh34ye8++b3OJIm94ks6/Q2rI7ORbPGhccQG4SMwbiADOzeugOX5L+/PsMQHJkhGD/yDsPf2wONvOoh7WIcEqWTabWXcHBnNBJ1hjAp/tFmai7R1IJLLeD6tSzk6rORlJhmeNuh8lUyByRmti3mgANhDtgJO88BiRXX1+FVew5IzGWBY+aA5hUD6cmiRYuMMxYuXGibO9zp03Bsy2d49+PNSHX3g7ePL1p5e8gjGT2S/9qDiL0HEH3qFE5fvAH3pi3RwdcFqX9uwf998T02bd2GbdsMj61b8fPGjdif2RqD+rdDvXrtcEfLPJzcvRkbfvgeK1dtw3m/B/DYtCA0vHkqm4lsxP22ERt+2oPfk2qhaceuuMPX07AeGtR1z8GpLV/iqx+2Y++BM3Dp0QXOB/6H3WevwycoCHXObcP6H/fgRHYjtGrfHv6eqTi0eRN+2nMM2Y3aoEN7XxTEbqvm9bWujz/+GPPnz5enlM+taTf06+6NtIhv8MEn/8MfsbE4efQgdoX/gt9vdMbE+/vCu+jv6NYC3e6oj3PrP8fmixq4XDuFX9b/jgZTFuLBHg0NFXdB4zrXcPCLD/DF//Zgx954NB/UEVe27cGlus3RoVNz3Pjrf2Zq3hY+nq4oSIzEhm82Yfvh86jdbQiCmyn/QLP01YsfffQRpEiQ8sAmfVCVHPCrD424geQKsmDwiOG4szVzoKqYA8wB5kB154ChJ9xzq3l9rUOj0UCv1xtz4LHHHjMOotSgenNAUlEWNIZn9kns/Xmv3eaA9JWsH374oXFaHioYKec+DpbQJWD7lztR777p6NuocJY+7zoyk85gy2e70PyFpzFMvqBelxmHE6eTkO/VDl07eFf5/EBt6hkci9ejeac70MwjD8mn/sLVRt0Q4GPB+L8G1vd2qek+DiXpkBkfg/OJV5FbqwFadQyAX91ykjbvCs7+dRZX4AX/OzqiaakvYci+dAzHLzuhRdcu8MVFnLhYG+06+VSuJvosJJyMQVbjO3BHszryTGVTxPe3W8rCbYs5UDVquo9DScyB28UcKN9t5YDExutbVWq8j0NJ1ZcDktvOApXmQHn3cVDRwEGPtO2v4NEDd2HFq6FoKM81yj6BNd+fQ9/pY9HKRZ5X49S2voXUO3Cg26WeHQY1bVvqzQF1DhzodjEHrEU966v+gQPdLrsZOFzZ/Q5mh22GPngo+ndthcYeGuiuJSI+tT4GznwYw1op6SxAta1vIQ4cHJeadhjUs22pNwc4cHBMzAFrUc/6cuBAdjJwKJQVdwA7dkfjTOI1FNT2Qos7+mLY0GAo9ZQxta0vBw6OS8qADh06qGCHoZCati015gAHDo5JPQOHQtwnqH4uLi7GwQIHDo7LrgYOZF0cODg2qf5q2WEg6+HAwbExB0jCgYNjk448lTVwqPn7OBARERERkeJx4EBERERERGZx4EBERERERGbdco1DZmYmcnNNb8FNjqRZs2ZISkqSp8jRSPUvOreZfeC4mAOOjTlAEqkPUlNTjTeDI8cjXRzdpEkT43PTaxxuGTgQkWMr2mEgIsfFHCCiIhUOHEwXkuOR+oA94LiK6s8+cGysv2NjDpCE9SepBySmfcBrHIiIiIiIyCwOHIiIiIiIyCwOHIiIiIiIyCwOHIiIiIiIyCwOHIiIiIiIyCwOHIiIiIiIyCz7+zpWfQqO7TqA07pWCBnaA75u8vxqp8PVpMvIzJX/Xk61UM+nBbzqFE6qlaN8/Zo+4zT2R/yFVJeW6HVXH7SuKy8o03VcOhqFI3G58OsXiu4+Gnm+/Smqv5L7wPLaZeL0gTh49ukOPyuVzLJ1UV9WOEIOaDMTkXRVi9L/Sie3Bmju2xAu8vRNzAFlMlcX6+fATRWtC3NA2SztE8fJAYnUA5ISfWCYMJKemkyqU9o+sfhfD4iwr8PFjnVviOmT3xC7UvLlhdUr/8LX4oHmtYr/bq6dHxNb0+WFKqb6HrBAzomvxazQIWLUyBDRvr6zaDLgJbEjVV5YQr5Ijlgu5j3woHjhqz0iJiNPnm+/iuqv1D6wrHYZ4sTmD8ScoW2ER6eF4tdseXY1s7SP1JgVdp8D+RfFV5OaCme5JjcfzqL++M/FxRJvG8wBZTJXF9vkQCHzPcIcUCpL+8TxckBS1K+miqfKWqguGWL7E91F6PsnRGE580TMsrGi14KtIs04XZ2yxaEPnhcfhEeIiIjCx8FTKYa2Uj+7D4q8s2Lte5+Jw8bAzhcpO8NEH/eGYuKXCaXqlyvOrp0n+vSYLr49adV3HEUpqr8i+8Di2v0tUlLSxIGX7xS1A6y0w2DxuqgzK+w9B/JOLhMPTXpZfLV5p9gn1yUiYqt4bURzMebjGPk9RMIcUCZL6mKDHDCyZF2YA8plSZ84Zg5IpB4o3QfFU2UtVJP8hK/ExEYDxdvHb0Z+/vmPxQiv8eLLkh8f3bb8xHXi1bd3GdrN/th/UOSK3Fz5qSRnj3guyE9M+z5FnlEo6/BiMaRJkFi4XeEfCVWzovorsw8sq12hfHFh+RhR12o7DJati1qzwt5zID16vzhSuihJ34lp7caKZWdvvocwB5TZB5bXxdo5YNm6MAeUruI+cdQckEg9ULoP7Obi6OzD+7AL/mjb6uaZqRqfdmhffz8OROfIcypBexGxcWX9/7Q4tmoFPnx3NoaPewSLvjmAS1p5EamAG9xMrnvRp8cj3X8B5oz2lucY6GKw8o238EfIXDw6tJE8k2qeBbUz4eRcDfFWbg5Ysi7MCqVq1CMEwfXkCSM9kndtx2+dRyC06D2EOaBMlayLVXPAonVhDqhBuX3CHLiFnQwcdEi8eAEZvk3hbXqdiqYBGjVIQ3xCsuEVt8qKXILRfhq4aZzQuPdULPruEBL10pJ07A4biQlfHjds8qXlQNP1QbzxzCQEO0Vi2cxQDHlgCX7LkBeTauiSD+KzF9fB9f570M3kolbtiQ1Y/fMNdPVNxfLZkxAaHIDA4XOx4tAVw+4FKUF5tauKquXATeWvC7NCNfRXsDP8N3QZHoqicQNzQJmsVZeq5IBl68IcUDPmQBnkIw9lHo5Qj1wR/dqdAr1fFdGmpw/kHhL/6QER8uafJuesFsqP/1aM9ekvPjgqHZfKFuf3fCNemx4iWtWvLxo18hG95q8XcWbPcLomTq6dL+5s6CF6hu0xTKmfenugMvJFctRqQ737i1buhr537SCmrTwr90i+SPjsHlHbubd4YuOpwkPLWcfEF5PbCLSYJlZV82lvSlNUf+X2QUW1M5UvLq4YZ/YUhdvLAUvXRaKurHCMHLgpP2mVmNruHvFJbFGxmQOm/1WOytbFmjlQlR5hDihTeX3i2DkgkXqgdB8UT5W1UD3yxOn3Bgv0+I84VOq846c7QYQuPWcofylph8WOA0m3zq+0bBH5xkDRMOg5sSdHnqVijhMUhdIiPxTjWzqL2n1fE5HG3skVR97sL1w7Py12m9Qz79g7Ykgtd3HvF5eroWeUq6j+auiDW2tnyrIdhurKgYrXpYh6ssKxciBfJK6cItrd84k4V9wIzAHT/ypHZetizRyoao8wB5SnvD5x7ByQSD1Qug/s5FQlF/i28YdP6hWkmR47yk9HempztGntjVu+aderN4b2a3rr/EpzR7dRIxGszUa2wx63Ui+vXrMQNqsvnJOTkWI8n80ZHh4eqOXhCXeTrcOlbS/0DCjA1cwMFMjzqGbdWrsqqKYcsGxdmBWKpE/Fzu2H0HVEKFoVNwJzQJmsVJcq5UBV14U5oB7MgbKY/CnUzb3PIAzOO4XTF2++a+suxOBs7SEY3NtTnmMluny4de+OLiq/+ZtjckOr5s3h0c4fbYwXu7qgRVAw2l84g5i/jS+QucKtjjfatvUr48ZQVDNK164mWbguzArF0afuQPihbhgR2spkx5E5oExKqsttrAtzQCWYA2Wxm4GDptlYPDI9G9u3nJEvhNbi1LZdEDNnY4yPcUa10KdHY+MP+xBfND7JOYuNq+MwZP4EtLz9wxdkA3q9ycc8ulhs3XEZY2dMQICcAHX6TsHDd0ZizdqTxRfD6S5E4WjtKZgytIE8h2qCudqZKigoKHzI09XN3LowK9RAj9Qd23E4cATuLlUU5oAyVbYu1swBS9aFOaAO5fUJc+BWTtL5SsYnZd1WWm0yDuD9xz9CYp9xCNQexLbYQDyzeAaCqvGAg+7EMkwc9gz+8B+HcXc2Rn6OG7pMfhKzBzSrhtOeap6932Jed3wJxgx5C4k9RmBwFy9oLyfBbeiTeGVGTzSUXyPRnf8JYXM+wbW7p2JokyRE/JqA4IVvYkbwbX6Fj8IV1V+JfWBp7aQPDeL2b8LapWEI29IU85e+hJlj70a3JtW3hVqyLmrOCnvPgWL6RKx8cBA2DfoFa2e2vqUuzAFl9oFldbF+DkjMrQtzQOnM94mj5oBE6gGJaR/Y18BBos/E2cijSKrTHj2D/OAuz65O1+OPIPp0Bmo17Yigbi1g5ROhbMr+g0KLlFPROBafDU09PwQE3oFm5TWJNgXHI/9CspMvuvbqDJ8aPx3G+orqr8w+qETtrM6ydVFrVth/Dsj0Kfhz7xnUCgxBZ69yduOYA/JchVFSXcysC3PADjhgDkikHpCY9oH9DRzotjAoHFtR/dkHjo31d2zMAZKw/iT1gMS0D+zmGgciIiIiIrIeDhyIiIiIiMgsDhyIiIiIiMgsDhyIiIiIiMgsDhyIiIiIiMgsDhyIiIiIiMgsDhyIiIiIiMisW+7jQESOTYoE5gGRY2MOEFER0/s48AZwVILUB+wBx1VUf/aBY2P9HRtzgCSsP0k9IDHtA56qREREREREZnHgQEREREREZnHgQEREREREZnHgQEREREREZnHgQEREREREZnHgQEREREREZnHgQEREREREZtnRfRyu49LRKByJy4Vfv1B099HI86tTJk4fiINnn+7wK+vH61NwbNcBnNa1QsjQHvB1k+eriGN9b7OZeubEI2pfJOK03ggeOADtG8jz7VhR/ZXcB/qM09gf8RdSXVqi11190LquvKBMtsgFg5zT2BGehvZj+qOVizyviApzwRFyQJuZiKSrWpT+Vzq5NUBz34YoXcYKa2xn1JADN1myjVsvByzuI+aAalTuPca+ST0gMe0DOzjioEfK/k8wf/I8rDjqjE6Dhllh5yATJ39egrnDeqDnw9/jtFaebSo9Am8/+ARWJ3qgUc52vPDQm9idqpcXkrKYr6fu/I94+qHXsed6fTTI3oXnJkzD50evy0upptw4+Q0efeBRvP3pUrwwOQS9R7+MnVfkhSXYIheK5CD643m4/5kfcKJ0LzEXlEkfj9Vze6Ctvz/8SzzaIWj+eiTdUqIKakw1xJJt3Mo5YGkfMQdUw/L3GAdmGEUYSU9NJlUiV5xdO0/06TFdfHsyW55nDX+LlJQ0ceDlO0XtgIXi11t+VYbY/kR3Efr+CZFnnM4TMcvGil4Ltoo047R6qK8HqsJMPfPOif+b1EvM3Zguz8gX8Sv/JdoPe0ccyZVn2ami+iuyD/LOirXvfSYOG8uSL1J2hok+7g3FxC8TDFOmbJULhXL/XC4WDOsmavvPF1uy5JlG6s0Fe8+BvJPLxEOTXhZfbd4p9kVEiAjjY6t4bURzMebjGLleN5VfY/uk6BwwsmQbt34OWNZHzAHVsPg9xnFIPVC6D1R9xOF65IeYNW8/Qt58D1M7uctzraEevL0boHlT71sPXxvoL23C59/UxbDQ9vJyF/iPDIXXd19gUzw/VVCeiuupu/Az1m5rjIAu9eU5GrQYOQZ9jq3E2oM35Hlkcy4tMO7Rh9G7kTShgXff4RjUwQPudVwNUzfZLhcMtCfx7fdZCJ0QAFd5VhHmgnJl5QRi3qeLMH30ENzVvz/6S492mTgb2wMjhrcumQsV1JhqhiXbuC1ywJI+Yg6oiIXvMY5OvQMHXQxWvvEW/giZi0eHGqtcddqLiI3LkSfK5+Rc9p8r+/A+7II/2pqc+KrxaYf29ffjQLT5n0s1o7x66hIScEl7A7k5BfIcA/eWaNPiHI6dSAKjvqa4wc3kvGB9ejzS/RdgzmhveY5BdeaCpMJs0CHm+6+RNHg6etWWZ5lgLihXox4hCK4nTxjpkbxrO37rPAKhJS5gqLjGVAMs2cZtlAOW9BFzQE0seI8h9Q4ctCc2YPXPN9DVNxXLZ09CaHAAAofPxYpDV8rcscuKXILRfhq4aZzQuPdULPruEBKNL0zH7rCRmPDlcVTt1FUdEi9eQIZvU3ibDkk1DdCoQRriE5INryA10Xg1RuP8Y/jjqEkviSxkXdPjxo0cmAwnqIbokg/isxfXwfX+e9DN5MK1yuaCpKrZoDu/Fl/E9sXMYd4ovHzMFHNBVfRXsDP8N3QZHlriwueKa0w1wZJt3JY5UMItfcQcUKvy3mNItQMHPa5EHUYUuqFH6AS89Pka/BLxIxY0Dsec+57CmlKH//QJKzFl7HoM25IFrT4bUe/cDc2Op9DPqwG8vDrj2fzXsWlRb8NYsyoKkJ2TA7jXQZ3Sf02nAtzI4aktauN2xz8wYTiw/v3XsT7muuFdKAW/b9iAXTEuaOJd9ulNZCt6pESvweKwZ7B43WYsmzoac1bFym++lcsFSZWzQR+Pnz79E4Ezx8K3zGPYzAU10V/Zie0Hu2B4qMlpSmZrTLZnyTZuwxwo5dY+Yg6oT0XvMSRR6cAhH1fS0lDQaSDGhgbAeKTQswumhc3FkKQfsf7XFEPpb9K4d8SCDeswP1A6z9EdbQZOw4tf7ceFq1eRnp6MyKXj0brKbwzO8HQ3/Fy93rBWJgpyIeWFh6enis8Hc1AuXTD38w14N+QSPnrwHkx8bDkOnIxHnGtv9O7eUH4R1QwNfHpOMmy/Efh9z4cY3zQWPyxfg6PGjwIrlwuSqmWDHombl2N/uxm4r015wcFcUA89UneE42CX4QgtLrYlNSbbs2Qbt1UOlFZWHzEH1Kei9xiSqLRnneHh4YFaHp5wN/kXuLTthZ4BBbiamVHydBKv3hjar6mVLm5xgW8bf/ikXkGaaRrlpyM9tTnatPbmRTUqpGk2APM//h8iDu7Aj8seQt3YaLiNmYR7O/F4g1J49ZqFsFl94ZycjBTjx0GVzAVJVbJBn4BNX3+NDe/eg64BAQgwPPq/FI5r8d9hTs+uuH/ZCeiYC+qhT8XO7YfQdUQoWhUVxaIak+1Zso3bKAdKK6uPmAOqdut7DElUOnBwQYugYLS/cAYxf8uzjFzhVscbbdv6yYcJbcO9zyAMzjuF0xdvdpbuQgzO1h6Cwb095TmkVhl7lmNZRDCeeW4y/JnyCuKGVs2bw6OdP9oYzyGwUS5ofHDv2+HYvGY1Vq8ufHy54C54NBuDl75diUX3tjL+HuaCOuhTdyD8UDeMCG11cyfOwhqTrVmyjdfM/kGZfWTAHFCz0u8xJFHpwAGo03cKHr4zEmvWniy+YEl3IQpHa0/BlKHWucVvQUFB4UOeLqJpNhaPTM/G9i1n5E+htDi1bRfEzNkY42OcQQpUXj1N6eLW4fmwCPT7+BM81lM6jE01Sa83+dhOF4utOy5j7IwJCJD3BGyTC3XQtEMQgoODix8dm3hA41IPvncEIcC3cGeAuaAG0ukl23E4cATubmm6u2dZjcn2LNnGbb9/UF4fMQfUxtx7DAFO0s0cjE/KuK200unO/4SwOZ/g2t1TMbRJEiJ+TUDwwjcxI7i6L4HXIm7/JqxdGoawLU0xf+lLmDn2bnRrYhIQGQfw/uMfIbHPOARqD2JbbCCeWTwDQSp7f3GMW8ybq6ceWclncWTXRmzYl4HOUxdiRoiPQxxSLqq/EvtAd3wJxgx5C4k9RmBwFy9oLyfBbeiTeGVGT5heeWK7XLjpytf3o91rPlj951KMMt3mVZoLjpEDBvpErHxwEDYN+gVrZ7aucBsvt8Z2SMk5ILFkG7dpDpjrI+aAKlj6HuNIpB6QmPaBqgcORtoUHI/8C8lOvujaqzN8avJwkj4TZyOPIqlOe/QM8oMaP592tKAokz4Bv++9AKeWAejUrgnqyLMdQVH9ldkHWqScisax+Gxo6vkhIPAONCtvI2Mu3BaHyQF9Cv7cewa1AkPQ2csRPhqwjLJzQGbJNm6rHLCkj5gDKlCJ9xgHIfWAxLQP1D9woGrleEFBporqzz5wbKy/Y2MOkIT1J6kHJKZ9oNprHIiIiIiIyHY4cCAiIiIiIrM4cCAiIiIiIrM4cCAiIiIiIrM4cCAiIiIiIrM4cCAiIiIiIrM4cCAiIiIiIrNuuY8DETk2KRKYB0SOjTlAREVM7+PAG8BRCVIfsAccV1H92QeOjfV3bMwBkrD+JPWAxLQPeKoSERERERGZxYEDERERERGZxYEDERERERGZxYEDERERERGZxYEDERERERGZxYEDERERERGZpdKvY83E6QNx8OzTHX4aeVYJ5pZXF3O/R4erSZeRmSv/TZ1qoZ5PC3jVKZxUIsf6+jUz9bt+EVERUTif7Ym2vQegZ0t3eYH9Kqq/Kvog5zR2hKeh/Zj+aOUizyvBVjlgUOG6MAeUqxK1Mdtv9kPpOaDNTETSVS1Kr5mTWwM0922IkuWxbg5Yvi7MAbXQZ5zG/oi/kOrSEr3u6oPWdeUFDkjqAUmJPjBMGElPTSYVKkOc2PyBmDO0jfDotFD8mi3PLmZueXWx7PfkX/haPNC8VvHf1rXzY2JrurxQoZTfA9XBfP3yzq8TCwYNE/M+2yJ2bl4mHh4wUDy18aLIl5fbq6L6K78PskXU4qGiUdv5YkuWPKuYrXKgSEXrwhxQMstrU3GN7U1R/RXZB/kXxVeTmgpnuWY3H86i/vjPxcXikLZBDli8LswBtcg58bWYFTpEjBoZItrXdxZNBrwkdqTKCx1QUb+aUtmpSho07j0VU0K8oZf+Kbcwt7y6WPJ7chD9Uwx6f7kbERERxsfeH59HaCN5MdUgc/XLwb7lr2CD/yN49eFRGDJ6Fl54oAE+f+P/EHlDfgnVKO1f32Dlr1eQU6M5UKjidWEOKJfltam4xmRLupifEYFH8OXmndgn1y0iYiteG9EMA4YMRLPiowrWzwHL14U5oAq6WGwOz8NDq3diy9a92L/hWbSN/hgrNl+CXn4Jqe4ah3rw9m6A5k29Sx2KLGJueXUx/3v0SVvxi24YHhreH/37Fz76BHgbooxqnrn6XUd8/AVkZV7FNTktXGo5Q+Tk4AZ3HGqe9iS+/T4LoRMC4CrPKslWOWBgZl2YA8plcW3M9hvZUlZOIOZ9ugjTRw/BXXLd+rfLxNnYHhgxvLXJNm/9HLB0XZgDKuHSAuMefRi9jQM6Dbz7DsegDh5wr+PKWplQ5cXRTs4Vr7a55RbRXkRsXI48Ubbyf48Wx1atwIfvzsbwcY9g0TcHcEkrLyLFKL9+9RHUvRfytyzB6+tiodWdw+bwGAx8ZDL62v9lDgqnQ8z3XyNp8HT0qi3PKof1c8DcujAHlMvS2ljeb2QbjXqEILiePGGkR/Ku7fit8wiElnHxiTVzwLJ1YQ6ohxvc3OSnBvr0eKT7L8Cc0d7yHJJUwxalXlmRSzDaTwM3jZPxkOai7w4h0fgJczp2h43EhC+PGzb5qsiBpuuDeOOZSQh2isSymaEY8sAS/JYhLyaFc0PwI6/h+QFp+GLW/fj3vMX4a/Bn+OLRICj4OjaHoDu/Fl/E9sXMYd4ovGTr9lU1B8yvC3NAuSyrjTX6jaqZ/gp2hv+GLsNDb+ui9WrZHyhzXZgDaqRLPojPXlwH1/vvQTcHvji6LA47cNAnrMSUsesxbEsWtPpsRL1zNzQ7nkI/rwbw8uqMZ/Nfx6ZFvQ27kFXREF1HTMWshYuwfGME9n43A432vIjH3t2LLPkVpHAN++Px/z6JEXVjsfrb/biiK5AXUI3Rx+OnT/9E4Myx8K2m48ZVzgGL1oU5oFwW1MYK/UbVT39lJ7Yf7ILhoaanKVVOde0PlL0uzAF10SMleg0Whz2Dxes2Y9nU0ZizKhY6eSk58MBB494RCzasw/xA6dwTd7QZOA0vfrUfF65eRXp6MiKXjkfranmzqItO972Fj57qiXPbwnGEF9eqgvb0Sjz2ymXM3LULn453wqYn7sdDS6NwXV5OtqZH4ubl2N9uBu5rU317cVXLgaqsC3NAucqqjXX6jaqbHqk7wnGwy3CE3sYbdvXsD1iyLswB5dPAp+ckQ/0j8PueDzG+aSx+WL4GR3l6WTHHPVXJqzeG9mtqowte3NFt1EgEa7ORbTz0SYqmj8Oq/7yAs/0fwugOPfDIiu/x9hhg23/fxbp4FrBG6BOw6euvseHde9A1IAABhkf/l8JxLf47zOnZFfcvO1G1T4SqkgNVXhfmgHKVqo21+o2qlz4VO7cfQtcRoWh1O2/m1bE/YPG6MAfUwqvXLITN6gvn5GSkcIMv5tDXONiULh9u3bujC0+SV74bfyHqt2to0dK/8NB03e545Jl/Iyg7BrHxecaXkI1pfHDv2+HYvGY1Vq8ufHy54C54NBuDl75diUX3trLaN6fc4nbWhTmgXKa1UVK/Ubn0qTsQfqgbRoS2qvFvvanUujAHVMINrZo3h0c7f7Sp2nnrdkmVA4eCgoLChzxdmrnl1aW836NPj8bGH/YhvmiEmnMWG1fHYcj8CWhZ0+lGxcrtE7eO6BLkhrMxJ1F0JNnZ1RVuTYPQrR2/kLFm1EHTDkEIDg4ufnRs4gGNSz343hGEAF9P+XU3lVvf22bZujAHlMt8bSrfb2Rr0qlB23E4cATurmCDsl4OmCp/XZgD6qLXmxwG0sVi647LGDtjAgL4SUExlQ0ctIjbvx5rdp9A9qXD+Hl1OP66Ynqsz9zy6lLx7ylIPoyvHhuJ/oMmY/6TCzDnyc+Qds9reOJOXpqvDGb6xCUA0994E112Pod5b6/ED999iKffPIKQt1/E+KZMeuWzVQ5UjDmgXKyNHdCnYMf2SASOuLucHXAb5kAF68JeUw/d8SX4R7Pm6DZyOh57eiFmP/gyjgxagnfur/kjWkriJN0+2vjEqfDL5uRJuk3X448g+nQGajXtiKBuLaCWz6ekPmAPyG4k4+SRE7iUVxf+gcFo18j+P3Ioqj/7oHowB5RLrbWxBVXkgGFn/c+9Z1ArMASdvWp4t87MujAH1EKLlFPROBafDU09PwQE3oFmDn7vJqkHJKZ9wIEDleB4QUGmiurPPnBsrL9jYw6QhPUnqQckpn3Ai6OJiIiIiMgsDhyIiIiIiMgsDhyIiIiIiMgsDhyIiIiIiMgsDhyIiIiIiMgsDhyIiIiIiMgsDhyIiIiIiMisW+7jQESOTYoE5gGRY2MOEFER0/s48AZwVILUB+wBx1VUf/aBY2P9HRtzgCSsP0k9IDHtA56qREREREREZnHgQEREREREZnHgQEREREREZnHgQEREREREZnHgQEREREREZnHgQEREREREZnHgQEREREREZqnwPg6ZOH0gDp59usNPI88q03VcOhqFI3G58OsXiu4+Fb64knS4cnI/fjuejlrNgxES0hYN5CUl6FNwbNcBnNa1QsjQHvB1k+crmMN8b3NOPKL2RSJO643ggQPQvqwCWvIaO1NUf1X0Qc5p7AhPQ/sx/dHKRZ53C2vmgESHq0mXkZkr/62caqGeTwt41SmcNGIOKJh91u92qSoHyGpYf5J6QGLaByo64pCJkz8vwdxhPdDz4e9xWivPvoUeKfs/wfzJ87DiqDM6DRpWzTsLGdj/7kT06TUKk/99P8YO6I67pnyKI1ny4iLpEXj7wSewOtEDjXK244WH3sTuVL28kGqS7vyPePqh17Hnen00yN6F5yZMw+dHr8tLC1nyGqpJOYj+eB7uf+YHnCgzC6ydA4X0F7/H3F7t4e/vb3wEjH4PkTfkhRLmgKKxfkRElWQYRRhJT00mFehvkZKSJg68fKeoHbBQ/Jotzy4hV5xdO0/06TFdfHuyzBfcttwj74kHH/pQ7DqfJfKvnRPhb44VbVwbiuEfHBN58muEyBDbn+guQt8/Ic/LEzHLxopeC7aKNOO0cim7B6pB3jnxf5N6ibkb0+UZ+SJ+5b9E+2HviCO58ixLXmOniuqv9D7I/XO5WDCsm6jtP19syZJnFrN+DhTKFoc+eF58EB4hIiIKHwdPpRi6pQhzQNnst363Sy05QNbF+pPUA6X7QEVHHOrB27sBmjf1RnlnJVyP/BCz5u1HyJvvYWond3luddIjPbU1pry1AIPbeEJT1x/Dn1qMxwbn41DUURQddNBf2oTPv6mLYaHt5XV1gf/IUHh99wU2xfPTqpqku/Az1m5rjIAu9eU5GrQYOQZ9jq3E2oOFHzVa8hqqQdqT+Pb7LIROCICrPMuU9XOgkD5pK37RDcNDw/ujf//CR58Ab0O3yMuZA4rG+hERVZ7qLo52ci5nlXUxWPnGW/gjZC4eHdpInnkbtBcRG5cjTxTRwHf4eAxrIk9KXPzQunVDNG7YoHgnJvvwPuyCP9qanHit8WmH9vX340B06Z9JtqRLSMAl7Q3k5hTIcwzcW6JNi3M4diLJMDS07DVUU3SI+f5rJA2ejl615VmmbJIDEi2OrVqBD9+djeHjHsGibw4YekZeJGMOKBnrR0RUFXbzrUraExuw+ucb6OqbiuWzJyE0OACBw+dixaEr5e7oZUUuwWg/Ddw0TmjceyoWfXcIicYXp2N32EhM+PK44e3FDF0Czl9sgFGj+sGzcAYSL15Ahm9TeJueUq1pgEYN0hCfkGx4BdUUjVdjNM4/hj+OmvSFyELWNT1u3MiBNFSw5DVUM3Tn1+KL2L6YOcwbhZdslWS7HMiBpuuDeOOZSQh2isSymaEY8sAS/JYhL2YOKBzrR0RUFXYycNDjStRhRKEbeoROwEufr8EvET9iQeNwzLnvKawp47CyPmElpoxdj2FbsqDVZyPqnbuh2fEU+nk1gJdXZzyb/zo2LeoNc1+gkXV4LXY0XIB5dxd9ulmA7JwcwL0O6pT+6zoV4EYOT3WpSW53/AMThgPr338d62OuG/Y0U/D7hg3YFeOCJt6Fp8FZ8hqqAfp4/PTpnwicORa+pjtzxWyZAw3RdcRUzFq4CMs3RmDvdzPQaM+LeOzdvfIpi8wBZWP9iIiqwk4GDvm4kpaGgk4DMTY0APWkWZ5dMC1sLoYk/Yj1v6bc8mmjxr0jFmxYh/mB0jnQ7mgzcBpe/Go/Lly9ivT0ZEQuHY/WZe6cmMiKwmdfpuFfr05Dh+K9SWd4uht+pl5vWCsTBbmQ3oc8PD3t5zCPGrl0wdzPN+DdkEv46MF7MPGx5ThwMh5xrr3Ru3tDy19DNqZH4ubl2N9uBu5rU96GWUM5gLrodN9b+Oipnji3LRxHjPuUzAH1YP2IiCxlJ9nnDA8PD9Ty8IS7yb/IpW0v9AwowNXMjFtPL/HqjaH9mhZfCFdp+gRsee9bYMYiTG5n+hm0C3zb+MMn9QrSTPdS8tORntocbVrfvPiOaoam2QDM//h/iDi4Az8uewh1Y6PhNmYS7u1kci6zBa8hGzJsb5u+/hob3r0HXQMCEGB49H8pHNfiv8Ocnl1x/7IT0NVEDhRzR7dRIxGszUa2cbtnDqgL60dEZAk7GTi4oEVQMNpfOIOYv+VZRq5wq+ONtm39qvf0En0K9nzwDqJ6Po3H+3vJM7OQkVF4+Nq9zyAMzjuF0xdvngWruxCDs7WHYHDvwishSBky9izHsohgPPPcZPiXsydgyWvIyjQ+uPftcGxesxqrVxc+vlxwFzyajcFL367EontbGbZxG+dAabp8uHXvji7yzcOYAyrD+hERmaW6gUNBQUHhQ54uUqfvFDx8ZyTWrD1ZfCGj7kIUjtaegilDq/GWv/pk7F48B4vjOqJzXjQ2bdiADetWYdnzz+KLo4UHtTXNxuKR6dnYvuWMfAGdFqe27YKYORtjfIwzSAF0cevwfFgE+n38CR7rKZ2qcitLXkO2UAdNOwQhODi4+NGxiQc0LvXge0cQAnwLd+RslQP69Ghs/GEf4ov2KXPOYuPqOAyZPwEt5cElc0C5WD8ioqpxkm7mYHxSxm2llUWLuP2bsHZpGMK2NMX8pS9h5ti70a3JzY+Aded/QticT3Dt7qkY2iQJEb8mIHjhm5gRXFd+xe3KxN7XJmLSq7uQXOLEV8A18Dls/+2/GFS0b5lxAO8//hES+4xDoPYgtsUG4pnFMxCk8A+q7P8W83pkJZ/FkV0bsWFfBjpPXYgZIT6lTjuw5DX2qaj+auiDK1/fj3av+WD1n0sxymS7sn4OGH7HiWWYOOwZ/OE/DuPubIz8HDd0mfwkZg9oVrJPmAOKZO/1u11qygGyHtafpB6QmPaBigYOFtKm4HjkX0h28kXXXp3hY+5rkaxJn4mzkUeRVKc9egb5QQ2fV9t9UOgT8PveC3BqGYBO7ZpAPiuhJEteY6eK6q/6PrBBDlyPP4Lo0xmo1bQjgrq1kL+OuQzMAUWy5/rdLrvJAbotrD9JPSAx7QP7GzjQbWFQOLai+rMPHBvr79iYAyRh/UnqAYlpH9jJxdFERERERGRNHDgQEREREZFZHDgQEREREZFZHDgQEREREZFZHDgQEREREZFZHDgQEREREZFZHDgQEREREZFZt9zHgYgcmxQJzAMix8YcIKIipvdx4A3gqASpD9gDjquo/uwDx8b6OzbmAElYf5J6QGLaBzxViYiIiIiIzOLAgYiIiIiIzOLAgYiIiIiIzOLAgYiIiIiIzOLAgYiIiIiIzOLAgYiIiIiIzFLR17HqcOXkfvx2PB21mgcjJKQtGshLbpWJ0wfi4NmnO/w08qxqZem66HA16TIyc+W/qVMt1PNpAa86hZNKZL9fv1ZxT+gzTmN/xF9IdWmJXnf1Qeu68gJTOfGI2heJOK03ggcOQPvyG1C1iuqv7D6wdLuydg5ILFkX5oAyVeY9RXIdl45G4UhcLvz6haK7j9WaqsapIwfI2lh/knpAUqIPDBNG0lOTSYVJFxHvjBX+7rWFu7uzcHauJ7r8a4X4/Zq8uFiGOLH5AzFnaBvh0Wmh+DVbnl2tLF0XIfIvfC0eaF6r+G/r2vkxsTVdXqhQyu2BqjLfEzknvhazQoeIUSNDRPv6zqLJgJfEjlR5oSzv3Drx1P0Pi7fX/SK2f/cfMX7IVPHZH1nyUvtRVH8l94H57coWOVDIkm2cOaBElue4oYIiOWK5mPfAg+KFr/aImIw8eb79Kqq//fcBVYT1J6kHSveBKk5V0v7xNb44NRRfHL+Ca8lnsfX1QcheF4bnvzwOnfyaQho07j0VU0K8oZf+qVZg+brkIPqnGPT+cjciIiKMj70/Po/QRvJishEzPaGLxebwPDy0eie2bN2L/RueRdvoj7Fi8yXo5ZdAdx6rXngbOQ+8hacn3o3QyS9hyb8L8M7TK/CHVn4N2Ygl25X1c6CQJevCHFAiy3Nci9gfHsc9j0ei90vL8fr0gWjf0EVeRkTkgOQBRJmjCmXIF5fD14tfTT8BzjsllgyvK+pPXilu/eAuX1xYPkbUDbDGJ42Wr0t+4jrx6tu7xN/ytFooswduV0U9kStyc+Wnkpw94rkgPzHt+xR5hqHEMR+K4fVHiqWx+fIcg7Q1YqpPN/Hs7hx5hn0oqr9S+8Dy7cqaOVDIknVhDiiR5TmedXixGNIkSCzcrvBDRNVM6TlAtsH6k9QDpftABUccNPAdPh7DmsiTEhc/tG7dEI0bNoCrPMuUk3M1/LO0FxEblyNPFLF0XbQ4tmoFPnx3NoaPewSLvjmAS/xkukaV3xNucHOTnxro0+OR7r8Ac0Z7y3MAXUKCoX43kJtTIM8xcG+JNi3O4diJpJtHJsjKKrddWS8HJJasC3NAmSzMcV0MVr7xFv4ImYtHh/IQERGRRBWnKt1Cl4DzFxtg1Kh+8JRnVUVW5BKM9tPATeNkPLVh0XeHkGjcC0zH7rCRmPDlccNbvxllrksONF0fxBvPTEKwUySWzQzFkAeW4LcMeTEpki75ID57cR1c778H3UwujtZ4NUbj/GP44+iVm4MEkYWsa3rcuJEDk+EEWZV1tquq5YAl68IcUI0yclx7YgNW/3wDXX1TsXz2JIQGByBw+FysOGSSA0REjkY+8lDm4QiluhbxHzHqgS/EmTKvUcsXF1eMM3uKQn78t2KsT3/xwVHpRdni/J5vxGvTQ0Sr+vVFo0Y+otf89SLO5MyU8lS8LpJr4uTa+eLOhh6iZ9gew5SyqaUHKsdcT+SL5KjVhvr3F63cDduBawcxbeVZUVzSvGNi6T+8hGvQHLH2TJYQuckieuUsEYi64r5vbp7SZA+K6q/8PjC3XdkyByzZxpkDSnZrjueLhM/uEbWde4snNp4qPNUs65j4YnIbgRbTxKqLFrw5qJh6coCsifUnqQdK90HxVFkLFelapHh3+qPiu7Pl7albtsMg0g6LHQeSDK++DWbXpUi2iHxjoGgY9JzYo/BT4u0zKCzsCYO0yA/F+JbOonbf10SkybUP+Yl7xdJHx4j+fYaKCbNeFh+GjRT1XIeKd4+Zq726FNVfHX1Q0XZlwxwwsmQbZw4oUpk5niuOvNlfuHZ+WphexpR37B0xpJa7uPeLy9XQM8qlrhwga2H9SeqB0n2grlOV9AnY8t63wIxFmNzuNr/Zwqs3hvZriip/E3el1sUd3UaNRLA2G9k8xq1oXr1mIWxWXzgnJyPF5OtVNM0GYP7H/0PEwR34cdlDqBsbDbcxk3BvJ37DSs2phu3qdnOgmCXrwhxQnHJz3BkeHh6o5eEJd5N3SZe2vdAzoABXMzN4iiIROST1DBz0KdjzwTuI6vk0Hu/vJc/MQkbGDfm5DVVlXXT5cOveHV0UfNMnkrihVfPm8GjnjzYmF02bytizHMsigvHMc5Phb7/3gFIHJW1XlqwLc0A5KsxxF7QICkb7C2cQ83fhkkKucKvjjbZt/QyvICJyPOoYOOiTsXvxHCyO64jOedHYtGEDNqxbhWXPP4svjubLL7qpoKCg8CFPVysL1kWfHo2NP+xDfNEn1jlnsXF1HIbMn4CW3NGsERX1hF5v8vGvLhZbd1zG2BkTEFDGnoEubh2eD4tAv48/wWM93eW5ZAuV3a6smQOWrAtzQMEsyPE6fafg4TsjsWbtyeKL43UXonC09hRMGWqHt40nIrKAk3S+kvFJWbeVVoRM7H1tIia9ugvJpcYIroHPYftv/8Wg4v03LeL2b8LapWEI29IU85e+hJlj70a3JtX1Lm3ZuuhOLMPEYc/gD/9xGHdnY+TnuKHL5Ccxe0Czajglwrrs7xbzFfeE7vgSjBnyFhJ7jMDgLl7QXk6C29An8cqMnmhofIVEj6zksziyayM27MtA56kLMSPER/G1rIqi+iuxDyzfrqydA5atC3NAqSx/T9Gd/wlhcz7BtbunYmiTJET8moDghW9iRrDJ167ZISXnANkO609SD0hM+0AFAwd1uh5/BNGnM1CraUcEdWtxW18ba0uOFxRapJyKxrH4bGjq+SEg8A40K30gQZ+A3/degFPLAHRq1wT2fJZJUf2V2gdK2q4sWRfmgB3QpuB45F9IdvJF116d4VPOKYz2ROk5QLbB+pPUAxLTPuDAgUpgUDi2ovqzDxwb6+/YmAMkYf1J6gGJaR+o8wZwRERERERkUxw4EBERERGRWRw4EBERERGRWRw4EBERERGRWRw4EBERERGRWRw4EBERERGRWRw4EBERERGRWbfcx4GIHJsUCcwDIsfGHCCiIqb3ceAN4KgEqQ/YA46rqP7sA8fG+js25gBJWH+SekBi2gc8VYmIiIiIiMziwIGIiIiIiMziwIGIiIiIiMziwIGIiIiIiMziwIGIiIiIiMziwIGIiIiIiMziwIGIiIiIiMxS0X0cdLhycj9+O56OWs2DERLSFg3kJWW7jktHo3AkLhd+/ULR3Ucjz68e+ozT2B/xF1JdWqLXXX3Quq68wJQ+Bcd2HcBpXSuEDO0BXzd5voLZ7/c2Z+L0gTh49ukOv1taoTK9VdHPUb+i+iu7D3S4mnQZmbny+jnVQj2fFvCqUzhZknVz4KYKfg9zQKEs2e4r+75jH9SRA2RtrD9JPSAx7QOVHHHIwP53J6JPr1GY/O/7MXZAd9w15VMcyZIXl6BHyv5PMH/yPKw46oxOg4ZV+87CjZPf4NEHHsXbny7FC5ND0Hv0y9h5RV5YJD0Cbz/4BFYneqBRzna88NCb2J2qlxeS7WTi5M9LMHdYD/R8+Huc1sqzi1naW+Z+DtmK/uL3mNurPfz9/Y2PgNHvIfKGvLCY9XOgkJnfwxxQKEu2+8q87xAROQjDKMJIemoyqSi5R94TDz70odh1PkvkXzsnwt8cK9q4NhTDPzgm8uTXFMoVZ9fOE316TBffnsyW51WzvLNi7XuficPp0kS+SNkZJvq4NxQTv0wwTBXJENuf6C5C3z8hr1+eiFk2VvRasFWkGaeVS6k9UHV/i5SUNHHg5TtF7YCF4tdSbWF5b1X8c+xFUf2V2wfZ4tAHz4sPwiNERETh4+CpFJNtT2KDHDAy93uYA0plyXZveTbYH+XnANkC609SD5Tug+KpshYqQ764HL5e/JoqT0ryToklw+uK+pNXCuP+uyzr8GIxpEmQWLjddG51yxW5ufJTSc4e8VyQn5j2fYo8w7DGCV+JiY0GireP33x7yT//sRjhNV58ebHkLo7S2GdQ5IsLy8eIurfs8FveW4XK+zn2o6j+Su2D/MR14tW3dxmGceWzTQ6Y/z3MAaWyZLuvbDbYF6XnANkG609SD5TuAxWcqqSB7/DxGNZEnpS4+KF164Zo3LABXOVZ0MVg5Rtv4Y+QuXh0aCN55m3QXkRsXI48YcoNbibnKOvT45HuvwBzRnvLc4Dsw/uwC/5o28pFnmP4V/i0Q/v6+3EguqyfSdbm5FxWq1vYWybK/jlkG1ocW7UCH747G8PHPYJF3xzApdKnjNkqByz4PcwBpbJku698NhAROQJ17gXpEnD+YgOMGtUPnvIs7YkNWP3zDXT1TcXy2ZMQGhyAwOFzseLQFZR3RnFW5BKM9tPATeOExr2nYtF3h5BofHE6doeNxIQvjxt2VcqnSz6Iz15cB9f770G34oujdUi8eAEZvk3hbXpKtaYBGjVIQ3xCsuEVpFhl9BYpRQ40XR/EG89MQrBTJJbNDMWQB5bgtwx5sYGtcsD872EOqIol2z2zgYhInQOHrMNrsaPhAsy7u+iTPj2uRB1GFLqhR+gEvPT5GvwS8SMWNA7HnPuewpr4W3cZ9AkrMWXsegzbkgWtPhtR79wNzY6n0M+rAby8OuPZ/NexaVFvlP0FKHqkRK/B4rBnsHjdZiybOhpzVsXKOwIFyM7JAdzroE7pv65TAW7k3HIVJynIrb1FytEQXUdMxayFi7B8YwT2fjcDjfa8iMfe3YvC61VtlQOW/B7mgJpYst0zG4iI1DhwyIrCZ1+m4V+vTkOH4jMA8nElLQ0FnQZibGgA6kmzPLtgWthcDEn6Eet/TZE/BbxJ494RCzasw/xAd8OUO9oMnIYXv9qPC1evIj09GZFLx6N1uV/CooFPz0mG10fg9z0fYnzTWPywfA2OGj+WdIanu+Fn6vWGtTJRkAtpP8LD01Olh3kcQJm9RcpUF53uewsfPdUT57aF44hxP9xWOWDJ72EOqIYl2z2zgYjISF3vXfoEbHnvW2DGIkxuZ5rezvDw8EAtD0+4m/yLXNr2Qs+AAlzNzECBPK+YV28M7dfUMAS4PV69ZiFsVl84JycjxXjIwQW+bfzhk3oFaaZ7KfnpSE9tjjatvW/7d5IVlNtbpFzu6DZqJIK12cg2bmu2ygFLfg9zQBUs2e6ZDURExdQzcNCnYM8H7yCq59N4vL+XPDMLGRnSR40uaBEUjPYXziDm78IlhVzhVscbbdv6GV5hLW5o1bw5PNr5o418PoN7n0EYnHcKpy/ePItZdyEGZ2sPweDePDtWcSrsLVI0XT7cundHF+PN32yVA5b9HuaAwlmy3TMbiIhKUMfAQZ+M3YvnYHFcR3TOi8amDRuwYd0qLHv+WXxxtPBEgDp9p+DhOyOxZu3J4gsZdReicLT2FEwZWr33+tTrTT5C1MVi647LGDtjAgLkvRJNs7F4ZHo2tm85I1/3oMWpbbsgZs7GGB/jDLKxgoKCwoc8XcyC3jJV7s8hq9OnR2PjD/sQX7QfnnMWG1fHYcj8CWgpf3xvqxyw5PcwBxTMku2+ktlAROQInKTvZDU+KeO20sqQib2vTcSkV3chuVRWuwY+h+2//ReDpNOTDXTnf0LYnE9w7e6pGNokCRG/JiB44ZuYEVz8lUe3TXd8CcYMeQuJPUZgcBcvaC8nwW3ok3hlRk80lF9jlHEA7z/+ERL7jEOg9iC2xQbimcUzEKTwDxrt7xbzWsTt34S1S8MQtqUp5i99CTPH3o1uTaQ9Tct7q+KfYz+K6q/EPtCdWIaJw57BH/7jMO7OxsjPcUOXyU9i9oBmJU77sUUOSCz6PcwBBbJku69MNtgfJecA2Q7rT1IPSEz7QAUDh0rSpuB45F9IdvJF116d4VP21yLdBi1STkXjWHw2NPX8EBB4B5qV9waiz8TZyKNIqtMePYP8oIb3GQaFYyuqv1L74Hr8EUSfzkCtph0R1K1F+V+LafUckFnye5gDpDJKzwGyDdafpB6QmPaB/Q0c6LYwKBxbUf3ZB46N9XdszAGSsP4k9YDEtA/Uc3E0ERERERHVGA4ciIiIiIjILA4ciIiIiIjILA4ciIiIiIjILA4ciIiIiIjILA4ciIiIiIjILA4ciIiIiIjIrFvu40BERERERCThfRyIiIiIiKhSio84EBERERERlYdHHIiIiIiIyAzg/wE5Dedr0rhU+gAAAABJRU5ErkJggg==[/img][br][br] 通过绘制填充的矩形来可视化表中数据（见[color=#0000ff]图 6-2-41[/color]），其高度对应计数，宽度对应年龄组的宽度，我们把条形图称之为直方图。注意，直方图的宽度表示组距大小，高度表示分组频数大小。为了使可视化成为有效的直方图，所有的条形规定为相同的宽度。[br][br] age_hist <- cbind(age_hist, age = (1:15) * 5 - 2.5) [br][br] h1 <- ggplot(age_hist, aes(x = age, y = count)) + [br][br] geom_col(width = 4.7, fill = "#56B4E9") + [br][br] scale_y_continuous(expand = c(0, 0), breaks = 25 * (0:5)) + [br][br] scale_x_continuous( name = "Age",limits = c(0, 75), expand = c(0, 0)) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid() + [br][br] theme( [br][br] axis.line.x = element_blank(), [br][br] plot.margin = margin(3, 7, 3, 1.5) [br][br] ) [br][br] h1[br][br][br][br][br][br][br][br] 图 6-2-41 乘客年龄分组直方图

直方图是通过对数据分组后绘制而成的，因此，视觉外观取决于组距大小。大多数系统生成的直方图可视化程序都会选择一个默认的柱形宽度，但是柱形宽度可能不是最合适的宽度。因此，掌握不同柱形宽度绘图技巧至关重要。[br][br] 为了绘制的直方图能准确地反映数据的基本特征，就要考虑分组大小。一般来说，分组条形宽度过小，直方图就会变得过于尖峰和拥挤，数据分布趋势和特征可能会被掩盖。另一方面，过大的分组会导致条形宽度过大，导致数据分布的差异特征被掩盖，数据中较小的特征值可能会消失。[br][br] 泰坦尼克号乘客的年龄分布[color=#0000ff]如图 6-2-42 [/color]所示，可以看到，1 年的组距使条形宽度太小，15 年的条形宽度太大，而 3～5 年的组宽就较为可行。[br][br][br][br][br][br][br][br][br][br][br][br][br][br] 图 6-2-42 年龄分组大小不同的直方图

age_hist_1 <- data.frame(age = (1:75) - 0.5, [br][br] count = hist(titanic$age, breaks = (0:75) + .01, [br][br] plot = FALSE)$counts [br][br] ) [br][br] age_hist_3 <- data.frame(age = (1:25) * 3 - 1.5, [br][br] count = hist(titanic$age, breaks = (0:25) * 3 + .01, [br][br] plot = FALSE)$counts [br][br] ) [br][br] age_hist_15 <- data.frame(age = (1:5) * 15 - 7.5, [br][br] count = hist(titanic$age, breaks = (0:5) * 15 + .01, [br][br] plot = FALSE)$counts [br][br] ) [br][br] h2 <- ggplot(age_hist_1, aes(x = age, y = count)) + [br][br] geom_col(width = .85, fill = "#56B4E9") + [br][br] scale_y_continuous(expand = c(0, 0), breaks = 10 * (0:5)) + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75), [br][br] expand = c(0, 0)) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid(12) + [br][br] theme(axis.line.x = element_blank(), [br][br] plot.margin = margin(3, 1.5, 3, 1.5) [br][br] ) [br][br] h3 <- ggplot(age_hist_3, aes(x = age, y = count)) + [br][br] geom_col(width = 2.75, fill = "#56B4E9") + [br][br] scale_y_continuous(expand = c(0, 0), breaks = 25 * (0:5)) + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75), [br][br] expand = c(0, 0)) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid(12) + [br][br] theme(axis.line.x = element_blank(), [br][br] plot.margin = margin(3, 1.5, 3, 1.5) [br][br] ) [br][br] h4 <- ggplot(age_hist_15, aes(x = age, y = count)) + [br][br] geom_col(width = 14.5, fill = "#56B4E9") + [br][br] scale_y_continuous(expand = c(0, 0), breaks = 100 * (0:4)) + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75), [br][br] expand = c(0, 0)) +[br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid(12) + [br][br] theme(axis.line.x = element_blank(), [br][br] plot.margin = margin(3, 1.5, 3, 1.5) [br][br] ) [br][br] plot_grid(h2, NULL, h3,NULL, NULL, NULL, [br][br] h1 + theme_dviz_hgrid(12) + [br][br] theme(axis.line.x = element_blank(), [br][br] plot.margin = margin(3, 1.5, 3, 1.5)), NULL, h4, [br][br] align = 'hv', [br][br] labels = c("a", "", "b", "", "", "", "c", "", "d"), [br][br] rel_widths = c(1, .04, 1), [br][br] rel_heights = c(1, .04, 1) [br][br] )[br][br] 随着计算机可视化能力的不断提高，直方图逐渐被一类密度图所代替。密度图一般使用连续曲线来可视化数据的概率分布，这与统计概率的定义是一致的。因为概率密度函数通常用一条钟形曲线来描述，而这条曲线需要数据进行估计，最常用的估计方法是核密度估计。在核密度估计中，每个数据点的位置绘制一条宽度很小的连续曲线（由一个叫作带宽的参数控制），然后将所有这些曲线拼合起来得到最终的密度估计。使用最广泛的高斯核密度（即高斯钟形曲线）[color=#0000ff]如图 6-2-43[/color] 所示。[br][br][br][br][br][br][br][br][br][br][br] 图 6-2-43 年龄分布密度图

ggplot(titanic, aes(x = age)) + [br][br] geom_density_line(fill = "#56B4E9", color = darken("#56B4E9", 0.5), [br][br] bw = 2, kernel = "gaussian") + [br][br] scale_y_continuous(limits = c(0, 0.046), expand = c(0, 0), [br][br] name = "概率密度") + [br][br] scale_x_continuous(name = "年龄", limits = c(0, 75), expand = c(0, 0)) +[br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid() + [br][br] theme( [br][br] axis.line.x = element_blank(), [br][br] plot.margin = margin(3, 7, 3, 1.5) [br][br] )[br][br] 与直方图类似，密度图的具体外观取决于条形宽度的选择。条形宽度参数的行为类似于直方图中的条形宽度。如果条形宽度太小，那么密度函数曲线可能变得过于尖峰和拥挤，数据中的主要趋势可能会被模糊化。另一方面，如果条形宽度太大，那么数据分布中的较小特征可能消失。此外，条形宽度的选择也会影响密度曲线的形状，如图 6-2-44 所示。例如，高斯曲线将倾向于产生看起来像高斯密度函数概率的估计，具有平滑的尾部特征。相比之下，矩形可以在密度曲线下生成。一般来说，数据集中的数据点越多，内核的选择就越不重要。因此，密度图对于大型数据集来说是较为可靠且有强大表现力的可视化图形，对于连续型随机变量来说，数据量越大，绘制的图形结果越准确，而对于只有几个点的数据来说，就可能产生较大误差。[br][br][br][br][br][br][br][br][br][br] 图 6-2-44 不同分组的核密度图

pdens1 <- ggplot(titanic, aes(x = age)) + [br][br] geom_density_line(fill = "#56B4E9", [br][br] color = darken("#56B4E9", 0.5), bw = .5, kernel = "gaussian") + [br][br] scale_y_continuous(limits = c(0, 0.046), expand = c(0, 0), [br][br] name = "density") + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75),[br] [br] expand = c(0, 0)) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid(12) + [br][br] theme(axis.line.x = element_blank(),plot.margin = margin(3, 1.5, 3, 1.5) [br][br] ) [br][br] pdens2 <- ggplot(titanic, aes(x = age)) + [br][br] geom_density_line(fill = "#56B4E9", color = darken("#56B4E9", 0.5), [br][br] bw = 2, kernel = "gaussian") + [br][br] scale_y_continuous(limits = c(0, 0.046), expand = c(0, 0), [br][br] name = "density") + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75), [br][br] expand = c(0, 0)) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid(12) + [br][br] theme(axis.line.x = element_blank(),plot.margin = margin(3, 1.5, 3, 1.5) [br][br] ) [br][br] pdens3 <- ggplot(titanic, aes(x = age)) + [br][br] geom_density_line(fill = "#56B4E9", color = darken("#56B4E9", 0.5), [br][br] bw = 5, kernel = "gaussian") + [br][br] scale_y_continuous(limits = c(0, 0.046), expand = c(0, 0), [br][br] name = "density") + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75), [br][br] expand = c(0, 0)) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid(12) + [br][br] theme(axis.line.x = element_blank(),plot.margin = margin(3, 1.5, 3, 1.5) [br][br] ) [br][br] pdens4 <- ggplot(titanic, aes(x = age)) + [br][br] geom_density_line(fill = "#56B4E9", color = darken("#56B4E9", 0.5), [br][br] bw = 2, kernel = "rectangular") + [br][br] scale_y_continuous(limits = c(0, 0.046), expand = c(0, 0), [br][br] name = "density") + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75), [br][br] expand = c(0, 0)) + [br][br] coord_cartesian(clip = "off") +[br][br] theme_dviz_hgrid(12) + [br][br] theme(axis.line.x = element_blank(),plot.margin = margin(3, 1.5, 3, 1.5) [br][br] ) [br][br][br] plot_grid(pdens1, NULL, pdens2, NULL, NULL, NULL,pdens3, NULL, pdens4, [br][br] align = 'hv', [br][br] labels = c("a", "", "b", "", "", "", "c", "", "d"), [br][br] rel_widths = c(1, .04, 1), [br][br] rel_heights = c(1, .04, 1) [br][br] )

（二）多变量可视化分布[br][br] 在许多情况下，有多个分布需要同时可视化。例如，想知道泰坦尼克号男乘客和女乘客的年龄分布。年龄是唯一分组，乘客的性别有两个分类。通常情况下，可视化策略是使用一个堆叠的直方图来展示，如图 6-2-45 所示，使用不同的颜色将女乘客的直方图置于男乘客的直方图之上，把这类图形称之为堆积或堆叠直方图。[br][br][br][br][br][br][br][br][br][br][br][br][br][br][br][br][br] 图 6-2-45 不同年龄和性别乘客的堆叠直方图

[br] data.frame( [br][br] age = (1:25)*3 - 1.5, [br][br] male = hist(filter(titanic, sex == "male")$age, [br][br] breaks = (0:25)*3 + .01, plot = FALSE)$counts, [br][br] female = hist(filter(titanic, sex == "female")$age, [br][br] breaks = (0:25)*3 + .01, plot = FALSE)$counts ) %>% [br][br] gather(gender, count, -age) -> gender_counts [br][br] gender_counts$gender <- factor(gender_counts$gender,[br][br] levels = c("female", "male")) [br][br] p_hist_stacked <- ggplot(gender_counts, [br][br] aes(x = age, y = count, [br][br] fill =gender)) + [br][br] geom_col(position = "stack") + [br][br] scale_x_continuous(name = "age (years)", [br][br] limits = c(0, 75), expand = c(0, 0)) + [br][br] scale_y_continuous(limits = c(0, 89), expand = c(0, 0), [br][br] name = "count") + [br][br] scale_fill_manual(values = c("#D55E00", "#0072B2")) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid() + [br][br] theme( [br][br] axis.line.x = element_blank(), [br][br] legend.position = c(.9, .87), [br][br] legend.justification = c("right", "top"), [br][br] legend.box.background = element_rect(fill = "white", [br][br] color = "white"), [br][br] plot.margin = margin(3, 7, 3, 1.5) [br][br] )

图 6-2-45 存在两个问题：首先，从数据上看，完全不清楚这些条形图到底是从哪个变量值开始的，是从颜色变化的地方开始还是从 0 度量开始？例如，18～20 岁的女乘客约有 25人，但是图上所示有约 80 人。其次，女乘客的条形图高度不是统一尺度的起点，横向之间不能直接相互比较。例如，男乘客的平均年龄比女乘客大，但图中看不出来。尝试让所有条形图都从 0 开始，超出部分透明显示，[color=#0000ff]如图 6-2-46[/color] 所示。[br][br] p_hist_overlapped <- ggplot(gender_counts, aes(x = age, y = count, [br][br] fill = gender)) + [br][br] geom_col(position = "identity", alpha = 0.7) + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75), [br][br] expand = c(0, 0)) + [br][br] scale_y_continuous(limits = c(0, 56), expand = c(0, 0), name = "count") + [br][br] scale_fill_manual(values = c("#D55E00", "#0072B2"), [br][br] guide = guide_legend(reverse = TRUE)) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid() + [br][br] theme( [br][br] axis.line.x = element_blank(), [br][br] legend.position = c(.9, .87),[br][br] legend.justification = c("right", "top"), [br][br] legend.box.background = element_rect(fill = "white", color = "white"), [br][br] plot.margin = margin(3, 7, 3, 1.5) [br][br] ) [br][br] stamp_bad(p_hist_overlapped)[br][br][br][br][br][br][br][br][br][br][br][br][br] 图 6-2-46 起点相同的堆叠直方图

[br] 然而，从图 6-2-46 中看出，实际上出现了三个不同的类，而不是两个，我们仍然不完全确定每个条形图的起点和终点。堆叠直方图的可视化效果并不好，因为在另一个直方图上绘制的半透明条形图看起来不像半透明条形图，而像是用不同颜色绘制的条形图。堆叠密度图通常不存在堆叠直方图所存在的问题，因为连续的密度曲线有助于视觉保持分离。然而，对于这个数据集，男乘客和女乘客的年龄分布在 17 岁左右几乎是重叠的，此后出现分离，因此，可视化的效果仍然不理想，[color=#0000ff]如图 6-2-47 所示[/color]。[br][br] titanic2 <- titanic [br][br] titanic2$sex <- factor(titanic2$sex, levels = c("male", "female")) [br][br] ggplot(titanic2, aes(x = age, y = ..count.., fill = sex, color = sex)) + [br][br] geom_density_line(bw = 2, alpha = 0.7) + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75), [br][br] expand = c(0, 0)) + [br][br] scale_y_continuous(limits = c(0, 19), expand = c(0, 0), [br][br] name = "scaled density") + [br][br] scale_fill_manual(values = c("#0072B2", "#D55E00"), name = "gender") + [br][br] scale_color_manual(values = darken(c("#0072B2", "#D55E00"), 0.5), [br][br] name = "gender") + [br][br] guides(fill = guide_legend(override.aes = list(linetype = 0))) + [br][br] coord_cartesian(clip = "off") +[br][br] theme_dviz_hgrid() + [br][br] theme( [br][br] axis.line.x = element_blank(), [br][br] legend.position = c(.9, .87), [br][br] legend.justification = c("right", "top"), [br][br] legend.box.background = element_rect(fill = "white", color = "white"), [br][br] plot.margin = margin(3, 7, 3, 1.5) [br][br] )[br][br][br][br][br][br][br][br][br][br] 图 6-2-47 堆积密度图

对于这个数据集，最好的解决方案是分别显示男乘客和女乘客的年龄分布，每个人都占总体年龄分布的比例如图 6-2-48 所示。从图 6-2-48 中可以更直观、清晰地展示泰坦尼克号上20～50 岁年龄段的女性比男性要少得多。[br][br] ggplot(titanic2, aes(x = age, y = ..count..)) + [br][br] geom_density_line( [br][br] data = select(titanic, -sex), aes(fill = "all passengers"), [br][br] color = "transparent" ) + [br][br] geom_density_line(aes(fill = sex), [br][br] bw = 2, [br][br] color = "transparent") + [br][br] scale_x_continuous(limits = c(0, 75), [br][br] name = "passenger age (years)", [br][br] expand = c(0, 0)) + [br][br] scale_y_continuous(limits = c(0, 26), [br][br] name = "scaled density", [br][br] expand = c(0, 0)) + [br][br] scale_fill_manual([br][br] values = c("#b3b3b3a0", "#D55E00", "#0072B2"), [br][br] breaks = c("all passengers", "male", "female"), [br][br] labels = c("all passengers ", "males ", "females"), [br][br] name = NULL, [br][br] guide = guide_legend(direction = "horizontal") ) + [br][br] coord_cartesian(clip = "off") + [br][br] facet_wrap(~sex, labeller = labeller( [br][br] sex = function(sex) paste(sex, "passengers"))) + [br][br] theme_dviz_hgrid() + [br][br] theme( [br][br] axis.line.x = element_blank(), [br][br] strip.text = element_text(size = 14, margin = margin(0, 0, 0.2, 0, "cm")), [br][br] legend.position = "bottom", [br][br] legend.justification = "right", [br][br] legend.margin = margin(4.5, 0, 1.5, 0, "pt"), [br][br] legend.spacing.x = grid::unit(4.5, "pt"), [br][br] legend.spacing.y = grid::unit(0, "pt"), [br][br] legend.box.spacing = grid::unit(0, "cm") [br][br] )[br][br][br][br][br][br][br][br][br][br][br] 图 6-2-48 按乘客性别展示的堆积密度图

当要精确地可视化两个分布时，还可以制作两个独立的直方图，将它们旋转 90，让其中一个直方图中的柱形点指向另一个直方图的相反方向，[color=#0000ff]如图 6-2-49 [/color]所示。在可视化年龄分布时，通常使用这个技巧，得到的图形被称为年龄金字塔图。[br][br] ggplot(gender_counts, aes(x = age, y = ifelse(gender == "male",-1, 1)*count, [br][br] fill = gender)) + [br][br] geom_col() + [br][br] scale_x_continuous(name = "age (years)", limits = c(0, 75), [br][br] expand = c(0, 0)) + [br][br] scale_y_continuous(name = "count", breaks = 20*(-2:1), [br][br] labels = c("40", "20", "0", "20")) + [br][br] scale_fill_manual(values = c("#D55E00", "#0072B2"), guide = "none") + [br][br] draw_text(x = 70, y = -39, "male", hjust = 0) + [br][br] draw_text(x = 70, y = 21, "female", hjust = 0) + [br][br] coord_flip() + [br][br] theme_dviz_grid() + [br][br] theme(axis.title.x = element_text(hjust = 0.61))[br][br][br][br][br][br][br][br][br][br] 图 6-2-49 年龄金字塔图

如果同时可视化两个以上的分布时，上述这些图就不起作用了。同时展示多个分布，直方图往往会变得非常混乱，而密度图较好地克服了直方图的这个缺陷。[color=#0000ff]如图 6-2-50[/color] 所示，使用堆积的密度图展示了 4 种不同奶制品乳脂百分比，对于同类的研究对象进行横向比较时能较好地表现数据的内部信息。[br][br] cows %>% [br][br] mutate(breed = as.character(breed)) %>% [br][br] filter(breed != "Canadian") -> cows_filtered [br][br] cows_dens <- group_by(cows_filtered, breed) %>% [br][br] do(ggplot2:::compute_density(.$butterfat, NULL)) %>% [br][br] rename(butterfat = x) [br][br] cows_max <- filter(cows_dens, density == max(density)) %>% [br][br] ungroup() %>%[br][br] mutate( [br][br] hjust = c(0, 0, 0, 0), [br][br] vjust = c(0, 0, 0, 0), [br][br] nudge_x = c(-0.2, -0.2, 0.1, 0.23), [br][br] nudge_y = c(0.03, 0.03, -0.2, -0.06) [br][br] ) [br][br] cows_p <- ggplot(cows_dens, aes(x = butterfat, y = density, color = breed, fill = breed)) + [br][br] geom_density_line(stat = "identity") + [br][br] geom_text( [br][br] data = cows_max, [br][br] aes( [br][br] label = breed, hjust = hjust, vjust = vjust, [br][br] color = breed, [br][br] x = butterfat + nudge_x, [br][br] y = density + nudge_y [br][br] ), [br][br] inherit.aes = FALSE, [br][br] size = 12/.pt [br][br] ) + [br][br] scale_color_manual( [br][br] values = darken(c("#56B4E9", "#E69F00", "#D55E00", "#009E73"), 0.3), [br][br] breaks = c("Ayrshire", "Guernsey", "Holstein-Friesian", "Jersey"), [br][br] guide = "none" [br][br] ) + [br][br] scale_fill_manual( [br][br] values = c("#56B4E950", "#E69F0050", "#D55E0050", "#009E7350"), [br][br] breaks = c("Ayrshire", "Guernsey", "Holstein-Friesian", "Jersey"), [br][br] guide = "none" [br][br] ) + [br][br] scale_x_continuous( [br][br] expand = c(0, 0), [br][br] labels = scales::percent_format(accuracy = 1, scale = 1), [br][br] name = "butterfat contents" [br][br] ) + [br][br] scale_y_continuous(limits = c(0, 1.99), expand = c(0, 0)) + [br][br] coord_cartesian(clip = "off") + [br][br] theme_dviz_hgrid() + [br][br] theme(axis.line.x = element_blank()) [br][br] cows_p[br][br][br] [br][br][br][br][br][br][br][br] 图 6-2-50 四种乳制品乳脂百分比堆积密度图