Category Archives: Scripts

R scripts

Posted on by
Reply 
library(lattice)
library(Hmisc)
bwplot(LOS~DT|CL,act, horiz=FALSE, cex=.5,pch="|")

bwplot(LOS~DT|CL,act, horiz=FALSE, cex=.5)

panel.mean <- function(x, y, ...) {
tmp <- tapply(x, y, FUN = mean)
panel.points(tmp, seq(tmp), pch = 20, ...)
}

bpplot(LOS~DT|CL,act, horiz=FALSE, cex=.3)

bwplot(LOS~DT|CL,act, horiz=FALSE, panel=panel.bwplot, cex=1.3)

bwplot(LOS~DT|CL,act, horiz=FALSE, cex=.5,pch="|",panel.mean <- function(LOS, DT,data=act ...) {
tmp <- tapply(LOS, DT,data=act, FUN = mean)
panel.points(tmp, seq(tmp), pch = 20, ...)
})

############################################try this
a=0.002; b=31.7; c=0.51
sds=rep(c(0,3,5,10,20,50,200), each=3)
y1=c(0,0,0.16, 0, 0.33,0.5, 0.16, 0.83, 1.16, 0.67, 0.5, 1.16, 0.83,
2.33, 3.6, 5.5, 4.33, 1.16, 22, 13, 12)
lo=y1-0.1*y1
hi=y1+0.1*y1
##########################################
# Figure 1
xYplot(
Cbind(y1, lo, hi)~jitter(sds, amount=1),
method="bars",ylim=c(0,max(hi)+1),
ylab="Y", xlab="X"
)

# Figure 2
xYplot(Cbind(y1, lo, hi)~jitter(sds, amount=1),
method="bars",ylim=c(0,max(hi)+1),
ylab="Y", xlab="X",
panel=function(...){
panel.xYplot(x,y,...)
panel.number=panel.number()
panel.curve(curve(a*(x+c)/1+a*b*(x+c), from=0, type="l", lwd=2))
})

#########################################################

###################################################################################################
bwplot(LOS~DT|CL,act, horiz=FALSE,cex=0.6,pch="|",
panel=function(x,y,...)
{
panel.bwplot(x,y,horiz=FALSE,...)
#     panel.mean(y,x,col="red",...)
bwplot(DT~LOS|CL,act,horiz=TRUE,panel=panel.mean )
#    panel.mean(y, x,col="red", horiz=TRUE,...)
#	panel.points(mean(x), y, col="red", ...)
}
)
#####################################
#########################
bwplot(LOS~DT|CL,act,horiz=FALSE,cex=0.5)
################

#############
bwplot(LOS~DT|CL,act,horiz=FALSE,panel=panel.mean )
############

#####
xYplot(
LOS~DT|CL,act,
panel=function(x,y,...)
{
xYplot(x,y,...)
bwplot(LOS~DT|CL,act,horiz=FALSE,panel=panel.mean )
#panel.mean
}
)
########

#########
xYplot(LOS~DT|CL,act,horiz=FALSE,cex=0.5)
################
library(ggplot2)
p <- ggplot(mtcars, aes(factor(cyl), mpg))
p + geom_boxplot()
str(act)
###############################
###############################

library(ggplot2)
p<-ggplot(act,aes(factor(DT),LOS))

p + geom_boxplot() + geom_hline(aes(yintercept=mean(LOS)),colour="red",linetype=2) + facet_wrap(~CL)+ geom_point(stat = "summary",colour = "red", size = I(3) ,shape = 5, fun.y = "mean", position = position_dodge(width = 0.75))+geom_line(stat = "summary",colour = "red", size = I(3) ,shape = 5, fun.y = "mean", position = position_dodge(width = 0.75))
last_plot() + theme_bw()

###################################################
###################################################
library(doBy)
summaryBy(LOS + DT  ~ CL + DT, data = act, FUN = function(x) { c(mean = mean(x), sd = sd(x), var=var(x),sum=sum(x)) } )
###############
summaryBy(LOS  ~ CL , data = act, FUN = function(x) { c(mean = mean(x), sd =sd(x), var=var(x),sum=sum(x)) } )
##############

####################################

p+geom_boxplot()+geom_line(aes(x=factor(DT),y=mean(LOS)) )
+ geom_point(stat = "summary",colour = "red", size = I(3) ,shape = 5, fun.y = "mean", position = position_dodge(width = 0.75))

#################################

library(ggplot2)
p<-ggplot(act,aes(factor(CL),LOS))
p + geom_mean()

p<-ggplot(act,aes(factor(DT),LOS))
p + geom_boxplot() +geom_hline(aes(yintercept=mean(LOS)),colour="red")+ facet_wrap(~CL)
###################################
# qplot examples -------------------------------------------------------------

qplot(diamonds$cut, diamonds$carat)
qplot(carat, price, data = diamonds)
qplot(carat, price, data = diamonds, colour=clarity)
qplot(carat, price, data = diamonds, geom=c("point", "smooth"), method=lm)

qplot(carat, data = diamonds,
  geom="histogram")
qplot(carat, data = diamonds,
  geom="histogram", binwidth = 1)
qplot(carat, data = diamonds,
  geom="histogram", binwidth = 0.1)
qplot(carat, data = diamonds,
  geom="histogram", binwidth = 0.01)

# using ggplot() -------------------------------------------------------------
d <- ggplot(diamonds, aes(x=carat, y=price))
d + geom_point()
d + geom_point(aes(colour = carat))
d + geom_point(aes(colour = carat)) + scale_colour_brewer()

ggplot(diamonds) + geom_histogram(aes(x=price))

# Separation of statistcs and geometric elements -----------------------------

p <- ggplot(diamonds, aes(x=price))

p + geom_histogram()
p + stat_bin(geom="area")
p + stat_bin(geom="point")
p + stat_bin(geom="line")

p + geom_histogram(aes(fill = clarity))
p + geom_histogram(aes(y = ..density..))

# Setting vs mapping ---------------------------------------------------------
p <- ggplot(diamonds, aes(x=carat,y=price))
# What will this do?
p + geom_point(aes(colour = "green"))
p + geom_point(colour = "green")
p + geom_point(colour = colour)
##################################

subset data

Posted on by
Reply

subset(dataframe, County==”CONWY”, c(N,date,hospital))

subsetting using an OR relation.

con2<-subset(ae,(AREA=="CONWY" & HEORG=="Ffestiniog_MIU" | AREA=="GWYNEDD" & HEORG=="Ffestiniog_MIU"), c(AT,AREA,DT_3,HEORG), order=c(HEORG,DT_3))

Importing data

Posted on by
Reply

temp <- read.table('clipboard', header=TRUE)
DataFrameName <-read.csv ("C:/filename.csv", header= TRUE)

When importing from the clipboard make sure you don't have any commas or spaces in the data or the headings as it may fail to import correctly. You'll get errors talking about too many or to few columns if you leave them in.