I have coded the following function, to draw a grid on the screen (using FlyWithLua in X-Plane 10).
It works and paints the grid as it should, boxes/labels and everything, and obviously it creates the "lt_box" three dimensional array as when I print in the loop (the commented out print instructions) it prints the correct values.
The issue is, if I call lt_box[x][y][z] from any other part of the code I can't get to those values...
any idea?
function draw_lt_table()
idx = 1
idx2 = 1
xx1 = rth_box[1]
xx2 = rth_box[2]
yy1 = rth_box[3]
yy2 = rth_box[4]
lite_idx = 1
cell_x_size = 38
cell_y_size = 40
num_cols = 6
num_rows = 6
lt_box = {}
if d_tab==false or d_stg==false then
return lt_box
end
for idx2 = 1,num_rows,1 do
for idx = 1,num_cols,1 do
lt_box[idx] = {}
lt_box[idx][idx2] = {xx1+((cell_x_size*idx)-cell_x_size), xx1+(cell_x_size)*idx, 1+yy2+((cell_y_size*idx2)-cell_y_size), 1+yy2+(cell_y_size)*idx2}
graphics.set_color(0, 0, 0, 0.7)
graphics.draw_rectangle(lt_box[idx][idx2][1], lt_box[idx][idx2][3], lt_box[idx][idx2][2], lt_box[idx][idx2][4])
graphics.set_color(1, 1, 1, 0.7)
graphics.set_width(2)
graphics.draw_line(lt_box[idx][idx2][1],lt_box[idx][idx2][3],lt_box[idx][idx2][1],lt_box[idx][idx2][4])
graphics.draw_line(lt_box[idx][idx2][1],lt_box[idx][idx2][4],lt_box[idx][idx2][2],lt_box[idx][idx2][4])
graphics.draw_line(lt_box[idx][idx2][2],lt_box[idx][idx2][4],lt_box[idx][idx2][2],lt_box[idx][idx2][3])
graphics.draw_line(lt_box[idx][idx2][2],lt_box[idx][idx2][3],lt_box[idx][idx2][1],lt_box[idx][idx2][3])
light_up(unpack(lt_box[idx][idx2]))
glColor4f(1, 1, 1, 0.7)
draw_string(lt_box[idx][idx2][1]+12, lt_box[idx][idx2][3]+30, lite_idx)
draw_string(lt_box[idx][idx2][1]+3, lt_box[idx][idx2][3]+15, lites_vars[4][lite_idx])
draw_string(lt_box[idx][idx2][1]+3, lt_box[idx][idx2][3]+5, lites_vars[lt_set][lite_idx])
lite_idx = lite_idx+1 -- this is usd in line 115-116 to select values as labels
--[[
print("LT_BOX " .. idx .. " " .. idx2 .. " x1 ".. lt_box[idx][idx2][1])
print("LT_BOX " .. idx .. " " .. idx2 .. " x2 ".. lt_box[idx][idx2][2])
print("LT_BOX " .. idx .. " " .. idx2 .. " y1 ".. lt_box[idx][idx2][3])
print("LT_BOX " .. idx .. " " .. idx2 .. " y2 ".. lt_box[idx][idx2][4])
print("****************************************************************************")
--]]
end
--print("____________________________________________________________________________")
end
end
You have lt_box[idx] = {} in the inner loop, which means you reset that table every time you add an element. You have to create that table in the outer loop.
for idx = 1,num_cols,1 do
lt_box[idx] = {}
for idx2 = 1,num_rows,1 do
Related
I am calculating accuracy from a word document by calculating the total number of changes made once track review is on. Incorrect use of punctuation is calculated as 1/4 mark, while for contextual or grammar errors a full 1 mark is deducted.
Right now all carriage returns are being calculated as 1 full mark. I want this either to be removed completely or can pass it along as 1/4 mark deduction. I am using the following for counting . ; and , as 1/4 mark deduction.
For Each myRevision In ActiveDocument.Revisions
myRevision.Range.Select
If myRevision.Type = wdRevisionInsert Then
lngRevisions = Len(Selection.Text)
For i = 1 To lngRevisions
If Mid(Selection.Text, i, 1) = "," Then
punct = punct + 1
Else
End If
If Mid(Selection.Text, i, 1) = "." Then
punct = punct + 1
Else
End If
If Mid(Selection.Text, i, 1) = ";" Then
punct = punct + 1
Else
End If
If Mid(Selection.Text, i, 1) = "" Then
punct = punct + 1
Else
End If
Next i
Count = Count + 1
Else
End If
Next
tCorrections = Count + punct * 0.25 - punct
Accuracy = ((tWords - tCorrections) / tWords) * 100
Accuracy = Round(Accuracy, 1)
Use an array of types names (aLabels) and a string of the types occurring in your data (sC) via a mapping (aMap) of types to counting slots for a flexible way to classify your string(s). As in this demo:
Option Explicit
Dim aLabels : aLabels = Split("Vowels Consants Digits Punctuations EOLs Unclassified")
ReDim aCounts(UBound(aLabels))
Dim sC : sC = "abce1,2." & vbCr
Dim aMap : aMap = Array(0, 1, 1, 0, 2, 3, 2, 3, 4)
Dim sD : sD = sC & "d" & sC & "bb111."
Dim p, i
For p = 1 To Len(sD)
i = Instr(sC, Mid(sD, p, 1))
If 0 = i Then
i = UBound(aLabels)
Else
i = aMap(i - 1)
End If
aCounts(i) = aCounts(i) + 1
Next
For i = 0 To UBound(aLabels)
WScript.Echo Right(" " & aCounts(i), 3), aLabels(i)
Next
output:
cscript 42505210.vbs
4 Vowels
6 Consants
7 Digits
5 Punctuations
2 EOLs
1 Unclassified
Based on such raw data (frequencies of types) you an add specials weights.
Update wrt comment:
As I said: Add weights after calculating the raw frequencies:
... as above ...
Dim nSum
' Std - all weights = 1
nSum = 0 : For Each i In aCounts : nSum = nSum + i : Next
WScript.Echo "all pigs are equal:", nSum
' No EOLs
nSum = 0 : For Each i In aCounts : nSum = nSum + i : Next : nSum = nSum - aCounts(4)
WScript.Echo "EOLs don't count:", nSum
nSum = 0 : aCounts(0) = aCounts(0) * 4 : For Each i In aCounts : nSum = nSum + i : Next
WScript.Echo "vowels count * 4:", nSum
additional output:
all pigs are equal: 25
EOLs don't count: 23
vowels count * 4: 37
I am trying to simulate the I/O of this website page
My Input sheet looks like this:
Now after taking the values from input sheet and arranging them in ascending order I got this in a temp worksheet :
This is what my results sheet looks like:
Now I have tried this after sorting process(didn't add code for sorting since it's not the problem):
Set rng = Union(wTime.Range("D6:D25"), wTime.Range("F6:F25"), wTime.Range("H6:H25"), wTime.Range("J6:J25"))
cnt1 = 1: cnt2 = 1: cnt3 = 1: cnt4 = 1
wTime.Range("A6:A25") = Empty 'Ticker
For i = 1 To 20
bckStroke(i) = wTemp.Range("A" & i + 1).Value
brstStroke(i) = wTemp.Range("C" & i + 1).Value
btrFly(i) = wTemp.Range("E" & i + 1).Value
frStyle(i) = wTemp.Range("G" & i + 1).Value
wTime.Range("A6:A25") = Empty
For Each cel In rng
If cel.Column = 4 And cel.Value = bckStroke(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt1 < 6 Then
wRes.Cells((cnt1 + 5 + (cnt1 - 1) * 2) - 1, 4) = wTime.Cells(cel.Row, 2) 'Athlete Name
wRes.Cells(cnt1 + 5 + (cnt1 - 1) * 2, 4) = bckStroke(i) 'Time
cnt1 = cnt1 + 1
wTime.Cells(cel.Row, 1) = "Y"
End If
If cel.Column = 6 And cel.Value = brstStroke(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt2 < 6 Then
wRes.Cells((cnt2 + 5 + (cnt2 - 1) * 2) - 1, 6) = wTime.Cells(cel.Row, 2) 'Athlete Name
wRes.Cells(cnt2 + 5 + (cnt2 - 1) * 2, 6) = brstStroke(i) 'Time
cnt2 = cnt2 + 1
wTime.Cells(cel.Row, 1) = "Y"
End If
If cel.Column = 8 And cel.Value = btrFly(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt3 < 6 Then
wRes.Cells((cnt3 + 5 + (cnt3 - 1) * 2) - 1, 8) = wTime.Cells(cel.Row, 2) 'Athlete Name
wRes.Cells(cnt3 + 5 + (cnt3 - 1) * 2, 8) = btrFly(i) 'Time
cnt3 = cnt3 + 1
wTime.Cells(cel.Row, 1) = "Y"
End If
If cel.Column = 10 And cel.Value = frStyle(i) And cel.Value <> 0 And Trim(wTime.Cells(cel.Row, 1)) <> "Y" And cnt4 < 6 Then
wRes.Cells((cnt4 + 5 + (cnt4 - 1) * 2) - 1, 10) = wTime.Cells(cel.Row, 2) 'Athlete Name
wRes.Cells(cnt4 + 5 + (cnt4 - 1) * 2, 10) = frStyle(i) 'Time
cnt4 = cnt4 + 1
wTime.Cells(cel.Row, 1) = "Y"
End If
Next cel
Next i
I just want to know the simplest logic to get the desired result after arranging them in ascending order (refer temp sheet) it should be easy but I can't seem to understand it.
Conditions that I know of for now:
Each team should have unique swimmers (i.e 4 Unique names in each team)
A swimmer can appear in other team as well if he has best time in other category as well. (E.g. Marcelo will appear in top 4 team since he has the best time in all 4 categories)
Teams with shortest time should be placed 1st in the list on result sheet. I think sorting in ascending order takes care of this it's matter of selecting right swimmer from the temp sheet list.
EDIT:
4. Relay Logic premise: Get all the combinations possible without 2 identical strings. And then sort them lowest to largest. I'd do the following: Get all the possible combinations and their sum with the following: *Combinations may still be buggy, since it may be variable to how many numbers you may have. This is just a guide to describe the process
Sub Combinations()
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long, q As Long
Dim CountComb As Long, lastrow As Long
Range("K2").Value = Now - 5
Application.ScreenUpdating = False
CountComb = 0: lastrow = 6
For i = 1 To 6: For j = 1 To 5
For k = 1 To 6: For l = 1 To 6
If Not (i = j Or i = k Or i = l Or j = k Or j = l Or k = l) Then
Range("K" & lastrow).Value = Range("A" & i).Value & "/" & _
Range("B" & j).Value & "/" & _
Range("C" & k).Value & "/" & _
Range("D" & l).Value
lastrow = lastrow + 1
CountComb = CountComb + 1
End If
Next: Next
Next: Next
Range("K1").Value = CountComb
Range("K3").Value = Now + 21
Application.ScreenUpdating = True
End Sub
Function TimeSum(Persons As String, Chr As String) As Double
Dim ArrayPersons() As String: ArrayPersons = Split(Persons, Chr)
Dim SumOfTime As Double
Dim ItemPerson As Variant
Dim NumberRoutines As Long: NumberRoutines = 2
Const SheetData = "Sheet1"
For Each ItemPerson In ArrayPersons
SumOfTime = Sheets(SheetData).Columns(NumberRoutines).Find(ItemPerson).Offset(0, -1).Value + SumOfTime
NumberRoutines = NumberRoutines + 2
Next ItemPerson
TimeSum = SumOfTime
End Function
Maybe you could define better the sub to do what you desire for, but, the last coding could guide you in the right path. In a second thought, you could get combinations in a dictionary instead.
[
[
I have this string:
0|1|2|3|4|5|6|7|8|9
I need to return the text after the 6th occurence of | and before the 7th. In this example, it would be 6.
Can his be achieved using the simple String functions (Mid, Left, Right, InStr)?
In addition, you could use a RegExp to look for the possibly empty sequence of non-| before a | and after 6 such sequences:
>> Set r = New RegExp
>> r.Pattern = "^(?:[^\|]*\|){6}([^\|]*)\|"
>> WScript.Echo r.Execute("0|1|2|3|4|5|6|7|8|9")(0).SubMatches(0)
>>
6
For production code, you'd need a check against non-confirming data.
s = "0|1|2|3|4|5|6|7|8|9"
For i = 1 To 6
intPos1 = InStr(intPos1 + 1, s, "|")
If intPos1 = 0 Then Exit For
Next
If intPos1 > 0 Then
intPos2 = InStr(intPos1 + 1, s, "|")
If intPos2 > intPos1 Then MsgBox Mid(s, intPos1 + 1, intPos2 - intPos1 - 1)
End If
Or, like #Filburt said, it could be a one-liner with Split():
MsgBox Split(s, "|")(6)
Dim s, c, n, i, p, e, r
s = "0|1|2|3|4|5|6|7|8|9" ' examined string
c = "|" ' split char
n = 6 ' occurance to start from
i = 0
p = 0
r = ""
Do
p = InStr(p + 1, s, c)
If p = 0 Then Exit Do
i = i + 1
If i = n Then
e = InStr(p + 1, s, c)
If e > 0 Then r = Mid(s, p + 1, e - p - 1)
Exit Do
End If
Loop
MsgBox r
I have a list of 100 items. I'd like to randomly pair these items with each other. These pairs must be unique, so there are 4950 possibilities (100 choose 2) total.
Of all 4950 pairs, I'd like to have 1000 pairs randomly selected. But they key is, I'd like each item (of the 100 items) to overall appear the same amount of times (here, 20 times).
I tried to implement this with code a couple of times. And it worked fine when I tried with a lower amount of pairs chosen, but each time I try with the full 1000 pairs, I get stuck in a loop.
Does anyone have an idea for an approach? And what if I change the number of pairs I wish to select (e.g., 1500 rather than 1000 random pairs)?
My attempt (written in VBA):
Dim City1(4951) As Integer
Dim City2(4951) As Integer
Dim CityCounter(101) As Integer
Dim PairCounter(4951) As Integer
Dim i As Integer
Dim j As Integer
Dim k As Integer
i = 1
While i < 101
CityCounter(i) = 0
i = i + 1
Wend
i = 1
While i < 4951
PairCounter(i) = 0
i = i + 1
Wend
i = 1
j = 1
While j < 101
k = j + 1
While k < 101
City1(i) = j
City2(i) = k
k = k + 1
i = i + 1
Wend
j = j + 1
Wend
Dim temp As Integer
i = 1
While i < 1001
temp = Random(1,4950)
While ((PairCounter(temp) = 1) Or (CityCounter( (City1(temp)) ) = 20) Or (CityCounter( (City2(temp)) ) = 20))
temp = Random(1,4950)
Wend
PairCounter(temp) = 1
CityCounter( (City1(temp)) ) = (CityCounter( (City1(temp)) ) + 1)
CityCounter( (City2(temp)) ) = (CityCounter( (City2(temp)) ) + 1)
i = i + 1
Wend
Take a list, scramble it, and mark every two elements off as a pair. Add these pairs to a list of pairs. Ensure that list of pairs is sorted.
Scramble the list of pairs, and add each pair to a "staged" pair list. Check if it's in the list of pairs. If it's in the list of pairs, scramble and start over. If you get the entire list without any duplicates, add the staged pair list to the pair list and start this paragraph over.
Since this involves a nondeterministic step at the end I'm not sure how slow it will be, but it should work.
This is old thread, but I was looking for something similar, and finaly did it myself.
The algorithm is not 100% random (after being a bit "tired" with unsuccessfull random trials starts systematic screening of the table :) - anyway for me - "random enough") but works reasonably fast, and returns required table (unfortunalety not always, but...) usually every second or third use (look in A1 if there is your reqired number of pairs for each item).
Here is VBA code to be run in Excel environment.
Output is directed to current sheet starting from A1 cell.
Option Explicit
Public generalmax%, oldgeneralmax%, generalmin%, alloweddiff%, i&
Public outtable() As Integer
Const maxpair = 100, upperlimit = 20
Sub generate_random_unique_pairs()
'by Kaper 2015.02 for stackoverflow.com/questions/14884975
Dim x%, y%, counter%
Randomize
ReDim outtable(1 To maxpair + 1, 1 To maxpair + 1)
Range("A1").Resize(maxpair + 1, maxpair + 1).ClearContents
alloweddiff = 1
Do
i = i + 1
If counter > (0.5 * upperlimit) Then 'try some systematic approach
For x = 1 To maxpair - 1 ' top-left or:' To 1 Step -1 ' bottom-right
For y = x + 1 To maxpair
Call test_and_fill(x, y, counter)
Next y
Next x
If counter > 0 Then
alloweddiff = alloweddiff + 1
counter = 0
End If
End If
' mostly used - random mode
x = WorksheetFunction.RandBetween(1, maxpair - 1)
y = WorksheetFunction.RandBetween(x + 1, maxpair)
counter = counter + 1
Call test_and_fill(x, y, counter)
If counter = 0 Then alloweddiff = WorksheetFunction.Max(alloweddiff, 1)
If i > (2.5 * upperlimit) Then Exit Do
Loop Until generalmin = upperlimit
Range("A1").Resize(maxpair + 1, maxpair + 1).Value = outtable
Range("A1").Value = generalmin
Application.StatusBar = ""
End Sub
Sub test_and_fill(x%, y%, ByRef counter%)
Dim temprowx%, temprowy%, tempcolx%, tempcoly%, tempmax%, j%
tempcolx = outtable(1, x + 1)
tempcoly = outtable(1, y + 1)
temprowx = outtable(x + 1, 1)
temprowy = outtable(y + 1, 1)
tempmax = 1+ WorksheetFunction.Max(tempcolx, tempcoly, temprowx, temprowy)
If tempmax <= (generalmin + alloweddiff) And tempmax <= upperlimit And outtable(y + 1, x + 1) = 0 Then
counter = 0
outtable(y + 1, x + 1) = 1
outtable(x + 1, y + 1) = 1
outtable(x + 1, 1) = 1 + outtable(x + 1, 1)
outtable(y + 1, 1) = 1 + outtable(y + 1, 1)
outtable(1, x + 1) = 1 + outtable(1, x + 1)
outtable(1, y + 1) = 1 + outtable(1, y + 1)
generalmax = WorksheetFunction.Max(generalmax, outtable(x + 1, 1), outtable(y + 1, 1), outtable(1, x + 1), outtable(1, y + 1))
generalmin = outtable(x + 1, 1)
For j = 1 To maxpair
If outtable(j + 1, 1) < generalmin Then generalmin = outtable(j + 1, 1)
If outtable(1, j + 1) < generalmin Then generalmin = outtable(1, j + 1)
Next j
If generalmax > oldgeneralmax Then
oldgeneralmax = generalmax
Application.StatusBar = "Working on pairs " & generalmax & "Total progress (non-linear): " & Format(1# * generalmax / upperlimit, "0%")
End If
alloweddiff = alloweddiff - 1
i = 0
End If
End Sub
Have an array appeared[] which keeps track of how many times each item already appeared in answer. Let's say each element has to appear k times. Iterate over the array, and while current element has its appeared value less than k, choose a random pair for it from that element who also have appeared less than k times. Add that pair to answer and increase appearance count for both.
create a 2-dimensional 100*100 matrix of booleans, all False
of these 10K booleans, set 1K of them to true, with the following constraints:
the diagonal should stay empty
no row or column should have more than 20 true values
at the end, every row and column should have 20 True values.
Now, there is the X=Y diagonal symmetry. Just add the following constraints:
the triangle at one side of the diagonal should stay empty
in the above constraints, the restrictions for rows&columns should be combined/added
I want a function to calculate numerology.For example if i enter "XYZ" then my output should be 3 .
Here is how it became 3:
X = 24
Y = 25
Z = 26
on adding it becomes 75 which again adds up to 12 (7+5) which again adds up to 3(1+2) . Similarly whatever names i should pass,my output should be a single digit score.
Here you are:
Function Numerology(Str)
Dim sum, i, char
' Convert the string to upper case, so that 'X' = 'x'
Str = UCase(Str)
sum = 0
' For each character, ...
For i = 1 To Len(Str)
' Check if it's a letter and raise an exception otherwise
char = Mid(Str, i , 1)
If char < "A" Or char > "Z" Then Err.Raise 5 ' Invalid procedure call or argument
' Add the letter's index number to the sum
sum = sum + Asc(char) - 64
Next
' Calculate the result using the digital root formula (http://en.wikipedia.org/wiki/Digital_root)
Numerology = 1 + (sum - 1) Mod 9
End Function
In vbscript:
Function numerology(literal)
result = 0
for i = 1 to Len(literal)
'' // for each letter, take its ASCII value and substract 64,
'' so "A" becomes 1 and "Z" becomes 26
result = result + Asc(Mid(literal, i, 1)) - 64
next
'' // while result is bigger than 10, let's sum it's digits
while(result > 10)
partial = 0
for i = 1 to Len(CStr(result))
partial = partial + CInt(Mid(CStr(result), i, 1))
next
result = partial
wend
numerology = result
End Function
I have no idea what this could possible be used for but it was fun to write anyway.
Private Function CalcStupidNumber(ByVal s As String) As Integer
s = s.ToLower
If (s.Length = 1) Then 'End condition
Try
Return Integer.Parse(s)
Catch ex As Exception
Return 0
End Try
End If
'cover to Values
Dim x As Int32
Dim tot As Int32 = 0
For x = 0 To s.Length - 1 Step 1
Dim Val As Integer = ConvertToVal(s(x))
tot += Val
Next
Return CalcStupidNumber(tot.ToString())
End Function
Private Function ConvertToVal(ByVal c As Char) As Integer
If (Char.IsDigit(c)) Then
Return Integer.Parse(c)
End If
Return System.Convert.ToInt32(c) - 96 ' offest of a
End Function