replica nfl jerseysreplica nfl jerseyssoccer jerseyreplica nfl jerseys forums.silverfrost.com :: View topic - Native %pl
forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Native %pl
Goto page Previous  1, 2, 3 ... 5, 6, 7 ... 26, 27, 28  Next
 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+
View previous topic :: View next topic  
Author Message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Thu Oct 05, 2017 11:46 pm    Post subject: Reply with quote

I have been experimenting with log_log scales.


Code:
module relay_curves_mod
implicit none

integer, parameter, private :: dp = SELECTED_REAL_KIND(15,307)
integer, parameter :: npts=60000
real(kind=dp) :: stand_inv(1:npts) = 0.d0, very_inv(1:npts) = 0.d0, extreme_inv(1:npts) = 0.d0, &
                 long_time_inv(1:npts) = 0.d0, amps(1:npts) = 0.d0

contains
  real(kind=dp) function trip_time(char_type, is, i, tms)
  integer, intent(in)       :: char_type  !Integer to denote characteristics
  real(kind=dp), intent(in) :: is         !Setting  current
  real(kind=dp), intent(in) :: i          !Fault current
  real(kind=dp), intent(in) :: tms        !Time multiplier setting
  real(kind=dp), parameter :: alpha(1:4) = (/0.02d0,1.d0,2.d0,1.d0/)
  real(kind=dp), parameter :: k(1:4) = (/0.14d0,13.5d0,80.d0,120.d0/)
    trip_time = 0.d0
    if (char_type .gt. 4) return
    if (char_type .lt. 1) return
    if ( (((i/is)**alpha(char_type)) - 1.d0 ) .gt. 0.d0 ) then
      trip_time = ( k(char_type)/ ( ((i/is)**alpha(char_type)) - 1.d0 ) ) * tms
    end if
  end function trip_time

  integer function generate_curves()
  include<windows.ins>
  integer i
  real(kind=dp) amp, min_y
    amp = 1.005d0
    do i = 1, npts
      stand_inv(i)     = trip_time(1, 1.d0, amp, 1.d0)
      very_inv(i)      = trip_time(2, 1.d0, amp, 1.d0)
      extreme_inv(i)   = trip_time(3, 1.d0, amp, 1.d0)
      long_time_inv(i) = trip_time(4, 1.d0, amp, 1.d0)
      amps(i)          = amp
      amp = amp+0.01d0
    end do
    i = winio@('%mn[Exit]&','exit')
    i = winio@('%fn[Tahoma]&')
    i = winio@('%ts&', 1.5d0)
    call winop@('%pl[native,smoothing=4,framed,etched,width=2]')
    CALL winop@("%pl[x_array,N_GRAPHS=4]")
    call winop@("%pl[scale=log_log]")
!    call winop@("%pl[y_min=0.0001, y_max=10000]")
!    call winop@("%pl[x_min=1,    x_max=1000]")
    call winop@("%pl[link=lines, colour=black,symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=blue, symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=red,  symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=green,symbol=0, pen_style=0]")
    call winop@("%pl[title='STANDARD IEC IDMT CHARACTERISTICS']")
    call winop@("%pl[x_axis='Multiple of setting current [-]']")
    call winop@("%pl[y_axis='Relay operating time [s]']")
    i = winio@('%`bg[white]&')
    i = winio@('%pl',800,600,npts,amps,stand_inv,very_inv,extreme_inv,long_time_inv)
    generate_curves = 1
  end function generate_curves
end module relay_curves_mod

program main
use relay_curves_mod
integer i
i = generate_curves()
end program main
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Fri Oct 06, 2017 12:17 am    Post subject: Reply with quote

The code above produces:-



Adding


Code:
    call winop@("%pl[y_min=0.0001, y_max=10000]")
    call winop@("%pl[x_min=1,    x_max=1000]")


Gives me:-



Now apart from the position of the y axis label and the lack of grid lines this is almost a perfect graph for my purposes. I assume, but have yet to test, that y_min, y_max etc can be changed via the %pl call back function, after scanning the data arrays to find the min and max vals to set the y_min etc values to a value corresponding to 10**N where N is an integer, so that the range covers the values to be plotted. Setting y_min = 0.00022 in the first plot above makes no sense to me, surely y_min = 0.0001 is better?
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Fri Oct 06, 2017 12:22 am    Post subject: Reply with quote

NOTE, the two plots above were produced using DLL14 and 64 bit. When using 32 bit, the modified code for the second plot has a problem with the y-axis.



The label values at 10**-3 and 10**-4 appear as 0.
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Fri Oct 06, 2017 11:27 am    Post subject: Reply with quote

A slightly modified version of last night's code. By scanning the data arrays before the call to %pl in order to set the plot limits we can get it right first time for this type of data set.


Code:
module relay_curves_mod
implicit none

integer, parameter, private :: dp = SELECTED_REAL_KIND(15,307)
integer, parameter :: npts=60000
real(kind=dp) :: stand_inv(1:npts) = 0.d0, very_inv(1:npts) = 0.d0, extreme_inv(1:npts) = 0.d0, &
                 long_time_inv(1:npts) = 0.d0, amps(1:npts) = 0.d0

contains
  real(kind=dp) function trip_time(char_type, is, i, tms)
  integer, intent(in)       :: char_type  !Integer to denote characteristics
  real(kind=dp), intent(in) :: is         !Setting  current
  real(kind=dp), intent(in) :: i          !Fault current
  real(kind=dp), intent(in) :: tms        !Time multiplier setting
  real(kind=dp), parameter :: alpha(1:4) = (/0.02d0,1.d0,2.d0,1.d0/)
  real(kind=dp), parameter :: k(1:4) = (/0.14d0,13.5d0,80.d0,120.d0/)
    trip_time = 0.d0
    if (char_type .gt. 4) return
    if (char_type .lt. 1) return
    if ( (((i/is)**alpha(char_type)) - 1.d0 ) .gt. 0.d0 ) then
      trip_time = ( k(char_type)/ ( ((i/is)**alpha(char_type)) - 1.d0 ) ) * tms
    end if
  end function trip_time

  integer function generate_curves()
  include<windows.ins>
  integer i
  real(kind=dp) amp
  real(kind=dp) :: min_y, max_y, min_x, max_x
  character(len=240) min_y_ch, max_y_ch, min_x_ch, max_x_ch
    amp = 1.005d0
    do i = 1, npts
      stand_inv(i)     = trip_time(1, 1.d0, amp, 1.d0)
      very_inv(i)      = trip_time(2, 1.d0, amp, 1.d0)
      extreme_inv(i)   = trip_time(3, 1.d0, amp, 1.d0)
      long_time_inv(i) = trip_time(4, 1.d0, amp, 1.d0)
      amps(i)          = amp
      amp = amp+0.01d0
    end do
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Fri Oct 06, 2017 11:30 am    Post subject: Reply with quote

cont

Code:
    i = winio@('%mn[Exit]&','exit')
    i = winio@('%fn[Tahoma]&')
    i = winio@('%ts&', 1.5d0)
    call winop@('%pl[native,smoothing=4,framed,etched,width=2]')
    CALL winop@("%pl[x_array,N_GRAPHS=4]")
    call winop@("%pl[scale=log_log]")
   
!   ------------------------------------------------   
    min_x = minval(amps)
    max_x = maxval(amps)
    min_y = min( minval(stand_inv), minval(very_inv), minval(extreme_inv), minval(long_time_inv))
    max_y = max( maxval(stand_inv), maxval(very_inv), maxval(extreme_inv), maxval(long_time_inv))
    call winop@("%pl[y_min="//trim(log10scale_min_char(min_y))//']')
    call winop@("%pl[y_max="//trim(log10scale_max_char(max_y))//']')
    call winop@("%pl[x_min="//trim(log10scale_min_char(min_x))//']')
    call winop@("%pl[x_max="//trim(log10scale_max_char(max_x))//']')
!   ---------------------------------------------------
     
    call winop@("%pl[link=lines, colour=black,symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=blue, symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=red,  symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=green,symbol=0, pen_style=0]")
    call winop@("%pl[title='STANDARD IEC IDMT CHARACTERISTICS']")
    call winop@("%pl[x_axis='Multiple of setting current [-]']")
    call winop@("%pl[y_axis='Relay operating time [s]']")
    i = winio@('%`bg[white]&')
    i = winio@('%pl',800,600,npts,amps,stand_inv,very_inv,extreme_inv,long_time_inv)
    generate_curves = 1

    contains
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Fri Oct 06, 2017 11:31 am    Post subject: Reply with quote

cont

Code:
   
    character(len=120) function log10scale_max_char(max_val)
    real(kind=2), intent(in) :: max_val
    real(kind=2) scale_max
      scale_max = log10scale_max(max_val)
      write(log10scale_max_char,*) scale_max
    end function log10scale_max_char


    character(len=120) function log10scale_min_char(min_val)
    real(kind=2), intent(in) :: min_val
    real(kind=2) scale_min
      scale_min = log10scale_min(min_val)
      write(log10scale_min_char,*) scale_min
    end function log10scale_min_char

    real(kind=2) function log10scale_max(max_val)
    real(kind=2), intent(in) :: max_val
    integer i
    real(kind=2) test_val
      do i = 308, -308, -1
        test_val = 10.d0**i
        if (max_val .gt. test_val) then
          log10scale_max = 10.d0**(i+1)
          exit
        else if (max_val .eq. test_val) then
          log10scale_max = test_val
          exit
        end if
      end do
    end function log10scale_max

    real(kind=2) function log10scale_min(min_val)
    real(kind=2), intent(in) :: min_val
    integer i
    real(kind=2) test_val
      do i = -308, 308, 1
        test_val = 10.d0**i
        if (min_val .lt. test_val) then
          log10scale_min = 10.d0**(i-1)
          exit
        else if (min_val .eq. test_val) then
          log10scale_min = test_val
          exit
        end if
      end do
    end function log10scale_min
   
  end function generate_curves
 
end module relay_curves_mod

program main
use relay_curves_mod
integer i
i = generate_curves()
end program main
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Fri Oct 06, 2017 11:36 am    Post subject: Reply with quote

cont

This works ok with DLL14 64 bit.
Back to top
View user's profile Send private message
DanRRight



Joined: 10 Mar 2008
Posts: 2925
Location: South Pole, Antarctica

PostPosted: Fri Oct 06, 2017 4:05 pm    Post subject: Reply with quote

Based on how much source text takes to plot similar graphs in Matlab or even older Simpleplot PL, i'd say that the glorious times of hacking returned back to this forum Smile. Before this was with broken Simpleplot PL, now it's native PL.

After trying everything we still could not fix the LOG_LOG with older Simpleplot PL, it worked only if X values do not exceed 1. And it had no X_min, Y_min, or framed plotting, and was buggy, crashing at Y values > 1e22, crashing debugger, not working with 64bit etc.

But like Matlab, older Simpleplot PL had no big problems with the correct LOG tics or labels. And, like in Matlab, the whole source code for the similar plots like above take only one single source text line. If it would take more no one would use them. With Matlab even 3D plot is done with one line, clearly people at Matlab know human psychology very well.

Here is what older Simpleplot PL produced (though crashing inside with LOG_LOG and turning to LINEAR_LOG plotting instead) with just one-two lines of Fortran code if plotting data already exist and all the fonts were preliminary set up. No minimum/maximum beautifications were necessary, let alone using Y_min for the native PL fixing. This is one single 132 character Fortran line!

Code:
i=winio@('%pl[title="STANDARD CHARACTERISTICS",colour=red,colour=green,X_ARRAY,N_GRAPHS=3,SCALE=LOG_LOG]%es',640,480,5,X,Y1,Y2,Y3)




The whole source code with setting data and fonts is here, SLINK its obj file with SIMPLE.DLL
Code:
real*8, dimension (5) :: X  = (/1.,    20.,  60., 200., 600./)
real*8, dimension (5) :: Y1 = (/2.9e4, 300.,  3., 0.2,  0.0022/)
real*8, dimension (5) :: Y2 = (/2.5e4, 500.,  2., 0.4,  0.042/)
real*8, dimension (5) :: Y3 = (/2.2e4, 722.,  2., 0.5,  0.072/)

        CALL DIAGLV (0)       
        CALL TEXTMN(0.4)      ! setting font size
        CALL AXLBJS('*C','C')  ! centering tic labels
        call thckmg('LINE',4.)  ! setting line width
        call chset(-11)          ! setting fonts

!... Case of two lines of Fortran source code
i=winio@('%ww%pv%pl[title="STANDARD IEC IDMT CHARACTERISTICS", x_axis="Multiple of setting current",y_axis="Relay operating time&
& [s]",  colour=red, colour=blue, colour=green, X_ARRAY, N_GRAPHS=3, SCALE=LOG_LOG]%es', 640, 480, 5, X, Y1, Y2, Y3)

End


Times actually are coming that even one single line will be way too much. People take their data to cell phone graphics plotting utility which costs $1 or is even free, set there all the MINs and MAXs if needed, and all analysis is done without programming at all. Look at BridPlot for example, the grand-grandson of Simpleplot.
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Sat Oct 07, 2017 10:51 am    Post subject: Reply with quote

Dan's data combined with Friday's "hack" and I can replicate the performance of the old simple plot with the native %pl.



And it works for log_log scales.

Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Sat Oct 07, 2017 2:46 pm    Post subject: Reply with quote

I was going to add grid lines to my log_log plots but unfortunately get_plot_point@ does not work with log scales as this example demonstrates.

Code:
module test
implicit none
integer, parameter, private :: dp = SELECTED_REAL_KIND(15,307)
real(kind=dp) :: x(1:5) = (/0.1d0,1.d0,10.d0,100.d0,1000.d0/)
real(kind=dp) :: y(1:5) = (/0.1d0,1.d0,10.d0,100.d0,1000.d0/)

contains

  integer function plot()
  include<windows.ins>
  integer i
    i = winio@('%mn[Exit]&','exit')
    i = winio@('%fn[Tahoma]&')
    i = winio@('%ts&', 1.5d0)
    call winop@('%pl[native,x_array,N_GRAPHS=1]')
    call winop@('%pl[scale=log_log]')
    call winop@('%pl[y_min=0.1,y_max=1000,x_min=0.1,x_max=1000]')
    call winop@('%pl[link=curves, colour=blue, symbol=11, pen_style=0]')
    i = winio@('%`bg[white]&')
    i = winio@('%^pl',800,600,5,x,y,call_back)
    plot=1
  end function plot

  integer function call_back()
  include<windows.ins>
  real(kind=dp) xx, yy
  integer i
    do i = 1, 5
      call get_plot_point@(x(i), y(i), xx, yy)
      call draw_ellipse@(nint(xx),nint(yy),6,6,rgb@(0,0,0))
      write(6,*) x(i), y(i), nint(xx), nint(yy)
    end do 
    call_back = 1
  end function call_back
 
end module test

program main
use test
integer i
i = plot()
end program main
Back to top
View user's profile Send private message
DanRRight



Joined: 10 Mar 2008
Posts: 2925
Location: South Pole, Antarctica

PostPosted: Sat Oct 07, 2017 5:19 pm    Post subject: Reply with quote

As everyone can see from comparison, even after the tricks and beautifications, even though the curves in native PL look better then in older PL, the unreasonable frame numbering, wrongly placed tic marks and other errors making the whole plot far from production quality.

Without the tricks (of setting X and Y axis min and max at exact orders of magnitude as Ken have done above) and beautifications (bullets, frames, font and lines sizes), here is what novice user will see for the first time in native PL as a default image when he will visualize with LOG_LINEAR and LOG_LOG the data above (even using more lines of Fortran code). For everyone raised on shiny covers of journals and flashy websites the cultural shock is guaranteed:

Code:
use clrwin
real*8 :: X (5) = (/1.,    20.,  60., 200., 600./)
real*8 :: Y1(5) = (/2.9e4, 300.,  3., 0.2,  0.0022/)
real*8 :: Y2(5) = (/2.5e4, 500.,  2., 0.4,  0.042/)
real*8 :: Y3(5) = (/2.2e4, 722.,  2., 0.5,  0.072/)

i=winio@('%pl[title="STANDARD IEC IDMT CHARACTERISTICS", x_axis="Multiple of setting current",y_axis="Relay operating time&
& [s]",  colour=red, colour=blue, colour=green, X_ARRAY, N_GRAPHS=3, SCALE=LOG_LOG]%es', 720, 480, 5, X, Y1, Y2, Y3)

End





Just in case, the compilation: ftn95 NativePL.f95 /link /64
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Sun Oct 08, 2017 11:46 am    Post subject: Reply with quote

I do agree with you Dan, my perseverance and enthusiasm with native the %pl is beginning to falter somewhat. I have hoped to be able to generate a plot similar to the one below with grid lines, but it's not that straightforward. Even if I can decode the coordinates returned by get_plot_point@ with log graphs, there is an added complication of user selected margins to consider, which takes me back to the struggles I have with my own %gr based plotting routines.



Guess we all just have to wait on Paul and his colleagues having the time to look at these issues. A quick fix for get_plot_point@ with log scales would be a step in the right direction as I can live with having to select appropriate ranges for scales.
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 8214
Location: Salford, UK

PostPosted: Thu Oct 12, 2017 7:03 am    Post subject: Reply with quote

I don't know if it is a bug or if, like a number of these plots, it is a matter of choosing nice values for y_min, y_max, dx and dy. If and when I am able to do more work on this we will need to start off with some simple plots that illustrate the problems. But please don't post them now.

In the mean time one or two fixes have been made and...

a) the limit on number of plots (previously 10) has been removed. At the same time, an option [stacked] has been added which means that the y (and x) data for different plots is concatenated in order to avoid multiple winio@ arguments. The concatenation is equivalent to using a two dimensional array for the data but this 2D array can be "ragged".

b) an option [gridlines] has been added with the expected result.
Back to top
View user's profile Send private message AIM Address
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Thu Oct 12, 2017 12:40 pm    Post subject: Reply with quote

Paul,

The option external_ticks works well, but unfortunately it does not address the issue of cases where the data to be plotted obscures the scale numbers on the axis as shown bottom right below, perhaps you might consider an 'external_scales' option at some time in the future.



Apologies for raising this again, my intention is to provide positive suggestions which all users will benefit from rather than negative feedback.

The news that you have implemented grid lines is a big step forward. I look forward to being able to use that option.
Back to top
View user's profile Send private message
Kenneth_Smith



Joined: 18 May 2012
Posts: 816
Location: Hamilton, Lanarkshire, Scotland.

PostPosted: Thu Oct 12, 2017 1:05 pm    Post subject: Reply with quote

As for the issue with get_plot_point@ with log-log scales, I don't think this is related to the selection of y_min, y_max etc. I have experimented with lots of variations on this. My impression is that somewhere within %pl there is a coordinate transformation that is the root cause of all the problems we are collectively complaining about.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+ All times are GMT + 1 Hour
Goto page Previous  1, 2, 3 ... 5, 6, 7 ... 26, 27, 28  Next
Page 6 of 28

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Powered by phpBB © 2001, 2005 phpBB Group