Interpolering af data fra tabel

Jeg har ikke kigget nærmere på din kode, men kan du ikke bare bruge de indbyggede funktioner til at vise regressionslinier? Du har faktisk de samme muligheder som i Excel.

jeg skal lave det i Access og det er det der er problemmet. :(

Jamen det er også i Access. Grafikken i Access er næsten identisk med grafikken i Excel. Det betyder at du også i Access kan få programmet til at vise diverse regressionslinier.

Phi-del > Jeg har fået din mail, og jeg fortsætter bare med at kommentere herinde. Jeg vil gerne se på din db, men jeg forstår ikke det tekniske i interpolation desværre, så jeg kan vist kun bistå med rettelse af kode, der ikke virker.

jesperfjoelner..
det er helt ok, jeg ahr også fundet ud af hvad problemmet er.
og den første kode kan jeg ikke bruge da mine linier ikke er linear.

jeg har derfor noget andet som virker, men problemmet er at det tage for langtid for databasen at lave.
jeg har 1200 recordset og 7 kolloner, og der tager jeg dem for punkt til punkt, frem og skriv, tilbage og skriv...osv....

jeg tænkte at det måske ville være hurtigere for computere hvis jeg smed alt i en array og arbejdede og senere smid ind i tabelen igen ?


eller om der er en måde man kan få hele tabellen ind i memoryen og arbejde med den der istedet for apply den senere ?

Ja det lyder som noget, der godt kunne laves hurtigere.
Hvis du poster koden, så vil jeg se om jeg kan finde på noget, som kan få det til at køre hurtigere.

ok jeg sender med det samme :)

har du modtaget min mail.

Den er modtaget.
Er det "Private Sub btn_interpolere_Click()" der er langsom?

ja

En ting først. Det er en god ting at bruge "Option Explicit" allerøverst i al kode.
Det sikrer at man får "Dim'et" alle variabler. Du kan slå det permanent til under Tools > Options > Require variable declarations

Hvis du så compiler projektet Debug > Compile  kan du se at en del variabler skal Dim'es.

Der er et par ting jeg undrer mig over.
Du refererer til funktionenerne DeltaY og DeltaX indenfor "btn_interpolere", men funktionerne bliver tilsyneladende ikke brugt til noget eller hvad?
Efter de er kaldt i btn_interpolere kan jeg ikke se at de bliver brugt mere.

Som jeg læser det vil du have f.eks. funktionen DeltaY til at returnere et tal?
Skal den returnere x1 og y1?

hej igen. undskylder tiden.....
Deltay og deltaX er procedure som bliver brugt af btn_interpolere til at finde
x1 y1 og y2 x2 disse findes og bruges i beregningerne.

Ok, men så vidt jeg kan se returnerer de ikke noget fra funktionerne fmmDataY/X til din procedure. Jeg tror der er et par problemer med det.

Dette er din funktion DeltaY:

Function fmmDeltaY(y1, x1, x, i)
Dim rec As Recordset
Dim qry As QueryDef
Dim strSQL As String
Dim dbs As Database
Set dbs = CurrentDb
strSQL = "SELECT * FROM TmpGraf"
Set qry = dbs.CreateQueryDef("", strSQL)
Set rec = qry.OpenRecordset()
While Not rec.Fields!Procent = x
    rec.MoveNext
Wend
While IsNull(rec.Fields("mpa" & i))
    rec.MovePrevious
Wend
y1 = rec.Fields("mpa" & i)
x1 = rec.Fields!Procent
rec.Close
Set qry = Nothing
End Function

men den returnerer ikke noget.
Hvad skal den returnere? x1 og y1?

Normalt kan en funktion kun returnere én værdi, men der er et par måder at få den til at returnere 2 værdier.

Er jeg på rette spor her?

Hvis den skal returnere noget skal den hedde noget med

Function fmmDeltaY(x, i) as long/string
..
End function

Hej igen, så er jeg tilbage.

proceduren inkl. de 2 functioner ser således ud.
jeg undskylder, jeg trorre jeg har blandet det sammen med alt mulligt.... sorry..





Private Sub btn_interpolere_Click()
Dim x As Double
Dim rec As Recordset
Dim qry As QueryDef
Dim strSQL As String

Set dbs = CurrentDb

strSQL = "SELECT * FROM TmpGraf "

Set qry = dbs.CreateQueryDef("", strSQL)
Set rec = qry.OpenRecordset()

For i = 2 To 8

rec.MoveFirst
Do Until Not IsNull(rec.Fields("mpa" & i))
    rec.MoveNext
Loop

    Do Until rec.Fields("mpa" & i) = 0
        If IsNull(rec.Fields("mpa" & i)) Then
            x = rec.Fields!Procent
            DeltaY = fmmDeltaY(y1, x1, x, i)
            DeltaX = fmmDeltaX(x2, y2, x, i)
            res = (y2 - y1) / (x2 - x1) * (x - x1) + y1
            rec.MoveFirst
            While Not rec.Fields!Procent = x
                rec.MoveNext
            Wend
            rec.Edit
            rec.Fields("mpa" & i) = Format(res, "#0.000")
            rec.Update
        End If
        rec.MoveNext
    Loop
Next i
MsgBox "Interpolering er fuldført "
    rec.Close
    Set qry = Nothing
End Sub
Function fmmDeltaY(y1, x1, x, i)
Dim rec As Recordset
Dim qry As QueryDef
Dim strSQL As String
Dim dbs As Database

Set dbs = CurrentDb

strSQL = "SELECT * FROM TmpGraf "
Set qry = dbs.CreateQueryDef("", strSQL)
Set rec = qry.OpenRecordset()


While Not rec.Fields!Procent = x
    rec.MoveNext
Wend

While IsNull(rec.Fields("mpa" & i))
    rec.MovePrevious
Wend

y1 = rec.Fields("mpa" & i)
x1 = rec.Fields!Procent

rec.Close
Set qms = Nothing
End Function

Function fmmDeltaX(x2, y2, x, i)
Dim rec As Recordset
Dim qry As QueryDef
Dim strSQL As String
Dim dbs As Database

Set dbs = CurrentDb

strSQL = "SELECT * FROM TmpGraf "
Set qry = dbs.CreateQueryDef("", strSQL)
Set rec = qry.OpenRecordset()

rec.MoveFirst
    While Not rec.Fields!Procent = x
    rec.MoveNext
    Wend
   
While IsNull(rec.Fields("mpa" & i))
    rec.MoveNext
Wend
    x2 = rec.Fields!Procent
    y2 = rec.Fields("mpa" & i)
   
rec.Close
Set qms = Nothing
End Function

hvis man kørere den i debug mode så kan de visse noget, men det er her der er den rigtige sorry.

Der er et par ting jeg ikke forstår.

Den her f.eks:
  Set qry = dbs.CreateQueryDef("", strSQL)
  Set rec = qry.OpenRecordset()

Hvorfor laver du den ikke bare som
  set rec = dbs.openrecordset(strSQL)

og helt unlader qry i proceduren. Så vidt jeg kan se bruger du ikke qry til noget.


Og din funktion:
  Function fmmDeltaX(x2, y2, x, i)
returnerer jo ikke noget værdi - skal den ikke det? Det ser ud som om du ønsker at den skal returnere x2 og y2. Men så skal den jo stare med:
  Function fmmDeltaX(x, i) as double
så den returnerer et tal. I dette tilfælde returnerer den godt nok kun et tal, men det kan laves så den returnerer begge to.

Og det her:
  DeltaY = fmmDeltaY(y1, x1, x, i)
  DeltaX = fmmDeltaX(x2, y2, x, i)
  res = (y2 - y1) / (x2 - x1) * (x - x1) + y1

Det ser ud som du ønsker at lægge nogle værider i variablerne DeltaY og DeltaX og at de værdier skal komme fra funktionen fmmDeltaY og fmmDeltaX. Men da funktionerne ikke returnerer værdier (se ovenfor) lægges der ikke noget i variablerne DeltaY og DeltaX.

jer på nu :)

hmmm. det med :

Den her f.eks:
  Set qry = dbs.CreateQueryDef("", strSQL)
  Set rec = qry.OpenRecordset()

Hvorfor laver du den ikke bare som
  set rec = dbs.openrecordset(strSQL)

det kan man jo rette det til men ville det gøre det hurtigere, og hvad er forskellen.
jeg har bare kun lært den jeg bruger ?


det andet med funktionerne:


Hvis du trykker lige udenfor
DeltaY = fmmDeltaY(y1, x1, x, i) så kan man sætte en Break point og når man så gå hen over y1, x1, x, i, så visser y1, og x1 ikke nogen værdie.
hvis man derfra så trykker på F8 og så kan man se at den går ind i funktionen og laver beregningen og sætter dem i variablerne Y1 og X1 .


se koden
Kommentar: phi-del
09/01-2006 09:20:20

jeg har været inde og rette det her

  Set qry = dbs.CreateQueryDef("", strSQL)
  Set rec = qry.OpenRecordset()

TIL
  set rec = dbs.openrecordset(strSQL)

Ang.
>Den her f.eks:
  Set qry = dbs.CreateQueryDef("", strSQL)
  Set rec = qry.OpenRecordset()

Det har ikke noget med hastigheden at gøre (det er jeg ikke kommet til endnu :-)
men :    set rec = dbs.OpenRecordset(strSQL)
gør det samme og du undgår at åbne en querydef.


>DeltaY = fmmDeltaY(y1, x1, x, i) så kan man sætte en Break point og når man så gå hen over y1, x1, x, i, så visser y1, og x1 ikke nogen værdie.

Der hvor du kalder funktionen med
DeltaY = fmmDeltaY(y1, x1, x, i)
har du ikke angivet værdier til y1 og x1. Så de vil jo være Null. Du skal vel fodre funktionen med nogle værdier, den kan arbejde med.

jamen værdierne er tomme til at starte med på nær X og i.
de andre bliver fyldt ud efter den har kørt igennem deltay.
hvor kommer y1,x1,y2 og x2 så fra ?

men jeg det er rigtigt at vi ikke bruger Deltay  til noget men fmmdeltaY kaldet og funktionen er ok og den sætter også nogle variable til  ?

har du ikke angivet værdier til y1 og x1. Så de vil jo være Null. Du skal vel fodre funktionen med nogle værdier, den kan arbejde med.
sorry har efter nærlæsning forstået det nærmere

jeg sender disse y1, x1, x, i og i  X og I ligger der nogle værdier som
funktionen bruger til at kommer frem og beregne Y1 og X1

er jeg meget gal på den :(

Først og fremmest er jeg ikke med på hvorfor der skal lægges værdier i variablen DeltaX med: DeltaX = fmmDeltaX(x2, y2, x, i)
er det fordi du vil have udført den kode der ligger i fmmDeltaX ?
Så kan du bruge en sub i stedet for en funktion

Hvis du vil have en værdi lagt i DeltaX kalder ikke funktioner på den korrekte måde.
Hvis man fodrer x til en funktion og vil have den til at returnere noget gøres det således:

Function test(x as integer) as integer
Dim y as integer
y = x*5
test = y
End function

Hvis du kalder dette fra et andet sted din kode sådan:

Myvalue = test(2)  så returnerer den 10.

Så din funktion skal hedde noget med
Function fmmDeltaX(x,i) as double
  ...
  y1 = rec.Fields("mpa" & i)
  fmmDeltaX = y1
End funktion

Vi mangler dog stadig at finde ud af hvordan du vil returnere 2 værdier fra funktionen. Eller vil du slet ikke returnere noget, men bare køre koden i fmmDeltaX/Y?

de to funktioner skal returnere værdier til os så vi kan udregne

res = (y2 - y1) / (x2 - x1) * (x - x1) + y1
også skriver vi nemlig res ned i databseb.

for hvis x1,x2,y1,y2 er null så for vi nemlige ikke noget res ud :(

prik prik --- Er du der ?  :)

jeg bladre meget i recordsetet med
rec.MoveFirst
    While Not rec.Fields!Procent = x
    rec.MoveNext
    Wend
jeg tror at det er det der bruger meget af tiden, kunne man bruge
rec.FindFirst (Procent = " & x & ") eller andet der er smart.

Ja hvis du bladre frem og tibage, så kan det godt tage tid!

phi-del > Jeg ved ikke om den er hurtigere, men det er da en anden måde at gøre det på:

rec.MoveFirst
Do Until rec.EOF
    rec.MoveNext
Loop

phi-del > kan du ikke bruge Dlookup? Kender du den?

Der ser ud som om du først gennemgår en masser rækker en for en, og derefter går tilbage nogle rækker én for én ?

Glem lige min kommentar - jeg var lige et helt andet sted henne ;0)

det gøre jeg fordi.
Jeg skal sætte mig på der hvor værdien procent er det samme som X
også skal jeg engang tilbage til der eksistere noget sætte den i variabel.

det er faktisk det det går ud på .
at jeg i finder x og går en frem og sætter den i en variabel.
også finder jeg x og sætter mig på den og går en tilbage.

OK, jeg kigger på det. Jeg tror godt det kan gøre hurtigere.

indtil videre har jeg lavet din funktion om således, men det failer halvvejs.

Der er stadig en del, der kan ryddes op i.
Du benytte dig stort set ikke SQLs muligheder for at finde poster frem, men looper bare igennem tabellen hver gang.
Det kan sagtens komme til at køre hurtigere.


Private Sub btn_interpolere_Click()
Dim x As Double
Dim rec As Recordset
Dim qry As QueryDef
Dim strSQL As String
Dim SQLX As String
Dim SQLY As String
Dim dbs As DAO.Database
Dim i As Integer
Dim y1 As Double, y2 As Double, x1 As Double, x2 As Double
Dim DeltaY As Double
Dim DeltaX As Double
Dim res As Double
Dim rsY As DAO.Recordset
Dim rsX As DAO.Recordset

Set dbs = CurrentDb

strSQL = "SELECT * FROM TmpGraf"

Set rec = dbs.OpenRecordset(strSQL)

For i = 2 To 8

rec.MoveFirst

Do Until Not IsNull(rec.Fields("mpa" & i))
    rec.MoveNext
Loop
    Do Until rec.Fields("mpa" & i) = 0
        If IsNull(rec.Fields("mpa" & i)) Then
            x = rec.Fields!procent
           
            'DeltaY = fmmDeltaY(y1, x1, x, i)
            'DeltaX = fmmDeltaX(x2, y2, x, i)
           
            'nytilføjet
            SQLY = "SELECT procent,[mpa" & i & "] FROM tmpGraf " & _
            "WHERE ([procent] <= " & Replace(x, ",", ".") & ") AND (not [mpa" & i & "] is null) ORDER BY [procent] DESC"
            'Debug.Print SQLY
            Set rsY = dbs.OpenRecordset(SQLY)
            x1 = rsY!procent
            y1 = rsY("mpa" & i)
            rsY.Close
            Set rsY = Nothing
           
            SQLX = "SELECT procent,[mpa" & i & "] FROM tmpGraf " & _
            "WHERE ([procent] >= " & Replace(x, ",", ".") & ") AND (not [mpa" & i & "] is null) ORDER BY [procent] ASC"
            'Debug.Print SQLX
            Set rsX = dbs.OpenRecordset(SQLX)
            x2 = rsX!procent
            y2 = rsX("mpa" & i)
            rsX.Close
            Set rsX = Nothing
                       
            res = (y2 - y1) / (x2 - x1) * (x - x1) + y1
            rec.MoveFirst
            While Not rec.Fields!procent = x
                rec.MoveNext
            Wend
            rec.Edit
            rec.Fields("mpa" & i) = Format(res, "#0.000")
            rec.Update
        End If
        rec.MoveNext
    Loop
Next i
MsgBox "Interpolering er fuldført "

rec.Close


End Sub

Jeg har ikke tid til at kigge mere på det i dag, men kan vende tilbage i morgen med en mere komplet løsning.

Har den overhovedet kunne køre og hvor lang tid tog det?
Der er primært hastighedsfobedringer vi er ude efter er det ikke eller har det overhovedet virket?

Den her:
res = (y2 - y1) / (x2 - x1) * (x - x1) + y1

skal den opfattes så'n her
res = ((y2 - y1) / (x2 - x1) * (x - x1)) + y1

eller så'n
res = (y2 - y1) / ((x2 - x1) * (x - x1) + y1)


?

Ja, så skulle jeg alligevel prøve.
Tjek din mail, jeg har sendt db'en.

Den kan nu køre det hele igennem, men jeg ved ikke hvordan tempoet er i forhold til før. Det tager stadig lidt tid. Jeg har sat en progressbar ind for at det skal være nemmere at se at der sker noget.
Beregningsfejlene, som jeg tror der er, må vi lige komme tilbage til. Det har måske noget at gøre med sidst post.

Hej igen :).
har kigget på de du har sendt til mig.
det tager ligeså langtid at regne på det.

og der forgår nogle helt forkerte beregninger fordi man sætter sig på de forkerte steder.

Beregning forgår på denne måde.
alle vores Procent er fuldkommende men vores MPA er ikke fuldkommende og der er dem vi skal have fyldt ud, derfor skal vi interpolllere, og måden er :

vi finder den første tomme felt i mpa og sætter og smider dens Procent værdi i en variabel (X) så vi kan finde den igen da Procent-værdierne er unikke.
så rykker vi engang tilbage til der er en MPA værdi som har noget indhold og smider dens MPA værdi og Procent værdi i 2 nye variabler X1,Y1.

derefter går vi tilbage til vores X variabel på recordsetet og finder den næste Y felt hvor indholdet ikke er tom og der smider vi procent og MPa i nye variabler x2,y2

derefter kørere vi den igennem formlen som giver resultater res. og res gemmer vi i den tomme y værdi vi startede med. og det er x variablet man bruger for at finde den.


du behøver ikke at bruge min kode, men kan også bruge andet så¨længe princippet fungere.

hvis du prøver at eksvere den orginale intepollering knap vil du opleve at det diagram der er her får lige linier og kommer til at se pænt ud, og der er derfor vi interpollere.

Ja, jeg kan godt se den regner forkert.
Jeg prøver at kigge på det senere i dag, og vil se om det kan komme til at køre lidt hurtigere.

Tjek lige den her og se om det nærmer sig.
Jeg tror den regner rigtigt - det var jo det med parenteserne jeg spurgte om.

Det går dog ikke hurtigere. Jeg ved ikke om det kan gøres så det går hurtigere. Man hopper rigtig meget rundt i tabellen og jeg ved ikke om der er en hurtigere vej.
Der er nogle huller i resultaterne. Det skal der lige kigges på.




Private Sub btn_interpolere_Click()
Dim x As Double
Dim rec As Recordset
Dim qry As QueryDef
Dim strSQL As String
Dim SQLupdate As String
Dim dbs As DAO.Database
Dim iCol As Integer
Dim y1 As Double, y2 As Double, x1 As Double, x2 As Double
Dim resultat As Double
Dim SQLy As String, SQLx As String
Dim rsY As DAO.Recordset
Dim rsX As DAO.Recordset

Set dbs = CurrentDb

strSQL = "SELECT * FROM TmpGraf"

Set rec = dbs.OpenRecordset(strSQL)

For iCol = 2 To 8
rec.MoveLast
rec.MoveFirst

Do Until Not IsNull(rec.Fields("mpa" & iCol))
    rec.MoveNext
Loop
    Do Until rec.Fields("mpa" & iCol) = 0
        ProgressBar rec.RecordCount, rec.AbsolutePosition + 1, iCol & " af 8"
        If IsNull(rec.Fields("mpa" & iCol)) Then
            x = rec.Fields!Procent

            SQLy = "SELECT procent,[mpa" & iCol & "] FROM tmpGraf " & _
            "WHERE ([procent] <= " & Replace(x, ",", ".") & ") AND (not [mpa" & iCol & "] is null) ORDER BY [procent] DESC"
            'Debug.Print SQLy
            Set rsY = dbs.OpenRecordset(SQLy)
           
            x1 = rsY!Procent
            y1 = rsY("mpa" & iCol)
            rsY.Close
            Set rsY = Nothing
           
            SQLx = "SELECT procent,[mpa" & iCol & "] FROM tmpGraf " & _
            "WHERE ([procent] >= " & Replace(x, ",", ".") & ") AND (not [mpa" & iCol & "] is null) ORDER BY [procent] ASC"
            'Debug.Print SQLx
            Set rsX = dbs.OpenRecordset(SQLx)
            x2 = rsX!Procent
            y2 = rsX("mpa" & iCol)
            rsX.Close
            Set rsX = Nothing

            'Her blev jeg nødt til at tjekke om det det giver nul,
            'da der ellers sættes 0 i nævneren nedenfor og det kan man ikke dividere med.
            If (x2 - x1) * (-x1) <> 0 Then
                resultat = ((y2 - y1) / (x2 - x1) * (x - x1)) + y1
                'resultat = (y2 - y1) / (x2 - x1) * (x - x1) + y1
                SQLupdate = "UPDATE tmpGraf SET [mpa" & iCol & "]=" & Replace(resultat, ",", ".") & " WHERE procent = " & Replace(x, ",", ".")
                Debug.Print SQLupdate
                dbs.Execute SQLupdate, dbFailOnError
            'Else
            '    resultat = x
            End If
           
        End If
        rec.MoveNext
    Loop
Next iCol
ProgressBar 1, 1, ""
MsgBox "Interpolering er fuldført "

rec.Close
Set rec = Nothing
End Sub

hej igen.

Jeg takker mange gange for det hjælpe du har ydet.  :)

jeg har fået løst problemmet.
efter flere forsøg, fik jeg gjort tingene således at alt blev smidt i en Array.
og senere har jeg så lavet mine beregninger i arrayen.
beregningen fungere nu optimal, og hastigheden er kommet ned på 4 sekunder, men den kan jeg lige tune ned til 2, og det må så være det :)

men igen tak for hjælp og support :)