Everything you never wanted to know about the R vulnerability ...but shouldn't be afraid to ask

 

Everything you never wanted to know about the R vulnerability

...but shouldn't be afraid to ask

https://aitap.github.io/2024/05/02/unserialize.html

R-bitrary Code Execution: Vulnerability in R’s Deserialization

  R-bitrary Code Execution: Vulnerability in R’s Deserialization

https://hiddenlayer.com/innovation-hub/r-bitrary-code-execution/

R table return integer as chr

 

re-install R and Rstudio to remove segfaulty memory not mapped error.

tried reinstall R and packages

https://stackoverflow.com/questions/49190251/caught-segfault-memory-not-mapped-error-in-r

gganimate and ffmpeg

=> Try to install gganimate in CoLab, it is unavailable. 

=> try in RStudio, 

File access error: 

Warning: file_renderer failed to copy frames to the destination directory  

file_renderer(dir = ".", prefix = "gganim_plot", overwrite = FALSE)

The frame sources:

/var/folders/bw/k6_tkc2142v1wh5r_1yhkqhc0000gp/T//RtmpIopU0P/1eec3399c50d/gganim_plot0001.png

I tried to change file permission in Finder, but my username is not allowed. 

The following codes worked: 

file_renderer(dir = "/Users/hqin/github/R-animation-sandbox/tmp/", prefix = "gganim_plot", overwrite = TRUE)
anim <- p + transition_time(year) +
  labs(title = "Year: {frame_time}")
gganimate::animate( anim, renderer=ffmpeg_renderer())

I tested and found out that I have ffmpeg installed. 

Reference: 

https://community.rstudio.com/t/warning-message-file-renderer-failed-to-copy-frames-to-the-destination-directory/45261/13

https://ottverse.com/create-video-from-images-using-ffmpeg/

ggplot overlay, joy plots

 

https://github.com/zonination/perceptions

simulated correlated random values in R

 

The rnorm_multi() function makes multiple normally distributed vectors with specified parameters and relationships.

https://cran.r-project.org/web/packages/faux/vignettes/rnorm_multi.html

R heatmap references

 

https://jokergoo.github.io/ComplexHeatmap-reference/book/index.html 

https://jokergoo.github.io/ComplexHeatmap-reference/book/a-single-heatmap.html#colors

Apple R job

 

Tweetable mathematical art with R

 

https://fronkonstin.com/2018/09/06/tweetable-mathematical-art-with-r/

Ready4R

 

Ready 4 R

https://ready4r.netlify.app/schedule/

tryCatch example in R

 

   tryCatch( info <- getMeta(lat = metaTb$Lat[i], lon = metaTb$Long_[i], plot=FALSE),   

       error=function(e)  {

         print( paste( "*** tryCaught error:", metaTb[i, ]) )

       } 

    )

    print(i)

ts conda create condaR403

 # Hong will install anaconda R403 in a conda environment on ts117. This strategy worked. 

conda create --name condaR403

  environment location: /home/hqin/.conda/envs/condaR403

-bash-4.2$ conda activate condaR403

conda install -c r r-base #??

# which R shows an R403 inside an conda environment. 

R

install.packages('tidyverse') #this seems worked. 

install.packages('EpiNow2')  #this run for a while

non-zero exit again due to V8. 

(condaR403) -bash-4.2$ conda install -c conda-forge libv8

$ conda install -c conda-forge r-randomcolor

R

install.packages('EpiNow2') #this worked!!!!

> library(EpiNow2)

> 

module load sge

qsub epinow2.pbs #this runs!!!!

(condaR403) -bash-4.2$ cat epinow2.pbs

#!/bin/bash -l

#$ -S /bin/bash

#$ -N epinow_job

#$ -V

#$ -cwd

. /etc/profile.d/modules.sh

module load anaconda/5.2.0

source activate condaR403

R -f batch_Rt_by_county.R --args 900 901 1 4/1/2020 5/1/2020

ts conda tsR403, tidyverse, EpiNow2 installation

# THIS DID NOT WORK

-bash-4.2$ module load anaconda/5.2.0 

-bash-4.2$ conda create --name tsR403

Collecting package metadata: done

Solving environment: done

## Package Plan ##

  environment location: /home/hqin/.conda/envs/tsR403

Proceed ([y]/n)? y  

Preparing transaction: done

Verifying transaction: done

Executing transaction: done

#

# To activate this environment, use

#

#     $ conda activate tsR403

#

# To deactivate an active environment, use

#

#     $ conda deactivate

-bash-4.2$ 

 -bash-4.2$ conda activate tsR403

(tsR403) -bash-4.2$ conda install -c conda-forge libv8

Collecting package metadata: done

Hong then run R

install.packages('tidyverse') #this seem to worked. 

-----------------------------[ ANTICONF ]-------------------------------

Configuration failed to find the libv8 engine library. Try installing:

 * deb: libv8-dev or libnode-dev (Debian / Ubuntu)

 * rpm: v8-devel (Fedora, EPEL)

 * brew: v8 (OSX)

 * csw: libv8_dev (Solaris)

To use a custom libv8, set INCLUDE_DIR and LIB_DIR manually via:

R CMD INSTALL --configure-vars='INCLUDE_DIR=... LIB_DIR=...'

---------------------------[ ERROR MESSAGE ]----------------------------

<stdin>:1:16: fatal error: v8.h: No such file or directory

compilation terminated.

-------------------------------------------------------

(tsR403) -bash-4.2$ conda install -c conda-forge r-randomcolor

Collecting package metadata: \ 

#this install many packages

Ref: https://github.com/iaconogi/bigSCale2/issues/19

I then tried:

R: install.packages('EpiNow2') #this seems to be running now. 

library(EpiNow2) #it worked!

install.packages('woldmet')

#The entire install seem to take almost 2 hours. 

Checked a few hour later, EpiNow2 installation did not work. 

Ubuntu 18.04 LTS apt get install R4.0.3

 

see: 

https://askubuntu.com/questions/1237102/problem-installing-r-4-0-on-ubuntu-18-04

 sudo apt remove r-base

 sudo apt-key adv --keyserver keyserver.ubuntu.com --recv-keys E298A3A825C0D65DFD57CBB651716619E084DAB9

sudo add-apt-repository 'deb https://cloud.r-project.org/bin/linux/ubuntu bionic-cran40/'

sudo apt update

sudo apt install r-base

EpiNow2 package

https://github.com/epiforecasts/EpiNow2 https://epiforecasts.io/EpiNow2/reference/estimate_infections.html#examples https://github.com/epiforecasts/covid-rt-estimates

These worked

reporting_delay <- bootstrapped_dist_fit(rlnorm(100, log(4), 1), max_value = 30)

generation_time <- get_generation_time(disease = "SARS-CoV-2", source = "ganyani")

incubation_period <- get_incubation_period(disease = "SARS-CoV-2", source = "lauer")

estimates <- epinow(reported_cases = local_cases, samples=100, output='samples',

                    generation_time = generation_time,

                    delays = list(incubation_period, reporting_delay))

localRtTb = estimates$estimates$summarised[ estimates$estimates$summarised$variable=='R' , ]

It seems the default setting is recommended. 

# Note: all examples below have been tuned to reduce the runtimes of examples # these settings are not suggesed for real world use. # run model with default setting

It seems that by default, Rt varies. 

# run model with stationary Rt assumption (likely to provide biased real-time estimates) stat <- estimate_infections(reported_cases, generation_time = generation_time, delays = list(incubation_period, reporting_delay), stan_args = list(warmup = 200, cores = ifelse(interactive(), 4, 1), control = list(adapt_delta = 0.9)), stationary = TRUE)

tidyverse, ggplot, FAQ

 

# Count the number of full duplicates

sum(duplicated(bike_share_rides))

# Remove duplicates

bike_share_rides_unique <- distinct(bike_share_rides)

# Count the full duplicates in bike_share_rides_unique

sum(duplicated(bike_share_rides_unique))

# Find duplicated ride_ids

bike_share_rides %>% 

  count(ride_id) %>% 

  filter(n > 1)

# Remove full and partial duplicates

bike_share_rides_unique <- bike_share_rides %>%

  # Only based on ride_id instead of all cols

  distinct(ride_id, .keep_all = TRUE)

bike_share_rides %>%

  # Group by ride_id and date

  group_by(ride_id, date) %>%

  # Add duration_min_avg column

  mutate(duration_min_avg = mean(duration_min)) %>%

  # Remove duplicates based on ride_id and date, keep all cols

  distinct(ride_id, date, .keep_all = TRUE) %>%

  # Remove duration_min column

  select(-duration_min)

# Find bad dest_size rows

sfo_survey %>% 

  # Join with dest_sizes data frame to get bad dest_size rows

  anti_join(dest_sizes, by = "dest_size") %>%

  # Select id, airline, destination, and dest_size cols

  select(id, airline, destination, dest_size)

# Add new columns to sfo_survey

sfo_survey <- sfo_survey %>%

  # dest_size_trimmed: dest_size without whitespace

  mutate(dest_size_trimmed = str_trim(dest_size),

         # cleanliness_lower: cleanliness converted to lowercase

         cleanliness_lower = str_to_lower(cleanliness))

# Count values of dest_size_trimmed

sfo_survey %>%

  count(dest_size_trimmed)

# Count values of cleanliness_lower

sfo_survey %>%

  count(cleanliness_lower)

# Count categories of dest_region

sfo_survey %>%

  count(dest_region)

# Categories to map to Europe

europe_categories <- c("EU", "eur", "Europ")

# Add a new col dest_region_collapsed

sfo_survey %>%

  # Map all categories in europe_categories to Europe

  mutate(dest_region_collapsed = fct_collapse(dest_region, 

                                              Europe = europe_categories)) %>%

  # Count categories of dest_region_collapsed

  count(dest_region_collapsed)

sfo_survey %>%

  filter(str_detect(phone, "-"))

glm formula -1

from datacamp, glm course

Second, fit a model that estimates the effect (or intercept) of both players. This formula option in R requires a - 1, for example formula = response ~ intercept - 1.

tidyverse

data carpentry, tidyverse

https://datacarpentry.org/R-ecology-lesson/03-dplyr.html

*** useful R, Rstudio tips, update

Useful R tips, 20181227 update

timestamp = format(Sys.Date(), "%Y%m%d")
write.csv(dangtb, paste("DangProteo_MS02Zscore_summary_",timestamp, ".csv",sep='' ), quote =T, row.names = F  )

title: "yeast PIN, rls ratio - CR prot"
author: "H Qin"
date: '`r paste( "2018-12-21 ~ ",format(Sys.Date(), "%Y-%B-%d"))`'
output:
  pdf_document: default
  html_document: default

Read csv is much faster than xlsx.

tb = read.csv(fullFileName, colClasses=c("character",NA, NA, "character", rep("numeric",8 ), NA));
tb = read.table("gene_association.sgd", skip=25, sep="\t", stringsAsFactors=FALSE, quote = "", row.names = NULL)



for( mymethod in mymethods ) {
 hd =  hclust( dist(ctb2), mymethod); 
 # plot( hd, main="hamming distance, ward linkage" )
 coat.cat = cutree(hd, numclus )  ###<=== change is here
 col.palette = c("red","brown","blue","green");
 coat.color = col.palette[coat.cat]

 library(RColorBrewer);
 #hmcol = colorRampPalette(brewer.pal(10,"RdBu"))(256);
 hmcol = colorRampPalette(brewer.pal(5,"RdBu"))(16);

 #heatmap( ctb2, col=hmcol, scale="none", margins = c(5,10) );
 heatmap( ctb2, col=hmcol, scale="none", margins = c(5,10), 
 RowSideColors=coat.color, ColSideColors = spec.colors,
 hclustfun = function(c) hclust( c, method=mymethod),
 #distfun = function(c) as.dist(hamming.distance(c)) #Hamming is less pleasant than Euclidean 
 main = mymethod
 );
}



options(echo=TRUE) # if you want see commands in output file
args <- commandArgs(trailingOnly = TRUE)print(args)
# trailingOnly=TRUE means that only your arguments are returned, check:
# print(commandsArgs(trailingOnly=FALSE))i = as.integer(args[1])
j = as.integer(args[2])
x = seq(i, j)
print(x)

R -f R-args.R --args 2 5
Rscript file 

#from lower case to upper case

chartr(old, new, x)

tolower(x)

toupper(x)

casefold(x, upper = FALSE)

    require(stringr)
    conditions$media[r] = str_replace( conditions$media[r], "\\/", "")


tb$AssignmentTotal= apply(tb[, assignments], 1, FUN=function(x){sum(x,na.rm=T)} )

http://cran.r-project.org/doc/FAQ/R-FAQ.html#How-can-I-create-rotated-axis-labels_003f

cumsum()
with()

R -f filename

axis( 2, at=pretty(tbf$s), tcl=0.2, las=2 )  #rotate axis labels

text( tb$G + 0.01*nchar(tb$strain)/4, log10(tb$R0)-0.1*nchar(tb$strain)/4, tb$strain, pos=3)

layout(mat, heights= c( 1.15, rep(1, nrow(mat)-2), 1.2) );
par(mar=c(5.1,4.1,4.1,2.1)
http://www.r-bloggers.com/setting-graph-margins-in-r-using-the-par-function-and-lots-of-cow-milk/

 text ( aa, bb, t, cex=0.8);

####aplha
names(fit)[ grep("alpha", names(fit))]
fit_alpha_tb = data.frame( t( fit[, grep("alpha", names(fit)) ]))
rownames(fit_alpha_tb) = names(fit)[grep("alpha", names(fit))]
fit_alpha_tb$names = gsub("_.*", "", rownames(fit_alpha_tb))

library(RColorBrewer);
#hmcol = colorRampPalette(brewer.pal(5,"RdBu"))(8);
hmcol = colorRampPalette(brewer.pal(3,"Blues"))(8);

format(Sys.time(), "%a %b %d %H:%M:%S %Y")

format(Sys.time(), "%Y%b%d_%H%M%S")

 

#regular expression 

require(org.Sc.sgd.db)
x <- org.Sc.sgdALIAS
ls(x)[grep("^Y..\\d{3}", ls(x))]

http://www.regular-expressions.info/rlanguage.html
http://www.r-bloggers.com/regular-expressions-in-r-vs-rstudio/

list.files for the contents of a directory.

normalizePath for a ‘canonical’ path name.

(WD <- getwd())

if (!is.null(WD)) setwd(WD)

require(xlsx) # read Excel in R.

Usage

! x
x & y
x && y
x | y
x || y
xor(x, y)

rm(list=ls() );



unlist(strsplit("a.b.c", "\\."))
-----
str(x)
attributes(x)
--------------
outer( month.abb, 1999:2003, FUn="paster");

Letters <- c( LETTERS, letters);
Letters[ ! sapply(Letters, function(xx) exists(xx) ) ]; # anonymous function as a wrapper for a primitive function

------------
 legend(100,60, seq(100,200,1), lty=1) # line legends

  Library(MASS); example(Skye); #tenary plot

 library(help = survivial)   

ColorBrewer.org

useful comnds:
x11; factor; relevel; class; loess; contour; is.element; math %in%; grep; sample; nrow; 
grepmisc: hist2d
url()
---
class and object
CA@a[1]

----

test1 <- list( time= c(4, 3,1,1,2,2,3),
  status=c(1,NA,1,0,1,1,0),
  x= c(0, 2,1,1,1,0,0),
  sex= c(0, 0,0,0,1,1,1))
coxph( Surv(time, status) ~ x + strata(sex), test1) #stratified model

----
delete NA form matrix

 > x<-matrix(1:16,4,4)
 > x[col(x)>=row(x)]<-NA
 > x[,! apply(x,2,function(x) all(is.na(x))) ]
     [,1] [,2] [,3]
[1,]   NA   NA   NA
[2,]    2   NA   NA
[3,]    3    7   NA
[4,]    4    8   12

----
? R/Splus Perl interface   RSperl
? R Pythong interface Rpy Rpython
not in CRAN
----
date.grouping <- function(d) {
  # for ea date in d calculate date beginning 6 month period which contains it
  mat <- matrix(as.numeric(unlist(strsplit(as.character(d),"-"))),nr=2)
  f <- function(x) do.call( "ISOdate", as.list(x) )
  POSIXct.dates <- apply(rbind(mat,1),2,f) + ISOdate(1970,1,1)
  breaks <- c(seq(from=min(POSIXct.dates), to=max(POSIXct.dates), by="6 mo"), Inf)
  format( as.POSIXct( cut( POSIXct.dates, breaks, include.lowest=T )), "%Y-%m" ) }

----
nonlinear regression
library(nls)
----
http://www.bioconductor.org/
----
library(lattice)
----
persp()
----
las=1 or 2
You can use the graphics parameter "srt" to rotate displayed text by a specified number of degrees,
 e.g. srt=45 to put it on an angle, srt=90 to put it vertical.  

----
cnams = dimnames(aa)[[2]]

cnams[which(cnams == 'blah3.Mg')] = 'Mg (%)'
...
dimnames(aa)[[2]] = cnams
----
eval(substitute(lf <- locfit(~s, data=age), list(s=s)))
------
  sub=sort(sample(x,200, replace=F))
  postscript("try.ps")
  matplot(x[sub],y[sub,],type="l",lwd=5)     
  dev.off()

-----

>Does anyone know if R has the functionality to calculate a simple 
>moving average. I cant seem to find it in the help menu.

filter in library ts. does filter() do what you need?
Or look at the 'running' function in the gregmisc package.


moving.average <- 
function(x, k) { 
 n <- length(x) 
 y <- rep(0, n) 
 for (i in (1+k):n) 
   y[i] <- mean(x[(i-k):i]) 
 return(y)
 } 

----
tree packages
----

# Create an Example Data Frame Containing Car x Color data, with long car names 
carnames <- c("BMW: High End, German",
              "Renault: Medium End, French",
              "Mercedes: High End, German", 
              "Seat: Imaginary, Unknown Producer")
carcolors <- c("red","white","silver","green")
datavals <- round(rnorm(16, mean=100, sd=60),1)
data <- data.frame(Car=rep(carnames,4),
                   Color=rep(carcolors, c(4,4,4,4) ),
                   Value=datavals )

# generate balloon plot with default scaling, the column labels will overlap 
# balloonplot( data$Color, data$Car, data$Value)


# try again, with column labels rodated 90 degrees, and given more space 
balloonplot( data$Car, data$Color, data$Value, colmar=3, colsrt=90)



----

Here is a very rough addlogo() using pixmap:

"addlogo" <- function(x, y, pixmap) {
    if (is.list(x)) {
        y <- x$y
        x <- x$x
    }
    else if (missing(y)) 
        stop("missing y")
    if (!is.numeric(x) || !is.numeric(y)) 
        stop("non-numeric coordinates")
    if ((nx <- length(x)) <= 1 || nx != length(y) || nx > 2) 
        stop("invalid coordinate lengths")
    pixmap@bbox[1] <- x[1]
    pixmap@bbox[2] <- y[1]
    pixmap@bbox[3] <- x[2]
    pixmap@bbox[4] <- y[2]
    pixmap@cellres[1] <- (pixmap@bbox[3] - pixmap@bbox[1]) / pixmap@size[2]
    pixmap@cellres[2] <- (pixmap@bbox[4] - pixmap@bbox[2]) / pixmap@size[1]
    plot(pixmap, add=TRUE)
    invisible(pixmap)
}

which will work with locator() too. To maintain aspect, it shouldn't alter 
the relative cell resolutions, and should just use the new x or y, bur 
this is the general case. The handling of the location of the logo is 
copied & pasted from legend().



----
x <- readLines(myfile)
strsplit(substring(x,8),split="")
----