Showing posts with label Concerto. Show all posts
Showing posts with label Concerto. Show all posts

Friday, February 6, 2015

Calculating the likelihood of item overlap with Base R Assessment

I have recently received an email from someone who had taken my Base R Assessment. In this email, the test taker reported that a large portion of the test items taken were duplicates (around 50%) when he took the test the second time.

I began wondering what the likelihood of this occurring would be.

The test selects between 10-20 items each time the test is taken.

These items are selected randomly.

There is around 80 items in total available.

First let us do some back of the envelope calculations.

1. Lets say the average number of test items is 15. Thus the average quantity of the test items taken is 18.75% for the first test.
2. If the same person were to take the test again then we would expect around 18.75% * 15 = 2.8 items to be duplicates.

We might want to know instead what the change of say 50% of the items administered in the second test being duplicates.

In order to do this calculation we would need to basically come up with the a list of all of the contamination of items which result in 50% overlap.

For instance, let us say that we have a ten item exam. The items that overlap are 1:5 and the items that do not are 6:10.

The probability of this outcome occurring is {first the overlap}*{those that do not overlap} : 1/80 * 1/79 * 1/78 * 1/77 * 1/76 * 74/75 * 73/74 * 72/73 * 71/72 * 70/71

Which results in a really small number. Then we would calculate the probability of the first 4 matching and last items matching: 1/80 * 1/79 * 1/78 * 1/77 * 75/76 * 74/75 * 73/74 * 72/73 * 71/72 * 1/71

Next the first three and last two and so on. You keep doing this with every possible combination. This process becomes rather tedious and time consuming pretty quickly.

However, if you are willing to undergo a little approximation bias then a much easier process is to put together a little simulation.

Let us simulate instead the process x number of times, say 100,000.

Nsim    <- 10^5
overlap <- rep(NA,Nsim)
testMin <- 10
testAdd <- 10
 
for (i in 1:Nsim) {
  testL1 <- testMin + sample(0:testAdd, 1)
  testL2 <- testMin + sample(0:testAdd, 1)
 
  first  <- sample(80, testL1)
  second <- sample(80, testL2)
 
  overlap[i] <- mean(second %in% first)
}
 
# Generate a density curve of overlap. The mode is around .2 which is just around 
# where we expected the average to be.
plot(density(overlap)) 
 
  
mean(overlap)
# [1] 0.1877303
 
# Now we can use a built in function 'ecdf' (empirical cdf) to process our 
# frequencies.
OverCDF <- ecdf(overlap)
 
# The ecdf function is pretty great! It can turn observations into probability data.
 
# We can plot our cdf curve. It is a step function because there is only a finite 
# number of possible overlap percentages possible.
plot(OverCDF, verticals = TRUE, do.points = FALSE) 
 
  
# We can also use it to calculate the likelihood of a certain level of overlap or 
# less.
 
# Say what is the likelihood of 25% or less of the items being repeated?
OverCDF(.25)
# [1] 0.76224 This is pretty high value.
 
# What about 18.75% or less of the items being repeated?
OverCDF(.1875)
# [1] 0.53936] Which is pretty close to
 
# Now we can ask the question, what is the likelihood that the user had 50% or 
# more overlap between exams.
1-OverCDF(.5)
 
#[1] 0.00212 This is a really small number and looking at it alone we might think 
# this person must have been exagerating.
 
# However, a lot of people have taken the exam (around 1,250 independent tries).
 
# Let's say each person attempts twice which gives us 625 attempts. What is the 
# probability that during one of these events someone recieved 50% or more of the 
# same items?
1-(OverCDF(.5))^650
 
# [1] 0.7482862 Which gives us a surprisingly large number.
 
# However, saying everybody took the test twice is pretty unlikely. Let's instead 
# say 100 people took the test twice.
1-(OverCDF(.5))^100
 
# [1] 0.1912173 Which is a very respectable odds. These numbers indicate that if 
# 100 people took the test twice there is a 20% chance that one person would end 
# up seeing on the second test 50% of the same items.
 
# Conversely we might want to ask the likelihood that someone would not see any 
# of the same items.
OverCDF(0)
 
# Giving about 5%.
Created by Pretty R at inside-R.org

Monday, June 17, 2013

Zombie Apocalypse Survival Test - R-Powered (using Concerto)

This test is the first attempt to seriously assess the ability of individuals to survive a zombie apocalypse.  This test is administered using the R powered open-source testing platform Concerto  developed at the University of Cambridge.

The test administers a number of questions which are expertly chosen in order to evaluate the likelihood of an individual surviving a zombie apocalypse.  The R code which powers the test be found on can be found on github.  The test makes extensive use of the RConcerto supplementary package that I am working.

The purpose of the package is to facilitate test creation using Concerto.  Many of the functions either create wrappers for concerto functions or build html objects such as the function mk.facebook(link) which takes a link and turns it into a facebook share button.

In order to implement the test, I run the code straight from a permalink created by dropbox which I demonstrate the use of in a previous post in the function dropbox.eval() which is also contained within the RConcerto package.

Please try out this test at:

Zombie Survival Test

Wednesday, May 29, 2013

Item Analysis App - Shiny Code

Here is the code for my first Shiny App! It is the one that I posted previously with a few slight revisions. You can see it at:

A Shiny R App
In order to make any sense of this I suggest you working through the tutorial (http://www.rstudio.com/shiny/) it would be also useful to apply for beta access to the rstudio server which provides free hosting for experimental shiny applications. To make the code below work you would need two files server.R and ui.R. Read the tutorial and you will understand their importance. After reading the tutorial and playing around a little I was able to create the following app. Hope you can do the same!
Visual Reasoning Test v0.2b


Please post as comments links to apps you have developed as well.  Also, feel free to use the data as needed.  It should continue to be updated as more people keep taking the test.


Francis

Code can be found at:

https://github.com/EconometricsBySimulation/2013-05-29-ShinyApp.git



Please tell me if I am doing this github thing wrong.  Should I have a different repo every post?
 

# server.R
library(shiny)
 
# For this app I will load in data form the visual reasoning test that I posted to this blog last week (Visual Reasoning Test Link).
 
# We have had a great deal of responses so the data is getting pretty rich!  Thanks so much :)

# I will come back to this generously generated data later!
  # Load the item response data into memory with this somewhat odd formation. con = url("http://concerto4.e-psychometrics.com/media/13/Visual.Reasoning1.RData") load(file=con) close(con) nrow(individual.responses)   # I specify input$obs initially for debugging purposes. Once this loads up on the server it is overwritten by the GUI. input = list(obs=27)   # Make a vector of values to identify the session ID for each test taker respondents = unique(individual.responses$sessionID)   # barplot(table(item.disp$user.answer), main="User Responses")     ### Item Analysis   # Create a vector of item names items = unique(individual.responses$item)   # Calculate some values that will be useful later responses.mean = tapply(individual.responses$anscorrect, individual.responses$item, mean) responses.count = tapply(individual.responses$anscorrect, individual.responses$item, length)   sum.responses = data.frame(items, mean=responses.mean, count=responses.count)   # hist(sum.responses$mean, breaks=12, col=grey(.4), main="Histogram of Item Difficulties", xlab="Probability of Correct Response")   # This function takes the min of a vector and that of a scalar or two vectors of equal length. tmin = function(v1,v2) { r = NULL if (length(v2)==1) v2=rep(v2,length(v1)) for (i in 1:length(v1)) r[i] = min(v1[i],v2[i]) return(r) } # A couple of examples tmin(1:10,5) tmin(1:10,10:1)   # END SERVER STARTUP   # Define server logic required to summarize and view the selected dataset shinyServer(function(input, output) {   # Generate a summary of the item output$summary <- renderPrint({   # I want to calculate what percent of the item responses got it right and out of all responses how that compared with other items. correct.mean = round(mean(responses.mean[input$obs]),2) percentile = round(mean(responses.mean<correct.mean),2)   dataset = individual.responses[individual.responses$item==input$obs,] loading = max(table(dataset$answer)/sum(table(dataset$answer)))   # I will save a number of text bits to combine together to a single text summary of the item. text0 = paste0("Item ", input$obs, ":\n")   text.5 = paste0("This item was taken by ", responses.count[input$obs], " respondents. ")   text1 = "This was a very easy item. As much as " if ((percentile<.80)) text1 = "This was an easy item. As much as " if ((percentile<.60)) text1 = "This was an average item. About " if ((percentile<.40)) text1 = "This was a hard item. Only " if ((percentile<.20)) text1 = "This was a very hard item. Only "   text2 = paste0(round(correct.mean,2)*100,"% of people got it correct, putting it in the ", 100-percentile*100, " percentile in terms of difficulty.")   text3 = "" if ((loading > .5) & (correct.mean<.5)) text3 = paste0(" Note that there is a large loading on a response ", round(loading,2)*100 ,"% which is not the correct one. This probably indicates that there is something wrong with this problem.")   cat(paste0(text0,text.5,text1,text2, text3)) })   # Plot Item Difficulty output$distPlot <- renderPlot({ hist(responses.mean, xlab="Probability of Correct Response", main="Difficulty Distribution") abline(v=responses.mean[input$obs], lwd=3, col="red") })   # Send item preview to the control bar output$preImage = renderImage({ # When input$n is 3, filename is ./images/image3.jpeg filename = normalizePath(file.path('Images', paste0('Q', input$obs, '.png'))) # Return a list containing the filename and alt text list(src = filename, alt = paste("Image number", input$obs)) }, deleteFile = FALSE)   # Graph bar graph of responses output$respPlot <- renderPlot({ # Grab a subset of the item.response data to display dataset = individual.responses[individual.responses$item==input$obs,]   # Set up the output for the plots that we would like. par(mfrow=c(1,2))   # Select the color of the bar which if the right answer to be red. barcol = c("grey", "grey", "grey", "grey", "grey") barcol[sort(unique(individual.responses$correct))==dataset$correct[1]]="red" barplot(table(dataset$answer), col=barcol, main=paste0("Correct Response=",dataset$correct[1]))   # Calculate the average number of correct responses per ten items. avg.correct = tapply(dataset$anscorrect, ceiling((1:length(dataset$correct))/10), mean) # Plot those respones over time. plot(avg.correct, xaxt = "n", type="b", ylab="", xlab="", main="Performance over time", ylim=c(0,1)) # Change the x axis to have custom tick labels. navgs = length(avg.correct) axis(1, at=1:length(avg.correct), paste0(1+(1:length(avg.correct)-1)*10,"/", (tmin((1:length(avg.correct))*10,length(dataset[[1]]))))) })   # Show a table of all of the item response values. output$view = renderTable({ # Select the subset of data that pertains to the item selected. dataset = individual.responses[individual.responses$item==input$obs,] rownames(dataset) <- 1:nrow(dataset) dataset$ip <- dataset$item <- dataset$id <- NULL dataset }, digits=0) })

# ui.R
library(shiny)
 
# Define UI for dataset viewer application
shinyUI(pageWithSidebar(
 
  # Application title.
  headerPanel("Visual Reasoning - Item Response Evaluation"),
 
  # This is the left hand panel.
  sidebarPanel(
    # This image is just loaded from another image and placed as a thumbnail into the shiny GUI.
      imageOutput("preImage", width = "100px", height = "100px"),
 
    # This allows the user to specify what the look of this input device will be.
    # In this case a slider that has a min of 1 and max of 92.
    sliderInput("obs", "Choose Item:", 
                min = 1, max = 92, value = 1, step= 1, 
                ticks=c(1,25,50,75,92) , animate=TRUE), 
 
    # This is the histogram of item difficulty
    plotOutput("distPlot", height = "300px"),
 
    # This displays text below the histogram
    helpText("Though histograms are organized into bins we know exactly in the range from 0 to 1 where this particular item falls.")          
  ),
 
  # Now let's define the main panel.
  mainPanel(
    # Display the title.
    h4("Item Summary"),
    # Display the item summary table.
    verbatimTextOutput("summary"),
 
    # Display sub heading.
    h4("User Responses"),
    # Display user response table.
    plotOutput("respPlot", height = "300px"),
    # Display the note.
    helpText("Note: Answer values are masked to mitigate potential cheating."),
 
    # Display sub heading
    h4("Observations"),
    # Display the table output of item responses.
    tableOutput("view"),
 
    helpText("Order is the order that the item was given in in this particular user's experience.")  
  )
))

Syntax Highlighting by Pretty R at inside-R.org

Friday, May 24, 2013

Shiny + Concerto = YES !!!

So I have finally gotten beta access to the two most powerful R controlled web application makers in existence and produced very exciting experimental products

A few posts ago I posted a Visual Reasoning Test that I had made by hand and powered with Concerto.  I posted a bit of the Concerto R code in order for people to get a feel for how Concerto 4.0 beta works. Of those who saw the post, about 300 people chose to start the test. Of those those 300, 60 generous
Shiny- Item Response Evaluation App
volunteers completed the entire exam (which took between 20 and 50 minutes depending upon how hard the user was trying).

Since each test is 22 items long, I now have data on about 2000 responses to individual items.  This gives me on average about 20 responses per item though some items have substantially more and others less.  If you have not taken the opportunity to take this exam, this might be a good chance though I will come back to it with future revisions.

I understand that many a test taker or non-test taker may be curious about the results of this test so I have made an analysis tool using Shiny R.  This test tool is a dynamic test tool this allows users to look at the individual items and how the difficulty of those items compares with that of other items.

If you have not yet had the chance to take a look at Shiny R, I suggest you do so.  The application, developed by the RStudio team is awesome.   Through a handful of commands users are able to create a fully interactive web application leveraging R's power and flexibility.

Visual Reasoning Test v0.2b 
The dynamic interface that Shiny allows users to design makes high powered analysis easy to systematize and enjoyable.

Concerto takes a bit more work but it also is more flexible.  It allows for complex interfaces that users interact with sequentially.  Concerto can easily manage keeping track of a user identity system and has database management tools which make it a very attractive option.  Combining the two, as I have done, I believe gives developers some serious power to work with.

In this Concerto and Shiny paired application I give the test to the user via Concerto.  After the test is done, I make the results of the test in terms of how others did on the items available through Shiny.  How this is accomplished is that Concerto saves a copy of the responses in a file in on the concerto server every time a user completes the test.  Likewise, every time a user access the Shiny web application, Shiny pulls the latest item response data from the Concerto server.

It then does some basic transformations on that data and then provides the data in various forms through the Shiny generated user interface.
Shiny- Item Response Evaluation App
As no doubt is embarrassingly clear, I am very exciting about these new (free!) products entering the market.    I will continue to work with both of them.  Keep tuned on for future posts.

Monday, May 20, 2013

Non-Verbal Reasoning Test - Concerto

I have just released my first complete test of non-verbal problem solving skills.  It is run on Concerto (an R-based application development platform targeted at primarily test developers)  Try it out by following the link below.


I will release the code for the test in a series of posts with explanation of how it all works.

Please take a look at the test.  Obviously I am not an item developer though I wrote all of the items on the test so you might find yourself very annoyed by how the test works.  Please do your best.

In this post I will release the first bit of code that deals with the introduction page that requires an agreement box to be checked in order to allow the user to proceed.


# Concerto R-script for the agree template
  # Set agree to zero to indicate that the user has not yet agreed
agree = 0
  # message is the message I will use to order the user to hit the agree box.
message = ""
  # Now for the while loop which will not end until agree is no longer 0
while (agree == 0) {
    # This is the first concerto specific function.  It tells concerto to call the "IntroCAThandmade" template and pass to it the parameter message.  See below the html for the "IntroCAThandmade" template.  By making check equal to the function it is passing the returns from the function which is a list to the variable agree.check.
  agree.check = concerto.template.show("IntroCAThandmade", param=list(Message=message))
    # I set message to equal "you must agree" no matter what because message will only be used again if the while loop starts the loop again which only happens if the user failed to click "I agree".
  message="You must agree!"
    # To decide if the user has agreed we check whether the user has agreed to our terms of use we look at the variable agree.check$chk_agree which either exists or does not.  If it exists then it means the check box was selected.  If it does not then it means the check box was not selected.
  if (!is.null(agree.check$chk_agree)) agree=1
}
# Pretty straightforward right?
Syntax Highlighting by Pretty R at inside-R.org


HTML template for the introduction page called "IntroCAThandmade".  See what it looks like by running the test and looking at the first page.

<p style="text-align: center;"><strong>Visual Problem Solving Skills Adaptive Test</strong> v0.1beta</p>

<p><span style="line-height: 1.6em;">You will be given a series of visual problem solving skills tasks. &nbsp;</span></p>

<p>Please note, this is a <strong>hard </strong>and&nbsp;<strong>annoying </strong>test. &nbsp;Most people only get through about half of it at best!</p>

<p>Every time someone takes the exam they will recieve a different test with a different set of items.</p>

<p>Question difficulty does not reflect how well you are doing on the test.</p>

<p>In a single sitting you will recieve 22 items (the first 2 are practice and not graded).</p>

<p>Do your best. &nbsp;Your effort makes a difference.</p>

<p>Please do not cheat or give the items to others.</p>

<p>Items/problems/material are all copyrighted.</p>

<p style="text-align: center;"><span style="color:#008000;"><span style="font-family:comic sans ms,cursive;"><strong><span style="font-size:14px;">{{Message}}</span></strong></span></span></p>

<p><input name="chk_agree" type="checkbox" value="1" />I agree not to cheat, steal, or complain. &nbsp;Cheers!&nbsp;</p>

<p style="text-align: center;"><input name="btn_start" type="button" value="Unleash the Test!" /></p>

Thursday, May 2, 2013

Concerto Simple Demonstration Test v4.b

# This is my first attempt to post a example of a test using Concerto 4 beta.


# This is an extremely simple test.  Too simple to be useful to most people yet I believe it is didactically helpful.


The Following is the HTML code for Template 9. It is the form that the user first inputs answers to the three questions.

Template Description/Name: FixedSimpleQuestions

<p>Please Answer:</p>

<!--This displays each question.  The important thing to notice is the name of each text box, txt_1, txt_2, and txt_3-->
<p>1. 1+1=<input name="txt_1" type="text" /></p>

<p>2. 2+2=<input name="txt_2" type="text" /></p>

<p>3. 3+3=<input name="txt_3" type="text" /></p>

<p><input name="done" type="button" value="done" />​</p>


The Following is the HTML code for Template 10. It is the form that the user receives feedback from.

Template Description/Name: FixedSimpleResults

<p>You got questions:</p>

<!-- Notice the values in {{}}.  These are the parameters passed to this template -->

<p>1. {{score1}}</p>

<p>2. {{score2}}</p>

<p>3. {{score3}}</p>


# The Following is the R code that the test actually uses to run.

# We can see how R controls the flow of the user interface.

# Concerto Simple Test 1

# We call template 9, FixedSimpleQuestions, to be shown.  It can either be referenced by the template number of the name of the template.
items = concerto.template.show("FixedSimpleQuestions")

# Check if the items results are correct.  We can see that the responses to the items from the first template are saved within the list object item with the names txt_1, txt_2, and txt_3.
TF1 = items$txt_1==2
TF2 = items$txt_2==4
TF3 = items$txt_3==6

# Show the results to the user by feeding our item values as parameters back into the second template.
concerto.template.show("FixedSimpleResults", params=list(score1=TF1, score2=TF2, score3=TF3))

# I hope this gives you a feel for how easy it is to use Concerto to handle web based inputs.

# A powerful feature of Concerto is that it has functions that and query and modify tables using My SQL.

# More in future posts.

# I used an HTML encoder to translate my html code to post into blogger.

Tuesday, April 23, 2013

Concerto v4.b web-based Content Management System for R Users


Concerto is a open source R Content Management System for developing online applications.  The primary purpose of Concerto is for the designing of online tests.  However, the hard working programmers at the University of Cambridge Psychometrics Centre have created a program that is flexible enough to address a wide range of applications such as the development of statistical learning tools, client management systems, as well as large scale survey deployment.  Future plans for Concerto would include the integration of it and the Psychometric's Center's facebook App which has collected detailed information for millions of respondents spanning a number of fascinating surveys.

The real beauty of Concerto is that it provides an interface that builds on the vast resources of R in order to seamlessly integrate a powerful environment capable of managing the enormous contributions of web developers.

Well, enough advertising.  Let's see how v4b works.

In this post I will map out the logic of Concerto environment as I understand it now.  I will flesh out more in future posts as I get a better grasp of the Concerto environment.

For this post and all future posts I will look only at version 4b of Concerto or higher.

For the test developer the base operating system is R.  For now I will use pseudo R-like code.  Pseudo code is useful at explaining coding concepts.

First we start with an initialization of a “test”.  Tests are made up of R code.

# START – pseudo code random item survey
# The first thing a test might do is have a user input demographic information.
1.> intro = Concerto.html.tempate(Introduction)

# The responses from the Introduction page are returned as a list assigned to the Intro object.
# This responses might include any kind of information like: age, name, gender, ect.  We can target the values the same way as any list object.
2> print(intro$age)

# Interestingly this command does not actually do anything as far as the user is concerned because the screen output from R is suppressed.  However in debugging mode screen returns from R are displayed in the testing window.
# We may write the information we have gathered so far to our user information table which is a sql table. Concerto R is able to send commands to sql.  Remember this is only pseudo-code.
3> Concerto.sql.send(user_table, user_name=intro$user.name, user_age=intro$user.age)

# Now let’s administer our test items.  Let’s say we have all of our items in a table.
4> items = concerto.sql.get(items)

# We can figure out how many we are by counting the rows.
5> nitems = nrows(items)

# We want to select 20 items randomly so that almost nobody shares item sets.
6> item.choice = sample(1:nitems, 20)

# Now to administer the items we simply send them to the user by looping through all of them.
7> response.vector = NULL
8> for (i in item.choice) response=c(response, Concerto.html.tempate(item.admin, params=list(text=items$text[i]))

# Now we have two vectors.  A vector of item responses and a vector of items administered.
# All that is left is to save this response pattern
9> Concerto.sql.send(response_table, items=item.choice, responses=response.vector)

# And provide the user with some feedback
10> feedback = feedback.analysis(item.choice, response.vector)

# Now we simply display the results of this feeback analysis (this of course would be a function that we have already coded.
11> concerto.html.template(Feedback)

# END – pseudo code random item survey

In future posts I will strive to post functioning code and functioning tests.  To learn more about Concerto check out the development website:
https://code.google.com/p/concerto-platform/

Tuesday, March 12, 2013

Non-verbal Reasoning Test Construction - Part 1 Shape Creation

# R script

# I have been interested in developing a non-verbal reasoning test.  In the next few posts I will go through the code I used to generate a little over 300 items.

# First I defined a number of transformations which I will
flip = function(z) z*-1

# Two commands to flip the images horizontally or vertically
hflip = function(Z) cbind(flip(Z[,1]), Z[,2])
vflip = function(Z) cbind(Z[,1], flip(Z[,2]))

# Commands to rotate the images 90 degrees clockwise or counterclockwise
rotateCC = function(Z) cbind(Z[,2], flip(Z[,1]))
rotateC = function(Z) -1*cbind(Z[,2], flip(Z[,1]))

# A command to rotate the coordinates 180
rotate180 = function(Z) Z*-1

# This command centers a vector so that the mean of all of the elements is zero 0
center = function(z) z-mean(c(min(z),max(z)))

# This function centers the matrix Z at zero for each column
Center = function(Z) cbind(center(Z[,1]),center(Z[,2]))
# This function scales and centers and object do that after centering the object the largest radius of any part of the object from the center is .5.
CenterScale = function(Z) Center(Z)/(2*max(abs(Center(Z))))

# This function makes the distance from any object from the 0,0 center to be unit 1 at the farthest point.
unitize = function(Z)  Z/max((Z[,1]^2+Z[,2]^2)^.5)

# This useful function samples i random draws without replacement from the vector V
rsample = function(V,i) V[order(runif(length(V)))][1:i]

# This function draws the coordinates for a polygon from the unit circle with number of sides equal to i.  If there is less than 3 sides specified then the number of sides is set to 50 making the polygon approximate a circle.
pgon = function(i, p=0, xscale=1) {
  if (i<3 i="50</p">  cbind(sin(pi*2*(1:i+p)/i)*xscale, cos(pi*2*(1:i+p)/i))/2
}

# This function draws a star with the number of points equal to i.
star = function(i, p=0) {
    pg1 = pgon(i,p)
    pg2 = pgon(i,.5+p) * .25

    pg = rbind(pg1[1,],pg2[1,])
 
    for (j in 2:i) pg = rbind(pg, pg1[j,],pg2[j,])
    pg
}

# This function draws a rectangle.  Speficy the rotation and it will construct the rectangle from around the unit circle.
rectangle = function(rad=.1) rbind(c(cos(rad),sin(rad)),
                                    c(-cos(rad),sin(rad)),
                                    c(-cos(rad),-sin(rad)),
                                    c(cos(rad),-sin(rad)))*.5

# This function will draw a cross.  Specify the starting location in the same manner as the rectangle.
cross = function(rad=.1) {
  S = cos(rad*pi)
  C = sin(rad*pi)
  sreturn= rbind(c(C,S),c(-C,S),c(-C,C),c(-S,C),c(-S,-C),c(-C,-C),
        c(-C,-S),c(C,-S),c(C,-C),c(S,-C),c(S,C),c(C,C))
  unitize(sreturn)*.5
  }

# Create a shape vector
shape_count=23
shape_vect = (1:23)[order(runif(shape_count))]
shape_vect = (1:23)

# Shape generating function
shape = function(shape_num=NA, sposition=c(0,0), size=1, dot=1, sdir=1) {
  sreturn=c(0,0)
  if (shape_num==shape_vect[1])  sreturn = pgon(1)
  if (shape_num==shape_vect[2])  sreturn = pgon(3)
  if (shape_num==shape_vect[3])  sreturn = pgon(4)
  if (shape_num==shape_vect[4])  sreturn = pgon(4,xscale=3)
  if (shape_num==shape_vect[5])  sreturn = pgon(4,.5)
  if (shape_num==shape_vect[6])  sreturn = pgon(5)
  if (shape_num==shape_vect[7])  sreturn = pgon(6,.5)
  if (shape_num==shape_vect[8])  sreturn = pgon(7)
  if (shape_num==shape_vect[9])  sreturn = pgon(8,.5)
  if (shape_num==shape_vect[10]) sreturn = star(3)
  if (shape_num==shape_vect[11]) sreturn = star(4,.5)
  if (shape_num==shape_vect[12]) sreturn = star(5)
  if (shape_num==shape_vect[13]) sreturn = star(6,.5)
  if (shape_num==shape_vect[14]) sreturn = rectangle(.2)
  if (shape_num==shape_vect[15]) sreturn = rectangle(1.8)
  if (shape_num==shape_vect[16]) sreturn = cross(.075)
  if (shape_num==shape_vect[17]) sreturn = cross(.4)
  if (shape_num==shape_vect[18]) sreturn = pgon(1,xscale=.5)
  if (shape_num==shape_vect[19]) sreturn = pgon(3,xscale=.3)
  if (shape_num==shape_vect[20]) sreturn = pgon(3,xscale=3)
  if (shape_num==shape_vect[21]) {
                        sreturn = pgon(1)[pgon(1)[,2]<.1,]
                        sreturn = cbind(sreturn[,1],sreturn[,2]+.3)
                      }

  if (shape_num==shape_vect[22]) {
                        sreturn = pgon(1)[pgon(1)[,1]<.1,]
                        sreturn = cbind(sreturn[,1]+.3,sreturn[,2])
                      }
                   
   if (shape_num==shape_vect[22]) {
                        sreturn = pgon(1)[pgon(1)[,1]<0 p="">                        sreturn.reverse = sreturn[nrow(sreturn):1,]
                        sreturn.reverse[,1] = sreturn.reverse[,1]*.5
                        sreturn = rbind(sreturn,sreturn.reverse)
                        sreturn = cbind(sreturn[,1]+.3,sreturn[,2])
                      }                  
  if (shape_num==shape_vect[23]) {
                        sreturn = pgon(1)[(pgon(1)[,1]>=0)&(pgon(1)[,2]>=0),]
                        sreturn = rbind(sreturn,0)
                     
                        sreturn = cbind(sreturn[,1]-.2,sreturn[,2]-.2)
                      }

  sreturn = unitize(sreturn)*size
  if (dot==1) sreturn = rbind(sreturn, cbind(NA,NA), size*(pgon(1)*.1+.75))

  # Rotate
  if (sdir==2)  sreturn=rotateCC(sreturn)
  if (sdir==3)  sreturn=rotateC(sreturn)
  if (sdir==4)  sreturn=rotate180(sreturn)

  sreturn=cbind(sreturn[,1]+sposition[1],sreturn[,2]+sposition[2])

  sreturn
}

# Plot a complete list of all of the shapes
par(mfrow=c(1,1))
plot(c(-1,1),c(-1,1), type="n")
for (i in 1:shape_count) {
  polygon(shape(i, c(sin(i*2*pi/shape_count),cos(i*2*pi/shape_count))*.9,size=.11), col="red", border="black")
  text(sin(i*2*pi/shape_count)*.9,cos(i*2*pi/shape_count)*.9,i,cex=2)
  }
for (i in 1:shape_count) polygon(shape(i,size=.7))


# This is an example of the 23 shapes available to be generated from the above code.

# I hope someone finds it useful.  In the next post I will show how I used the generated shapes to generate a set of problems intended to provide a test for visual reasoning.