 |
AutoHotkey Community Let's help each other out
|
| View previous topic :: View next topic |
| Author |
Message |
tinku99
Joined: 03 Aug 2007 Posts: 312 Location: Houston, TX
|
Posted: Wed Jun 24, 2009 5:49 pm Post subject: Re: Non Continuous Subsequences |
|
|
| Laszlo wrote: | | We can find all Non Continuous Subsequences by selecting those 01 sequences, which do not consist of only one block of 1’s. It is very easy with regular expressions. At the end we have to translate 1’s to the sequence entries corresponding to their position |
Very nice, I thought about doing this task a while ago, unsuccessfully. I love your implementation
I wrapped up your code in a function. | Code: | seq = a,b,c,d,e
MsgBox % noncontinuous(seq, ",")
MsgBox % noncontinuous("1,2,3,4", ",")
noncontinuous(list, delimiter)
{
stringsplit, seq, list, %delimiter%
n := seq0 ; sequence length
Loop % x := (1<<n) - 1 { ; try all 0-1 candidate sequences
If !RegExMatch(b:=ToBin(A_Index,n),"^0*1*0*$") { ; drop continuous subsequences
Loop Parse, b
t .= A_LoopField ? seq%A_Index% " " : "" ; position -> number
t .= "`n" ; new sequences in new lines
}
}
return t
}
ToBin(n,W=16) { ; LS W-bits of Binary representation of n
Return W=1 ? n&1 : ToBin(n>>1,W-1) . n&1
}
|
|
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Wed Jun 24, 2009 6:25 pm Post subject: Re: Non Continuous Subsequences |
|
|
| tinku99 wrote: | | I wrapped up your code in a function. | You are right: it is more convenient to use when packed in a function. |
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Wed Jun 24, 2009 8:21 pm Post subject: Roots of a function |
|
|
This AHK solution of task Roots of a function consists of 3 functions. Poly(x) is a test function of one variable. We search for its roots. roots() searches for intervals within given limits, shifted by a given “step”, where our function has different signs at the endpoints. Having found such an interval, the root() function searches for a value where our function is 0, within a given tolerance. It also sets ErrorLevel to info about the root found. | Code: | MsgBox % roots("poly", -0.99, 2, 0.1, 1.0e-5)
MsgBox % roots("poly", -1, 3, 0.1, 1.0e-5)
roots(f,x1,x2,step,tol) { ; search for roots in intervals of length "step", within tolerance "tol"
x := x1, y := %f%(x), s := (y>0)-(y<0)
Loop % ceil((x2-x1)/step) {
x += step, y := %f%(x), t := (y>0)-(y<0)
If (s=0 || s!=t)
res .= root(f, x-step, x, tol) " [" ErrorLevel "]`n"
s := t
}
Sort res, UN ; remove duplicate endpoints
Return res
}
root(f,x1,x2,d) { ; find x in [x1,x2]: f(x)=0 within tolerance d, by bisection
If (!y1 := %f%(x1))
Return x1, ErrorLevel := "Exact"
If (!y2 := %f%(x2))
Return x2, ErrorLevel := "Exact"
If (y1*y2>0)
Return "", ErrorLevel := "Need different sign ends!"
Loop {
x := (x2+x1)/2, y := %f%(x)
If (y = 0 || x2-x1 < d)
Return x, ErrorLevel := y ? "Approximate" : "Exact"
If ((y>0) = (y1>0))
x1 := x, y1 := y
Else
x2 := x, y2 := y
}
}
poly(x) {
Return ((x-3)*x+2)*x
} |
|
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Wed Jun 24, 2009 9:11 pm Post subject: Numerical Integration |
|
|
The Numerical Integration task asks for implementing 5 methods for integrating a function f between a and b, dividing the interval to n equal pieces. The Rect function below implements the 3 rectangular methods, dependent on its last parameter. The Trapez and Simpson method approximate the function with line- or parabolic segments, repectively: | Code: | MsgBox % Rect("fun", 0, 1, 10,-1) ; 0.45 left
MsgBox % Rect("fun", 0, 1, 10) ; 0.50 mid
MsgBox % Rect("fun", 0, 1, 10, 1) ; 0.55 right
MsgBox % Trapez("fun", 0, 1, 10) ; 0.50
MsgBox % Simpson("fun", 0, 1, 10) ; 0.50
Rect(f,a,b,n,side=0) { ; side: -1=left, 0=midpoint, 1=right
h := (b - a) / n
sum := 0, a += (side-1)*h/2
Loop %n%
sum += %f%(a + h*A_Index)
Return h*sum
}
Trapez(f,a,b,n) {
h := (b - a) / n
sum := 0
Loop % n-1
sum += %f%(a + h*A_Index)
Return h/2 * (%f%(a) + %f%(b) + 2*sum)
}
Simpson(f,a,b,n) {
h := (b - a) / n
sum1 := sum2 := 0, ah := a - h/2
Loop %n%
sum1 += %f%(ah + h*A_Index)
Loop % n-1
sum2 += %f%(a + h*A_Index)
Return h/6 * (%f%(a) + %f%(b) + 4*sum1 + 2*sum2)
}
fun(x) { ; linear test function
Return x
} |
|
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Wed Jun 24, 2009 9:17 pm Post subject: |
|
|
| I guess we picked all the low hanging fruits: the relatively simple RosettaCode tasks. (We might need some debugging, though.) How far are we from the top 10 languages? |
|
| Back to top |
|
 |
tinku99
Joined: 03 Aug 2007 Posts: 312 Location: Houston, TX
|
Posted: Wed Jun 24, 2009 9:35 pm Post subject: top10 |
|
|
We're there
Thanks to all of you who participated in this challenge!
top 10
1 Programming Tasks (316 members)
2 Tcl (316 members)
3 Python (277 members)
4 Ruby (244 members)
5 Ada (238 members)
6 C (237 members)
7 Perl (233 members)
8 OCaml (212 members)
9 Java (208 members)
10 AutoHotkey (204 members)
11 Haskell (201 members)
12 ALGOL 68 (198 members)
13 D (187 members)
14 E (178 members)
15 C++ (170 members) |
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Thu Jul 02, 2009 12:53 am Post subject: Conway's Game of Life |
|
|
Here is Conway's Game of Life with GUI. In the first line set the size of the grid of cells (or add a simple inputbox query, or use command line parameters). At start all the cells are dead (unchecked). With the mouse check a few cells, e.g. three in a row. When the “step” button is pressed, the new generation is calculated and shown in the GUI. | Code: | rows := cols := 10 ; set grid dimensions
i = -1,0,1, -1,1, -1,0,1 ; neighbors' x-offsets
j = -1,-1,-1, 0,0, 1,1,1 ; neighbors' y-offsets
StringSplit i, i, `, ; make arrays
StringSplit j, j, `,
Loop % rows { ; setup grid of checkboxes
r := A_Index, y := r*17-8 ; looks good in VISTA
Loop % cols {
c := A_Index, x := c*17-5
Gui Add, CheckBox, x%x% y%y% w17 h17 vv%c%_%r% gCheck
}
}
Gui Add, Button, % "x12 w" x+2, step ; button to step to next generation
Gui Show
Return
Check:
GuiControlGet %A_GuiControl% ; manual set of cells
Return
ButtonStep: ; move to next generation
Loop % rows {
r := A_Index
Loop % cols {
c := A_Index, n := 0
Loop 8 ; w[x,y] <- new states
x := c+i%A_Index%, y := r+j%A_Index%, n += 1=v%x%_%y%
GuiControl,,v%c%_%r%,% w%c%_%r% := v%c%_%r% ? n=2 || n=3 : n=3
}
}
Loop % rows { ; update v[x,y] = states
r := A_Index
Loop % cols
v%A_Index%_%r% := w%A_Index%_%r%
}
Return
GuiClose: ; exit when GUI is closed
ExitApp |
|
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Thu Jul 02, 2009 3:44 am Post subject: Trial factoring of a Mersenne number |
|
|
The task Trial factoring of a Mersenne number is very simple and fast, if we only search for prime factors at most 32 bit long. The Mersenne number itself can be up to 4 billion bits long (2**p-1, where p is 32 bit prime). The function uses a deterministic variant of the Miller-Rabin primality test, which needs at most 3 iterations of its inner loop. To speed it up, 2 digit primes are directly checked, and the divisibility by primes less than 20 is also directly tested. | Code: | MsgBox % MFact(27) ;-1: 27 is not prime
MsgBox % MFact(2) ; 0
MsgBox % MFact(3) ; 0
MsgBox % MFact(5) ; 0
MsgBox % MFact(7) ; 0
MsgBox % MFact(11) ; 23
MsgBox % MFact(13) ; 0
MsgBox % MFact(17) ; 0
MsgBox % MFact(19) ; 0
MsgBox % MFact(23) ; 47
MsgBox % MFact(29) ; 233
MsgBox % MFact(31) ; 0
MsgBox % MFact(37) ; 223
MsgBox % MFact(41) ; 13367
MsgBox % MFact(43) ; 431
MsgBox % MFact(47) ; 2351
MsgBox % MFact(53) ; 6361
MsgBox % MFact(929) ; 13007
MFact(p) { ; blank if 2**p-1 can be prime, otherwise a prime divisor < 2**32
If !IsPrime32(p)
Return -1 ; Error (p must be prime)
Loop % 2.0**(p<64 ? p/2-1 : 31)/p ; test prime divisors < 2**32, up to sqrt(2**p-1)
If (((q:=2*p*A_Index+1)&7 = 1 || q&7 = 7) && IsPrime32(q) && PowMod(2,p,q)=1)
Return q
Return 0
}
IsPrime32(n) { ; n < 2**32
If n in 2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97
Return 1
If (!(n&1)||!mod(n,3)||!mod(n,5)||!mod(n,7)||!mod(n,11)||!mod(n,13)||!mod(n,17)||!mod(n,19))
Return 0
n1 := d := n-1, s := 0
While !(d&1)
d>>=1, s++
Loop 3 {
x := PowMod( A_Index=1 ? 2 : A_Index=2 ? 7 : 61, d, n)
If (x=1 || x=n1)
Continue
Loop % s-1
If (1 = x:=PowMod(x,2,n))
Return 0
Else If (x = n1)
Break
IfLess x,%n1%, Return 0
}
Return 1
}
PowMod(x,n,m) { ; x**n mod m
y := 1, i := n, z := x
While i>0
y := i&1 ? mod(y*z,m) : y, z := mod(z*z,m), i >>= 1
Return y
} |
|
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Thu Jul 02, 2009 4:30 pm Post subject: Power Set |
|
|
Representing sets is the easiest with 0-1 indicator sequences, keeping the elements themselves in a separate list, indexed by the position of the corresponding bit in the indicator sequence. The list of elements of the Power Set of a base set of much more than 20 elements will be too long, therefore we can safely use the bits of 64 bit AHK integers as indicator sequences. | Code: | a = 1,a,-- ; elements separated by commas
StringSplit a, a, `, ; a0 = #elements, a1,a2,... = elements of the set
t = {
Loop % (1<<a0) { ; generate all 0-1 sequences
x := A_Index-1
Loop % a0
t .= (x>>A_Index-1) & 1 ? a%A_Index% "," : ""
t .= "}`n{" ; new subsets in new lines
}
MsgBox % RegExReplace(SubStr(t,1,StrLen(t)-1),",}","}") |
|
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Thu Jul 02, 2009 5:03 pm Post subject: One dimensional cellular automata |
|
|
One dimensional cellular automata can be visualized by a row of checkboxes. The living cells are marked by mouse clicks. Clicking on the “step” button shows the next generation. | Code: | n := 22, n1 := n+1, v0 := v%n1% := 0 ; set grid dimensions, and fixed cells
Loop % n { ; draw a line of checkboxes
v%A_Index% := 0
Gui Add, CheckBox, % "y10 w17 h17 gCheck x" A_Index*17-5 " vv" A_Index
}
Gui Add, Button, x+5 y6, step ; button to step to next generation
Gui Show
Return
Check:
GuiControlGet %A_GuiControl% ; set cells by the mouse
Return
ButtonStep: ; move to next generation
Loop % n
i := A_Index-1, j := i+2, w%A_Index% := v%i%+v%A_Index%+v%j% = 2
Loop % n
GuiControl,,v%A_Index%, % v%A_Index% := w%A_Index%
Return
GuiClose: ; exit when GUI is closed
ExitApp |
|
|
| Back to top |
|
 |
BoBo³ Guest
|
Posted: Thu Jul 02, 2009 5:40 pm Post subject: |
|
|
| Quote: | | I guess we picked all the low hanging fruits | I'll assist you if you can tell me how to enable those billions of unused braincells in that nutshell which is positioned right on my neck.
Gruß aus dem mediteranen Deutschland (31°C ) |
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Thu Jul 02, 2009 6:33 pm Post subject: |
|
|
| BoBo³ wrote: | | tell me how to enable those billions of unused braincells in that nutshell which is positioned right on my neck |
In the nice old days I had a flight from Budapest. We walked to the TU134 waiting for the passengers. One of us noticed that fluid was leaking from a hole above the cockpit, and alerted the stewardess, who called the pilot. He came with a hammer attached to a long stick, and banged on the side of the plain, saying: “Don’t worry, the leak usually stops after a strong enough hit”.
The Tupolev airplanes are long gone, but you might get hold of one of those hammers. If one stops a leak on a plane, it might also enable brain cells with a strategically positioned hit...  |
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Thu Jul 02, 2009 7:04 pm Post subject: Long Multiplication |
|
|
BCD coding allows very simple implementation of Long Multiplication. Long (non-negative) integers are stored in decimal digit strings, MS first. | Code: | MsgBox % x := mul(256,256)
MsgBox % x := mul(x,x)
MsgBox % x := mul(x,x) ; 18446744073709551616
MsgBox % x := mul(x,x) ; 340282366920938463463374607431768211456
mul(b,c) { ; <- b*c
VarSetCapacity(a, n:=StrLen(b)+StrLen(c), 48), NumPut(0,a,n,"char")
Loop % StrLen(c) {
i := StrLen(c)+1-A_Index, cy := 0
Loop % StrLen(b) {
j := StrLen(b)+1-A_Index,
t := SubStr(a,i+j,1) + SubStr(b,j,1) * SubStr(c,i,1) + cy
cy := t // 10
NumPut(mod(t,10)+48,a,i+j-1,"char")
}
NumPut(cy+48,a,i+j-2,"char")
}
Return cy ? a : SubStr(a,2)
} |
Edit: simplified!
Note: literal long integer parameters have to be enclosed in quotes, otherwise they are treated as 64-bit numbers, which could overflow. |
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Fri Jul 03, 2009 12:19 am Post subject: Sierpinski triangle |
|
|
Here is a recursive function for the ASCII representation of Sierpinski triangles. It constructs the string in a static array. | Code: | Loop 6
MsgBox % Triangle(A_Index)
Triangle(n,x=0,y=1) { ; Triangle(n) -> string of dots and spaces of Sierpinski triangle
Static t, l ; put chars in a static string
If (x < 1) { ; when called with one parameter
l := 2*x := 1<<(n-1) ; - compute location, string size
VarSetCapacity(t,l*x,32) ; - allocate memory filled with spaces
Loop %x%
NumPut(13,t,A_Index*l-1,"char") ; - new lines in the end of rows
}
If (n = 1) ; at the bottom of recursion
Return t, NumPut(46,t,x-1+(y-1)*l,"char") ; - write "." (better at proportional fonts)
u := 1<<(n-2)
Triangle(n-1,x,y) ; draw smaller triangle here
Triangle(n-1,x-u,y+u) ; smaller triangle down-left
Triangle(n-1,x+u,y+u) ; smaller triangle down right
Return t
} |
|
|
| Back to top |
|
 |
Laszlo
Joined: 14 Feb 2005 Posts: 4517 Location: Boulder, CO
|
Posted: Fri Jul 03, 2009 3:46 am Post subject: Sierpinski carpet |
|
|
The iterative script for the Sierpinski carpet below is based on the Python code: determine from the base 3 representation of coordinates if we need dot or space. | Code: | Loop 4
MsgBox % Carpet(A_Index)
Carpet(n) {
Loop % 3**n {
x := A_Index-1
Loop % 3**n
t .= Dot(x,A_Index-1)
t .= "`n"
}
Return t
}
Dot(x,y) {
While x>0 && y>0
If (mod(x,3)=1 && mod(y,3)=1)
Return " "
Else x //= 3, y //= 3
Return "."
} |
|
|
| Back to top |
|
 |
|
|
You can post new topics in this forum You can reply to topics in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|