Skip to content

Instantly share code, notes, and snippets.

@inkhorn
inkhorn / gist:2151594
Created March 21, 2012 19:18
Concordance Function for Logistic Regression Models in R
# Assuming the input is a stored binomial GLM object
Concordance = function(GLM.binomial) {
outcome_and_fitted_col = cbind(GLM.binomial$y, GLM.binomial$fitted.values)
# get a subset of outcomes where the event actually happened
ones = outcome_and_fitted_col[outcome_and_fitted_col[,1] == 1,]
# get a subset of outcomes where the event didn't actually happen
zeros = outcome_and_fitted_col[outcome_and_fitted_col[,1] == 0,]
# Equate the length of the event and non-event tables
if (length(ones[,1])>length(zeros[,1])) {ones = ones[1:length(zeros[,1]),]}
else {zeros = zeros[1:length(ones[,1]),]}
@inkhorn
inkhorn / lengthby.r
Created March 27, 2012 02:05
LengthBy
LengthBy = function(y, x) {
tapply(!is.na(y), x, sum) }
@inkhorn
inkhorn / dfsample.r
Created March 28, 2012 00:36
Simple Function to Sample Rows from a Data Frame in R
df.sample = function(df.in, n) {
return(df.in[sample(nrow(df.in), size=n),])
}
@inkhorn
inkhorn / df_sample_exIDs.r
Created March 30, 2012 13:08
Function to Sample Rows from a Data Frame Excluding the ID Values from Another Sample Data Frame
# This function assumes that you're going to input ID1.name and ID2.name as strings.
df.sample.exIDs = function(main.df, sample1.df, n, ID1.name, ID2.name) {
main.ID1.notin.ID2 = main.df[!main.df[,ID1.name] %in% sample1.df[,ID2.name],]
sample2.df = main.ID1.notin.ID2[sample(nrow(main.ID1.notin.ID2), size=n),]
return(sample2.df)
}
@inkhorn
inkhorn / fmatchresults
Created April 2, 2012 19:09
Fuzzy Matching Results
Call:
glm(formula = Probable.Match. ~ First.Name.Match + Spouse.First.Name.Match:Spouse.Last.Name.Match +
Parenthetical + Ampersand, family = binomial(logit), data = fuzzy.matching)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.9371 -0.2437 -0.1136 -0.0462 3.3885
Coefficients:
Estimate Std. Error z value Pr(>|z|)
@inkhorn
inkhorn / safe.max.r
Created April 29, 2012 01:39
Max Function that Returns NA when vector is full of NAs
safe.max = function(invector) {
na.pct = sum(is.na(invector))/length(invector)
if (na.pct == 1) {
return(NA) }
else {
return(max(invector,na.rm=TRUE))
}
}
@inkhorn
inkhorn / chisq_mining.r
Created May 2, 2012 00:40
Scripted example of using chisq to mine for relations between nominal variables
testvars = c(6,7,9,10,11,12,13,14,16, 17,18,19,20,21,23,24,25,26,384,375,376,386,385,387,388)
resultlist = c()
for (i in testvars) {
xsq = chisq.test(big.dataset[,i], big.dataset$DV_3lvls)$statistic
varname = names(big.dataset)[i]
tab = xtabs(~DV_3lvls + big.dataset[,i], data=big.dataset)
resultlist = rbind(resultlist, list(chisq=xsq, testvar=varname, xtab=tab))
}
@inkhorn
inkhorn / dedupe_records_w_less_info.r
Created May 4, 2012 01:42
Scripted example in R of removing records with duplicate IDs but are missing other info
# These column numbers represent fields with name/contact info that I've
# marked with 1s and 0s depending on whether or not there's anything in
# the field.
bio_cols = c(5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,23,24,25,26)
# Now we get the row numbers of all the records with duplicate IDs
dupe_id_rows = which(duplicated(big.dataset$ID) == TRUE)
@inkhorn
inkhorn / crossbarminmax.r
Created June 10, 2012 02:33
min median max crossbar with dots
scents = read.table("clipboard",header=TRUE,sep="\t")
strial3.by.sex.wide = ddply(scents, 'Sex', function (x) quantile(x$S.Trial.3, c(0,.5,1), na.rm=TRUE))
strial3.by.sex.smokers = melt(ddply(subset(scents,Smoker == "Y") , 'Sex', function (x) quantile(x$S.Trial.3, c(0,1), na.rm=TRUE)),variable.name="Percentile",value.name="Time")
ggplot() + geom_crossbar(data=strial3.by.sex.wide, aes(x=Sex, y=strial3.by.sex.wide$"50%", ymin=strial3.by.sex.wide$"0%", ymax=strial3.by.sex.wide$"100%"),fill="#bcc927",width=.75) +
geom_point(data=strial3.by.sex.smokers, aes(x=Sex, y=Time, stat="identity"), size=3)
+ opts(legend.title = theme_text(size=10, face="bold"), legend.text = theme_text(size=10),
axis.text.x=theme_text(size=10), axis.text.y=theme_text(size=10,hjust=1), axis.title.x=theme_text(size=12,face="bold"), axis.title.y=theme_text(size=12, angle=90,
face="bold")) + scale_y_continuous(name="Time to Completion")
@inkhorn
inkhorn / penultimax.r
Created September 14, 2012 01:45
Find the second highest value in a vector
penultimax = function(invector) {
# If the vector starts off as only having 1 or 0 numbers, return NA
if (length(invector) <= 1) {
return(NA)
}
first.max = safe.max(invector)
#Once we get the max, take it out of the vector and make newvector
newvector = invector[!invector == first.max]
#If newvector now has nothing in it, return NA
if (length(newvector) == 0) {