R/plot_national_flag.R

Defines functions plot_Han18Star plot_ROC_KMT_flag plot_ROC_Beiyang_flag plot_P.R.CHINA_flag

Documented in plot_Han18Star plot_P.R.CHINA_flag plot_ROC_Beiyang_flag plot_ROC_KMT_flag

#' Plot the national flag of the People's Republic of China
#'
#' Draws the national flag of the People's Republic of China at the regulation
#' proportions using pure geometric computation and \code{ggplot2}. The shape
#' and orientation of the stars are computed analytically so that each small
#' star points to the centre of the large star. No external image or SVG
#' resources are used, which makes the function suitable for teaching and
#' programmatic graphics.
#'
#' @param label Logical; whether to display the title and axis text. If
#'   \code{TRUE} (default) the title, designer and reference information are
#'   shown; if \code{FALSE} only the flag is drawn.
#'
#' @return A \code{ggplot} object, which can be printed directly or saved with
#'   \code{ggsave()}.
#'
#' @details
#' \itemize{
#'   \item The flag has a 3:2 aspect ratio.
#'   \item The large star is placed in the upper-left canton.
#'   \item The four small stars are positioned per the specification and
#'     rotated to point at the large star.
#'   \item \code{ggplot2::coord_quickmap()} keeps a 1:1 x:y ratio.
#' }
#'
#' @examples
#' \donttest{
#' plot_P.R.CHINA_flag()
#' plot_P.R.CHINA_flag(label = FALSE)
#' }
#'
#' @author Flag design: Zeng Liansong.
#'
#' @seealso \code{\link[ggplot2]{geom_polygon}},
#'   \code{\link[ggplot2]{coord_quickmap}}
#'
#' @export
plot_P.R.CHINA_flag<-function(label=TRUE){
  # ------------------------------------------------------------
  # 图像几何绘制方法参考 B 站视频:BV1Ni4y1978g
  # 本脚本通过纯几何计算 + ggplot2 绘制标准五星红旗
  # ------------------------------------------------------------
  # ------------------------------------------------------------
  # 标题和坐标轴标签
  # ------------------------------------------------------------
  if(label==TRUE){
    labels<-list(x='\u8bbe\u8ba1\u53c2\u8003B\u7ad9\u89c6\u9891\uff1aBV1Ni4y1978g',  # 设计参考B站视频:BV1Ni4y1978g
                 y='\u8bbe\u8ba1\u8005\uff1a\u66fe\u8054\u677e',  # 设计者:曾联松
                 title='R\u8bed\u8a00\u7ed8\u5236\u6807\u51c6\u4e94\u661f\u7ea2\u65d7')  # R语言绘制标准五星红旗
  }else{
    labels<-list(x='',
                 y='',
                 title='')
  }
  # ------------------------------------------------------------
  # 函数1:计算两条由两点确定的直线的交点
  # (x1,y1)-(x2,y2) 与 (x3,y3)-(x4,y4)
  # ------------------------------------------------------------
  line_line_point<-function(x1,y1,x2,y2,x3,y3,x4,y4){
    # 第一条直线斜率
    k1 = (y2 - y1) / (x2 - x1)
    # 第二条直线斜率
    k2 = (y4 - y3) / (x4 - x3)
    # 直线截距
    b1 = y1 - k1 * x1
    b2 = y3 - k2 * x3
    # 联立求解交点
    x0 = (b2 - b1) / (k1 - k2)
    y0 = k1 * x0 + b1
    result<-c(x0,y0)
    result
  }

  # ------------------------------------------------------------
  # 函数2:构造五角星的 10 个顶点
  # x0, y0 : 星星中心坐标
  # r      : 外接圆半径
  # w      : 整体旋转角度(弧度)
  # ------------------------------------------------------------
  star_construction_point<-function(x0,y0,r,w)#中心坐标,半径,旋转角度
  {
    onefifth2pi=2*pi/5 # 五角星相邻顶点夹角
    # 外圈五个顶点坐标
    x1=x0+r*sin(w)
    y1=y0+r*cos(w)
    x2=x0+r*sin((w+onefifth2pi))
    x3=x0+r*sin((w+2*onefifth2pi))
    x4=x0+r*sin((w+3*onefifth2pi))
    x5=x0+r*sin((w+4*onefifth2pi))
    y2=y0+r*cos((w+onefifth2pi))
    y3=y0+r*cos((w+2*onefifth2pi))
    y4=y0+r*cos((w+3*onefifth2pi))
    y5=y0+r*cos((w+4*onefifth2pi))
    # ----------------------------------------------------------
    # 内部五个顶点:通过外顶点连线求交点
    # ----------------------------------------------------------
    xy6<-c(line_line_point(x1,y1,x3,y3,x5,y5,x2,y2))
    x6=xy6[1]
    y6=xy6[2]
    xy7<-c(line_line_point(x2,y2,x4,y4,x1,y1,x3,y3))
    x7=xy7[1]
    y7=xy7[2]
    xy8<-c(line_line_point(x3,y3,x5,y5,x4,y4,x2,y2))
    x8=xy8[1]
    y8=xy8[2]
    xy9<-c(line_line_point(x1,y1,x4,y4,x5,y5,x3,y3))
    x9=xy9[1]
    y9=xy9[2]
    xy10<-c(line_line_point(x1,y1,x4,y4,x5,y5,x2,y2))
    x10=xy10[1]
    y10=xy10[2]
    # 返回顺序排列的 10 个点(用于 geom_polygon)
    result<-c(x1,x6,x2,x7,x3,x8,x4,x9,x5,x10,
              y1,y6,y2,y7,y3,y8,y4,y9,y5,y10)
    result
  }
  # ------------------------------------------------------------
  # 函数3:计算小星需要旋转的角度
  # 目标:让小星的某个角“指向”大星中心
  # ------------------------------------------------------------
  # x0,y0 : 大星中心
  # x,y   : 小星中心
  # xn,yn : 小星某个顶点
  # r     : 小星半径
  w_cal<-function(x0,y0,x,y,xn,yn,r){
    # 大星中心 - 小星中心 的连线
    k=(y0-y)/(x0-x)
    b=y-k*x
    # 点到直线的距离
    distance=(abs(k*xn-yn+b))/((1+k^2)^0.5)
    # 根据几何关系反推旋转角
    w=asin(distance/r)
    w
  }
  # ------------------------------------------------------------
  # 初始状态下各星的坐标(未旋转)
  # ------------------------------------------------------------
  # 小星 1
  star1_x<-c(star_construction_point(10,18,1,0)[1:10])
  star1_y<-c(star_construction_point(10,18,1,0)[11:20])
  star1<-data.frame(star1_x,star1_y)
  # 小星 2
  star2_x<-c(star_construction_point(12,16,1,0)[1:10])
  star2_y<-c(star_construction_point(12,16,1,0)[11:20])
  star2<-data.frame(star1_x,star1_y)
  # 小星 3
  star3_x<-c(star_construction_point(12,13,1,0)[1:10])
  star3_y<-c(star_construction_point(12,13,1,0)[11:20])
  star3<-data.frame(star1_x,star1_y)
  # 小星 4
  star4_x<-c(star_construction_point(10,11,1,0)[1:10])
  star4_y<-c(star_construction_point(10,11,1,0)[11:20])
  star4<-data.frame(star1_x,star1_y)
  # 大星
  star0_x<-c(star_construction_point(5,15,3,0)[1:10])
  star0_y<-c(star_construction_point(5,15,3,0)[11:20])
  star0<-data.frame(star1_x,star1_y)#构建数据框
  #星1是x4对准,星2是x5对准,星3是x1对准,星4是x5对准
  # ------------------------------------------------------------
  # 计算四颗小星的旋转角度
  # 不同小星指向大星的不同顶点
  # w1为正,w2为负,w3为负,w4正
  # ------------------------------------------------------------
  w1<-w_cal(5,15,10,18,star1_x[7],star1_y[7],1)
  w2<-w_cal(5,15,12,16,star2_x[9],star2_y[9],1)
  w3<-w_cal(5,15,12,13,star3_x[1],star3_y[1],1)
  w4<-w_cal(5,15,10,11,star4_x[9],star4_y[9],1)#计算旋转角度绝对值
  # 方向修正(顺/逆时针)
  w2<-w2*(-1)
  w3<-w3*(-1)#校正角度正负(旋转方向)
  # ------------------------------------------------------------
  # 重新构建旋转后的小星坐标
  # ------------------------------------------------------------
  star0_x<-c(star_construction_point(5,15,3,0)[1:10])
  star0_y<-c(star_construction_point(5,15,3,0)[11:20])
  star0<-data.frame(star1_x,star1_y)
  star1_x<-c(star_construction_point(10,18,1,w1)[1:10])
  star1_y<-c(star_construction_point(10,18,1,w1)[11:20])
  star1<-data.frame(star1_x,star1_y)
  star2_x<-c(star_construction_point(12,16,1,w2)[1:10])
  star2_y<-c(star_construction_point(12,16,1,w2)[11:20])
  star2<-data.frame(star1_x,star1_y)
  star3_x<-c(star_construction_point(12,13,1,w3)[1:10])
  star3_y<-c(star_construction_point(12,13,1,w3)[11:20])
  star3<-data.frame(star1_x,star1_y)
  star4_x<-c(star_construction_point(10,11,1,w4)[1:10])
  star4_y<-c(star_construction_point(10,11,1,w4)[11:20])
  star4<-data.frame(star1_x,star1_y)#重新构建数据框

  # ------------------------------------------------------------
  # 背景红旗矩形
  # ------------------------------------------------------------
  rectangle<-data.frame(c(0,30,30,0),c(0,0,20,20))
  colnames(rectangle)<-c('x','y')
  # ------------------------------------------------------------
  # ggplot 绘图
  # ------------------------------------------------------------
  ggplot2::ggplot()+
    ggplot2::geom_polygon(data = rectangle,ggplot2::aes(x=x,y=y),color="#ee1c25",
                 fill="#ee1c25")+
    ggplot2::geom_polygon(data = star0,ggplot2::aes(x=star0_x,y=star0_y),color="#ffff00",
                 fill="#ffff00")+
    ggplot2::geom_polygon(data = star1,ggplot2::aes(x=star1_x,y=star1_y),color="#ffff00",
                 fill="#ffff00")+
    ggplot2::geom_polygon(data = star2,ggplot2::aes(x=star2_x,y=star2_y),color="#ffff00",
                 fill="#ffff00")+
    ggplot2::geom_polygon(data = star3,ggplot2::aes(x=star3_x,y=star3_y),color="#ffff00",
                 fill="#ffff00")+#绘图星星
    ggplot2::geom_polygon(data = star4,ggplot2::aes(x=star4_x,y=star4_y),color="#ffff00",
                 fill="#ffff00")+#绘图红旗
    ggplot2::coord_quickmap()+#调整为1:1比例显示
    ggplot2::theme(legend.key = ggplot2::element_blank(),
          panel.grid.major=ggplot2::element_line(colour=NA),
          panel.background = ggplot2::element_rect(fill = "transparent",colour = NA),
          plot.background = ggplot2::element_rect(fill = "transparent",colour = NA),
          panel.grid.minor = ggplot2::element_blank(),
          axis.text = ggplot2::element_blank(),
          axis.ticks = ggplot2::element_blank(),
          panel.grid  = ggplot2::element_blank())+#隐藏坐标系
    ggplot2::labs(x=labels$x,
         y=labels$y,
         title=labels$title)+
    showtext::showtext_auto()#显示中文文本
}



#' Plot the Five-Colored Flag of the Beiyang Government
#'
#' Draws the Five-Colored Flag used during the Beiyang Government period
#' (circa 1912-1928) of the Republic of China, using horizontal colour bands
#' rendered with \code{ggplot2}. The flag has five equal horizontal stripes in
#' red, yellow, blue, white and black, symbolising the Han, Manchu, Mongol, Hui
#' and Tibetan peoples. The drawing is fully programmatic and uses no external
#' image resources.
#'
#' @param label Logical; whether to display the title and explanatory text.
#'   \code{TRUE} (default) shows the title and annotations; \code{FALSE} draws
#'   only the flag.
#'
#' @return A \code{ggplot} object, which can be printed or saved with
#'   \code{ggsave()}.
#'
#' @details
#' \itemize{
#'   \item The flag is built from five equal-height horizontal rectangles.
#'   \item From top to bottom the colours are red, yellow, blue, white, black.
#'   \item These represent the Han, Manchu, Mongol, Hui and Tibetan peoples.
#'   \item \code{ggplot2::coord_quickmap()} keeps the proportions undistorted.
#'   \item Axes, grid and legend are hidden.
#' }
#'
#' @examples
#' \donttest{
#' plot_ROC_Beiyang_flag()
#' plot_ROC_Beiyang_flag(label = FALSE)
#' }
#'
#' @seealso \code{\link[ggplot2]{geom_rect}},
#'   \code{\link[ggplot2]{coord_quickmap}}
#'
#' @author Historical flag of the Beiyang Government era.
#'
#' @export
plot_ROC_Beiyang_flag<-function(label=TRUE){
  # ------------------------------------------------------------
  # 标题和坐标轴标签
  # ------------------------------------------------------------
  if(label==TRUE){
    labels<-list(x='\u5317\u6d0b\u653f\u5e9c - \u4e94\u65cf\u5171\u548c\u65d7',  # 北洋政府 - 五族共和旗
                 y='\u6c49\u6ee1\u8499\u56de\u85cf\n\uff08\u7ea2\u9ec4\u84dd\u767d\u9ed1\uff09',  # 汉满蒙回藏\n(红黄蓝白黑)
                 title='\u5317\u6d0b\u653f\u5e9c\u65f6\u671f\uff081912-1928\uff09')  # 北洋政府时期(1912-1928)
  }else{
    labels<-list(x='',
                 y='',
                 title='')
  }
  # ------------------------------------------------------------
  # 不同颜色块坐标
  # ------------------------------------------------------------
  rect_data<-rbind(
    data.frame(xmin=0,xmax=8,ymin=4,ymax=5,color='red',order=1),
    data.frame(xmin=0,xmax=8,ymin=3,ymax=4,color='gold',order=2),
    data.frame(xmin=0,xmax=8,ymin=2,ymax=3,color='darkblue',order=3),
    data.frame(xmin=0,xmax=8,ymin=1,ymax=2,color='white',order=4),
    data.frame(xmin=0,xmax=8,ymin=0,ymax=1,color='black',order=5)
  )
  rect_data$order<-factor(rect_data$order,levels=rect_data$order)
  # ------------------------------------------------------------
  # ggplot 绘图
  # ------------------------------------------------------------
  ggplot2::ggplot()+
    ggplot2::geom_rect(data = rect_data,
              mapping = ggplot2::aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax,
                            fill=order))+
    ggplot2::scale_fill_manual(values=rect_data$color)+
    ggplot2::coord_quickmap()+#调整为1:1比例显示
    ggplot2::theme(legend.key = ggplot2::element_blank(),
          panel.grid.major=ggplot2::element_line(colour=NA),
          panel.background = ggplot2::element_rect(fill = "transparent",colour = NA),
          plot.background = ggplot2::element_rect(fill = "transparent",colour = NA),
          panel.grid.minor = ggplot2::element_blank(),
          axis.text = ggplot2::element_blank(),
          axis.ticks = ggplot2::element_blank(),
          legend.position = 'none',
          panel.grid  = ggplot2::element_blank())+#隐藏坐标系
    ggplot2::labs(x=labels$x,
         y=labels$y,
         title=labels$title)+
    showtext::showtext_auto()#显示中文文本
}



#' Plot the Blue Sky, White Sun, and a Wholly Red Earth flag
#'
#' Programmatically draws the Blue Sky, White Sun, and a Wholly Red Earth flag
#' used during the Nationalist Government period (1928-1949) of the Republic of
#' China, using analytic geometry with \code{ggplot2} and \code{ggforce}. The
#' flag has a red field, a blue canton in the upper-left, and a twelve-rayed
#' white sun within the canton, all generated from vector geometry without
#' external image files.
#'
#' @param label Logical; whether to display the title and explanatory text.
#'   \code{TRUE} (default) shows the title, designer and period; \code{FALSE}
#'   draws only the flag.
#'
#' @return A \code{ggplot} object, which can be printed or saved with
#'   \code{ggsave()}.
#'
#' @details
#' \itemize{
#'   \item The red field and blue canton are built from rectangles.
#'   \item The twelve-rayed sun is a closed polygon of 24 vertices.
#'   \item Two concentric circles form the core of the white sun.
#'   \item \code{ggplot2::coord_quickmap()} keeps the proportions undistorted.
#'   \item Axes, grid and legend are hidden by default.
#' }
#'
#' @examples
#' \donttest{
#' plot_ROC_KMT_flag()
#' plot_ROC_KMT_flag(label = FALSE)
#' }
#'
#' @seealso \code{\link[ggplot2]{geom_polygon}},
#'   \code{\link[ggplot2]{geom_rect}},
#'   \code{\link[ggforce]{geom_circle}}
#'
#' @author Design: Sun Yat-sen (proposal) and Lu Haodong (Blue Sky, White Sun).
#'
#' @export
plot_ROC_KMT_flag<-function(label=TRUE){
  # ------------------------------------------------------------
  # 设计参考:https://zh.wikipedia.org/wiki/%E4%B8%AD%E8%8F%AF%E6%B0%91%E5%9C%8B%E5%9C%8B%E6%97%97
  # https://commons.wikimedia.org/wiki/File:Flag_of_the_Republic_of_China_construction_sheet.svg
  # ------------------------------------------------------------

  # ------------------------------------------------------------
  # 标题和坐标轴标签
  # ------------------------------------------------------------
  if(label==TRUE){
    labels<-list(x='\u56fd\u6c11\u653f\u5e9c - \u9752\u5929\u767d\u65e5\u6ee1\u5730\u7ea2\u65d7',  # 国民政府 - 青天白日满地红旗
                 y='\u8bbe\u8ba1\u8005\uff1a\u5b59\u4e2d\u5c71\u3001\u9646\u7693\u4e1c',  # 设计者:孙中山、陆皓东
                 title='\u56fd\u6c11\u653f\u5e9c\u65f6\u671f\uff081928-1949\uff09')  # 国民政府时期(1928-1949)
  }else{
    labels<-list(x='',
                 y='',
                 title='')
  }
  # ------------------------------------------------------------
  # 背景颜色块坐标
  # ------------------------------------------------------------
  rect_bg_red<-data.frame(xmin=0,xmax=48,ymin=0,ymax=32,color='red',order=1)
  rect_bg_blue<-data.frame(xmin=0,xmax=24,ymin=16,ymax=32,color='blue',order=1)
  # ------------------------------------------------------------
  # 十二星顶点和底点坐标(从正上方点顺时针排序ID)
  # ------------------------------------------------------------
  # 外接圆、太阳内小圆半径;圆心坐标
  r1=6;r2=3;loc_center<-c(12,24)
  # 第一象限内
  ##不在坐标轴的顶点坐标
  point_top1<-c(0,r1)
  point_top2<-c(r1*sin(pi/6),r1*cos(pi/6))
  point_top3<-c(r1*sin(pi/3),r1*cos(pi/3))
  ##低点坐标
  point_bottom1<-c(r2*sin(pi/12),r2*cos(pi/12))
  point_bottom2<-c(r2*sin(pi/4),r2*cos(pi/4))
  point_bottom3<-c(r2*cos(pi/12),r2*sin(pi/12))
  # 第二象限:第一象限关于X轴对称
  point_top4<-c(r1,0)
  point_top5<-c(point_top3[1],-point_top3[2])
  point_top6<-c(point_top2[1],-point_top2[2])
  ##低点坐标
  point_bottom4<-c(point_bottom3[1],-point_bottom3[2])
  point_bottom5<-c(point_bottom2[1],-point_bottom2[2])
  point_bottom6<-c(point_bottom1[1],-point_bottom1[2])
  # 第三象限:第一象限关于原点中心对称
  point_top7<-c(0,-r1)
  point_top8<-c(-point_top2[1],-point_top2[2])
  point_top9<-c(-point_top3[1],-point_top3[2])
  ##低点坐标
  point_bottom7<-c(-point_bottom1[1],-point_bottom1[2])
  point_bottom8<-c(-point_bottom2[1],-point_bottom2[2])
  point_bottom9<-c(-point_bottom3[1],-point_bottom3[2])
  # 第四象限:第一象限关于Y轴对称
  point_top10<-c(-r1,0)
  point_top11<-c(-point_top3[1],point_top3[2])
  point_top12<-c(-point_top2[1],point_top2[2])
  ##低点坐标
  point_bottom10<-c(-point_bottom3[1],point_bottom3[2])
  point_bottom11<-c(-point_bottom2[1],point_bottom2[2])
  point_bottom12<-c(-point_bottom1[1],point_bottom1[2])
  # 构建十二星闭合图案数据框
  star12_df<-data.frame(matrix(nrow=24,ncol=2)) #建立空白变量
  colnames(star12_df)<-c('x','y')
  star12_order<-paste0('point_',rep(c('top','bottom'),12),
                       rep(c(as.character(1:12)),each=2))
  for (i in 1:24) {
    star12_df$x[i]<-get(star12_order[i])[1]
    star12_df$y[i]<-get(star12_order[i])[2]
  }
  # 基于圆心平移图案
  star12_df$x<-star12_df$x+loc_center[1];star12_df$y<-star12_df$y+loc_center[2]

  # ------------------------------------------------------------
  # ggplot 绘图
  # ------------------------------------------------------------
  ggplot2::ggplot()+
    ggplot2::geom_rect(data = rect_bg_red,
              mapping = ggplot2::aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),fill='#DE0000')+
    ggplot2::geom_rect(data = rect_bg_blue,
              mapping = ggplot2::aes(xmin=xmin,xmax=xmax,ymin=ymin,ymax=ymax),fill='#0000AA')+
    ggplot2::geom_polygon(data = star12_df,ggplot2::aes(x=x,y=y),color="white",
                 fill="white")+
    ggforce::geom_circle(ggplot2::aes(x0=12, y0=24, r=3*(1+1/15)), fill='#0000AA')+
    ggforce::geom_circle(ggplot2::aes(x0=12, y0=24, r=3), fill='white')+
    ggplot2::coord_quickmap()+#调整为1:1比例显示
    ggplot2::theme(legend.key = ggplot2::element_blank(),
          panel.grid.major=ggplot2::element_line(colour=NA),
          panel.background = ggplot2::element_rect(fill = "transparent",colour = NA),
          plot.background = ggplot2::element_rect(fill = "transparent",colour = NA),
          panel.grid.minor = ggplot2::element_blank(),
          axis.text = ggplot2::element_blank(),
          axis.ticks = ggplot2::element_blank(),
          legend.position = 'none',
          panel.grid  = ggplot2::element_blank())+#隐藏坐标系
    ggplot2::labs(x=labels$x,
         y=labels$y,
         title=labels$title)+
    showtext::showtext_auto()#显示中文文本
}





#' Plot the Iron-Blood 18-Star Flag of the Wuchang Uprising
#'
#' Draws the Iron-Blood 18-Star Flag (also called the Nine-Pointed
#' Eighteen-Star Flag) used by the Hubei military government after the Wuchang
#' Uprising of the Xinhai Revolution. The flag has a red field, a central black
#' nine-pointed star, and nine inner and nine outer yellow dots representing the
#' eighteen Han provinces of the time. All shapes are generated by vector
#' computation, without external image files.
#'
#' @param label Logical; whether to display the title and explanatory text.
#'   \code{TRUE} (default) shows the title, designer and historical background;
#'   \code{FALSE} draws only the flag.
#'
#' @return A \code{ggplot} object, which can be printed or saved with
#'   \code{ggsave()}.
#'
#' @details
#' \itemize{
#'   \item The aspect ratio is 5:8; x ranges over [-80, 80], y over [-50, 50].
#'   \item The nine-pointed star has a circumscribed radius of 44 units and an
#'     inner radius of 8 units.
#'   \item Nine outer yellow dots sit along the star tips; nine inner dots sit
#'     midway between the centre and the tips.
#'   \item \code{ggplot2::coord_fixed(ratio = 1)} keeps the proportions fixed.
#'   \item Axes, grid and legend are hidden by default.
#' }
#'
#' @examples
#' \donttest{
#' plot_Han18Star()
#' plot_Han18Star(label = FALSE)
#' }
#'
#' @seealso \code{\link[ggplot2]{geom_polygon}},
#'   \code{\link[ggforce]{geom_circle}},
#'   \code{\link{plot_P.R.CHINA_flag}},
#'   \code{\link{plot_ROC_Beiyang_flag}},
#'   \code{\link{plot_ROC_KMT_flag}}
#'
#' @author Flag design: the Chinese Revolutionary Alliance (Tongmenghui).
#'
#' @references \url{https://www.19111010.com.tw/story?id=93}
#'
#' @export
plot_Han18Star<-function(label=TRUE){

  #参考链接:https://www.19111010.com.tw/story?id=93
  #设置旗子长160个单位,宽100个单位


  # ------------------------------------------------------------
  # 必要函数
  # ------------------------------------------------------------
  # 根据圆心和圆上两点计算对应圆心夹角度数的函数
  getAngle_byABO_circle<-
    function(O,#圆心坐标x,y
             A,#圆上一点坐标x,y
             B,#圆上另一点坐标x,y
             size, #large是优弧对应角,small是劣弧对应角
             r#圆半径
    ){

      # 检验AB点是否在圆上
      if(round(abs(sqrt((A[2]-O[2])^2+(A[1]-O[1])^2)),5)!=round(r,5)){
        message('A point is NOT on the cycle!')
        return(NA)
      }
      if(round(abs(sqrt((B[2]-O[2])^2+(B[1]-O[1])^2)),5)!=round(r,5)){
        message('B point is NOT on the cycle!')
        return(NA)
      }

      # 计算AB点弦长
      distance_AB<-
        abs(sqrt((B[2]-A[2])^2+(B[1]-A[1])^2))
      # 计算劣弧对应角度
      angle_small<-asin((distance_AB/2)/r)*2
      # 基于劣弧结果计算优弧对应结果
      angle_large<-2*pi-asin((distance_AB/2)/r)*2
      #输出
      if(size=='large'){
        return(angle_large)
      }else if(size=='small'){
        return(angle_small)
      }else{
        message('Input of Size is not correct.')
        return(NA)
      }
    }
  # 圆弧与直线交点坐标
  ## 以A点(xp,yp)为圆心,B点(x1,y1)为圆弧起点画圆,与直线CD:C(x2,y2),
  ## D(x3,y3)交与E点(x4,y4)和F(x5,y5)。side为X轴方向上靠左还是靠右。
  getPointCrossLineAndCircle<-
    function(xp,yp,x1,y1,x2,y2,x3,y3,side){
      #开始求圆弧和直线交点
      k=((y2-y3)/(x2-x3))#计算CD斜率
      if(!is.infinite(k)){
        b=y2-(k*x2)#计算CD截距
        r=((x1-xp)^2+(y1-yp)^2)^0.5#计算圆弧对应完整圆的半径
        a=k^2+1
        b2=2*(b*k-k*yp-xp)
        c=xp^2+(b-yp)^2-r^2#标准一元二次方程求根
        delta=b2^2-4*a*c#验证是否有实根
        x4=(b2*(-1)+((delta)^0.5))/(2*a)
        x5=(b2*(-1)-((delta)^0.5))/(2*a)
        y4=k*x4+b
        y5=k*x5+b#求交点坐标
        x_left<-min(c(x4,x5))
        x_right<-max(c(x4,x5))
        if(side=='left'){
          return(c(x_left,k*x_left+b))
        }else if(side=='right'){
          return(c(x_right,k*x_right+b))
        }
      }else if(is.infinite(k)){
        #斜率无限大/无限小,即垂直线与圆交点,此时x2==x3
        if(x2!=x3){
          message('k is infinite but x2 is not equal as x3')
          return(NA)
        }else{
          r=sqrt((xp-x1)^2+(yp-y1)^2)
          x_get=unique(c(x2,x3))
          y1_get<-yp+sqrt(r^2-(x2-xp)^2)
          y2_get<-yp-sqrt(r^2-(x2-xp)^2)
          if(side=='top'){
            return(c(x_get,max(y1_get,y2_get)))
          }else if(side=='bottom'){
            return(c(x_get,min(y1_get,y2_get)))
          }
        }
      }

    }
  # 计算两点之间距离
  dis2points<-function(p1,p2){
    return(
      sqrt((p1[1]-p2[1])^2+(p1[2]-p2[2])^2)
    )
  }
  # 计算直线 AB 与直线 CD 的交点
  getLineIntersection <- function(A, B, C, D, tol = 1e-10) {
    # A, B, C, D 均为长度为 2 的向量 c(x, y)
    x1 <- A[1]; y1 <- A[2]
    x2 <- B[1]; y2 <- B[2]
    x3 <- C[1]; y3 <- C[2]
    x4 <- D[1]; y4 <- D[2]
    # 行列式
    denom <- (x1 - x2) * (y3 - y4) -
      (y1 - y2) * (x3 - x4)
    # 平行或重合
    if (abs(denom) < tol) {
      return(list(
        intersect = FALSE,
        type = "parallel_or_collinear",
        point = NULL
      ))
    }
    # 交点坐标
    px <- ((x1*y2 - y1*x2) * (x3 - x4) -
             (x1 - x2) * (x3*y4 - y3*x4)) / denom

    py <- ((x1*y2 - y1*x2) * (y3 - y4) -
             (y1 - y2) * (x3*y4 - y3*x4)) / denom
    return(list(
      intersect = TRUE,
      type = "unique",
      point = c(px, py)
    ))
  }
  # 求两圆交点中靠左或靠右的点
  circle_intersection <- function(x1, y1, r1, x2, y2, r2, side = c("left", "right")) {
    side <- match.arg(side)

    # 圆心距
    dx <- x2 - x1
    dy <- y2 - y1
    d <- sqrt(dx^2 + dy^2)

    # 容差
    eps <- .Machine$double.eps^0.5

    # 无交点或无穷多交点的情况
    if (d > r1 + r2 + eps || d < abs(r1 - r2) - eps || (d < eps && abs(r1 - r2) < eps)) {
      return(c(NA_real_, NA_real_))
    }

    # 从圆心A沿AB方向到弦垂足的距离
    a <- (r1^2 - r2^2 + d^2) / (2 * d)
    # 垂足到交点的距离(半弦长)
    h2 <- r1^2 - a^2
    h <- if (h2 < 0) 0 else sqrt(h2)   # 处理相切或极小数值误差

    # 垂足坐标
    x0 <- x1 + a * dx / d
    y0 <- y1 + a * dy / d

    # 垂直于AB的单位向量(两个方向)
    # 注意:dx, dy 可能为0,但d>0时除法安全
    vx <- -dy / d
    vy <-  dx / d

    # 两个交点
    p1 <- c(x0 - h * vx, y0 - h * vy)
    p2 <- c(x0 + h * vx, y0 + h * vy)

    # 根据 side 选择
    if (side == "left") {
      # x 较小者;若相等则返回第一个(即 p1 和 p2 中x坐标较小的那一个)
      if (p1[1] <= p2[1]) p1 else p2
    } else { # "right"
      if (p1[1] > p2[1]) p1 else p2
    }
  }

  #背景
  p_bg<-
    ggplot2::ggplot()+
    ggplot2::geom_rect(mapping = ggplot2::aes(xmin=-80,xmax=80,ymin=-50,ymax=50),
                       fill='red')+
    ggplot2::coord_fixed(ratio = 1)

  #黑正九角星
  ##建立点坐标
  PointDF<-data.frame(
    ID=NA,
    X=NA,Y=NA
  )
  ##开始按照说明计算点坐标
  ##辅助点坐标数据框
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID='O',X=0,Y=0
                 ))
  ##从数据框中调出坐标的函数
  getPointLoc<-function(ID){
    return(
      list(
        X=PointDF$X[which(PointDF$ID==ID)],
        Y=PointDF$Y[which(PointDF$ID==ID)]
      )
    )
  }
  #1.取大小
  rO_Small=8;rO_Big=44
  #2.定两点
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID=c('G','D','A1','A'),
                   X=c((-rO_Big*sqrt(3)/2),rO_Big*sqrt(3)/2,0,0),
                   Y=c(rep(-rO_Big/2,2),-rO_Big,rO_Big)
                 ))#G、D点的坐标一眼就可以看出
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID=c('B1','C1'),
                   X=c(-rO_Big/2,rO_Big/2),
                   Y=c(rep(rO_Big*sqrt(3)/2,2))
                 ))#B1 C1点的坐标一眼就可以看出
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID=c('D1'),
                   X=c(0),
                   Y=c(-rO_Big/3)
                 ))#D1点的坐标简单计算可以知道
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID=c('F'),
                   X=getPointCrossLineAndCircle(
                     0,0,#O
                     0,-rO_Big,#A1
                     0,-rO_Big/3,#D1
                     0+1,-rO_Big/3+sqrt(3),#子线斜率为3,过D点
                     'left'
                   )[1],
                   Y=getPointCrossLineAndCircle(
                     0,0,#O
                     0,-rO_Big,#A1
                     0,-rO_Big/3,#D1
                     0+1,-rO_Big/3+sqrt(3),#子线斜率为根3,过D点
                     'left'
                   )[2]
                 ))#F
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID=c('E'),
                   X=getPointCrossLineAndCircle(
                     0,0,#O
                     0,-rO_Big,#A1
                     0,-rO_Big/3,#D1
                     0+1,-rO_Big/3-sqrt(3),#子线斜率为3,过D1点
                     'right'
                   )[1],
                   Y=getPointCrossLineAndCircle(
                     0,0,#O
                     0,-rO_Big,#A1
                     0,-rO_Big/3,#D1
                     0+1,-rO_Big/3-sqrt(3),#丑线斜率为负根3,过D1点
                     'right'
                   )[2]
                 ))#E
  #3.移中心
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID=c('E1'),
                   X=0,
                   Y=getPointLoc('E')$Y
                 ))#E1
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID=c('F1'),
                   X=0,
                   Y=mean(c(getPointLoc('E')$Y,getPointLoc('A')$Y))
                 ))#F1
  PointDF$Y<-PointDF$Y-getPointLoc('F1')$Y
  PointDF<-PointDF[which(PointDF$ID %in% c('O','A','G','F','E','D')),]
  #4.连九星
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID=c('E1','F1'),
                   X=c((2*getPointLoc('O')$X-getPointLoc('E')$X),
                       (2*getPointLoc('O')$X-getPointLoc('F')$X)),
                   Y=c((2*getPointLoc('O')$Y-getPointLoc('E')$Y),
                       (2*getPointLoc('O')$Y-getPointLoc('F')$Y))
                 ))
  H_loc<-circle_intersection(getPointLoc('O')$X,getPointLoc('O')$Y,rO_Big,
                             getPointLoc('E1')$X,getPointLoc('E1')$Y,rO_Big,'left')
  B_loc<-circle_intersection(getPointLoc('O')$X,getPointLoc('O')$Y,rO_Big,
                             getPointLoc('E1')$X,getPointLoc('E1')$Y,rO_Big,'right')
  I_loc<-circle_intersection(getPointLoc('O')$X,getPointLoc('O')$Y,rO_Big,
                             getPointLoc('F1')$X,getPointLoc('F1')$Y,rO_Big,'left')
  C_loc<-circle_intersection(getPointLoc('O')$X,getPointLoc('O')$Y,rO_Big,
                             getPointLoc('F1')$X,getPointLoc('F1')$Y,rO_Big,'right')
  PointDF<-rbind(PointDF,
                 data.frame(
                   ID=c('H','B','I','C'),
                   X=c(H_loc[1],B_loc[1],I_loc[1],C_loc[1]),
                   Y=c(H_loc[2],B_loc[2],I_loc[2],C_loc[2])
                 ))
  PointStar<-data.frame(
    ID=NA,X=NA,Y=NA
  )
  for(id in c('A','F','B','G','C','H','D','I','E','A')){
    PointStar<-
      rbind(PointStar,
            data.frame(
              ID=id,
              X=getPointLoc(id)$X,
              Y=getPointLoc(id)$Y
            ))
  }
  PointStar<-PointStar[!is.na(PointStar$X),]
  #windows版会出现geom_polygon导致的空白,因此要单独建立一个图层
  Star_Cross<-data.frame(
    Line1Point1=c('A','I','H','G','F','A','G','H','B'),
    Line1Point2=c('F','E','D','C','B','E','C','C','G'),
    Line2Point1=c('I','H','G','A','E','H','I','B','A'),
    Line2Point2=c('D','C','B','F','I','D','D','F','E'),
    X=NA,
    Y=NA
  )
  for(i in 1:nrow(Star_Cross)){
    Star_Cross_i<-
    getLineIntersection(
      A=c(getPointLoc(Star_Cross$Line1Point1[i])$X,getPointLoc(Star_Cross$Line1Point1[i])$Y),
      B=c(getPointLoc(Star_Cross$Line1Point2[i])$X,getPointLoc(Star_Cross$Line1Point2[i])$Y),
      C=c(getPointLoc(Star_Cross$Line2Point1[i])$X,getPointLoc(Star_Cross$Line2Point1[i])$Y),
      D=c(getPointLoc(Star_Cross$Line2Point2[i])$X,getPointLoc(Star_Cross$Line2Point2[i])$Y),
      tol = 1e-10
    )
    Star_Cross$X[i]<-Star_Cross_i$point[1]
    Star_Cross$Y[i]<-Star_Cross_i$point[2]
  }
  p_Star<-list(
    ggplot2::geom_path(data=PointStar,ggplot2::aes(x=X,y=Y)),
    ggplot2::geom_polygon(data=PointStar,ggplot2::aes(x=X,y=Y),fill='black'),
    ggplot2::geom_polygon(data=Star_Cross,ggplot2::aes(x=X,y=Y),fill='black')
  )

  #外圈的黄圆
  p_Circle_Out<-list(
    ggforce::geom_circle(data=PointStar,
                         ggplot2::aes(x0=X,y0=Y,r=rO_Small/2),
                         fill = "yellow", color=NA)
  )

  #内圈黄圆
  CircleInside<-data.frame(
    ID=1,X=0,Y=1.5*rO_Small
  )
  for(i in 2:nrow(dplyr::distinct(PointStar))){
    CircleInside<-
      rbind(CircleInside,
            data.frame(
              ID=i,
              X=getPointCrossLineAndCircle(xp=getPointLoc('O')$X,yp=getPointLoc('O')$Y,
                                           x1=getPointLoc('O')$X+1.5*rO_Small,y1=getPointLoc('O')$Y,
                                           x2=getPointLoc('O')$X,y2=getPointLoc('O')$Y,
                                           x3=dplyr::distinct(PointStar)$X[i],y3=dplyr::distinct(PointStar)$Y[i],
                                           side=ifelse(dplyr::distinct(PointStar)$X[i]<=0,'left','right'))[1],
              Y=getPointCrossLineAndCircle(xp=getPointLoc('O')$X,yp=getPointLoc('O')$Y,
                                           x1=getPointLoc('O')$X+1.5*rO_Small,y1=getPointLoc('O')$Y,
                                           x2=getPointLoc('O')$X,y2=getPointLoc('O')$Y,
                                           x3=dplyr::distinct(PointStar)$X[i],y3=dplyr::distinct(PointStar)$Y[i],
                                           side=ifelse(dplyr::distinct(PointStar)$X[i]<=0,'left','right'))[2]
            ))
  }
  p_Circle_Inside<-list(
    ggforce::geom_circle(data=CircleInside,
                         ggplot2::aes(x0=X,y0=Y,r=rO_Small/2),
                         fill = "yellow", color=NA)
  )

  if(label==TRUE){
    labels<-list(x='\u94c1\u8840\u5341\u516b\u661f\u65d7',  # 铁血十八星旗
                 y='\u8bbe\u8ba1\uff1a\u4e2d\u56fd\u9769\u547d\u540c\u76df\u4f1a',  # 设计:中国革命同盟会
                 title='\u6b66\u660c\u8d77\u4e49 \u2014 \u4e2d\u534e\u6c11\u56fd\u6e56\u5317\u519b\u653f\u5e9c')  # 武昌起义 — 中华民国湖北军政府
  }else{
    labels<-list(x='',
                 y='',
                 title='')
  }

  return(
    p_bg+
      p_Star+
      p_Circle_Out+p_Circle_Inside+
      ggplot2::labs(
        x=labels$x,y=labels$y,title=labels$title
      )+
      ggplot2::scale_y_continuous(limits = c(-50,50))+
      ggplot2::scale_x_continuous(limits = c(-80,80))+
      ggplot2::theme(legend.key = ggplot2::element_blank(),
                     panel.grid.major=ggplot2::element_line(colour=NA),
                     panel.background = ggplot2::element_rect(fill = "transparent",colour = NA),
                     plot.background = ggplot2::element_rect(fill = "transparent",colour = NA),
                     panel.grid.minor = ggplot2::element_blank(),
                     axis.text = ggplot2::element_blank(),
                     axis.ticks = ggplot2::element_blank(),
                     legend.position = 'none',
                     plot.title = ggplot2::element_text(face = 'bold',hjust=0.5),
                     panel.grid  = ggplot2::element_blank())+
      showtext::showtext_auto()
  )
}

Try the ggChinaFlag package in your browser

Any scripts or data that you put into this service are public.

ggChinaFlag documentation built on July 4, 2026, 9:07 a.m.