rsquaredacademy / vistributions

@@ -19,3 +19,56 @@
Loading
19 19
  list(plot_data = plot_data, bm = bm, bsd = bsd)
20 20
21 21
}
22 +
23 +
bprob_data_prep <- function(n, p, s, method) {
24 +
25 +
  n   <- as.integer(n)
26 +
  s   <- as.integer(s)
27 +
  x   <- seq(0, n, 1)
28 +
  bm  <- round(n * p, 2)
29 +
  bsd <- round(sqrt((1 - p) * bm), 2)
30 +
31 +
  if (method == "lower") {
32 +
    k    <- round(pbinom(s, n, p), 3)
33 +
    cols <- ifelse(cumsum(round(dbinom(x, n, p), 3)) <= k, "#0000CD", "#6495ED")
34 +
  } else if (method == "upper") {
35 +
    k    <- round(1 - pbinom((s - 1), n, p), 3)
36 +
    cols <- ifelse(cumsum(round(dbinom(x, n, p), 3)) >= k, "#0000CD", "#6495ED")
37 +
  } else if (method == "exact") {
38 +
    k    <- pbinom(s, n, p) - pbinom((s - 1), n, p)
39 +
    cols <- ifelse(round(dbinom(x, n, p), 5) == round(k, 5), "#0000CD", "#6495ED")
40 +
  } else {
41 +
    k1   <- pbinom((s[1] - 1), n, p)
42 +
    k2   <- pbinom(s[2], n, p)
43 +
    k    <- pbinom(s[2], n, p) - pbinom((s[1] - 1), n, p)
44 +
    cols <- ifelse((round(cumsum(dbinom(x, n, p)), 6) > round(k1, 6) &
45 +
                      round(cumsum(dbinom(x, n, p)), 6) <= round(k2, 6)), "#0000CD", "#6495ED")
46 +
  }
47 +
48 +
  data      <- dbinom(x, n, p)
49 +
  plot_data <- data.frame(n = seq(0, n), df = data)
50 +
51 +
  list(plot_data = plot_data, bm = bm, bsd = bsd, k = k, cols = cols)
52 +
53 +
}
54 +
55 +
56 +
bperc_data_prep <- function(n, p, tp, method) {
57 +
58 +
  n      <- as.integer(n)
59 +
  x      <- seq(0, n, 1)
60 +
61 +
  if (method == "lower") {
62 +
    k    <- round(qbinom(tp, n, p), 3)
63 +
    cols <- ifelse(cumsum(dbinom(x, n, p)) <= pbinom(k, n, p), "#0000CD", "#6495ED")
64 +
  } else {
65 +
    k    <- round(qbinom(tp, n, p, lower.tail = F), 3)
66 +
    cols <- ifelse(cumsum(dbinom(x, n, p)) > pbinom((k + 1), n, p), "#0000CD", "#6495ED")
67 +
  }
68 +
69 +
  data      <- dbinom(x, n, p)
70 +
  plot_data <- data.frame(n = seq(0, n), df = data)
71 +
72 +
  list(plot_data = plot_data, k = k, cols = cols)
73 +
74 +
}

@@ -70,64 +70,15 @@
Loading
70 70
		stop("s must be less than or equal to n.", call. = FALSE)
71 71
	}
72 72
73 -
	n   <- as.integer(n)
74 -
	s   <- as.integer(s)
75 -
	x   <- seq(0, n, 1)
76 -
	bm  <- round(n * p, 2)
77 -
	bsd <- round(sqrt((1 - p) * bm), 2)
78 -
79 -
	if (method == "lower") {
80 -
		k    <- round(pbinom(s, n, p), 3)
81 -
		cols <- ifelse(cumsum(round(dbinom(x, n, p), 3)) <= k, "#0000CD", "#6495ED")
82 -
	} else if (method == "upper") {
83 -
		k    <- round(1 - pbinom((s - 1), n, p), 3)
84 -
		cols <- ifelse(cumsum(round(dbinom(x, n, p), 3)) >= k, "#0000CD", "#6495ED")
85 -
	} else if (method == "exact") {
86 -
		k    <- pbinom(s, n, p) - pbinom((s - 1), n, p)
87 -
		cols <- ifelse(round(dbinom(x, n, p), 5) == round(k, 5), "#0000CD", "#6495ED")
88 -
	} else {
89 -
		k1   <- pbinom((s[1] - 1), n, p)
90 -
		k2   <- pbinom(s[2], n, p)
91 -
		k    <- pbinom(s[2], n, p) - pbinom((s[1] - 1), n, p)
92 -
		cols <- ifelse((round(cumsum(dbinom(x, n, p)), 6) > round(k1, 6) &
93 -
											round(cumsum(dbinom(x, n, p)), 6) <= round(k2, 6)), "#0000CD", "#6495ED")
94 -
	}
73 +
	bprob_data <- bprob_data_prep(n, p, s, method)
74 +
	plot_base  <- bprob_plot_build(bprob_data, n)
75 +
	plot_final <- bprob_plot_modify(plot_base, method, n, p, s, bprob_data)
95 76
96 -
	data      <- dbinom(x, n, p)
97 -
	plot_data <- data.frame(n = seq(0, n), df = data)
98 -
99 -
	pp <-
100 -
		ggplot(plot_data) +
101 -
		geom_col(aes(x = n, y = df),
102 -
		         fill = cols) +
103 -
		ylab("Probability") +
104 -
		xlab(paste("No. of success\n", "Mean =", bm, ", Std. Dev. =", bsd)) +
105 -
		scale_x_continuous(breaks = seq(0, n)) +
106 -
		theme(plot.title    = element_text(hjust = 0.5),
107 -
		      plot.subtitle = element_text(hjust = 0.5))
108 -
109 -
	if (method == "lower") {
110 -
		pp +
111 -
			ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
112 -
			        subtitle = paste("P(X) <=", s, "=", round(k, 3)))
113 -
	} else if (method == "upper") {
114 -
		pp +
115 -
			ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
116 -
			        subtitle = paste("P(X) >=", s, "=", round(k, 3)))
117 -
	} else if (method == "exact") {
118 -
		pp +
119 -
			ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
120 -
			        subtitle = paste("P(X) =", s, "=", round(k, 3)))
121 -
	} else {
122 -
		pp +
123 -
			ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
124 -
			        subtitle = paste0("P(", s[1], " <= X <= ", s[2], ")", " = ", round(k, 3)))
125 -
	}
126 77
127 78
	if (print_plot) {
128 -
		print(pp)
79 +
		print(plot_final)
129 80
	} else {
130 -
		return(pp)
81 +
		return(plot_final)
131 82
	}
132 83
133 84
}
@@ -143,47 +94,16 @@
Loading
143 94
	check_range(p)
144 95
	check_range(tp, 0, 0.5, "tp")
145 96
146 -
	n      <- as.integer(n)
147 97
	method <- match.arg(type)
148 -
	x      <- seq(0, n, 1)
149 98
150 -
	if (method == "lower") {
151 -
		k    <- round(qbinom(tp, n, p), 3)
152 -
		cols <- ifelse(cumsum(dbinom(x, n, p)) <= pbinom(k, n, p), "#0000CD", "#6495ED")
153 -
	} else {
154 -
		k    <- round(qbinom(tp, n, p, lower.tail = F), 3)
155 -
		cols <- ifelse(cumsum(dbinom(x, n, p)) > pbinom((k + 1), n, p), "#0000CD", "#6495ED")
156 -
	}
99 +
	bperc_data <- bperc_data_prep(n, p, tp, method)
100 +
	plot_base  <- bperc_plot_build(bperc_data, n)
101 +
  plot_final <- bperc_plot_modify(plot_base, method, n, p, tp, bperc_data)
157 102
158 -
	data      <- dbinom(x, n, p)
159 -
	plot_data <- data.frame(n = seq(0, n), df = data)
160 -
161 -
	pp <-
162 -
		ggplot(plot_data) +
163 -
		geom_col(aes(x = n, y = df),
164 -
		         fill = cols) +
165 -
		ylab("Probability") +
166 -
	  xlab("No. of success") +
167 -
		scale_x_continuous(breaks = seq(0, n)) +
168 -
		theme(plot.title    = element_text(hjust = 0.5),
169 -
		      plot.subtitle = element_text(hjust = 0.5))
170 -
171 -
172 -
	if (method == "lower") {
173 -
		pp +
174 -
			ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
175 -
			        subtitle = paste0("P(X <= ", k, ") <= ", tp, ", but P(X <= ", (k + 1), ") > ", tp)
176 -
			        )
177 -
	} else {
178 -
		pp +
179 -
			ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
180 -
			        subtitle = paste0("P(X >= ", (k + 1), ") <= ", tp, ", but P(X >= ", k, ") > ", tp)
181 -
			        )
182 -
	}
183 103
184 104
	if (print_plot) {
185 -
		print(pp)
105 +
		print(plot_final)
186 106
	} else {
187 -
		return(pp)
107 +
		return(plot_final)
188 108
	}
189 109
}

@@ -24,3 +24,81 @@
Loading
24 24
  return(p)
25 25
26 26
}
27 +
28 +
bprob_plot_build <- function(data, n) {
29 +
30 +
  p <-
31 +
    ggplot(data$plot_data) +
32 +
    geom_col(aes(x = n, y = df),
33 +
             fill = data$cols) +
34 +
    ylab("Probability") +
35 +
    xlab(paste("No. of success\n", "Mean =", data$bm, ", Std. Dev. =", data$bsd)) +
36 +
    scale_x_continuous(breaks = seq(0, n)) +
37 +
    theme(plot.title    = element_text(hjust = 0.5),
38 +
          plot.subtitle = element_text(hjust = 0.5))
39 +
40 +
  return(p)
41 +
}
42 +
43 +
44 +
bprob_plot_modify <- function(plot, method, n, p, s, data) {
45 +
46 +
  if (method == "lower") {
47 +
    plot <-
48 +
      plot +
49 +
      ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
50 +
              subtitle = paste("P(X) <=", s, "=", round(data$k, 3)))
51 +
  } else if (method == "upper") {
52 +
    plot <-
53 +
      plot +
54 +
      ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
55 +
              subtitle = paste("P(X) >=", s, "=", round(data$k, 3)))
56 +
  } else if (method == "exact") {
57 +
    plot <-
58 +
      plot +
59 +
      ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
60 +
              subtitle = paste("P(X) =", s, "=", round(data$k, 3)))
61 +
  } else {
62 +
    plot <-
63 +
      plot +
64 +
      ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
65 +
              subtitle = paste0("P(", s[1], " <= X <= ", s[2], ")", " = ", round(data$k, 3)))
66 +
  }
67 +
68 +
  return(plot)
69 +
70 +
}
71 +
72 +
bperc_plot_build <- function(data, n) {
73 +
74 +
  pp <-
75 +
    ggplot(data$plot_data) +
76 +
    geom_col(aes(x = n, y = df),
77 +
             fill = data$cols) +
78 +
    ylab("Probability") +
79 +
    xlab("No. of success") +
80 +
    scale_x_continuous(breaks = seq(0, n)) +
81 +
    theme(plot.title    = element_text(hjust = 0.5),
82 +
          plot.subtitle = element_text(hjust = 0.5))
83 +
84 +
  return(pp)
85 +
}
86 +
87 +
bperc_plot_modify <- function(plot, method, n, p, tp, data) {
88 +
89 +
  if (method == "lower") {
90 +
    plot <-
91 +
      plot +
92 +
      ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
93 +
              subtitle = paste0("P(X <= ", data$k, ") <= ", tp, ", but P(X <= ", (data$k + 1), ") > ", tp)
94 +
      )
95 +
  } else {
96 +
    plot <-
97 +
      plot +
98 +
      ggtitle(label    = paste("Binomial Distribution: n =", n, ", p =", p),
99 +
              subtitle = paste0("P(X >= ", (data$k + 1), ") <= ", tp, ", but P(X >= ", data$k, ") > ", tp)
100 +
      )
101 +
  }
102 +
103 +
  return(plot)
104 +
}
Files Coverage
R 95.75%
Project Totals (10 files) 95.75%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 1%
9
        informational: true
10
    patch:
11
      default:
12
        target: auto
13
        threshold: 1%
14
        informational: true
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading