.Rhistory

install.packages("rlang")
.libPaths()
.libPaths(2)
.libPaths(D:\RLibrary)
.libPaths(D:/RLibrary)
.libPaths("D:\RLibrary")
.libPaths("D:/RLibrary")
.libPaths()
shiny::runApp('C:/Users/cgao001/OneDrive/R_shiny/COPD')
shiny::runApp('C:/Users/cgao001/OneDrive/R_shiny/COPD')
shiny::runApp('C:/Users/cgao001/OneDrive/R_shiny/COPD')
install.packages("magrittr")
shiny::runApp('C:/Users/cgao001/OneDrive/R_shiny/COPD')
install.packages("fastmap")
shiny::runApp('C:/Users/cgao001/OneDrive/R_shiny/COPD')
clear
clc
set.seed(10111)
x = matrix(rnorm(40), 20, 2)
y = rep(c(-1, 1), c(10, 10))
x[y == 1,] = x[y == 1,] + 1
plot(x, col = y + 3, pch = 19)
View(x)
y
library(e1071)
dat = data.frame(x, y = as.factor(y))
View(dat)
svmfit = svm(y ~ ., data = dat, kernel = "linear", cost = 10, scale = FALSE)
print(svmfit)
print(svmfit)
plot(svmfit, dat)
library(e1071)
library(rpart)
data(Glass, package="mlbench")
## split data into a train and test set
index <- 1:nrow(Glass)
testindex <- sample(index, trunc(length(index)/3))
testset <- Glass[testindex,]
trainset <- Glass[-testindex,]
install.packages("mlbench")
data(Glass, package="mlbench")
View(Glass)
## split data into a train and test set
index <- 1:nrow(Glass)
testindex <- sample(index, trunc(length(index)/3))
testset <- Glass[testindex,]
trainset <- Glass[-testindex,]
svm.model <- svm(Type ~ ., data = trainset, cost = 100, gamma = 1)
svm.pred <- predict(svm.model, testset[,-10])
## compute svm confusion matrix
table(pred = svm.pred, true = testset[,10])
# NOT RUN {
data(iris)
attach(iris)
## classification mode
# default with factor response:
model <- svm(Species ~ ., data = iris)
# alternatively the traditional interface:
x <- subset(iris, select = -Species)
y <- Species
model <- svm(x, y)
print(model)
summary(model)
# test with train data
pred <- predict(model, x)
# (same as:)
pred <- fitted(model)
# Check accuracy:
table(pred, y)
# compute decision values and probabilities:
pred <- predict(model, x, decision.values = TRUE)
attr(pred, "decision.values")[1:4,]
# visualize (classes by color, SV by crosses):
plot(cmdscale(dist(iris[,-5])),
col = as.integer(iris[,5]),
pch = c("o","+")[1:150 %in% model$index + 1])
View(iris)
t <- cmdscale(dist(iris[,-5]))
View(t)
m <- svm(setosa ~ Petal.Width + Petal.Length,
data = iris2, kernel = "linear")
iris2 = scale(iris[,-5])
View(iris2)
m <- svm(setosa ~ Petal.Width + Petal.Length,
data = iris2, kernel = "linear")
setosa <- as.factor(iris$Species == "setosa")
m <- svm(setosa ~ Petal.Width + Petal.Length,
data = iris2, kernel = "linear")
# plot data and separating hyperplane
plot(Petal.Length ~ Petal.Width, data = iris2, col = setosa)
(cf <- coef(m))
abline(-cf[1]/cf[3], -cf[2]/cf[3], col = "red")
plot(cmdscale(dist(iris[,-5])),
col = as.integer(iris[,5]),
pch = c("o","+")[1:150 %in% model$index + 1])
model$index
[1:150 %in% model$index + 1]
1:150 %in% model$index + 1
1:150 %in% model$index
1:150 %in% model$index + 1
t <- read.csv("C:/Users/cgao001/OneDrive - University of Dundee/HIC research/3 hic/Roche/Lab_Summary_27102021.csv")
View(t)
View(t)
t$Control <- paste0(t$ControlMean,"±",t$ControlSTD)
View(t)
t$HFpEF <- paste0(t$HFpEFMean,"±",t$HFpEFSTD)
t$HFrEF <- paste0(t$HFrEFMean,"±",t$HFrEFSTD)
write.csv(t,"C:/Users/cgao001/OneDrive - University of Dundee/HIC research/3 hic/Roche/Lab_Summary_27102021_v2.csv")
t <- read.csv("C:/Users/cgao001/OneDrive - University of Dundee/HIC research/3 hic/Roche/Lab_Summary_27102021.csv")
View(t)
t$Control <- paste0(t$ControlMean,"±",t$ControlSTD)
t$Control <- paste0(round(t$ControlMean,0),"±",round(t$ControlSTD,0))
t$Control <- paste0(round(t$ControlMean,0),"±",round(t$ControlSTD,0))
t$HFpEF <- paste0(round(t$HFpEFMean,0),"±",round(t$HFpEFSTD,0))
t$HFrEF <- paste0(round(t$HFrEFMean,0),"±",round(t$HFrEFSTD,0))
write.csv(t, "C:/Users/cgao001/OneDrive - University of Dundee/HIC research/3 hic/Roche/Lab_Summary_27102021_v3.csv")
# library
library(likert)
# Use a provided dataset
data(pisaitems)
items28 <- pisaitems[, substr(names(pisaitems), 1, 5) == "ST24Q"]
# Build plot
p <- likert(items28)
plot(p)
# library
install.packages("likert")
library(likert)
data(pisaitems)
items28 <- pisaitems[, substr(names(pisaitems), 1, 5) == "ST24Q"]
p <- likert(items28)
plot(p)
View(items28)
xy.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,3.2,2.8,2.2,1.8,
1.5,1.3,0.7,0.4)
xx.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,2.5,2,1.7,1.5,
1.3,1,0.8)
agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34",
"35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74",
"75-79","80-44","85+")
mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18)
fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18)
par(mar=pyramid.plot(xy.pop,xx.pop,labels=agelabels,
main="Australian population pyramid 2002",lxcol=mcol,rxcol=fcol,
gap=0.5,show.values=TRUE))
# three column matrices
avtemp<-c(seq(11,2,by=-1),rep(2:6,each=2),seq(11,2,by=-1))
malecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
femalecook<-matrix(avtemp+sample(-2:2,30,TRUE),ncol=3)
# group by age
agegrps<-c("0-10","11-20","21-30","31-40","41-50","51-60",
"61-70","71-80","81-90","91+")
oldmar<-pyramid.plot(malecook,femalecook,labels=agegrps,
unit="Bowls per month",lxcol=c("#ff0000","#eeee88","#0000ff"),
rxcol=c("#ff0000","#eeee88","#0000ff"),laxlab=c(0,10,20,30),
raxlab=c(0,10,20,30),top.labels=c("Males","Age","Females"),gap=4,
do.first="plot_bg(\"#eedd55\")")
# put a box around it
box()
# give it a title
mtext("Porridge temperature by age and sex of bear",3,2,cex=1.5)
# stick in a legend
legend(par("usr")[1],11,c("Too hot","Just right","Too cold"),
fill=c("#ff0000","#eeee88","#0000ff"))
# don't forget to restore the margins and background
par(mar=oldmar,bg="transparent")
xy.pop<-c(3.2,3.5,3.6,3.6,3.5,3.5,3.9,3.7,3.9,3.5,3.2,2.8,2.2,1.8,
1.5,1.3,0.7,0.4)
xx.pop<-c(3.2,3.4,3.5,3.5,3.5,3.7,4,3.8,3.9,3.6,3.2,2.5,2,1.7,1.5,
1.3,1,0.8)
agelabels<-c("0-4","5-9","10-14","15-19","20-24","25-29","30-34",
"35-39","40-44","45-49","50-54","55-59","60-64","65-69","70-74",
"75-79","80-44","85+")
mcol<-color.gradient(c(0,0,0.5,1),c(0,0,0.5,1),c(1,1,0.5,1),18)
fcol<-color.gradient(c(1,1,0.5,1),c(0.5,0.5,0.5,1),c(0.5,0.5,0.5,1),18)
par(mar=pyramid.plot(xy.pop,xx.pop,labels=agelabels,
main="Australian population pyramid 2002",lxcol=mcol,rxcol=fcol,
gap=0.5,show.values=TRUE))
install.packages("pyramid.plot")
library(pyramid.plot)
par(mar=pyramid.plot(xy.pop,xx.pop,labels=agelabels,
main="Australian population pyramid 2002",lxcol=mcol,rxcol=fcol,
gap=0.5,show.values=TRUE))
library(pyramid)
library(pyramid.plot: Pyramid plot)
library(Pyramid plot)
library(XML)
library(reshape2)
library(ggplot2)
library(plyr)
get_data <- function(country, year) {
c1 <- "http://www.census.gov/population/international/data/idb/region.php?N=%20Results%20&T=10&A=separate&RT=0&Y="
c2 <- "&R=-1&C="
url <- paste0(c1, year, c2, country)
df <- data.frame(readHTMLTable(url))
keep <- c(2, 4, 5)
df <- df[,keep]
names(df) <- c("Age", "Male", "Female")
cols <- 2:3
df[,cols] <- apply(df[,cols], 2, function(x) as.numeric(as.character(gsub(",", "", x))))
df <- df[df$Age != 'Total', ]
df$Male <- -1 * df$Male
df$Age <- factor(df$Age, levels = df$Age, labels = df$Age)
df.melt <- melt(df,
value.name='Population',
variable.name = 'Gender',
id.vars='Age' )
return(df.melt)
}
View(get_data)
nigeria <- get_data("NI", 2014)
library(XML)
library(reshape2)
library(ggplot2)
library(plyr)
get_data <- function(country, year) {
c1 <- "http://www.census.gov/population/international/data/idb/region.php?N=%20Results%20&T=10&A=separate&RT=0&Y="
c2 <- "&R=-1&C="
url <- paste0(c1, year, c2, country)
df <- data.frame(readHTMLTable(url))
keep <- c(2, 4, 5)
df <- df[,keep]
names(df) <- c("Age", "Male", "Female")
cols <- 2:3
df[,cols] <- apply(df[,cols], 2, function(x) as.numeric(as.character(gsub(",", "", x))))
df <- df[df$Age != 'Total', ]
df$Male <- -1 * df$Male
df$Age <- factor(df$Age, levels = df$Age, labels = df$Age)
df.melt <- melt(df,
value.name='Population',
variable.name = 'Gender',
id.vars='Age' )
return(df.melt)
}
nigeria <- get_data("NI", 2014)
popGHcens <- getAgeTable(country = "QA", year = 2015)
library(XML)
library(reshape2)
library(plyr)
library(ggplot2)
source('http://klein.uk/R/Viz/pyramids.R')
test <- data.frame(v=sample(1:20,1000,replace=T), g=c('M','F'))
View(test)
require(ggplot2)
require(plyr)
ggplot(data=test,aes(x=as.factor(v),fill=g)) +
geom_bar(subset=.(g=="F")) +
geom_bar(subset=.(g=="M"),aes(y=..count..*(-1))) +
scale_y_continuous(breaks=seq(-40,40,10),labels=abs(seq(-40,40,10))) +
coord_flip()
ggplot(data=test,aes(x=as.factor(v),fill=g)) +
geom_bar(data=subset(test,g=="F")) +
geom_bar(data=subset(test,g=="M"),aes(y=..count..*(-1))) +
scale_y_continuous(breaks=seq(-40,40,10),labels=abs(seq(-40,40,10))) +
coord_flip()
ggplot(data=test,aes(x=as.factor(v),fill=g)) +
geom_bar(data=subset(test,g=="F")) +
geom_bar(data=subset(test,g=="M"),aes(y=..count..*(-1))) +
scale_y_continuous(breaks=seq(-40,40,10),labels=abs(seq(-40,40,10))) +
coord_flip()
require(graphics)
x <- c(0.80, 0.83, 1.89, 1.04, 1.45, 1.38, 1.91, 1.64, 0.73, 1.46)
y <- c(1.15, 0.88, 0.90, 0.74, 1.21)
wilcox.test(x, y, alternative = "g")        # greater
data(aSAH)
roc1 <- roc(aSAH$outcome, aSAH$s100b)
## Basic example ##
ci.auc(roc1)
install.packages("pROC")
library(pROC)
data(aSAH)
roc1 <- roc(aSAH$outcome, aSAH$s100b)
## Basic example ##
ci.auc(roc1)
data(aSAH)
force(aSAH)
View(aSAH)
roc(aSAH$outcome, aSAH$s100b,
levels=c("Good", "Poor"))
data("two_class_example")
ppv(two_class_example, truth, predicted)
mydata <- read.csv("https://stats.idre.ucla.edu/stat/data/binary.csv")
View(mydata)
install.packages("survival")
install.packages("survminer")
install.packages("dplyr")
library(survival)
library(survminer)
library(dplyr)
data(cancer)
force(ovarian)
# Dichotomize age and change data labels
ovarian$rx <- factor(ovarian$rx,
levels = c("1", "2"),
labels = c("A", "B"))
ovarian$resid.ds <- factor(ovarian$resid.ds,
levels = c("1", "2"),
labels = c("no", "yes"))
ovarian$ecog.ps <- factor(ovarian$ecog.ps,
levels = c("1", "2"),
labels = c("good", "bad"))
View(ovarian)
ovarian <- ovarian %>% mutate(age_group = ifelse(age >=50, "old", "young"))
ovarian$age_group <- factor(ovarian$age_group)
surv_object <- Surv(time = ovarian$futime, event = ovarian$fustat)
ovarian$futime
surv_object
? Surv
? coxph
# Fit a time transform model using current age
coxph(Surv(time, status) ~ ph.ecog + tt(age), data=lung,
tt=function(x,t,...) pspline(x + t/365.25))
View(lung)
coxph(Surv(stop, event) ~ (rx + size + number) * strata(enum),
cluster = id, bladder1)
exp((75-45)*log(1.04))
log(1.04)
log(10)
exp(4)
? exp
log2(4)
log2(8)
log2(10)
log2(16)
Read2SNOMED <- read.delim("C:/Users/cgao001/Downloads/nhs_datamigration_29.0.0_20200401000001/Mapping Tables/Updated/Clinically Assured/codesWithValues_AlternateMaps_READ2_20200401000001.txt")
View(Read2SNOMED)
rcsctmap2_uk_20200401000001 <- read.delim("C:/Users/cgao001/OneDrive - University of Dundee/HIC research/3 hic/Sprint project/ReadCode2SNOMED/nhs_datamigration1/Mapping Tables/Updated/Clinically Assured/rcsctmap2_uk_20200401000001.txt")
View(rcsctmap2_uk_20200401000001)
View(rcsctmap2_uk_20200401000001)
sct2_Concept_UKCLDelta_GB1000000_20211124 <- read.delim("C:/Users/cgao001/Downloads/uk_sct2cldelta_32.7.0_20211124000001Z/SnomedCT_UKClinicalRF2_PRODUCTION_20211124T000001Z/Delta/Terminology/sct2_Concept_UKCLDelta_GB1000000_20211124.txt")
View(sct2_Concept_UKCLDelta_GB1000000_20211124)
sct2_Description_UKCLDelta.en_GB1000000_20211124 <- read.delim("C:/Users/cgao001/Downloads/uk_sct2cldelta_32.7.0_20211124000001Z/SnomedCT_UKClinicalRF2_PRODUCTION_20211124T000001Z/Delta/Terminology/sct2_Description_UKCLDelta-en_GB1000000_20211124.txt")
View(sct2_Description_UKCLDelta.en_GB1000000_20211124)
sct2_Description_Delta.en_INT_20210131 <- read.delim("C:/Users/cgao001/Downloads/uk_sct2cldelta_32.7.0_20211124000001Z/SnomedCT_InternationalRF2_PRODUCTION_20210131T120000Z/Delta/Terminology/sct2_Description_Delta-en_INT_20210131.txt")
View(sct2_Description_Delta.en_INT_20210131)
shiny::runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
shiny::runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
runApp('C:/Users/CGao001/OneDrive - University of Dundee/General/0. Archive/Sprint project/Shiny-APP/career-pathfinder-master')
setwd("C:/Users/CGao001/OneDrive - University of Dundee/Documents/GitHub/ScottishLabData")
source('ExemplarTestData/createTables.R')
source('./R code for data harmonisation/0_functions.R')
# initialise 'HIC' database - creates 'con' variable
initDb()
# get dummy data from db
dat <- dbGetQuery(con, "SELECT * FROM FHIR_HIC")
# create example data harmonisation object
changeCmd <- data.frame(ReadCode = '44I4.',
readCodeDescription = 'Potassium',
HIC_unit = 'mmol/L; nmol/L',
Unit = 'mmol/L',
Rule = 'if nmol/L value 1e-06')
# harmonise data by transfering units
rc = '44I4.'
View(dat)
# harmonise data by transfering units
rc = '44I4.'
t <- unitTransferFunction(dat, changeCmd,rc)
View(t)
data <- dat
unitinfor <- changeCmd
t <- unitTransferFunction(data, unitinfor,rc)
data <- data[!is.na(data$valueUnit),]        #remove na
data <- data[!is.na(data$valueQuantity),]    #remove na
rules <- strsplit(as.character(unitinfor$Rule),";")
rulenumber=1
r=rules[[1]][rulenumber]
r_u <- lapply(strsplit(as.character(r)," "),function(x) x[pmax(0,which(x=="value")-1)])
r_r <- lapply(strsplit(as.character(r)," "),function(x) x[pmax(0,which(x=="value")+1)])
dim(na.omit(data[data$code==rc & data$valueUnit==r_u,]))[1]
dim(na.omit(data[data$code==rc & data$valueUnit==r_u,]))
r_u
rc
dim(data[data$code==rc & data$valueUnit==r_u,])
data[data$code==rc & data$valueUnit==r_u,]
View(dat)
source('./R code for data harmonisation/0_functions.R')
t <- unitTransferFunction(data, unitinfor,rc)
as.double(r_r)
as.double(r_r)*100
data[data$code==rc & data$valueUnit==r_u,"valueQuantity"] <- as.double(r_r)*data[data$code==rc & data$valueUnit==r_u,"valueQuantity"]
data[data$code==rc & data$valueUnit==r_u,"valueQuantity"] <- as.double(r_r)*as.double(data[data$code==rc & data$valueUnit==r_u,"valueQuantity"])
source('./R code for data harmonisation/0_functions.R')
t <- unitTransferFunction(data, unitinfor,rc)
View(t)