Using Tcl_ListObj and his friends

This page compares lsort with some alternative optimized commands to sort a integer list. The purpose is to compare different ways to handle Tcl_ListObj's fast. The sort is not so much of interest, but more the performance handling a list in C(++).

Code

#include <tcl.h>
#include "Run.h"

#include <vector>
#include <algorithm>
#include <sstream>


void sort(std::vector<int>& vec)
{
	//std::sort(vec.begin(), vec.end());
}

void sort(int* begin, int* end)
{
	//std::sort<int*>(begin,end);
}

int Run_ObjCmd1(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[]);
int Run_ObjCmd2(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[]);
int Run_ObjCmd3(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[]);
int Run_ObjCmd4(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[]);
int Run_ObjCmd5(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[]);


int Run_Init(Tcl_Interp *interp)
{
	if (Tcl_InitStubs(interp, "8.0", 0) == NULL) {
		return TCL_ERROR;
	}
	if (Tcl_PkgProvide(interp, "run", "0.1") != TCL_OK) {
		return TCL_ERROR;
	}
	
	// use Tcl_ListObjIndex
	Tcl_CreateObjCommand(interp, "::run::run1", Run_ObjCmd1,
		NULL, (Tcl_CmdDeleteProc*)NULL);

	// use Tcl_ListObjGetElements
	Tcl_CreateObjCommand(interp, "::run::run2", Run_ObjCmd2,
		NULL, (Tcl_CmdDeleteProc*)NULL);

	// use Tcl_SetResult (string interface) instead of Tcl_SetObjResult
	// (rest run2)
	Tcl_CreateObjCommand(interp, "::run::run3", Run_ObjCmd3,
		NULL, (Tcl_CmdDeleteProc*)NULL);

	// use std::vector<int>::reserve
	// (rest run2)
	Tcl_CreateObjCommand(interp, "::run::run4", Run_ObjCmd4,
		NULL, (Tcl_CmdDeleteProc*)NULL);

	// use int[] instead of std::vector 
	Tcl_CreateObjCommand(interp, "::run::run5", Run_ObjCmd5,
		NULL, (Tcl_CmdDeleteProc*)NULL);

    return TCL_OK;
}



int Run_ObjCmd5(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[])
{
	
	if (objc != 2)
	{
		Tcl_WrongNumArgs(interp, 1, objv, "list");
		return TCL_ERROR;
	}
	
	int length;
	if (Tcl_ListObjLength(interp, objv[1], &length) != TCL_OK)
		return TCL_ERROR;

	if (!length)
		return TCL_OK;


	Tcl_Obj** elem;
	int x;

	if (Tcl_ListObjGetElements(interp, objv[1], &length, &elem) != TCL_OK)
		return TCL_ERROR;

	int* pInt = new int[length];
	int* pIter = pInt;

	for (int i = 0; i < length; ++i,++elem,++pIter)
	{
		if (Tcl_GetIntFromObj(interp, *elem, &x) != TCL_OK)
		{
			delete[] pInt;
			return TCL_ERROR;
		}
		*pIter = x;
	}

	sort(pInt,&pInt[length]);
	
	Tcl_Obj* listPtr = Tcl_NewListObj(0,NULL); 
	pIter = pInt;
	for (int i = 0; i < length; ++i,++pIter)
	{
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(*pIter));
	}

	delete[] pInt;

	Tcl_SetObjResult(interp,listPtr);	
	return TCL_OK;
}
int Run_ObjCmd4(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[])
{
	
	if (objc != 2)
	{
		Tcl_WrongNumArgs(interp, 1, objv, "list");
		return TCL_ERROR;
	}
	
	int length;
	if (Tcl_ListObjLength(interp, objv[1], &length) != TCL_OK)
		return TCL_ERROR;

	if (!length)
		return TCL_OK;


	std::vector<int> sort_int;
	sort_int.reserve(static_cast<std::vector<int>::size_type>(length));
	Tcl_Obj** elem;
	int x;

	if (Tcl_ListObjGetElements(interp, objv[1], &length, &elem) != TCL_OK)
		return TCL_ERROR;

	for (int i = 0; i < length; ++i,++elem)
	{
		if (Tcl_GetIntFromObj(interp, *elem, &x) != TCL_OK)
			return TCL_ERROR;

		sort_int.push_back(x);
	}

	sort(sort_int);

	std::vector<int>::const_iterator iter;

	Tcl_Obj* listPtr = Tcl_NewListObj(0,NULL); 

	for (iter = sort_int.begin(); iter != sort_int.end(); ++iter)
	{
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(*iter));
	}

	Tcl_SetObjResult(interp,listPtr);	
	return TCL_OK;
}

int Run_ObjCmd3(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[])
{
	
	if (objc != 2)
	{
		Tcl_WrongNumArgs(interp, 1, objv, "list");
		return TCL_ERROR;
	}
	
	int length;
	if (Tcl_ListObjLength(interp, objv[1], &length) != TCL_OK)
		return TCL_ERROR;

	if (!length)
		return TCL_OK;


	std::vector<int> sort_int;

	Tcl_Obj** elem;
	int x;

	if (Tcl_ListObjGetElements(interp, objv[1], &length, &elem) != TCL_OK)
		return TCL_ERROR;

	for (int i = 0; i < length; ++i,++elem)
	{
		if (Tcl_GetIntFromObj(interp, *elem, &x) != TCL_OK)
			return TCL_ERROR;

		sort_int.push_back(x);
	}

	sort(sort_int);

	std::vector<int>::const_iterator iter;

	Tcl_ResetResult(interp); 
	std::stringstream list_str;

	for (iter = sort_int.begin(); iter != sort_int.end(); ++iter)
	{
		list_str << " " << *iter;
	}
	
	Tcl_SetResult(interp, const_cast<char *>(list_str.str().c_str()), TCL_VOLATILE);

	return TCL_OK;
}
int Run_ObjCmd2(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[])
{
	
	if (objc != 2)
	{
		Tcl_WrongNumArgs(interp, 1, objv, "list");
		return TCL_ERROR;
	}
	
	int length;
	if (Tcl_ListObjLength(interp, objv[1], &length) != TCL_OK)
		return TCL_ERROR;

	if (!length)
		return TCL_OK;


	std::vector<int> sort_int;

	Tcl_Obj** elem;
	int x;

	if (Tcl_ListObjGetElements(interp, objv[1], &length, &elem) != TCL_OK)
		return TCL_ERROR;

	for (int i = 0; i < length; ++i,++elem)
	{
		if (Tcl_GetIntFromObj(interp, *elem, &x) != TCL_OK)
			return TCL_ERROR;

		sort_int.push_back(x);
	}

	sort(sort_int);

	std::vector<int>::const_iterator iter;

	Tcl_Obj* listPtr = Tcl_NewListObj(0,NULL); 

	for (iter = sort_int.begin(); iter != sort_int.end(); ++iter)
	{
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(*iter));
	}

	Tcl_SetObjResult(interp,listPtr);	
	return TCL_OK;
}

int Run_ObjCmd1(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj*CONST objv[])
{
	
	if (objc != 2)
	{
		Tcl_WrongNumArgs(interp, 1, objv, "list");
		return TCL_ERROR;
	}
	
	int length;
	if (Tcl_ListObjLength(interp, objv[1], &length) != TCL_OK)
		return TCL_ERROR;

	if (!length)
		return TCL_OK;


	std::vector<int> sort_int;

	Tcl_Obj* elem;
	int x;
	for (int i = 0; i < length; ++i)
	{
		if (Tcl_ListObjIndex(interp, objv[1], i, &elem) != TCL_OK)
			return TCL_ERROR;

		if (Tcl_GetIntFromObj(interp, elem, &x) != TCL_OK)
			return TCL_ERROR;

		sort_int.push_back(x);
	}

	sort(sort_int);


	std::vector<int>::const_iterator iter;

	Tcl_Obj* listPtr = Tcl_NewListObj(0,NULL); 

	for (iter = sort_int.begin(); iter != sort_int.end(); ++iter)
	{
		Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewIntObj(*iter));
	}

	Tcl_SetObjResult(interp,listPtr);	
	return TCL_OK;
}

Script

lappend auto_path .

package require run

proc GetBigIntList {n} {
    set ret [list]
    set i 0
    while {$i < $n} {
	lappend ret [expr {int(rand()*100)}]
	incr i
    }
    return $ret
}

proc mycall {proc_name l} {
    puts "\t  $proc_name [time {$proc_name $l} 50]"
}

foreach n {10 100 100000 10000000} {
    set l [GetBigIntList $n]
    
    puts "n = $n:"
    foreach p {::run::run5 ::run::run4 ::run::run3 ::run::run2 ::run::run1} {
	mycall $p $l
    }
    puts "\t  lsort       [time {lsort $l} 50]"
    puts "\t  lsort       [time {lsort -integer $l} 50]"
    puts ""
}

Results (with sort)

(Tclsh 8.5.2.2)

% source start.tcl
n = 10:
	  ::run::run5 4.98 microseconds per iteration
	  ::run::run4 5.14 microseconds per iteration
	  ::run::run3 51.74 microseconds per iteration
	  ::run::run2 9.42 microseconds per iteration
	  ::run::run1 9.48 microseconds per iteration
	  lsort       4.88 microseconds per iteration
	  lsort       4.42 microseconds per iteration

n = 100:
	  ::run::run5 24.84 microseconds per iteration
	  ::run::run4 26.5 microseconds per iteration
	  ::run::run3 358.0 microseconds per iteration
	  ::run::run2 35.22 microseconds per iteration
	  ::run::run1 37.32 microseconds per iteration
	  lsort       44.62 microseconds per iteration
	  lsort       33.58 microseconds per iteration

n = 100000:
	  ::run::run5 10153.28 microseconds per iteration
	  ::run::run4 9999.94 microseconds per iteration
	  ::run::run3 129187.98 microseconds per iteration
	  ::run::run2 11257.74 microseconds per iteration
	  ::run::run1 11721.1 microseconds per iteration
	  lsort       41961.3 microseconds per iteration
	  lsort       29183.34 microseconds per iteration

n = 10000000:
	  ::run::run5 1059397.0 microseconds per iteration
	  ::run::run4 1113793.18 microseconds per iteration
	  ::run::run3 13306324.52 microseconds per iteration
	  ::run::run2 1219605.26 microseconds per iteration
	  ::run::run1 1272201.24 microseconds per iteration
	  lsort       14047392.36 microseconds per iteration
	  lsort       9633409.14 microseconds per iteration
%

Results (without sort)

(Tclsh 8.5.2.2)

% source start.tcl
n = 10:
	  ::run::run5 4.68 microseconds per iteration
	  ::run::run4 4.68 microseconds per iteration
	  ::run::run3 54.4 microseconds per iteration
	  ::run::run2 9.08 microseconds per iteration
	  ::run::run1 9.16 microseconds per iteration
	  
n = 100:
	  ::run::run5 15.6 microseconds per iteration
	  ::run::run4 17.62 microseconds per iteration
	  ::run::run3 368.98 microseconds per iteration
	  ::run::run2 31.0 microseconds per iteration
	  ::run::run1 28.1 microseconds per iteration
	 
n = 100000:
	  ::run::run5 5772.92 microseconds per iteration
	  ::run::run4 5541.34 microseconds per iteration
	  ::run::run3 125792.62 microseconds per iteration
	  ::run::run2 6715.04 microseconds per iteration
	  ::run::run1 7321.1 microseconds per iteration
	  
n = 10000000:
	  ::run::run5 603011.78 microseconds per iteration
	  ::run::run4 655316.34 microseconds per iteration
	  ::run::run3 12944475.46 microseconds per iteration
	  ::run::run2 784494.52 microseconds per iteration
	  ::run::run1 827458.8 microseconds per iteration
%

Category Example	Category Performance	Category Tcl Library