I have a function, which i called InterpolLinear
Function InterpolLinear(x, xvalues, yvalues)
x1 = Application.WorksheetFunction.Index(xvalues, Application.WorksheetFunction.Match(x, xvalues, 1))
x2 = Application.WorksheetFunction.Index(xvalues, Application.WorksheetFunction.Match(x, xvalues, 1) + 1)
y1 = Application.WorksheetFunction.Index(xvalues, Application.WorksheetFunction.Match(y, xvalues, 1))
y2 = Application.WorksheetFunction.Index(xvalues, Application.WorksheetFunction.Match(y, xvalues, 1) + 1)
InterpolLinear = y1 + (y2 - y1) * (x - x1) / (x2 - x1)
EndFunction
I want the function to automatically select all the x values and all the y values, without having to adjust it manually. I can have 10 x and y values, or 100. The function is working ok, but i have to adjust the selection manually.
I took 2 screenshots.
You just need to define two named ranges which adjust dynamically. Add a named range, say x_values and define it by
=$E$1:INDEX($E:$E;MATCH(1000000;$E:$E;1))
Do the same for y_values, changing the references to column F. Then
=LinInterp(D1;x_values;y_values)
note, your images used the function LinInterp and your code uses the function InterpolLinear, so just make sure you're consistent
Also, you can assign your variables more simply, for example:
x1 = xvalues.Cells(Application.Match(x, xvalues, 1),1).Value
Related
I'm making a mod for some game, and I'm using a base tile-map that I want to be scaleable to a bigger map. However, when I just use a "nearest-neighbour" kind of scaling the map will have hard square edges. I want to prevent this.
So I have a tilemap, something like this:
- - X -
- X X X
X X X X
X X - -
With my current scaling I get something like:
- - - - X X - -
- - - - X X - -
- - X X X X X X
- - X X X X X X
X X X X X X X X
X X X X X X X X
X X X X - - - -
X X X X - - - -
Which has some hard edges as you can see. I would like them to be more smooth:
- - - - X X - -
- - - X X X X -
- - X X X X X X
- X X X X X X X
X X X X X X X X
X X X X X X X X
X X X X X X - -
X X X X - - - -
I wasn't sure what to call this, so my search didn't turn up much.
How can I do something like this?
Note that there are several different kinds of tiles, and no in-between tile types.
So I played around a bit myself, and found something that seems to work quite well.
Here's what I do (Lua):
--First get the cells you're between (x and y are real numbers, not ints)
local top = math.floor(y)
local bottom = (top + 1)
local left = math.floor(x)
local right = (left + 1)
--Then calculate weights. These are basically 1 - the distance. The distance is scaled to be between 0 and 1.
local sqrt2 = math.sqrt(2)
local w_top_left = 1 - math.sqrt((top - y)*(top - y) + (left - x)*(left - x)) / sqrt2
local w_top_right = 1 - math.sqrt((top - y)*(top - y) + (right - x)*(right - x)) / sqrt2
local w_bottom_left = 1 - math.sqrt((bottom - y)*(bottom - y) + (left - x)*(left - x)) / sqrt2
local w_bottom_right = 1 - math.sqrt((bottom - y)*(bottom - y) + (right - x)*(right - x)) / sqrt2
--Then square these weights, which makes it look better
w_top_left = w_top_left * w_top_left
w_top_right = w_top_right * w_top_right
w_bottom_left = w_bottom_left * w_bottom_left
w_bottom_right = w_bottom_right * w_bottom_right
--Now get the codes (or types) of the surrounding tiles
local c_top_left = decompressed_map_data[top % height][left % width]
local c_top_right = decompressed_map_data[top % height][right % width]
local c_bottom_left = decompressed_map_data[bottom % height][left % width]
local c_bottom_right = decompressed_map_data[bottom % height][right % width]
--Next calculate total weights for codes
-- So add together the weights of surrounding tiles if they have the same type
local totals = {}
add_to_total(totals, w_top_left, c_top_left) --see below for this helper func
add_to_total(totals, w_top_right, c_top_right)
add_to_total(totals, w_bottom_left, c_bottom_left)
add_to_total(totals, w_bottom_right, c_bottom_right)
--Lastly choose final code, which is the tile-type with the highest weight
local code = nil
local weight = 0
for _, total in pairs(totals) do
if total.weight > weight then
code = total.code
weight = total.weight
end
end
return terrain_codes[code]
-- Helper function
local function add_to_total(totals, weight, code)
if totals[code] == nil then
totals[code] = {code=code, weight=weight}
else
totals[code].weight = totals[code].weight + weight
end
end
And voila. This select an exact tile-type for any x/y value even when they are not integers, thus making it possible to scale your grid. I'm not sure if there are better ways, but it works and looks good. In the end I also added some random number to the weights, to make the edges a little less straight which looks better in Factorio when scaling very high.
I need to use two Loops and the easy part is to count how many times does a "submodul" repeats in a defined and known range ("B3","B18"), this means the quantity of elements each submodul has. The difficult part comes when trying to count how many times does a "position" repeats for each different "submodul", this is because the amount of elements of each "submodul" is different so I have to adjust a range in a especial Loop to calculate how many times does a specific element (=Position) repeats within a "submodul".
The specific part that I need help with is the following:
positionrepetition = Application.CountIf(Worksheets("Sheet2").range("cells(3 + x + y - 1, 3)", "cells(3 + x + y - 1 + submodulrepetition,3"), position)
If I can manage to write it in a correct format I believe it will work. The problem is that normally I only use the range function when I know that the range is fixed or known, it doesn´t have to be calculated. I normally write for example: Range("A1","F10").Select
As you can see this is a fixed range, so I imagined that instead of using the format of Range("A1", "F10") I could use the range function with the arguments ("Cells(1,1)","Cells(10,6)"). Please correct me if I´m wrong.
Here is the rest of the code for the Loop.
For x = 0 To numberofparts
If Cells(3 + x, 18) = "1" Then
submodul = Cells(3 + x, 2).Value
submodulrepetition = Application.CountIf(Worksheets("Sheet2").range("B3", "B18"), submodul)
For y = 1 To submodulrepetition
position = Cells(3 + x + y - 1, 3).Value
positionrepetition = Application.CountIf(Worksheets("Sheet2").range("cells(3 + x + y - 1, 3)", "cells(3 + x + y - 1 + submodulrepetition,3"), position)
Next
Else
End If
x = x + submodulrepetition - 1
Next
To explain a little more, all data is gathered from Excel Sheets:
-All Information is gathered from a Excel sheet
-The "submodules" are in column B and they are arranged in numerical order. Every submodul repeats in this column as many elements it has.
-The "positions" (elements of the submodules) are in column C and can also repeat in the same column and even in other "Submodul"s.
All help will be appreciated and I thank you in advance.
Alejandro Farina
Change your line:
positionrepetition = Application.CountIf(Worksheets("Sheet2").Range("cells(3 + x + y - 1, 3)", "cells(3 + x + y - 1 + submodulrepetition,3"), Position)
With :
positionrepetition = Application.CountIf(Worksheets("Sheet2").Range(Cells(3 + x + y - 1, 3), Cells(3 + x + y - 1 + submodulrepetition, 3), Position))
If the Range is going to Change by Column/Row use the following code to get the end of column or row:
Dim GetColEnd, GetRowEnd As Integer
GetColEnd = Sheets("Sheet_Name").Cells(1, .Columns.Count).End(xlToLeft).Column
GetRowEnd = Sheets("Sheet_Name").Cells(Rows.Count, 1).End(xlUp).Row
Use the GetColEnd GetRowEnd in your Range function for flexible Column\Row for example as follows:
Sheets("Sheet_Name").Range(Cells(1,1),Cells(GetRowEnd,GetColEnd)
I am using VBA for the first time. I started with a very basic code using Runga Kutta Method. I am not able to run it. Can I know where I am going wrong? Can you also post some solutions for this type of differential equation solvers?
Option Explicit
Dim K1 As Double
Dim K2 As Double
Dim K3 As Double
Dim K4 As Double
Dim y As Double
Dim x As Double
Dim dx As Double
Dim x0 As Integer
Dim y0 As Integer
Function f(x, y) As Double
f = 0.5 * x - 0.5 * y
End Function
Sub RK(x, y, dx)
Dim i As Integer
Dim ynew As Double
dx = 0.5
x0 = 0
y0 = 1
K1 = dx * f(x, y)
K2 = dx * f(x + dx / 2, y + K1 / 2)
K3 = dx * f(x + dx / 2, y + K2 / 2)
K4 = dx * f(x + dx, y + K3)
RK = y + ((K1 + 2 * (K2 + K3 + K4)) / 6)
For i = 0 To 6
ynew = RK(x, y, dx)
x = x + dx
y = ynew
Next i
For j = 1 To 6
Call RK(x, y, dx, ynew)
ActiveCell.Offset(i - 1, 1).Value = x
ActiveCell.Offset(i - 1, 2).Value = y
x = x + dx
y = ynew
Next
End Sub
You need to execute the RK procedure and give it the starting values of x, y and dx.
To do this from within the VBE (Visual Basic Editor) open the Immediate window. If it's not visible press Ctrl+G and it should appear at the bottom of the VBE.
In the Immediate window type something like RK 1, 3, 2 and the results will appear in the two columns to the right of the active cell and take up 6 rows.
If you want the procedure to execute on the press of a button, or when a value is updated you'll need to add an extra bit of code for that.
Edit:
Just noticed these lines - RK = y + ((K1 + 2 * (K2 + K3 + K4)) / 6) and ynew = RK(x, y, dx).
The RK procedure won't return a value and you can't set it as a value either.
This link may help explain it: http://what-when-how.com/excel-vba/vba-sub-and-function-procedures/
I'm trying to make a function in Lua or VB based code to draw / plot a filled ellipse.
I don't have much knowledge about this math and I can use some help.
I Googled everything there is to Google about drawing ellipses with code but I can't find a good simple working example in VB or Lua for a filled one.
On a previous post on this site I did get an answer about how to draw a normal ellipse but nothing came up for a filled one, that's why i make a new topic for a filled one.
Here are a few websites I visited but I can't find a way to make a filled ellipse without redrawing already drawed pixels...
https://sites.google.com/site/ruslancray/lab/projects/bresenhamscircleellipsedrawingalgorithm/bresenham-s-circle-ellipse-drawing-algorithm
http://groups.csail.mit.edu/graphics/classes/6.837/F98/Lecture6/circle.html
http://www.blitzbasic.com/codearcs/codearcs.php?code=2817
http://hackipedia.org/Algorithms/Graphics/pdf/A%20Fast%20Bresenham%20Type%20Algorithm%20For%20Drawing%20Ellipses%20by%20John%20Kennedy.pdf
https://scratch.mit.edu/projects/49873666/
http://www.sourcecodesworld.com/source/show.asp?ScriptID=112
Here is the code I have for a normal ellipse (thanks to "Johnny Strings" for the VB version):
function DrawEllipse(xc,yc,w,h)
local w2 = w * w
local h2 = h * h
local fw2 = 4 * w2
local fh2 = 4 * h2
xc = xc + w
yc = yc + h
local x = 0
local y = h
local s = 2 * h2 + w2 * (1 - h)
while h2 * x <= w2 * y do
dot(xc + x, yc + y)
dot(xc - x, yc + y)
dot(xc + x, yc - y)
dot(xc - x, yc - y)
redraw()inkey()
color(int(rnd()*255),int(rnd()*255),int(rnd()*255))
if s >= 0 then
s = s + fw2 * (1 - y)
y = y - 1
end
s = s + h2 * ((4 * x) + 6)
x = x + 1
end
x = w
y = 0
s = 2 * w2 + h2 * (1 - w)
while w2 * y <= h2 * x do
dot(xc + x, yc + y)
dot(xc - x, yc + y)
dot(xc + x, yc - y)
dot(xc - x, yc - y)
redraw()inkey()
color(int(rnd()*255),int(rnd()*255),int(rnd()*255))
if s >= 0 then
s = s + fh2 * (1 - x)
x = x - 1
end
s = s + w2 * ((4 * y) + 6)
y = y + 1
end
end
Here's what I came up with for my CPU renderer in the past. It's very efficient and very simple too.
It relies on the mathematical definition of the ellipse, so the ellipse is drawn centered at x,y and has the width and height defined from the center, not from the other side.
The draw point function draws a pixel at the x by y point specified.
local function drawaxisalignedellipse(x,y,w,h)
--n Defines the bounds of the horizontal lines which fill the ellipse.
local n=w
local w2=w*w
local h2=h*h
--draws the center horizontal line.
for i=x-w,x+w do
drawpoint(i,y)
end
for j=1,h do
--The current top and bottom rows.
local ra,rb=y+j,y-j
--This loop removes 1 from n until it is within the shape
while w2*(h2-j*j)<h2*n*n and n~=0 do n=n-1 end
--Draws horizontal line from -n to n across the ellipse
for i=x-n,x+n do
drawpoint(i,ra)
drawpoint(i,rb)
end
end
end
I've drawn a line, using an X1, X2, Y1, Y2 variable. I'm looking to find any number of points along a this line, and to that extent I've written this:
Private Function genPointsArray(ByRef xPointArray() As Integer, ByRef yPointArray() As Integer, startX As Integer, finX As Integer, startY As Integer, finY As Integer, numPoints As Integer) As Integer
ReDim xPointArray(numPoints)
ReDim yPointArray(numPoints)
xPointArray(0) = startX
xPointArray(numPoints - 1) = finX
yPointArray(0) = startY
yPointArray(numPoints - 1) = finY
For i = 1 To numPoints - 2
xPointArray(i) = xPointArray(i - 1) + (finX - startX) \ numPoints
yPointArray(i) = yPointArray(i - 1) + (finY - startY) \ numPoints
Next
Return 0
End Function
As you can see, it accepts the X1, X2, Y1, Y2 variables (startX etc), two arrays to store the resultant points, and a number of points to find. The issue it has is that (worryingly often) a point is a pixel off (due to the actual result being a decimal). This then gets progressively worse as every following point is 2,3,4,5 etc pixels off, making the effect quite noticeable. Does anyone know of a way to make sure every point is along the line- either through a better algorithm or validation?
Thanks
The reason why your generated points drift is because you're allowing the error of the integer rounding to accumulate. It's like walking with your eyes closed.
Instead of basing each point from the previous, keep going back to your original endpoints. Each point that results will be off at worst one due to rounding.
Replace
xPointArray(0) = startX
xPointArray(numPoints - 1) = finX
yPointArray(0) = startY
yPointArray(numPoints - 1) = finY
For i = 1 To numPoints - 2
xPointArray(i) = xPointArray(i - 1) + (finX - startX) \ numPoints
yPointArray(i) = yPointArray(i - 1) + (finY - startY) \ numPoints
Next
With just
For i = 0 To numPoints - 1
xPointArray(i) = startX + (finX - startX) * i / numPoints
yPointArray(i) = startX + (finX - startX) * i / numPoints
Next
Please forgive any syntax or loop bound errors; I don't write VBA
In terms of geometry a line is unidimensional, i.e. it doesn't have width and hence it's hard to know if a point is on a line without defining a criterion.
A common way to test if a point resides on a line is to compute the distance from that point to the line, and if such a distance is small enough (less than an epsilon value), then the point is considered to be on the line. I don't know VB but here is snippet that illustrates this idea:
boolean inLine(Point2D a, Point2D b, Point2D p)
{
double a1 = b.x() - a.x();
double b1 = b.y() - a.y();
double a2 = p.x() - a.x();
double b2 = p.y() - a.y();
double alpha = Math.atan2(b1, a1);
double beta = Math.atan2(b2, a2);
double theta = Math.abs(alpha - beta);
double dist = Math.abs(a.distanceTo(p) * Math.sin(theta));
double eps = Math.abs(fx(3) - fx(0));
return dist < eps;
}
This algorithm is known as Distance from a Point to a Line.
The epsilon value depends on your particular problem, how much precision is needed, for most applications 1e-9 will be OK.
The method distanceTo() in the code simply computes the Euclidean distance between two points.
A foolproof formula is ((N - I) * Start + I * Fin) / N. For I=0, gives you exactly Start, and for I=N, gives you exactly Fin. Intermediate values will be regularly aligned.
This works both in integer and floating-point coordinates, but mind overflows.