Histogrammes barres et/ou camembert

' ce programme télécharge les statistiques Actifs-Retraités INSEE
' puis produit un histogramme avec ces données.
'
' Le téléchargement arrive en format Excel (*.xls). Ouvrir ce
' fichier avec Excel et sauvegarder en format texte avec séparateur TAB,
' sous le nom de fichier Actifs-REtraités.txt.
'
' Si Excel n'est pas disponible, mettre la valeur de EXCEL% à zéro,
' et le programme suppose la préexistance du fichier texte.

' LINE   Line Chart
' BAR   Bar Chart (Including Horizontal, and stacked charts)
' SPLINE   Curve-fitting Chart
' MARK   Point Chart
' PIE   Pie Chart
' AREA   Area Chart (Including stacked charts)
' PARETO   Pareto Chart (Statistical Chart. Special)
' SCATTER   Scatter Chart
' HILOW   Hi-Low Close Chart

label purger_ligne, extraire_valeur, charger_fichier
label telecharger_fichier, generer

' paramètres à adapter
dim EXCEL% : EXCEL% = 0
dim lien$ : lien$ = "http://www.insee.fr/fr/ffc/figure/NATTEF04560.xls"
dim file_stat$ : file_stat$ = "Actifs-Retraités.txt"
dim file_histo$ : file_histo$ = "Histogramme.txt"

height 0,550

dim annees%(50), cotisants(50), retraites(50), rapport(50)
dim n_lignes%, canal%, ligne$, i% , j%, s$, crlf$, config%
dim type$

crlf$ = chr$(13) + chr$(10)
button 2 : top 2,10 : left 2,10 : width 2,200
caption 2,"Charger Actifs-Retraités.txt"
on_click 2,charger_fichier
if EXCEL%=1
    alpha 3 : top 3,40 : left 3,10
    s$ = "Pour charger les statistiques Actifs-Retraités de l'INSEE," + crlf$
    s$ = s$+"Cliquez sur le bouton Télécharger"
    caption 3,s$
    alpha 4 : top 4,40 : left 4,10
    s$ = "Dans le tableau Excel, faire:"+chr$(13)+chr$(10)
    s$ = s$ + "    Ficher/Enregistrer sous: "+file_stat$+crlf$
    s$ = s$ + "    Type de fichier: Texte (séparateur: tabulation) (*.txt)"+crlf$
    s$ = s$ + "Puis cliquer sur le bouton Charger"
    caption 4,s$  : hide 4
    hide 2 : hide 4
    button 1 : top 1,10 : left 1,10 : width 1,200
    caption 1,"Télécharger statistiques du net"
    on_click 1,telecharger_fichier
end_if

                                              '
memo 10 : hide 10 : top 10,10 : left 10,10 : width 10,250 : height 10,500
button 11 : hide 11 : top 11,10 : left 11,270 : width 11,120
caption 11,"Générer histogramme"
on_click 11,generer

container_option 20 : hide 20 : top 20,40 : left 20,270 : width 20,200 : height 20,130
caption 20,"Format"
option 21 : parent 21,20 : top 21,20 : left 21,10 : caption 21,"Sans boutons"
option 22 : parent 22,20 : top 22,40 : left 22,10 : caption 22,"Boutons à droite"
option 23 : parent 23,20 : top 23,60 : left 23,10 : caption 23,"Boutons à gauche"
option 24 : parent 24,20 : top 24,80 : left 24,10 : caption 24,"Boutons en haut"
option 25 : parent 25,20 : top 25,100 : left 25,10 : caption 25,"Boutons en bas"


container_option 30 : hide 30 : top 30,200 : left 30,270 : width 30,200 : height 30,220
caption 30,"Type d'histogramme"
option 31 : parent 31,30 : top 31,20 : left 31,10 : caption 31,"BAR - Barres"
option 32 : parent 32,30 : top 32,40 : left 32,10 : caption 32,"SCATTER"
option 33 : parent 33,30 : top 33,60 : left 33,10 : caption 33,"AREA"
option 34 : parent 34,30 : top 34,80 : left 34,10 : caption 34,"HILOW"
option 35 : parent 35,30 : top 35,100 : left 35,10 : caption 35,"MARK"
option 36 : parent 36,30 : top 36,120 : left 36,10 : caption 36,"SPLINE"
option 37 : parent 37,30 : top 37,140 : left 37,10 : caption 37,"LINE"
option 38 : parent 38,30 : top 38,160 : left 38,10 : caption 38,"PARETO"
option 39 : parent 39,30 : top 39,180 : left 39,10 : caption 39,"PIE - Camembert"
mark_on 22 : mark_on 31

end

generer:
    file_open_write 1,file_histo$
    if checked(31)=1 then type$ = "BAR"
    if checked(32)=1 then type$ = "SCATTER"
    if checked(33)=1 then type$ = "AREA"
    if checked(34)=1 then type$ = "HILOW"
    if checked(35)=1 then type$ = "MARK"
    if checked(36)=1 then type$ = "SPLINE"
    if checked(37)=1 then type$ = "LINE"
    if checked(38)=1 then type$ = "PARETO"
    if checked(39)=1 then type$ = "PIE"
    file_writeln 1,"#Type="+type$
    file_writeln 1,"#Largeur=2"
    file_writeln 1,"#Séries=3"
    file_writeln 1,"#Valeurs="+str$(n_lignes%)
    file_writeln 1,"#Données=1"
    for i%=1 to n_lignes%
        s$ = str$(rapport(i%))
        j% = instr(s$,".")
        if j%>0 then s$ = left$(s$,j%-1)+","+mid$(s$,j%+1,len(s$))
        file_writeln 1,s$
    next i%
    file_writeln 1,"#Données=2"
    for i%=1 to n_lignes%
        s$ = str$(retraites(i%))
        j% = instr(s$,".")
        if j%>0 then s$ = left$(s$,j%-1)+","+mid$(s$,j%+1,len(s$))
        file_writeln 1,s$
    next i%
    file_writeln 1,"#Données=3"
    for i%=1 to n_lignes%
        s$ = str$(cotisants(i%))
        j% = instr(s$,".")
        if j%>0 then s$ = left$(s$,j%-1)+","+mid$(s$,j%+1,len(s$))
        file_writeln 1,s$
    next i%
    file_writeln 1,"#Titres"
    file_writeln 1,"Haut="+"Actifs/Retraités (en millions)"
    file_writeln 1,"Bas=Années "+str$(annees%(1))+" à "+str$(annees%(n_lignes%))
    file_writeln 1,"#Légendes séries"
    file_writeln 1,"Rapport"
    file_writeln 1,"Retraités"
    file_writeln 1,"Cotisants"
    file_writeln 1,"#Légendes valeurs"
    for i%=1 to n_lignes%
'        file_writeln 1,right$(str$(annees%(i%)),2)
        file_writeln 1,str$(annees%(i%))
    next i%
    file_writeln 1,"#Fin"
    file_close 1

    dll_on "histo.dll"
'    i% = DLL_call1("Histogramme",adr(file_histo$))
    config% = 0
    for i%=2 to 5
        if checked(20+i%)=1 then config% = i% - 1
    next i%
    i% = DLL_call2("HistogrammeEX",adr(file_histo$),config%)
    dll_off
    return

telecharger_fichier:
    hide 1 : hide 3
    execute lien$
    show 2 : show 4
    return
   
charger_fichier:
    hide 2 : if EXCEL%=1 then hide 4
    canal% = 1
    file_open_read canal%,file_stat$
    n_lignes% = 0
    file_readln canal%,ligne$
    file_readln canal%,ligne$
    file_readln canal%,ligne$
    file_readln canal%,ligne$

    file_readln canal%,ligne$
    while numeric(left$(ligne$,4))=1
        gosub purger_ligne
        item_add 10,ligne$
        n_lignes% = n_lignes% + 1
        gosub extraire_valeur
        annees%(n_lignes%) = val(s$)
        gosub extraire_valeur
        cotisants(n_lignes%) = val(s$)
        gosub extraire_valeur
        retraites(n_lignes%) = val(s$)
        gosub extraire_valeur
        rapport(n_lignes%) = val(s$)
        file_readln canal%,ligne$
    end_while
    file_close canal%
    show 10 : show 11 : show 20 : show 30
    return

purger_ligne:
    i% = instr(ligne$," (")
    if i%>0 then ligne$ = left$(ligne$,i%-1) + mid$(ligne$,instr(ligne$,")")+1,len(ligne$))
    i% = instr(ligne$,"(")
    if i%>0 then ligne$ = left$(ligne$,i%-1) + mid$(ligne$,instr(ligne$,")")+1,len(ligne$))
    i% = instr(ligne$," ")
    if i%>0 then ligne$ = left$(ligne$,i%-1) + mid$(ligne$,i%+1,len(ligne$))
    return

' extraire_valeur:
'    i% = instr(ligne$,chr$(9))
'    s$ = left$(ligne$,i%-1)
'    j% = instr(s$,",")
'    if j%>0 then s$ = left$(s$,j%-1) + "." + mid$(s$,j%+1,len(s$))
'    ligne$ = mid$(ligne$,i%+1,len(ligne$))
'    return

' remplacement par Jecehel
extraire_valeur:
    i% = instr(ligne$,chr$(9))
    if i% > 0
      s$ = left$(ligne$,i%-1)
      j% = instr(s$,",")
      if j%>0 then s$ = left$(s$,j%-1) + "." + mid$(s$,j%+1,len(s$))
      ligne$ = mid$(ligne$,i%+1,len(ligne$))
    end_if
    return

procedure FitModel(Model : TModel;
                  X, Y, Ycalc : TVector;
                  U : TMatrix;
                  Lb, Ub : Integer;
                  MaxIter : Integer;
                  Tol, SVDTol : Float;
                  B : TVector;
                  V : TMatrix;
                  var Test : TRegTest);