[175] | 1 |
|
---|
| 2 | /*
|
---|
| 3 | Copyright (c) 2007, Pavel Demin
|
---|
| 4 |
|
---|
| 5 | All rights reserved.
|
---|
| 6 |
|
---|
| 7 | Redistribution and use in source and binary forms,
|
---|
| 8 | with or without modification, are permitted
|
---|
| 9 | provided that the following conditions are met:
|
---|
| 10 |
|
---|
| 11 | * Redistributions of source code must retain
|
---|
| 12 | the above copyright notice, this list of conditions
|
---|
| 13 | and the following disclaimer.
|
---|
| 14 | * Redistributions in binary form must reproduce
|
---|
| 15 | the above copyright notice, this list of conditions
|
---|
| 16 | and the following disclaimer in the documentation
|
---|
| 17 | and/or other materials provided with the distribution.
|
---|
| 18 | * Neither the name of the SRMlite nor the names of its
|
---|
| 19 | contributors may be used to endorse or promote products
|
---|
| 20 | derived from this software without specific prior written permission.
|
---|
| 21 |
|
---|
| 22 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
---|
| 23 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
---|
| 24 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
---|
| 25 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR
|
---|
| 26 | CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
|
---|
| 27 | EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
|
---|
| 28 | PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
|
---|
| 29 | PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
|
---|
| 30 | LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
|
---|
| 31 | NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
|
---|
| 32 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
---|
| 33 | */
|
---|
| 34 |
|
---|
| 35 | #include <string.h>
|
---|
| 36 | #include <stdlib.h>
|
---|
| 37 | #include <memory.h>
|
---|
| 38 | #include <stdio.h>
|
---|
| 39 | #include <math.h>
|
---|
| 40 | #include <tcl.h>
|
---|
| 41 |
|
---|
| 42 | #define SQRT_2 1.4142135623730951
|
---|
| 43 |
|
---|
| 44 | static double bior_3_1_hi[4] = {-0.25, -0.75, 0.75, 0.25};
|
---|
| 45 | static double bior_3_1_lo[4] = {0.125, 0.375, 0.375, 0.125};
|
---|
| 46 |
|
---|
| 47 | /*
|
---|
| 48 | static double bior_3_1_hi[4] = {-1.0, -3.0, 3.0, 1.0};
|
---|
| 49 | static double bior_3_1_lo[4] = {1.0, 3.0, 3.0, 1.0};
|
---|
| 50 | */
|
---|
| 51 |
|
---|
| 52 | static void uwt_forward(double *input, double *d, double *a, int n, int level,
|
---|
| 53 | double *hi, double *lo, int l)
|
---|
| 54 | {
|
---|
| 55 | int i, j, k;
|
---|
| 56 | double entry;
|
---|
| 57 |
|
---|
| 58 | for(i = 0; i < n; ++i)
|
---|
| 59 | {
|
---|
| 60 | k = i + (((l - 1) << (level - 1)) + 1)/2;
|
---|
| 61 | entry = (k >= 0 && k < n) ? input[k] : 0.0;
|
---|
| 62 | d[i] = hi[0] * entry;
|
---|
| 63 | a[i] = lo[0] * entry;
|
---|
| 64 | /*
|
---|
| 65 | printf("%d %d -> %g * %g -> %g\n", i, 0, hi[0], entry, d[i]);
|
---|
| 66 | */
|
---|
| 67 | for(j = 1; j < l; ++j)
|
---|
| 68 | {
|
---|
| 69 | k -= (1 << (level - 1));
|
---|
| 70 | entry = (k >= 0 && k < n) ? input[k] : 0.0;
|
---|
| 71 | d[i] += hi[j] * entry;
|
---|
| 72 | a[i] += lo[j] * entry;
|
---|
| 73 | /*
|
---|
| 74 | printf("%d %d -> + %g * %g -> %g\n", i, j, hi[j], entry, d[i]);
|
---|
| 75 | */
|
---|
| 76 | }
|
---|
| 77 | }
|
---|
| 78 | }
|
---|
| 79 |
|
---|
| 80 | /* ----------------------------------------------------------------- */
|
---|
| 81 |
|
---|
| 82 | static int UwtObjCmdProc(ClientData clientData, Tcl_Interp *interp,
|
---|
| 83 | int objc, Tcl_Obj *CONST objv[])
|
---|
| 84 | {
|
---|
| 85 | int shift = 0;
|
---|
| 86 | int size = 0;
|
---|
| 87 | int i = 0;
|
---|
| 88 | int level = 0;
|
---|
| 89 | double value = 0.0;
|
---|
| 90 | double *tmp, *input, *d, *a;
|
---|
| 91 | Tcl_Obj *result = NULL;
|
---|
| 92 | Tcl_Obj *lista = NULL;
|
---|
| 93 | Tcl_Obj *listd = NULL;
|
---|
| 94 |
|
---|
| 95 | if(objc != 3)
|
---|
| 96 | {
|
---|
| 97 | Tcl_WrongNumArgs(interp, 1, objv, "level data");
|
---|
| 98 | return TCL_ERROR;
|
---|
| 99 | }
|
---|
| 100 |
|
---|
| 101 | if(TCL_OK != Tcl_GetIntFromObj(interp, objv[1], &level))
|
---|
| 102 | {
|
---|
| 103 | return TCL_ERROR;
|
---|
| 104 | }
|
---|
| 105 |
|
---|
| 106 | if(TCL_OK != Tcl_ListObjLength(interp, objv[2], &size))
|
---|
| 107 | {
|
---|
| 108 | return TCL_ERROR;
|
---|
| 109 | }
|
---|
| 110 |
|
---|
| 111 | input = (double *) malloc(size*sizeof(double));
|
---|
| 112 | d = (double *) malloc(size*sizeof(double));
|
---|
| 113 | a = (double *) malloc(size*sizeof(double));
|
---|
| 114 |
|
---|
| 115 | for(i = 0; i < size; ++i)
|
---|
| 116 | {
|
---|
| 117 | Tcl_ListObjIndex(interp, objv[2], i, &result);
|
---|
| 118 | if(TCL_OK != Tcl_GetDoubleFromObj(interp, result, &value))
|
---|
| 119 | {
|
---|
| 120 | free(input);
|
---|
| 121 | free(d);
|
---|
| 122 | free(a);
|
---|
| 123 | return TCL_ERROR;
|
---|
| 124 | }
|
---|
| 125 | input[i] = value;
|
---|
| 126 | /*
|
---|
| 127 | printf("%d -> %g\n", i, input[i]);
|
---|
| 128 | */
|
---|
| 129 | }
|
---|
| 130 |
|
---|
| 131 | for(i = 1; i <= level; ++i)
|
---|
| 132 | {
|
---|
| 133 | uwt_forward(input, d, a, size, i, bior_3_1_hi, bior_3_1_lo, 4);
|
---|
| 134 | tmp = input;
|
---|
| 135 | input = a;
|
---|
| 136 | a = tmp;
|
---|
| 137 | }
|
---|
| 138 |
|
---|
| 139 | result = Tcl_GetObjResult(interp);
|
---|
| 140 | lista = Tcl_NewObj();
|
---|
| 141 | listd = Tcl_NewObj();
|
---|
| 142 | for(i = 0; i < size; ++i)
|
---|
| 143 | {
|
---|
| 144 | Tcl_ListObjAppendElement(interp, listd, Tcl_NewDoubleObj(d[i]));
|
---|
| 145 | Tcl_ListObjAppendElement(interp, lista, Tcl_NewDoubleObj(input[i]));
|
---|
| 146 | /*
|
---|
| 147 | printf("%d -> %g\n", i, d[i]);
|
---|
| 148 | */ }
|
---|
| 149 |
|
---|
| 150 | Tcl_ListObjAppendElement(interp, result, listd);
|
---|
| 151 | Tcl_ListObjAppendElement(interp, result, lista);
|
---|
| 152 |
|
---|
| 153 | free(input);
|
---|
| 154 | free(d);
|
---|
| 155 | free(a);
|
---|
| 156 |
|
---|
| 157 | return TCL_OK;
|
---|
| 158 | }
|
---|
| 159 |
|
---|
| 160 | /* ----------------------------------------------------------------- */
|
---|
| 161 |
|
---|
| 162 | static void sum8(double *input, double *output, int n)
|
---|
| 163 | {
|
---|
| 164 | int i, j, k;
|
---|
| 165 | double entry;
|
---|
| 166 |
|
---|
| 167 | for(i = 0; i < n; ++i)
|
---|
| 168 | {
|
---|
| 169 | k = i + 4;
|
---|
| 170 | entry = (k >= 0 && k < n) ? input[k] : 0.0;
|
---|
| 171 | output[i] = entry;
|
---|
| 172 | for(j = 1; j < 8; ++j)
|
---|
| 173 | {
|
---|
| 174 | --k;
|
---|
| 175 | entry = (k >= 0 && k < n) ? input[k] : 0.0;
|
---|
| 176 | output[i] += entry;
|
---|
| 177 | }
|
---|
| 178 |
|
---|
| 179 | output[i] = output[i]/8.0;
|
---|
| 180 |
|
---|
| 181 | }
|
---|
| 182 | }
|
---|
| 183 |
|
---|
| 184 | /* ----------------------------------------------------------------- */
|
---|
| 185 |
|
---|
| 186 | static int Sum8ObjCmdProc(ClientData clientData, Tcl_Interp *interp,
|
---|
| 187 | int objc, Tcl_Obj *CONST objv[])
|
---|
| 188 | {
|
---|
| 189 | int size = 0;
|
---|
| 190 | int i = 0;
|
---|
| 191 | int level = 0;
|
---|
| 192 | double value = 0.0;
|
---|
| 193 | double *input, *output;
|
---|
| 194 | Tcl_Obj *result = NULL;
|
---|
| 195 |
|
---|
| 196 | if(objc != 2)
|
---|
| 197 | {
|
---|
| 198 | Tcl_WrongNumArgs(interp, 1, objv, "data");
|
---|
| 199 | return TCL_ERROR;
|
---|
| 200 | }
|
---|
| 201 |
|
---|
| 202 | if(TCL_OK != Tcl_ListObjLength(interp, objv[1], &size))
|
---|
| 203 | {
|
---|
| 204 | return TCL_ERROR;
|
---|
| 205 | }
|
---|
| 206 |
|
---|
| 207 | input = (double *) malloc(size*sizeof(double));
|
---|
| 208 | output = (double *) malloc(size*sizeof(double));
|
---|
| 209 |
|
---|
| 210 | for(i = 0; i < size; ++i)
|
---|
| 211 | {
|
---|
| 212 | Tcl_ListObjIndex(interp, objv[1], i, &result);
|
---|
| 213 | if(TCL_OK != Tcl_GetDoubleFromObj(interp, result, &value))
|
---|
| 214 | {
|
---|
| 215 | free(input);
|
---|
| 216 | free(output);
|
---|
| 217 | return TCL_ERROR;
|
---|
| 218 | }
|
---|
| 219 | input[i] = value;
|
---|
| 220 | /*
|
---|
| 221 | printf("%d -> %g\n", i, input[i]);
|
---|
| 222 | */
|
---|
| 223 | }
|
---|
| 224 |
|
---|
| 225 | sum8(input, output, size);
|
---|
| 226 |
|
---|
| 227 | result = Tcl_GetObjResult(interp);
|
---|
| 228 | for(i = 0; i < size; ++i)
|
---|
| 229 | {
|
---|
| 230 | Tcl_ListObjAppendElement(interp, result, Tcl_NewDoubleObj(output[i]));
|
---|
| 231 | /*
|
---|
| 232 | printf("%d -> %g\n", i, d[i]);
|
---|
| 233 | */
|
---|
| 234 | }
|
---|
| 235 |
|
---|
| 236 | free(input);
|
---|
| 237 | free(output);
|
---|
| 238 |
|
---|
| 239 | return TCL_OK;
|
---|
| 240 | }
|
---|
| 241 |
|
---|
| 242 | /* ----------------------------------------------------------------- */
|
---|
| 243 |
|
---|
| 244 | int Swt_Init(Tcl_Interp *interp)
|
---|
| 245 | {
|
---|
| 246 | Tcl_CreateObjCommand(interp, "uwt", UwtObjCmdProc, 0, 0);
|
---|
| 247 | Tcl_CreateObjCommand(interp, "sum8", Sum8ObjCmdProc, 0, 0);
|
---|
| 248 |
|
---|
| 249 | return Tcl_PkgProvide(interp, "swt", "0.1");
|
---|
| 250 | }
|
---|