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