upload appendix E

.Rhistory

@@ -0,0 +1,391 @@
+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)