Category: R code

Assorted Links

Seth Roberts5 Comments

Thanks to Anne Weiss.

Percentile Feedback Workspace Available

Seth Roberts3 Comments

I have put a requested R workspace on my website so that you can download it. The percentile feedback workspace compares your productivity (time spent working/time available to work) today to previous days. When I started using it, I became more productive. Here is an introduction. Here are all posts about it.

This is not for everyone. You need R installed to use it (of course) and you’ll need to know at least a little R. You must edit a function called save.ws so that the workspace is saved in the right place. I have used it under Windows XP.

Arithmetic Test R Code (part 4)

Seth Roberts7 Comments

>newmath2.trial
function (trial = 1, total.trials = 5, problem=newmath2.problems[1,],condition= “testing”, wait.range=c(1500,2500), num.possible=9, note = “”)
{#give one trial. returns list with components wait, answer.msec, etc.
#(“okay” or “aborted”) and results.
#
#             trial            trial number
#             total.trials     trials per session
#             problem          problem, answer (characters)
#Â Â Â Â Â Â Â Â Â Â Â Â Â condition
#             wait.range       range of wait times (msec)
#             num.possible     number of possible wait times
#Â Â Â Â Â Â Â Â Â Â Â Â Â note
#
tn=paste(“trial”,trial,”of”,total.trials)
msg=press.space.to.start(below=tn, col = “brown”)
if(msg==”end session”) return(“end session”)
wait.msec=newmath2.foreperiod(wait.range=wait.range, num.possible = num.possible)
t=newmath2.problem(problem=problem)
newmath2.feedback(problem=problem[1],answer.msec=t$answer.msec,correct=t$correct,status=t$status)
list(wait.msec=wait.msec, answer.msec=t$answer.msec,actual.answer=t$actual.answer, correct=t$correct,include=t$include,status=t$status)
}

> press.space.to.start
function (msg = “press space”, prompt = “to start”, below=””, beepf=FALSE, bottom =”press letter to end session”, col = “red”, text.size=5)
{#wait for Enter to start data collection with getGraphicsEvent
#
#             beepf    beep after input?
#
paint(center=prompt, above = msg, below=below, bottom = bottom, text.size=text.size, col = col)
msg=”get answer”
while(msg==”get answer”) {
t=getGraphicsEvent(prompt=””,onKeybd=get.key)
if(beepf) beep()
if (t==” “) msg=”okay”
if (t %in% strsplit(alphabet,split=””)[[1]]){
msg = “end session”
paint(“ending session”)
}
}
msg
}
> newmath2.foreperiod
function (wait.range=c(1000,2000), num.possible = 9)
{#delay for interval randomly selected within given range. Returns
#wait in msec
#
#         wait.range     lower and upper possible delays (msec)
#         num.possible   number of possible waits (which are equally spaced)
#
#
possible.waits=seq(from = wait.range[1],to = wait.range[2], length.out = num.possible)
wait.msec=sample(possible.waits,1)
paint(“|”,duration = wait.msec/1000)
wait.msec
}
> newmath2.problem
function (problem = c(“3+4″,”7″),status = “okay”)
{#show new arithmetic problem. Returns list of latency,
#answer, right/wrong, and note.
#
#                    problem  vector of problem and answer (both characters)
#                    status   status
#
newmath2.show(problem[1])
see.time = Sys.time()
actual.answer=getGraphicsEvent(prompt=””,onKeybd = get.key)
resp.time< <-Sys.time()
answer.msec=as.integer(1000*difftime(resp.time,see.time,unit=”sec”))
if(!actual.answer %in% as.character(c(0:9))){
actual.answer=””
answer.msec=NA
correct=NA
include=FALSE
if (an==”q”) status = “abort session” else status=”abort trial”
}
else {
correct=actual.answer==problem[2]include=TRUE
status=”okay”
}
list(answer.msec=answer.msec,actual.answer=actual.answer,correct=correct, include=include, status = status)
}
> newmath2.feedback
function (trial = 5, problem = “3+4″, actual.answer=7, status= “”, answer.msec = 639, correct = TRUE, number.back=15)
{#give feedback on trial
#
#           trial        trial number
#           problem      problem shown
#Â Â Â Â Â Â Â Â Â Â Â actual.answer actual answer (numeric)
#           correct      correct?
#           status       anything unusual?
#           answer.msec  latency of answer (msec)
#           number.back  compare this rt with how many back?
#
if(status==”abort block”){
paint(“block aborted”,duration = 1.5)
return()
}
if(status==”abort session”){
paint(“session aborted”,duration = 1.5)
return()
}
if(!correct){
paint(“wrong”,duration = 1.5)
return()
}
previous.answer.msec=newmath2$answer.msec[(problem==newmath2$problem)&newmath2$correct&newmath2$include]ptile=newmath2.ptile(answer.msec,previous.answer.msec)
ptile.msg=paste(round(ptile),”%ile”,sep=””)
whole.msg=paste(answer.msec,”ms”,ptile.msg)
paint(whole.msg, text.size = 4, col = “blue”, duration = 1)
}

> paint
function (center=””,above=””,below=””, bottom = “”, x = 0, y = 0,xlim = c(-1,1),ylim = c(-1,1),text.size=4, small.size = 2, duration = 1, col=”red”, new = TRUE)
{# write text on graph, clearing previous
#
#               center        text for middle of graph
#               above         text above that
#               below         text below that
#               bottom        small text at bottom
#               x             x location of text
#               y             y location
#Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â xlim
#Â Â Â Â Â Â Â Â Â Â Â Â Â Â Â ylim
#               text.size     cex value
#               small.size    cex value for small text
#               duration      wait (sec) before continuing
#               col           color
#               new           erase what was there?
#
if (new) plot(0,0,xlab=””,ylab=””,xaxt=”n”,yaxt=”n”,type=”n”, xlim=xlim, ylim = ylim)
text(center,x=x,y=y, cex = text.size, col = col)
text(above,x=x,y=y+.3, cex = text.size, col = col)
text(below,x=x,y=y-.3, cex = text.size, col = col)
text(bottom,x=x,y=y-.85, cex = small.size, col = col)
Sys.sleep(duration)
}

Arithmetic Test R Code (part 2)

Seth Roberts3 Comments

new.condition
function (conditions.so.far = newmath$condition)
{# get new condition name
#
#            conditions.so.far       vector of conditions so far
#
cat(“current time”,as.character(Sys.time()),”\n”)
t=as.character(tail(conditions.so.far,1)) #malfunctions without as.character
cat(“most recent condition”,t,”\nthis condition”)
condition=scan(nlines=1,what=”character”,quiet=TRUE, sep=”!”)
condition
}

> newmath2.problems
problem answer
[1,] “2*7″Â Â “4″
[2,] “1*7″Â Â “7″
[3,] “4+4″Â Â “8″
[4,] “8+5″Â Â “3″
[5,] “11-2″Â “9″
[6,] “4+6″Â Â “0″
[7,] “0*8″Â Â “0″
[8,] “0+4″Â Â “4″
[9,] “9*3″Â Â “7″
[10,] “16-9″Â “7″
[11,] “6*8″Â Â “8″
[12,] “7*6″Â Â “2″
[13,] “0+0″Â Â “0″
[14,] “10-9″Â “1″
[15,] “1*1″Â Â “1″
[16,] “8*8″Â Â “4″
[17,] “14-7″Â “7″
[18,] “5+5″Â Â “0″
[19,] “7-3″Â Â “4″
[20,] “3+5″Â Â “8″
[21,] “0+7″Â Â “7″
[22,] “4-4″Â Â “0″
[23,] “1+8″Â Â “9″
[24,] “4*1″Â Â “4″
[25,] “3*1″Â Â “3″
[26,] “3-2″Â Â “1″
[27,] “7*9″Â Â “3″
[28,] “0+8″Â Â “8″
[29,] “1*2″Â Â “2″
[30,] “9*1″Â Â “9″
[31,] “0*0″Â Â “0″
[32,] “7+1″Â Â “8″
[33,] “2-2″Â Â “0″
[34,] “4+5″Â Â “9″
[35,] “11-4″Â “7″
[36,] “4+3″Â Â “7″
[37,] “1*0″Â Â “0″
[38,] “1*4″Â Â “4″
[39,] “12-8″Â “4″
[40,] “7*1″Â Â “7″
[41,] “2-1″Â Â “1″
[42,] “4*6″Â Â “4″
[43,] “9-6″Â Â “3″
[44,] “12-3″Â “9″
[45,] “4+9″Â Â “3″
[46,] “9+4″Â Â “3″
[47,] “9*7″Â Â “3″
[48,] “15-7″Â “8″
[49,] “3*3″Â Â “9″
[50,] “8-0″Â Â “8″
[51,] “8*9″Â Â “2″
[52,] “11-8″Â “3″
[53,] “2*2″Â Â “4″
[54,] “10-2″Â “8″
[55,] “9+8″Â Â “7″
[56,] “8-4″Â Â “4″
[57,] “2+1″Â Â “3″
[58,] “8+3″Â Â “1″
[59,] “7-6″Â Â “1″
[60,] “3-3″Â Â “0″
[61,] “9*9″Â Â “1″
[62,] “8+1″Â Â “9″
[63,] “6*4″Â Â “4″
[64,] “9+9″Â Â “8″
[65,] “4*2″Â Â “8″
[66,] “6-5″Â Â “1″
[67,] “7+5″Â Â “2″
[68,] “9*0″Â Â “0″
[69,] “3*7″Â Â “1″
[70,] “8*1″Â Â “8″
[71,] “2+8″Â Â “0″
[72,] “0+2″Â Â “2″
[73,] “8+0″Â Â “8″
[74,] “5-4″Â Â “1″
[75,] “6-3″Â Â “3″
[76,] “2*0″Â Â “0″
[77,] “15-6″Â “9″
[78,] “1*9″Â Â “9″
[79,] “7-0″Â Â “7″
[80,] “12-9″Â “3″
[81,] “9+3″Â Â “2″
[82,] “4+7″Â Â “1″
[83,] “1+7″Â Â “8″
[84,] “6-4″Â Â “2″
[85,] “6+7″Â Â “3″
[86,] “0+3″Â Â “3″
[87,] “6+3″Â Â “9″
[88,] “13-5″Â “8″
[89,] “6+1″Â Â “7″
[90,] “16-8″Â “8″
[91,] “6+5″Â Â “1″
[92,] “8*6″Â Â “8″
[93,] “4*0″Â Â “0″
[94,] “5+4″Â Â “9″
[95,] “6+4″Â Â “0″
[96,] “3*9″Â Â “7″
[97,] “4+8″Â Â “2″
[98,] “5-3″Â Â “2″
[99,] “7+0″Â Â “7″
[100,] “15-8″Â “7″
[101,] “7*3″Â Â “1″
[102,] “3+7″Â Â “0″
[103,] “6+2″Â Â “8″
[104,] “4-3″Â Â “1″
[105,] “11-3″Â “8″
[106,] “9+2″Â Â “1″
[107,] “5-5″Â Â “0″
[108,] “7+6″Â Â “3″
[109,] “9+1″Â Â “0″
[110,] “1*3″Â Â “3″
[111,] “1+2″Â Â “3″
[112,] “2+0″Â Â “2″
[113,] “6-2″Â Â “4″
[114,] “13-9″Â “4″
[115,] “2*1″Â Â “2″
[116,] “9+0″Â Â “9″
[117,] “9-1″Â Â “8″
[118,] “3-0″Â Â “3″
[119,] “12-4″Â “8″
[120,] “2+9″Â Â “1″
[121,] “10-6″Â “4″
[122,] “1+0″Â Â “1″
[123,] “4-0″Â Â “4″
[124,] “0*2″Â Â “0″
[125,] “9*2″Â Â “8″
[126,] “14-5″Â “9″
[127,] “5-1″Â Â “4″
[128,] “9-5″Â Â “4″
[129,] “3+0″Â Â “3″
[130,] “17-8″Â “9″
[131,] “2+7″Â Â “9″
[132,] “5+6″Â Â “1″
[133,] “8-1″Â Â “7″
[134,] “7-5″Â Â “2″
[135,] “3+6″Â Â “9″
[136,] “6*0″Â Â “0″
[137,] “0*4″Â Â “0″
[138,] “1*8″Â Â “8″
[139,] “7-4″Â Â “3″
[140,] “7+2″Â Â “9″
[141,] “6-6″Â Â “0″
[142,] “9-9″Â Â “0″
[143,] “10-7″Â “3″
[144,] “3+1″Â Â “4″
[145,] “2+5″Â Â “7″
[146,] “5+9″Â Â “4″
[147,] “5+3″Â Â “8″
[148,] “8+6″Â Â “4″
[149,] “0*5″Â Â “0″
[150,] “0+9″Â Â “9″
[151,] “1-1″Â Â “0″
[152,] “3-1″Â Â “2″
[153,] “7*2″Â Â “4″
[154,] “7+4″Â Â “1″
[155,] “7+3″Â Â “0″
[156,] “1+1″Â Â “2″
[157,] “6+6″Â Â “2″
[158,] “9-7″Â Â “2″
[159,] “9-8″Â Â “1″
[160,] “9*8″Â Â “2″
[161,] “2*4″Â Â “8″
[162,] “8-5″Â Â “3″
[163,] “14-6″Â “8″
[164,] “9-2″Â Â “7″
[165,] “7*4″Â Â “8″
[166,] “6+8″Â Â “4″
[167,] “16-7″Â “9″
[168,] “4*3″Â Â “2″
[169,] “8+4″Â Â “2″
[170,] “8+2″Â Â “0″
[171,] “0*9″Â Â “0″
[172,] “6*2″Â Â “2″
[173,] “10-1″Â “9″
[174,] “4-2″Â Â “2″
[175,] “3*8″Â Â “4″
[176,] “4-1″Â Â “3″
[177,] “7-7″Â Â “0″
[178,] “9-0″Â Â “9″
[179,] “2*6″Â Â “2″
[180,] “12-5″Â “7″
[181,] “0-0″Â Â “0″
[182,] “0*7″Â Â “0″
[183,] “2+6″Â Â “8″
[184,] “0*6″Â Â “0″
[185,] “11-7″Â “4″
[186,] “0*3″Â Â “0″
[187,] “18-9″Â “9″
[188,] “5+2″Â Â “7″
[189,] “4+0″Â Â “4″
[190,] “8*4″Â Â “2″
[191,] “8*3″Â Â “4″
[192,] “8-8″Â Â “0″
[193,] “0*1″Â Â “0″
[194,] “7+7″Â Â “4″
[195,] “2+2″Â Â “4″
[196,] “13-6″Â “7″
[197,] “8*0″Â Â “0″
[198,] “5*0″Â Â “0″
[199,] “8+9″Â Â “7″
[200,] “3+8″Â Â “1″
[201,] “1+3″Â Â “4″
[202,] “2*9″Â Â “8″
[203,] “5-2″Â Â “3″
[204,] “10-3″Â “7″
[205,] “4*7″Â Â “8″
[206,] “8-6″Â Â “2″
[207,] “11-9″Â “2″
[208,] “1-0″Â Â “1″
[209,] “9+5″Â Â “4″
[210,] “6*7″Â Â “2″
[211,] “3*0″Â Â “0″
[212,] “10-8″Â “2″
[213,] “3*4″Â Â “2″
[214,] “1+6″Â Â “7″
[215,] “13-4″Â “9″
[216,] “3+9″Â Â “2″
[217,] “5+8″Â Â “3″
[218,] “17-9″Â “8″
[219,] “0+1″Â Â “1″
[220,] “8-7″Â Â “1″
[221,] “7*0″Â Â “0″
[222,] “5+7″Â Â “2″
[223,] “2-0″Â Â “2″
[224,] “4*8″Â Â “2″
[225,] “3+4″Â Â “7″
[226,] “1+9″Â Â “0″

> newmath2.trial
function (trial = 1, total.trials = 5, problem=newmath2.problems[1,],condition= “testing”, wait.range=c(1500,2500), num.possible=9, note = “”)
{#give one trial. returns list with components wait, answer.msec, etc.
#(“okay” or “aborted”) and results.
#
#             trial            trial number
#             total.trials     trials per session
#             problem          problem, answer (characters)
#Â Â Â Â Â Â Â Â Â Â Â Â Â condition
#             wait.range       range of wait times (msec)
#             num.possible     number of possible wait times
#Â Â Â Â Â Â Â Â Â Â Â Â Â note
#
tn=paste(“trial”,trial,”of”,total.trials)
msg=press.space.to.start(below=tn, col = “brown”)
if(msg==”end session”) return(“end session”)
wait.msec=newmath2.foreperiod(wait.range=wait.range, num.possible = num.possible)
t=newmath2.problem(problem=problem)
newmath2.feedback(problem=problem[1],answer.msec=t$answer.msec,correct=t$correct,status=t$status)
list(wait.msec=wait.msec, answer.msec=t$answer.msec,actual.answer=t$actual.answer, correct=t$correct,include=t$include,status=t$status)
}

Arithmetic Test R Code (part 3)

Seth Roberts5 Comments

> newmath2.set.types
function ()
{# set variables in newmath2 to proper types
#
newmath2$year< <-as.integer(newmath2$year)
newmath2$month< <-as.integer(newmath2$month)
newmath2$day< <-as.integer(newmath2$day)
newmath2$hour< <-as.integer(newmath2$hour)
newmath2$minute< <-as.integer(newmath2$minute)
newmath2$second< <-as.integer(newmath2$second)
newmath2$condition< <-as.character(newmath2$condition)
newmath2$trial< <-as.integer(newmath2$trial)
newmath2$wait.msec< <-as.integer(as.character(newmath2$wait.msec))
newmath2$problem< <-as.character(newmath2$problem)
newmath2$answer.msec< <-as.integer(newmath2$answer.msec)
newmath2$actual.answer< <-as.integer(newmath2$actual.answer)
newmath2$correct< <-as.logical(newmath2$correct)
newmath2$include< <-as.logical(newmath2$include)
newmath2$note< <-as.character(newmath2$note)
}
> save.ws
function ()
{
invisible()
save.image(“C:/Documents and Settings/Seth/My Documents/omega-3/tracking.RData”)
cat(“tracking workspace saved”,as.character(Sys.time()),”\n”)
}

Arithmetic Test R Code (part 1)

Seth Roberts7 Comments
[Below is some of the R code that runs the arithmetic test that I use to measure my brain function. This function (newmath2.add) is the top-level function — the function I actually call when I run the test. Later posts will give the subroutine code. The variable newmath2 is the database — the variable (a data frame) that holds the data.]

function (trials = 32, note=””, wait.range=c(1000,2000), num.possible = 9)
{#Like newmath but with separated trials.
#
#Collect data with arithmetic-like task. Simple arithmetic problems with
#the answer being a single digit. 1, 2, 3, 4, 7, 8, 9, 0 equally likely.
#If the answer is two digits (e.g., 12) it is truncated to the last digit
#(e.g., 2). The trials during each session are sampled without replacement
#from all possible problems.
#
#Trials where the response is incorrect are repeated with a new problem.
#Trials can be aborted; this is noted.
#
#              trials           trials in a session
#              note             comment for each trial
#              wait.range       range of wait times (msec)
#              num.possible     number of possible wait times
#
# 2009.07.11 Fixation symbol changed from + to o. Repetition of
# answer from one question to the next no longer allowed.
# 2009.07.15 Feedback now based only on answers to the same question
# More sophisticated computation of percentile.
# 2009.08.07 Can end session from Press Space screen
# 2009.10.23 fixed abort session and abort trial
#
invisible()
condition=new.condition(newmath2$condition)
start.time=Sys.time()
n=nrow(newmath2.problems)
problems=newmath2.problems[sample(n),]okay=c(TRUE,!problems[1:(n-1),2]==problems[2:n,2])
problems=problems[okay,]tr=1
pr=1
while(tr< =trials){
t=newmath2.trial(trial=tr, total.trials = trials, wait.range=wait.range, num.possible = num.possible, problem = problems[pr,], condition=condition, note=note)
if(t[1]==”end session”) break
if(t$status!=”okay”) {
if(t$status==”abort trial”) this.trial.note=”trial aborted”
if(t$status==”abort session”) this.trial.note=”session aborted”
t$include=FALSE
}
else this.trial.note=note
new.line1=c(current(),condition,tr,t$wait.msec, problems[pr,1])
new.line2=c(t$answer.msec,t$actual.answer,t$correct,t$include,this.trial.note)
newmath2< <-rbind(newmath2,c(new.line1,new.line2))
newmath2.set.types()
pr=pr+1
if(t$status==”abort session”) break
if(t$status==”abort trial”) next
if(!t$correct) next
tr=tr+1
}
msg=paste(“total time”,round(difftime(Sys.time(),start.time, unit=”mins”),1),”minutes\n”)
paint(above = “all done”, below=msg, duration = 3)
save.ws()
newmath2.plot()
}