Skip to content

Instantly share code, notes, and snippets.

@calpolystat

calpolystat/#Longest_Run.txt

Last active April 7, 2019 13:21
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save calpolystat/eee9a9e00dd4ddd68614 to your computer and use it in GitHub Desktop.
Save calpolystat/eee9a9e00dd4ddd68614 to your computer and use it in GitHub Desktop.
Download ZIP
Longest Run of Heads or Tails: Shiny app at http://www.statistics.calpoly.edu/shiny
Raw
#Longest_Run.txt
Longest Run Shiny App
Base R code created by Jimmy Doi
Shiny app files created by Jimmy Doi
Cal Poly Statistics Dept Shiny Series
http://statistics.calpoly.edu/shiny
Raw
Coin_Flips_Runs.R
##################################################
# R code written by: #
# #
# Jimmy A. Doi (jdoi@calpoly.edu) #
# Department of Statistics #
# Cal Poly State Univ, San Luis Obispo #
# Web: www.calpoly.edu/~jdoi #
# #
# ............................................ #
# #
# Shiny app site: #
# calpolystat.shinyapps.io/LongRun #
# ............................................ #
# #
# Code updated on: 3SEP2014 #
##################################################
flip.gen <- function(trials,prob){
# Generate random uniform variates
flips <-runif(trials)
# COINS will have Heads (1) or Tails (0)
coins <- seq(1:length(flips))
for (i in 1:length(flips)){
if (flips[i]<=prob) coins[i] = 1
else coins[i] = 0
}
coords <- matrix(NA,ncol=3,nrow=(length(coins)))
colnames(coords) <- c("coin","segment","run")
coords[,1]<-coins
# SEGMENT will be an ID number attached to each run
segment <- 1
coords[1,2] <- 1 # automatic start at 1 for first row
for (i in 2:length(coins)){
coin1 <- coords[i-1,1]
coin2 <- coords[i,1]
if (coin1 == coin2) coords[i,2] <- segment
if (coin1 != coin2) {
segment <- segment +1
coords[i,2] <- segment}
}
# MY.RUNS will determine the observed frequency of
# each SEGMENT value [using table()], thereby
# determining the exact run length for each run.
my.runs <- table(coords[,2])
# In the following loop, for each unique value of
# SEGMENT, the corresponding run length will be assigned
for (i in 1:length(my.runs)){
coords[coords[,2]==i,3]<-my.runs[i]
}
return(coords)
}
###############################################################################
plot.flips <- function(run.min,coords,my.cex,sub.flag){
# run.min = Specified minimum run length to color
# coords = Returned matrix from call to FLIP.GEN()
# my.cex = Specified font size
# sub.flag = Indicator of whether to include subtitle MY.SUB
if(missing(sub.flag)) sub.flag <- 0
if(missing(my.cex)) my.cex <- 2
my.cex <- seq(1,2.5,,10)[my.cex]
# Determine the observed maximum run length
max.run <- max(coords[,3])
my.title <- paste("n = ", nrow(coords), ", Longest run = ",max.run,
"\n Marked runs of at least ",run.min,sep="")
my.sub <- " "
n <- nrow(coords)
# Subtitle to include point and interval estimates
if (sub.flag==1){
# The point and interval estimates for the approximate length
# of the longest run are stored in PRED_ESTIMATES.TXT and were
# provided by M. Schilling (see references).
#
# The file contains 4 columns corresponding to sample size,
# predicted approximate length of longest run, and the lower/upper
# limits for the 95% prediction interval.
pred.est <- read.table("pred_estimates.txt", header=F)
sel.row <- pred.est[(pred.est[,1]==n),]
my.sub <- paste("Predicted approximate longest run = ",
sel.row[2],
"\n Appx. 95% prediction interval for longest run = [",#
sel.row[3],",",sel.row[4],"]",sep="")
}
# Trim white space around plot [default is mar=c(4.1,4.1,4.1,4.1)]
# By trimming, this allows a better view of plot
par(mar=c(3,.5,3,.5)+0.1)
# Plot will use rows of a maximum of 25 outcomes per row
plot(1,1,xlim=c(0,25+1),ylim=c(0,ceiling(nrow(coords)/25)+1),col=0,
yaxt="n",xaxt="n",xlab="",ylab="",main=my.title)
mtext(my.sub,1,2,cex=1.2)
# X will be the horizontal Cartesian coordinate of coin flip
# [Range of X will be 1, 2, ..., 25]
# Y will be the vertical Cartesian coordinate of coin flip
# [Range of Y will be 1, 2, ..., ceiling(TRIALS/25)]
i <- seq(1,nrow(coords))
x <- i %% 25
x[which(x==0)]<-25
y <- ceiling(nrow(coords)/25) - ceiling(i/25) + 1
coords <- cbind(coords,x,y)
# Plot the outcome of each coin flip:
# Use color for any outcome belonging to
# a run whose length is at least RUN.MIN
for (i in 1:nrow(coords)){
my.coin <- coords[i,1]
if (my.coin==1) {
if (coords[i,3]>=run.min) text(coords[i,4],coords[i,5],"H",
col="red",font=2,cex=my.cex)
else text(coords[i,4],coords[i,5],"H",cex=my.cex)}
if (my.coin==0) {
if (coords[i,3]>=run.min) text(coords[i,4],coords[i,5],"T",
col="deepskyblue",font=2,cex=my.cex)
else text(coords[i,4],coords[i,5],"T",cex=my.cex)}
}
}
Raw
DESCRIPTION
Title: Longest Run of Heads or Tails
Author: Jimmy Doi
AuthorUrl: http://www.calpoly.edu/~jdoi
License: MIT
DisplayMode: Normal
Tags: Longest Run of Heads or Tails
Type: Shiny
Raw
LICENSE
The MIT License (MIT)
Copyright (c) 2015 Jimmy Doi
Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.
Raw
pred_estimates.txt
10 4 2 6
11 4 2 6
12 4 2 7
13 4 2 7
14 4 2 7
15 4 2 7
16 4 2 7
17 4 2 7
18 5 2 7
19 5 3 8
20 5 3 8
21 5 3 8
22 5 3 8
23 5 3 8
24 5 3 8
25 5 3 8
26 5 3 8
27 5 3 8
28 5 3 8
29 5 3 8
30 5 3 8
31 5 3 8
32 5 3 8
33 5 3 9
34 5 3 9
35 5 3 9
36 6 3 9
37 6 3 9
38 6 3 9
39 6 3 9
40 6 3 9
41 6 3 9
42 6 3 9
43 6 3 9
44 6 3 9
45 6 3 9
46 6 3 9
47 6 3 9
48 6 3 9
49 6 3 9
50 6 4 10
51 6 4 10
52 6 4 10
53 6 4 10
54 6 4 10
55 6 4 10
56 6 4 10
57 6 4 10
58 6 4 10
59 6 4 10
60 6 4 10
61 6 4 10
62 6 4 10
63 6 4 10
64 6 4 10
65 6 4 10
66 6 4 10
67 6 4 10
68 6 4 10
69 6 4 10
70 6 4 10
71 6 4 10
72 7 4 10
73 7 4 10
74 7 4 10
75 7 4 10
76 7 4 10
77 7 4 10
78 7 4 10
79 7 4 10
80 7 4 10
81 7 4 10
82 7 4 10
83 7 4 10
84 7 4 10
85 7 4 10
86 7 4 10
87 7 4 10
88 7 4 10
89 7 4 10
90 7 4 10
91 7 4 10
92 7 4 10
93 7 4 10
94 7 4 10
95 7 4 10
96 7 4 10
97 7 4 10
98 7 4 10
99 7 4 10
100 7 4 10
101 7 4 10
102 7 4 10
103 7 4 10
104 7 4 10
105 7 4 10
106 7 5 11
107 7 5 11
108 7 5 11
109 7 5 11
110 7 5 11
111 7 5 11
112 7 5 11
113 7 5 11
114 7 5 11
115 7 5 11
116 7 5 11
117 7 5 11
118 7 5 11
119 7 5 11
120 7 5 11
121 7 5 11
122 7 5 11
123 7 5 11
124 7 5 11
125 7 5 11
126 7 5 11
127 7 5 11
128 7 5 11
129 7 5 11
130 7 5 11
131 7 5 11
132 7 5 11
133 7 5 11
134 7 5 11
135 7 5 11
136 7 5 11
137 7 5 11
138 7 5 11
139 7 5 11
140 7 5 11
141 7 5 11
142 7 5 11
143 7 5 11
144 8 5 11
145 8 5 11
146 8 5 11
147 8 5 11
148 8 5 11
149 8 5 11
150 8 5 11
151 8 5 11
152 8 5 11
153 8 5 11
154 8 5 11
155 8 5 11
156 8 5 11
157 8 5 11
158 8 5 11
159 8 5 11
160 8 5 11
161 8 5 11
162 8 5 11
163 8 5 11
164 8 5 11
165 8 5 11
166 8 5 11
167 8 5 11
168 8 5 11
169 8 5 11
170 8 5 11
171 8 5 11
172 8 5 11
173 8 5 11
174 8 5 11
175 8 5 11
176 8 5 11
177 8 5 11
178 8 5 11
179 8 5 11
180 8 5 11
181 8 5 11
182 8 5 11
183 8 5 11
184 8 5 11
185 8 5 11
186 8 5 11
187 8 5 11
188 8 5 11
189 8 5 11
190 8 5 11
191 8 5 11
192 8 5 11
193 8 5 11
194 8 5 11
195 8 5 11
196 8 5 11
197 8 5 11
198 8 5 11
199 8 5 11
200 8 5 11
201 8 5 11
202 8 5 11
203 8 5 11
204 8 5 11
205 8 5 11
206 8 5 11
207 8 5 11
208 8 5 11
209 8 5 11
210 8 5 11
211 8 5 11
212 8 5 11
213 8 5 11
214 8 5 11
215 8 5 11
216 8 5 11
217 8 5 11
218 8 5 11
219 8 6 12
220 8 6 12
221 8 6 12
222 8 6 12
223 8 6 12
224 8 6 12
225 8 6 12
226 8 6 12
227 8 6 12
228 8 6 12
229 8 6 12
230 8 6 12
231 8 6 12
232 8 6 12
233 8 6 12
234 8 6 12
235 8 6 12
236 8 6 12
237 8 6 12
238 8 6 12
239 8 6 12
240 8 6 12
241 8 6 12
242 8 6 12
243 8 6 12
244 8 6 12
245 8 6 12
246 8 6 12
247 8 6 12
248 8 6 12
249 8 6 12
250 8 6 12
251 8 6 12
252 8 6 12
253 8 6 12
254 8 6 12
255 8 6 12
256 8 6 12
257 8 6 12
258 8 6 12
259 8 6 12
260 8 6 12
261 8 6 12
262 8 6 12
263 8 6 12
264 8 6 12
265 8 6 12
266 8 6 12
267 8 6 12
268 8 6 12
269 8 6 12
270 8 6 12
271 8 6 12
272 8 6 12
273 8 6 12
274 8 6 12
275 8 6 12
276 8 6 12
277 8 6 12
278 8 6 12
279 8 6 12
280 8 6 12
281 8 6 12
282 8 6 12
283 8 6 12
284 8 6 12
285 8 6 12
286 8 6 12
287 8 6 12
288 9 6 12
289 9 6 12
290 9 6 12
291 9 6 12
292 9 6 12
293 9 6 12
294 9 6 12
295 9 6 12
296 9 6 12
297 9 6 12
298 9 6 12
299 9 6 12
300 9 6 12
301 9 6 12
302 9 6 12
303 9 6 12
304 9 6 12
305 9 6 12
306 9 6 12
307 9 6 12
308 9 6 12
309 9 6 12
310 9 6 12
311 9 6 12
312 9 6 12
313 9 6 12
314 9 6 12
315 9 6 12
316 9 6 12
317 9 6 12
318 9 6 12
319 9 6 12
320 9 6 12
321 9 6 12
322 9 6 12
323 9 6 12
324 9 6 12
325 9 6 12
326 9 6 12
327 9 6 12
328 9 6 12
329 9 6 12
330 9 6 12
331 9 6 12
332 9 6 12
333 9 6 12
334 9 6 12
335 9 6 12
336 9 6 12
337 9 6 12
338 9 6 12
339 9 6 12
340 9 6 12
341 9 6 12
342 9 6 12
343 9 6 12
344 9 6 12
345 9 6 12
346 9 6 12
347 9 6 12
348 9 6 12
349 9 6 12
350 9 6 12
351 9 6 12
352 9 6 12
353 9 6 12
354 9 6 12
355 9 6 12
356 9 6 12
357 9 6 12
358 9 6 12
359 9 6 12
360 9 6 12
361 9 6 12
362 9 6 12
363 9 6 12
364 9 6 12
365 9 6 12
366 9 6 12
367 9 6 12
368 9 6 12
369 9 6 12
370 9 6 12
371 9 6 12
372 9 6 12
373 9 6 12
374 9 6 12
375 9 6 12
376 9 6 12
377 9 6 12
378 9 6 12
379 9 6 12
380 9 6 12
381 9 6 12
382 9 6 12
383 9 6 12
384 9 6 12
385 9 6 12
386 9 6 12
387 9 6 12
388 9 6 12
389 9 6 12
390 9 6 12
391 9 6 12
392 9 6 12
393 9 6 12
394 9 6 12
395 9 6 12
396 9 6 12
397 9 6 12
398 9 6 12
399 9 6 12
400 9 6 12
Raw
server.r
# --------------------------
# App Title: Longest Run
# Author: Jimmy Doi
# --------------------------
library(shiny)
source("Coin_Flips_Runs.R")
options(shiny.error=browser)
shinyServer(function(input, output) {
dataInput <- reactive({
flip.gen(input$trials*(input$save>-1),input$H.prob)
})
# Fill in the spot we created for a plot
output$coinPlot <- renderPlot({
plot.flips(input$minrun,dataInput(),input$my.cex,input$checkbox)
####################################################################
})
})
Raw
ui.r
# --------------------------
# App Title: Longest Run
# Author: Jimmy Doi
# --------------------------
library(shiny)
# Define the overall UI
shinyUI(
# Use a fluid Bootstrap layout
fluidPage(
tags$head(tags$link(rel = "icon", type = "image/x-icon", href =
"https://webresource.its.calpoly.edu/cpwebtemplate/5.0.1/common/images_html/favicon.ico")),
# Give the page a title
tags$title("Longest Run of Heads or Tails"),
titlePanel("Longest Run of Heads or Tails"),
div("Note: Please adjust width of browser if only one column is visible.",
style = "font-size: 9pt;color:teal"),br(),
# Generate a row with a sidebar
sidebarLayout(
# Define the sidebar with one input
sidebarPanel(
sliderInput("trials",
label = h5(HTML((paste0("Number of trials (", em("n"),"):")))),
min = 10, max = 400, value = 200, step=10),br(),
sliderInput("minrun",
label = h5("Mark run lengths of at least ..."),
min = 2, max = 15, value = 5, step=1),
div("Change of specified run length will impact marked runs in current plot", style = "font-size: 9.5pt;color:teal",align="right"),br(),
sliderInput("my.cex",
label = h5("Font size:"),
min = 1, max = 10, value = 4, step=1
),br(),
checkboxInput("checkbox", label = "Include predicted longest run and
prediction interval", value = TRUE),
checkboxInput("showProp", label = "Modify probability of heads", FALSE),
conditionalPanel(condition="input.showProp",
sliderInput("H.prob", label=NULL,
#label = h5("Probability of Heads"),
min = .01, max = .99, value = .5, step=.01)
)#end conditionalPanel
,
div(actionButton("save", label="Generate"),align="right"),
div("Click", tags$b("Generate")," to re-randomize outcomes based on current number of trials", style = "font-size: 9.5pt;color:teal",align="right"),br(),
br(),
div("Shiny app by",
a(href="http://statweb.calpoly.edu/jdoi/",target="_blank",
"Jimmy Doi"),align="right", style = "font-size: 8pt"),
div("Base R code by",
a(href="http://statweb.calpoly.edu/jdoi/",target="_blank",
"Jimmy Doi"),align="right", style = "font-size: 8pt"),
div("Shiny source files:",
a(href="https://gist.github.com/calpolystat/eee9a9e00dd4ddd68614",
target="_blank","GitHub Gist"),align="right", style = "font-size: 8pt"),
div(a(href="http://www.statistics.calpoly.edu/shiny",target="_blank",
"Cal Poly Statistics Dept Shiny Series"),align="right", style = "font-size: 8pt")
),
# Create a spot for the barplot
mainPanel(
plotOutput("coinPlot", width="100%"), HTML("<hr style='height: 2px; color: #de7008;
background-color: #df7109; border: none;'>"),
p("If a fair coin is flipped 100 times and a streak of 7 heads (or tails) in a row is
observed, is that an unusual result? To answer this we can simulate tosses of a fair
coin and keep track of runs of heads or tails.",style="margin-top:-10px"),
p("This Shiny app allows you to simulate the outcomes of a coin flipped",
HTML(paste(em("n"),sep="")), "times. You can specify the probability of heads
(default is 50%). Any runs of at least the length you specify will
be marked in color, and the length of the longest run will be given. You may also choose
to display the predicted approximate length of the longest run and an approximate 95%
prediction interval for the length of the longest run. Details on these two estimators
can be found in the first reference below.") ,
p("More information on the length of the longest run can be found in the following journal
articles:"),
div("Schilling, M. 'The Longest Run of Heads'",
em("The College Mathematics Journal"),", 21(3), 196--207", style="padding-left: 20px;
display:block; border-left: 5px solid #faebbc;margin-left:0px"),
div("Schilling, M. 'The Surprising Predictability of Long Runs'",
em("Mathematics Magazine"),", 85(2), 141--149", style="padding-left: 20px; display:block;
border-left: 5px solid #faebbc;margin-left:0px")
)
)
)
)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment