Related
I am trying to plot a heatmap (colored by odds ratios) using ggplot2. The odds ratio values range from 0-200. I would like my heatmap legend to show markings corresponding to certain values (0.1, 1, 10, 50, 100, 200). This is the code I am using but my legend does not label all the values (see below)
Code below:
map is a sample data frame with columns: segments, OR, tissue type
segments <- c("TssA", "TssBiv", "BivFlnk", "EnhBiv","ReprPC", "ReprPCWk", "Quies", "TssAFlnk", "TxFlnk", "Tx", "TxWk", "EnhG", "Enh", "ZNF/Rpts", "Het")
OR <- c(1.4787622, 46.99886002, 11.74417278, 4.49223136, 204.975818, 1.85228517, 0.85762414, 0.67926846, 0.33696213, 0.06532777, 0.10478027, 0.07462983, 0.06501252, 1.32922162, 0.32638438)
df <- data.frame(segments, OR)
map <- df %>% mutate(tissue = 'colon')
ggplot(map, aes(tissue,segments, fill = OR))+ geom_tile(colour="gray80")+
theme_bw()+coord_equal()+
scale_fill_gradientn(colours=c("lightskyblue1", "white","navajowhite","lightsalmon", "orangered2", "indianred1"),
values=rescale(c(0.1, 1, 10, 50, 100, 200)), guide="colorbar", breaks=c(0.1, 1, 10, 50, 150, 200))
I am looking for my legend to look something similar to this (using the values I specified):
With your map data, first rescale OR to log(OR).
Also, you might want to assign white to OR = 1. If that's the case, your approach would be able to achieve that. You may want to try different limits values to achieve that with real data.
map_1 <-map %>% mutate(OR = log(OR))
OR_max <- max(map$OR, na.rm = TRUE)
log_list <- c(0.2, 1, 10, 50, 200) %>% log
ggplot(map_1, aes(tissue,segments, fill = OR))+ geom_tile(colour="gray80")+
theme_bw()+coord_equal()+
scale_fill_gradientn(
colours = c("red3", "white", "navy"),
values=rescale(log_list),
guide="colorbar",
breaks=log_list,
limits = c(1/OR_max, OR_max) %>% log,
labels = c("0.1", "1", "10", "50", "200")
)
I would like to make some plots from my data. Unfortunately, it is hard to predict how many plots I will generate because it depends on data and may be different. It is a reason why I would like to make it easy adjustable. However, it will be most often a plot from group of 3 rows each time.
So, I would like to plot from rows 1:3, 4-6,7-9, etc.
This is data:
> dput(DF_final)
structure(list(AC = c(0.0031682160632777, 0.00228591145206846,
0.00142094444568728, 0.000661218113472149, 0.0010078157353918,
0.000400289437089513, 40.4634784175177, 40.5055070858594, 0.0183737773741582
), SD = c(0.00250647379467532, 0.0013244185401148, 0.000469332241199189,
0.000294558308707343, 0.000385553400676202, 0.000104447914881357,
11.0693842400794, 8.78768774254084, 0.00696532251341454), ln_AC = c(-5.75458660556339,
-6.08099044923792, -6.556433525855, -7.32142679754668, -6.89996992823399,
-7.8233226797995, 3.70039979980691, 3.70143794229703, -3.99683077355773
), ln_SD = c(-5.98887837626238, -6.62678175351058, -7.66419963690747,
-8.13003358225542, -7.86083085139947, -9.16682203300101, 2.40418312097106,
2.17335162163583, -4.96681136795312), Percent_AC = c(126.401324043689,
172.597361244303, 302.758754023937, 224.477834753288, 261.394591157605,
383.243109777925, 365.544076706723, 460.934756361151, 263.789326894369
), Percent_SD = c(100, 100, 100, 100, 100, 100, 100, 100, 100
), TP = c(0, 40, 80, 0, 40, 80, 0, 40, 80)), row.names = c("Tim_0",
"Tim_40", "Tim_80", "Jack_0", "Jack_40", "Jack_80", "Tom_0",
"Tom_40", "Tom_80"), class = "data.frame")
Column ln_AC should be set as an Y axis and column TP as X axis. First of all I would like to have all of them on separate graphs next to each other (remember about issue that the number of plots may be igh at some point) and if possible everything at the same graph. It should be a point plot with trend line.
Is it also possible to get a slope, SD slope, R^2 on a plot from linear regression ?
I manage to do it a for a single plot but regression line looks strange...
The code below was used to generate this plot and regression line.
fit <- lm(DF_final$ln_AC~DF_final$TP, data=DF_final)
plot(DF_final[1:3,7], DF_final[1:3,3], type = "p", ylim = c(-10,0), xlim=c(0,100), col = "red")
lines(DF_final$TP, fitted(fit), col="blue")
In base R (without so many packages), you can do:
# splits every 3 rows
DF = split(DF_final,gsub("_[^ ]*","",rownames(DF_final) ))
# you can also do
# DF = split(DF_final,(1:nrow(DF_final) - 1) %/%3 ))
To store your values:
slopes = vector("numeric",3)
names(slopes) = names(DF)
rsq = vector("numeric",3)
names(rsq) = names(DF)
To plot:
par(mfrow=c(1,3))
for(i in names(DF)){
fit <- lm(ln_AC~TP, data=DF[[i]])
plot(DF[[i]]$TP, DF[[i]]$ln_AC, type = "p", col = "red",main=i)
abline(fit, col="blue")
slopes[i]=round(fit$coefficients[2],digits=2)
rsq[i]=round(summary(fit)$r.squared,digits=2)
mtext(side=1,paste("slope=",slopes[i],"\nrsq=",rsq[i]),
padj=-2,cex=0.7)
}
And your values:
slopes
Jack Tim Tom
-0.01 -0.01 -0.10
rsq
Jack Tim Tom
0.29 0.99 0.75
If I understand correctly, the reason you want 3 observation per graph is because you have different individuals (Jack,Tim,Tom) . Is that so?
If you don't want to worry about that number, you can do this
# move rownames to column
data$person <- rownames(data)
data$person <- gsub("\\_.*","",data$person) # remove TP from names
# better to use library(data.table) for this step
data <- melt(data,id.vars=c("person","TP","ln_AC"))
ggplot(data,aes(x=TP, y=ln_AC)) + geom_point() +
geom_smooth(method = "lm") + facet_grid(~person)
This results in a plot like #giocomai, but it will work also if you have 4,5,6 or whatever persons in your data.
---- Edit
If you want to add R2 values, you can do something like this. Note, that it may not be the best and elegant solution, but it works.
data <- data.frame(...)
data$person <- rownames(data)
data$person <- gsub("\\_.*","",data$person)
# run lm for all persons and save them in a data.frame
nomi <- unique(data$person)
#lmStats <- data.frame()
lmStats <- sapply(nomi,
function(ita){
model <- lm(ln_AC~TP,data= data[which(data$person == ita),])
lmStat <- summary(model)
# I only save r2, but you can get all the statistics you need
lmRow <- data.frame("r2" = lmStat$r.squared )
#lmStats <- rbind(lmStats,lmRow)
}
)
lmStats <- do.call(rbind,lmStats)
# format the output,and create a dataframe we will use to annotate facet_grid
lmStats <- as.data.frame(lmStats)
rownames(lmStats) <- gsub("\\..*","",rownames(lmStats))
lmStats$person <- rownames(lmStats)
colnames(lmStats)[1] <- "r2"
lmStats$r2 <- round(lmStats$r2,2)
lmStats$TP <- 40
lmStats$ln_AC <- 0
lmStats$lab <- paste0("r2= ",lmStats$r2)
# melt and add r2 column to the data (not necessary, but I like to have everything I plot in teh data)
data <- melt(data,id.vars=c("person","TP","ln_AC"))
data$r2 <- lmStats[match(data$person,rownames(lmStats)),1]
ggplot(data,aes(x=TP, y=ln_AC)) + geom_point() +
geom_smooth(method = "lm") + facet_grid(~person) +
geom_text(data=lmStats,label=lmStats$lab)
An easier way (less steps) would be to use facet_grid(~r2), so that you have the R.square value in the title.
If I understand correctly what you mean, assuming you will always have three observation per graph, your main issue would be creating a categorical variable to separate them. Here's one way to accomplish it. Depending on the layout you prefer, you may want to check facet_wrap instead of facet_grid.
library("dplyr")
library("ggplot2")
DF_final <- structure(list(AC = c(0.0031682160632777, 0.00228591145206846,
0.00142094444568728, 0.000661218113472149, 0.0010078157353918,
0.000400289437089513, 40.4634784175177, 40.5055070858594, 0.0183737773741582
), SD = c(0.00250647379467532, 0.0013244185401148, 0.000469332241199189,
0.000294558308707343, 0.000385553400676202, 0.000104447914881357,
11.0693842400794, 8.78768774254084, 0.00696532251341454), ln_AC = c(-5.75458660556339,
-6.08099044923792, -6.556433525855, -7.32142679754668, -6.89996992823399,
-7.8233226797995, 3.70039979980691, 3.70143794229703, -3.99683077355773
), ln_SD = c(-5.98887837626238, -6.62678175351058, -7.66419963690747,
-8.13003358225542, -7.86083085139947, -9.16682203300101, 2.40418312097106,
2.17335162163583, -4.96681136795312), Percent_AC = c(126.401324043689,
172.597361244303, 302.758754023937, 224.477834753288, 261.394591157605,
383.243109777925, 365.544076706723, 460.934756361151, 263.789326894369
), Percent_SD = c(100, 100, 100, 100, 100, 100, 100, 100, 100
), TP = c(0, 40, 80, 0, 40, 80, 0, 40, 80)), row.names = c("Tim_0",
"Tim_40", "Tim_80", "Jack_0", "Jack_40", "Jack_80", "Tom_0",
"Tom_40", "Tom_80"), class = "data.frame")
DF_final %>%
mutate(id = as.character(sapply(1:(nrow(DF_final)/3), rep, 3))) %>%
ggplot(aes(x=TP, y=ln_AC)) +
geom_point() +
geom_smooth(method = "lm") +
facet_grid(~id)
Created on 2020-02-06 by the reprex package (v0.3.0)
I am using the following code to produce a scatterplot using rCharts & HighCharts. I each point to have a their corresponding Ticker right next to the point at all times. I would also like for the color of the dot to be determined by "Type", and all points to be circles.
library(rCharts)
x <- as.data.frame(c(1:6))
x$Tickers <- c("DBC", "IWV", "TIP", "TLT", "SPY", "MODEL")
x$Return <- c(0, 15, 4.3, 7.3, 15, 7)
x$StdDev <- c(16, 16, 6, 15, 16, 6)
x$Type <- c('Asset', 'Asset', 'Asset', 'Asset', 'Benchmark', 'Model')
x
b <- hPlot(x="StdDev", y="Return", data = x, group="Type", type = "scatter")
b
Thank you!
As is, the nodes are colored by "Type", you can force the nodes to be circles with this:
b$plotOptions(scatter=list(marker=list(symbol='circle')))
I'm using Paul Bleicher's Calendar Heatmap to visualize some events over time and I'm interested to add black-and-white fill patterns instead of (or on top of) the color coding to increase the readability of the Calendar Heatmap when printed in black and white.
Here is an example of the Calendar Heatmap look in color,
and here is how it look in black and white,
it gets very difficult to distinguish between the individual levels in black and white.
Is there an easy way to get R to add some kind of patten to the 6 levels instead of color?
Code to reproduce the Calendar Heatmap in color.
source("http://blog.revolution-computing.com/downloads/calendarHeat.R")
stock <- "MSFT"
start.date <- "2012-01-12"
end.date <- Sys.Date()
quote <- paste("http://ichart.finance.yahoo.com/table.csv?s=", stock, "&a=", substr(start.date,6,7), "&b=", substr(start.date, 9, 10), "&c=", substr(start.date, 1,4), "&d=", substr(end.date,6,7), "&e=", substr(end.date, 9, 10), "&f=", substr(end.date, 1,4), "&g=d&ignore=.csv", sep="")
stock.data <- read.csv(quote, as.is=TRUE)
# convert the continuous var to a categorical var
stock.data$by <- cut(stock.data$Adj.Close, b = 6, labels = F)
calendarHeat(stock.data$Date, stock.data$by, varname="MSFT Adjusted Close")
update 02-13-2013 03:52:11Z, what do I mean by adding a pattern,
I envision adding a pattern to the individual day-boxes in the Calendar Heatmap as pattern is added to the individual slices in the pie chart to the right (B) in this plot,
found here something like the states in this plot.
I answered this question before he becomes a bounty. It looks like the OP find my previous answer a little bit complicated. I organized the code in a single gist here. you need just to download the file and source it.
I create new function extra.calendarHeat which is an extension of the first one to draw hetmap of double time series.(dat,value1,value2). I addedthis new parameters:
pch.symbol : vector of symbols , defualt 15:20
cex.symbol : cex of the symbols , default = 2
col.symbol : color of symbols , default #00000044
pvalues : value of symbols
Here some examples:
## I am using same data
stock <- "MSFT"
start.date <- "2012-01-12"
end.date <- Sys.Date()
quote <- paste("http://ichart.finance.yahoo.com/table.csv?s=",
stock,
"&a=", substr(start.date,6,7),
"&b=", substr(start.date, 9, 10),
"&c=", substr(start.date, 1,4),
"&d=", substr(end.date,6,7),
"&e=", substr(end.date, 9, 10),
"&f=", substr(end.date, 1,4),
"&g=d&ignore=.csv", sep="")
stock.data <- read.csv(quote, as.is=TRUE)
p1 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
pvalues = stock.data$Volume,
varname="W&B MSFT Adjusted Close
\n Volume as no border symbol ")
## multiply symbols
p2 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
pvalues = stock.data$Volume,
varname="W&B MSFT Adjusted Close \n
black Volume as multiply symbol ",
pch.symbol = c(3,4,8,9),
col.symbol='black')
## circles symbols
p3 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
pvalues = stock.data$Volume,
varname="W&B MSFT Adjusted Close \n blue Volume as circles",
pch.symbol = c(1,10,13,16,18),
col.symbol='blue')
## triangles symbols
p4 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
pvalues = stock.data$Volume,
varname="W&B MSFT Adjusted Close \n red Volume as triangles",
pch.symbol = c(2,6,17,24,25),
col.symbol='red')
p5 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
varname="MSFT Adjusted Close",
pch.symbol = LETTERS,
col.symbol='black')
# symbols are LETTERS
p6 <- extra.calendarHeat(dates= stock.data$Date, values = stock.data$Adj.Close,
pvalues = stock.data$Volume,
varname="MSFT Adjusted Close \n Volume as LETTERS symbols",
pch.symbol = letters,
color='r2b')
You can panel.level.plot from latticeExtra to add pattern. I think the question as it is asked is a little bit specific. So I try to generalize it. The idea is to give the steps to transform a time series to a calendar heatmap: with 2 patterns (fill color and a shape). We can imagine multiple time series (Close/Open). For example, you can get something like this
or like this, using a ggplot2 theme:
The function calendarHeat , giving a single time series (dat,value) , transforms data like this :
date.seq value dotw woty yr month seq
1 2012-01-01 NA 0 2 2012 1 1
2 2012-01-02 NA 1 2 2012 1 2
3 2012-01-03 NA 2 2 2012 1 3
4 2012-01-04 NA 3 2 2012 1 4
5 2012-01-05 NA 4 2 2012 1 5
6 2012-01-06 NA 5 2 2012 1 6
So I assume that I have data formated like this, otherwise, I extracted from calendarHeat the part of data transformation in a function(see this gist)
dat <- transformdata(stock.data$Date, stock.data$by)
Then the calendar is essentially a levelplot with custom sacles , custom theme and custom panel' function.
library(latticeExtra)
levelplot(value~woty*dotw | yr, data=dat, border = "black",
layout = c(1, nyr%%7),
col.regions = (calendar.pal(ncolors)),
aspect='iso',
between = list(x=0, y=c(1,1)),
strip=TRUE,
panel = function(...) {
panel.levelplot(...)
calendar.division(...)
panel.levelplot.points(...,na.rm=T,
col='blue',alpha=0.5,
## you can play with cex and pch here to get the pattern you
## like
cex =dat$value/max(dat$value,na.rm=T)*3
pch=ifelse(is.na(dat$value),NA,20),
type = c("p"))
},
scales= scales,
xlim =extendrange(dat$woty,f=0.01),
ylim=extendrange(dat$dotw,f=0.1),
cuts= ncolors - 1,
colorkey= list(col = calendar.pal(ncolors), width = 0.6, height = 0.5),
subscripts=TRUE,
par.settings = calendar.theme)
Where the scales are:
scales = list(
x = list( at= c(seq(2.9, 52, by=4.42)),
labels = month.abb,
alternating = c(1, rep(0, (nyr-1))),
tck=0,
cex =1),
y=list(
at = c(0, 1, 2, 3, 4, 5, 6),
labels = c("Sunday", "Monday", "Tuesday", "Wednesday", "Thursday",
"Friday", "Saturday"),
alternating = 1,
cex =1,
tck=0))
And the theme is setting as :
calendar.theme <- list(
xlab=NULL,ylab=NULL,
strip.background = list(col = "transparent"),
strip.border = list(col = "transparent"),
axis.line = list(col="transparent"),
par.strip.text=list(cex=2))
The panel function uses a function caelendar.division. In fact, the division of the grid(month black countour) is very long and is done using grid package in the hard way (panel focus...). I change it a little bit, and now I call it in the lattice panel function: caelendar.division.
We can use ggplot2's scale_shape_manual to get us shapes that appear close to shading, and we can plot these over the grey heatmap.
Note: This was adapted from #Jay's comments in the original blog posting for the calendar heatmap
# PACKAGES
library(ggplot2)
library(data.table)
# Transofrm data
stock.data <- transform(stock.data,
week = as.POSIXlt(Date)$yday %/% 7 + 1,
month = as.POSIXlt(Date)$mon + 1,
wday = factor(as.POSIXlt(Date)$wday, levels=0:6, labels=levels(weekdays(1, abb=FALSE)), ordered=TRUE),
year = as.POSIXlt(Date)$year + 1900)
# find when the months change
# Not used, but could be
stock.data$mchng <- as.logical(c(0, diff(stock.data$month)))
# we need dummy data for Sunday / Saturday to be included.
# These added rows will not be plotted due to their NA values
dummy <- as.data.frame(stock.data[1:2, ])
dummy[, -which(names(dummy) %in% c("wday", "year"))] <- NA
dummy[, "wday"] <- weekdays(2:3, FALSE)
dummy[, "mchng"] <- TRUE
rbind(dummy, stock.data) -> stock.data
# convert the continuous var to a categorical var
stock.data$Adj.Disc <- cut(stock.data$Adj.Close, b = 6, labels = F)
# vals is the greyscale tones used for the outer monthly borders
vals <- gray(c(.2, .5))
# PLOT
# Expected warning due to dummy variable with NA's:
# Warning message:
# Removed 2 rows containing missing values (geom_point).
ggplot(stock.data) +
aes(week, wday, fill=as.factor(Adj.Disc),
shape=as.factor(Adj.Disc), color=as.factor(month %% 2)) +
geom_tile(linetype=1, size=1.8) +
geom_tile(linetype=6, size=0.4, color="white") +
scale_color_manual(values=vals) +
geom_point(aes(alpha=0.2), color="black") +
scale_fill_grey(start=0, end=0.9) + scale_shape_manual(values=c(2, 3, 4, 12, 14, 8)) +
theme(legend.position="none") + labs(y="Day of the Week") + facet_wrap(~ year, ncol = 1)
I work in a laboratory and we have to produce day to day Levey-Jennings charts and I was wondering if there is an easy way produce Levey-Jennings chart using R.
Well, I googled and didn't find one on CRAN, but maybe Levey-Jennings charts also go by another name? Anyway, here's a low tech one that you can tweak that I just made following the description on Wikipedia:
# make a data series
my.stat <- rnorm(100,sd=2.5)
# get its standard dev:
my.sd <- sd(my.stat)
# convert series to distance in sd:
my.lj.stat <- (my.stat - mean(my.stat)) / my.sd
plot(1:100, my.lj.stat, type = "o", pch = 19, col = "blue", ylab = "sd", xlab = "observation",
main = paste("mean value of", round(mean(my.stat),3),"\nstandard deviation of",round(my.sd,3)))
# a low tech L-J chart function:
LJchart <- function(series, ...){
xbar <- mean(series)
se <- sd(series)
conv.series <- (my.stat - xbar) / se
plot(1:length(series), conv.series, type = "o", pch = 19, col = "blue", ylab = "sd", xlab = "observation",
main = paste("mean value of", round(xbar,3), "\nstandard deviation of", round(se,3)), ...)
}
LJchart(rnorm(100,sd=2.5))
[Edit: adding a shaded region for the 1 sd zone, inspired by Seth's comment]
This one also has more flexible args I guess, but I'm not too experienced with the use of ... when different functions share the ..., but trying it out with this example it doesn't break:
LJchart <- function(series, ...){
xbar <- mean(series)
se <- sd(series)
conv.series <- (my.stat - xbar) / se
plot(1:length(series), conv.series, type = "n", ...)
rect(0, -1, length(series)+1, 1, col = gray(.9), border = NA)
lines(1:length(series), conv.series, ...)
points(1:length(series), conv.series, ...)
if (! "main" %in% names(list(...))) {
title(paste("mean value of", round(xbar,3), "\nstandard deviation of", round(se,3)))
}
}
LJchart(rnorm(100,sd=2.5), xlab = "observations", ylab = "sd", col = "blue", pch = 19)
For plotting I prefer ggplot2 over standard graphics. Therefore, here is my solution using ggplot2:
theme_set(theme_bw())
dat = data.frame(value = rnorm(100,sd=2.5))
dat = within(dat, {
value_scaled = scale(value, scale = sd(value))
obs_idx = 1:length(value)
})
ggplot(aes(x = obs_idx, y = value_scaled), data = dat) +
geom_ribbon(ymin = -1, ymax = 1, alpha = 0.1) +
geom_line() + geom_point()
Which yields:
For the uninitiated: Levey-Jenning's chart is a chart used to manage quality-control samples, especially in a medical laboratory. The Y axis is no. of SDs, and X axis should be timestamps.
Modified from Tim Riffe's answer from above. This should be more suited for laboratory use.
# LJchart
# modified from Tim Riffe's answer on StackOverflow
#
# Version history:
# 1.1 Added support for timestamp on each datapoint
# Added rectangle to delineate the 2SD boundary, limited the scope to 3 SD
#
# Usage:
# LJchart( [Series of values], [Series of timestamp], [Manufacturer set mean], [Manufacturer set SD] )
# e.g.
# creatinineLV1 <- c(52, 51, 48, 51, 42, 48, 46, 44, 45, 51, 51,
# 46, 50, 45, 52, 41, 58, 45, 44, 44, 42, 47,
# 45, 43, 48, 43, 47, 47, 48)
# timeCRLV1 <- c(41267.41106, 41267.51615, 41267.64512, 41267.683,
# 41268.32005, 41269.55979, 41269.62026, 41269.88109,
# 41270.20442, 41270.5897, 41270.61914, 41270.66589,
# 41270.76311, 41271.43517, 41271.58534, 41271.69562,
# 41271.75682, 41272.43492, 41272.51768, 41272.53,
# 41272.59527, 41273.38759, 41273.46314, 41273.49382,
# 41273.6311, 41273.66563, 41273.78007, 41273.82463,
# 41273.88547)
# > LJchart(creatinineLV1, timeCRLV1, 50, 6)
LJchart <- function(series1, series2, meanx, sdx){
xbar <- mean(series1)
se <- sd(series1)
conv.series <- (series1 - meanx) / sdx
plot(series2, conv.series, type = "n", ylim=c(-3,+3))
rect(0, -2, max(series2)+1, 2, col = gray(.9), border = NA)
rect(0, -1, max(series2)+1, 1, col = gray(.8), border = NA)
lines(series2, conv.series)
points(series2, conv.series)
title(paste("calculated mean value of", round(xbar,3),
"\ncalculated standard deviation of", round(se,3)))
}
I'm working on developing some scripts for this type of chart>
Check the script. The main data in "value" vector.
All comments "##/#" may be erased.
value<-rnorm(100,1000,200) ##create list of numbers, "scan()" may be used for real observations
nmbrs<-length(value) ## determine the length of vector
obrv<-1:length(value) ## create list of observations
par(xpd=FALSE)
sd1<-sd(value[1:20])*1 ## 1 standart deviation
sd2<-sd(value[1:20])*2 ## 2 standart deviations
sd3<-sd(value[1:20])*3 ## 3 standart deviations
usd1<-mean(value)+sd1 ## upper limit
lsd1<-mean(value)-sd1 ## lower limit
lsd2<-mean(value)-sd2 ## lower limit
usd2<-mean(value)+sd2 ## upper limit
usd3<-mean(value)+sd3 ## upper limit
lsd3<-mean(value)-sd3 ## lower limit
## ploting the grid
plot(obrv,value,type="n",xlab="Observations",ylab="Value",ylim=c(lsd3-sd1,usd3+sd1))
abline(h=mean(value),col=2,lty=1)
abline(h=usd1,col=3,lty=3)
abline(h=lsd1,col=3,lty=3)
abline(h=usd2,col=4,lty=2)
abline(h=lsd2,col=4,lty=2)
abline(h=usd3,col=6,lty=1)
abline(h=lsd3,col=6,lty=1)
## 20 first values for L-G chart for QC limits
for (i in 1:20)
{
points(obrv[i],value[i],col="black")
}
lines(obrv[1:20],value[1:20],col="red")
## if over mean - "red", under mean - "blue"
for (i in 21:nmbrs)
{
points(obrv[i],value[i],col="blue")
segments(obrv[i-1],value[i-1],obrv[i],value[i],col="blue")
}
# 1s points - blue; 2s points - red
#if (value[i]<usd1 || value[i]>lsd1) points(obrv[i],value[i],col="blue")
#if (value[i]>usd1 || value[i]<lsd1) points(obrv[i],value[i],col="red")
#12s violation rule
#if (value[i]>usd1 || value[i]<usd1) text(30, usd3, "12s violation")
#if (value[i]>usd1 || value[i]<usd1) text(30, usd3, "12s violation")
#segments(obrv[i-1],value[i-1],obrv[i],value[i],col="blue")
#if (value[i]>usd1) break
#}
#legend placement - might be omited
#legend(1,min(value)-sd1*0.2,bg=8,c("mean","sd1","sd2","sd3"),lty=c(1,3,2,1),lwd=c(2.5,2.5,2.5,2.5),col=c(2,3,4,6),cex=0.8)