Code Snippets > Misc ( Created 15 September 2016 | Last Edited 15 September 2016)

 Contour Map from Data by Andy_A | No VotesMakes a contour map! Written inBlitz I found this on the QB64 forum. It's a really nice and compact way to create a contour map from just a handful of data points. There seems to be quite a few practical uses for this type of code. Here's a simple use: However, it can be very slow, if you use a large screen res with lots of data points (loops nested 4 deep). As it is now, with 23 data points at 640x480 res, it takes about 20 seconds on my slow laptop. ;http://www.qb64.net/forum/index.php?topic=3714.msg37019#msg37019 ;https://en.wikipedia.org/wiki/Richard_V._Southwell ;https://en.wikipedia.org/wiki/Relaxation_(iterative_method) ;============================================================ ; Contour map directly from data points by Mrwhy ;============================================================ ; B+ version by Andres Amaya Jr - 2016 ;============================================================ AppTitle "Contour Map by Mrwhy - Click to exit" Const sw% = 640 Const sh% = 480 Graphics sw, sh, 32, 2 SetBuffer BackBuffer() SeedRnd MilliSecs() Dim pal%(47,2), fx#(50), fy#(50), iz#(100), E#(50), h#(640, 480) Gosub setPalette Local i#, ztot#, n#, zmean#, wo#, w#, emax# Local k#, dx#, dy#, dsq#, ii#, x#, y#, dsq2#, et# Local numPoints%, st%, jj%, col% Restore heightData Read numPoints For i = 1 To numPoints Read fx(i),fy(i),iz(i) Color 255,255,255 Text fx(i)-8, fy(i)-16, Str(Int(iz(i))) Color pal(iz(i-1),0), pal(iz(i-1),1), pal(iz(i-1),2) Oval fx(i)-4, fy(i) - 4, 8, 8, True Color 0,0,0 Oval fx(i)-2, fy(i) - 2, 4, 4, True ztot = ztot + iz(i) Next n = numPoints zmean = ztot / n wo = Float(sw) * Float(sh) / n w = wo/2.0 legend(47) Color 255,255,255 msg\$ = "Calculating contour plot" Text 50,0,msg\$ tx = StringWidth(msg\$)+50 Flip st = MilliSecs() For i = 1 To n E(i) = Float(iz(i)) - zmean Next chk% = 9 * n / 10 For jj = 1 To 9 * n ;find max error point emax = 0.0 For i = 1. To n If Abs(E(i)) > emax Then emax = Abs(E(i)): ii = i k = E(ii) Next ;fixit For i = 1 To n dx = fx(i) - fx(ii) dy = fy(i) - fy(ii) dsq = dx*dx + dy*dy E(i) = E(i) - k * Exp(-(dsq / w)) If i = ii Then For y = 1 To sh-1 For x = 1 To sw-1 dx = x - fx(ii) dy = y - fy(ii) dsq2 = dx*dx + dy*dy h(x, y) = h(x, y) + k * Exp(-(dsq2 / w)) Next If KeyHit(1) Then End Next End If Next If jj Mod chk = 0 Then Text tx, 0,"." Flip tx = tx + 6 End If Next For y = 1 To sh-1 For x = 1 To sw-1 col = h(x, y) + Int(zmean) Color pal(col,0), pal(col,1), pal(col,2) Rect x-1, y-1, 3, 3, True Next If KeyHit(1) Then End Next et = (MilliSecs()-st)/1000.0 legend(47) Color 0,0,0 Text 50, sh-15, "et: "+et For i = 1 To n Color 0,0,0 Text fx(i)-8, fy(i)-16, Str(Int(iz(i))) Oval fx(i)-3, fy(i)-3, 6, 6, True Color pal(iz(i),0), pal(iz(i),1), pal(iz(i),2) Oval fx(i)-2, fy(i)-2, 4, 4, True Next Flip WaitMouse() End Function legend(colorMax%) iy = 0 Color 0,0,0 Rect 0,0,40,sh,True For id% = 0 To colorMax Color 255,255,255 If id < 10 Then istr\$ = " "+Str(id) Else istr\$ = Str(id) End If Text 0, iy, istr\$ Color pal(id,0),pal(id,1),pal(id,2) Rect 18,iy+2, 22, 6,True iy = iy + 10 Next End Function .heightData Data 23 ;number of data points Data 279,220,11 ;1 Data 160,160,29 ;2 Data 80,80,36 ;3 Data 144,40,27 ;4 Data 350,158,34 ;5 Data 356,248,37 ;6 Data 280,347,29 ;7 Data 387,77,13 ;8 Data 130,230,12 ;9 Data 270,120,29 ;10 Data 360,320,28 ;11 Data 140,270,11 ;12 Data 530,300,36 ;13 Data 450,110,29 ;14 Data 380,370,12 ;15 Data 270,270,10 ;16 Data 600,40,15 ;17 Data 60,440,16 ;18 Data 195,81,17 ;19 Data 206,196,18 ;20 Data 196,110,15 ;21 Data 198,306,20 ;22 Data 399,229,21 ;23 .setPalette Restore rbw48 For i = 0 To 47 Read co% pal(i,0) = co Shr 16 And 255 pal(i,1) = co Shr 8 And 255 pal(i,2) = co And 255 Next Return .rbw48 Data \$0000FF,\$2000FF,\$4000FF,\$6000FF,\$8000FF,\$A000FF,\$C000FF,\$E000FF Data \$FF00FF,\$FF00E0,\$FF00C0,\$FF00A0,\$FF0080,\$FF0060,\$FF0040,\$FF0020 Data \$FF0000,\$FF2000,\$FF4000,\$FF6000,\$FF8000,\$FFA000,\$FFC000,\$FFE000 Data \$FFFF00,\$E0FF00,\$C0FF00,\$A0FF00,\$80FF00,\$60FF00,\$40FF00,\$20FF00 Data \$00FF00,\$00FF20,\$00FF40,\$00FF60,\$00FF80,\$00FFA0,\$00FFC0,\$00FFE0 Data \$00FFFF,\$00E0FF,\$00C0FF,\$00A0FF,\$0080FF,\$0060FF,\$0040FF,\$0020FF[imgs]null[/imgs] -->

Posted : Friday, 16 September 2016, 18:14
HoboBen

Ooooh neat!

-=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- (c) WidthPadding Industries 1987 648|0 -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=- -=+=-
 Latest PostsAny Feature Requests? Kuron Fri 23:09 More Monkey Madness - With Ducks therevillsgames Fri 20:23 Arms on Switch Jayenkai Fri 18:30 Time for a new Android Test Doohickey Jayenkai Fri 09:26 CSS-Me-Do - SoCoder2 Jayenkai Fri 06:28 Pillowcases for kids! rockford Thu 16:15 Manchester Arena Explosion Jayenkai Thu 02:04 Buy Zelda spinal Wed 11:31 Family Jayenkai Wed 04:06 RIP - Sir Roger Moore rockford Tue 15:56 More

 Latest Items Showcase : Hiveszzoom Fri 16:10 Dev-Diary : My Journey into NES Developmentrychan Thu 12:31 Showcase : FlappadiddleJayenkai Sun 14:39 Snippet : QFindJayenkai Sun 13:02 Showcase : Tiny BlocksJayenkai Sun 04:08 Showcase : Read Error Arychan Fri 05:13 Blog : All my makes!Jayenkai Tue 05:48 Showcase : Infinitronrychan Mon 18:03 Showcase : Quadobanrskgames Fri 10:11 Blog : My Arduino experience.steve_ancell Wed 17:02 Showcase : Roguelike ExplorerPakz Fri 06:59 News : Newsletter #311Jayenkai Thu 17:27 Link : Super Shapes Exploration KitAndy_A Thu 11:09 Dev-Diary : Sensitive - Arduboy!rychan Thu 17:27 Snippet : Skylinessteve_ancell Tue 14:25More

Who's Online
Kuron
Fri, at 23:09
Evil Roy Ferguson
Fri, at 20:47
therevillsgames
Fri, at 20:23
rskgames
Fri, at 19:28
Jayenkai
Fri, at 18:41