|
|
/*ScianArrays.c
Eric Pepke
February 9, 1990
Array handling stuff in scian
*/
#include "Scian.h"
#include "ScianTypes.h"
#include "ScianWindows.h"
#include "ScianObjWindows.h"
#include "ScianDialogs.h"
#include "ScianArrays.h"
#include "ScianLists.h"
#include "ScianErrors.h"
#include "ScianIDs.h"
#include "ScianDatasets.h"
#include "ScianTimers.h"
#include "ScianNetObjects.h"
#include "ScianGarbageMan.h"
ObjPtr arrayClass, objectArrayClass, byteArrayClass, shortArrayClass, realArrayClass, pointerArrayClass;
#ifdef PROTO
long SearchReal(ObjPtr array, real value)
#else
long SearchReal(array, value)
ObjPtr array;
real value;
#endif
/*Assuming array is a sorted, 1-dimensional real array, finds the index to the
lowest element which is larger than value, or the dims if the value is
higher than all. Returns -1 if the array is bad.*/
{
long top, bottom, mid;
real *elements;
if ((!IsRealArray(array)) || (RANK(array) != 1))
{
ReportError("SearchReal",
"This function requires a real array of rank 1");
return -1;
}
bottom = 0;
top = DIMS(array)[0] - 1;
elements = ELEMENTS(array);
if (value >= elements[top])
{
return top + 1;
}
while (top > bottom)
{
mid = (top + bottom) / 2;
if (value >= elements[mid])
{
bottom = mid + 1;
}
else
{
top = mid;
}
}
return bottom;
}
#ifdef PROTO
long SearchShort(ObjPtr array, short value)
#else
long SearchShort(array, value)
ObjPtr array;
short value;
#endif
/*Assuming array is a sorted, 1-dimensional short array, finds the index to the
lowest element which is larger than value, or the dims if the value is
higher than all. Returns -1 if the array is bad.*/
{
long top, bottom, mid;
short *elements;
if ((!IsShortArray(array)) || (RANK(array) != 1))
{
ReportError("SearchShort",
"This function requires a short array of rank 1");
return -1;
}
bottom = 0;
top = DIMS(array)[0] - 1;
elements = ELEMENTS(array);
if (value >= elements[top])
{
return top + 1;
}
while (top > bottom)
{
mid = (top + bottom) / 2;
if (value >= elements[mid])
{
bottom = mid + 1;
}
else
{
top = mid;
}
}
return bottom;
}
#ifdef PROTO
real SearchFuzzyReal(ObjPtr array, real value)
#else
real SearchFuzzyReal(array, value)
ObjPtr array;
real value;
#endif
/*Assuming array is a sorted, 1-dimensional real array, finds a fuzzy real index
into the array.*/
{
long found;
real *elements;
if ((!IsRealArray(array)) || (RANK(array) != 1))
{
ReportError("SearchFuzzyReal",
"This function requires a real array of rank 1");
return 0.0;
}
found = SearchReal(array, value);
elements = ELEMENTS(array);
if (DIMS(array)[0] == 1)
{
/*Degenerate case*/
return 0;
}
if (found >= DIMS(array)[0])
{
/*This is bigger. Extrapolate*/
return (value - elements[DIMS(array)[0] - 1]) /
(elements[DIMS(array)[0] - 1] - elements[DIMS(array)[0] - 2])
+ (real) (DIMS(array)[0] - 1);
}
else if (found <= 0)
{
/*This is smaller. Extrapolate*/
return (value - elements[0]) / (elements[1] - elements[0]);
}
else
{
/*It's in between*/
return (value - elements[found - 1]) / (elements[found] - elements[found - 1])
+ (real) (found - 1);
}
}
#ifdef PROTO
real FuzzyRealIndex(ObjPtr array, real index)
#else
real FuzzyRealIndex(array, index)
ObjPtr array;
real index;
#endif
/*Assuming array is a sorted, 1-dimensional real array, indexes a fuzzy real index
into the array.*/
{
real *elements;
long indexI;
if ((!IsRealArray(array)) || (RANK(array) != 1))
{
ReportError("FuzzyRealIndex",
"This function requires a real array of rank 1");
return -1.0;
}
elements = ELEMENTS(array);
/*Degenerate case*/
if (DIMS(array)[0] == 1)
{
return elements[0];
}
indexI = index;
if (indexI < 0)
{
/*Extrapolate*/
return elements[0] +
index * (elements[1] - elements[0]);
}
else if (indexI >= DIMS(array)[0] - 1)
{
/*Extrapolate*/
return elements[DIMS(array)[0] - 1] +
(index - (DIMS(array)[0] - 1)) *
(elements[DIMS(array)[0] - 1] - elements[DIMS(array)[0] - 2]);
}
else
{
/*Interpolate*/
return elements[indexI] +
(index - (real) indexI) * (elements[indexI + 1] - elements[indexI]);
}
}
static int globalVar;
#ifdef PROTO
int CompareStringVars(const void *a, const void *b)
#else
int CompareStringVars(a, b)
void *a, *b;
#endif
/*Compares two object's globalVar strings for qsort*/
{
ObjPtr s1, s2;
s1 = GetStringVar("CompareStringVars", *((ObjPtr *) a), NAME);
s2 = GetStringVar("CompareStringVars", *((ObjPtr *) b), NAME);
if (!s1 || !s2) return 0;
return strcmp2(GetString(s1), GetString(s2));
}
#ifdef PROTO
ObjPtr SortArrayByStringVar(ObjPtr array, NameTyp var)
#else
ObjPtr SortArrayByStringVar(array, var)
ObjPtr array;
NameTyp var;
#endif
/*Sorts a 1-dimensional object array by var, which must be a string.
Returns the sorted array or NULLOBJ*/
{
ObjPtr retVal;
long *newDims;
ObjPtr *elements, *newElements;
long k;
if (!IsObjArray(array) || RANK(array) != 1)
{
ReportError("SortArrayByStringVar",
"This function requires an object array of rank 1");
return NULLOBJ;
}
/*Make the elements*/
newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * DIMS(array)[0]);
if (!newElements)
{
OMErr();
return NULLOBJ;
}
/*Make the dimensions*/
newDims = (long *) Alloc(sizeof(long));
if (!newDims)
{
Free(newElements);
OMErr();
return NULLOBJ;
}
/*Make the array*/
retVal = NewObject(objectArrayClass,
sizeof(Array) - sizeof(Obj));
/*If can't, return NIL*/
if (!retVal)
{
Free(newElements);
Free(newDims);
OMErr();
return NULLOBJ;
}
/*Make elements and dims*/
ELEMENTS(retVal) = newElements;
DIMS(retVal) = newDims;
newDims[0] = DIMS(array)[0];
/*Fill in values for flags and dimensions*/
SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags));
RANK(retVal) = 1;
elements = ELEMENTS(array);
for (k = 0; k < DIMS(array)[0]; ++k)
{
newElements[k] = elements[k];
}
globalVar = var;
qsort(newElements,
DIMS(array)[0],
sizeof(ObjPtr),
CompareStringVars);
return retVal;
}
#ifdef PROTO
long SearchStringVar(ObjPtr array, NameTyp whichVar, char *value)
#else
long SearchStringVar(array, whichVar, value)
ObjPtr array;
NameTyp whichVar;
char *value;
#endif
/*Assuming array is a sorted, 1-dimensional object array, finds the index to the
lowest element which has a string var whichVar larger than value,
or the dims if the value is higher than all. Returns -1 if the array is bad.*/
{
long top, bottom, mid;
ObjPtr var;
ObjPtr *elements;
if ((!IsObjArray(array)) || (RANK(array) != 1))
{
ReportError("SearchStringVar",
"This function requires an object array of rank 1");
return -1;
}
bottom = 0;
top = DIMS(array)[0] - 1;
elements = ELEMENTS(array);
MakeVar(elements[top], whichVar);
var = GetVar(elements[top], whichVar);
if (var && IsString(var))
{
if (strcmp2(value, GetString(var)) >= 0)
{
return top + 1;
}
}
else
{
return -1;
}
while (top > bottom)
{
mid = (top + bottom) / 2;
MakeVar(elements[mid], whichVar);
var = GetVar(elements[mid], whichVar);
if (var && IsString(var))
{
if (strcmp2(value, GetString(var)) >= 0)
{
bottom = mid + 1;
}
else
{
top = mid;
}
}
else
{
return -1;
}
}
return bottom;
}
#ifdef PROTO
long SearchIntVar(ObjPtr array, NameTyp whichVar, int value)
#else
long SearchIntVar(array, whichVar, value)
ObjPtr array;
NameTyp whichVar;
int value;
#endif
/*Assuming array is a sorted, 1-dimensional object array, finds the index to the
lowest element which has an int var whichVar larger than value,
or the dims if the value is higher than all. Returns -1 if the array is bad.*/
{
long top, bottom, mid;
ObjPtr var;
ObjPtr *elements;
if ((!IsObjArray(array)) || (RANK(array) != 1))
{
ReportError("SearchIntVar",
"This function requires an object array of rank 1");
return -1;
}
bottom = 0;
top = DIMS(array)[0] - 1;
elements = ELEMENTS(array);
MakeVar(elements[top], whichVar);
var = GetVar(elements[top], whichVar);
if (var && IsInt(var))
{
if (value >= GetInt(var))
{
return top + 1;
}
}
else
{
return -1;
}
while (top > bottom)
{
mid = (top + bottom) / 2;
MakeVar(elements[mid], whichVar);
var = GetVar(elements[mid], whichVar);
if (var && IsInt(var))
{
if (value >= GetInt(var))
{
bottom = mid + 1;
}
else
{
top = mid;
}
}
else
{
return -1;
}
}
return bottom;
}
#ifdef PROTO
static int ComparePointers(const void *a, const void *b)
#else
static int ComparePointers(a, b)
void *a, *b;
#endif
/*Compares two pointers*/
{
return (*(ObjPtr *) a) - (*(ObjPtr *) b);
}
#ifdef PROTO
static int CR(const void *a, const void *b)
#else
static int CR(a, b)
void *a, *b;
#endif
/*Compares two reals*/
{
return (*(real *) a) - (*(real *) b);
}
#ifdef PROTO
ObjPtr Uniq(ObjPtr array)
#else
ObjPtr Uniq(array)
ObjPtr array;
#endif
/*Returns array with only unique elements of array. Array must be 1-dimensional.
Warning! This will sort the array first*/
{
long *newDims;
ObjPtr retVal;
int s, d;
if ((!IsObjArray(array) && !IsRealArray(array)) || RANK(array) != 1)
{
ReportError("Uniq",
"This function requires an array of rank 1");
return NULLOBJ;
}
/*Make the new dims*/
newDims = (long *) Alloc(sizeof(long));
if (!newDims)
{
OMErr();
return NULLOBJ;
}
/*Make the array*/
retVal = NewObject(IsRealArray(array) ? realArrayClass : objectArrayClass, sizeof(Array) - sizeof(Obj));
/*If can't, return NIL*/
if (!retVal)
{
Free(newDims);
OMErr();
return NULLOBJ;
}
/*Set dims*/
DIMS(retVal) = newDims;
/*Fill in values for flags and dimensions*/
SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags));
RANK(retVal) = 1;
if (IsRealArray(array))
{
real *elements;
real *newElements;
elements = ELEMENTS(array);
/*Make the new elements*/
newElements = (real *) Alloc(sizeof(real) * DIMS(array)[0]);
if (!newElements)
{
OMErr();
return NULLOBJ;
}
for (s = 0; s < DIMS(array)[0]; ++s)
{
newElements[s] = elements[s];
}
qsort(newElements,
DIMS(array)[0],
sizeof(real),
CR);
s = d = 0;
++s;
while (s < DIMS(array)[0])
{
if (newElements[s] != newElements[d])
{
newElements[++d] = newElements[s];
}
++s;
}
newElements = Realloc(newElements, sizeof(ObjPtr) * (d + 1));
ELEMENTS(retVal) = newElements;
}
else
{
ObjPtr *elements;
ObjPtr *newElements;
elements = ELEMENTS(array);
/*Make the new elements*/
newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * DIMS(array)[0]);
if (!newElements)
{
OMErr();
return NULLOBJ;
}
for (s = 0; s < DIMS(array)[0]; ++s)
{
newElements[s] = elements[s];
}
qsort(newElements,
DIMS(array)[0],
sizeof(real),
ComparePointers);
s = d = 0;
++s;
while (s < DIMS(array)[0])
{
if (newElements[s] != newElements[d])
{
newElements[++d] = newElements[s];
}
++s;
}
newElements = Realloc(newElements, sizeof(ObjPtr) * (d + 1));
ELEMENTS(retVal) = newElements;
}
DIMS(retVal)[0] = d + 1;
return retVal;
}
#ifdef PROTO
ObjPtr SortArray(ObjPtr array)
#else
ObjPtr SortArray(array)
ObjPtr array;
#endif
/*Returns array from array sorted by real value or object address.
Array must be 1-dimensional.*/
{
long *newDims;
ObjPtr retVal;
long k;
if ((!IsObjArray(array) && !IsRealArray(array)) || RANK(array) != 1)
{
ReportError("SortArray",
"This function requires an array of rank 1");
return NULLOBJ;
}
/*Make the new dims*/
newDims = (long *) Alloc(sizeof(long));
if (!newDims)
{
OMErr();
return NULLOBJ;
}
/*Make the array*/
retVal = NewObject(IsRealArray(array) ? realArrayClass : objectArrayClass, sizeof(Array) - sizeof(Obj));
/*If can't, return NIL*/
if (!retVal)
{
Free(newDims);
OMErr();
return NULLOBJ;
}
/*Set dims*/
DIMS(retVal) = newDims;
/*Fill in values for flags and dimensions*/
SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags));
RANK(retVal) = 1;
if (IsRealArray(array))
{
real *elements;
real *newElements;
elements = ELEMENTS(array);
/*Make the new elements*/
newElements = (real *) Alloc(sizeof(real) * DIMS(array)[0]);
if (!newElements)
{
OMErr();
return NULLOBJ;
}
for (k = 0; k < DIMS(array)[0]; ++k)
{
newElements[k] = elements[k];
}
qsort(newElements,
DIMS(array)[0],
sizeof(real),
CR);
ELEMENTS(retVal) = newElements;
}
else
{
ObjPtr *elements;
ObjPtr *newElements;
elements = ELEMENTS(array);
/*Make the new elements*/
newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * DIMS(array)[0]);
if (!newElements)
{
OMErr();
return NULLOBJ;
}
for (k = 0; k < DIMS(array)[0]; ++k)
{
newElements[k] = elements[k];
}
qsort(newElements,
DIMS(array)[0],
sizeof(real),
ComparePointers);
ELEMENTS(retVal) = newElements;
}
DIMS(retVal)[0] = DIMS(array)[0];
return retVal;
}
#ifdef PROTO
ObjPtr RealArrayDeltas(ObjPtr array)
#else
ObjPtr RealArrayDeltas(array)
ObjPtr array;
#endif
/*Takes a real array of rank one, dimension n. If n is 1, returns an array
of dimension 1 with a 0 in it. If n > 1, returns an array of dimension
n - 1 where each element is the difference between successive elements
of array*/
{
ObjPtr retVal;
real *sElements, *dElements;
long k;
if ((!IsRealArray(array)) || RANK(array) != 1)
{
ReportError("Uniq",
"This function requires a real array of rank 1");
return NULLOBJ;
}
if (DIMS(array)[0] <= 1)
{
retVal = NewRealArray(1, 1L);
*((real *) ELEMENTS(retVal)) = 0.0;
return retVal;
}
/*Make new array*/
retVal = NewRealArray(1, DIMS(array)[0] - 1);
/*If can't, return NIL*/
if (!retVal)
{
return NULLOBJ;
}
/*Fill in new array*/
sElements = ELEMENTS(array);
dElements = ELEMENTS(retVal);
for (k = 0; k < DIMS(retVal)[0]; ++k)
{
dElements[k] = sElements[k + 1] - sElements[k];
}
return retVal;
}
#ifdef PROTO
ObjPtr InsertInArray(ObjPtr array, ObjPtr value, long index)
#else
ObjPtr InsertInArray(array, value, index)
ObjPtr array;
ObjPtr value;
long index;
#endif
/*Inserts value into a new array like array at index*/
{
long *newDims;
ObjPtr retVal;
int s;
if ((!IsObjArray(array) && !IsRealArray(array)) || RANK(array) != 1)
{
ReportError("InsertInArray",
"This function requires an array of rank 1");
return NULLOBJ;
}
if (IsRealArray(array) && !IsReal(value))
{
ReportError("InsertInArray",
"You can only insert reals into real arrays");
}
/*Make the new dims*/
newDims = (long *) Alloc(sizeof(long));
if (!newDims)
{
OMErr();
return NULLOBJ;
}
/*Make the array*/
retVal = NewObject(IsRealArray(array) ? realArrayClass : objectArrayClass, sizeof(Array) - sizeof(Obj));
/*If can't, return NIL*/
if (!retVal)
{
Free(newDims);
OMErr();
return NULLOBJ;
}
/*Set dims*/
DIMS(retVal) = newDims;
DIMS(retVal)[0] = DIMS(array)[0] + 1;
/*Fill in values for flags and dimensions*/
SETOBJTYPE(retVal -> flags, OBJTYPE(array -> flags));
RANK(retVal) = 1;
if (IsRealArray(array))
{
real *elements;
real *newElements;
elements = ELEMENTS(array);
/*Make the new elements*/
newElements = (real *) Alloc(sizeof(real) * (DIMS(array)[0] + 1));
if (!newElements)
{
OMErr();
return NULLOBJ;
}
/*Copy the elements*/
for (s = 0; s < index; ++s)
{
newElements[s] = elements[s];
}
newElements[index] = GetReal(value);
for (s = index; s < DIMS(array)[0]; ++s)
{
newElements[s + 1] = elements[s];
}
ELEMENTS(retVal) = newElements;
}
else
{
ObjPtr *elements;
ObjPtr *newElements;
elements = ELEMENTS(array);
/*Make the new elements*/
newElements = (ObjPtr *) Alloc(sizeof(ObjPtr) * (DIMS(array)[0] + 1));
if (!newElements)
{
OMErr();
return NULLOBJ;
}
/*Copy the elements*/
for (s = 0; s < index; ++s)
{
newElements[s] = elements[s];
}
newElements[index] = value;
for (s = index; s < DIMS(array)[0]; ++s)
{
newElements[s + 1] = elements[s];
}
ELEMENTS(retVal) = newElements;
}
return retVal;
}
#ifdef PROTO
ObjPtr InterpArray(ObjPtr interp1, ObjPtr interp2, real weight)
#else
ObjPtr InterpArray(interp1, interp2, weight)
ObjPtr interp1, interp2;
real weight;
#endif
/*Makes a new array that linearly interpolates between interp1 and interp2.
Weight is the amount, between 0.0 and 1.0, to favor interp2 over interp1.*/
{
register long nels; /*Number of elements in array*/
register int k; /*Random counter*/
long *dimPtr1, *dimPtr2, *dimPtr3; /*Pointer to dimensions and then some*/
register real *interpPtr1, *interpPtr2;
register real *destPtr;
APtr retVal;
real *elements; /*Pointer to the elements*/
long *dims; /*Pointer to dims*/
if ((!IsRealArray(interp1)) || (!IsRealArray(interp2)))
{
ReportError("InterpArray","Can only interpolate between real arrays");
return NULLOBJ;
}
if (RANK(interp1) != RANK(interp2))
{
ReportError("InterpArray","Rank mismatch");
return NULLOBJ;
}
nels = 1;
dimPtr1 = DIMS(interp1);
dimPtr2 = DIMS(interp2);
for (k = 0; k < RANK(interp1); ++k)
{
if (*dimPtr1 != *dimPtr2)
{
ReportError("InterpArray","Dimension mismatch\n");
return NULLOBJ;
}
nels *= *dimPtr1;
++dimPtr1;
++dimPtr2;
}
/*Try to allocate the elements*/
elements = (real *) Alloc(nels * sizeof(real));
/*If can't, return NIL*/
if (!elements)
{
OMErr();
return NULLOBJ;
}
/*Try to allocate the dims*/
dims = (long *) Alloc(RANK(interp1) * sizeof(long));
if (!dims)
{
Free(elements);
OMErr();
return NULLOBJ;
}
/*Make the array*/
retVal = (APtr) NewObject(realArrayClass,
sizeof(Array) - sizeof(Obj));
/*If can't, return NIL*/
if (!retVal)
{
OMErr();
Free(elements);
Free(dims);
return (ObjPtr) retVal;
}
/*Make elements and dims*/
ELEMENTS(retVal) = elements;
DIMS(retVal) = dims;
/*Fill in values for flags and dimensions*/
SETOBJTYPE(retVal -> thing . flags, REALARRAY);
retVal -> rank = RANK(interp1);
dimPtr1 = DIMS(interp1);
dimPtr2 = DIMS(interp2);
dimPtr3 = DIMS(retVal);
for (k = 0; k < RANK(interp1); ++k)
{
DIMS(retVal)[k] = DIMS(interp1)[k];
++dimPtr1;
++dimPtr2;
++dimPtr3;
}
interpPtr1 = ELEMENTS(interp1);
interpPtr2 = ELEMENTS(interp2);
destPtr = ELEMENTS(retVal);
while (nels)
{
*destPtr = *interpPtr2 * weight + *interpPtr1 * (1.0 - weight);
if (*interpPtr1 == missingData || *interpPtr2 == missingData)
{
*destPtr = missingData;
}
++destPtr;
++interpPtr1;
++interpPtr2;
--nels;
}
return (ObjPtr) retVal;
}
#ifdef PROTO
ObjPtr MergeRealArrays(ObjPtr merge1, ObjPtr merge2)
#else
ObjPtr MergeRealArrays(merge1, merge2)
ObjPtr merge1, merge2;
#endif
/*Makes a new real array that merges values from merge1 and merge2. Assumes
that merge1 and merge2 are already sorted*/
{
register long nels1, nels2; /*Number of elements in array*/
register int k; /*Random counter*/
register long s1, s2, d; /*Indices for copy*/
register real *mergePtr1, *mergePtr2;
register real *destPtr;
APtr retVal;
real *elements; /*Pointer to the elements*/
long *dims; /*Pointer to dims*/
if ((!IsRealArray(merge2)) || (!IsRealArray(merge1)))
{
ReportError("MergeRealArrays", "Can only merge real arrays");
return NULLOBJ;
}
if (RANK(merge1) != 1 || RANK(merge2) != 1)
{
ReportError("MergeRealArrays", "Can only merge arrays of rank 1");
return NULLOBJ;
}
nels1 = DIMS(merge1)[0];
nels2 = DIMS(merge2)[0];
/*Try to allocate the elements*/
elements = (real *) Alloc((nels1 + nels2) * sizeof(real));
/*If can't, return NIL*/
if (!elements)
{
OMErr();
return NULLOBJ;
}
/*Try to allocate the dims*/
dims = (long *) Alloc(sizeof(long));
if (!dims)
{
Free(elements);
OMErr();
return NULLOBJ;
}
dims[0] = nels1 + nels2;
/*Make the array*/
retVal = (APtr) NewObject(realArrayClass, sizeof(Array) - sizeof(Obj));
/*If can't, return NIL*/
if (!retVal)
{
OMErr();
Free(elements);
Free(dims);
return (ObjPtr) retVal;
}
/*Make elements and dims*/
ELEMENTS(retVal) = elements;
DIMS(retVal) = dims;
/*Fill in values for flags and dimensions*/
SETOBJTYPE(retVal -> thing . flags, REALARRAY);
retVal -> rank = 1;
mergePtr1 = ELEMENTS(merge1);
mergePtr2 = ELEMENTS(merge2);
destPtr = ELEMENTS(retVal);
s1 = 0; s2 = 0; d = 0;
while (s1 < nels1 || s2 < nels2)
{
if (s2 >= nels2)
{
destPtr[d] = mergePtr1[s1];
++s1;
++d;
}
else if (s1 >= nels1)
{
destPtr[d] = mergePtr2[s2];
++s2;
++d;
}
else if (mergePtr1[s1] < mergePtr2[s2])
{
destPtr[d] = mergePtr1[s1];
++s1;
++d;
}
else
{
destPtr[d] = mergePtr2[s2];
++s2;
++d;
}
}
return (ObjPtr) retVal;
}
void CArray2Array(array, pointer)
ObjPtr array;
real *pointer;
/*Fills array with the data at pointer. It better be right!*/
{
long nels; /*Number of elements in array*/
int k; /*Random counter*/
long *dimPtr; /*Pointer to dimensions and then some*/
real *destPtr; /*Pointer to destination within array*/
nels = 1;
dimPtr = DIMS(array);
for (k = 0; k < RANK(array); ++k)
{
nels *= *dimPtr;
++dimPtr;
}
destPtr = ELEMENTS(array);
while (nels)
{
*destPtr = *pointer;
++destPtr;
++pointer;
--nels;
}
}
#ifdef PROTO
void MinMax(real *min, real *max, real *elements, long nels)
#else
void MinMax(min, max, elements, nels)
real *min;
real *max;
real *elements;
long nels;
#endif
/*Returns the min and max of nels reals at elements*/
{
Bool firstTime = true;
while (nels)
{
if (*elements != missingData)
{
if (firstTime)
{
firstTime = false;
*min = *max = *elements;
}
else
{
if (*elements > *max) *max = *elements;
if (*elements < *min) *min = *elements;
}
}
++elements;
--nels;
}
}
void Array2CArray(pointer, array)
ObjPtr array;
real *pointer;
/*Fills data at pointer with array. It better be right!*/
{
int nels; /*Number of elements in array*/
int k; /*Random counter*/
long *dimPtr; /*Pointer to dimensions and then some*/
real *srcPtr; /*Pointer to source within array*/
nels = 1;
dimPtr = DIMS(array);
for (k = 0; k < ((APtr) array) -> rank; ++k)
{
nels *= *dimPtr;
++dimPtr;
}
srcPtr = ELEMENTS(array);
while (nels)
{
*pointer = *srcPtr;
++srcPtr;
++pointer;
--nels;
}
}
#ifdef PROTO
ObjPtr NewRealArray(int rank, ...)
#else
ObjPtr NewRealArray(rank)
int rank;
#endif
/*Makes a real array with rank rank and long dimensions starting after. For
example, to make a 20 by 25 by 30 array, use NewRealArray(3, 20, 25, 30).
An array of rank 0 has exactly one element. Arrays of negative rank will
return NIL, as will arrays too big to create in memory. Sets every element
of the array to zero*/
{
long numEls; /*Number of elements in array*/
register int k; /*Counter for random purposes*/
long *dimPtr; /*Pointer to the next dimension*/
APtr retVal; /*Value to return*/
real *runner; /*Runner for setting stuff to 0.0*/
real *elements; /*The elements of the array*/
long *dims; /*The dimensions of the array*/
/*Check for valid rank*/
if (rank < 0)
{
return (ObjPtr) NIL;
}
/*Calculate the number of elements*/
dimPtr = (long *) (&rank + 1);
numEls = 1;
for (k = 0; k < rank; ++k)
{
numEls *= *dimPtr;
++dimPtr;
}
/*Try to allocate the elements*/
elements = (real *) Alloc(numEls * sizeof(real));
if (!elements)
{
OMErr();
return NULLOBJ;
}
/*Try to allocate the dims*/
dims = 0;
if (rank)
{
dims = (long *) Alloc(rank * sizeof(long));
if (!dims)
{
Free(elements);
OMErr();
return NULLOBJ;
}
}
/*Try to allocate the array*/
retVal = (APtr) NewObject(realArrayClass,
sizeof(Array) - sizeof(Obj));
/*If can't, return NIL*/
if (!retVal)
{
OMErr();
Free(elements);
SAFEFREE(dims);
return NULLOBJ;
}
/*Put in the elements and dims*/
ELEMENTS(retVal) = elements;
DIMS(retVal) = dims;
/*Fill in values for flags and dimensions*/
SETOBJTYPE(retVal -> thing . flags, REALARRAY);
RANK(retVal) = rank;
dimPtr = (long *) (&rank + 1);
for (k = 0; k < rank; ++k)
{
DIMS(retVal)[k] = *dimPtr;
++dimPtr;
}
/*Zero the array*/
runner = ArrayMeat((ObjPtr) retVal);
while (numEls)
{
*runner = 0.0;
++runner;
--numEls;
}
return (ObjPtr) retVal;
}
#ifdef PROTO
ObjPtr NewArray(int arrayType, int rank, long *dimensions)
#else
ObjPtr NewArray(arrayType, rank, dimensions)
int arrayType;
int rank;
long *dimensions;
#endif
/*Makes an array of arrayType with rank rank and dimensions in an array of longs
pointed to by dimensions. Arrays of negative rank will return NIL, as will
arrays too big to create in memory. Sets every element of the array to zero
or NIL or whatever*/
{
long numEls; /*Number of elements in array*/
register int k; /*Counter for random purposes*/
APtr retVal; /*Value to return*/
long *dimPtr; /*Running pointer to dimensions*/
long *dims; /*Pointer to dimensions*/
ObjPtr superClass;
/*Check for valid rank*/
if (rank < 0)
{
return (ObjPtr) NIL;
}
/*Calculate the number of elements*/
numEls = 1;
dimPtr = dimensions;
for (k = 0; k < rank; ++k)
{
numEls *= *dimPtr;
++dimPtr;
}
/*Try to allocate the array*/
switch(arrayType)
{
case AT_REAL:
superClass = realArrayClass;
break;
case AT_OBJECT:
superClass = objectArrayClass;
break;
case AT_BYTE:
superClass = byteArrayClass;
break;
case AT_POINTER:
superClass = pointerArrayClass;
break;
case AT_SHORT:
superClass = shortArrayClass;
break;
default:
ReportError("NewArray", "Bad array type");
return ObjFalse;
}
retVal = (APtr) NewObject(superClass, sizeof(Array) - sizeof(Obj));
/*If can't, return NIL*/
if (!retVal)
{
OMErr();
return (ObjPtr) retVal;
}
ELEMENTS(retVal) = 0;
DIMS(retVal) = 0;
/*Try to allocate the elements*/
switch(arrayType)
{
case AT_REAL:
{
real *elements;
real *runner;
elements = (void *) Alloc(numEls * sizeof(real));
/*If can't, return NIL*/
if (!elements)
{
OMErr();
return NULLOBJ;
}
/*Put in the elements*/
ELEMENTS(retVal) = elements;
/*Fill in values for flags*/
SETOBJTYPE(retVal -> thing . flags, REALARRAY);
/*Zero the array*/
runner = elements;
while (numEls)
{
*runner = 0.0;
++runner;
--numEls;
}
}
break;
case AT_BYTE:
{
unsigned char *elements;
unsigned char *runner;
elements = (void *) Alloc(numEls * sizeof(unsigned char));
/*If can't, return NIL*/
if (!elements)
{
OMErr();
return NULLOBJ;
}
/*Put in the elements*/
ELEMENTS(retVal) = elements;
/*Fill in values for flags*/
SETOBJTYPE(retVal -> thing . flags, OT_BYTEARRAY);
/*Zero the array*/
runner = elements;
while (numEls)
{
*runner = 0;
++runner;
--numEls;
}
}
break;
case AT_SHORT:
{
short *elements;
short *runner;
elements = (void *) Alloc(numEls * sizeof(short));
/*If can't, return NIL*/
if (!elements)
{
OMErr();
return NULLOBJ;
}
/*Put in the elements*/
ELEMENTS(retVal) = elements;
/*Fill in values for flags*/
SETOBJTYPE(retVal -> thing . flags, OT_SHORTARRAY);
/*Zero the array*/
runner = elements;
while (numEls)
{
*runner = 0;
++runner;
--numEls;
}
}
break;
case AT_OBJECT:
{
ObjPtr *elements;
ObjPtr *runner;
elements = (void *) Alloc(numEls * sizeof(ObjPtr));
/*If can't, return NIL*/
if (!elements)
{
OMErr();
return NULLOBJ;
}
/*Put in the elements*/
ELEMENTS(retVal) = elements;
/*Fill in values for flags*/
SETOBJTYPE(retVal -> thing . flags, OBJECTARRAY);
/*Zero the array*/
runner = elements;
while (numEls)
{
*runner = NULLOBJ;
++runner;
--numEls;
}
}
break;
case AT_POINTER:
{
void **elements;
void **runner;
elements = (void *) Alloc(numEls * sizeof(ObjPtr));
/*If can't, return NIL*/
if (!elements)
{
OMErr();
return NULLOBJ;
}
/*Put in the elements*/
ELEMENTS(retVal) = elements;
/*Fill in values for flags*/
SETOBJTYPE(retVal -> thing . flags, OT_POINTERARRAY);
/*Zero the array*/
runner = elements;
while (numEls)
{
*runner = NULL;
++runner;
--numEls;
}
}
break;
default:
ReportError("NewArray", "Bad array type");
return NULLOBJ;
}
/*Try to allocate the dims*/
if (rank)
{
dims = (long *) Alloc(rank * sizeof(long));
if (!dims)
{
OMErr();
return NULLOBJ;
}
}
else
{
dims = 0;
}
DIMS(retVal) = dims;
/*Fill in rank and dimensions*/
retVal -> rank = rank;
dimPtr = dimensions;
for (k = 0; k < rank; ++k)
{
retVal -> dims[k] = *dimPtr;
++dimPtr;
}
return (ObjPtr) retVal;
}
#ifdef PROTO
ObjPtr ListToArray(ObjPtr list)
#else
ObjPtr ListToArray(list)
ObjPtr list;
#endif
/*Converts a list to a 1-dimensional object array*/
{
ObjPtr retVal;
long size;
ThingListPtr runner;
ObjPtr *elements;
long k;
size = ListCount(list);
retVal = NewArray(AT_OBJECT, 1, &size);
elements = ELEMENTS(retVal);
runner = LISTOF(list);
k = 0;
while (runner)
{
elements[k] = runner -> thing;
++k;
runner = runner -> next;
}
return retVal;
}
static ObjPtr MarkObjectArray(array)
ObjPtr array;
/*Marks an object array*/
{
long nels;
long *dimPtr;
long k;
ObjPtr *meat;
if (!IsObjArray(array))
{
/*Needed to avoid marking class*/
return ObjFalse;
}
nels = 1;
dimPtr = DIMS(array);
for (k = 0; k < RANK(array); ++k)
{
nels *= *dimPtr;
++dimPtr;
}
meat = (ObjPtr *) ELEMENTS(array);
while (nels)
{
if (*meat)
{
MarkObject(*meat);
}
++meat;
--nels;
}
return ObjTrue;
}
static ObjPtr CleanupArray(array)
ObjPtr array;
/*Cleans up an array by getting rid of its elements*/
{
if (ELEMENTS(array))
{
Free(ELEMENTS(array));
ELEMENTS(array) = 0;
}
if (DIMS(array))
{
Free(DIMS(array));
DIMS(array) = 0;
}
return ObjTrue;
}
static ObjPtr RegisterRealArray(field, whichField)
ObjPtr field;
int whichField;
/*Registers an array field in field slot whichField*/
{
Component *component = 0;
component = (Component *) Alloc(sizeof(Component));
if (!component)
{
OMErr();
return ObjFalse;
}
component -> flags = 0;
component -> indices = 0;
component -> dimensions = 0;
component -> steps = 0;
curFields[whichField] . components = component;
curFields[whichField] . nComponents = 1;
return RegisterComponent(whichField, 0, field) ? ObjTrue : ObjFalse;
}
static ObjPtr RegisterByteArray(field, whichField)
ObjPtr field;
int whichField;
/*Registers an array field in field slot whichField*/
{
Component *component = 0;
ObjPtr var;
component = (Component *) Alloc(sizeof(Component));
if (!component)
{
OMErr();
return ObjFalse;
}
component -> flags = 0;
component -> indices = 0;
component -> dimensions = 0;
component -> steps = 0;
curFields[whichField] . components = component;
curFields[whichField] . nComponents = 1;
return RegisterComponent(whichField, 0, field) ? ObjTrue : ObjFalse;
}
static ObjPtr RegisterObjectArray(field, whichField)
ObjPtr field;
int whichField;
/*Registers an object array field in field slot whichField*/
{
int nComponents;
int k;
long dimension;
Component *component = 0;
ObjPtr retVal;
if (RANK(field) != 1)
{
/*Only vectors allowed, bud.*/
ReportError("RegisterObjectArray", "Only vector object arrays can be used in datasets.");
return ObjFalse;
}
nComponents = DIMS(field)[0];
component = (Component *) Alloc(nComponents * sizeof(Component));
if (!component)
{
OMErr();
return ObjFalse;
}
for (k = 0; k < nComponents; ++k)
{
component[k] . flags = 0;
component[k] . indices = 0;
component[k] . dimensions = 0;
component[k] . steps = 0;
}
retVal = ObjTrue;
curFields[whichField] . components = component;
curFields[whichField] . nComponents = nComponents;
for (dimension = 0; dimension < nComponents; ++dimension)
{
ObjPtr temp;
temp = GetObjectElement(field, &dimension);
if (!RegisterComponent(whichField, dimension, temp))
{
retVal = false;
}
}
return retVal;
}
static ObjPtr RegisterByteComponent(field, whichField, whichComponent)
ObjPtr field;
int whichField, whichComponent;
/*Registers an array field in field slot whichField in component whichComponent*/
{
Component *component;
int *indices = 0;
long *dimensions = 0;
long *steps = 0;
ObjPtr indicesVar;
long dataSize;
int k;
ObjPtr var;
/*A scalar array, the simplest type of field*/
if (RANK(field))
{
indices = (int *) Alloc(RANK(field) * sizeof(int));
if (!indices)
{
OMErr();
return ObjFalse;
}
steps = (long *) Alloc(RANK(field) * sizeof(long));
if (!steps)
{
Free(indices);
OMErr();
return ObjFalse;
}
dimensions = (long *) Alloc(RANK(field) * sizeof(long));
if (!dimensions)
{
Free(indices);
Free(steps);
OMErr();
return ObjFalse;
}
}
else
{
steps = 0;
indices = 0;
dimensions = 0;
}
indicesVar = GetVar(field, INDICES);
if (indicesVar)
{
if (!IsRealArray(indicesVar) || RANK(indicesVar) != 1 || DIMS(indicesVar)[0] != RANK(field))
{
ReportError("ReigsterRealComponent", "Bad INDICES variable");
indicesVar = 0;
}
}
component = &(curFields[whichField] . components[whichComponent]);
/*Fill in dimensions, indices, and steps*/
dataSize = 1;
for (k = RANK(field) - 1; k >= 0; --k)
{
if (indicesVar)
{
indices[k] = ((real *) ELEMENTS(indicesVar))[k];
}
else
{
indices[k] = k;
}
dimensions[k] = DIMS(field)[k];
dataSize *= DIMS(field)[k];
steps[k] =
(k == RANK(field) - 1) ?
1 :
dimensions[k + 1] * steps[k + 1];
}
var = GetVar(field, CTABLE);
if (var && IsRealArray(var) && RANK(var) == 1 && DIMS(var)[0] == 256)
{
Array2CArray(&(component -> cTable), var);
}
else
{
for (k = 0; k < 256; ++k)
{
component -> cTable[k] = (real) k;
}
}
component -> data . comp = ELEMENTS(field);
component -> dataCompressed = true;
component -> dataSize = dataSize;
component -> nIndices = RANK(field);
component -> indices = indices;
component -> dimensions = dimensions;
component -> steps = steps;
return ObjTrue;
}
static ObjPtr RegisterRealComponent(field, whichField, whichComponent)
ObjPtr field;
int whichField, whichComponent;
/*Registers an array field in field slot whichField in component whichComponent*/
{
Component *component;
int *indices = 0;
long *dimensions = 0;
long *steps = 0;
ObjPtr indicesVar;
long dataSize;
int k;
/*A scalar array, the simplest type of field*/
if (RANK(field))
{
indices = (int *) Alloc(RANK(field) * sizeof(int));
if (!indices)
{
OMErr();
return ObjFalse;
}
steps = (long *) Alloc(RANK(field) * sizeof(long));
if (!steps)
{
Free(indices);
OMErr();
return ObjFalse;
}
dimensions = (long *) Alloc(RANK(field) * sizeof(long));
if (!dimensions)
{
Free(indices);
Free(steps);
OMErr();
return ObjFalse;
}
}
else
{
steps = 0;
indices = 0;
dimensions = 0;
}
indicesVar = GetVar(field, INDICES);
if (indicesVar)
{
if (!IsRealArray(indicesVar) || RANK(indicesVar) != 1 || DIMS(indicesVar)[0] != RANK(field))
{
ReportError("ReigsterRealComponent", "Bad INDICES variable");
indicesVar = 0;
}
}
component = &(curFields[whichField] . components[whichComponent]);
/*Fill in dimensions, indices, and steps*/
dataSize = 1;
for (k = RANK(field) - 1; k >= 0; --k)
{
if (indicesVar)
{
indices[k] = ((real *) ELEMENTS(indicesVar))[k];
}
else
{
indices[k] = k;
}
dimensions[k] = DIMS(field)[k];
dataSize *= DIMS(field)[k];
steps[k] =
(k == RANK(field) - 1) ?
1 :
dimensions[k + 1] * steps[k + 1];
}
component -> data . unComp = ELEMENTS(field);
component -> dataCompressed = false;
component -> dataSize = dataSize;
component -> nIndices = RANK(field);
component -> indices = indices;
component -> dimensions = dimensions;
component -> steps = steps;
return ObjTrue;
}
ObjPtr GetArrayTopDim(array)
ObjPtr array;
/*Gets the topological dimension of array*/
{
return NewInt(RANK(array));
}
ObjPtr GetObjArrayTopDim(array)
ObjPtr array;
/*Gets the topological dimension of array*/
{
FuncTyp method;
ObjPtr firstElement;
long dimension;
dimension = 0;
firstElement = GetObjectElement(array, &dimension);
method = GetMethod(firstElement, GETTOPDIM);
if (method)
{
return (*method)(firstElement);
}
else
{
return NewInt(0);
}
}
#ifdef PROTO
ObjPtr GetObjectElement(ObjPtr array, long *dims)
#else
ObjPtr GetObjectElement(array, dims)
ObjPtr array;
long *dims;
#endif
/*Gets a element specified by dims within array, assuming that
array is an object array. There had better be enough dims.*/
{
long offset;
int k;
ObjPtr *elements;
if (!IsObjArray(array))
{
return NULLOBJ;
}
offset = 0;
for (k = 0; k < RANK(array); ++k)
{
if (k)
{
offset *= DIMS(array)[k];
}
offset += dims[k];
}
elements = (ObjPtr *) ELEMENTS(array);
/*Hey, John! Put your code in here!*/
return elements[offset];
}
#ifdef PROTO
void InitArrays(void)
#else
void InitArrays()
#endif
/*Initializes the array system*/
{
arrayClass = NewObject(NULLOBJ, sizeof(Array) - sizeof(Obj));
ELEMENTS(arrayClass) = 0;
DIMS(arrayClass) = 0;
AddToReferenceList(arrayClass);
SetMethod(arrayClass, CLEANUP, CleanupArray);
SetMethod(arrayClass, GETTOPDIM, GetArrayTopDim);
realArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
ELEMENTS(realArrayClass) = 0;
DIMS(realArrayClass) = 0;
AddToReferenceList(realArrayClass);
SetMethod(realArrayClass, REGISTERFIELD, RegisterRealArray);
SetMethod(realArrayClass, REGISTERCOMP, RegisterRealComponent);
#ifdef SOCKETS
#if MACHINE == IRIS4D
#ifdef FASTSOCKETS
fprintf(stderr, "Using fast, raw data sockets\n");
SetMethod(realArrayClass, TRANSMITEXTRA, TransmitExtraStuffRealArrayRaw);
SetMethod(realArrayClass, RECEIVEEXTRA, ReceiveExtraStuffRealArrayRaw);
#else
fprintf(stderr, "Using slow, ascii data sockets\n");
SetMethod(realArrayClass, TRANSMITEXTRA, TransmitExtraStuffRealArrayAscii);
SetMethod(realArrayClass, RECEIVEEXTRA, ReceiveExtraStuffRealArrayAscii);
#endif
#else
fprintf(stderr, "Using slow, ascii data sockets\n");
SetMethod(realArrayClass, TRANSMITEXTRA, TransmitExtraStuffRealArrayAscii);
SetMethod(realArrayClass, RECEIVEEXTRA, ReceiveExtraStuffRealArrayAscii);
#endif
#endif
byteArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
ELEMENTS(byteArrayClass) = 0;
DIMS(byteArrayClass) = 0;
AddToReferenceList(byteArrayClass);
SetMethod(byteArrayClass, REGISTERFIELD, RegisterByteArray);
SetMethod(byteArrayClass, REGISTERCOMP, RegisterByteComponent);
pointerArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
ELEMENTS(pointerArrayClass) = 0;
DIMS(pointerArrayClass) = 0;
AddToReferenceList(pointerArrayClass);
shortArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
ELEMENTS(shortArrayClass) = 0;
DIMS(shortArrayClass) = 0;
AddToReferenceList(shortArrayClass);
objectArrayClass = NewObject(arrayClass, sizeof(Array) - sizeof(Obj));
ELEMENTS(objectArrayClass) = 0;
DIMS(objectArrayClass) = 0;
AddToReferenceList(objectArrayClass);
SetMethod(objectArrayClass, MARK, MarkObjectArray);
SetMethod(objectArrayClass, REGISTERCOMP, (FuncTyp) 0);
SetMethod(objectArrayClass, REGISTERFIELD, RegisterObjectArray);
SetMethod(objectArrayClass, GETTOPDIM, GetObjArrayTopDim);
#ifdef SOCKETS
SetMethod(objectArrayClass, TRANSMITEXTRA, TransmitExtraStuffObjectArray);
SetMethod(objectArrayClass, RECEIVEEXTRA, ReceiveExtraStuffObjectArray);
#endif
}
#ifdef PROTO
void KillArrays(void)
#else
void KillArrays()
#endif
/*Kills the array system*/
{
DeleteThing(objectArrayClass);
DeleteThing(pointerArrayClass);
DeleteThing(byteArrayClass);
DeleteThing(realArrayClass);
DeleteThing(arrayClass);
}
|
