autotests/folding/highlight.R.fold

0001 ## R Script Sample File
0002 ## Source: http://www.rexamples.com
0003
0004 ## Basics
0005 a <- 42.24
0006 a <- 42i
0007 a <- 42L
0008 a <- 42
0009 A <- a * 2  # R is case sensitive
0010 print(a)
0011 cat(A, "\n") # "84" is concatenated with "\n"
0012 if(A>a) # true, 84 > 42
0013 <beginfold id='1'>{</beginfold id='1'>
0014   cat(A, ">", a, "\n")
0015 <endfold id='1'>}</endfold id='1'>
0016
0017 ## Functions
0018 Square <- function(x) <beginfold id='1'>{</beginfold id='1'>
0019   return(x^2)
0020 <endfold id='1'>}</endfold id='1'>
0021
0022 print(Square(4))
0023 print(Square(x=4)) # same thing
0024
0025 DoSomething(color="red",number=55)
0026
0027 ## Countdown
0028 countdown <- function(from)
0029 <beginfold id='1'>{</beginfold id='1'>
0030   print(from)
0031   while(from!=0)
0032   <beginfold id='1'>{</beginfold id='1'>
0033     Sys.sleep(1)
0034     from <- from - 1
0035     print(from)
0036   <endfold id='1'>}</endfold id='1'>
0037 <endfold id='1'>}</endfold id='1'>
0038
0039 countdown(5)
0040
0041 ## Reading user input
0042 readinteger <- function()
0043 <beginfold id='1'>{</beginfold id='1'>
0044   n <- readline(prompt="Enter an integer: ")
0045   n <- as.integer(n)
0046   if (is.na(n))<beginfold id='1'>{</beginfold id='1'>
0047     n <- readinteger()
0048   <endfold id='1'>}</endfold id='1'>
0049   return(n)
0050 <endfold id='1'>}</endfold id='1'>
0051 print(readinteger())
0052
0053 readinteger <- function()
0054 <beginfold id='1'>{</beginfold id='1'>
0055   n <- readline(prompt="Enter an integer: ")
0056   if(!grepl("^[0-9]+$",n))
0057   <beginfold id='1'>{</beginfold id='1'>
0058     return(readinteger())
0059   <endfold id='1'>}</endfold id='1'>
0060
0061   return(as.integer(n))
0062 <endfold id='1'>}</endfold id='1'>
0063 print(readinteger())
0064
0065 ## Guess a random number game
0066 readinteger <- function()
0067 <beginfold id='1'>{</beginfold id='1'>
0068   n <- readline(prompt="Enter an integer: ")
0069   if(!grepl("^[0-9]+$",n))
0070   <beginfold id='1'>{</beginfold id='1'>
0071     return(readinteger())
0072   <endfold id='1'>}</endfold id='1'>
0073   return(as.integer(n))
0074 <endfold id='1'>}</endfold id='1'>
0075
0076 # real program start here
0077
0078 num <- round(runif(1) * 100, digits = 0)
0079 guess <- -1
0080
0081 cat("Guess a number between 0 and 100.\n")
0082
0083 while(guess != num)
0084 <beginfold id='1'>{</beginfold id='1'>
0085   guess <- readinteger()
0086   if (guess == num)
0087   <beginfold id='1'>{</beginfold id='1'>
0088     cat("Congratulations,", num, "is right.\n")
0089   <endfold id='1'>}</endfold id='1'>
0090   else if (guess < num)
0091   <beginfold id='1'>{</beginfold id='1'>
0092     cat("It's bigger!\n")
0093   <endfold id='1'>}</endfold id='1'>
0094   else if(guess > num)
0095   <beginfold id='1'>{</beginfold id='1'>
0096     cat("It's smaller!\n")
0097   <endfold id='1'>}</endfold id='1'>
0098 <endfold id='1'>}</endfold id='1'>
0099
0100 ## Lists
0101 sum(0:9)
0102 append(LETTERS[1:13],letters[14:26])
0103 c(1,6,4,9)*2
0104 something <- c(1,4,letters[2])  # indices start at one, you get (1,4,"b")
0105 length(something)
0106
0107 ## margrittr's pipe
0108 diamonds %>%
0109   filter(price > 1000) %>%
0110   group_by(cut) %>%
0111   tally() %>%
0112   rename(tally = n) %>%
0113   arrange(-tally) %>%
0114   mutate(pct = tally / sum(tally)) -> df
0115
0116 ## R native pipes (R > 4.1)
0117 Sys.setenv("_R_USE_PIPEBIND_"= TRUE)
0118 mtcars |> x => lm(mpg ~ cyl, data = x)
0119
0120 ## ggplot2
0121 plot = ggplot(diamonds, aes(x = price, y = carat)) +
0122   geom_point(alpha = 0.3, colour = 'steelblue') +
0123   labs(
0124     title = "ggplot diamonds",
0125     x = "Price, $",
0126     y = "Carat"
0127   ) +
0128   facet_wrap(~ cut) +
0129   theme_minimal()
0130
0131 plot + coord_flip()