add semicircle primitive

lch14forever · Jul 24, 2023 · fc25b39 · fc25b39
1 parent a4e874c
commit fc25b39
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 8 deletions.
diff --git a/R/geom-star.R b/R/geom-star.R
@@ -132,7 +132,9 @@ starshape_table <- c(
                  "anise star4"              = 27,
                  "square diamond"           = 28,
                  "plus filled"              = 29,
-                 "antiparallelogram"        = 30)
+                 "antiparallelogram"        = 30,
+                 "semicircle"               = 31
+                 )
 
 # reference ggplot2
 translate_starshape_string <- function(starshape_string){

diff --git a/R/primitive.R b/R/primitive.R
@@ -10,8 +10,8 @@ starGrob <- function(x=0.5, y=0.5,
                                lwd=0.5),
                      position.units = "npc", 
                      size.units="mm", ...){
-    if (! all(starshape %in% seq_len(30))){
-        stop("the starshape should be one of 1 to 30 !")
+    if (! all(starshape %in% seq_len(31))){
+        stop("the starshape should be one of 1 to 31 !")
     }
     N <- length(x)
     stopifnot(length(y)==N)
@@ -56,18 +56,18 @@ starshape_ntab <- c(5, 6, 7, 8,
                     0, 0, 0, 0,
                     0, 3, 3, 6,
                     50, 3, 0, 4,
-                    0, 0)
+                    0, 0, 50)
 
-names(starshape_ntab) <- seq_len(30)
+names(starshape_ntab) <- seq_len(31)
 
 match_n <- function(starshape){
     n <- starshape_ntab[match(starshape,names(starshape_ntab))]
     return(unname(n))
 }
 
 # index of starshape = aspect ratio (ar) 
-starshape_artab <- c(rep(1, 9), 0.5, 1, 0.5, rep(1,12),0.5, 0.18, 1, 1, 1, 1)
-names(starshape_artab) <- seq_len(30)
+starshape_artab <- c(rep(1, 9), 0.5, 1, 0.5, rep(1,12),0.5, 0.18, 1, 1, 1, 1,1)
+names(starshape_artab) <- seq_len(31)
 
 match_ar <- function(starshape){
     ar <- starshape_artab[match(starshape,names(starshape_artab))]
@@ -141,7 +141,11 @@ build_polygenxy_id.lengths <- function(starshape, phase){
         plxy <- 0.58 * data.frame(x=c(-1,-1.6, 1.6, 1),
                                  y=c(1, -1, -1, 1))
         plxy <- as.matrix(plxy)
-    }else{
+    }else if (starshape==31){
+        plxy <- polygon_regular(n=n+1, phase=phase)
+        plxy <- plxy[1:(nrow(plxy)/2), ]
+    }
+    else{
         plxy <- 0.8*polygon_regular(n=n, phase=phase)
     }
     return (plxy)