Posts: 3,983
Threads: 178
Joined: Apr 2022
Reputation:
222
(06-20-2024, 05:16 PM)SMcNeill Wrote: (06-20-2024, 05:10 PM)bplus Wrote: Quote:And I's brokes it already!
reread my reply 13, expansion only
Code: (Select All)
REDIM Grid(1 TO 5, 1 TO 5) AS LONG
' LoadInitialValues
FOR y = 1 TO 5
FOR x = 1 TO 5
counter = counter + 1
Grid(x, y) = counter
NEXT
NEXT
ShowArrayValues Grid()
moreXPerRow Grid(), 4, 10
ShowArrayValues Grid()
END
SUB moreXPerRow (arr() AS LONG, xpr AS LONG, r AS LONG) ' xpr x per row
DIM AS LONG lbx, lby, ubx, uby
lbx = LBOUND(arr, 1)
lby = LBOUND(arr, 2)
ubx = UBOUND(arr, 1)
uby = UBOUND(arr, 2)
DIM c(lbx TO ubx, lby TO uby) AS LONG
FOR y = lby TO uby
FOR x = lbx TO uby
c(x, y) = arr(x, y)
NEXT
NEXT
REDIM arr(xpr, r) ' fixed
'ReDim _Preserve arr(xpr, r) 'nope
'ReDim _Preserve arr(lbx To xpr, lby To r)
'ReDim _Preserve arr(lbx To xpr, lby To r) As Long ' nope
FOR y = lby TO uby
FOR x = lbx TO uby
IF x <= xpr THEN arr(x, y) = c(x, y)
NEXT
NEXT
END SUB
SUB ShowArrayValues (arr() AS LONG)
PRINT "Array Values:": PRINT
FOR y = 1 TO UBOUND(arr, 2)
PRINT USING "Row ## "; y,
FOR x = 1 TO UBOUND(arr, 1)
PRINT USING " ##"; arr(x, y);
NEXT
PRINT
NEXT
PRINT
END SUB
There. I fixed it for downsizing one, while expanding on the other index. 
ok even more handy! 
b = b + ...
Posts: 3,983
Threads: 178
Joined: Apr 2022
Reputation:
222
(06-20-2024, 05:40 PM)Dimster Wrote: CoPilot says it can REDim a 3 Dim array into a $ dim array and preserve the values from the original array. Here is it's suggestion.
Certainly! To redimension a 3D array to a 4D array while preserving all values in QB64pe, you can follow these steps:
- Let’s assume you have a 3D array called
with the shape
Code: (Select All) (n_bands, y_pixels, x_pixels)
- First, swap the
Code: (Select All) n_bands
Code: (Select All) DIM SHARED arr(1 TO n_bands, 1 TO y_pixels, 1 TO x_pixels)
DIM SHARED arr4d(1 TO 1, 1 TO y_pixels, 1 TO x_pixels, 1 TO n_bands)
FOR x = 1 TO x_pixels
FOR y = 1 TO y_pixels
FOR z = 1 TO n_bands
arr4d(1, y, x, z) = arr(z, y, x)
NEXT z
NEXT y
NEXT x
- Now you have a 4D array
with the desired shape
Code: (Select All) (1, y_pixels, x_pixels, n_bands)
Remember to adjust the array dimensions and indices according to your specific use case!
I'll have to see if Gemini can do it.
Yeah this is fine because there is no issue with trying to use the same array name with the different dimensions.
while on the subject you can make a 1 d array, a list, into many dimensions with a little math manipulation. As steve has shown, i think, in memory it's all 1 d.
b = b + ...
Posts: 2,698
Threads: 328
Joined: Apr 2022
Reputation:
218
Why would you swap the first index to the last position??? Something seems kinda jank there to me. LOL!
Posts: 2,698
Threads: 328
Joined: Apr 2022
Reputation:
218
I'm thinking this should now resize on both dimentsions, up or down, while preserving the original data:
Code: (Select All)
'Expanded upon by Steve-the-AMAZING(tm) from what bplus had originally 
REDIM Grid(1 TO 5, 1 TO 5) AS LONG
' LoadInitialValues
FOR y = 1 TO 5
FOR x = 1 TO 5
counter = counter + 1
Grid(x, y) = counter
NEXT
NEXT
ShowArrayValues Grid()
Redim2D Grid(), 0, 6, 3, 4
ShowArrayValues Grid()
END
SUB Redim2D (arr() AS LONG, xlb AS LONG, xub, ylb AS LONG, yub AS LONG) ' xpr x per row
DIM AS LONG lbx, lby, ubx, uby
lbx = LBOUND(arr, 1)
lby = LBOUND(arr, 2)
ubx = UBOUND(arr, 1)
uby = UBOUND(arr, 2)
DIM c(lbx TO ubx, lby TO uby) AS LONG
FOR y = lby TO uby
FOR x = lbx TO uby
c(x, y) = arr(x, y)
NEXT
NEXT
REDIM arr(xlb TO xub, ylb TO yub) ' fixed
'ReDim _Preserve arr(xpr, r) 'nope
'ReDim _Preserve arr(lbx To xpr, lby To r)
'ReDim _Preserve arr(lbx To xpr, lby To r) As Long ' nope
FOR y = lby TO uby
IF y >= ylb AND y <= yub THEN
FOR x = lbx TO uby
IF x >= xlb AND x <= xub THEN arr(x, y) = c(x, y)
NEXT
END IF
NEXT
END SUB
SUB ShowArrayValues (arr() AS LONG)
PRINT "Array Values:": PRINT
FOR y = LBOUND(arr, 2) TO UBOUND(arr, 2)
PRINT USING "Row ## "; y,
FOR x = LBOUND(arr, 1) TO UBOUND(arr, 1)
PRINT USING " ##"; arr(x, y);
NEXT
PRINT
NEXT
PRINT
END SUB
Posts: 3,983
Threads: 178
Joined: Apr 2022
Reputation:
222
(06-20-2024, 06:07 PM)SMcNeill Wrote: I'm thinking this should now resize on both dimentsions, up or down, while preserving the original data:
Code: (Select All)
'Expanded upon by Steve-the-AMAZING(tm) from what bplus had originally
REDIM Grid(1 TO 5, 1 TO 5) AS LONG
' LoadInitialValues
FOR y = 1 TO 5
FOR x = 1 TO 5
counter = counter + 1
Grid(x, y) = counter
NEXT
NEXT
ShowArrayValues Grid()
Redim2D Grid(), 0, 6, 3, 4
ShowArrayValues Grid()
END
SUB Redim2D (arr() AS LONG, xlb AS LONG, xub, ylb AS LONG, yub AS LONG) ' xpr x per row
DIM AS LONG lbx, lby, ubx, uby
lbx = LBOUND(arr, 1)
lby = LBOUND(arr, 2)
ubx = UBOUND(arr, 1)
uby = UBOUND(arr, 2)
DIM c(lbx TO ubx, lby TO uby) AS LONG
FOR y = lby TO uby
FOR x = lbx TO uby
c(x, y) = arr(x, y)
NEXT
NEXT
REDIM arr(xlb TO xub, ylb TO yub) ' fixed
'ReDim _Preserve arr(xpr, r) 'nope
'ReDim _Preserve arr(lbx To xpr, lby To r)
'ReDim _Preserve arr(lbx To xpr, lby To r) As Long ' nope
FOR y = lby TO uby
IF y >= ylb AND y <= yub THEN
FOR x = lbx TO uby
IF x >= xlb AND x <= xub THEN arr(x, y) = c(x, y)
NEXT
END IF
NEXT
END SUB
SUB ShowArrayValues (arr() AS LONG)
PRINT "Array Values:": PRINT
FOR y = LBOUND(arr, 2) TO UBOUND(arr, 2)
PRINT USING "Row ## "; y,
FOR x = LBOUND(arr, 1) TO UBOUND(arr, 1)
PRINT USING " ##"; arr(x, y);
NEXT
PRINT
NEXT
PRINT
END SUB
hmm... amazing ;-)) what happened to 5th value on row 3 and 4
Code: (Select All) 'Expanded upon by Steve-the-AMAZING(tm) from what bplus had originally Wink
ReDim Grid(1 To 5, 1 To 5) As Long
' LoadInitialValues
For y = 1 To 5
For x = 1 To 5
counter = counter + 1
Grid(x, y) = counter
Next
Next
ShowArrayValues Grid()
Redim2D Grid(), 0, 6, 3, 4
ShowArrayValues Grid()
Redim2D Grid(), 1, 5, 1, 5
ShowArrayValues Grid()
End
Sub Redim2D (arr() As Long, xlb As Long, xub, ylb As Long, yub As Long) ' xpr x per row
Dim As Long lbx, lby, ubx, uby
lbx = LBound(arr, 1)
lby = LBound(arr, 2)
ubx = UBound(arr, 1)
uby = UBound(arr, 2)
Dim c(lbx To ubx, lby To uby) As Long
For y = lby To uby
For x = lbx To uby
c(x, y) = arr(x, y)
Next
Next
ReDim arr(xlb To xub, ylb To yub) ' fixed
'ReDim _Preserve arr(xpr, r) 'nope
'ReDim _Preserve arr(lbx To xpr, lby To r)
'ReDim _Preserve arr(lbx To xpr, lby To r) As Long ' nope
For y = lby To uby
If y >= ylb And y <= yub Then
For x = lbx To uby
If x >= xlb And x <= xub Then arr(x, y) = c(x, y)
Next
End If
Next
End Sub
Sub ShowArrayValues (arr() As Long)
Print "Array Values:": Print
For y = LBound(arr, 2) To UBound(arr, 2)
Print Using "Row ## "; y,
For x = LBound(arr, 1) To UBound(arr, 1)
Print Using " ##"; arr(x, y);
Next
Print
Next
Print
End Sub
b = b + ...
Posts: 2,698
Threads: 328
Joined: Apr 2022
Reputation:
218
Typo here: For x = lbx To uby
Change to: For x = lbx To ubx
Code: (Select All)
'Expanded upon by Steve-the-AMAZING(tm) from what bplus had originally
REDIM Grid(1 TO 5, 1 TO 5) AS LONG
' LoadInitialValues
FOR y = 1 TO 5
FOR x = 1 TO 5
counter = counter + 1
Grid(x, y) = counter
NEXT
NEXT
ShowArrayValues Grid()
Redim2D Grid(), 0, 6, 3, 4
ShowArrayValues Grid()
Redim2D Grid(), 1, 5, 1, 5
ShowArrayValues Grid()
END
SUB Redim2D (arr() AS LONG, xlb AS LONG, xub, ylb AS LONG, yub AS LONG) ' xpr x per row
DIM AS LONG lbx, lby, ubx, uby
lbx = LBOUND(arr, 1)
lby = LBOUND(arr, 2)
ubx = UBOUND(arr, 1)
uby = UBOUND(arr, 2)
DIM c(lbx TO ubx, lby TO uby) AS LONG
FOR y = lby TO uby
FOR x = lbx TO ubx
c(x, y) = arr(x, y)
NEXT
NEXT
REDIM arr(xlb TO xub, ylb TO yub) ' fixed
'ReDim _Preserve arr(xpr, r) 'nope
'ReDim _Preserve arr(lbx To xpr, lby To r)
'ReDim _Preserve arr(lbx To xpr, lby To r) As Long ' nope
FOR y = lby TO uby
IF y >= ylb AND y <= yub THEN
FOR x = lbx TO ubx
IF x >= xlb AND x <= xub THEN arr(x, y) = c(x, y)
NEXT
END IF
NEXT
END SUB
SUB ShowArrayValues (arr() AS LONG)
PRINT "Array Values:": PRINT
FOR y = LBOUND(arr, 2) TO UBOUND(arr, 2)
PRINT USING "Row ## "; y,
FOR x = LBOUND(arr, 1) TO UBOUND(arr, 1)
PRINT USING " ##"; arr(x, y);
NEXT
PRINT
NEXT
PRINT
END SUB
Posts: 3,983
Threads: 178
Joined: Apr 2022
Reputation:
222
06-20-2024, 07:51 PM
(This post was last modified: 06-20-2024, 07:52 PM by bplus.)
ha yeah i figured it would be something like that but i couldn't see it
i am keeping this, who knows if this will come in handy some day, maybe sooner than i think!
b = b + ...
Posts: 10
Threads: 3
Joined: Jun 2024
Reputation:
2
(06-20-2024, 04:00 PM)SMcNeill Wrote: The problem with adding it into the source is simple: How do you account for all possible variations of array that a user might have?
DIM x(0 to 1, 1 to 4)
REDIM x(1 to 3, 4 to 17) <--- Now what the heck does the source look like for this??
DIM x(-1 to 3, 2 to 14, 1 to 27, 11, apple_number, cheestos, and_frogs) <-- and what would the source look like to handle this when its redimmed? Sigh. 90% of programming seems to be dealing with the edge cases. Your explanation is really clear.
One question I have: how does QB64 store the LBOUNDS and UBOUNDS for an array? Could you point me to the data structure in source?
It seems that QB wants to keep all of the data in the array and just change the indexes that point to the data. Is that true? I'm not sure I understand the reasoning behind that, but I'd love to know.
Posts: 10
Threads: 3
Joined: Jun 2024
Reputation:
2
WOW! I walked away for a bit and found a flurry of solutions.
All while I was working on my own solution... heh.
Code: (Select All)
SUB Resize2DArray (Array(), yLowerNew, yUpperNew, xLowerNew, xUpperNew)
'
' Redimension a two-dimensional array by altering the upper
' and/or lower bounds of either dimension.
'
' The new array's existing elements will be in the
' same (x,y) position as they were previously.
'
' If reducing an array dimension, DATA LOSS WILL OCCUR.
'
'
DIM y, x
DIM yLowerCurrent, yUpperCurrent, xLowerCurrent, xUpperCurrent
DIM yLower, xLower, yUpper, xUpper
' start by getting our current array boundaries
yLowerCurrent = LBOUND(Array, 1)
yUpperCurrent = UBOUND(Array, 1)
xLowerCurrent = LBOUND(Array, 2)
xUpperCurrent = UBOUND(Array, 2)
' do we actually require a resize?
IF yLowerNew = yLowerCurrent AND xLowerNew = xLowerCurrent AND yUpperNew = yUpperCurrent AND xUpperNew = xUpperCurrent THEN
EXIT SUB
END IF
' Find the smaller of the lower bounds and the larger of
' the upper bounds.
yLower = (yLowerNew + yLowerCurrent + ABS(yLowerNew - yLowerCurrent)) / 2
xLower = (xLowerNew + xLowerCurrent + ABS(xLowerNew - xLowerCurrent)) / 2
yUpper = (yUpperNew + yUpperCurrent - ABS(yUpperNew - yUpperCurrent)) / 2
xUpper = (xUpperNew + xUpperCurrent - ABS(xUpperNew - xUpperCurrent)) / 2
' create a temporary array with the updated dimensions
DIM Temp(yLowerNew TO yUpperNew, xLowerNew TO xUpperNew)
' Copy original array values to new array
FOR y = yLower TO yUpper
FOR x = xLower TO xUpper
Temp(y, x) = Array(y, x)
NEXT
NEXT
' redimension original array
REDIM Array(yLowerNew TO yUpperNew, xLowerNew TO xUpperNew)
' copy temporary values back to original array
FOR y = yLower TO yUpper
FOR x = xLower TO xUpper
Array(y, x) = Temp(y, x)
NEXT
NEXT
END SUB
Posts: 1,000
Threads: 50
Joined: May 2022
Reputation:
27
The manual for Quick- and QBasic: "Neither the type nor the dimension of an array may be changed."
I don't know what you're doing, but I don't think it's solid.
Quote:When reducing an array dimension, DATA LOSS OCCURS.
Well, what do you know! If I reduce a 5X5 array to 4X4, data is lost... Thanks!
Let's see where this ends up!
|
