开发者

Is there a partial sort command for tcl?

开发者 https://www.devze.com 2023-02-13 05:55 出处:网络
As C++\'s std::partial_sort do. lsort is no开发者_JAVA百科t powerful enough.There is no built-in equivalent to partial_sort.I think your choices are either to implement it by hand in Tcl, which would

As C++'s std::partial_sort do. lsort is no开发者_JAVA百科t powerful enough.


There is no built-in equivalent to partial_sort. I think your choices are either to implement it by hand in Tcl, which would probably undermine whatever efficiency you sought to gain; or write an extension that actually exposes partial_sort to the interpreter. That wouldn't be too difficult actually -- Tcl extensions are pretty easy to write. Here's a bit of code I just whipped up that should get you started:

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

using namespace std;

static int PartialSortCommand(ClientData dummy,
        Tcl_Interp *interp,
        int objc,
        Tcl_Obj *CONST objv[]);


EXTERN int
Partialsort_Init(Tcl_Interp *interp)
{
    if (Tcl_InitStubs(interp, "8.0", 0) == NULL) {
        return TCL_ERROR;
    }

    if (Tcl_PkgProvide(interp, "partialsort", "1.0") != TCL_OK) {
        return TCL_ERROR;
    }

    Tcl_CreateObjCommand(interp, "partialsort", PartialSortCommand,
            (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

    return TCL_OK;
}

bool CompareObjs(Tcl_Obj *a, Tcl_Obj *b) {
    int left, right;
    Tcl_GetIntFromObj(0, a, &left);
    Tcl_GetIntFromObj(0, b, &right);
    return left < right;
}

int PartialSortCommand(
    ClientData dummy,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *CONST objv[])
{
    if (objc != 5) {
        Tcl_WrongNumArgs(interp, 1, objv, "list start middle end");
        return TCL_ERROR;
    }

    Tcl_Obj **objs;
    int count;

    if (Tcl_ListObjGetElements(interp, objv[1], &count, &objs) != TCL_OK) {
        return TCL_ERROR;
    }

    int start, middle, end;
    if (Tcl_GetIntFromObj(interp, objv[2], &start) != TCL_OK) {
        return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[3], &middle) != TCL_OK) {
        return TCL_ERROR;
    }

    if (Tcl_GetIntFromObj(interp, objv[4], &end) != TCL_OK) {
        return TCL_ERROR;
    }

    partial_sort(&objs[start], &objs[middle], &objs[end], CompareObjs);
    Tcl_SetObjResult(interp, Tcl_NewListObj(count, objs));
    return TCL_OK;
}

Of course this is just a rough cut. It only handles lists of integers. It doesn't do much in the way of error checking. It's a bit cavalier with respect to shared Tcl_Obj structures. But hopefully it will get you going in the right directory.

0

精彩评论

暂无评论...
验证码 换一张
取 消