| hexmap<-function(x,y,id,...){ | |
| xcent<-x*sqrt(3) - (y%%2) *sqrt(3)/2 | |
| ycent<-y*1.5 | |
| plot(x,y,type="n",ylim=range(ycent)+c(-2,2),xlim=range(xcent)+c(-2,2)) | |
| for(i in 1:length(x)){ | |
| polygon(hex_x+xcent[i],hex_y+ycent[i]) | |
| text(xcent[i],ycent[i],id[i],cex=0.4) | |
| } |
| "+.bentime"<-function(e1,e2){ | |
| e<-list(hour=e1$hour+e2$hour,min=e1$min+e2$min,sec=e1$sec+e2$sec) | |
| sec_overflow<-e$sec>60L | |
| e$sec<-e$sec %% 60L | |
| e$min<-e$min+sec_overflow | |
| min_overflow<-e$min>60L | |
| e$hour<-e$hour+min_overflow | |
| e$min<-e$min %% 60L | |
| class(e)<-"bentime" |
| rock<-read.csv("~/Downloads/output.csv", as.is=TRUE, header=FALSE, col.names=c("datetime","song","group")) | |
| rock$stime<-substr(rock$datetime,5,9) | |
| rock$timeangle<-with(rock, as.numeric(substr(stime,1,2))*2*pi/24+as.numeric(substr(stime,4,5))*2*pi/24/60) | |
| rock$ty<-cos(rock$timeangle) | |
| rock$tx<-sin(rock$timeangle) | |
| rock$txmean<-mean(rock$tx) | |
| rock$tymean<-mean(rock$ty) |
| library(hextri) | |
| library(survey) | |
| data(api) | |
| ## all hexes same orientation: looks as if middle schools went up more | |
| with(apipop,hextri(api99,api00,stype,c("orange","forestgreen","purple"),nbins=20,diffuse=FALSE, | |
| xlab="1999 Academic Performance Index",ylab="2000 Academic Performance Index",style="size")) | |
| legend("topleft",fill=c("orange","purple","forestgreen"),legend=c("Elementary","Middle","High"),bty="n") | |
| ## random orientation: less pretty, but you can see middle schools went up less |
| library(FNN) | |
| x1<-runif(5e4) | |
| x2<-matrix(runif(5e4*2),ncol=2) | |
| x10<-matrix(runif(5e4*10),ncol=10) | |
| x100<-matrix(runif(5e4*100),ncol=100) | |
| system.time(d1<-knn.dist(x1,k=1)) | |
| system.time(d2<-knn.dist(x2,k=1)) | |
| system.time(d10<-knn.dist(x10,k=1)) |
| redpeak=function(s,w){ | |
| x=c(0,0,1,NA, 1,2,2,NA,0.5,1,1.5) | |
| y=c(0,1,1,NA,1,1,0,NA,0,0.5,0) | |
| polygon(x*w+s[1],y*w+s[2],col=c("black","navyblue","#98332f")) | |
| } |
| one.nri<-function(N=1000){ | |
| x<-rnorm(50) | |
| y<-rbinom(50,1,x/10+0.5) | |
| z<-rnorm(50) | |
| m_old<-lm(y~x) | |
| m_new<-lm(y~x+z) | |
| x<-rnorm(N) | |
| y<-rbinom(N,1,x/10+0.5) |
| expit<-function(eta) exp(eta)/(1+exp(eta)) | |
| one.nri<-function(N=1000){ | |
| x<-rnorm(50) | |
| y<-rbinom(50,1,expit(x)) | |
| z<-rnorm(50) | |
| m_old<-glm(y~x,family=binomial()) | |
| m_new<-glm(y~x+z,family=binomial()) |
This code implements the thing that PREDMARG in SUDAAN does, as described in
Along the lines of the 'jammr' package, an example to show it's quite easy to hide things from even moderately careful inspection.
If you run the code in evil.R, there isn't any obvious impact on your session, as evil-output.txt shows. But now look at what pie() and attach() do.
This isn't a security issue: anyone who can run arbitrary R code on your system can do much worse.