I am struggling with this exercise where I have to find a number (y) so that when counting the times (nr) the value "1" appears in a string (x) composed of all the consecutive numbers starting from 1 to y, the following conditions are met: nr=y and nr is divisible by 10.
example:
x (string with consecutive from 1 to 12)= 123456789101112
y (the number) = 12
nr (times of "1" appearances) = 5
so i need to find the situation where nr=y and y mod 10 = 0
I've tried creating a vba sub to do this, but it takes forever and cannot seem to find a suitable result:
Sub abc2()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Double
Dim y As Double
Dim nr As Double
Dim x As String
x = 1
y = 1
For i = 1 To 500001
x = x & (y + 1)
y = y + 1
nr = Len(x) - Len(Replace(x, "1", ""))
If nr = y And nr Mod 10 = 0 Then
Range("E1") = y
GoTo out
End If
Next i
out:
Range("A1") = x
Range("B1") = y
Range("C1") = nr
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I'd really appreciate some suggestions. Maybe it can be solved in some other ingenious way.
Thank you!
Python:
x = ''
y = 0
####################################
# BRUTE FORCE, FINDS ANSWER 199990 #
####################################
#for iteration in range(100000):
# for index in range(10):
# y+=1
# x+=str(y)
# if (y == x.count('1')):
# print 'Found: ' + str(y) + ': ' + x
####################################
# More elegantly and efficiently, just track how many '1's we've added in each step
ones = 0
for iteration in range(100000):
x = ''
for index in range(10):
y += 1
x += str(y)
ones += x.count('1')
if (y == ones):
print 'Found: ' + str(y)
The commented-out solution takes about 2 minutes to execute. The second solution finishes in .46 seconds.
Related
I don't understand why 2 of my codes have overflow error
Sub varr3_1()
Dim x As Single
Dim y As Single
For x = 1 To 2 Step 0.2
y = Sqr((x - 1) / (x + 1))
Debug.Print x, y
Next x
End Sub
Sub varr3_3()
Dim x As Single
Dim z As Double
For x = 3 To 8 Step 0.9
z = 2
While (z > 1)
z = Log(x) + Tan(2 * x)
Debug.Print z
Wend
Next x
End Sub
I tried to change Single to Integer and so on but there is still a problem
The first sub Var3_1() works fine for me.
The second sub gets stuck in an endless loop on the second iteration of x. The value of z = 19.86... which will always be greater than 1 so the While/Wend loop never exits thus resulting in an eventual overflow.
I'm trying to find and remove outliers from many columns of data, but it doesn't clear the cells that contain the outliers when I run the code. I tried just printing "colLength" within the first For loop, and that did nothing either. Advice on where I went wrong or how I might be able to fix it?
Sub Outliers()
Dim calc As Worksheet
Set calc = ThisWorkbook.Sheets("Sheet2")
Dim num As Double
Dim x As Integer
Dim y As Integer
Dim colLength As Integer
'Variables for upper fence, lower fence, first quartile, third quartile, and interquartile range
Dim upper As Double
Dim lower As Double
Dim q1 As Double
Dim q3 As Double
Dim interquartRange As Double
For y = 1 To y = 49
'Find last row of the column
colLength = calc.Cells(Rows.count, y).End(xlUp).Row
'Calculate first and third quartiles
q1 = Application.WorksheetFunction.Quartile(Range(Cells(2, y), Cells(colLength, y)), 1)
q3 = Application.WorksheetFunction.Quartile(Range(Cells(2, y), Cells(colLength, y)), 3)
interquartRange = q3 - q1
'Calculate upper and lower fences
upper = q3 + (1.5 * interquartRange)
lower = q1 - (1.5 * interquartRange)
For x = 2 To x = colLength
num = calc.Cells(x, y)
'Remove outliers
If num > upper Or num < lower Then
Range(calc.Cells(x, y)).ClearContents
End If
Next x
Next y
End Sub
For y = 1 To y = 49 should be For y = 1 To 49. Similarly For x = 2 To x = colLength should be For x = 2 To colLength
Try this in a new module and you will see and understand the difference ;)
Dim Y As Long
Sub SampleA()
For Y = 1 To Y = 49
Debug.Print Y
Next Y
End Sub
Sub SampleB()
For Y = 1 To 49
Debug.Print Y
Next Y
End Sub
this function interpolates/extrapolates a table of known x,y
For example,
x y
1 10
2 15
3 20
Linterp(A1:B3, -1) = 0
However, this code can only do two adjacent arrays.
I would like to modify this code so that I can
select two separate arrays, for example N106:N109,P106:P109.
How can I make this adjustment in this code?
Function Linterp(r As Range, x As Double) As Double
' linear interpolator / extrapolator
' R is a two-column range containing known x, known y
Dim lR As Long, l1 As Long, l2 As Long
Dim nR As Long
'If x = 1.5 Then Stop
nR = r.Rows.Count
If nR < 2 Then Exit Function
If x < r(1, 1) Then ' x < xmin, extrapolate
l1 = 1: l2 = 2: GoTo Interp
ElseIf x > r(nR, 1) Then ' x > xmax, extrapolate
l1 = nR - 1: l2 = nR: GoTo Interp
Else
' a binary search would be better here
For lR = 1 To nR
If r(lR, 1) = x Then ' x is exact from table
Linterp = r(lR, 2)
Exit Function
ElseIf r(lR, 1) > x Then ' x is between tabulated values, interpolate
l1 = lR: l2 = lR - 1: GoTo Interp
End If
Next
End If
Interp:
Linterp = r(l1, 2) _
+ (r(l2, 2) - r(l1, 2)) _
* (x - r(l1, 1)) _
/ (r(l2, 1) - r(l1, 1))
End Function
one very simple way is having the function accepting two ranges in input, one for X values (say rX) and one for Y ones (say rY), and then changing every occurrence of r(foo,1) to rX(foo) and r(foo,2) to rY(foo)
like follows
Option Explicit
Function Linterp2(rX As Range, rY As Range, x As Double) As Double
' linear interpolator / extrapolator
' R is a two-column range containing known x, known y
Dim lR As Long, l1 As Long, l2 As Long
Dim nR As Long
'If x = 1.5 Then Stop
nR = rX.Rows.Count
If nR < 2 Then Exit Function
If x < rX(1) Then ' x < xmin, extrapolate
l1 = 1: l2 = 2: GoTo Interp
ElseIf x > rX(nR) Then ' x > xmax, extrapolate
l1 = nR - 1: l2 = nR: GoTo Interp
Else
' a binary search would be better here
For lR = 1 To nR
If rX(lR) = x Then ' x is exact from table
Linterp2 = rY(lR)
Exit Function
ElseIf rX(lR) > x Then ' x is between tabulated values, interpolate
l1 = lR: l2 = lR - 1: GoTo Interp
End If
Next
End If
Interp:
Linterp2 = rY(l1) _
+ (rY(l2) - rY(l1)) _
* (x - rX(l1)) _
/ (rX(l2) - rX(l1))
End Function
but you must implement code to check for consistency of the two ranges, like being both of one column each and with the same number of rows
use this function :
Public Function lineare_iterpolation(x As Variant, x1 As Variant, x2 As Variant, y1 As Variant, y2 As Variant) As Variant
If x = x1 Then
lineare_iterpolation = y1
Exit Function
End If
If x = x2 Then
lineare_iterpolation = y2
Exit Function
End If
lineare_iterpolation = y1 + (x - x1) * (y2 - y1) / (x2 - x1)
Exit Function
End Function
I tried to google the answer for this but could not find it. I am working on VB.Net. I would like to know what does the operator += mean in VB.Net ?
It means that you want to add the value to the existing value of the variable. So, for instance:
Dim x As Integer = 1
x += 2 ' x now equals 3
In other words, it would be the same as doing this:
Dim x As Integer = 1
x = x + 2 ' x now equals 3
For future reference, you can see the complete list of VB.NET operators on the MSDN.
a += b
is equivalent to
a = a + b
In other words, it adds to the current value.
It is plus equals. What it does is take the same variable, adds it with the right hand number (using the + operator), and then assigns it back to the variable. For example,
Dim a As Integer
Dim x As Integer
x = 1
a = 1
x += 2
a = a + 2
if x = a then
MsgBox("This will print!")
endif
those 2 lines compiled produce the same IL code:
x += 1
and
x = x + 1
Just makes code more efficient -
Dim x as integer = 3
x += 1
'x = 4
is the same as
x = x + 1
'x = 4
It can also be used with a (-):
x -= 1
' x = 2
Is the same as
x = x - 1
'x = 2
First off, here is what I have so far:
Option Explicit
Dim y As Variant
Dim yforx As Variant
Dim yfork As Variant
Dim ynew As Variant
Dim ymin As Variant
Dim x As Variant
Dim xmin As Variant
Dim k As Variant
Dim kmin As Variant
Dim s As Variant
Dim Z As Variant
Dim Track As Variant
Sub PracticeProgram()
'Selects the right sheet
Sheets("PracticeProgram").Select
'y = k ^ 2 * (x ^ 2 + 2 * x * k - 6) / (x + k) ^ 2
'these are the bounds we are stepping through
Track = 0
x = 1
xmin = 1
k = 1
kmin = 1
y = 100000000
yforx = 100000
yfork = 1000000000
Do
y = 100000000
For x = 0 To 1000 Step 0.1
ynew = kmin ^ 2 * (x ^ 2 + 2 * x * kmin - 6) / (x + kmin) ^ 2
'This checks the new y-value against an absurdly high y-value we know is wrong. if it is less than this y-value, we keep the x-value that corresponds with it.
If ynew < y Then
xmin = x
y = ynew
yforx = y
xmin = Application.Evaluate("=Round(" & xmin & ", 3)")
Else
End If
Next
MsgBox (yforx)
For k = 0 To 1000 Step 0.1
y = k ^ 2 * (xmin ^ 2 + 2 * xmin * k - 6) / (xmin + k) ^ 2
If ynew < y Then
kmin = k
y = ynew
yfork = y
kmin = Application.Evaluate("=Round(" & kmin & ",3)")
Else
End If
Next
MsgBox (yfork)
Loop Until (Abs(yforx - yfork) < 10)
End Sub
This program is supposed to find the values of x and k in order to minimize the value of y. This is a practice for a much more complicated program that will use this same concept. In my actual program y, k, and x will all be greater than zero no matter what, but since it was hard to think of a simple equation whose results would be in the shape of a parabola opening up, I decided to allow negative answers for this practice program.
Basically, it should bounce back and forth between the equations finding the ideal values for x and k until finally it has a minimal answer for y using ideal answers for both x and k. I'm not sure what the actual answer is, so I'm letting it stop within a range of 10. If it works, I'll make it smaller, but I don't want the program going for forever, just in case.
MY PROBLEM: I keep getting overflow errors! I'm trying to round the values for xmin and kmin to three figures after the decimal, but it doesn't seem to be helping. Am I using them wrong? Can someone help me get this program working?
You're doing a division by zero. xmin = 0, k = 0, (xmin + k) ^ 2 = 0. (I'm not sure why it isn't reporting division by zero.)
A suggestion: use the Locals pane to see the value of local variables. You can also use the Watch pane to see the value of expressions you want to monitor.